X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/943949149f666ddd4569f12f620059176eb9b777..27422a9d8a01ea0658d689be824936674bb20d6e:/lisp/mwheel.el diff --git a/lisp/mwheel.el b/lisp/mwheel.el index b2c0c0bdda..391ce3a5e0 100644 --- a/lisp/mwheel.el +++ b/lisp/mwheel.el @@ -1,6 +1,7 @@ -;;; mwheel.el --- Mouse support for MS intelli-mouse type mice +;;; mwheel.el --- Wheel mouse support -;; Copyright (C) 1998,2000,2001,2002 Free Software Foundation, Inc. +;; Copyright (C) 1998, 2000, 2001, 2002, 2002, 2004, +;; 2005 Free Software Foundation, Inc. ;; Maintainer: William M. Perry ;; Keywords: mouse @@ -18,8 +19,8 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: @@ -35,11 +36,12 @@ ;; 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 @@ -52,28 +54,55 @@ (set-default var button) (when active (mouse-wheel-mode 1)))) -(defcustom mouse-wheel-down-button 4 - "Obsolete. Use `mouse-wheel-down-event'.") +(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. - (intern (format (if (featurep 'xemacs) "button%s" "mouse-%s") - mouse-wheel-down-button)) + (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-up-button 5 - "Obsolete. Use `mouse-wheel-up-event'.") +(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. - (intern (format (if (featurep 'xemacs) "button%s" "mouse-%s") - mouse-wheel-up-button)) + (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 'symbol :set 'mouse-wheel-change-button) +(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 '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 @@ -81,7 +110,7 @@ the wheel is moved with the modifier key depressed. 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." @@ -109,7 +138,7 @@ 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 @@ -140,6 +169,19 @@ This can be slightly disconcerting, but some people prefer it." (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." @@ -156,7 +198,7 @@ This should only be bound to mouse buttons 4 and 5." (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, 15, ...). (setq amt (* amt (event-click-count event)))) @@ -165,8 +207,14 @@ This should only be bound to mouse buttons 4 and 5." (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 @@ -203,4 +251,5 @@ Returns non-nil if the new state is enabled." (provide 'mwheel) +;; arch-tag: 50ed00e7-3686-4b7a-8037-fb31aa5c237f ;;; mwheel.el ends here