bug#16196: 24.3.50; Disable ding when scrolling

[Stefan Kangas <stefan@marxist.se>]

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

Stefan Monnier <monnier@iro.umontreal.ca> writes:

>>> So the question is: which kind of feedback should we use instead?
>>> I'd rather keep some kind of feedback.  Maybe a `message'?
>> As we do already.
>
> Indeed!  I didn't notice it because the (ding) drowns it out.
>
>> Just suppress the additional beep.
>
> Sounds OK.  Can someone provide a patch to mwheel.el?

I took a stab at this.  The attached patch traps the beginning-of-buffer
and end-of-buffer errors and shows a message instead as suggested above.

To make it easier to review, I've also included a git diff
ignoring whitespace changes.

What do you think?

Best regards,
Stefan Kangas

[-- Attachment #2: 0001-Make-mouse-scroll-show-a-message-instead-of-dinging-.patch --]
[-- Type: application/octet-stream, Size: 11941 bytes --]

From b96a34adce2c494f02656b2ee81942fc9216b294 Mon Sep 17 00:00:00 2001
From: Stefan Kangas <stefankangas@gmail.com>
Date: Fri, 9 Aug 2019 09:39:16 +0200
Subject: [PATCH] Make mouse scroll show a message instead of dinging at buffer
 limits

* lisp/mwheel.el (mwheel-scroll): Show a message instead of dinging at
end of buffer and beginning of buffer.  This should be less intrusive,
especially when using a trackpad.  (Bug#16196)
---
 lisp/mwheel.el | 196 +++++++++++++++++++++++++------------------------
 1 file changed, 102 insertions(+), 94 deletions(-)

diff --git a/lisp/mwheel.el b/lisp/mwheel.el
index dfea55374b..34e4668b5a 100644
--- a/lisp/mwheel.el
+++ b/lisp/mwheel.el
@@ -208,100 +208,108 @@ mwheel-scroll
 This should be bound only to mouse buttons 4, 5, 6, and 7 on
 non-Windows systems."
   (interactive (list last-input-event))
-  (let* ((selected-window (selected-window))
-         (scroll-window
-          (or (catch 'found
-                (let* ((window (if mouse-wheel-follow-mouse
-                                   (mwheel-event-window event)
-                                 (selected-window)))
-                       (frame (when (window-live-p window)
-                                (frame-parameter
-                                 (window-frame window) 'mouse-wheel-frame))))
-                  (when (frame-live-p frame)
-                    (let* ((pos (mouse-absolute-pixel-position))
-                           (pos-x (car pos))
-                           (pos-y (cdr pos)))
-                      (walk-window-tree
-                       (lambda (window-1)
-                         (let ((edges (window-edges window-1 nil t t)))
-                           (when (and (<= (nth 0 edges) pos-x)
-                                      (<= pos-x (nth 2 edges))
-                                      (<= (nth 1 edges) pos-y)
-                                      (<= pos-y (nth 3 edges)))
-                             (throw 'found window-1))))
-                       frame nil t)))))
-              (mwheel-event-window event)))
-	 (old-point
-          (and (eq scroll-window selected-window)
-	       (eq (car-safe transient-mark-mode) 'only)
-	       (window-point)))
-         (mods
-	  (delq 'click (delq 'double (delq 'triple (event-modifiers event)))))
-         (amt (assoc mods mouse-wheel-scroll-amount)))
-    (unless (eq scroll-window selected-window)
-      ;; Mark window to be scrolled for redisplay.
-      (select-window scroll-window 'mark-for-redisplay))
-    ;; Extract the actual amount or find the element that has no modifiers.
-    (if amt (setq amt (cdr amt))
-      (let ((list-elt mouse-wheel-scroll-amount))
-	(while (consp (setq amt (pop list-elt))))))
-    (if (floatp amt) (setq amt (1+ (truncate (* amt (window-height))))))
-    (when (and mouse-wheel-progressive-speed (numberp amt))
-      ;; When the double-mouse-N comes in, a mouse-N has been executed already,
-      ;; So by adding things up we get a squaring up (1, 3, 6, 10, 15, ...).
-      (setq amt (* amt (event-click-count event))))
-    (when (numberp amt) (setq amt (* amt (event-line-count event))))
-    (unwind-protect
-	(let ((button (mwheel-event-button event)))
-	  (cond ((eq button mouse-wheel-down-event)
-                 (condition-case nil (funcall mwheel-scroll-down-function amt)
-                   ;; Make sure we do indeed scroll to the beginning of
-                   ;; the buffer.
-                   (beginning-of-buffer
-                    (unwind-protect
-                        (funcall mwheel-scroll-down-function)
-                      ;; If the first scroll succeeded, then some scrolling
-                      ;; is possible: keep scrolling til the beginning but
-                      ;; do not signal an error.  For some reason, we have
-                      ;; to do it even if the first scroll signaled an
-                      ;; error, because otherwise the window is recentered
-                      ;; for a reason that escapes me.  This problem seems
-                      ;; to only affect scroll-down.  --Stef
-                      (set-window-start (selected-window) (point-min))))))
-		((eq button mouse-wheel-up-event)
-                 (condition-case nil (funcall mwheel-scroll-up-function amt)
-                   ;; Make sure we do indeed scroll to the end of the buffer.
-                   (end-of-buffer (while t (funcall mwheel-scroll-up-function)))))
-                ((eq button mouse-wheel-left-event) ; for tilt scroll
-                 (when mouse-wheel-tilt-scroll
-                   (funcall (if mouse-wheel-flip-direction
-                                mwheel-scroll-right-function
-                              mwheel-scroll-left-function) amt)))
-                ((eq button mouse-wheel-right-event) ; for tilt scroll
-                 (when mouse-wheel-tilt-scroll
-                   (funcall (if mouse-wheel-flip-direction
-                                mwheel-scroll-left-function
-                              mwheel-scroll-right-function) amt)))
-		(t (error "Bad binding in mwheel-scroll"))))
-      (if (eq scroll-window selected-window)
-	  ;; If there is a temporarily active region, deactivate it if
-	  ;; scrolling moved point.
-	  (when (and old-point (/= old-point (window-point)))
-	    ;; Call `deactivate-mark' at the original position, so that
-	    ;; the original region is saved to the X selection.
-	    (let ((new-point (window-point)))
-	      (goto-char old-point)
-	      (deactivate-mark)
-	      (goto-char new-point)))
-	(select-window selected-window t))))
-
-  (when (and mouse-wheel-click-event mouse-wheel-inhibit-click-time)
-    (if mwheel-inhibit-click-event-timer
-	(cancel-timer mwheel-inhibit-click-event-timer)
-      (add-hook 'pre-command-hook 'mwheel-filter-click-events))
-    (setq mwheel-inhibit-click-event-timer
-	  (run-with-timer mouse-wheel-inhibit-click-time nil
-			  'mwheel-inhibit-click-timeout))))
+  (let (saw-error)
+    (let* ((selected-window (selected-window))
+           (scroll-window
+            (or (catch 'found
+                  (let* ((window (if mouse-wheel-follow-mouse
+                                     (mwheel-event-window event)
+                                   (selected-window)))
+                         (frame (when (window-live-p window)
+                                  (frame-parameter
+                                   (window-frame window) 'mouse-wheel-frame))))
+                    (when (frame-live-p frame)
+                      (let* ((pos (mouse-absolute-pixel-position))
+                             (pos-x (car pos))
+                             (pos-y (cdr pos)))
+                        (walk-window-tree
+                         (lambda (window-1)
+                           (let ((edges (window-edges window-1 nil t t)))
+                             (when (and (<= (nth 0 edges) pos-x)
+                                        (<= pos-x (nth 2 edges))
+                                        (<= (nth 1 edges) pos-y)
+                                        (<= pos-y (nth 3 edges)))
+                               (throw 'found window-1))))
+                         frame nil t)))))
+                (mwheel-event-window event)))
+	   (old-point
+            (and (eq scroll-window selected-window)
+	         (eq (car-safe transient-mark-mode) 'only)
+	         (window-point)))
+           (mods
+	    (delq 'click (delq 'double (delq 'triple (event-modifiers event)))))
+           (amt (assoc mods mouse-wheel-scroll-amount)))
+      (unless (eq scroll-window selected-window)
+        ;; Mark window to be scrolled for redisplay.
+        (select-window scroll-window 'mark-for-redisplay))
+      ;; Extract the actual amount or find the element that has no modifiers.
+      (if amt (setq amt (cdr amt))
+        (let ((list-elt mouse-wheel-scroll-amount))
+	  (while (consp (setq amt (pop list-elt))))))
+      (if (floatp amt) (setq amt (1+ (truncate (* amt (window-height))))))
+      (when (and mouse-wheel-progressive-speed (numberp amt))
+        ;; When the double-mouse-N comes in, a mouse-N has been executed already,
+        ;; So by adding things up we get a squaring up (1, 3, 6, 10, 15, ...).
+        (setq amt (* amt (event-click-count event))))
+      (when (numberp amt) (setq amt (* amt (event-line-count event))))
+      (condition-case nil
+          (unwind-protect
+	      (let ((button (mwheel-event-button event)))
+	        (cond ((eq button mouse-wheel-down-event)
+                       (condition-case nil (funcall mwheel-scroll-down-function amt)
+                         ;; Make sure we do indeed scroll to the beginning of
+                         ;; the buffer.
+                         (beginning-of-buffer
+                          (unwind-protect
+                              (funcall mwheel-scroll-down-function)
+                            ;; If the first scroll succeeded, then some scrolling
+                            ;; is possible: keep scrolling til the beginning but
+                            ;; do not signal an error.  For some reason, we have
+                            ;; to do it even if the first scroll signaled an
+                            ;; error, because otherwise the window is recentered
+                            ;; for a reason that escapes me.  This problem seems
+                            ;; to only affect scroll-down.  --Stef
+                            (set-window-start (selected-window) (point-min))))))
+		      ((eq button mouse-wheel-up-event)
+                       (condition-case nil (funcall mwheel-scroll-up-function amt)
+                         ;; Make sure we do indeed scroll to the end of the buffer.
+                         (end-of-buffer (while t (funcall mwheel-scroll-up-function)))))
+                      ((eq button mouse-wheel-left-event) ; for tilt scroll
+                       (when mouse-wheel-tilt-scroll
+                         (funcall (if mouse-wheel-flip-direction
+                                      mwheel-scroll-right-function
+                                    mwheel-scroll-left-function) amt)))
+                      ((eq button mouse-wheel-right-event) ; for tilt scroll
+                       (when mouse-wheel-tilt-scroll
+                         (funcall (if mouse-wheel-flip-direction
+                                      mwheel-scroll-left-function
+                                    mwheel-scroll-right-function) amt)))
+		      (t (error "Bad binding in mwheel-scroll"))))
+            (if (eq scroll-window selected-window)
+                ;; If there is a temporarily active region, deactivate it if
+                ;; scrolling moved point.
+	        (when (and old-point (/= old-point (window-point)))
+                  ;; Call `deactivate-mark' at the original position, so that
+                  ;; the original region is saved to the X selection.
+	          (let ((new-point (window-point)))
+	            (goto-char old-point)
+	            (deactivate-mark)
+	            (goto-char new-point)))
+	      (select-window selected-window t)))
+        ;; Do not ding at buffer limits.  Show a message instead.
+        (beginning-of-buffer (message "Beginning of buffer")
+                             (setq saw-error t))
+        (end-of-buffer (message "End of buffer")
+                       (setq saw-error t))))
+
+    (when (and (not saw-error)
+               mouse-wheel-click-event mouse-wheel-inhibit-click-time)
+      (if mwheel-inhibit-click-event-timer
+          (cancel-timer mwheel-inhibit-click-event-timer)
+        (add-hook 'pre-command-hook 'mwheel-filter-click-events))
+      (setq mwheel-inhibit-click-event-timer
+            (run-with-timer mouse-wheel-inhibit-click-time nil
+                            'mwheel-inhibit-click-timeout)))))
 
 (put 'mwheel-scroll 'scroll-command t)
 
-- 
2.22.0


[-- Attachment #3: bug-16196-no-ws.diff --]
[-- Type: application/octet-stream, Size: 1914 bytes --]

diff --git a/lisp/mwheel.el b/lisp/mwheel.el
index dfea55374b..34e4668b5a 100644
--- a/lisp/mwheel.el
+++ b/lisp/mwheel.el
@@ -208,6 +208,7 @@ mwheel-scroll
 This should be bound only to mouse buttons 4, 5, 6, and 7 on
 non-Windows systems."
   (interactive (list last-input-event))
+  (let (saw-error)
     (let* ((selected-window (selected-window))
            (scroll-window
             (or (catch 'found
@@ -251,6 +252,7 @@ mwheel-scroll
         ;; So by adding things up we get a squaring up (1, 3, 6, 10, 15, ...).
         (setq amt (* amt (event-click-count event))))
       (when (numberp amt) (setq amt (* amt (event-line-count event))))
+      (condition-case nil
           (unwind-protect
 	      (let ((button (mwheel-event-button event)))
 	        (cond ((eq button mouse-wheel-down-event)
@@ -293,15 +295,21 @@ mwheel-scroll
 	            (goto-char old-point)
 	            (deactivate-mark)
 	            (goto-char new-point)))
-	(select-window selected-window t))))
-
-  (when (and mouse-wheel-click-event mouse-wheel-inhibit-click-time)
+	      (select-window selected-window t)))
+        ;; Do not ding at buffer limits.  Show a message instead.
+        (beginning-of-buffer (message "Beginning of buffer")
+                             (setq saw-error t))
+        (end-of-buffer (message "End of buffer")
+                       (setq saw-error t))))
+
+    (when (and (not saw-error)
+               mouse-wheel-click-event mouse-wheel-inhibit-click-time)
       (if mwheel-inhibit-click-event-timer
           (cancel-timer mwheel-inhibit-click-event-timer)
         (add-hook 'pre-command-hook 'mwheel-filter-click-events))
       (setq mwheel-inhibit-click-event-timer
             (run-with-timer mouse-wheel-inhibit-click-time nil
-			  'mwheel-inhibit-click-timeout))))
+                            'mwheel-inhibit-click-timeout)))))
 
 (put 'mwheel-scroll 'scroll-command t)