bug#68213: 30.0.50; completion-preview-tests failure in --without-x build

[Stefan Monnier]

> Thanks.  I see that bug#50321 suggests we keep `mouse-4/5` in the
> `mouse-wheel-*-event` for any build that can use `xterm-mouse-mode`.
> It should be easy to adjust my patch to support that.
> Tho bug#49803 suggests we could fix it in `xt-mouse.el` as well and make
> `xt-mouse.el` emit `wheel-up/down` events instead.

The patch below still seems to handle simultaneous mixes of wheel-up and
mouse-4/5 buttons via tty+GUI frames.  And based on my understanding of
the code, it should behave exactly like the current code in pretty much
all circumstances.

It also gets rid of `mwheel-event-button` which has been obsolete for
the last 20 years, apparently.  This is notable, because
`mwheel-event-button` is the only part of the code that distinguishes
between `mouse-wheel-*-event` and
`mouse-wheel-*-alternate-event`, AFAICT.

It still contains a FIXME, tho:

    (defcustom mouse-wheel-use-old-style-wheel-buttons
      ;; FIXME: Is this ever non-nil in practice?
      (not (and (or (featurep 'w32-win) (featurep 'ns-win)
                    (featurep 'haiku-win) (featurep 'pgtk-win)
                    (featurep 'android-win))
                (or (featurep 'xinput2)
                    (featurep 'x))))
      "If non-nil, treat mouse-4/5/6/7 as wheel buttons.
    These are the event names used historically in X11 before XInput2.
    They are sometimes used by things like `xterm-mouse-mode' as well."
      :group 'mouse
      :type 'boolean)

The above code is a slight shuffling of the current code which uses

    (if (or (featurep 'w32-win) (featurep 'ns-win)
            (featurep 'haiku-win) (featurep 'pgtk-win)
            (featurep 'android-win))
        'wheel-up
      'mouse-4)
    [...]
    (if (featurep 'xinput2)
        'wheel-up
      (unless (featurep 'x)
        'mouse-4))

repeated 4 times.

Is it worth worrying about the case where this monstrosity is non-nil?


        Stefan

diff --git a/lisp/mwheel.el b/lisp/mwheel.el
index b75b6f27d53..ca6d3cccb97 100644
--- a/lisp/mwheel.el
+++ b/lisp/mwheel.el
@@ -56,49 +56,32 @@ mouse-wheel-change-button
              (bound-and-true-p mouse-wheel-mode))
     (mouse-wheel-mode 1)))
 
-(defcustom mouse-wheel-down-event
-  (if (or (featurep 'w32-win) (featurep 'ns-win)
-          (featurep 'haiku-win) (featurep 'pgtk-win)
-          (featurep 'android-win))
-      'wheel-up
-    'mouse-4)
-  "Event used for scrolling down."
+(defcustom mouse-wheel-use-old-style-wheel-buttons
+  ;; FIXME: Is this ever non-nil in practice?
+  (not (and (or (featurep 'w32-win) (featurep 'ns-win)
+                (featurep 'haiku-win) (featurep 'pgtk-win)
+                (featurep 'android-win))
+            (or (featurep 'xinput2)
+                (featurep 'x))))
+  "If non-nil, treat mouse-4/5/6/7 as wheel buttons.
+These are the event names used historically in X11 before XInput2.
+They are sometimes used by things like `xterm-mouse-mode' as well."
   :group 'mouse
-  :type 'symbol
-  :set 'mouse-wheel-change-button)
-
-(defcustom mouse-wheel-down-alternate-event
-  (if (featurep 'xinput2)
-      'wheel-up
-    (unless (featurep 'x)
-      'mouse-4))
-  "Alternative wheel down event to consider."
+  :type 'boolean)
+
+(defcustom mouse-wheel-down-event
+  (if mouse-wheel-use-old-style-wheel-buttons 'mouse-4)
+  "Event used for scrolling down, beside `wheel-down', if any."
   :group 'mouse
   :type 'symbol
-  :version "29.1"
-  :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))
-      'wheel-down
-    'mouse-5)
-  "Event used for scrolling up."
+  (if mouse-wheel-use-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)
-
-(defcustom mouse-wheel-up-alternate-event
-  (if (featurep 'xinput2)
-      'wheel-down
-    (unless (featurep 'x)
-      'mouse-5))
-  "Alternative wheel up event to consider."
-  :group 'mouse
-  :type 'symbol
-  :version "29.1"
-  :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.
@@ -108,7 +91,7 @@ mouse-wheel-click-event
 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."
@@ -165,7 +148,7 @@ mouse-wheel-scroll-amount
                     (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
@@ -216,15 +199,10 @@ mouse-wheel-flip-direction
   :type 'boolean
   :version "26.1")
 
-(defun mwheel-event-button (event)
-  (let ((x (event-basic-type event)))
-    ;; Map mouse-wheel events to appropriate buttons
-    (if (eq 'mouse-wheel x)
-        (let ((amount (car (cdr (cdr (cdr event))))))
-          (if (< amount 0)
-              mouse-wheel-up-event
-            mouse-wheel-down-event))
-      x)))
+
+;; This function used to handle the `mouse-wheel` event which was
+;; removed in 2003 by commit 9eb28007fb27, thus making it obsolete.
+(define-obsolete-function-alias 'mwheel-event-button #'event-basic-type "30.1")
 
 (defun mwheel-event-window (event)
   (posn-window (event-start event)))
@@ -255,34 +233,12 @@ mwheel-scroll-right-function
   "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))
-      'wheel-left
-    'mouse-6)
-  "Event used for scrolling left.")
-
-(defvar mouse-wheel-left-alternate-event
-  (if (featurep 'xinput2)
-      'wheel-left
-    (unless (featurep 'x)
-      'mouse-6))
-  "Alternative wheel left event to consider.")
+  (if mouse-wheel-use-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))
-      'wheel-right
-    'mouse-7)
-  "Event used for scrolling right.")
-
-(defvar mouse-wheel-right-alternate-event
-  (if (featurep 'xinput2)
-      'wheel-right
-    (unless (featurep 'x)
-      'mouse-7))
-  "Alternative wheel right event to consider.")
+  (if mouse-wheel-use-old-style-wheel-buttons 'mouse-7)
+  "Event used for scrolling right, beside `wheel-right', if any.")
 
 (defun mouse-wheel--get-scroll-window (event)
   "Return window for mouse wheel event EVENT.
@@ -311,6 +267,15 @@ mouse-wheel--get-scroll-window
                frame nil t)))))
       (mwheel-event-window event)))
 
+(defmacro mwheel--is-dir-p (dir button)
+  (declare (debug (sexp form)))
+  (let ((custom-var (intern (format "mouse-wheel-%s-event" dir)))
+        (event (intern (format "wheel-%s" dir))))
+    (macroexp-let2 nil butsym button
+      `(or (eq ,butsym ',event)
+           ;; We presume here `button' is never nil.
+           (eq ,butsym ,custom-var)))))
+
 (defun mwheel-scroll (event &optional arg)
   "Scroll up or down according to the EVENT.
 This should be bound only to mouse buttons 4, 5, 6, and 7 on
@@ -347,18 +312,18 @@ mwheel-scroll
     (when (numberp amt) (setq amt (* amt (event-line-count event))))
     (condition-case nil
         (unwind-protect
-           (let ((button (mwheel-event-button event)))
-              (cond ((and (eq amt 'hscroll) (memq button (list 
mouse-wheel-down-event
-                                                               
mouse-wheel-down-alternate-event)))
+           (let ((button (event-basic-type event)))
+              (cond ((and (eq amt 'hscroll)
+                          (mwheel--is-dir-p down button))
                      (when (and (natnump arg) (> arg 0))
                        (setq mouse-wheel-scroll-amount-horizontal arg))
                      (funcall (if mouse-wheel-flip-direction
                                   mwheel-scroll-left-function
                                 mwheel-scroll-right-function)
                               mouse-wheel-scroll-amount-horizontal))
-                    ((memq button (list mouse-wheel-down-event
-                                        mouse-wheel-down-alternate-event))
-                     (condition-case nil (funcall mwheel-scroll-down-function 
amt)
+                    ((mwheel--is-dir-p down button)
+                     (condition-case nil
+                         (funcall mwheel-scroll-down-function amt)
                        ;; Make sure we do indeed scroll to the beginning of
                        ;; the buffer.
                        (beginning-of-buffer
@@ -372,31 +337,32 @@ mwheel-scroll
                           ;; for a reason that escapes me.  This problem seems
                           ;; to only affect scroll-down.  --Stef
                           (set-window-start (selected-window) (point-min))))))
-                    ((and (eq amt 'hscroll) (memq button (list 
mouse-wheel-up-event
-                                                               
mouse-wheel-up-alternate-event)))
+                    ((and (eq amt 'hscroll)
+                          (mwheel--is-dir-p up button))
                      (when (and (natnump arg) (> arg 0))
                        (setq mouse-wheel-scroll-amount-horizontal arg))
                      (funcall (if mouse-wheel-flip-direction
                                   mwheel-scroll-right-function
                                 mwheel-scroll-left-function)
                               mouse-wheel-scroll-amount-horizontal))
-                    ((memq button (list mouse-wheel-up-event
-                                        mouse-wheel-up-alternate-event))
-                     (condition-case nil (funcall mwheel-scroll-up-function 
amt)
+                    ((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)))))
-                    ((memq button (list mouse-wheel-left-event
-                                        mouse-wheel-left-alternate-event)) ; 
for tilt scroll
+                       (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
                                     mwheel-scroll-right-function
-                                  mwheel-scroll-left-function) amt)))
-                    ((memq button (list mouse-wheel-right-event
-                                        mouse-wheel-right-alternate-event)) ; 
for tilt scroll
+                                  mwheel-scroll-left-function)
+                                amt)))
+                    ((mwheel--is-dir-p right button) ; for tilt scroll
                      (when mouse-wheel-tilt-scroll
                        (funcall (if mouse-wheel-flip-direction
                                     mwheel-scroll-left-function
-                                  mwheel-scroll-right-function) amt)))
+                                  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
@@ -434,14 +400,12 @@ mouse-wheel-text-scale
   (interactive (list last-input-event))
   (let ((selected-window (selected-window))
         (scroll-window (mouse-wheel--get-scroll-window event))
-        (button (mwheel-event-button event)))
+        (button (event-basic-type event)))
     (select-window scroll-window 'mark-for-redisplay)
     (unwind-protect
-        (cond ((memq button (list mouse-wheel-down-event
-                                  mouse-wheel-down-alternate-event))
+        (cond ((mwheel--is-dir-p down button)
                (text-scale-increase 1))
-              ((memq button (list mouse-wheel-up-event
-                                  mouse-wheel-up-alternate-event))
+              ((mwheel--is-dir-p up button)
                (text-scale-decrease 1)))
       (select-window selected-window))))
 
@@ -450,12 +414,10 @@ mouse-wheel-global-text-scale
   "Increase or decrease the global font size according to the EVENT.
 This invokes `global-text-scale-adjust', which see."
   (interactive (list last-input-event))
-  (let ((button (mwheel-event-button event)))
-    (cond ((memq button (list mouse-wheel-down-event
-                              mouse-wheel-down-alternate-event))
+  (let ((button (event-basic-type event)))
+    (cond ((mwheel--is-dir-p down button)
            (global-text-scale-adjust 1))
-          ((memq button (list mouse-wheel-up-event
-                              mouse-wheel-up-alternate-event))
+          ((mwheel--is-dir-p up button)
            (global-text-scale-adjust -1)))))
 
 (defun mouse-wheel--add-binding (key fun)
@@ -507,15 +469,13 @@ mouse-wheel--setup-bindings
      ;; Bindings for changing font size.
      ((and (consp binding) (eq (cdr binding) 'text-scale))
       (dolist (event (list mouse-wheel-down-event mouse-wheel-up-event
-                           mouse-wheel-down-alternate-event
-                           mouse-wheel-up-alternate-event))
+                           'wheel-down 'wheel-up))
         (when event
           (mouse-wheel--add-binding `[,(append (car binding) (list event))]
                                     'mouse-wheel-text-scale))))
      ((and (consp binding) (eq (cdr binding) 'global-text-scale))
       (dolist (event (list mouse-wheel-down-event mouse-wheel-up-event
-                           mouse-wheel-down-alternate-event
-                           mouse-wheel-up-alternate-event))
+                           'wheel-down 'wheel-up))
         (when event
           (mouse-wheel--add-binding `[,(append (car binding) (list event))]
                                     'mouse-wheel-global-text-scale))))
@@ -523,10 +483,7 @@ mouse-wheel--setup-bindings
      (t
       (dolist (event (list mouse-wheel-down-event mouse-wheel-up-event
                            mouse-wheel-left-event mouse-wheel-right-event
-                           mouse-wheel-down-alternate-event
-                           mouse-wheel-up-alternate-event
-                           mouse-wheel-left-alternate-event
-                           mouse-wheel-right-alternate-event))
+                           'wheel-down 'wheel-up 'wheel-left 'wheel-right))
         (when event
           (dolist (key (mouse-wheel--create-scroll-keys binding event))
             (mouse-wheel--add-binding key 'mwheel-scroll))))))))