[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master d0cf9f3601b 2/2: Merge branch 'mouse-wheel-buttons'
|
From: |
Stefan Monnier |
|
Subject: |
master d0cf9f3601b 2/2: Merge branch 'mouse-wheel-buttons' |
|
Date: |
Tue, 9 Apr 2024 10:30:42 -0400 (EDT) |
branch: master
commit d0cf9f3601b88e4a87a0afd557110ea4c6834998
Merge: 7236010d2e1 e720ba62193
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>
Merge branch 'mouse-wheel-buttons'
---
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 3bce7686869..a2a3fe494cb 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
@@ -533,15 +542,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!!
"<wheel-up>" #'completion-preview-prev-candidate
"<wheel-down>" #'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 b7435edaa31..c63f7f30c5e 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 783718b4ba4..8cbb44ece14 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)
@@ -212,12 +210,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
;; <EVENT-CODE> <X> <Y> in default mode, and
;; <EVENT-CODE> ";" <X> ";" <Y> <"M" or "m"> in extended mode.
@@ -263,14 +255,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);
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- master d0cf9f3601b 2/2: Merge branch 'mouse-wheel-buttons',
Stefan Monnier <=