diff options
| author | Stefan Monnier | 2002-06-24 23:59:22 +0000 |
|---|---|---|
| committer | Stefan Monnier | 2002-06-24 23:59:22 +0000 |
| commit | eb4504e0b52c2cf1ccf78dba3d2fd2df0775ae0e (patch) | |
| tree | 3d7b69fcfc52af5efd6ab80bdcb9b5aa8118065b | |
| parent | b81f379bd4592e41a730e42999d615799014fafb (diff) | |
| download | emacs-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.el | 53 |
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. |
| 68 | This is actually a cons cell, where the first item is the amount to scroll | 68 | This is an alist mapping the modifier key to the amount to scroll when |
| 69 | on a normal wheel event, and the rest is an alist mapping the modifier key | 69 | the wheel is moved with the modifier key depressed. |
| 70 | to the amount to scroll when the wheel is moved with the modifier key depressed. | 70 | Elements of the list have the form (MODIFIERS . AMOUNT) or just AMOUNT if |
| 71 | 71 | MODIFIERS is nil. | |
| 72 | Each item should be the number of lines to scroll, or `nil' for near | 72 | |
| 73 | full screen. It can also be a floating point number, specifying | 73 | AMOUNT should be the number of lines to scroll, or `nil' for near full |
| 74 | the fraction of the window to scroll. | 74 | screen. It can also be a floating point number, specifying the fraction of |
| 75 | A near full screen is `next-screen-context-lines' less than a full screen." | 75 | a full screen to scroll. A near full screen is `next-screen-context-lines' |
| 76 | less 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. |
| 93 | Note that this has no effect when `mouse-wheel-scroll-amount' specifies | 103 | Note that this has no effect when `mouse-wheel-scroll-amount' specifies |
| 94 | a \"near full screen\" scroll." | 104 | a \"near full screen\" scroll or when the mouse wheel sends key instead |
| 105 | of 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. |
| 100 | This can be slightly disconcerting, but some people may prefer it." | 111 | This 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 |