bug#68796: Stefan's wheel event change

bug#68796: Stefan's wheel event change

[Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors]

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

> I'm now satisfied that Stefan's change to return wheel events on all
> platforms does not produce the adverse effects I feared, but I have also
> misplaced the number of the bug report where it was discussed, so,
> Stefan, please post your version of the patch again before it is
> installed.  Thanks in advance.

Here it is, with a brand new etc/NEWS,


        Stefan

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-mouse-wheel-buttons-Map-old-style-wheel-buttons-to-a.patch --]
[-- Type: text/x-diff, Size: 13980 bytes --]

From 56559400277d5535713349431ca0cda967e8e281 Mon Sep 17 00:00:00 2001
From: Stefan Monnier <monnier@iro.umontreal.ca>
Date: Mon, 29 Jan 2024 09:35:09 -0500
Subject: [PATCH] (mouse-wheel-buttons): Map old-style wheel buttons to actual
 wheel events

Change the handling of the old X11 convention to use mouse-4/5/6/7
events to represent wheel events: instead of asking downstream
packages to use the `mouse-wheel-*-event` variables to know which events
represent wheel events, use new var `mouse-wheel-buttons` to directly
convert those events into the standard `wheel-up/down/left/right` events
used everywhere else.

This will simplify the work of packages which can thus just bind their
commands to `wheel-up/down/left/right`.

* lisp/mouse.el (mouse-wheel-buttons): New custom variable.

* src/keyboard.c (make_lispy_event): Adjust for "wheel-clicks" on the tab-bar.
* src/xterm.c (x_construct_mouse_click): Add `xi2` argument and
obey `mouse-wheel-buttons` variable.
(handle_one_xevent): Adjust calls accordingly.
(syms_of_xterm): Define the `mouse-wheel-buttons` and the
`wheel-up/down/left/right`symbols.

* lisp/xt-mouse.el: Don't require `mwheel` any more.
(xterm-mouse--same-button-p): Delete function.
(xterm-mouse--read-event-sequence): Use `mouse-wheel-buttons`.

* lisp/mwheel.el (mouse-wheel-up-event, mouse-wheel-down-event)
(mouse-wheel-left-event, mouse-wheel-right-event): Make obsolete.
(mouse-wheel-obey-old-style-wheel-buttons): Delete variable.
---
 etc/NEWS         | 16 ++++++++++-----
 lisp/mouse.el    | 13 ++++++++++++
 lisp/mwheel.el   | 21 ++++++++-----------
 lisp/xt-mouse.el | 20 ++++--------------
 src/keyboard.c   | 13 ++++++++++--
 src/xterm.c      | 53 +++++++++++++++++++++++++++++++++++++++---------
 6 files changed, 90 insertions(+), 46 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index 2654d9d7995..d1054d4337b 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -68,6 +68,12 @@ more details.
 \f
 * Incompatible Changes in Emacs 30.1
 
+** Mouse wheel events should now always be 'wheel-up/down/left/right'.
+At those places where the old 'mouse-4/5/6/7' events could still occur
+(i.e. X11 input in the absence of XInput2, and `xterm-mouse-mode`),
+we remap them to the corresponding 'wheel-up/down/left/right' event,
+according to the new variable 'mouse-wheel-buttons'.
+
 ** Tree-Sitter modes are now declared as submodes of the non-TS modes.
 In order to help the use of those Tree-Sitter modes, they are now
 declared to have the corresponding non-Tree-Sitter mode as an
@@ -520,15 +526,15 @@ In batch mode, tracing now sends the trace to stdout.
 ** Mwheel
 The 'wheel-up/down/left/right' events are now bound unconditionally,
 and the 'mouse-wheel-up/down/left/right-event' variables are thus used
-only to specify the 'mouse-4/5/6/7' events generated by older
-configurations such as X11 when the X server does not support at least
-version 2.1 of the X Input Extension, and 'xterm-mouse-mode'.
+only to specify the 'mouse-4/5/6/7' events that might still
+happen to be generated by some old packages (or if 'mouse-wheel-buttons'
+has been set to nil).
 
 ** 'xterm-mouse-mode'
 This mode now emits 'wheel-up/down/right/left' events instead of
 'mouse-4/5/6/7' events for the mouse wheel.
-It uses the 'mouse-wheel-up/down/left/right-event'
-variables to decide which button maps to which wheel event (if any).
+It uses the new variable 'mouse-wheel-buttons' to decide which button
+maps to which wheel event (if any).
 
 ** Info
 
diff --git a/lisp/mouse.el b/lisp/mouse.el
index cef88dede8a..ae5a6455566 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -133,6 +133,19 @@ mouse-drag-mode-line-buffer
   :type 'boolean
   :version "29.1")
 
+(defcustom mouse-wheel-buttons
+  '((4 . wheel-up) (5 . wheel-down) (6 . wheel-left) (7 . wheel-right))
+  "Buttons to remap to wheel events.
+This is an alist of (NUMBER . SYMBOL) used to remap old-style mouse wheel
+events represented as mouse button events.  It remaps mouse button event
+NUMBER to the event SYMBOL.  SYMBOL must be one of `wheel-up', `wheel-down',
+`wheel-left', or `wheel-right'.
+This is used only for events that come from sources known to generate such
+events, such as X11 events when XInput2 is not used, or events coming from
+a text terminal."
+  :type '(alist)
+  :version "30.1")
+
 (defvar mouse--last-down nil)
 
 (defun mouse--down-1-maybe-follows-link (&optional _prompt)
diff --git a/lisp/mwheel.el b/lisp/mwheel.el
index 66a1fa1a706..9fc922eebc9 100644
--- a/lisp/mwheel.el
+++ b/lisp/mwheel.el
@@ -56,20 +56,17 @@ mouse-wheel-change-button
              (bound-and-true-p mouse-wheel-mode))
     (mouse-wheel-mode 1)))
 
-(defvar mouse-wheel-obey-old-style-wheel-buttons 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 text-terminals as well.")
+(make-obsolete-variable 'mouse-wheel-up-event    'mouse-wheel-buttons "30.1")
+(make-obsolete-variable 'mouse-wheel-down-event  'mouse-wheel-buttons "30.1")
+(make-obsolete-variable 'mouse-wheel-left-event  'mouse-wheel-buttons "30.1")
+(make-obsolete-variable 'mouse-wheel-right-event 'mouse-wheel-buttons "30.1")
 
-(defcustom mouse-wheel-down-event
-  (if mouse-wheel-obey-old-style-wheel-buttons 'mouse-4)
+(defcustom mouse-wheel-down-event 'mouse-4
   "Event used for scrolling down, beside `wheel-up', if any."
   :group 'mouse
   :type 'symbol
   :set #'mouse-wheel-change-button)
-
-(defcustom mouse-wheel-up-event
-  (if mouse-wheel-obey-old-style-wheel-buttons 'mouse-5)
+(defcustom mouse-wheel-up-event 'mouse-5
   "Event used for scrolling up, beside `wheel-down', if any."
   :group 'mouse
   :type 'symbol
@@ -223,12 +220,10 @@ mwheel-scroll-left-function
 (defvar mwheel-scroll-right-function 'scroll-right
   "Function that does the job of scrolling right.")
 
-(defvar mouse-wheel-left-event
-  (if mouse-wheel-obey-old-style-wheel-buttons 'mouse-6)
+(defvar mouse-wheel-left-event 'mouse-6
   "Event used for scrolling left, beside `wheel-left', if any.")
 
-(defvar mouse-wheel-right-event
-  (if mouse-wheel-obey-old-style-wheel-buttons 'mouse-7)
+(defvar mouse-wheel-right-event 'mouse-7
   "Event used for scrolling right, beside `wheel-right', if any.")
 
 (defun mouse-wheel--get-scroll-window (event)
diff --git a/lisp/xt-mouse.el b/lisp/xt-mouse.el
index 081b8f32456..c27dee7e249 100644
--- a/lisp/xt-mouse.el
+++ b/lisp/xt-mouse.el
@@ -40,8 +40,6 @@
 
 ;;; Code:
 
-(require 'mwheel)
-
 (defvar xterm-mouse-debug-buffer nil)
 
 (defun xterm-mouse-translate (_event)
@@ -195,12 +193,6 @@ xterm-mouse--read-number-from-terminal
           (cons n c))
       (cons (- (setq c (xterm-mouse--read-coordinate)) 32) c))))
 
-(defun xterm-mouse--button-p (event btn)
-  (and (symbolp event)
-       (string-prefix-p "mouse-" (symbol-name event))
-       (eq btn (car (read-from-string (symbol-name event)
-                                      (length "mouse-"))))))
-
 ;; XTerm reports mouse events as
 ;; <EVENT-CODE> <X> <Y> in default mode, and
 ;; <EVENT-CODE> ";" <X> ";" <Y> <"M" or "m"> in extended mode.
@@ -246,14 +238,10 @@ xterm-mouse--read-event-sequence
             (if meta "M-" "")
             (if shift "S-" "")
             (if down "down-" "")
-            (cond
-             ;; BEWARE: `mouse-wheel-UP-event' corresponds to
-             ;; `wheel-DOWN' events and vice versa!!
-             ((xterm-mouse--button-p mouse-wheel-down-event btn)  "wheel-up")
-             ((xterm-mouse--button-p mouse-wheel-up-event btn)    "wheel-down")
-             ((xterm-mouse--button-p mouse-wheel-left-event btn)  "wheel-left")
-             ((xterm-mouse--button-p mouse-wheel-right-event btn) "wheel-right")
-             (t (format "mouse-%d" btn))))))))
+            (let ((remap (alist-get btn mouse-wheel-buttons)))
+              (if remap
+                  (symbol-name remap)
+                (format "mouse-%d" btn))))))))
     (list sym (1- x) (1- y))))
 
 (defun xterm-mouse--set-click-count (event click-count)
diff --git a/src/keyboard.c b/src/keyboard.c
index 91faf4582fa..a06c9116d24 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -6639,8 +6639,17 @@ make_lispy_event (struct input_event *event)
 
 	if (CONSP (event->arg))
 	  return list5 (head, position, make_fixnum (double_click_count),
-			XCAR (event->arg), Fcons (XCAR (XCDR (event->arg)),
-						  XCAR (XCDR (XCDR (event->arg)))));
+			XCAR (event->arg),
+			/* FIXME: When a mouse-click on a tab-bar is
+                           converted into a wheel-event we get here something
+                           of an unexpected shape...  */
+			(CONSP (XCDR (event->arg))
+			 && CONSP (XCDR (XCDR (event->arg))))
+			? Fcons (XCAR (XCDR (event->arg)),
+			         XCAR (XCDR (XCDR (event->arg))))
+			/* ... not knowing what this "unexpected shape" means,
+			   we just use nil.  */
+			: Qnil);
         else if (NUMBERP (event->arg))
           return list4 (head, position, make_fixnum (double_click_count),
                         event->arg);
diff --git a/src/xterm.c b/src/xterm.c
index c0aef65ab66..5e5eb6269e4 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -14551,18 +14551,19 @@ x_query_pointer (Display *dpy, Window w, Window *root_return,
    `x', `y', `x_root' and `y_root'.  This function should not access
    any other fields in EVENT without also initializing the
    corresponding fields in `bv' under the XI_ButtonPress and
-   XI_ButtonRelease labels inside `handle_one_xevent'.  */
+   XI_ButtonRelease labels inside `handle_one_xevent'.
+
+   XI2 indicates that this click comes from XInput2 rather than core
+   event.   */
 
 static Lisp_Object
 x_construct_mouse_click (struct input_event *result,
                          const XButtonEvent *event,
-                         struct frame *f)
+                         struct frame *f, bool xi2)
 {
   int x = event->x;
   int y = event->y;
 
-  /* Make the event type NO_EVENT; we'll change that when we decide
-     otherwise.  */
   result->kind = MOUSE_CLICK_EVENT;
   result->code = event->button - Button1;
   result->timestamp = event->time;
@@ -14572,6 +14573,29 @@ x_construct_mouse_click (struct input_event *result,
 			  ? up_modifier
 			  : down_modifier));
 
+  /* Convert pre-XInput2 wheel events represented as mouse-clicks.  */
+  if (!xi2)
+    {
+      Lisp_Object base
+        = Fcdr_safe (Fassq (make_fixnum (result->code + 1),
+                            Fsymbol_value (Qmouse_wheel_buttons)));
+      int wheel
+        = (NILP (base) ? -1
+           : BASE_EQ (base, Qwheel_down)  ? 0
+           : BASE_EQ (base, Qwheel_up)    ? 1
+           : BASE_EQ (base, Qwheel_left)  ? 2
+           : BASE_EQ (base, Qwheel_right) ? 3
+           : -1);
+      if (wheel >= 0)
+        {
+          result->kind = (event->type != ButtonRelease ? NO_EVENT
+		          : wheel & 2 ? HORIZ_WHEEL_EVENT : WHEEL_EVENT);
+          result->code = 0;         /* Not used.  */
+          result->modifiers &= ~(up_modifier || down_modifier);
+          result->modifiers |= wheel & 1 ? up_modifier : down_modifier;
+        }
+    }
+
   /* If result->window is not the frame's edit widget (which can
      happen with GTK+ scroll bars, for example), translate the
      coordinates so they appear at the correct position.  */
@@ -21881,13 +21905,14 @@ handle_one_xevent (struct x_display_info *dpyinfo,
 			&& event->xbutton.time > ignore_next_mouse_click_timeout)
 		      {
 			ignore_next_mouse_click_timeout = 0;
-			x_construct_mouse_click (&inev.ie, &event->xbutton, f);
+			x_construct_mouse_click (&inev.ie, &event->xbutton,
+			                         f, false);
 		      }
 		    if (event->type == ButtonRelease)
 		      ignore_next_mouse_click_timeout = 0;
 		  }
 		else
-		  x_construct_mouse_click (&inev.ie, &event->xbutton, f);
+		  x_construct_mouse_click (&inev.ie, &event->xbutton, f, false);
 
 		*finish = X_EVENT_DROP;
 		goto OTHER;
@@ -21957,13 +21982,15 @@ handle_one_xevent (struct x_display_info *dpyinfo,
                           && event->xbutton.time > ignore_next_mouse_click_timeout)
                         {
                           ignore_next_mouse_click_timeout = 0;
-                          x_construct_mouse_click (&inev.ie, &event->xbutton, f);
+                          x_construct_mouse_click (&inev.ie, &event->xbutton,
+                                                   f, false);
                         }
                       if (event->type == ButtonRelease)
                         ignore_next_mouse_click_timeout = 0;
                     }
                   else
-                    x_construct_mouse_click (&inev.ie, &event->xbutton, f);
+                    x_construct_mouse_click (&inev.ie, &event->xbutton,
+                                             f, false);
 
 		  if (!NILP (tab_bar_arg))
 		    inev.ie.arg = tab_bar_arg;
@@ -23740,13 +23767,13 @@ handle_one_xevent (struct x_display_info *dpyinfo,
 				&& xev->time > ignore_next_mouse_click_timeout)
 			      {
 				ignore_next_mouse_click_timeout = 0;
-				x_construct_mouse_click (&inev.ie, &bv, f);
+				x_construct_mouse_click (&inev.ie, &bv, f, true);
 			      }
 			    if (xev->evtype == XI_ButtonRelease)
 			      ignore_next_mouse_click_timeout = 0;
 			  }
 			else
-			  x_construct_mouse_click (&inev.ie, &bv, f);
+			  x_construct_mouse_click (&inev.ie, &bv, f, true);
 
 			if (!NILP (tab_bar_arg))
 			  inev.ie.arg = tab_bar_arg;
@@ -32452,6 +32479,12 @@ syms_of_xterm (void)
   DEFSYM (Qexpose, "expose");
   DEFSYM (Qdont_save, "dont-save");
 
+  DEFSYM (Qmouse_wheel_buttons, "mouse-wheel-buttons");
+  DEFSYM (Qwheel_up,    "wheel-up");
+  DEFSYM (Qwheel_down,  "wheel-down");
+  DEFSYM (Qwheel_left,  "wheel-left");
+  DEFSYM (Qwheel_right, "wheel-right");
+
 #ifdef USE_GTK
   xg_default_icon_file = build_pure_c_string ("icons/hicolor/scalable/apps/emacs.svg");
   staticpro (&xg_default_icon_file);
-- 
2.43.0

bug#68796: Stefan's wheel event change

[Eli Zaretskii]

> Cc: 68796@debbugs.gnu.org
> Date: Wed, 03 Apr 2024 15:27:54 -0400
> From:  Stefan Monnier via "Bug reports for GNU Emacs,
>  the Swiss army knife of text editors" <bug-gnu-emacs@gnu.org>
> 
> > I'm now satisfied that Stefan's change to return wheel events on all
> > platforms does not produce the adverse effects I feared, but I have also
> > misplaced the number of the bug report where it was discussed, so,
> > Stefan, please post your version of the patch again before it is
> > installed.  Thanks in advance.
> 
> Here it is, with a brand new etc/NEWS,

Thanks, a few minor comments below.

> Change the handling of the old X11 convention to use mouse-4/5/6/7
> events to represent wheel events: instead of asking downstream
> packages to use the `mouse-wheel-*-event` variables to know which events
> represent wheel events, use new var `mouse-wheel-buttons` to directly
> convert those events into the standard `wheel-up/down/left/right` events
> used everywhere else.
> 
> This will simplify the work of packages which can thus just bind their
> commands to `wheel-up/down/left/right`.
> 
> * lisp/mouse.el (mouse-wheel-buttons): New custom variable.
> 
> * src/keyboard.c (make_lispy_event): Adjust for "wheel-clicks" on the tab-bar.
> * src/xterm.c (x_construct_mouse_click): Add `xi2` argument and
> obey `mouse-wheel-buttons` variable.
> (handle_one_xevent): Adjust calls accordingly.
> (syms_of_xterm): Define the `mouse-wheel-buttons` and the
> `wheel-up/down/left/right`symbols.
> 
> * lisp/xt-mouse.el: Don't require `mwheel` any more.
> (xterm-mouse--same-button-p): Delete function.
> (xterm-mouse--read-event-sequence): Use `mouse-wheel-buttons`.

Nit-picking: can we please NOT use Markdown-style quoting `like this`
in our docs and change logs?

> +** Mouse wheel events should now always be 'wheel-up/down/left/right'.
> +At those places where the old 'mouse-4/5/6/7' events could still occur
> +(i.e. X11 input in the absence of XInput2, and `xterm-mouse-mode`),
> +we remap them to the corresponding 'wheel-up/down/left/right' event,
> +according to the new variable 'mouse-wheel-buttons'.

Likewise here.

> +(defcustom mouse-wheel-buttons
> +  '((4 . wheel-up) (5 . wheel-down) (6 . wheel-left) (7 . wheel-right))
> +  "Buttons to remap to wheel events.

Suggest to rephrase:

  "How to remap mouse button numbers to wheel events."

> +This is an alist of (NUMBER . SYMBOL) used to remap old-style mouse wheel
> +events represented as mouse button events.  It remaps mouse button event
> +NUMBER to the event SYMBOL.  SYMBOL must be one of `wheel-up', `wheel-down',

Not "mouse event NUMBER", but "mouse button NUMBER", I think.
Alternatively, you could say "mouse button event 'mouse-NUMBER'".
IOW, NUMBER is not a mouse event, it's a number.

> +  /* Convert pre-XInput2 wheel events represented as mouse-clicks.  */
> +  if (!xi2)
> +    {
> +      Lisp_Object base
> +        = Fcdr_safe (Fassq (make_fixnum (result->code + 1),
> +                            Fsymbol_value (Qmouse_wheel_buttons)));

Should this test mouse-wheel-buttons for being bound and have a list
value, before calling assq?  mouse.el is preloaded relatively late in
loadup, so I think we had better played it safe, no?

bug#68796: Stefan's wheel event change

[Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors]

>> +** Mouse wheel events should now always be 'wheel-up/down/left/right'.
>> +At those places where the old 'mouse-4/5/6/7' events could still occur
>> +(i.e. X11 input in the absence of XInput2, and `xterm-mouse-mode`),
>> +we remap them to the corresponding 'wheel-up/down/left/right' event,
>> +according to the new variable 'mouse-wheel-buttons'.
>
> Likewise here.

Fixed.

>> +(defcustom mouse-wheel-buttons
>> +  '((4 . wheel-up) (5 . wheel-down) (6 . wheel-left) (7 . wheel-right))
>> +  "Buttons to remap to wheel events.
>
> Suggest to rephrase:
>
>   "How to remap mouse button numbers to wheel events."

Thanks.

>> +This is an alist of (NUMBER . SYMBOL) used to remap old-style mouse wheel
>> +events represented as mouse button events.  It remaps mouse button event
>> +NUMBER to the event SYMBOL.  SYMBOL must be one of `wheel-up', `wheel-down',
>
> Not "mouse event NUMBER", but "mouse button NUMBER", I think.
> Alternatively, you could say "mouse button event 'mouse-NUMBER'".
> IOW, NUMBER is not a mouse event, it's a number.

Indeed.

>> +  /* Convert pre-XInput2 wheel events represented as mouse-clicks.  */
>> +  if (!xi2)
>> +    {
>> +      Lisp_Object base
>> +        = Fcdr_safe (Fassq (make_fixnum (result->code + 1),
>> +                            Fsymbol_value (Qmouse_wheel_buttons)));
>
> Should this test mouse-wheel-buttons for being bound and have a list
> value, before calling assq?  mouse.el is preloaded relatively late in
> loadup, so I think we had better played it safe, no?

AFAIK we can't get such events until *much* later, after the dump, so
I don't see any need for that.  Especially since it only affects mouse
clicks, so it wouldn't render Emacs unusable.

`Fassq` can also signal an error if `mouse-wheel-buttons` contains
something else than an alist, but in my tests, this simply results in
error messages when you use the mouse buttons/wheel, which is about as
good as it gets, IMO.


        Stefan

bug#68796: Stefan's wheel event change

[Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors]

Pushed to `master, closing,


        Stefan

bug#68796: Stefan's wheel event change

[Po Lu via Bug reports for GNU Emacs, the Swiss army knife of text editors]

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

> Pushed to `master, closing,

Thanks.