diff options
| author | Stefan Monnier | 2002-06-27 21:46:45 +0000 |
|---|---|---|
| committer | Stefan Monnier | 2002-06-27 21:46:45 +0000 |
| commit | bb5d43feaa7fb2ba0a0a3841073faa51b3909ebf (patch) | |
| tree | d28ce8e1e6ba19ff557813f4ffada27f394539eb | |
| parent | b8b1b15e9a9bc708024ee61381d2c1c1c31ea27c (diff) | |
| download | emacs-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/ChangeLog | 11 | ||||
| -rw-r--r-- | lisp/mwheel.el | 62 |
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 | ||
| 25 | 2002-06-27 Stefan Monnier <monnier@cs.yale.edu> | 25 | 2002-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. |
| 111 | This can be slightly disconcerting, but some people prefer it." | 122 | This 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. |
| 136 | This should only be bound to mouse buttons 4 and 5." | 145 | This 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. | |||
| 166 | Returns non-nil if the new state is enabled." | 175 | Returns 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 | ||