From: Stefan Monnier via "Bug reports for GNU Emacs, the Swiss army knife of text editors" <bug-gnu-emacs@gnu.org>
To: Po Lu <luangruo@yahoo.com>
Cc: Eli Zaretskii <eliz@gnu.org>,
jm@pub.pink, Eshel Yaron <me@eshelyaron.com>,
68213@debbugs.gnu.org
Subject: bug#68213: 30.0.50; completion-preview-tests failure in --without-x build
Date: Tue, 09 Jan 2024 01:07:53 -0500 [thread overview]
Message-ID: <jwvv883vyk0.fsf-monnier+emacs@gnu.org> (raw)
In-Reply-To: <jwv8r4zxip2.fsf-monnier+emacs@gnu.org> (Stefan Monnier's message of "Mon, 08 Jan 2024 23:11:36 -0500")
[-- Attachment #1: Type: text/plain, Size: 1916 bytes --]
> Thanks. I see that bug#50321 suggests we keep `mouse-4/5` in the
> `mouse-wheel-*-event` for any build that can use `xterm-mouse-mode`.
> It should be easy to adjust my patch to support that.
> Tho bug#49803 suggests we could fix it in `xt-mouse.el` as well and make
> `xt-mouse.el` emit `wheel-up/down` events instead.
The patch below still seems to handle simultaneous mixes of wheel-up and
mouse-4/5 buttons via tty+GUI frames. And based on my understanding of
the code, it should behave exactly like the current code in pretty much
all circumstances.
It also gets rid of `mwheel-event-button` which has been obsolete for
the last 20 years, apparently. This is notable, because
`mwheel-event-button` is the only part of the code that distinguishes
between `mouse-wheel-*-event` and
`mouse-wheel-*-alternate-event`, AFAICT.
It still contains a FIXME, tho:
(defcustom mouse-wheel-use-old-style-wheel-buttons
;; FIXME: Is this ever non-nil in practice?
(not (and (or (featurep 'w32-win) (featurep 'ns-win)
(featurep 'haiku-win) (featurep 'pgtk-win)
(featurep 'android-win))
(or (featurep 'xinput2)
(featurep 'x))))
"If non-nil, treat mouse-4/5/6/7 as wheel buttons.
These are the event names used historically in X11 before XInput2.
They are sometimes used by things like `xterm-mouse-mode' as well."
:group 'mouse
:type 'boolean)
The above code is a slight shuffling of the current code which uses
(if (or (featurep 'w32-win) (featurep 'ns-win)
(featurep 'haiku-win) (featurep 'pgtk-win)
(featurep 'android-win))
'wheel-up
'mouse-4)
[...]
(if (featurep 'xinput2)
'wheel-up
(unless (featurep 'x)
'mouse-4))
repeated 4 times.
Is it worth worrying about the case where this monstrosity is non-nil?
Stefan
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: mwheel.patch --]
[-- Type: text/x-diff, Size: 13603 bytes --]
diff --git a/lisp/mwheel.el b/lisp/mwheel.el
index b75b6f27d53..ca6d3cccb97 100644
--- a/lisp/mwheel.el
+++ b/lisp/mwheel.el
@@ -56,49 +56,32 @@ mouse-wheel-change-button
(bound-and-true-p mouse-wheel-mode))
(mouse-wheel-mode 1)))
-(defcustom mouse-wheel-down-event
- (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."
+(defcustom mouse-wheel-use-old-style-wheel-buttons
+ ;; FIXME: Is this ever non-nil in practice?
+ (not (and (or (featurep 'w32-win) (featurep 'ns-win)
+ (featurep 'haiku-win) (featurep 'pgtk-win)
+ (featurep 'android-win))
+ (or (featurep 'xinput2)
+ (featurep 'x))))
+ "If non-nil, treat mouse-4/5/6/7 as wheel buttons.
+These are the event names used historically in X11 before XInput2.
+They are sometimes used by things like `xterm-mouse-mode' as well."
: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."
+ :type 'boolean)
+
+(defcustom mouse-wheel-down-event
+ (if mouse-wheel-use-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-use-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 +91,7 @@ mouse-wheel-click-event
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 +148,7 @@ mouse-wheel-scroll-amount
(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 +199,10 @@ mouse-wheel-flip-direction
: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 @@ mwheel-scroll-right-function
"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-use-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-use-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 @@ mouse-wheel--get-scroll-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,18 @@ mwheel-scroll
(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 +337,32 @@ mwheel-scroll
;; 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))
- (condition-case nil (funcall mwheel-scroll-up-function amt)
+ ((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 +400,12 @@ mouse-wheel-text-scale
(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 +414,10 @@ mouse-wheel-global-text-scale
"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 +469,13 @@ mouse-wheel--setup-bindings
;; 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 +483,7 @@ mouse-wheel--setup-bindings
(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))))))))
next prev parent reply other threads:[~2024-01-09 6:07 UTC|newest]
Thread overview: 39+ messages / expand[flat|nested] mbox.gz Atom feed top
2024-01-02 16:42 bug#68213: 30.0.50; completion-preview-tests failure in --without-x build john muhl via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-01-02 17:11 ` Eli Zaretskii
2024-01-02 17:20 ` Eshel Yaron via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-01-02 17:42 ` john muhl via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-01-03 7:20 ` Eshel Yaron via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-01-03 17:27 ` Eli Zaretskii
2024-01-03 18:45 ` Eshel Yaron via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-01-03 19:18 ` Eli Zaretskii
2024-01-05 7:17 ` Eshel Yaron via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-01-05 11:54 ` Eli Zaretskii
2024-01-07 17:15 ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-01-07 17:19 ` Eli Zaretskii
2024-01-07 16:54 ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-01-08 1:51 ` Po Lu via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-01-08 3:19 ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-01-08 6:16 ` Po Lu via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-01-08 12:48 ` Eli Zaretskii
2024-01-08 14:20 ` Po Lu via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-01-08 17:12 ` Eli Zaretskii
2024-01-09 1:01 ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-01-08 15:21 ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-01-09 1:39 ` Po Lu via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-01-09 4:11 ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-01-09 6:07 ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors [this message]
2024-01-09 14:44 ` Drew Adams
2024-01-02 17:48 ` Eli Zaretskii
2024-01-07 16:46 ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-01-02 17:48 ` john muhl via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-01-02 19:15 ` Eli Zaretskii
2024-01-02 22:49 ` john muhl via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-01-06 9:42 ` Eli Zaretskii
2024-01-07 17:03 ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-01-07 17:09 ` Eli Zaretskii
2024-01-07 17:46 ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-01-13 0:16 ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-01-13 6:55 ` Eli Zaretskii
2024-01-13 7:17 ` Stefan Kangas
2024-01-20 9:15 ` Eli Zaretskii
2024-01-20 20:19 ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=jwvv883vyk0.fsf-monnier+emacs@gnu.org \
--to=bug-gnu-emacs@gnu.org \
--cc=68213@debbugs.gnu.org \
--cc=eliz@gnu.org \
--cc=jm@pub.pink \
--cc=luangruo@yahoo.com \
--cc=me@eshelyaron.com \
--cc=monnier@iro.umontreal.ca \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).