Can specify different scroll amounts for different modifiers now.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index b679bd218e3c2dd0477d2e4738f65cd41f2ae77c..9ff7107dc0db981954f1aee8ce05da1ea311bb01 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,11 @@
+2002-02-19  Sam Steingold  <sds@gnu.org>
+
+       * mwheel.el (mouse-wheel-scroll-amount): Can specify different
+       scroll amounts for different modifiers now.
+       (mwheel-scroll): Handle the new `mouse-wheel-scroll-amount'
+       format properly.
+       (mouse-wheel-mode): Ditto.
+
 2002-02-19  Eli Zaretskii  <eliz@is.elta.co.il>
 
        * textmodes/bibtex.el (bibtex-parse-keys): Put save-match-data
@@ -208,11 +216,11 @@
        (describe-text-category): New command.
        (describe-text-at): New command.
        (facemenu-menu): Replace `list-text-properties-at' with
-       `describe-text-at' in the menu.  
-       
+       `describe-text-at' in the menu.
+
        * wid-edit.el (widgetp): New function.
        * wid-edit.el (widget-keymap, widget-insert, widget-setup):
-       Autoloaded. 
+       Autoloaded.
 
        * emacs-lisp/pp.el (pp-to-string): Autoloaded.
 
@@ -258,7 +266,7 @@
 
        * menu-bar.el (menu-bar-options-save): Removed `truncate-lines'.
        (menu-bar-options-menu): Don't set default value for
-       `truncate-lines'. 
+       `truncate-lines'.
 
 2002-02-12  Per Abrahamsen  <abraham@dina.kvl.dk>
 
@@ -294,14 +302,14 @@
        (menu-bar-showhide-menu): Ditto.
        (menu-bar-options-menu): Ditto.
        (menu-bar-scroll-bar-right, menu-bar-scroll-bar-left,
-       menu-bar-scroll-bar-none): Removed. 
+       menu-bar-scroll-bar-none): Removed.
        (menu-bar-showhide-scroll-bar-menu): Use customize aware lambda
        expressions instead.
 
        * cus-edit.el (customize-set-value): Return value.
        (customize-set-variable): Ditto.
        (customize-save-variable): Ditto.
-       (customize-set-variable): Load dependencies before setting value. 
+       (customize-set-variable): Load dependencies before setting value.
         (custom-load-symbol): Autoload it.
        (customize-mark-as-set): New function.
 
@@ -342,24 +350,24 @@
        toggling.
 
 2002-02-10  Michael Kifer  <kifer@cs.stonybrook.edu>
-       
+
        * viper-util.el (viper-read-key-sequence): fixed so it'll read
        fast key sequences in emacs native mode
        (viper-events-to-keys): deleted
-       
+
        * viper.el (describe-key, describe-key-briefly): get rid of
        viper-events-to-keys.
 
        * ediff-init.el (ediff-has-gutter-support): Steven Turnbull's patch.
-       
+
        * ediff-wind.el (ediff-setup-control-frame): Use
        ediff-has-gutter-support.
-       
+
        * ediff-util.el (ediff-dispose-of-variant-according-to-user):
        check if buff is alive.
-       
+
        * ediff.el: typo in comment.
-       
+
 2002-02-09  Pavel Jan\e,Bm\e(Bk  <Pavel@Janik.cz>
 
        * menu-bar.el (menu-bar-options-save): Take care of

diff --git a/lisp/mwheel.el b/lisp/mwheel.el
index 6f2fe95eb721bac44c78b46a581391074642cdc3..7cb5058e0637dafe3ce52429a6813966b15b905c 100644 (file)
--- a/lisp/mwheel.el
+++ b/lisp/mwheel.el
@@ -63,11 +63,11 @@
   :type 'integer
   :set 'mouse-wheel-change-button)
 
-(defcustom mouse-wheel-scroll-amount '(5 . 1)
+(defcustom mouse-wheel-scroll-amount '(5 ((shift) . 1) ((control) . nil))
   "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
-wheel is moved with the shift key depressed.
+on a normal wheel event, and the rest is an alist mapping the modifier key
+to the amount to scroll when the wheel is moved with the modifier key depressed.
 
 Each item should be the number of lines to scroll, or `nil' for near
 full screen.  It can also be a floating point number, specifying
@@ -79,10 +79,14 @@ 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")
                  (float :tag "Fraction of window"))
-         (choice :tag "Shifted"
-                 (const :tag "Full screen" :value nil)
-                 (integer :tag "Specific # of lines")
-                 (float :tag "Fraction of window"))))
+          (repeat
+           (cons
+            (repeat (choice :tag "modifier" (const alt) (const control) (const hyper)
+                            (const meta) (const shift) (const super)))
+            (choice :tag "scroll amount"
+                    (const :tag "Full screen" :value nil)
+                    (integer :tag "Specific # of lines")
+                    (float :tag "Fraction of window"))))))
 
 (defcustom mouse-wheel-progessive-speed t
   "If non-nil, the faster the user moves the wheel, the faster the scrolling.
@@ -114,13 +118,14 @@ This can be slightly disconcerting, but some people may prefer it."
   "Scroll up or down according to the EVENT.
 This should only be bound to mouse buttons 4 and 5."
   (interactive "e")
-  (let ((curwin (if mouse-wheel-follow-mouse
-                   (prog1
-                       (selected-window)
-                     (select-window (mwheel-event-window event)))))
-       (amt (if (memq 'shift (event-modifiers event))
-                (cdr mouse-wheel-scroll-amount)
-              (car mouse-wheel-scroll-amount))))
+  (let* ((curwin (if mouse-wheel-follow-mouse
+                     (prog1
+                         (selected-window)
+                       (select-window (mwheel-event-window event)))))
+         (mods (delete 'click (event-modifiers event)))
+         (amt (if mods
+                  (cdr (assoc mods (cdr mouse-wheel-scroll-amount)))
+                  (car mouse-wheel-scroll-amount))))
     (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,
@@ -145,16 +150,15 @@ 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 ((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])))))
+  (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)))
+         (keys
+          (nconc (list dn up)
+                 (mapcar (lambda (amt) `[(,@(car amt) ,up)])
+                         (cdr mouse-wheel-scroll-amount))
+                 (mapcar (lambda (amt) `[(,@(car amt) ,dn)])
+                         (cdr mouse-wheel-scroll-amount)))))
     ;; 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