From e720ba6219394d275dd741c5f17feea1ee0bf9af Mon Sep 17 00:00:00 2001 From: Stefan Monnier 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 that uses 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/completion-preview.el (completion-preview--mouse-map): * lisp/progmodes/flymake.el (flymake--mode-line-counter-map): * lisp/edmacro.el (edmacro-fix-menu-commands): Silence warnings. --- etc/NEWS | 19 ++++++++++---- lisp/completion-preview.el | 8 ++++-- lisp/edmacro.el | 10 ++++--- lisp/mouse.el | 13 ++++++++++ lisp/mwheel.el | 21 ++++++--------- lisp/progmodes/flymake.el | 18 +++++++------ lisp/xt-mouse.el | 20 +++----------- src/keyboard.c | 13 ++++++++-- src/xterm.c | 53 +++++++++++++++++++++++++++++++------- 9 files changed, 116 insertions(+), 59 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 2654d9d7995..5decf6d1800 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -68,6 +68,15 @@ more details. * 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'. +The old variables 'mouse-wheel-up-event', 'mouse-wheel-down-event', +'mouse-wheel-left-event', and 'mouse-wheel-right-event' are thereby +obsolete. + ** 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 +529,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/completion-preview.el b/lisp/completion-preview.el index a86c1ba1cc9..a1e0abe2e14 100644 --- a/lisp/completion-preview.el +++ b/lisp/completion-preview.el @@ -139,9 +139,13 @@ If this option is nil, these commands do not display any message." ;; and vice versa!! "" #'completion-preview-prev-candidate "" #'completion-preview-next-candidate - (key-description (vector mouse-wheel-up-event)) + (key-description (with-suppressed-warnings + ((obsolete mouse-wheel-up-event)) + (vector mouse-wheel-up-event))) #'completion-preview-next-candidate - (key-description (vector mouse-wheel-down-event)) + (key-description (with-suppressed-warnings + ((obsolete mouse-wheel-down-event)) + (vector mouse-wheel-down-event))) #'completion-preview-prev-candidate) (defvar-local completion-preview--overlay nil) diff --git a/lisp/edmacro.el b/lisp/edmacro.el index abfc380d154..2694e097b86 100644 --- a/lisp/edmacro.el +++ b/lisp/edmacro.el @@ -744,9 +744,13 @@ This function assumes that the events can be stored in a string." ;; info is recorded in macros to make this possible. ((or (mouse-event-p ev) (mouse-movement-p ev) (memq (event-basic-type ev) - `( ,mouse-wheel-down-event ,mouse-wheel-up-event - ,mouse-wheel-right-event ,mouse-wheel-left-event - wheel-down wheel-up wheel-left wheel-right))) + (with-suppressed-warnings + ((obsolete + mouse-wheel-down-event mouse-wheel-right-event + mouse-wheel-up-event mouse-wheel-left-event)) + `( ,mouse-wheel-down-event ,mouse-wheel-up-event + ,mouse-wheel-right-event ,mouse-wheel-left-event + wheel-down wheel-up wheel-left wheel-right)))) nil) (noerror nil) (t diff --git a/lisp/mouse.el b/lisp/mouse.el index cef88dede8a..410e52b2ecb 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -133,6 +133,19 @@ or macOS)." :type 'boolean :version "29.1") +(defcustom mouse-wheel-buttons + '((4 . wheel-up) (5 . wheel-down) (6 . wheel-left) (7 . wheel-right)) + "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 +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 @@ (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 @@ Also see `mouse-wheel-tilt-scroll'." (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/progmodes/flymake.el b/lisp/progmodes/flymake.el index 779c612f479..f2750a026ce 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -1645,14 +1645,16 @@ correctly.") (let ((map (make-sparse-keymap))) ;; BEWARE: `mouse-wheel-UP-event' corresponds to `wheel-DOWN' events ;; and vice versa!! - (define-key map (vector 'mode-line mouse-wheel-down-event) - #'flymake--mode-line-counter-scroll-prev) - (define-key map [mode-line wheel-down] - #'flymake--mode-line-counter-scroll-next) - (define-key map (vector 'mode-line mouse-wheel-up-event) - #'flymake--mode-line-counter-scroll-next) - (define-key map [mode-line wheel-up] - #'flymake--mode-line-counter-scroll-prev) + (with-suppressed-warnings + ((obsolete mouse-wheel-up-event mouse-wheel-down-event)) + (define-key map (vector 'mode-line mouse-wheel-down-event) + #'flymake--mode-line-counter-scroll-prev) + (define-key map [mode-line wheel-down] + #'flymake--mode-line-counter-scroll-next) + (define-key map (vector 'mode-line mouse-wheel-up-event) + #'flymake--mode-line-counter-scroll-next) + (define-key map [mode-line wheel-up] + #'flymake--mode-line-counter-scroll-prev)) map)) (defun flymake--mode-line-counter-1 (type) 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 @@ single byte." (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 ;; in default mode, and ;; ";" ";" <"M" or "m"> in extended mode. @@ -246,14 +238,10 @@ single byte." (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);