diff options
| author | Stefan Monnier | 2024-01-12 19:05:24 -0500 |
|---|---|---|
| committer | Stefan Monnier | 2024-01-12 19:05:24 -0500 |
| commit | f355557bb9e93f5d5e7c3fae17e4da398226efb4 (patch) | |
| tree | fd9ab6b35197b703b541c0ab7443c39eb7eff04d | |
| parent | 8cb8b9736532fdd8f2fc734b08ed55c17b922806 (diff) | |
| download | emacs-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.el | 54 |
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. | ||
| 70 | These are the event names used historically in X11 before XInput2. | ||
| 71 | They 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 | |||
| 92 | set to the event sent when clicking on the mouse wheel button." | 92 | set 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 |