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 967d8a94113..8129412e872 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -416,6 +416,13 @@ respectively, in addition to the existing translations 'C-x 8 / e' and ** Trace 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 +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 baadb4714b1..f552db7aa8e 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,17 @@ 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) + "" #'completion-preview-prev-candidate + "" #'completion-preview-next-candidate + (key-description (vector mouse-wheel-up-event)) + #'completion-preview-prev-candidate + (key-description (vector mouse-wheel-down-event)) + #'completion-preview-next-candidate) (defvar-local completion-preview--overlay nil) diff --git a/lisp/edmacro.el b/lisp/edmacro.el index 362ec0ecbb4..9d185d79142 100644 --- a/lisp/edmacro.el +++ b/lisp/edmacro.el @@ -720,17 +720,15 @@ 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) ;; Make a list of the elements. (setq macro (append macro nil)) (dolist (ev macro) @@ -746,9 +744,9 @@ 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-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/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/lisp/mwheel.el b/lisp/mwheel.el index b75b6f27d53..fc1f8e8b6d6 100644 --- a/lisp/mwheel.el +++ b/lisp/mwheel.el @@ -56,49 +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)) - 'wheel-up - 'mouse-4) - "Event used for scrolling down." - :group 'mouse - :type 'symbol - :set 'mouse-wheel-change-button) + (if (featurep 'xinput2) + nil + (unless (featurep 'x) + 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-alternate-event - (if (featurep 'xinput2) - 'wheel-up - (unless (featurep 'x) - 'mouse-4)) - "Alternative wheel down event to consider." +(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 - :version "29.1" - :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)) - 'wheel-down - 'mouse-5) - "Event used for scrolling up." + (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) - -(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) + :set #'mouse-wheel-change-button) (defcustom mouse-wheel-click-event 'mouse-2 "Event that should be temporarily inhibited after mouse scrolling. @@ -108,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." @@ -165,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 @@ -216,15 +200,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))) @@ -255,34 +233,12 @@ 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)) - 'wheel-left - '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.") + (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)) - 'wheel-right - '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.") + (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) "Return window for mouse wheel event EVENT. @@ -311,6 +267,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))) + (event (intern (format "wheel-%s" dir)))) + (macroexp-let2 nil butsym button + `(or (eq ,butsym ',event) + ;; We presume here `button' is never nil. + (eq ,butsym ,custom-var))))) + (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 @@ -347,18 +312,17 @@ 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))) - (cond ((and (eq amt 'hscroll) (memq button (list mouse-wheel-down-event - mouse-wheel-down-alternate-event))) + (let ((button (event-basic-type 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)) - (condition-case nil (funcall mwheel-scroll-down-function amt) + ((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. (beginning-of-buffer @@ -372,31 +336,30 @@ 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 + (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 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 @@ -434,14 +397,12 @@ 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 - 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)))) @@ -450,12 +411,10 @@ 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))) - (cond ((memq button (list mouse-wheel-down-event - mouse-wheel-down-alternate-event)) + (let ((button (event-basic-type 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) @@ -507,15 +466,13 @@ 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))] 'mouse-wheel-global-text-scale)))) @@ -523,10 +480,7 @@ 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)) (mouse-wheel--add-binding key 'mwheel-scroll)))))))) 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)"