aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2024-01-12 19:05:24 -0500
committerStefan Monnier2024-01-12 19:05:24 -0500
commitf355557bb9e93f5d5e7c3fae17e4da398226efb4 (patch)
treefd9ab6b35197b703b541c0ab7443c39eb7eff04d
parent8cb8b9736532fdd8f2fc734b08ed55c17b922806 (diff)
downloademacs-scratch/mwheel-no-alts.tar.gz
emacs-scratch/mwheel-no-alts.zip
mwheel.el: Code clean to reduce duplicationscratch/mwheel-no-alts
* 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.
-rw-r--r--lisp/mwheel.el54
1 files 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 @@
56 (bound-and-true-p mouse-wheel-mode)) 56 (bound-and-true-p mouse-wheel-mode))
57 (mouse-wheel-mode 1))) 57 (mouse-wheel-mode 1)))
58 58
59(defcustom mouse-wheel-down-event 59(defvar mouse-wheel-obey-old-style-wheel-buttons
60 ;; FIXME: Yuck!
60 (if (or (featurep 'w32-win) (featurep 'ns-win) 61 (if (or (featurep 'w32-win) (featurep 'ns-win)
61 (featurep 'haiku-win) (featurep 'pgtk-win) 62 (featurep 'haiku-win) (featurep 'pgtk-win)
62 (featurep 'android-win)) 63 (featurep 'android-win))
63 (if (featurep 'xinput2) 64 (if (featurep 'xinput2)
64 nil 65 nil
65 (unless (featurep 'x) 66 (unless (featurep 'x)
66 'mouse-4)) 67 t))
67 'mouse-4) 68 t)
69 "If non-nil, treat mouse-4/5/6/7 events as mouse wheel events.
70These are the event names used historically in X11 before XInput2.
71They are sometimes generated by things like `xterm-mouse-mode' as well.")
72
73(defcustom mouse-wheel-down-event
74 (if mouse-wheel-obey-old-style-wheel-buttons 'mouse-4)
68 "Event used for scrolling down, beside `wheel-down', if any." 75 "Event used for scrolling down, beside `wheel-down', if any."
69 :group 'mouse 76 :group 'mouse
70 :type 'symbol 77 :type 'symbol
71 :set 'mouse-wheel-change-button) 78 :set #'mouse-wheel-change-button)
72 79
73(defcustom mouse-wheel-up-event 80(defcustom mouse-wheel-up-event
74 (if (or (featurep 'w32-win) (featurep 'ns-win) 81 (if mouse-wheel-obey-old-style-wheel-buttons 'mouse-5)
75 (featurep 'haiku-win) (featurep 'pgtk-win)
76 (featurep 'android-win))
77 (if (featurep 'xinput2)
78 nil
79 (unless (featurep 'x)
80 'mouse-5))
81 'mouse-5)
82 "Event used for scrolling up, beside `wheel-up', if any." 82 "Event used for scrolling up, beside `wheel-up', if any."
83 :group 'mouse 83 :group 'mouse
84 :type 'symbol 84 :type 'symbol
85 :set 'mouse-wheel-change-button) 85 :set #'mouse-wheel-change-button)
86 86
87(defcustom mouse-wheel-click-event 'mouse-2 87(defcustom mouse-wheel-click-event 'mouse-2
88 "Event that should be temporarily inhibited after mouse scrolling. 88 "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
92set to the event sent when clicking on the mouse wheel button." 92set to the event sent when clicking on the mouse wheel button."
93 :group 'mouse 93 :group 'mouse
94 :type 'symbol 94 :type 'symbol
95 :set 'mouse-wheel-change-button) 95 :set #'mouse-wheel-change-button)
96 96
97(defcustom mouse-wheel-inhibit-click-time 0.35 97(defcustom mouse-wheel-inhibit-click-time 0.35
98 "Time in seconds to inhibit clicking on mouse wheel button after scroll." 98 "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'."
149 (const :tag "Scroll horizontally" :value hscroll) 149 (const :tag "Scroll horizontally" :value hscroll)
150 (const :tag "Change buffer face size" :value text-scale) 150 (const :tag "Change buffer face size" :value text-scale)
151 (const :tag "Change global face size" :value global-text-scale))))) 151 (const :tag "Change global face size" :value global-text-scale)))))
152 :set 'mouse-wheel-change-button 152 :set #'mouse-wheel-change-button
153 :version "28.1") 153 :version "28.1")
154 154
155(defcustom mouse-wheel-progressive-speed t 155(defcustom mouse-wheel-progressive-speed t
@@ -233,25 +233,11 @@ Also see `mouse-wheel-tilt-scroll'."
233 "Function that does the job of scrolling right.") 233 "Function that does the job of scrolling right.")
234 234
235(defvar mouse-wheel-left-event 235(defvar mouse-wheel-left-event
236 (if (or (featurep 'w32-win) (featurep 'ns-win) 236 (if mouse-wheel-obey-old-style-wheel-buttons 'mouse-6)
237 (featurep 'haiku-win) (featurep 'pgtk-win)
238 (featurep 'android-win))
239 (if (featurep 'xinput2)
240 nil
241 (unless (featurep 'x)
242 'mouse-6))
243 'mouse-6)
244 "Event used for scrolling left, beside `wheel-left', if any.") 237 "Event used for scrolling left, beside `wheel-left', if any.")
245 238
246(defvar mouse-wheel-right-event 239(defvar mouse-wheel-right-event
247 (if (or (featurep 'w32-win) (featurep 'ns-win) 240 (if mouse-wheel-obey-old-style-wheel-buttons 'mouse-7)
248 (featurep 'haiku-win) (featurep 'pgtk-win)
249 (featurep 'android-win))
250 (if (featurep 'xinput2)
251 nil
252 (unless (featurep 'x)
253 'mouse-7))
254 'mouse-7)
255 "Event used for scrolling right, beside `wheel-right', if any.") 241 "Event used for scrolling right, beside `wheel-right', if any.")
256 242
257(defun mouse-wheel--get-scroll-window (event) 243(defun mouse-wheel--get-scroll-window (event)
@@ -335,7 +321,8 @@ value of ARG, and the command uses it in subsequent scrolls."
335 mwheel-scroll-right-function) 321 mwheel-scroll-right-function)
336 mouse-wheel-scroll-amount-horizontal)) 322 mouse-wheel-scroll-amount-horizontal))
337 ((mwheel--is-dir-p down button) 323 ((mwheel--is-dir-p down button)
338 (condition-case nil (funcall mwheel-scroll-down-function amt) 324 (condition-case nil
325 (funcall mwheel-scroll-down-function amt)
339 ;; Make sure we do indeed scroll to the beginning of 326 ;; Make sure we do indeed scroll to the beginning of
340 ;; the buffer. 327 ;; the buffer.
341 (beginning-of-buffer 328 (beginning-of-buffer
@@ -359,7 +346,8 @@ value of ARG, and the command uses it in subsequent scrolls."
359 ((mwheel--is-dir-p up button) 346 ((mwheel--is-dir-p up button)
360 (condition-case nil (funcall mwheel-scroll-up-function amt) 347 (condition-case nil (funcall mwheel-scroll-up-function amt)
361 ;; Make sure we do indeed scroll to the end of the buffer. 348 ;; Make sure we do indeed scroll to the end of the buffer.
362 (end-of-buffer (while t (funcall mwheel-scroll-up-function))))) 349 (end-of-buffer
350 (while t (funcall mwheel-scroll-up-function)))))
363 ((mwheel--is-dir-p left button) ; for tilt scroll 351 ((mwheel--is-dir-p left button) ; for tilt scroll
364 (when mouse-wheel-tilt-scroll 352 (when mouse-wheel-tilt-scroll
365 (funcall (if mouse-wheel-flip-direction 353 (funcall (if mouse-wheel-flip-direction