;;; mwheel.el --- Wheel mouse support
-;; Copyright (C) 1998, 2000, 2001, 2002, 2002, 2004, 2005, 2006, 2007,
-;; 2008, 2009 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2000-2011 Free Software Foundation, Inc.
;; Maintainer: William M. Perry <wmperry@gnu.org>
;; Keywords: mouse
+;; Package: emacs
;; This file is part of GNU Emacs.
(require 'custom)
(require 'timer)
+(defvar mouse-wheel-mode)
+
;; Setter function for mouse-button user-options. Switch Mouse Wheel
;; mode off and on again so that the old button is unbound and
;; new button is bound to mwheel-scroll.
(defun mouse-wheel-change-button (var button)
(set-default var button)
;; Sync the bindings.
- (when mouse-wheel-mode (mouse-wheel-mode 1)))
+ (when (bound-and-true-p mouse-wheel-mode) (mouse-wheel-mode 1)))
(defvar mouse-wheel-down-button 4)
(make-obsolete-variable 'mouse-wheel-down-button
(choice :tag "scroll amount"
(const :tag "Full screen" :value nil)
(integer :tag "Specific # of lines")
- (float :tag "Fraction of window"))))))
+ (float :tag "Fraction of window")))))
+ :set 'mouse-wheel-change-button)
(defcustom mouse-wheel-progressive-speed t
"If non-nil, the faster the user moves the wheel, the faster the scrolling.
(if (eq (event-basic-type last-input-event) mouse-wheel-click-event)
(setq this-command 'ignore)))
+(defvar mwheel-scroll-up-function 'scroll-up
+ "Function that does the job of scrolling upward.")
+
+(defvar mwheel-scroll-down-function 'scroll-down
+ "Function that does the job of scrolling downward.")
+
(defun mwheel-scroll (event)
"Scroll up or down according to the EVENT.
This should only be bound to mouse buttons 4 and 5."
(unwind-protect
(let ((button (mwheel-event-button event)))
(cond ((eq button mouse-wheel-down-event)
- (condition-case nil (scroll-down amt)
+ (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
- (scroll-down)
+ (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 only affect scroll-down. --Stef
(set-window-start (selected-window) (point-min))))))
((eq button mouse-wheel-up-event)
- (condition-case nil (scroll-up amt)
+ (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 (scroll-up)))))
+ (end-of-buffer (while t (funcall mwheel-scroll-up-function)))))
(t (error "Bad binding in mwheel-scroll"))))
(if curwin (select-window curwin)))
;; If there is a temporarily active region, deactivate it iff
(run-with-timer mouse-wheel-inhibit-click-time nil
'mwheel-inhibit-click-timeout))))
+(put 'mwheel-scroll 'scroll-command t)
+
(defvar mwheel-installed-bindings nil)
-;;;###autoload
+;; preloaded ;;;###autoload
(define-minor-mode mouse-wheel-mode
"Toggle mouse wheel support.
With prefix argument ARG, turn on if positive, otherwise off.
(push key mwheel-installed-bindings)))))
;;; Compatibility entry point
-;;;###autoload
+;; preloaded ;;;###autoload
(defun mwheel-install (&optional uninstall)
"Enable mouse wheel support."
(mouse-wheel-mode (if uninstall -1 1)))
(provide 'mwheel)
-;; arch-tag: 50ed00e7-3686-4b7a-8037-fb31aa5c237f
;;; mwheel.el ends here