;;; mwheel.el --- Wheel mouse support
-;; Copyright (C) 1998,2000,2001,2002 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 2000, 2001, 2002, 2002, 2004,
+;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Maintainer: William M. Perry <wmperry@gnu.org>
;; Keywords: mouse
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; To enable this code, simply put this at the top of your .emacs
;; file:
;;
-;; (mwheel-install)
+;; (mouse-wheel-mode 1)
;;; Code:
(set-default var button)
(when active (mouse-wheel-mode 1))))
-(defvar mouse-wheel-down-button 4
- "Obsolete. Use `mouse-wheel-down-event'.")
+(defvar mouse-wheel-down-button 4)
+(make-obsolete-variable 'mouse-wheel-down-button
+ 'mouse-wheel-down-event)
(defcustom mouse-wheel-down-event
;; In the latest versions of XEmacs, we could just use mouse-%s as well.
- (intern (format (if (featurep 'xemacs) "button%s" "mouse-%s")
- mouse-wheel-down-button))
+ (if (memq window-system '(w32 mac))
+ 'wheel-up
+ (intern (format (if (featurep 'xemacs) "button%s" "mouse-%s")
+ mouse-wheel-down-button)))
"Event used for scrolling down."
:group 'mouse
:type 'symbol
:set 'mouse-wheel-change-button)
-(defvar mouse-wheel-up-button 5
- "Obsolete. Use `mouse-wheel-up-event'.")
+(defvar mouse-wheel-up-button 5)
+(make-obsolete-variable 'mouse-wheel-up-button
+ 'mouse-wheel-up-event)
(defcustom mouse-wheel-up-event
;; In the latest versions of XEmacs, we could just use mouse-%s as well.
- (intern (format (if (featurep 'xemacs) "button%s" "mouse-%s")
- mouse-wheel-up-button))
- "Event used for scrolling down."
+ (if (memq window-system '(w32 mac))
+ 'wheel-down
+ (intern (format (if (featurep 'xemacs) "button%s" "mouse-%s")
+ mouse-wheel-up-button)))
+ "Event used for scrolling up."
:group 'mouse
:type 'symbol
:set 'mouse-wheel-change-button)
-(defvar mouse-wheel-click-button 2
- "Obsolete. Use `mouse-wheel-click-event'.")
+(defvar mouse-wheel-click-button 2)
+(make-obsolete-variable 'mouse-wheel-click-button
+ 'mouse-wheel-click-event)
(defcustom mouse-wheel-click-event
;; In the latest versions of XEmacs, we could just use mouse-%s as well.
(intern (format (if (featurep 'xemacs) "button%s" "mouse-%s")
mouse-wheel-click-button))
"Event that should be temporarily inhibited after mouse scrolling.
The mouse wheel is typically on the mouse-2 button, so it may easily
-happen that text is accidentially yanked into the buffer when
+happen that text is accidentally yanked into the buffer when
scrolling with the mouse wheel. To prevent that, this variable can be
set to the event sent when clicking on the mouse wheel button."
:group 'mouse
Elements of the list have the form (MODIFIERS . AMOUNT) or just AMOUNT if
MODIFIERS is nil.
-AMOUNT should be the number of lines to scroll, or `nil' for near full
+AMOUNT should be the number of lines to scroll, or nil for near full
screen. It can also be a floating point number, specifying the fraction of
a full screen to scroll. A near full screen is `next-screen-context-lines'
less than a full screen."
(choice :tag "Normal"
(const :tag "Full screen" :value nil)
(integer :tag "Specific # of lines")
- (number :tag "Fraction of window")
+ (float :tag "Fraction of window")
(cons
(repeat (choice :tag "modifier"
(const alt) (const control) (const hyper)
(choice :tag "scroll amount"
(const :tag "Full screen" :value nil)
(integer :tag "Specific # of lines")
- (number :tag "Fraction of window"))))
+ (float :tag "Fraction of window"))))
(repeat
(cons
(repeat (choice :tag "modifier"
(choice :tag "scroll amount"
(const :tag "Full screen" :value nil)
(integer :tag "Specific # of lines")
- (number :tag "Fraction of window"))))))
+ (float :tag "Fraction of window"))))))
-(defcustom mouse-wheel-progessive-speed t
+(defcustom mouse-wheel-progressive-speed t
"If non-nil, the faster the user moves the wheel, the faster the scrolling.
Note that this has no effect when `mouse-wheel-scroll-amount' specifies
a \"near full screen\" scroll or when the mouse wheel sends key instead
(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-progessive-speed (numberp amt))
+ (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))))
(unwind-protect
(let ((button (mwheel-event-button event)))
- (cond ((eq button mouse-wheel-down-event) (scroll-down amt))
- ((eq button mouse-wheel-up-event) (scroll-up amt))
+ (cond ((eq button mouse-wheel-down-event)
+ (condition-case nil (scroll-down amt)
+ ;; Make sure we do indeed scroll to the beginning of
+ ;; the buffer.
+ (beginning-of-buffer
+ (unwind-protect
+ (scroll-down)
+ ;; 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 signalled 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))))))
+ ((eq button mouse-wheel-up-event)
+ (condition-case nil (scroll-up amt)
+ ;; Make sure we do indeed scroll to the end of the buffer.
+ (end-of-buffer (while t (scroll-up)))))
(t (error "Bad binding in mwheel-scroll"))))
(if curwin (select-window curwin))))
(when (and 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
+ (setq mwheel-inhibit-click-event-timer
(run-with-timer mouse-wheel-inhibit-click-time nil
'mwheel-inhibit-click-timeout))))
(define-minor-mode mouse-wheel-mode
"Toggle mouse wheel support.
With prefix argument ARG, turn on if positive, otherwise off.
-Returns non-nil if the new state is enabled."
+Return non-nil if the new state is enabled."
:global t
:group 'mouse
(let* ((dn mouse-wheel-down-event)
(provide 'mwheel)
+;; arch-tag: 50ed00e7-3686-4b7a-8037-fb31aa5c237f
;;; mwheel.el ends here