Mercurial > emacs
comparison lisp/mwheel.el @ 46001:5133c42d55cc
(mouse-wheel-scroll-amount, mwheel-scroll, mouse-wheel-mode):
Don't require the first element to be modifier-free.
| author | Stefan Monnier <monnier@iro.umontreal.ca> |
|---|---|
| date | Mon, 24 Jun 2002 23:59:22 +0000 |
| parents | 65253ed28734 |
| children | 99487f98aaa7 |
comparison
equal
deleted
inserted
replaced
| 46000:5af6af67f95a | 46001:5133c42d55cc |
|---|---|
| 63 :type 'integer | 63 :type 'integer |
| 64 :set 'mouse-wheel-change-button) | 64 :set 'mouse-wheel-change-button) |
| 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) |
| 88 (integer :tag "Specific # of lines") | 98 (integer :tag "Specific # of lines") |
| 89 (float :tag "Fraction of window")))))) | 99 (float :tag "Fraction of window")))))) |
| 90 | 100 |
| 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 |
| 104 (if (not (fboundp 'event-button)) | 115 (if (not (fboundp 'event-button)) |
| 105 (defun mwheel-event-button (event) | 116 (defun mwheel-event-button (event) |
| 128 (prog1 | 139 (prog1 |
| 129 (selected-window) | 140 (selected-window) |
| 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, |
| 140 ;; So by adding things up we get a squaring up (1, 3, 6, 10, 16, ...). | 152 ;; So by adding things up we get a squaring up (1, 3, 6, 10, 16, ...). |
| 141 (setq amt (* amt (event-click-count event)))) | 153 (setq amt (* amt (event-click-count event)))) |
| 160 ;; versions of XEmacs as it can. | 172 ;; versions of XEmacs as it can. |
| 161 (let* ((prefix (if (featurep 'xemacs) "button%d" "mouse-%d")) | 173 (let* ((prefix (if (featurep 'xemacs) "button%d" "mouse-%d")) |
| 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 |
| 173 ;; that if the wheeled-mouse is there, it just works, and this way it | 184 ;; that if the wheeled-mouse is there, it just works, and this way it |
| 174 ;; doesn't yell at me if I'm on my laptop or another machine, etc. | 185 ;; doesn't yell at me if I'm on my laptop or another machine, etc. |