aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2002-06-27 21:46:45 +0000
committerStefan Monnier2002-06-27 21:46:45 +0000
commitbb5d43feaa7fb2ba0a0a3841073faa51b3909ebf (patch)
treed28ce8e1e6ba19ff557813f4ffada27f394539eb
parentb8b1b15e9a9bc708024ee61381d2c1c1c31ea27c (diff)
downloademacs-bb5d43feaa7fb2ba0a0a3841073faa51b3909ebf.tar.gz
emacs-bb5d43feaa7fb2ba0a0a3841073faa51b3909ebf.zip
(mouse-wheel-change-button): Deactivate before changing.
(mouse-wheel-up-button, mouse-wheel-down-button): Obsolete. (mouse-wheel-up-event, mouse-wheel-down-event): New vars. (mouse-wheel-follow-mouse): Change default to t. (mwheel-event-button): Return the basic event symbol. (mwheel-scroll): Work with non-mouse events. (mouse-wheel-mode): Use the new vars. (mwheel-install): Obey `uninstall'.
-rw-r--r--lisp/ChangeLog11
-rw-r--r--lisp/mwheel.el62
2 files changed, 44 insertions, 29 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index a177827d11a..bdb479bc33c 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -24,6 +24,17 @@
24 24
252002-06-27 Stefan Monnier <monnier@cs.yale.edu> 252002-06-27 Stefan Monnier <monnier@cs.yale.edu>
26 26
27 * mwheel.el (mouse-wheel-change-button): Deactivate before changing.
28 (mouse-wheel-up-button, mouse-wheel-down-button): Obsolete.
29 (mouse-wheel-up-event, mouse-wheel-down-event): New vars.
30 (mouse-wheel-follow-mouse): Change default to t.
31 (mwheel-event-button): Return the basic event symbol.
32 (mwheel-scroll): Work with non-mouse events.
33 (mouse-wheel-mode): Use the new vars.
34 (mwheel-install): Obey `uninstall'.
35
36 * term/xterm.el (function-key-map): Add some bindings.
37
27 * uniquify.el (uniquify-delay-rationalize-file-buffer-names): 38 * uniquify.el (uniquify-delay-rationalize-file-buffer-names):
28 Rename from delay-uniquify-rationalize-file-buffer-names. 39 Rename from delay-uniquify-rationalize-file-buffer-names.
29 Only rationalize if the buffer is under uniquify control. 40 Only rationalize if the buffer is under uniquify control.
diff --git a/lisp/mwheel.el b/lisp/mwheel.el
index 379e6d9d8ca..ae764f4a69b 100644
--- a/lisp/mwheel.el
+++ b/lisp/mwheel.el
@@ -1,6 +1,6 @@
1;;; mwheel.el --- Mouse support for MS intelli-mouse type mice 1;;; mwheel.el --- Mouse support for MS intelli-mouse type mice
2 2
3;; Copyright (C) 1998, 2000, 2001 Free Software Foundation, Inc. 3;; Copyright (C) 1998,2000,2001,2002 Free Software Foundation, Inc.
4;; Maintainer: William M. Perry <wmperry@gnu.org> 4;; Maintainer: William M. Perry <wmperry@gnu.org>
5;; Keywords: mouse 5;; Keywords: mouse
6 6
@@ -46,21 +46,32 @@
46;; new button is bound to mwheel-scroll. 46;; new button is bound to mwheel-scroll.
47 47
48(defun mouse-wheel-change-button (var button) 48(defun mouse-wheel-change-button (var button)
49 (set-default var button) 49 (let ((active mouse-wheel-mode))
50 (when mouse-wheel-mode 50 ;; Deactivate before changing the setting.
51 (mouse-wheel-mode 0) 51 (when active (mouse-wheel-mode -1))
52 (mouse-wheel-mode 1))) 52 (set-default var button)
53 (when active (mouse-wheel-mode 1))))
53 54
54(defcustom mouse-wheel-down-button 4 55(defcustom mouse-wheel-down-button 4
55 "Mouse button number for scrolling down." 56 "Obsolete. Use `mouse-wheel-down-event'.")
57(defcustom mouse-wheel-down-event
58 ;; In the latest versions of XEmacs, we could just use mouse-%s as well.
59 (intern (format (if (featurep 'xemacs) "button%s" "mouse-%s")
60 mouse-wheel-down-button))
61 "Event used for scrolling down."
56 :group 'mouse 62 :group 'mouse
57 :type 'integer 63 :type 'symbol
58 :set 'mouse-wheel-change-button) 64 :set 'mouse-wheel-change-button)
59 65
60(defcustom mouse-wheel-up-button 5 66(defcustom mouse-wheel-up-button 5
61 "Mouse button number for scrolling up." 67 "Obsolete. Use `mouse-whell-up-event'.")
68(defcustom mouse-wheel-up-event
69 ;; In the latest versions of XEmacs, we could just use mouse-%s as well.
70 (intern (format (if (featurep 'xemacs) "button%s" "mouse-%s")
71 mouse-wheel-up-button))
72 "Event used for scrolling down."
62 :group 'mouse 73 :group 'mouse
63 :type 'integer 74 :type 'symbol
64 :set 'mouse-wheel-change-button) 75 :set 'mouse-wheel-change-button)
65 76
66(defcustom mouse-wheel-scroll-amount '(5 ((shift) . 1) ((control) . nil)) 77(defcustom mouse-wheel-scroll-amount '(5 ((shift) . 1) ((control) . nil))
@@ -106,7 +117,7 @@ of button events."
106 :group 'mouse 117 :group 'mouse
107 :type 'boolean) 118 :type 'boolean)
108 119
109(defcustom mouse-wheel-follow-mouse nil 120(defcustom mouse-wheel-follow-mouse t
110 "Whether the mouse wheel should scroll the window that the mouse is over. 121 "Whether the mouse wheel should scroll the window that the mouse is over.
111This can be slightly disconcerting, but some people prefer it." 122This can be slightly disconcerting, but some people prefer it."
112 :group 'mouse 123 :group 'mouse
@@ -114,16 +125,14 @@ This can be slightly disconcerting, but some people prefer it."
114 125
115(if (not (fboundp 'event-button)) 126(if (not (fboundp 'event-button))
116 (defun mwheel-event-button (event) 127 (defun mwheel-event-button (event)
117 (let ((x (symbol-name (event-basic-type event)))) 128 (let ((x (event-basic-type event)))
118 ;; Map mouse-wheel events to appropriate buttons 129 ;; Map mouse-wheel events to appropriate buttons
119 (if (string-equal "mouse-wheel" x) 130 (if (eq 'mouse-wheel x)
120 (let ((amount (car (cdr (cdr (cdr event)))))) 131 (let ((amount (car (cdr (cdr (cdr event))))))
121 (if (< amount 0) 132 (if (< amount 0)
122 mouse-wheel-up-button 133 mouse-wheel-up-event
123 mouse-wheel-down-button)) 134 mouse-wheel-down-event))
124 (if (not (string-match "^mouse-\\([0-9]+\\)" x)) 135 x)))
125 (error "Not a button event: %S" event)
126 (string-to-int (substring x (match-beginning 1) (match-end 1)))))))
127 (fset 'mwheel-event-button 'event-button)) 136 (fset 'mwheel-event-button 'event-button))
128 137
129(if (not (fboundp 'event-window)) 138(if (not (fboundp 'event-window))
@@ -134,7 +143,7 @@ This can be slightly disconcerting, but some people prefer it."
134(defun mwheel-scroll (event) 143(defun mwheel-scroll (event)
135 "Scroll up or down according to the EVENT. 144 "Scroll up or down according to the EVENT.
136This should only be bound to mouse buttons 4 and 5." 145This should only be bound to mouse buttons 4 and 5."
137 (interactive "e") 146 (interactive (list last-input-event))
138 (let* ((curwin (if mouse-wheel-follow-mouse 147 (let* ((curwin (if mouse-wheel-follow-mouse
139 (prog1 148 (prog1
140 (selected-window) 149 (selected-window)
@@ -149,12 +158,12 @@ This should only be bound to mouse buttons 4 and 5."
149 (if (floatp amt) (setq amt (1+ (truncate (* amt (window-height)))))) 158 (if (floatp amt) (setq amt (1+ (truncate (* amt (window-height))))))
150 (when (and mouse-wheel-progessive-speed (numberp amt)) 159 (when (and mouse-wheel-progessive-speed (numberp amt))
151 ;; When the double-mouse-N comes in, a mouse-N has been executed already, 160 ;; When the double-mouse-N comes in, a mouse-N has been executed already,
152 ;; So by adding things up we get a squaring up (1, 3, 6, 10, 16, ...). 161 ;; So by adding things up we get a squaring up (1, 3, 6, 10, 15, ...).
153 (setq amt (* amt (event-click-count event)))) 162 (setq amt (* amt (event-click-count event))))
154 (unwind-protect 163 (unwind-protect
155 (let ((button (mwheel-event-button event))) 164 (let ((button (mwheel-event-button event)))
156 (cond ((= button mouse-wheel-down-button) (scroll-down amt)) 165 (cond ((eq button mouse-wheel-down-event) (scroll-down amt))
157 ((= button mouse-wheel-up-button) (scroll-up amt)) 166 ((eq button mouse-wheel-up-event) (scroll-up amt))
158 (t (error "Bad binding in mwheel-scroll")))) 167 (t (error "Bad binding in mwheel-scroll"))))
159 (if curwin (select-window curwin))))) 168 (if curwin (select-window curwin)))))
160 169
@@ -166,13 +175,8 @@ With prefix argument ARG, turn on if positive, otherwise off.
166Returns non-nil if the new state is enabled." 175Returns non-nil if the new state is enabled."
167 :global t 176 :global t
168 :group 'mouse 177 :group 'mouse
169 ;; In the latest versions of XEmacs, we could just use 178 (let* ((dn mouse-wheel-down-event)
170 ;; (S-)*mouse-[45], since those are aliases for the button 179 (up mouse-wheel-up-event)
171 ;; equivalents in XEmacs, but I want this to work in as many
172 ;; versions of XEmacs as it can.
173 (let* ((prefix (if (featurep 'xemacs) "button%d" "mouse-%d"))
174 (dn (intern (format prefix mouse-wheel-down-button)))
175 (up (intern (format prefix mouse-wheel-up-button)))
176 (keys 180 (keys
177 (nconc (mapcar (lambda (amt) `[(,@(if (consp amt) (car amt)) ,up)]) 181 (nconc (mapcar (lambda (amt) `[(,@(if (consp amt) (car amt)) ,up)])
178 mouse-wheel-scroll-amount) 182 mouse-wheel-scroll-amount)
@@ -195,7 +199,7 @@ Returns non-nil if the new state is enabled."
195;;;###autoload 199;;;###autoload
196(defun mwheel-install (&optional uninstall) 200(defun mwheel-install (&optional uninstall)
197 "Enable mouse wheel support." 201 "Enable mouse wheel support."
198 (mouse-wheel-mode t)) 202 (mouse-wheel-mode (if uninstall -1 1)))
199 203
200(provide 'mwheel) 204(provide 'mwheel)
201 205