Re: Pixel scrolling support

[Po Lu <luangruo@yahoo.com>]

[-- Attachment #1: Type: text/plain, Size: 196 bytes --]

Eli Zaretskii <eliz@gnu.org> 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'?


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Move-the-precise-pixel-scrolling-feature-to-pixel-sc.patch --]
[-- Type: text/x-patch, Size: 12999 bytes --]

From db8bf63b949ab65e7ed7ff6b9dfbcd5428cc11c4 Mon Sep 17 00:00:00 2001
From: Po Lu <luangruo@yahoo.com>
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 <https://www.gnu.org/licenses/>.
-
-;;; 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