Function: x-dnd-mwheel-scroll
x-dnd-mwheel-scroll is a byte-compiled function defined in
x-dnd.el.gz.
Signature
(x-dnd-mwheel-scroll BUTTON COUNT MODIFIERS)
Documentation
Call the appropriate wheel scrolling function for BUTTON.
Use MODIFIERS, an X modifier mask, to determine if any alternative operation (such as scrolling horizontally) should be taken. COUNT is the number of times in quick succession BUTTON has been pressed.
Source Code
;; Defined in /usr/src/emacs/lisp/x-dnd.el.gz
(defun x-dnd-mwheel-scroll (button count modifiers)
"Call the appropriate wheel scrolling function for BUTTON.
Use MODIFIERS, an X modifier mask, to determine if any
alternative operation (such as scrolling horizontally) should be
taken. COUNT is the number of times in quick succession BUTTON
has been pressed."
(let* ((type (x-dnd-wheel-modifier-type modifiers))
(hscroll (eq type 'hscroll))
(amt (or (and (not mouse-wheel-progressive-speed) 1)
(* 1 count))))
(unless (and (not mouse-wheel-tilt-scroll)
(or (eq button 6) (eq button 7)))
(let ((function (cond ((eq type 'text-scale)
#'text-scale-adjust)
((eq type 'global-text-scale)
#'global-text-scale-adjust)
((eq button 4)
(if hscroll
mwheel-scroll-right-function
mwheel-scroll-down-function))
((eq button 5)
(if hscroll
mwheel-scroll-left-function
mwheel-scroll-up-function))
((eq button 6)
(if mouse-wheel-flip-direction
mwheel-scroll-right-function
mwheel-scroll-left-function))
((eq button 7)
(if mouse-wheel-flip-direction
mwheel-scroll-left-function
mwheel-scroll-right-function)))))
;; Button5 should decrease the text scale, not increase it.
(when (and (memq type '(text-scale global-text-scale))
(eq button 5))
(setq amt (- amt)))
(when function
(condition-case nil
;; Don't overwrite any echo-area message that might
;; already be shown, since this can be called from
;; `x-begin-drag'.
(let ((inhibit-message t))
(funcall function amt))
;; Do not error at buffer limits. Show a message instead.
;; This is especially important here because signaling an
;; error will mess up the drag-and-drop operation.
(beginning-of-buffer
(message (error-message-string '(beginning-of-buffer))))
(end-of-buffer
(message (error-message-string '(end-of-buffer))))))))))