bug#68796: xterm.c: Convert mouse-4/5/6/7 to wheel-up/down/left/right

[Stefan Monnier]

Ping?

I believe this patch should be much less controversial since it allows
users to get the old behavior back and still keeps the same semantics
for existing `mouse-wheel-*-event` variables in case some other code
still generates such events.  It's basically a half-way step between
what I proposed at first and the status quot.

But I'd like some confirmation that you think it's acceptable, and maybe
if you could comment on the FIXME included in there (I needed it for
clicks on the tab-bar, but I don't understand that code).


        Stefan


Stefan Monnier [2024-02-10 10:33:01] wrote:

>> Or maybe we should keep `mouse-wheel-*-event` untouched (tho, maybe mark
>> them obsolete) and instead introduce a new set of variables that control
>> the remapping of `mouse-4/5/6/7` to `wheel-*` events.
>
> See patch below.
> It would need etc/NEWS and doc changes, of course, and probably some
> warning-silencing in those packages using `mouse-wheel-*-event`s.
>
>
>         Stefan
>
> From 0e94e1140a8ec72bd068648eb5ec1dc861f0884b 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.
> ---
>  lisp/mouse.el    | 13 ++++++++++++
>  lisp/mwheel.el   | 21 ++++++++-----------
>  lisp/xt-mouse.el | 20 ++++--------------
>  src/keyboard.c   |  9 ++++++--
>  src/xterm.c      | 53 +++++++++++++++++++++++++++++++++++++++---------
>  5 files changed, 75 insertions(+), 41 deletions(-)
>
> diff --git a/lisp/mouse.el b/lisp/mouse.el
> index d1b06c2040d..585891bf699 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 1f7253a7da1..4c3e33762af 100644
> --- a/src/keyboard.c
> +++ b/src/keyboard.c
> @@ -6628,8 +6628,13 @@ 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: I don't know what I'm doing here.  */
> +                     (CONSP (XCDR (event->arg))
> +                      && CONSP (XCDR (XCDR (event->arg))))
> +                     ? Fcons (XCAR (XCDR (event->arg)),
> +                              XCAR (XCDR (XCDR (event->arg))))
> +                     : 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 c8a43785564..e75b64ed3d4 100644
> --- a/src/xterm.c
> +++ b/src/xterm.c
> @@ -14543,18 +14543,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;
> @@ -14564,6 +14565,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.  */
> @@ -21873,13 +21897,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;
> @@ -21949,13 +21974,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;
> @@ -23732,13 +23759,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;
> @@ -32444,6 +32471,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);