aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2002-06-24 23:59:22 +0000
committerStefan Monnier2002-06-24 23:59:22 +0000
commiteb4504e0b52c2cf1ccf78dba3d2fd2df0775ae0e (patch)
tree3d7b69fcfc52af5efd6ab80bdcb9b5aa8118065b
parentb81f379bd4592e41a730e42999d615799014fafb (diff)
downloademacs-eb4504e0b52c2cf1ccf78dba3d2fd2df0775ae0e.tar.gz
emacs-eb4504e0b52c2cf1ccf78dba3d2fd2df0775ae0e.zip
(mouse-wheel-scroll-amount, mwheel-scroll, mouse-wheel-mode):
Don't require the first element to be modifier-free.
-rw-r--r--lisp/mwheel.el53
1 files changed, 32 insertions, 21 deletions
diff --git a/lisp/mwheel.el b/lisp/mwheel.el
index 3fa83c27773..379e6d9d8ca 100644
--- a/lisp/mwheel.el
+++ b/lisp/mwheel.el
@@ -65,23 +65,33 @@
65 65
66(defcustom mouse-wheel-scroll-amount '(5 ((shift) . 1) ((control) . nil)) 66(defcustom mouse-wheel-scroll-amount '(5 ((shift) . 1) ((control) . nil))
67 "Amount to scroll windows by when spinning the mouse wheel. 67 "Amount to scroll windows by when spinning the mouse wheel.
68This is actually a cons cell, where the first item is the amount to scroll 68This is an alist mapping the modifier key to the amount to scroll when
69on a normal wheel event, and the rest is an alist mapping the modifier key 69the wheel is moved with the modifier key depressed.
70to the amount to scroll when the wheel is moved with the modifier key depressed. 70Elements of the list have the form (MODIFIERS . AMOUNT) or just AMOUNT if
71 71MODIFIERS is nil.
72Each item should be the number of lines to scroll, or `nil' for near 72
73full screen. It can also be a floating point number, specifying 73AMOUNT should be the number of lines to scroll, or `nil' for near full
74the fraction of the window to scroll. 74screen. It can also be a floating point number, specifying the fraction of
75A near full screen is `next-screen-context-lines' less than a full screen." 75a full screen to scroll. A near full screen is `next-screen-context-lines'
76less than a full screen."
76 :group 'mouse 77 :group 'mouse
77 :type '(cons 78 :type '(cons
78 (choice :tag "Normal" 79 (choice :tag "Normal"
79 (const :tag "Full screen" :value nil) 80 (const :tag "Full screen" :value nil)
80 (integer :tag "Specific # of lines") 81 (integer :tag "Specific # of lines")
81 (float :tag "Fraction of window")) 82 (float :tag "Fraction of window")
83 (cons
84 (repeat (choice :tag "modifier"
85 (const alt) (const control) (const hyper)
86 (const meta) (const shift) (const super)))
87 (choice :tag "scroll amount"
88 (const :tag "Full screen" :value nil)
89 (integer :tag "Specific # of lines")
90 (float :tag "Fraction of window"))))
82 (repeat 91 (repeat
83 (cons 92 (cons
84 (repeat (choice :tag "modifier" (const alt) (const control) (const hyper) 93 (repeat (choice :tag "modifier"
94 (const alt) (const control) (const hyper)
85 (const meta) (const shift) (const super))) 95 (const meta) (const shift) (const super)))
86 (choice :tag "scroll amount" 96 (choice :tag "scroll amount"
87 (const :tag "Full screen" :value nil) 97 (const :tag "Full screen" :value nil)
@@ -91,13 +101,14 @@ A near full screen is `next-screen-context-lines' less than a full screen."
91(defcustom mouse-wheel-progessive-speed t 101(defcustom mouse-wheel-progessive-speed t
92 "If non-nil, the faster the user moves the wheel, the faster the scrolling. 102 "If non-nil, the faster the user moves the wheel, the faster the scrolling.
93Note that this has no effect when `mouse-wheel-scroll-amount' specifies 103Note that this has no effect when `mouse-wheel-scroll-amount' specifies
94a \"near full screen\" scroll." 104a \"near full screen\" scroll or when the mouse wheel sends key instead
105of button events."
95 :group 'mouse 106 :group 'mouse
96 :type 'boolean) 107 :type 'boolean)
97 108
98(defcustom mouse-wheel-follow-mouse nil 109(defcustom mouse-wheel-follow-mouse nil
99 "Whether the mouse wheel should scroll the window that the mouse is over. 110 "Whether the mouse wheel should scroll the window that the mouse is over.
100This can be slightly disconcerting, but some people may prefer it." 111This can be slightly disconcerting, but some people prefer it."
101 :group 'mouse 112 :group 'mouse
102 :type 'boolean) 113 :type 'boolean)
103 114
@@ -130,10 +141,11 @@ This should only be bound to mouse buttons 4 and 5."
130 (select-window (mwheel-event-window event))))) 141 (select-window (mwheel-event-window event)))))
131 (mods 142 (mods
132 (delq 'click (delq 'double (delq 'triple (event-modifiers event))))) 143 (delq 'click (delq 'double (delq 'triple (event-modifiers event)))))
133 (amt 144 (amt (assoc mods mouse-wheel-scroll-amount)))
134 (if mods 145 ;; Extract the actual amount or find the element that has no modifiers.
135 (cdr (assoc mods (cdr mouse-wheel-scroll-amount))) 146 (if amt (setq amt (cdr amt))
136 (car mouse-wheel-scroll-amount)))) 147 (let ((list-elt mouse-wheel-scroll-amount))
148 (while (consp (setq amt (pop list-elt))))))
137 (if (floatp amt) (setq amt (1+ (truncate (* amt (window-height)))))) 149 (if (floatp amt) (setq amt (1+ (truncate (* amt (window-height))))))
138 (when (and mouse-wheel-progessive-speed (numberp amt)) 150 (when (and mouse-wheel-progessive-speed (numberp amt))
139 ;; When the double-mouse-N comes in, a mouse-N has been executed already, 151 ;; When the double-mouse-N comes in, a mouse-N has been executed already,
@@ -162,11 +174,10 @@ Returns non-nil if the new state is enabled."
162 (dn (intern (format prefix mouse-wheel-down-button))) 174 (dn (intern (format prefix mouse-wheel-down-button)))
163 (up (intern (format prefix mouse-wheel-up-button))) 175 (up (intern (format prefix mouse-wheel-up-button)))
164 (keys 176 (keys
165 (nconc (list (vector dn) (vector up)) 177 (nconc (mapcar (lambda (amt) `[(,@(if (consp amt) (car amt)) ,up)])
166 (mapcar (lambda (amt) `[(,@(car amt) ,up)]) 178 mouse-wheel-scroll-amount)
167 (cdr mouse-wheel-scroll-amount)) 179 (mapcar (lambda (amt) `[(,@(if (consp amt) (car amt)) ,dn)])
168 (mapcar (lambda (amt) `[(,@(car amt) ,dn)]) 180 mouse-wheel-scroll-amount))))
169 (cdr mouse-wheel-scroll-amount)))))
170 ;; This condition-case is here because Emacs 19 will throw an error 181 ;; This condition-case is here because Emacs 19 will throw an error
171 ;; if you try to define a key that it does not know about. I for one 182 ;; if you try to define a key that it does not know about. I for one
172 ;; prefer to just unconditionally do a mwheel-install in my .emacs, so 183 ;; prefer to just unconditionally do a mwheel-install in my .emacs, so