From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Po Lu Newsgroups: gmane.emacs.devel Subject: Re: Pixel scrolling support Date: Fri, 26 Nov 2021 15:01:57 +0800 Message-ID: <87sfvjfli2.fsf@yahoo.com> References: <87a6hrzrcv.fsf.ref@yahoo.com> <87a6hrzrcv.fsf@yahoo.com> <87v90fhayx.fsf@yahoo.com> <835ysf4dyr.fsf@gnu.org> <871r33h0th.fsf@yahoo.com> <8335nj4d53.fsf@gnu.org> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="29279"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/28.0.60 (gnu/linux) Cc: monnier@iro.umontreal.ca, emacs-devel@gnu.org To: Eli Zaretskii Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Fri Nov 26 08:02:57 2021 Return-path: Envelope-to: ged-emacs-devel@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1mqVG5-0007Oi-4R for ged-emacs-devel@m.gmane-mx.org; Fri, 26 Nov 2021 08:02:57 +0100 Original-Received: from localhost ([::1]:60212 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1mqVG3-0004N0-8O for ged-emacs-devel@m.gmane-mx.org; Fri, 26 Nov 2021 02:02:55 -0500 Original-Received: from eggs.gnu.org ([209.51.188.92]:55664) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1mqVFM-0003Yd-7b for emacs-devel@gnu.org; Fri, 26 Nov 2021 02:02:12 -0500 Original-Received: from sonic306-20.consmr.mail.ne1.yahoo.com ([66.163.189.82]:46423) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1mqVFJ-0001JZ-Bo for emacs-devel@gnu.org; Fri, 26 Nov 2021 02:02:11 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=yahoo.com; s=s2048; t=1637910127; bh=tccnk0hbgb2VlBkLxgJuiynAs6W9mcPDVgiRtsDVDN0=; h=From:To:Cc:Subject:References:Date:In-Reply-To:From:Subject:Reply-To; b=epOkp82J/trEXjc15HLbXPBefzbHCmOu1Ky2jqJJSzXPLosKomZ0Zssp8KKZkzjWH1QOdPj0K2C7GxUXXufsNlCuayZBLXnIIAtNP84YLvLXf33omTuZpVk3CdLmt4dfSJG6/A+n64Lc1b9FP4OgqkSQ9/CSfTledqoWeCsBS7/E5/7Q/YnmMGoaeQNj0PPBcEuHgdTgAffAwQMd30ZQOtMA4OG/wBsnu4cA5GgcAIIGWys6udDE5UR8Px66zcXtqSW8Zq6ucWvGDnGvKalTXuN+nLIIcC1m2eWF2dCFBEmsoHJ8Dn+dFirUUVmRicJeVrQNc9iqY8J5tFcTpSYFvg== X-SONIC-DKIM-SIGN: v=1; a=rsa-sha256; c=relaxed/relaxed; d=yahoo.com; s=s2048; t=1637910127; bh=Ou+snBpcXrD+O8dQkICvAAABVmfoJp0y8bMtD+8cXBc=; h=X-Sonic-MF:From:To:Subject:Date:From:Subject; b=ssibmVIo9kgN+8G83yPdejGtubh5i6u5JllQ9f2EvkvReYffdrmPbC3VHCPu5FizLdZT4r2I0ev7XnOqWgi3iMZAOMDAXbxCqXQwZ9yVYIzDUmW9Zr/pq++3Hsgxtktczn3OIYVsSd7xaeI1oryTM+T2D2769MXGncY4N3mK8Lld7KNKeTgNz+czIh/NAk1Eb/rwI0F87AavfQvfVfv68rfY6gWviQOA6EWuTjAm684SWUW01dO48TSfFWOiigL7+Z7YbiF1TgdaSlgJHvj2aneTCL1+C5/H8hrHQBWGt4OIdMmz+od94k00h/A+KiDFvCCrDQ4AJCwEB06UgSVSKw== X-YMail-OSG: 5V6KltkVM1nEiqnbxj6CVjIlIOG2G9jMbHUtCePNPTLW6Gt0oshQiczKY4ETTpv Ur96C6JM1MMXkAA.xl6luqQtu7LWUDzE2LMNkfT9jOk1usg40uhTH0hq3XOcVxmBB1IVfD.e1s.. LIVpwbfSkK861nNBh5GbuZPgdRDSLFAZJzxgCiEGDRwbVf44Tz74zK2hqb78l4VgOP75dAPF8PkM _oSe10MjuwjjriXESyXoXj_5.F_lgdEaUWYFuPHszL9wo7c7xHNyoAMedhgyf0CSve3Y593jZKMy 7tfh0ldMjPLA.HE2gdakeF7H9u3XzQrFhAm294UzcMdUIW1Y6bcsxVXL.JIf1wPwau5KjEp2dHuM S3bIcGu0EETzv9QNwa5oHf3RLLFgg4SLqDoxI5DP6J6gpWb_as0ngkWilTBKsMO6x6.e5jzOUNeT wFZsIAgVvghFtDwtzS7nPb_uEauq4NhxMHevEQ3nLUSUlAczWD8_dJUhUn_D9AKkkSaXmt159hpt upvPXD5396fGkeF_GLQ7tykignghkKZ4WM7b8aZLa.6zUTlVBbIR4SSY06VC4JCE0nIZ7cRRFOVD eJs1Xhj4C0WaA9q9Jx567MW7R5ij12keokfPCKaDo0lu2LPKf.Hpe37FNJ.k5vRmBHRiagKhseCq h8_snNefNFyyOuwiy.CvPR0zR.7ccFzNrpcwqNZYdW_Cf3Z6kBeyA2l8cbvDrdO5GNDurksKR7kr 8vJxI0TkKn8vR0QRK9jHQHC9bkhg0rv3x6Wst6keKHLFW2JVcMO65465oB.LQeQkj2NrYyrfjLTy gEc7oKVHSmxv.PYM8kxqBGCZ4OSYcop8q_u0k.aZtT X-Sonic-MF: Original-Received: from sonic.gate.mail.ne1.yahoo.com by sonic306.consmr.mail.ne1.yahoo.com with HTTP; Fri, 26 Nov 2021 07:02:07 +0000 Original-Received: by kubenode509.mail-prod1.omega.sg3.yahoo.com (VZM Hermes SMTP Server) with ESMTPA ID cc51c879412cd76460b92d0e4072804d; Fri, 26 Nov 2021 07:02:01 +0000 (UTC) In-Reply-To: <8335nj4d53.fsf@gnu.org> (Eli Zaretskii's message of "Fri, 26 Nov 2021 08:58:00 +0200") X-Mailer: WebService/1.1.19306 mail.backend.jedi.jws.acl:role.jedi.acl.token.atz.jws.hermes.yahoo Received-SPF: pass client-ip=66.163.189.82; envelope-from=luangruo@yahoo.com; helo=sonic306-20.consmr.mail.ne1.yahoo.com X-Spam_score_int: -20 X-Spam_score: -2.1 X-Spam_bar: -- X-Spam_report: (-2.1 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, FREEMAIL_FROM=0.001, RCVD_IN_DNSWL_NONE=-0.0001, RCVD_IN_MSPIKE_H2=-0.001, SPF_HELO_NONE=0.001, SPF_PASS=-0.001 autolearn=unavailable autolearn_force=no X-Spam_action: no action X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Original-Sender: "Emacs-devel" Xref: news.gmane.io gmane.emacs.devel:280207 Archived-At: --=-=-= Content-Type: text/plain Eli Zaretskii writes: > Separate mode should be fine, but we need a good name for it ("better > pixel scroll" is not a good name). Thanks, how about `pixel-scroll-precise-mode'? --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-Move-the-precise-pixel-scrolling-feature-to-pixel-sc.patch >From db8bf63b949ab65e7ed7ff6b9dfbcd5428cc11c4 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Fri, 26 Nov 2021 14:51:27 +0800 Subject: [PATCH] Move the precise pixel scrolling feature to pixel-scroll.el * etc/NEWS: Update NEWS entry for 'pixel-scroll-precise-mode' * lisp/better-pixel-scroll.el: Remove file. * src/pixel-scroll.el (x-coalesce-scroll-events): New variable declaration. (pixel-scroll-precise-mode-map): New variable. (pixel-scroll-precise-scroll-down): (pixel-scroll-precise-scroll-up): (pixel-scroll-precise): New functions. (pixel-scroll-precise-mode): New minor mode. --- etc/NEWS | 2 +- lisp/better-pixel-scroll.el | 147 ------------------------------------ lisp/pixel-scroll.el | 115 ++++++++++++++++++++++++++++ 3 files changed, 116 insertions(+), 148 deletions(-) delete mode 100644 lisp/better-pixel-scroll.el diff --git a/etc/NEWS b/etc/NEWS index 329de2f811..af8689ab83 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -94,7 +94,7 @@ This controls the thickness of the external borders of the menu bars and pop-up menus. --- -** New minor mode 'better-pixel-scroll-mode'. +** New minor mode 'pixel-scroll-precise-mode'. When enabled, using this mode with a capable scroll wheel will result in the display being scrolled precisely according to the turning of that wheel. diff --git a/lisp/better-pixel-scroll.el b/lisp/better-pixel-scroll.el deleted file mode 100644 index c1469108e0..0000000000 --- a/lisp/better-pixel-scroll.el +++ /dev/null @@ -1,147 +0,0 @@ -;;; better-pixel-scroll.el --- Pixel scrolling support -*- lexical-binding:t -*- - -;; Copyright (C) 2021 Free Software Foundation, Inc. - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Commentary: - -;; This enables the use of smooth scroll events provided by XInput 2 -;; or NS to scroll the display according to the user's precise turning -;; of the mouse wheel. - -;;; Code: - -(require 'mwheel) -(require 'subr-x) - -(defvar x-coalesce-scroll-events) - -(defvar better-pixel-scroll-mode-map - (let ((map (make-sparse-keymap))) - (define-key map [wheel-down] #'better-pixel-scroll) - (define-key map [wheel-up] #'better-pixel-scroll) - map) - "The key map used by `better-pixel-scroll-mode'.") - -(defun better-pixel-scroll-scroll-down (delta) - "Scroll the current window down by DELTA pixels. -Note that this function doesn't work if DELTA is larger than -the height of the current window." - (when-let* ((posn (posn-at-point)) - (current-y (cdr (posn-x-y posn))) - (min-y (+ (window-tab-line-height) - (window-header-line-height))) - (cursor-height (line-pixel-height)) - (window-height (window-text-height nil t)) - (next-height (save-excursion - (vertical-motion 1) - (line-pixel-height)))) - (if (and (> delta 0) - (<= cursor-height window-height)) - (while (< (- current-y min-y) delta) - (vertical-motion 1) - (setq current-y (+ current-y - (line-pixel-height))) - (when (eobp) - (error "End of buffer"))) - (when (< (- (cdr (posn-object-width-height posn)) - (cdr (posn-object-x-y posn))) - (- window-height next-height)) - (vertical-motion 1) - (setq posn (posn-at-point) - current-y (cdr (posn-x-y posn))) - (while (< (- current-y min-y) delta) - (vertical-motion 1) - (setq current-y (+ current-y - (line-pixel-height))) - (when (eobp) - (error "End of buffer"))))) - (let* ((desired-pos (posn-at-x-y 0 (+ delta - (window-tab-line-height) - (window-header-line-height)))) - (desired-start (posn-point desired-pos)) - (desired-vscroll (cdr (posn-object-x-y desired-pos)))) - (unless (eq (window-start) desired-start) - (set-window-start nil desired-start t)) - (set-window-vscroll nil desired-vscroll t)))) - -(defun better-pixel-scroll-scroll-up (delta) - "Scroll the current window up by DELTA pixels." - (when-let* ((max-y (- (window-text-height nil t) - (window-tab-line-height) - (window-header-line-height))) - (posn (posn-at-point)) - (current-y (+ (cdr (posn-x-y posn)) - (cdr (posn-object-width-height posn))))) - (while (< (- max-y current-y) delta) - (vertical-motion -1) - (setq current-y (- current-y (line-pixel-height))))) - (let ((current-vscroll (window-vscroll nil t))) - (setq delta (- delta current-vscroll)) - (set-window-vscroll nil 0 t)) - (while (> delta 0) - (set-window-start nil (save-excursion - (goto-char (window-start)) - (when (zerop (vertical-motion -1)) - (set-window-vscroll nil 0) - (signal 'beginning-of-buffer nil)) - (setq delta (- delta (line-pixel-height))) - (point)) - t)) - (when (< delta 0) - (when-let* ((desired-pos (posn-at-x-y 0 (+ (- delta) - (window-tab-line-height) - (window-header-line-height)))) - (desired-start (posn-point desired-pos)) - (desired-vscroll (cdr (posn-object-x-y desired-pos)))) - (unless (eq (window-start) desired-start) - (set-window-start nil desired-start t)) - (set-window-vscroll nil desired-vscroll t)))) - -(defun better-pixel-scroll (event &optional arg) - "Scroll the display according to EVENT. -Take into account any pixel deltas in EVENT to scroll the display -according to the user's turning the mouse wheel. If EVENT does -not have precise scrolling deltas, call `mwheel-scroll' instead. -ARG is passed to `mwheel-scroll', should that be called." - (interactive (list last-input-event current-prefix-arg)) - (let ((window (mwheel-event-window event))) - (if (and (nth 4 event) - (zerop (window-hscroll window))) - (let ((delta (round (cdr (nth 4 event))))) - (if (> (abs delta) (window-text-height window t)) - (mwheel-scroll event arg) - (with-selected-window window - (if (< delta 0) - (better-pixel-scroll-scroll-down (- delta)) - (better-pixel-scroll-scroll-up delta))))) - (mwheel-scroll event arg)))) - -;;;###autoload -(define-minor-mode better-pixel-scroll-mode - "Toggle pixel scrolling. -When enabled, this minor mode allows to scroll the display -precisely, according to the turning of the mouse wheel." - :global t - :group 'mouse - :keymap better-pixel-scroll-mode-map - (setq x-coalesce-scroll-events - (not better-pixel-scroll-mode))) - -(provide 'better-pixel-scroll) - -;;; better-pixel-scroll.el ends here. diff --git a/lisp/pixel-scroll.el b/lisp/pixel-scroll.el index 249484cf58..9ea92fe903 100644 --- a/lisp/pixel-scroll.el +++ b/lisp/pixel-scroll.el @@ -67,6 +67,7 @@ ;;; Code: (require 'mwheel) +(require 'subr-x) (defvar pixel-wait 0 "Idle time on each step of pixel scroll specified in second. @@ -90,6 +91,15 @@ pixel-dead-time (defvar pixel-last-scroll-time 0 "Time when the last scrolling was made, in second since the epoch.") +(defvar x-coalesce-scroll-events) + +(defvar pixel-scroll-precise-mode-map + (let ((map (make-sparse-keymap))) + (define-key map [wheel-down] #'pixel-scroll-precise) + (define-key map [wheel-up] #'pixel-scroll-precise) + map) + "The key map used by `pixel-scroll-precise-mode'.") + (defun pixel-scroll-in-rush-p () "Return non-nil if next scroll should be non-smooth. When scrolling request is delivered soon after the previous one, @@ -354,5 +364,110 @@ pixel-scroll-down-and-set-window-vscroll (set-window-start nil (pixel-point-at-unseen-line) t) (set-window-vscroll nil vscroll t)) +(defun pixel-scroll-precise-scroll-down (delta) + "Scroll the current window down by DELTA pixels. +Note that this function doesn't work if DELTA is larger than +the height of the current window." + (when-let* ((posn (posn-at-point)) + (current-y (cdr (posn-x-y posn))) + (min-y (+ (window-tab-line-height) + (window-header-line-height))) + (cursor-height (line-pixel-height)) + (window-height (window-text-height nil t)) + (next-height (save-excursion + (vertical-motion 1) + (line-pixel-height)))) + (if (and (> delta 0) + (<= cursor-height window-height)) + (while (< (- current-y min-y) delta) + (vertical-motion 1) + (setq current-y (+ current-y + (line-pixel-height))) + (when (eobp) + (error "End of buffer"))) + (when (< (- (cdr (posn-object-width-height posn)) + (cdr (posn-object-x-y posn))) + (- window-height next-height)) + (vertical-motion 1) + (setq posn (posn-at-point) + current-y (cdr (posn-x-y posn))) + (while (< (- current-y min-y) delta) + (vertical-motion 1) + (setq current-y (+ current-y + (line-pixel-height))) + (when (eobp) + (error "End of buffer"))))) + (let* ((desired-pos (posn-at-x-y 0 (+ delta + (window-tab-line-height) + (window-header-line-height)))) + (desired-start (posn-point desired-pos)) + (desired-vscroll (cdr (posn-object-x-y desired-pos)))) + (unless (eq (window-start) desired-start) + (set-window-start nil desired-start t)) + (set-window-vscroll nil desired-vscroll t)))) + +(defun pixel-scroll-precise-scroll-up (delta) + "Scroll the current window up by DELTA pixels." + (when-let* ((max-y (- (window-text-height nil t) + (window-tab-line-height) + (window-header-line-height))) + (posn (posn-at-point)) + (current-y (+ (cdr (posn-x-y posn)) + (cdr (posn-object-width-height posn))))) + (while (< (- max-y current-y) delta) + (vertical-motion -1) + (setq current-y (- current-y (line-pixel-height))))) + (let ((current-vscroll (window-vscroll nil t))) + (setq delta (- delta current-vscroll)) + (set-window-vscroll nil 0 t)) + (while (> delta 0) + (set-window-start nil (save-excursion + (goto-char (window-start)) + (when (zerop (vertical-motion -1)) + (set-window-vscroll nil 0) + (signal 'beginning-of-buffer nil)) + (setq delta (- delta (line-pixel-height))) + (point)) + t)) + (when (< delta 0) + (when-let* ((desired-pos (posn-at-x-y 0 (+ (- delta) + (window-tab-line-height) + (window-header-line-height)))) + (desired-start (posn-point desired-pos)) + (desired-vscroll (cdr (posn-object-x-y desired-pos)))) + (unless (eq (window-start) desired-start) + (set-window-start nil desired-start t)) + (set-window-vscroll nil desired-vscroll t)))) + +(defun pixel-scroll-precise (event &optional arg) + "Scroll the display according to EVENT. +Take into account any pixel deltas in EVENT to scroll the display +according to the user's turning the mouse wheel. If EVENT does +not have precise scrolling deltas, call `mwheel-scroll' instead. +ARG is passed to `mwheel-scroll', should that be called." + (interactive (list last-input-event current-prefix-arg)) + (let ((window (mwheel-event-window event))) + (if (and (nth 4 event) + (zerop (window-hscroll window))) + (let ((delta (round (cdr (nth 4 event))))) + (if (> (abs delta) (window-text-height window t)) + (mwheel-scroll event arg) + (with-selected-window window + (if (< delta 0) + (pixel-scroll-precise-scroll-down (- delta)) + (pixel-scroll-precise-scroll-up delta))))) + (mwheel-scroll event arg)))) + +;;;###autoload +(define-minor-mode pixel-scroll-precise-mode + "Toggle pixel scrolling. +When enabled, this minor mode allows to scroll the display +precisely, according to the turning of the mouse wheel." + :global t + :group 'mouse + :keymap pixel-scroll-precise-mode-map + (setq x-coalesce-scroll-events + (not pixel-scroll-precise-mode))) + (provide 'pixel-scroll) ;;; pixel-scroll.el ends here -- 2.33.1 --=-=-=--