# HG changeset patch # User Stefan Monnier # Date 1025214342 0 # Node ID 99487f98aaa7cb16612effc950bcec1c39d104a1 # Parent 3f4640971880db89d0976d06e06d5f4038b0accb (mouse-wheel-change-button): Deactivate before changing. (mouse-wheel-up-button, mouse-wheel-down-button): Obsolete. (mouse-wheel-up-event, mouse-wheel-down-event): New vars. (mouse-wheel-follow-mouse): Change default to t. (mwheel-event-button): Return the basic event symbol. (mwheel-scroll): Work with non-mouse events. (mouse-wheel-mode): Use the new vars. (mwheel-install): Obey `uninstall'. diff -r 3f4640971880 -r 99487f98aaa7 lisp/mwheel.el --- a/lisp/mwheel.el Thu Jun 27 21:38:52 2002 +0000 +++ b/lisp/mwheel.el Thu Jun 27 21:45:42 2002 +0000 @@ -1,6 +1,6 @@ ;;; mwheel.el --- Mouse support for MS intelli-mouse type mice -;; Copyright (C) 1998, 2000, 2001 Free Software Foundation, Inc. +;; Copyright (C) 1998,2000,2001,2002 Free Software Foundation, Inc. ;; Maintainer: William M. Perry ;; Keywords: mouse @@ -46,21 +46,32 @@ ;; 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)))) (defcustom mouse-wheel-down-button 4 - "Mouse button number for scrolling down." + "Obsolete. Use `mouse-wheel-down-event'.") +(defcustom mouse-wheel-down-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-down-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." + "Obsolete. Use `mouse-whell-up-event'.") +(defcustom mouse-wheel-up-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-up-button)) + "Event used for scrolling down." :group 'mouse - :type 'integer + :type 'symbol :set 'mouse-wheel-change-button) (defcustom mouse-wheel-scroll-amount '(5 ((shift) . 1) ((control) . nil)) @@ -106,7 +117,7 @@ :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 @@ -114,16 +125,14 @@ (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))))))) + mouse-wheel-up-event + mouse-wheel-down-event)) + x))) (fset 'mwheel-event-button 'event-button)) (if (not (fboundp 'event-window)) @@ -134,7 +143,7 @@ (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) @@ -149,12 +158,12 @@ (if (floatp amt) (setq amt (1+ (truncate (* amt (window-height)))))) (when (and mouse-wheel-progessive-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))))) @@ -166,13 +175,8 @@ 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) @@ -195,7 +199,7 @@ ;;;###autoload (defun mwheel-install (&optional uninstall) "Enable mouse wheel support." - (mouse-wheel-mode t)) + (mouse-wheel-mode (if uninstall -1 1))) (provide 'mwheel)