Function: mwheel-scroll

mwheel-scroll is an interactive and byte-compiled function defined in mwheel.el.gz.

Signature

(mwheel-scroll EVENT &optional ARG)

Documentation

Scroll up or down according to the EVENT.

This should be bound only to mouse buttons 4, 5, 6, and 7 on non-Windows systems.

Optional argument ARG (interactively, prefix numeric argument) controls the step of horizontal scrolling.

The variable mouse-wheel-scroll-amount-horizontal records the last value of ARG, and the command uses it in subsequent scrolls.

Key Bindings

Source Code

;; Defined in /usr/src/emacs/lisp/mwheel.el.gz
(defun mwheel-scroll (event &optional arg)
  "Scroll up or down according to the EVENT.
This should be bound only to mouse buttons 4, 5, 6, and 7 on
non-Windows systems.

Optional argument ARG (interactively, prefix numeric argument) controls
the step of horizontal scrolling.

The variable `mouse-wheel-scroll-amount-horizontal' records the last
value of ARG, and the command uses it in subsequent scrolls."
  (interactive (list last-input-event current-prefix-arg))
  (let* ((selected-window (selected-window))
         (scroll-window (mouse-wheel--get-scroll-window event))
	 (old-point
          (and (eq scroll-window selected-window)
	       (eq (car-safe transient-mark-mode) 'only)
	       (window-point)))
         (mods
	  (delq 'click (delq 'double (delq 'triple (event-modifiers event)))))
         (amt (assoc mods mouse-wheel-scroll-amount))
         saw-error)
    (unless (eq scroll-window selected-window)
      ;; Mark window to be scrolled for redisplay.
      (select-window scroll-window 'mark-for-redisplay))
    ;; Extract the actual amount or find the element that has no modifiers.
    (if amt (setq amt (cdr amt))
      (let ((list-elt mouse-wheel-scroll-amount))
	(while (consp (setq amt (pop list-elt))))))
    (if (floatp amt) (setq amt (1+ (truncate (* amt (window-height))))))
    (when (and mouse-wheel-progressive-speed (numberp amt))
      ;; When the double-mouse-N comes in, a mouse-N has been executed already,
      ;; So by adding things up we get a squaring up (1, 3, 6, 10, 15, ...).
      (setq amt (* amt (event-click-count event))))
    (when (numberp amt) (setq amt (* amt (event-line-count event))))
    (condition-case nil
        (unwind-protect
	    (let ((button (event-basic-type event)))
              (cond ((and (eq amt 'hscroll) (mwheel--is-dir-p down button))
                     (when (and (natnump arg) (> arg 0))
                       (setq mouse-wheel-scroll-amount-horizontal arg))
                     (funcall (if mouse-wheel-flip-direction
                                  mwheel-scroll-left-function
                                mwheel-scroll-right-function)
                              mouse-wheel-scroll-amount-horizontal))
                    ((mwheel--is-dir-p down button)
                     (condition-case nil
                         (funcall mwheel-scroll-down-function amt)
                       ;; Make sure we do indeed scroll to the beginning of
                       ;; the buffer.
                       (beginning-of-buffer
                        (unwind-protect
                            (funcall mwheel-scroll-down-function)
                          ;; If the first scroll succeeded, then some scrolling
                          ;; is possible: keep scrolling til the beginning but
                          ;; do not signal an error.  For some reason, we have
                          ;; to do it even if the first scroll signaled an
                          ;; error, because otherwise the window is recentered
                          ;; for a reason that escapes me.  This problem seems
                          ;; to only affect scroll-down.  --Stef
                          (set-window-start (selected-window) (point-min))))))
                    ((and (eq amt 'hscroll) (mwheel--is-dir-p up button))
                     (when (and (natnump arg) (> arg 0))
                       (setq mouse-wheel-scroll-amount-horizontal arg))
                     (funcall (if mouse-wheel-flip-direction
                                  mwheel-scroll-right-function
                                mwheel-scroll-left-function)
                              mouse-wheel-scroll-amount-horizontal))
                    ((mwheel--is-dir-p up button)
                     (condition-case nil (funcall mwheel-scroll-up-function amt)
                       ;; Make sure we do indeed scroll to the end of the buffer.
                       (end-of-buffer
                        (while t (funcall mwheel-scroll-up-function)))))
                    ((mwheel--is-dir-p left button) ; for tilt scroll
                     (when mouse-wheel-tilt-scroll
                       (funcall (if mouse-wheel-flip-direction
                                    mwheel-scroll-right-function
                                  mwheel-scroll-left-function)
                                amt)))
                    ((mwheel--is-dir-p right button) ; for tilt scroll
                     (when mouse-wheel-tilt-scroll
                       (funcall (if mouse-wheel-flip-direction
                                    mwheel-scroll-left-function
                                  mwheel-scroll-right-function)
                                amt)))
		    (t (error "Bad binding in mwheel-scroll"))))
          (if (eq scroll-window selected-window)
              ;; If there is a temporarily active region, deactivate it if
              ;; scrolling moved point.
	      (when (and old-point (/= old-point (window-point)))
                ;; Call `deactivate-mark' at the original position, so that
                ;; the original region is saved to the X selection.
                (let ((new-point (window-point)))
                  (goto-char old-point)
                  (deactivate-mark)
                  (goto-char new-point)))
	    (select-window selected-window t)))
      ;; Do not ding at buffer limits.  Show a message instead.
      (beginning-of-buffer
       (message (error-message-string '(beginning-of-buffer)))
       (setq saw-error t))
      (end-of-buffer
       (message (error-message-string '(end-of-buffer)))
       (setq saw-error t)))

    (when (and (not saw-error)
               mouse-wheel-click-event mouse-wheel-inhibit-click-time)
      (if mwheel-inhibit-click-event-timer
          (cancel-timer mwheel-inhibit-click-event-timer)
        (add-hook 'pre-command-hook 'mwheel-filter-click-events))
      (setq mwheel-inhibit-click-event-timer
            (run-with-timer mouse-wheel-inhibit-click-time nil
                            'mwheel-inhibit-click-timeout)))))