diff options
Diffstat (limited to 'lisp/mwheel.el')
| -rw-r--r-- | lisp/mwheel.el | 51 |
1 files changed, 30 insertions, 21 deletions
diff --git a/lisp/mwheel.el b/lisp/mwheel.el index 317f2cd8edd..d5172ba0bf5 100644 --- a/lisp/mwheel.el +++ b/lisp/mwheel.el @@ -25,8 +25,8 @@ ;; Under X11/X.Org, the wheel events are sent as button4/button5 ;; events. -;; It is already enabled by default on most graphical displays. You -;; can toggle it with M-x mouse-wheel-mode. +;; Mouse wheel support is already enabled by default on most graphical +;; displays. You can toggle it using `M-x mouse-wheel-mode'. ;;; Code: @@ -162,23 +162,18 @@ Also see `mouse-wheel-tilt-scroll'." :type 'boolean :version "26.1") -(eval-and-compile - (if (fboundp 'event-button) - (fset 'mwheel-event-button 'event-button) - (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)))) - - (if (fboundp 'event-window) - (fset 'mwheel-event-window 'event-window) - (defun mwheel-event-window (event) - (posn-window (event-start event))))) +(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))) + +(defun mwheel-event-window (event) + (posn-window (event-start event))) (defvar mwheel-inhibit-click-event-timer nil "Timer running while mouse wheel click event is inhibited.") @@ -360,6 +355,18 @@ This is a helper function for `mouse-wheel-mode'." (when (memq (lookup-key (current-global-map) key) funs) (global-unset-key key)))) +(defun mouse-wheel--create-scroll-keys (binding event) + "Return list of key vectors for BINDING and EVENT. +BINDING is an element in `mouse-wheel-scroll-amount'. EVENT is +an event used for scrolling, such as `mouse-wheel-down-event'." + (let ((prefixes (list 'left-margin 'right-margin + 'left-fringe 'right-fringe + 'vertical-scroll-bar 'horizontal-scroll-bar + 'mode-line 'header-line))) + (cons (vector event) ; default case: no prefix. + (when (not (consp binding)) + (mapcar (lambda (prefix) (vector prefix event)) prefixes))))) + (define-minor-mode mouse-wheel-mode "Toggle mouse wheel support (Mouse Wheel mode)." :init-value t @@ -384,14 +391,16 @@ This is a helper function for `mouse-wheel-mode'." ;; Bindings for changing font size. ((and (consp binding) (eq (cdr binding) 'text-scale)) (dolist (event (list mouse-wheel-down-event mouse-wheel-up-event)) + ;; Add binding. (let ((key `[,(list (caar binding) event)])) (global-set-key key 'mouse-wheel-text-scale) (push key mwheel-installed-text-scale-bindings)))) ;; Bindings for scrolling. (t (dolist (event (list mouse-wheel-down-event mouse-wheel-up-event - mouse-wheel-right-event mouse-wheel-left-event)) - (let ((key `[(,@(if (consp binding) (car binding)) ,event)])) + mouse-wheel-left-event mouse-wheel-right-event)) + (dolist (key (mouse-wheel--create-scroll-keys binding event)) + ;; Add binding. (global-set-key key 'mwheel-scroll) (push key mwheel-installed-bindings)))))))) |