scratch/mwheel-no-alts f355557bb9e 7/7: mwheel.el: Code clean to reduce duplication

[Stefan Monnier]

branch: scratch/mwheel-no-alts
commit f355557bb9e93f5d5e7c3fae17e4da398226efb4
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>

    mwheel.el: Code clean to reduce duplication
    
    * lisp/mwheel.el (mouse-wheel-obey-old-style-wheel-buttons): New var,
    extracted from `mouse-wheel-*-event` definitions.
    (mouse-wheel-down-event, mouse-wheel-up-event)
    (mouse-wheel-left-event, mouse-wheel-right-event): Use it.
---
 lisp/mwheel.el | 54 +++++++++++++++++++++---------------------------------
 1 file changed, 21 insertions(+), 33 deletions(-)

diff --git a/lisp/mwheel.el b/lisp/mwheel.el
index 438ca5f84d5..fc1f8e8b6d6 100644
--- a/lisp/mwheel.el
+++ b/lisp/mwheel.el
@@ -56,33 +56,33 @@
              (bound-and-true-p mouse-wheel-mode))
     (mouse-wheel-mode 1)))
 
-(defcustom mouse-wheel-down-event
+(defvar mouse-wheel-obey-old-style-wheel-buttons
+  ;; FIXME: Yuck!
   (if (or (featurep 'w32-win) (featurep 'ns-win)
           (featurep 'haiku-win) (featurep 'pgtk-win)
           (featurep 'android-win))
       (if (featurep 'xinput2)
           nil
         (unless (featurep 'x)
-         'mouse-4))
-    'mouse-4)
+          t))
+    t)
+  "If non-nil, treat mouse-4/5/6/7 events as mouse wheel events.
+These are the event names used historically in X11 before XInput2.
+They are sometimes generated by things like `xterm-mouse-mode' as well.")
+
+(defcustom mouse-wheel-down-event
+  (if mouse-wheel-obey-old-style-wheel-buttons 'mouse-4)
   "Event used for scrolling down, beside `wheel-down', if any."
   :group 'mouse
   :type 'symbol
-  :set 'mouse-wheel-change-button)
+  :set #'mouse-wheel-change-button)
 
 (defcustom mouse-wheel-up-event
-  (if (or (featurep 'w32-win) (featurep 'ns-win)
-          (featurep 'haiku-win) (featurep 'pgtk-win)
-          (featurep 'android-win))
-      (if (featurep 'xinput2)
-          nil
-        (unless (featurep 'x)
-          'mouse-5))
-    'mouse-5)
+  (if mouse-wheel-obey-old-style-wheel-buttons 'mouse-5)
   "Event used for scrolling up, beside `wheel-up', if any."
   :group 'mouse
   :type 'symbol
-  :set 'mouse-wheel-change-button)
+  :set #'mouse-wheel-change-button)
 
 (defcustom mouse-wheel-click-event 'mouse-2
   "Event that should be temporarily inhibited after mouse scrolling.
@@ -92,7 +92,7 @@ scrolling with the mouse wheel.  To prevent that, this 
variable can be
 set to the event sent when clicking on the mouse wheel button."
   :group 'mouse
   :type 'symbol
-  :set 'mouse-wheel-change-button)
+  :set #'mouse-wheel-change-button)
 
 (defcustom mouse-wheel-inhibit-click-time 0.35
   "Time in seconds to inhibit clicking on mouse wheel button after scroll."
@@ -149,7 +149,7 @@ information, see `text-scale-adjust' and 
`global-text-scale-adjust'."
                     (const :tag "Scroll horizontally" :value hscroll)
                     (const :tag "Change buffer face size" :value text-scale)
                     (const :tag "Change global face size" :value 
global-text-scale)))))
-  :set 'mouse-wheel-change-button
+  :set #'mouse-wheel-change-button
   :version "28.1")
 
 (defcustom mouse-wheel-progressive-speed t
@@ -233,25 +233,11 @@ Also see `mouse-wheel-tilt-scroll'."
   "Function that does the job of scrolling right.")
 
 (defvar mouse-wheel-left-event
-  (if (or (featurep 'w32-win) (featurep 'ns-win)
-          (featurep 'haiku-win) (featurep 'pgtk-win)
-          (featurep 'android-win))
-      (if (featurep 'xinput2)
-          nil
-        (unless (featurep 'x)
-          'mouse-6))
-    'mouse-6)
+  (if mouse-wheel-obey-old-style-wheel-buttons 'mouse-6)
   "Event used for scrolling left, beside `wheel-left', if any.")
 
 (defvar mouse-wheel-right-event
-  (if (or (featurep 'w32-win) (featurep 'ns-win)
-          (featurep 'haiku-win) (featurep 'pgtk-win)
-          (featurep 'android-win))
-      (if (featurep 'xinput2)
-          nil
-        (unless (featurep 'x)
-          'mouse-7))
-    'mouse-7)
+  (if mouse-wheel-obey-old-style-wheel-buttons 'mouse-7)
   "Event used for scrolling right, beside `wheel-right', if any.")
 
 (defun mouse-wheel--get-scroll-window (event)
@@ -335,7 +321,8 @@ value of ARG, and the command uses it in subsequent 
scrolls."
                                 mwheel-scroll-right-function)
                               mouse-wheel-scroll-amount-horizontal))
                     ((mwheel--is-dir-p down button)
-                     (condition-case nil (funcall mwheel-scroll-down-function 
amt)
+                     (condition-case nil
+                         (funcall mwheel-scroll-down-function amt)
                        ;; Make sure we do indeed scroll to the beginning of
                        ;; the buffer.
                        (beginning-of-buffer
@@ -359,7 +346,8 @@ value of ARG, and the command uses it in subsequent 
scrolls."
                     ((mwheel--is-dir-p up button)
                      (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)))))
+                       (end-of-buffer
+                        (while t (funcall mwheel-scroll-up-function)))))
                     ((mwheel--is-dir-p left button) ; for tilt scroll
                      (when mouse-wheel-tilt-scroll
                        (funcall (if mouse-wheel-flip-direction