* lisp/dired-x.el: Use easymenu for menu items. Fix item capitalization.

[gnu-emacs] / lisp / mwheel.el

diff --git a/lisp/mwheel.el b/lisp/mwheel.el
index 31e26c14487f8d61b56f217ddfaf95753fb0ec7d..4ead168b18822bb1b187cb2486de7a30f078ab6f 100644 (file)
--- a/lisp/mwheel.el
+++ b/lisp/mwheel.el
@@ -1,9 +1,9 @@
 ;;; mwheel.el --- Wheel mouse support
 
-;; Copyright (C) 1998, 2000, 2001, 2002, 2002, 2004, 2005, 2006, 2007,
-;;   2008, 2009  Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2000-2011  Free Software Foundation, Inc.
 ;; Maintainer: William M. Perry <wmperry@gnu.org>
 ;; Keywords: mouse
+;; Package: emacs
 
 ;; This file is part of GNU Emacs.
 
@@ -41,7 +41,7 @@
 (require 'custom)
 (require 'timer)
 
-(defvar mouse-wheel-mode nil)
+(defvar mouse-wheel-mode)
 
 ;; Setter function for mouse-button user-options.  Switch Mouse Wheel
 ;; mode off and on again so that the old button is unbound and
@@ -50,7 +50,7 @@
 (defun mouse-wheel-change-button (var button)
   (set-default var button)
   ;; Sync the bindings.
-  (when mouse-wheel-mode (mouse-wheel-mode 1)))
+  (when (bound-and-true-p mouse-wheel-mode) (mouse-wheel-mode 1)))
 
 (defvar mouse-wheel-down-button 4)
 (make-obsolete-variable 'mouse-wheel-down-button
@@ -131,7 +131,8 @@ less than a full screen."
             (choice :tag "scroll amount"
                     (const :tag "Full screen" :value nil)
                     (integer :tag "Specific # of lines")
-                    (float :tag "Fraction of window"))))))
+                    (float :tag "Fraction of window")))))
+  :set 'mouse-wheel-change-button)
 
 (defcustom mouse-wheel-progressive-speed t
   "If non-nil, the faster the user moves the wheel, the faster the scrolling.
@@ -178,6 +179,12 @@ This can be slightly disconcerting, but some people prefer it."
   (if (eq (event-basic-type last-input-event) mouse-wheel-click-event)
       (setq this-command 'ignore)))
 
+(defvar mwheel-scroll-up-function 'scroll-up
+  "Function that does the job of scrolling upward.")
+
+(defvar mwheel-scroll-down-function 'scroll-down
+  "Function that does the job of scrolling downward.")
+
 (defun mwheel-scroll (event)
   "Scroll up or down according to the EVENT.
 This should only be bound to mouse buttons 4 and 5."
@@ -205,12 +212,12 @@ This should only be bound to mouse buttons 4 and 5."
     (unwind-protect
        (let ((button (mwheel-event-button event)))
          (cond ((eq button mouse-wheel-down-event)
-                 (condition-case nil (scroll-down amt)
+                 (condition-case nil (funcall mwheel-scroll-down-function amt)
                    ;; Make sure we do indeed scroll to the beginning of
                    ;; the buffer.
                    (beginning-of-buffer
                     (unwind-protect
-                        (scroll-down)
+                        (funcall mwheel-scroll-down-function)
                       ;; If the first scroll succeeded, then some scrolling
                       ;; is possible: keep scrolling til the beginning but
                       ;; do not signal an error.  For some reason, we have
@@ -220,9 +227,9 @@ This should only be bound to mouse buttons 4 and 5."
                       ;; to only affect scroll-down.  --Stef
                       (set-window-start (selected-window) (point-min))))))
                ((eq button mouse-wheel-up-event)
-                 (condition-case nil (scroll-up amt)
+                 (condition-case nil (funcall mwheel-scroll-up-function amt)
                    ;; Make sure we do indeed scroll to the end of the buffer.
-                   (end-of-buffer (while t (scroll-up)))))
+                   (end-of-buffer (while t (funcall mwheel-scroll-up-function)))))
                (t (error "Bad binding in mwheel-scroll"))))
       (if curwin (select-window curwin)))
     ;; If there is a temporarily active region, deactivate it iff
@@ -239,8 +246,11 @@ This should only be bound to mouse buttons 4 and 5."
          (run-with-timer mouse-wheel-inhibit-click-time nil
                          'mwheel-inhibit-click-timeout))))
 
+(put 'mwheel-scroll 'scroll-command t)
+
 (defvar mwheel-installed-bindings nil)
 
+;; preloaded ;;;###autoload
 (define-minor-mode mouse-wheel-mode
   "Toggle mouse wheel support.
 With prefix argument ARG, turn on if positive, otherwise off.
@@ -267,12 +277,11 @@ Return non-nil if the new state is enabled."
         (push key mwheel-installed-bindings)))))
 
 ;;; Compatibility entry point
-;;;###autoload
+;; preloaded ;;;###autoload
 (defun mwheel-install (&optional uninstall)
   "Enable mouse wheel support."
   (mouse-wheel-mode (if uninstall -1 1)))
 
 (provide 'mwheel)
 
-;; arch-tag: 50ed00e7-3686-4b7a-8037-fb31aa5c237f
 ;;; mwheel.el ends here