From ee2a8fd4cff84cd5bd672fdde8ec3e0800f132be Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 9 Jan 2024 11:34:05 -0500 Subject: [PATCH 1/7] (mouse-wheel-*-event): Minor cleanups * lisp/mwheel.el (mwheel-event-button): Mark as obsolete alias. Change all callers. * lisp/edmacro.el (mouse-wheel-*-event): Move declarations to ... (edmacro-fix-menu-commands): ... where we do know that they should be defined. Obey `mouse-wheel-*-alternate-event`s as well. --- lisp/edmacro.el | 20 +++++++++++++------- lisp/mwheel.el | 18 ++++++------------ 2 files changed, 19 insertions(+), 19 deletions(-) diff --git a/lisp/edmacro.el b/lisp/edmacro.el index 362ec0ecbb4..5bd0c1892e5 100644 --- a/lisp/edmacro.el +++ b/lisp/edmacro.el @@ -720,17 +720,19 @@ This function assumes that the events can be stored in a string." (setf (aref seq i) (logand (aref seq i) 127))) seq) -;; These are needed in a --without-x build. -(defvar mouse-wheel-down-event) -(defvar mouse-wheel-up-event) -(defvar mouse-wheel-right-event) -(defvar mouse-wheel-left-event) - (defun edmacro-fix-menu-commands (macro &optional noerror) (if (vectorp macro) (let (result) ;; Not preloaded in a --without-x build. (require 'mwheel) + (defvar mouse-wheel-down-event) + (defvar mouse-wheel-up-event) + (defvar mouse-wheel-right-event) + (defvar mouse-wheel-left-event) + (defvar mouse-wheel-down-alternate-event) + (defvar mouse-wheel-up-alternate-event) + (defvar mouse-wheel-right-alternate-event) + (defvar mouse-wheel-left-alternate-event) ;; Make a list of the elements. (setq macro (append macro nil)) (dolist (ev macro) @@ -748,7 +750,11 @@ This function assumes that the events can be stored in a string." (memq (event-basic-type ev) (list mouse-wheel-down-event mouse-wheel-up-event mouse-wheel-right-event - mouse-wheel-left-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))) nil) (noerror nil) (t diff --git a/lisp/mwheel.el b/lisp/mwheel.el index b75b6f27d53..735adf42f68 100644 --- a/lisp/mwheel.el +++ b/lisp/mwheel.el @@ -216,15 +216,9 @@ Also see `mouse-wheel-tilt-scroll'." :type 'boolean :version "26.1") -(defun mwheel-event-button (event) - (let ((x (event-basic-type event))) - ;; Map mouse-wheel events to appropriate buttons - (if (eq 'mouse-wheel x) - (let ((amount (car (cdr (cdr (cdr event)))))) - (if (< amount 0) - mouse-wheel-up-event - mouse-wheel-down-event)) - x))) +;; This function used to handle the `mouse-wheel` event which was +;; removed in 2003 by commit 9eb28007fb27, thus making it obsolete. +(define-obsolete-function-alias 'mwheel-event-button #'event-basic-type "30.1") (defun mwheel-event-window (event) (posn-window (event-start event))) @@ -347,7 +341,7 @@ value of ARG, and the command uses it in subsequent scrolls." (when (numberp amt) (setq amt (* amt (event-line-count event)))) (condition-case nil (unwind-protect - (let ((button (mwheel-event-button event))) + (let ((button (event-basic-type event))) (cond ((and (eq amt 'hscroll) (memq button (list mouse-wheel-down-event mouse-wheel-down-alternate-event))) (when (and (natnump arg) (> arg 0)) @@ -434,7 +428,7 @@ See also `text-scale-adjust'." (interactive (list last-input-event)) (let ((selected-window (selected-window)) (scroll-window (mouse-wheel--get-scroll-window event)) - (button (mwheel-event-button event))) + (button (event-basic-type event))) (select-window scroll-window 'mark-for-redisplay) (unwind-protect (cond ((memq button (list mouse-wheel-down-event @@ -450,7 +444,7 @@ See also `text-scale-adjust'." "Increase or decrease the global font size according to the EVENT. This invokes `global-text-scale-adjust', which see." (interactive (list last-input-event)) - (let ((button (mwheel-event-button event))) + (let ((button (event-basic-type event))) (cond ((memq button (list mouse-wheel-down-event mouse-wheel-down-alternate-event)) (global-text-scale-adjust 1)) From a764b503e126a60ff4ea1266da924de7b020637e Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 12 Jan 2024 17:50:09 -0500 Subject: [PATCH 2/7] (mwheel--is-dir-p): New macro to reduce code duplication It also slightly reduces memory allocation. * lisp/mwheel.el (mwheel--is-dir-p): New macro. (mwheel-scroll, mouse-wheel-text-scale) (mouse-wheel-global-text-scale): Use it. --- lisp/mwheel.el | 45 +++++++++++++++++++++++---------------------- 1 file changed, 23 insertions(+), 22 deletions(-) diff --git a/lisp/mwheel.el b/lisp/mwheel.el index 735adf42f68..84679f5c33f 100644 --- a/lisp/mwheel.el +++ b/lisp/mwheel.el @@ -305,6 +305,15 @@ active window." frame nil t))))) (mwheel-event-window event))) +(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)))) + (macroexp-let2 nil butsym button + `(or (eq ,butsym ,custom-var) + ;; We presume here `button' is never nil. + (eq ,butsym ,custom-var-alt))))) + (defun mwheel-scroll (event &optional arg) "Scroll up or down according to the EVENT. This should be bound only to mouse buttons 4, 5, 6, and 7 on @@ -342,16 +351,14 @@ value of ARG, and the command uses it in subsequent scrolls." (condition-case nil (unwind-protect (let ((button (event-basic-type event))) - (cond ((and (eq amt 'hscroll) (memq button (list mouse-wheel-down-event - mouse-wheel-down-alternate-event))) + (cond ((and (eq amt 'hscroll) (mwheel--is-dir-p down button)) (when (and (natnump arg) (> arg 0)) (setq mouse-wheel-scroll-amount-horizontal arg)) (funcall (if mouse-wheel-flip-direction mwheel-scroll-left-function mwheel-scroll-right-function) mouse-wheel-scroll-amount-horizontal)) - ((memq button (list mouse-wheel-down-event - mouse-wheel-down-alternate-event)) + ((mwheel--is-dir-p down button) (condition-case nil (funcall mwheel-scroll-down-function amt) ;; Make sure we do indeed scroll to the beginning of ;; the buffer. @@ -366,31 +373,29 @@ value of ARG, and the command uses it in subsequent scrolls." ;; for a reason that escapes me. This problem seems ;; to only affect scroll-down. --Stef (set-window-start (selected-window) (point-min)))))) - ((and (eq amt 'hscroll) (memq button (list mouse-wheel-up-event - mouse-wheel-up-alternate-event))) + ((and (eq amt 'hscroll) (mwheel--is-dir-p up button)) (when (and (natnump arg) (> arg 0)) (setq mouse-wheel-scroll-amount-horizontal arg)) (funcall (if mouse-wheel-flip-direction mwheel-scroll-right-function mwheel-scroll-left-function) mouse-wheel-scroll-amount-horizontal)) - ((memq button (list mouse-wheel-up-event - mouse-wheel-up-alternate-event)) + ((mwheel--is-dir-p up button) (condition-case nil (funcall mwheel-scroll-up-function amt) ;; Make sure we do indeed scroll to the end of the buffer. (end-of-buffer (while t (funcall mwheel-scroll-up-function))))) - ((memq button (list mouse-wheel-left-event - mouse-wheel-left-alternate-event)) ; for tilt scroll + ((mwheel--is-dir-p left button) ; for tilt scroll (when mouse-wheel-tilt-scroll (funcall (if mouse-wheel-flip-direction mwheel-scroll-right-function - mwheel-scroll-left-function) amt))) - ((memq button (list mouse-wheel-right-event - mouse-wheel-right-alternate-event)) ; for tilt scroll + mwheel-scroll-left-function) + amt))) + ((mwheel--is-dir-p right button) ; for tilt scroll (when mouse-wheel-tilt-scroll (funcall (if mouse-wheel-flip-direction mwheel-scroll-left-function - mwheel-scroll-right-function) amt))) + mwheel-scroll-right-function) + amt))) (t (error "Bad binding in mwheel-scroll")))) (if (eq scroll-window selected-window) ;; If there is a temporarily active region, deactivate it if @@ -431,11 +436,9 @@ See also `text-scale-adjust'." (button (event-basic-type event))) (select-window scroll-window 'mark-for-redisplay) (unwind-protect - (cond ((memq button (list mouse-wheel-down-event - mouse-wheel-down-alternate-event)) + (cond ((mwheel--is-dir-p down button) (text-scale-increase 1)) - ((memq button (list mouse-wheel-up-event - mouse-wheel-up-alternate-event)) + ((mwheel--is-dir-p up button) (text-scale-decrease 1))) (select-window selected-window)))) @@ -445,11 +448,9 @@ See also `text-scale-adjust'." This invokes `global-text-scale-adjust', which see." (interactive (list last-input-event)) (let ((button (event-basic-type event))) - (cond ((memq button (list mouse-wheel-down-event - mouse-wheel-down-alternate-event)) + (cond ((mwheel--is-dir-p down button) (global-text-scale-adjust 1)) - ((memq button (list mouse-wheel-up-event - mouse-wheel-up-alternate-event)) + ((mwheel--is-dir-p up button) (global-text-scale-adjust -1))))) (defun mouse-wheel--add-binding (key fun) From eb779ae64677e643d2d78cfc2b016088e8d7ff98 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 12 Jan 2024 18:05:14 -0500 Subject: [PATCH 3/7] * lisp/keymap.el (define-keymap): Demote "duplicate def" to a warning * test/src/keymap-tests.el (keymap-test-duplicate-definitions): Adjust accordingly. --- lisp/keymap.el | 12 +++++++++--- test/src/keymap-tests.el | 17 +++++++++++++---- 2 files changed, 22 insertions(+), 7 deletions(-) diff --git a/lisp/keymap.el b/lisp/keymap.el index 065c59da74c..d2544e30ce0 100644 --- a/lisp/keymap.el +++ b/lisp/keymap.el @@ -577,9 +577,15 @@ should be a MENU form as accepted by `easy-menu-define'. (let ((def (pop definitions))) (if (eq key :menu) (easy-menu-define nil keymap "" def) - (if (member key seen-keys) - (error "Duplicate definition for key: %S %s" key keymap) - (push key seen-keys)) + (when (member key seen-keys) + ;; Since the keys can be computed dynamically, it can + ;; very well happen that we get duplicate definitions + ;; due to some unfortunate configuration rather than + ;; due to an actual bug. While such duplicates are + ;; not desirable, they shouldn't prevent the users + ;; from getting their job done. + (message "Duplicate definition for key: %S %s" key keymap)) + (push key seen-keys) (keymap-set keymap key def))))) keymap))) diff --git a/test/src/keymap-tests.el b/test/src/keymap-tests.el index bc9977f31bf..04b897045db 100644 --- a/test/src/keymap-tests.el +++ b/test/src/keymap-tests.el @@ -23,6 +23,7 @@ ;;; Code: (require 'ert) +(require 'cl-lib) (defun keymap-tests--make-keymap-test (fun) (should (eq (car (funcall fun)) 'keymap)) @@ -470,10 +471,18 @@ g .. h foo ert-keymap-duplicate "a" #'next-line "a" #'previous-line)) - (should-error - (define-keymap - "a" #'next-line - "a" #'previous-line))) + (let ((msg "")) + ;; FIXME: It would be nicer to use `current-message' rather than override + ;; `message', but `current-message' returns always nil in batch mode :-( + (cl-letf (((symbol-function 'message) + (lambda (fmt &rest args) (setq msg (apply #'format fmt args))))) + (should + (string-match "duplicate" + (progn + (define-keymap + "a" #'next-line + "a" #'previous-line) + msg)))))) (ert-deftest keymap-unset-test-remove-and-inheritance () "Check various behaviors of keymap-unset. (Bug#62207)" From 82f71e106afd9bede95cfea3025f7c059d7c2bcf Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 12 Jan 2024 18:08:31 -0500 Subject: [PATCH 4/7] * lisp/completion-preview.el: Fix use in non-GUI session Fix loading in non-GUI sessions where `mwheel` is not preloaded. Not requiring `mwheel` would be a lot more complex, since it would require delaying the construction of `completion-preview--mouse-map`. * lisp/completion-preview.el (): Require `mwheel`. Remove correspondingly redundant `defvar`s. (completion-preview--mouse-map): Use `key-description` rather than mimicking it with `format`. --- lisp/completion-preview.el | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) diff --git a/lisp/completion-preview.el b/lisp/completion-preview.el index baadb4714b1..3bb5ef24e9d 100644 --- a/lisp/completion-preview.el +++ b/lisp/completion-preview.el @@ -52,6 +52,8 @@ ;;; Code: +(require 'mwheel) + (defgroup completion-preview nil "In-buffer completion preview." :group 'completion) @@ -128,19 +130,19 @@ If this option is nil, these commands do not display any message." ;; "M-p" #'completion-preview-prev-candidate ) -(defvar mouse-wheel-up-event) -(defvar mouse-wheel-up-alternate-event) -(defvar mouse-wheel-down-event) -(defvar mouse-wheel-down-alternate-event) (defvar-keymap completion-preview--mouse-map :doc "Keymap for mouse clicks on the completion preview." "" #'completion-preview-insert "C-" #'completion-at-point "" #'completion-at-point - (format "<%s>" mouse-wheel-up-event) #'completion-preview-prev-candidate - (format "<%s>" mouse-wheel-up-alternate-event) #'completion-preview-prev-candidate - (format "<%s>" mouse-wheel-down-event) #'completion-preview-next-candidate - (format "<%s>" mouse-wheel-down-alternate-event) #'completion-preview-next-candidate) + (key-description (vector mouse-wheel-up-event)) + #'completion-preview-prev-candidate + (key-description (vector mouse-wheel-up-alternate-event)) + #'completion-preview-prev-candidate + (key-description (vector mouse-wheel-down-event)) + #'completion-preview-next-candidate + (key-description (vector mouse-wheel-down-alternate-event)) + #'completion-preview-next-candidate) (defvar-local completion-preview--overlay nil) From db8890b3c96289ca95e4ea3ea53f0eda1a948af6 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. * doc/lispref/commands.texi (Misc Events): Document the need to use `wheel-up/down/left/right` unconditionally. --- doc/lispref/commands.texi | 29 +++++++++++++++-------------- etc/NEWS | 7 +++++++ lisp/completion-preview.el | 2 ++ lisp/edmacro.el | 15 ++++++++------- lisp/mwheel.el | 15 ++++++++++----- 5 files changed, 42 insertions(+), 26 deletions(-) diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index 10f47d736d2..5f840ac21ec 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -2562,23 +2562,24 @@ non-@code{nil}. @vindex mouse-wheel-up-event @vindex mouse-wheel-down-event The @code{wheel-up} and @code{wheel-down} events are generated only on -some kinds of systems. On other systems, @code{mouse-4} and -@code{mouse-5} are used instead. For portable code, use the variables -@code{mouse-wheel-up-event}, @code{mouse-wheel-up-alternate-event}, -@code{mouse-wheel-down-event} and -@code{mouse-wheel-down-alternate-event} defined in @file{mwheel.el} to -determine what event types to expect from the mouse wheel. +some kinds of systems. On other systems, other events like @code{mouse-4} and +@code{mouse-5} are used instead. Portable code should handle both +@code{wheel-up} and @code{wheel-down} events as well as the events +specified in the variables @code{mouse-wheel-up-event} and +@code{mouse-wheel-down-event}, defined in @file{mwheel.el}. @vindex mouse-wheel-left-event @vindex mouse-wheel-right-event -Similarly, some mice can generate @code{mouse-wheel-left-event} and -@code{mouse-wheel-right-event} and can be used to scroll if -@code{mouse-wheel-tilt-scroll} is non-@code{nil}. However, some mice -also generate other events at the same time as they're generating -these scroll events which may get in the way. The way to fix this is -generally to unbind these events (for instance, @code{mouse-6} or -@code{mouse-7}, but this is very hardware and operating system -dependent). +The same holds for the horizontal wheel movements which are usually +represented by @code{wheel-left} and @code{wheel-right} events, but +for which portable code should also obey the variables +@code{mouse-wheel-left-event} and @code{mouse-wheel-right-event}, +defined in @file{mwheel.el}. +However, some mice also generate other events at the same time as +they're generating these scroll events which may get in the way. +The way to fix this is generally to unbind these events (for instance, +@code{mouse-6} or @code{mouse-7}, but this is very hardware and +operating system dependent). @cindex @code{pinch} event @item (pinch @var{position} @var{dx} @var{dy} @var{scale} @var{angle}) diff --git a/etc/NEWS b/etc/NEWS index f4d008ee2d6..fefdfb2afb3 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -406,6 +406,13 @@ respectively, in addition to the existing translations 'C-x 8 / e' and * Changes in Specialized Modes and Packages in Emacs 30.1 ++++ +** 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 +legacy setup, such as 'xterm-mouse-mode' or X11 without XInput2. + +++ ** New command 'lldb'. Run the LLDB debugger, analogous to the 'gud-gdb' command. 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 @@ If this option is nil, these commands do not display any message." "" #'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 @@ 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) - (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 @@ active 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 @@ an event used for scrolling, such as `mouse-wheel-down-event'." ((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 @@ an event used for scrolling, such as `mouse-wheel-down-event'." 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)))))))) From 18294854c717a82966090e99130bcb99fc354a5b Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 12 Jan 2024 18:52:37 -0500 Subject: [PATCH 6/7] mwheel.el: Remove `mouse-wheel-*-alternate-event` vars Now that `wheel-DIR` events are hardcoded, we never need more than one variable (which we actually never needed anyway, we could have let `mouse-wheel-*-event` vars hold lists of events instead), so remove the `mouse-wheel-*-alternate-event` vars by merging their default value into that of the corresponding `mouse-wheel-*-event`. * lisp/mwheel.el (mouse-wheel-down-event, mouse-wheel-up-event) (mouse-wheel-left-event, mouse-wheel-right-event): Don't bother holding `wheel-DIR` events since these are already handled anyway. Hold the event that would have been held in `mouse-wheel-DIR-alternate-event` instead. (mouse-wheel-down-alternate-event, mouse-wheel-up-alternate-event) (mouse-wheel-left-alternate-event, mouse-wheel-right-alternate-event): Delete vars. (mwheel--is-dir-p, mouse-wheel--setup-bindings): * lisp/edmacro.el (edmacro-fix-menu-commands): * lisp/completion-preview.el (completion-preview--mouse-map): Don't use `mouse-wheel-up/down-alternate-event` any more. * lisp/progmodes/flymake.el (flymake--mode-line-counter-map): Do nothing, because it already ignored those vars. --- lisp/completion-preview.el | 4 -- lisp/edmacro.el | 11 +----- lisp/mwheel.el | 76 +++++++++++--------------------------- 3 files changed, 22 insertions(+), 69 deletions(-) diff --git a/lisp/completion-preview.el b/lisp/completion-preview.el index 48b6a4fd822..f552db7aa8e 100644 --- a/lisp/completion-preview.el +++ b/lisp/completion-preview.el @@ -139,11 +139,7 @@ If this option is nil, these commands do not display any message." "" #'completion-preview-next-candidate (key-description (vector mouse-wheel-up-event)) #'completion-preview-prev-candidate - (key-description (vector mouse-wheel-up-alternate-event)) - #'completion-preview-prev-candidate (key-description (vector mouse-wheel-down-event)) - #'completion-preview-next-candidate - (key-description (vector mouse-wheel-down-alternate-event)) #'completion-preview-next-candidate) (defvar-local completion-preview--overlay nil) diff --git a/lisp/edmacro.el b/lisp/edmacro.el index 9ade554f559..9d185d79142 100644 --- a/lisp/edmacro.el +++ b/lisp/edmacro.el @@ -729,10 +729,6 @@ This function assumes that the events can be stored in a string." (defvar mouse-wheel-up-event) (defvar mouse-wheel-right-event) (defvar mouse-wheel-left-event) - (defvar mouse-wheel-down-alternate-event) - (defvar mouse-wheel-up-alternate-event) - (defvar mouse-wheel-right-alternate-event) - (defvar mouse-wheel-left-alternate-event) ;; Make a list of the elements. (setq macro (append macro nil)) (dolist (ev macro) @@ -749,12 +745,7 @@ This function assumes that the events can be stored in a string." ((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 - ,mouse-wheel-down-alternate-event - ,mouse-wheel-up-alternate-event - ,mouse-wheel-right-alternate-event - ,mouse-wheel-left-alternate-event + ,mouse-wheel-right-event ,mouse-wheel-left-event wheel-down wheel-up wheel-left wheel-right))) nil) (noerror nil) diff --git a/lisp/mwheel.el b/lisp/mwheel.el index f50376c72b5..438ca5f84d5 100644 --- a/lisp/mwheel.el +++ b/lisp/mwheel.el @@ -60,46 +60,30 @@ (if (or (featurep 'w32-win) (featurep 'ns-win) (featurep 'haiku-win) (featurep 'pgtk-win) (featurep 'android-win)) - 'wheel-up + (if (featurep 'xinput2) + nil + (unless (featurep 'x) + 'mouse-4)) 'mouse-4) - "Event used for scrolling down." + "Event used for scrolling down, beside `wheel-down', if any." :group 'mouse :type 'symbol :set 'mouse-wheel-change-button) -(defcustom mouse-wheel-down-alternate-event - (if (featurep 'xinput2) - 'wheel-up - (unless (featurep 'x) - 'mouse-4)) - "Alternative wheel down event to consider." - :group 'mouse - :type 'symbol - :version "29.1" - :set 'mouse-wheel-change-button) - (defcustom mouse-wheel-up-event (if (or (featurep 'w32-win) (featurep 'ns-win) (featurep 'haiku-win) (featurep 'pgtk-win) (featurep 'android-win)) - 'wheel-down + (if (featurep 'xinput2) + nil + (unless (featurep 'x) + 'mouse-5)) 'mouse-5) - "Event used for scrolling up." + "Event used for scrolling up, beside `wheel-up', if any." :group 'mouse :type 'symbol :set 'mouse-wheel-change-button) -(defcustom mouse-wheel-up-alternate-event - (if (featurep 'xinput2) - 'wheel-down - (unless (featurep 'x) - 'mouse-5)) - "Alternative wheel up event to consider." - :group 'mouse - :type 'symbol - :version "29.1" - :set 'mouse-wheel-change-button) - (defcustom mouse-wheel-click-event 'mouse-2 "Event that should be temporarily inhibited after mouse scrolling. The mouse wheel is typically on the mouse-2 button, so it may easily @@ -252,31 +236,23 @@ Also see `mouse-wheel-tilt-scroll'." (if (or (featurep 'w32-win) (featurep 'ns-win) (featurep 'haiku-win) (featurep 'pgtk-win) (featurep 'android-win)) - 'wheel-left + (if (featurep 'xinput2) + nil + (unless (featurep 'x) + 'mouse-6)) 'mouse-6) - "Event used for scrolling left.") - -(defvar mouse-wheel-left-alternate-event - (if (featurep 'xinput2) - 'wheel-left - (unless (featurep 'x) - 'mouse-6)) - "Alternative wheel left event to consider.") + "Event used for scrolling left, beside `wheel-left', if any.") (defvar mouse-wheel-right-event (if (or (featurep 'w32-win) (featurep 'ns-win) (featurep 'haiku-win) (featurep 'pgtk-win) (featurep 'android-win)) - 'wheel-right + (if (featurep 'xinput2) + nil + (unless (featurep 'x) + 'mouse-7)) 'mouse-7) - "Event used for scrolling right.") - -(defvar mouse-wheel-right-alternate-event - (if (featurep 'xinput2) - 'wheel-right - (unless (featurep 'x) - 'mouse-7)) - "Alternative wheel right event to consider.") + "Event used for scrolling right, beside `wheel-right', if any.") (defun mouse-wheel--get-scroll-window (event) "Return window for mouse wheel event EVENT. @@ -308,13 +284,11 @@ active 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))) (event (intern (format "wheel-%s" dir)))) (macroexp-let2 nil butsym button `(or (eq ,butsym ',event) - (eq ,butsym ,custom-var) ;; We presume here `button' is never nil. - (eq ,butsym ,custom-var-alt))))) + (eq ,butsym ,custom-var))))) (defun mwheel-scroll (event &optional arg) "Scroll up or down according to the EVENT. @@ -504,16 +478,12 @@ an event used for scrolling, such as `mouse-wheel-down-event'." ;; Bindings for changing font size. ((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 '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 'wheel-down 'wheel-up)) (when event (mouse-wheel--add-binding `[,(append (car binding) (list event))] @@ -522,10 +492,6 @@ an event used for scrolling, such as `mouse-wheel-down-event'." (t (dolist (event (list mouse-wheel-down-event mouse-wheel-up-event mouse-wheel-left-event mouse-wheel-right-event - mouse-wheel-down-alternate-event - mouse-wheel-up-alternate-event - mouse-wheel-left-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)) From 998667f90262432facbf43cdb1f0a96704c84271 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 12 Jan 2024 19:05:24 -0500 Subject: [PATCH 7/7] mwheel.el: Code clean to reduce duplication * lisp/mwheel.el (mouse-wheel-obey-old-style-wheel-buttons): New var, extracted from `mouse-wheel-*-event` definitions. (mouse-wheel-down-event, mouse-wheel-up-event) (mouse-wheel-left-event, mouse-wheel-right-event): Use it. --- lisp/mwheel.el | 54 ++++++++++++++++++++------------------------------ 1 file changed, 21 insertions(+), 33 deletions(-) diff --git a/lisp/mwheel.el b/lisp/mwheel.el index 438ca5f84d5..fc1f8e8b6d6 100644 --- a/lisp/mwheel.el +++ b/lisp/mwheel.el @@ -56,33 +56,33 @@ (bound-and-true-p mouse-wheel-mode)) (mouse-wheel-mode 1))) -(defcustom mouse-wheel-down-event +(defvar mouse-wheel-obey-old-style-wheel-buttons + ;; FIXME: Yuck! (if (or (featurep 'w32-win) (featurep 'ns-win) (featurep 'haiku-win) (featurep 'pgtk-win) (featurep 'android-win)) (if (featurep 'xinput2) nil (unless (featurep 'x) - 'mouse-4)) - 'mouse-4) + t)) + 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 `xterm-mouse-mode' as well.") + +(defcustom mouse-wheel-down-event + (if mouse-wheel-obey-old-style-wheel-buttons 'mouse-4) "Event used for scrolling down, beside `wheel-down', if any." :group 'mouse :type 'symbol - :set 'mouse-wheel-change-button) + :set #'mouse-wheel-change-button) (defcustom mouse-wheel-up-event - (if (or (featurep 'w32-win) (featurep 'ns-win) - (featurep 'haiku-win) (featurep 'pgtk-win) - (featurep 'android-win)) - (if (featurep 'xinput2) - nil - (unless (featurep 'x) - 'mouse-5)) - 'mouse-5) + (if mouse-wheel-obey-old-style-wheel-buttons 'mouse-5) "Event used for scrolling up, beside `wheel-up', if any." :group 'mouse :type 'symbol - :set 'mouse-wheel-change-button) + :set #'mouse-wheel-change-button) (defcustom mouse-wheel-click-event 'mouse-2 "Event that should be temporarily inhibited after mouse scrolling. @@ -92,7 +92,7 @@ scrolling with the mouse wheel. To prevent that, this variable can be set to the event sent when clicking on the mouse wheel button." :group 'mouse :type 'symbol - :set 'mouse-wheel-change-button) + :set #'mouse-wheel-change-button) (defcustom mouse-wheel-inhibit-click-time 0.35 "Time in seconds to inhibit clicking on mouse wheel button after scroll." @@ -149,7 +149,7 @@ information, see `text-scale-adjust' and `global-text-scale-adjust'." (const :tag "Scroll horizontally" :value hscroll) (const :tag "Change buffer face size" :value text-scale) (const :tag "Change global face size" :value global-text-scale))))) - :set 'mouse-wheel-change-button + :set #'mouse-wheel-change-button :version "28.1") (defcustom mouse-wheel-progressive-speed t @@ -233,25 +233,11 @@ Also see `mouse-wheel-tilt-scroll'." "Function that does the job of scrolling right.") (defvar mouse-wheel-left-event - (if (or (featurep 'w32-win) (featurep 'ns-win) - (featurep 'haiku-win) (featurep 'pgtk-win) - (featurep 'android-win)) - (if (featurep 'xinput2) - nil - (unless (featurep 'x) - 'mouse-6)) - 'mouse-6) + (if mouse-wheel-obey-old-style-wheel-buttons 'mouse-6) "Event used for scrolling left, beside `wheel-left', if any.") (defvar mouse-wheel-right-event - (if (or (featurep 'w32-win) (featurep 'ns-win) - (featurep 'haiku-win) (featurep 'pgtk-win) - (featurep 'android-win)) - (if (featurep 'xinput2) - nil - (unless (featurep 'x) - 'mouse-7)) - 'mouse-7) + (if mouse-wheel-obey-old-style-wheel-buttons 'mouse-7) "Event used for scrolling right, beside `wheel-right', if any.") (defun mouse-wheel--get-scroll-window (event) @@ -335,7 +321,8 @@ value of ARG, and the command uses it in subsequent scrolls." mwheel-scroll-right-function) mouse-wheel-scroll-amount-horizontal)) ((mwheel--is-dir-p down button) - (condition-case nil (funcall mwheel-scroll-down-function amt) + (condition-case nil + (funcall mwheel-scroll-down-function amt) ;; Make sure we do indeed scroll to the beginning of ;; the buffer. (beginning-of-buffer @@ -359,7 +346,8 @@ value of ARG, and the command uses it in subsequent scrolls." ((mwheel--is-dir-p up button) (condition-case nil (funcall mwheel-scroll-up-function amt) ;; Make sure we do indeed scroll to the end of the buffer. - (end-of-buffer (while t (funcall mwheel-scroll-up-function))))) + (end-of-buffer + (while t (funcall mwheel-scroll-up-function))))) ((mwheel--is-dir-p left button) ; for tilt scroll (when mouse-wheel-tilt-scroll (funcall (if mouse-wheel-flip-direction