From b0f04ce4d3495de8593e3b64ddd218cd3bad221c Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 12 Jan 2024 18:28:12 -0500 Subject: [PATCH 5/7] mwheel.el: Unconditionally use the `wheel-up/down/...` events The `mouse-wheel-DIR-event` vars were introduced because under X11 we get different `mouse-N` events depending on the users' mouse and those same events can be used for other things for other rodents, so we can't unconditionally treat those events as mouse-wheel events. But this does not apply to the `wheel-up/down/...` events. So hard code them. * lisp/mwheel.el (mwheel--is-dir-p): Always consider the `wheel-DIR` events. (mouse-wheel--setup-bindings): Always bind the `wheel-DIR` events. * lisp/completion-preview.el (completion-preview--mouse-map): Unconditionally bind the `wheel-DIR` events. * lisp/edmacro.el (edmacro-fix-menu-commands): Hard code the `wheel-DIR` events as mouse events regardless of `mouse-wheel-*-event`s. * lisp/progmodes/flymake.el (flymake--mode-line-counter-map): Do nothing, because it's already been done in commit e5be6c7ae309. --- lisp/completion-preview.el | 2 ++ lisp/edmacro.el | 15 ++++++++------- lisp/mwheel.el | 15 ++++++++++----- 3 files changed, 20 insertions(+), 12 deletions(-) diff --git a/lisp/completion-preview.el b/lisp/completion-preview.el index 3bb5ef24e9d..48b6a4fd822 100644 --- a/lisp/completion-preview.el +++ b/lisp/completion-preview.el @@ -135,6 +135,8 @@ completion-preview--mouse-map "" #'completion-preview-insert "C-" #'completion-at-point "" #'completion-at-point + "" #'completion-preview-prev-candidate + "" #'completion-preview-next-candidate (key-description (vector mouse-wheel-up-event)) #'completion-preview-prev-candidate (key-description (vector mouse-wheel-up-alternate-event)) diff --git a/lisp/edmacro.el b/lisp/edmacro.el index 5bd0c1892e5..9ade554f559 100644 --- a/lisp/edmacro.el +++ b/lisp/edmacro.el @@ -748,13 +748,14 @@ edmacro-fix-menu-commands ;; info is recorded in macros to make this possible. ((or (mouse-event-p ev) (mouse-movement-p ev) (memq (event-basic-type ev) - (list mouse-wheel-down-event mouse-wheel-up-event - mouse-wheel-right-event - mouse-wheel-left-event - mouse-wheel-down-alternate-event - mouse-wheel-up-alternate-event - mouse-wheel-right-alternate-event - mouse-wheel-left-alternate-event))) + `( ,mouse-wheel-down-event ,mouse-wheel-up-event + ,mouse-wheel-right-event + ,mouse-wheel-left-event + ,mouse-wheel-down-alternate-event + ,mouse-wheel-up-alternate-event + ,mouse-wheel-right-alternate-event + ,mouse-wheel-left-alternate-event + wheel-down wheel-up wheel-left wheel-right))) nil) (noerror nil) (t diff --git a/lisp/mwheel.el b/lisp/mwheel.el index 84679f5c33f..f50376c72b5 100644 --- a/lisp/mwheel.el +++ b/lisp/mwheel.el @@ -308,9 +308,11 @@ mouse-wheel--get-scroll-window (defmacro mwheel--is-dir-p (dir button) (declare (debug (sexp form))) (let ((custom-var (intern (format "mouse-wheel-%s-event" dir))) - (custom-var-alt (intern (format "mouse-wheel-%s-alternate-event" dir)))) + (custom-var-alt (intern (format "mouse-wheel-%s-alternate-event" dir))) + (event (intern (format "wheel-%s" dir)))) (macroexp-let2 nil butsym button - `(or (eq ,butsym ,custom-var) + `(or (eq ,butsym ',event) + (eq ,butsym ,custom-var) ;; We presume here `button' is never nil. (eq ,butsym ,custom-var-alt))))) @@ -503,14 +505,16 @@ mouse-wheel--setup-bindings ((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)) + 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)) + 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)))) @@ -521,7 +525,8 @@ mouse-wheel--setup-bindings mouse-wheel-down-alternate-event mouse-wheel-up-alternate-event mouse-wheel-left-alternate-event - mouse-wheel-right-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)))))))) -- 2.39.2