procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

mwheel.el: Code clean to reduce duplication

Browse source 
* 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.
This commit is contained in:
Stefan Monnier 2024-01-12 19:05:24 -05:00
parent 18294854c7
commit 998667f902
1 changed files with 21 additions and 33 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

54
lisp/mwheel.el
View file

@ -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