emacs/lisp/mwheel.el

1 ;;; mwheel.el --- Wheel mouse support
6 ;; Keywords: mouse
39 ;; (mouse-wheel-mode 1)
43 (require 'custom)
46 ;; Setter function for mouse-button user-options.  Switch Mouse Wheel
47 ;; mode off and on again so that the old button is unbound and
48 ;; new button is bound to mwheel-scroll.
50 (defun mouse-wheel-change-button (var button)
51   (let ((active mouse-wheel-mode))
53     (when active (mouse-wheel-mode -1))
54     (set-default var button)
55     (when active (mouse-wheel-mode 1))))
57 (defvar mouse-wheel-down-button 4)
58 (make-obsolete-variable 'mouse-wheel-down-button
59                         'mouse-wheel-down-event)
60 (defcustom mouse-wheel-down-event
61   ;; In the latest versions of XEmacs, we could just use mouse-%s as well.
64     (intern (format (if (featurep 'xemacs) "button%s" "mouse-%s")
65 		    mouse-wheel-down-button)))
67   :group 'mouse
69   :set 'mouse-wheel-change-button)
71 (defvar mouse-wheel-up-button 5)
72 (make-obsolete-variable 'mouse-wheel-up-button
73                         'mouse-wheel-up-event)
74 (defcustom mouse-wheel-up-event
75   ;; In the latest versions of XEmacs, we could just use mouse-%s as well.
78     (intern (format (if (featurep 'xemacs) "button%s" "mouse-%s")
79 		    mouse-wheel-up-button)))
81   :group 'mouse
83   :set 'mouse-wheel-change-button)
85 (defvar mouse-wheel-click-button 2)
86 (make-obsolete-variable 'mouse-wheel-click-button
87                         'mouse-wheel-click-event)
88 (defcustom mouse-wheel-click-event
89   ;; In the latest versions of XEmacs, we could just use mouse-%s as well.
90   (intern (format (if (featurep 'xemacs) "button%s" "mouse-%s")
91 		  mouse-wheel-click-button))
92   "Event that should be temporarily inhibited after mouse scrolling.
93 The mouse wheel is typically on the mouse-2 button, so it may easily
95 scrolling with the mouse wheel.  To prevent that, this variable can be
96 set to the event sent when clicking on the mouse wheel button."
97   :group 'mouse
99   :set 'mouse-wheel-change-button)
101 (defcustom mouse-wheel-inhibit-click-time 0.35
102   "Time in seconds to inhibit clicking on mouse wheel button after scroll."
103   :group 'mouse
106 (defcustom mouse-wheel-scroll-amount '(5 ((shift) . 1) ((control) . nil))
107   "Amount to scroll windows by when spinning the mouse wheel.
117   :group 'mouse
141 (defcustom mouse-wheel-progressive-speed t
143 Note that this has no effect when `mouse-wheel-scroll-amount' specifies
144 a \"near full screen\" scroll or when the mouse wheel sends key instead
145 of button events."
146   :group 'mouse
149 (defcustom mouse-wheel-follow-mouse t
150   "Whether the mouse wheel should scroll the window that the mouse is over.
152   :group 'mouse
155 (if (not (fboundp 'event-button))
156     (defun mwheel-event-button (event)
158 	;; Map mouse-wheel events to appropriate buttons
159 	(if (eq 'mouse-wheel x)
162 		  mouse-wheel-up-event
163 		mouse-wheel-down-event))
165   (fset 'mwheel-event-button 'event-button))
173   "Timer running while mouse wheel click event is inhibited.")
181   "Discard `mouse-wheel-click-event' while scrolling the mouse."
182   (if (eq (event-basic-type last-input-event) mouse-wheel-click-event)
187 This should only be bound to mouse buttons 4 and 5."
189   (let* ((curwin (if mouse-wheel-follow-mouse
195          (amt (assoc mods mouse-wheel-scroll-amount)))
198       (let ((list-elt mouse-wheel-scroll-amount))
201     (when (and mouse-wheel-progressive-speed (numberp amt))
202       ;; When the double-mouse-N comes in, a mouse-N has been executed already,
206 	(let ((button (mwheel-event-button event)))
207 	  (cond ((eq button mouse-wheel-down-event)
222 		((eq button mouse-wheel-up-event)
228   (when (and mouse-wheel-click-event mouse-wheel-inhibit-click-time)
233 	  (run-with-timer mouse-wheel-inhibit-click-time nil
237 (define-minor-mode mouse-wheel-mode
238   "Toggle mouse wheel support.
242   :group 'mouse
243   (let* ((dn mouse-wheel-down-event)
244          (up mouse-wheel-up-event)
247 			 mouse-wheel-scroll-amount)
249 			 mouse-wheel-scroll-amount))))
253     ;; that if the wheeled-mouse is there, it just works, and this way it
257 	  (cond (mouse-wheel-mode
266   "Enable mouse wheel support."
267   (mouse-wheel-mode (if uninstall -1 1)))