Minor fixes for text of help-echo in some options.

[gnu-emacs] / lisp / mwheel.el

diff --git a/lisp/mwheel.el b/lisp/mwheel.el
index e7519cbfb6663da858aa2771f7cffaf114c7177b..461ae41575b05a26ed68f46e9e3d846b6ec0049c 100644 (file)
--- a/lisp/mwheel.el
+++ b/lisp/mwheel.el
@@ -1,6 +1,6 @@
 ;;; mwheel.el --- Mouse support for MS intelli-mouse type mice
 
-;; Copyright (C) 1998, Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2000, 2001 Free Software Foundation, Inc.
 ;; Maintainer: William M. Perry <wmperry@gnu.org>
 ;; Keywords: mouse
 
@@ -41,7 +41,29 @@
 
 (require 'custom)
 
-(defcustom mwheel-scroll-amount '(5 . 1)
+;; 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)))
+
+(defcustom mouse-wheel-down-button 4
+  "Mouse button number for scrolling down."
+  :group 'mouse
+  :type 'integer
+  :set 'mouse-wheel-change-button)
+
+(defcustom mouse-wheel-up-button 5
+  "Mouse button number for scrolling up."
+  :group 'mouse
+  :type 'integer
+  :set 'mouse-wheel-change-button)
+
+(defcustom mouse-wheel-scroll-amount '(5 . 1)
   "Amount to scroll windows by when spinning the mouse wheel.
 This is actually a cons cell, where the first item is the amount to scroll
 on a normal wheel event, and the second is the amount to scroll when the
@@ -59,7 +81,7 @@ A near full screen is `next-screen-context-lines' less than a full screen."
                  (const :tag "Full screen" :value nil)
                  (integer :tag "Specific # of lines"))))
 
-(defcustom mwheel-follow-mouse nil
+(defcustom mouse-wheel-follow-mouse nil
   "Whether the mouse wheel should scroll the window that the mouse is over.
 This can be slightly disconcerting, but some people may prefer it."
   :group 'mouse
@@ -80,17 +102,17 @@ This can be slightly disconcerting, but some people may prefer it."
 
 (defun mwheel-scroll (event)
   (interactive "e")
-  (let ((curwin (if mwheel-follow-mouse
+  (let ((curwin (if mouse-wheel-follow-mouse
                    (prog1
                        (selected-window)
                      (select-window (mwheel-event-window event)))))
        (amt (if (memq 'shift (event-modifiers event))
-                (cdr mwheel-scroll-amount)
-              (car mwheel-scroll-amount))))
+                (cdr mouse-wheel-scroll-amount)
+              (car mouse-wheel-scroll-amount))))
     (unwind-protect
        (let ((button (mwheel-event-button event)))
-         (cond ((= button 4) (scroll-down amt))
-               ((= button 5) (scroll-up amt))
+         (cond ((= button mouse-wheel-down-button) (scroll-down amt))
+               ((= button mouse-wheel-up-button) (scroll-up amt))
                (t (error "Bad binding in mwheel-scroll"))))
       (if curwin (select-window curwin)))))
 
@@ -110,10 +132,16 @@ Returns non-nil if the new state is enabled."
   ;; (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* ((mwheel-running-xemacs (string-match "XEmacs" (emacs-version)))
-        (keys (if mwheel-running-xemacs
-                  '(button4 [(shift button4)] button5 [(shift button5)])
-                '([mouse-4] [S-mouse-4] [mouse-5] [S-mouse-5]))))
+  (let ((keys
+        (if (featurep 'xemacs)
+            (let ((down (intern (format "button%d" mouse-wheel-down-button)))
+                  (up (intern (format "button%d" mouse-wheel-up-button))))
+              `(,down [(shift ,down)] ,up [(shift ,up)]))
+          (let ((down (intern (format "mouse-%d" mouse-wheel-down-button)))
+                (s-down (intern (format "S-mouse-%d" mouse-wheel-down-button)))
+                (up (intern (format "mouse-%d" mouse-wheel-up-button)))
+                (s-up (intern (format "S-mouse-%d" mouse-wheel-up-button))))
+            `([,down] [,s-down] [,up] [,s-up])))))
     ;; This condition-case is here because Emacs 19 will throw an error
     ;; if you try to define a key that it does not know about.  I for one
     ;; prefer to just unconditionally do a mwheel-install in my .emacs, so
@@ -133,7 +161,6 @@ Returns non-nil if the new state is enabled."
   "Enable mouse wheel support."
   (mouse-wheel-mode t))
 
-
 (provide 'mwheel)
 
 ;;; mwheel.el ends here