aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--lisp/mwheel.el114
1 files changed, 62 insertions, 52 deletions
diff --git a/lisp/mwheel.el b/lisp/mwheel.el
index dfea55374b0..4862406fa19 100644
--- a/lisp/mwheel.el
+++ b/lisp/mwheel.el
@@ -237,7 +237,8 @@ non-Windows systems."
237 (window-point))) 237 (window-point)))
238 (mods 238 (mods
239 (delq 'click (delq 'double (delq 'triple (event-modifiers event))))) 239 (delq 'click (delq 'double (delq 'triple (event-modifiers event)))))
240 (amt (assoc mods mouse-wheel-scroll-amount))) 240 (amt (assoc mods mouse-wheel-scroll-amount))
241 saw-error)
241 (unless (eq scroll-window selected-window) 242 (unless (eq scroll-window selected-window)
242 ;; Mark window to be scrolled for redisplay. 243 ;; Mark window to be scrolled for redisplay.
243 (select-window scroll-window 'mark-for-redisplay)) 244 (select-window scroll-window 'mark-for-redisplay))
@@ -251,57 +252,66 @@ non-Windows systems."
251 ;; So by adding things up we get a squaring up (1, 3, 6, 10, 15, ...). 252 ;; So by adding things up we get a squaring up (1, 3, 6, 10, 15, ...).
252 (setq amt (* amt (event-click-count event)))) 253 (setq amt (* amt (event-click-count event))))
253 (when (numberp amt) (setq amt (* amt (event-line-count event)))) 254 (when (numberp amt) (setq amt (* amt (event-line-count event))))
254 (unwind-protect 255 (condition-case nil
255 (let ((button (mwheel-event-button event))) 256 (unwind-protect
256 (cond ((eq button mouse-wheel-down-event) 257 (let ((button (mwheel-event-button event)))
257 (condition-case nil (funcall mwheel-scroll-down-function amt) 258 (cond ((eq button mouse-wheel-down-event)
258 ;; Make sure we do indeed scroll to the beginning of 259 (condition-case nil (funcall mwheel-scroll-down-function amt)
259 ;; the buffer. 260 ;; Make sure we do indeed scroll to the beginning of
260 (beginning-of-buffer 261 ;; the buffer.
261 (unwind-protect 262 (beginning-of-buffer
262 (funcall mwheel-scroll-down-function) 263 (unwind-protect
263 ;; If the first scroll succeeded, then some scrolling 264 (funcall mwheel-scroll-down-function)
264 ;; is possible: keep scrolling til the beginning but 265 ;; If the first scroll succeeded, then some scrolling
265 ;; do not signal an error. For some reason, we have 266 ;; is possible: keep scrolling til the beginning but
266 ;; to do it even if the first scroll signaled an 267 ;; do not signal an error. For some reason, we have
267 ;; error, because otherwise the window is recentered 268 ;; to do it even if the first scroll signaled an
268 ;; for a reason that escapes me. This problem seems 269 ;; error, because otherwise the window is recentered
269 ;; to only affect scroll-down. --Stef 270 ;; for a reason that escapes me. This problem seems
270 (set-window-start (selected-window) (point-min)))))) 271 ;; to only affect scroll-down. --Stef
271 ((eq button mouse-wheel-up-event) 272 (set-window-start (selected-window) (point-min))))))
272 (condition-case nil (funcall mwheel-scroll-up-function amt) 273 ((eq button mouse-wheel-up-event)
273 ;; Make sure we do indeed scroll to the end of the buffer. 274 (condition-case nil (funcall mwheel-scroll-up-function amt)
274 (end-of-buffer (while t (funcall mwheel-scroll-up-function))))) 275 ;; Make sure we do indeed scroll to the end of the buffer.
275 ((eq button mouse-wheel-left-event) ; for tilt scroll 276 (end-of-buffer (while t (funcall mwheel-scroll-up-function)))))
276 (when mouse-wheel-tilt-scroll 277 ((eq button mouse-wheel-left-event) ; for tilt scroll
277 (funcall (if mouse-wheel-flip-direction 278 (when mouse-wheel-tilt-scroll
278 mwheel-scroll-right-function 279 (funcall (if mouse-wheel-flip-direction
279 mwheel-scroll-left-function) amt))) 280 mwheel-scroll-right-function
280 ((eq button mouse-wheel-right-event) ; for tilt scroll 281 mwheel-scroll-left-function) amt)))
281 (when mouse-wheel-tilt-scroll 282 ((eq button mouse-wheel-right-event) ; for tilt scroll
282 (funcall (if mouse-wheel-flip-direction 283 (when mouse-wheel-tilt-scroll
283 mwheel-scroll-left-function 284 (funcall (if mouse-wheel-flip-direction
284 mwheel-scroll-right-function) amt))) 285 mwheel-scroll-left-function
285 (t (error "Bad binding in mwheel-scroll")))) 286 mwheel-scroll-right-function) amt)))
286 (if (eq scroll-window selected-window) 287 (t (error "Bad binding in mwheel-scroll"))))
287 ;; If there is a temporarily active region, deactivate it if 288 (if (eq scroll-window selected-window)
288 ;; scrolling moved point. 289 ;; If there is a temporarily active region, deactivate it if
289 (when (and old-point (/= old-point (window-point))) 290 ;; scrolling moved point.
290 ;; Call `deactivate-mark' at the original position, so that 291 (when (and old-point (/= old-point (window-point)))
291 ;; the original region is saved to the X selection. 292 ;; Call `deactivate-mark' at the original position, so that
292 (let ((new-point (window-point))) 293 ;; the original region is saved to the X selection.
293 (goto-char old-point) 294 (let ((new-point (window-point)))
294 (deactivate-mark) 295 (goto-char old-point)
295 (goto-char new-point))) 296 (deactivate-mark)
296 (select-window selected-window t)))) 297 (goto-char new-point)))
297 298 (select-window selected-window t)))
298 (when (and mouse-wheel-click-event mouse-wheel-inhibit-click-time) 299 ;; Do not ding at buffer limits. Show a message instead.
299 (if mwheel-inhibit-click-event-timer 300 (beginning-of-buffer
300 (cancel-timer mwheel-inhibit-click-event-timer) 301 (message (error-message-string '(beginning-of-buffer)))
301 (add-hook 'pre-command-hook 'mwheel-filter-click-events)) 302 (setq saw-error t))
302 (setq mwheel-inhibit-click-event-timer 303 (end-of-buffer
303 (run-with-timer mouse-wheel-inhibit-click-time nil 304 (message (error-message-string '(end-of-buffer)))
304 'mwheel-inhibit-click-timeout)))) 305 (setq saw-error t)))
306
307 (when (and (not saw-error)
308 mouse-wheel-click-event mouse-wheel-inhibit-click-time)
309 (if mwheel-inhibit-click-event-timer
310 (cancel-timer mwheel-inhibit-click-event-timer)
311 (add-hook 'pre-command-hook 'mwheel-filter-click-events))
312 (setq mwheel-inhibit-click-event-timer
313 (run-with-timer mouse-wheel-inhibit-click-time nil
314 'mwheel-inhibit-click-timeout)))))
305 315
306(put 'mwheel-scroll 'scroll-command t) 316(put 'mwheel-scroll 'scroll-command t)
307 317