-;;; mwheel.el --- Mouse support for MS intelli-mouse type mice
+;;; mwheel.el --- Wheel mouse support
-;; Copyright (C) 1998, 2000, 2001 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2000, 2001, 2002, 2004 Free Software Foundation, Inc.
;; Maintainer: William M. Perry <wmperry@gnu.org>
;; Keywords: mouse
;; To enable this code, simply put this at the top of your .emacs
;; file:
;;
-;; (mwheel-install)
+;; (mouse-wheel-mode 1)
;;; Code:
(require 'custom)
+(require 'timer)
;; Setter function for mouse-button user-options. Switch Mouse Wheel
;; mode off and on again so that the old button is unbound and
;; new button is bound to mwheel-scroll.
(defun mouse-wheel-change-button (var button)
- (set-default var button)
- (when mouse-wheel-mode
- (mouse-wheel-mode 0)
- (mouse-wheel-mode 1)))
+ (let ((active mouse-wheel-mode))
+ ;; Deactivate before changing the setting.
+ (when active (mouse-wheel-mode -1))
+ (set-default var button)
+ (when active (mouse-wheel-mode 1))))
+
+(defvar mouse-wheel-down-button 4)
+(make-obsolete-variable 'mouse-wheel-down-button
+ 'mouse-wheel-down-event)
+(defcustom mouse-wheel-down-event
+ ;; In the latest versions of XEmacs, we could just use mouse-%s as well.
+ (if (memq window-system '(w32 mac))
+ 'wheel-up
+ (intern (format (if (featurep 'xemacs) "button%s" "mouse-%s")
+ mouse-wheel-down-button)))
+ "Event used for scrolling down."
+ :group 'mouse
+ :type 'symbol
+ :set 'mouse-wheel-change-button)
-(defcustom mouse-wheel-down-button 4
- "Mouse button number for scrolling down."
+(defvar mouse-wheel-up-button 5)
+(make-obsolete-variable 'mouse-wheel-up-button
+ 'mouse-wheel-up-event)
+(defcustom mouse-wheel-up-event
+ ;; In the latest versions of XEmacs, we could just use mouse-%s as well.
+ (if (memq window-system '(w32 mac))
+ 'wheel-down
+ (intern (format (if (featurep 'xemacs) "button%s" "mouse-%s")
+ mouse-wheel-up-button)))
+ "Event used for scrolling down."
:group 'mouse
- :type 'integer
+ :type 'symbol
:set 'mouse-wheel-change-button)
-(defcustom mouse-wheel-up-button 5
- "Mouse button number for scrolling up."
+(defvar mouse-wheel-click-button 2)
+(make-obsolete-variable 'mouse-wheel-click-button
+ 'mouse-wheel-click-event)
+(defcustom mouse-wheel-click-event
+ ;; In the latest versions of XEmacs, we could just use mouse-%s as well.
+ (intern (format (if (featurep 'xemacs) "button%s" "mouse-%s")
+ mouse-wheel-click-button))
+ "Event that should be temporarily inhibited after mouse scrolling.
+The mouse wheel is typically on the mouse-2 button, so it may easily
+happen that text is accidentially yanked into the buffer when
+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 'integer
+ :type 'symbol
: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."
+ :group 'mouse
+ :type 'number)
+
(defcustom mouse-wheel-scroll-amount '(5 ((shift) . 1) ((control) . nil))
"Amount to scroll windows by when spinning the mouse wheel.
This is an alist mapping the modifier key to the amount to scroll when
Elements of the list have the form (MODIFIERS . AMOUNT) or just AMOUNT if
MODIFIERS is nil.
-AMOUNT should be the number of lines to scroll, or `nil' for near full
+AMOUNT should be the number of lines to scroll, or nil for near full
screen. It can also be a floating point number, specifying the fraction of
a full screen to scroll. A near full screen is `next-screen-context-lines'
less than a full screen."
(integer :tag "Specific # of lines")
(float :tag "Fraction of window"))))))
-(defcustom mouse-wheel-progessive-speed t
+(defcustom mouse-wheel-progressive-speed t
"If non-nil, the faster the user moves the wheel, the faster the scrolling.
Note that this has no effect when `mouse-wheel-scroll-amount' specifies
a \"near full screen\" scroll or when the mouse wheel sends key instead
:group 'mouse
:type 'boolean)
-(defcustom mouse-wheel-follow-mouse nil
+(defcustom mouse-wheel-follow-mouse t
"Whether the mouse wheel should scroll the window that the mouse is over.
This can be slightly disconcerting, but some people prefer it."
:group 'mouse
(if (not (fboundp 'event-button))
(defun mwheel-event-button (event)
- (let ((x (symbol-name (event-basic-type event))))
+ (let ((x (event-basic-type event)))
;; Map mouse-wheel events to appropriate buttons
- (if (string-equal "mouse-wheel" x)
+ (if (eq 'mouse-wheel x)
(let ((amount (car (cdr (cdr (cdr event))))))
(if (< amount 0)
- mouse-wheel-up-button
- mouse-wheel-down-button))
- (if (not (string-match "^mouse-\\([0-9]+\\)" x))
- (error "Not a button event: %S" event)
- (string-to-int (substring x (match-beginning 1) (match-end 1)))))))
- (fset 'mwheel-event-button 'event-button))
+ mouse-wheel-up-event
+ mouse-wheel-down-event))
+ x)))
+ (fset 'mwheel-event-button 'event-button))
(if (not (fboundp 'event-window))
(defun mwheel-event-window (event)
(posn-window (event-start event)))
(fset 'mwheel-event-window 'event-window))
+(defvar mwheel-inhibit-click-event-timer nil
+ "Timer running while mouse wheel click event is inhibited.")
+
+(defun mwheel-inhibit-click-timeout ()
+ "Handler for `mwheel-inhibit-click-event-timer'."
+ (setq mwheel-inhibit-click-event-timer nil)
+ (remove-hook 'pre-command-hook 'mwheel-filter-click-events))
+
+(defun mwheel-filter-click-events ()
+ "Discard `mouse-wheel-click-event' while scrolling the mouse."
+ (if (eq (event-basic-type last-input-event) mouse-wheel-click-event)
+ (setq this-command 'ignore)))
+
(defun mwheel-scroll (event)
"Scroll up or down according to the EVENT.
This should only be bound to mouse buttons 4 and 5."
- (interactive "e")
+ (interactive (list last-input-event))
(let* ((curwin (if mouse-wheel-follow-mouse
(prog1
(selected-window)
(let ((list-elt mouse-wheel-scroll-amount))
(while (consp (setq amt (pop list-elt))))))
(if (floatp amt) (setq amt (1+ (truncate (* amt (window-height))))))
- (when (and mouse-wheel-progessive-speed (numberp amt))
+ (when (and mouse-wheel-progressive-speed (numberp amt))
;; When the double-mouse-N comes in, a mouse-N has been executed already,
- ;; So by adding things up we get a squaring up (1, 3, 6, 10, 16, ...).
+ ;; So by adding things up we get a squaring up (1, 3, 6, 10, 15, ...).
(setq amt (* amt (event-click-count event))))
(unwind-protect
(let ((button (mwheel-event-button event)))
- (cond ((= button mouse-wheel-down-button) (scroll-down amt))
- ((= button mouse-wheel-up-button) (scroll-up amt))
+ (cond ((eq button mouse-wheel-down-event) (scroll-down amt))
+ ((eq button mouse-wheel-up-event) (scroll-up amt))
(t (error "Bad binding in mwheel-scroll"))))
- (if curwin (select-window curwin)))))
-
+ (if curwin (select-window curwin))))
+ (when (and mouse-wheel-click-event mouse-wheel-inhibit-click-time)
+ (if mwheel-inhibit-click-event-timer
+ (cancel-timer mwheel-inhibit-click-event-timer)
+ (add-hook 'pre-command-hook 'mwheel-filter-click-events))
+ (setq mwheel-inhibit-click-event-timer
+ (run-with-timer mouse-wheel-inhibit-click-time nil
+ 'mwheel-inhibit-click-timeout))))
;;;###autoload
(define-minor-mode mouse-wheel-mode
Returns non-nil if the new state is enabled."
:global t
:group 'mouse
- ;; In the latest versions of XEmacs, we could just use
- ;; (S-)*mouse-[45], since those are aliases for the button
- ;; equivalents in XEmacs, but I want this to work in as many
- ;; versions of XEmacs as it can.
- (let* ((prefix (if (featurep 'xemacs) "button%d" "mouse-%d"))
- (dn (intern (format prefix mouse-wheel-down-button)))
- (up (intern (format prefix mouse-wheel-up-button)))
+ (let* ((dn mouse-wheel-down-event)
+ (up mouse-wheel-up-event)
(keys
(nconc (mapcar (lambda (amt) `[(,@(if (consp amt) (car amt)) ,up)])
mouse-wheel-scroll-amount)
;;;###autoload
(defun mwheel-install (&optional uninstall)
"Enable mouse wheel support."
- (mouse-wheel-mode t))
+ (mouse-wheel-mode (if uninstall -1 1)))
(provide 'mwheel)
+;; arch-tag: 50ed00e7-3686-4b7a-8037-fb31aa5c237f
;;; mwheel.el ends here
HCoop / bpt / emacs.git / blobdiff