Commit | Line | Data |
---|---|---|
092af6d8 RS |
1 | ;;; mouse-drag.el --- use mouse-2 to do a new style of scrolling |
2 | ||
0d30b337 | 3 | ;; Copyright (C) 1996, 1997, 2001, 2002, 2003, 2004, |
aaef169d | 4 | ;; 2005, 2006 Free Software Foundation, Inc. |
84f19a49 | 5 | |
bc28b212 RS |
6 | ;; Author: John Heidemann <johnh@ISI.EDU> |
7 | ;; Keywords: mouse | |
84f19a49 RS |
8 | |
9 | ;; This file is part of GNU Emacs. | |
10 | ||
11 | ;; GNU Emacs is free software; you can redistribute it and/or modify | |
12 | ;; it under the terms of the GNU General Public License as published by | |
13 | ;; the Free Software Foundation; either version 2, or (at your option) | |
14 | ;; any later version. | |
15 | ||
16 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 | ;; GNU General Public License for more details. | |
20 | ||
21 | ;; You should have received a copy of the GNU General Public License | |
22 | ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
086add15 LK |
23 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
24 | ;; Boston, MA 02110-1301, USA. | |
84f19a49 RS |
25 | |
26 | ;;; Commentary: | |
27 | ||
28 | ;;; What is ``mouse-drag.el''? | |
29 | ;;; | |
30 | ;;; Doesn't that scroll bar seem far away when you want to scroll? | |
31 | ;;; This module overloads mouse-2 to do ``throw'' scrolling. You | |
32 | ;;; click and drag. The distance you move from your original click | |
33 | ;;; turns into a scroll amount. The scroll amount is scaled | |
34 | ;;; exponentially to make both large moves and short adjustments easy. | |
35 | ;;; What this boils down to is that you can easily scroll around the | |
36 | ;;; buffer without much mouse movement. Finally, clicks which aren't | |
37 | ;;; drags are passed off to the old mouse-2 binding, so old mouse-2 | |
38 | ;;; operations (find-file in dired-mode, yanking in most other modes) | |
39 | ;;; still work. | |
40 | ;;; | |
41 | ;;; There is an alternative way to scroll, ``drag'' scrolling. You | |
42 | ;;; can click on a character and then drag it around, scrolling the | |
43 | ;;; buffer with you. The character always stays under the mouse. | |
44 | ;;; Compared to throw-scrolling, this approach provides direct | |
45 | ;;; manipulation (nice) but requires more mouse movement | |
46 | ;;; (unfortunate). It is offered as an alternative for those who | |
47 | ;;; prefer it. | |
48 | ;;; | |
49 | ;;; If you like mouse-drag, you should also check out mouse-copy | |
50 | ;;; for ``one-click text copy and move''. | |
51 | ;;; | |
52 | ;;; To use mouse-drag, place the following in your .emacs file: | |
53 | ;;; (require 'mouse-drag) | |
54 | ;;; -and either- | |
55 | ;;; (global-set-key [down-mouse-2] 'mouse-drag-throw) | |
56 | ;;; -or- | |
57 | ;;; (global-set-key [down-mouse-2] 'mouse-drag-drag) | |
58 | ;;; | |
59 | ;;; | |
60 | ;;; | |
61 | ;;; Options: | |
62 | ;;; | |
63 | ;;; - reverse the throw-scroll direction with \\[mouse-throw-with-scroll-bar] | |
64 | ;;; - work around a bug with \\[mouse-extras-work-around-drag-bug] | |
351d52f7 KH |
65 | ;;; - auto-enable horizontal scrolling with |
66 | ;;; \\[mouse-drag-electric-col-scrolling] | |
84f19a49 RS |
67 | ;;; |
68 | ;;; | |
69 | ;;; History and related work: | |
70 | ;;; | |
71 | ;;; One-click copying and moving was inspired by lemacs-19.8. | |
72 | ;;; Throw-scrolling was inspired by MacPaint's ``hand'' and by Tk's | |
73 | ;;; mouse-2 scrolling. The package mouse-scroll.el by Tom Wurgler | |
74 | ;;; <twurgler@goodyear.com> is similar to mouse-drag-throw, but | |
75 | ;;; doesn't pass clicks through. | |
76 | ;;; | |
77 | ;;; These functions have been tested in emacs version 19.30, | |
78 | ;;; and this package has run in the past on 19.25-19.29. | |
79 | ;;; | |
80 | ;;; Originally mouse-drag was part of a larger package. | |
81 | ;;; As of 11 July 96 the scrolling functions were split out | |
82 | ;;; in preparation for incorporation into (the future) emacs-19.32. | |
83 | ;;; | |
84 | ;;; | |
85 | ;;; Thanks: | |
86 | ;;; | |
87 | ;;; Thanks to Kai Grossjohann | |
88 | ;;; <grossjoh@dusty.informatik.uni-dortmund.de> for reporting bugs, to | |
89 | ;;; Tom Wurgler <twurgler@goodyear.com> for reporting bugs and | |
90 | ;;; suggesting fixes, and to Joel Graber <jgraber@ti.com> for | |
91 | ;;; prompting me to do drag-scrolling and for an initial | |
92 | ;;; implementation of horizontal drag-scrolling. | |
93 | ;;; | |
94 | ;;; -johnh@isi.edu, 11-Jul-96 | |
95 | ;;; | |
96 | ;;; | |
351d52f7 | 97 | ;;; What's new with mouse-drag 2.24? |
84f19a49 | 98 | ;;; |
351d52f7 KH |
99 | ;;; - mouse-drag-electric-col-scrolling (default: on) |
100 | ;;; auto-enables horizontal scrolling when clicks on wrapped | |
101 | ;;; lines occur | |
84f19a49 RS |
102 | \f |
103 | ;;; Code: | |
104 | ||
105 | ;; | |
106 | ;; scrolling code | |
107 | ;; | |
108 | ||
109 | (defun mouse-drag-safe-scroll (row-delta &optional col-delta) | |
8c398124 | 110 | "Scroll down ROW-DELTA lines and right COL-DELTA, ignoring buffer edge errors. |
84f19a49 | 111 | Keep the cursor on the screen as needed." |
f1ade7d3 GM |
112 | (let ((scroll-preserve-screen-position nil)) |
113 | (if (and row-delta | |
114 | (/= 0 row-delta)) | |
115 | (condition-case nil ;; catch and ignore movement errors | |
116 | (scroll-down row-delta) | |
117 | (beginning-of-buffer (message "Beginning of buffer")) | |
118 | (end-of-buffer (message "End of buffer")))) | |
119 | (if (and col-delta | |
120 | (/= 0 col-delta)) | |
121 | (progn | |
122 | (scroll-right col-delta) | |
123 | ;; Make sure that the point stays on the visible screen | |
124 | ;; (if truncation-lines in set). | |
125 | ;; This code mimics the behavior we automatically get | |
126 | ;; when doing vertical scrolling. | |
127 | ;; Problem identified and a fix suggested by Tom Wurgler. | |
128 | (cond | |
129 | ((< (current-column) (window-hscroll)) | |
130 | (move-to-column (window-hscroll))) ; make on left column | |
131 | ((> (- (current-column) (window-hscroll) (window-width) -2) 0) | |
132 | (move-to-column (+ (window-width) (window-hscroll) -3)))))))) | |
84f19a49 RS |
133 | |
134 | (defun mouse-drag-repeatedly-safe-scroll (row-delta &optional col-delta) | |
8c398124 | 135 | "Scroll ROW-DELTA rows and COL-DELTA cols until an event happens." |
84f19a49 RS |
136 | (while (sit-for mouse-scroll-delay) |
137 | (mouse-drag-safe-scroll row-delta col-delta))) | |
138 | ||
139 | (defun mouse-drag-events-are-point-events-p (start-posn end-posn) | |
8c398124 | 140 | "Determine if START-POSN and END-POSN are \"close\"." |
84f19a49 RS |
141 | (let* |
142 | ((start-col-row (posn-col-row start-posn)) | |
143 | (end-col-row (posn-col-row end-posn))) | |
144 | (and | |
145 | ;; We no longer exclude things by time. | |
146 | ;; (< (- (posn-timestamp end-posn) (posn-timestamp start-posn)) | |
147 | ;; (if (numberp double-click-time) | |
148 | ;; (* 2 double-click-time) ;; stretch it a little | |
149 | ;; 999999)) ;; non-numeric => check by position alone | |
150 | (= (car start-col-row) (car end-col-row)) | |
151 | (= (cdr start-col-row) (cdr end-col-row))))) | |
152 | ||
351d52f7 KH |
153 | (defvar mouse-drag-electric-col-scrolling t |
154 | "If non-nil, mouse-drag on a long line enables truncate-lines.") | |
155 | ||
84f19a49 | 156 | (defun mouse-drag-should-do-col-scrolling () |
8c398124 | 157 | "Determine if it's wise to enable col-scrolling for the current window. |
351d52f7 | 158 | Basically, we check for existing horizontal scrolling." |
84f19a49 RS |
159 | (or truncate-lines |
160 | (> (window-hscroll (selected-window)) 0) | |
f36782bc | 161 | (< (window-width) (frame-width)) |
351d52f7 KH |
162 | (and |
163 | mouse-drag-electric-col-scrolling | |
164 | (save-excursion ;; on a long line? | |
165 | (let | |
166 | ((beg (progn (beginning-of-line) (point))) | |
167 | (end (progn (end-of-line) (point)))) | |
168 | (if (> (- end beg) (window-width)) | |
169 | (setq truncate-lines t) | |
170 | nil)))))) | |
84f19a49 RS |
171 | |
172 | (defvar mouse-throw-with-scroll-bar nil | |
8c398124 | 173 | "*Set direction of mouse-throwing. |
84f19a49 RS |
174 | If nil, the text moves in the direction the mouse moves. |
175 | If t, the scroll bar moves in the direction the mouse moves.") | |
8c398124 | 176 | (defconst mouse-throw-magnifier-with-scroll-bar |
84f19a49 RS |
177 | [-16 -8 -4 -2 -1 0 0 0 1 2 4 8 16]) |
178 | (defconst mouse-throw-magnifier-with-mouse-movement | |
179 | [ 16 8 4 2 1 0 0 0 -1 -2 -4 -8 -16]) | |
180 | (defconst mouse-throw-magnifier-min -6) | |
181 | (defconst mouse-throw-magnifier-max 6) | |
182 | ||
183 | (defun mouse-drag-throw (start-event) | |
184 | "\"Throw\" the page according to a mouse drag. | |
185 | ||
186 | A \"throw\" is scrolling the page at a speed relative to the distance | |
187 | from the original mouse click to the current mouse location. Try it; | |
188 | you'll like it. It's easier to observe than to explain. | |
189 | ||
190 | If the mouse is clicked and released in the same place of time we | |
191 | assume that the user didn't want to scdebugroll but wanted to whatever | |
192 | mouse-2 used to do, so we pass it through. | |
193 | ||
194 | Throw scrolling was inspired (but is not identical to) the \"hand\" | |
195 | option in MacPaint, or the middle button in Tk text widgets. | |
196 | ||
197 | If `mouse-throw-with-scroll-bar' is non-nil, then this command scrolls | |
198 | in the opposite direction. (Different people have different ideas | |
199 | about which direction is natural. Perhaps it has to do with which | |
200 | hemisphere you're in.) | |
201 | ||
202 | To test this function, evaluate: | |
203 | (global-set-key [down-mouse-2] 'mouse-drag-throw)" | |
204 | (interactive "e") | |
205 | ;; we want to do save-selected-window, but that requires 19.29 | |
206 | (let* ((start-posn (event-start start-event)) | |
207 | (start-window (posn-window start-posn)) | |
208 | (start-row (cdr (posn-col-row start-posn))) | |
209 | (start-col (car (posn-col-row start-posn))) | |
210 | (old-selected-window (selected-window)) | |
211 | event end row mouse-delta scroll-delta | |
e35afc97 | 212 | have-scrolled |
84f19a49 RS |
213 | window-last-row |
214 | col mouse-col-delta window-last-col | |
215 | (scroll-col-delta 0) | |
216 | adjusted-mouse-col-delta | |
4ebeb09d | 217 | adjusted-mouse-delta |
84f19a49 RS |
218 | ;; be conservative about allowing horizontal scrolling |
219 | (col-scrolling-p (mouse-drag-should-do-col-scrolling))) | |
220 | (select-window start-window) | |
221 | (track-mouse | |
222 | (while (progn | |
223 | (setq event (read-event) | |
224 | end (event-end event) | |
225 | row (cdr (posn-col-row end)) | |
226 | col (car (posn-col-row end))) | |
227 | (or (mouse-movement-p event) | |
228 | (eq (car-safe event) 'switch-frame))) | |
229 | (if (eq start-window (posn-window end)) | |
230 | (progn | |
231 | (setq mouse-delta (- start-row row) | |
232 | adjusted-mouse-delta | |
233 | (- (cond | |
234 | ((<= mouse-delta mouse-throw-magnifier-min) | |
235 | mouse-throw-magnifier-min) | |
236 | ((>= mouse-delta mouse-throw-magnifier-max) | |
237 | mouse-throw-magnifier-max) | |
238 | (t mouse-delta)) | |
239 | mouse-throw-magnifier-min) | |
240 | scroll-delta (aref (if mouse-throw-with-scroll-bar | |
241 | mouse-throw-magnifier-with-scroll-bar | |
242 | mouse-throw-magnifier-with-mouse-movement) | |
243 | adjusted-mouse-delta)) | |
244 | (if col-scrolling-p | |
245 | (setq mouse-col-delta (- start-col col) | |
246 | adjusted-mouse-col-delta | |
247 | (- (cond | |
248 | ((<= mouse-col-delta mouse-throw-magnifier-min) | |
249 | mouse-throw-magnifier-min) | |
250 | ((>= mouse-col-delta mouse-throw-magnifier-max) | |
251 | mouse-throw-magnifier-max) | |
252 | (t mouse-col-delta)) | |
253 | mouse-throw-magnifier-min) | |
254 | scroll-col-delta (aref (if mouse-throw-with-scroll-bar | |
255 | mouse-throw-magnifier-with-scroll-bar | |
256 | mouse-throw-magnifier-with-mouse-movement) | |
257 | adjusted-mouse-col-delta))))) | |
258 | (if (or (/= 0 scroll-delta) | |
259 | (/= 0 scroll-col-delta)) | |
260 | (progn | |
261 | (setq have-scrolled t) | |
262 | (mouse-drag-safe-scroll scroll-delta scroll-col-delta) | |
263 | (mouse-drag-repeatedly-safe-scroll scroll-delta scroll-col-delta))))) ;xxx | |
264 | ;; If it was a click and not a drag, prepare to pass the event on. | |
e35afc97 | 265 | ;; Is there a more correct way to reconstruct the event? |
84f19a49 RS |
266 | (if (and (not have-scrolled) |
267 | (mouse-drag-events-are-point-events-p start-posn end)) | |
e35afc97 RS |
268 | (push (cons (event-basic-type start-event) (cdr start-event)) |
269 | unread-command-events)) | |
84f19a49 | 270 | ;; Now restore the old window. |
e35afc97 | 271 | (select-window old-selected-window))) |
84f19a49 RS |
272 | |
273 | (defun mouse-drag-drag (start-event) | |
274 | "\"Drag\" the page according to a mouse drag. | |
275 | ||
276 | Drag scrolling moves the page according to the movement of the mouse. | |
277 | You \"grab\" the character under the mouse and move it around. | |
278 | ||
279 | If the mouse is clicked and released in the same place of time we | |
280 | assume that the user didn't want to scroll but wanted to whatever | |
281 | mouse-2 used to do, so we pass it through. | |
282 | ||
283 | Drag scrolling is identical to the \"hand\" option in MacPaint, or the | |
284 | middle button in Tk text widgets. | |
285 | ||
286 | To test this function, evaluate: | |
287 | (global-set-key [down-mouse-2] 'mouse-drag-drag)" | |
288 | (interactive "e") | |
289 | ;; we want to do save-selected-window, but that requires 19.29 | |
290 | (let* ((start-posn (event-start start-event)) | |
291 | (start-window (posn-window start-posn)) | |
292 | (start-row (cdr (posn-col-row start-posn))) | |
293 | (start-col (car (posn-col-row start-posn))) | |
294 | (old-selected-window (selected-window)) | |
295 | event end row mouse-delta scroll-delta | |
e35afc97 | 296 | have-scrolled |
84f19a49 RS |
297 | window-last-row |
298 | col mouse-col-delta window-last-col | |
299 | (scroll-col-delta 0) | |
300 | ;; be conservative about allowing horizontal scrolling | |
301 | (col-scrolling-p (mouse-drag-should-do-col-scrolling))) | |
302 | (select-window start-window) | |
303 | (setq window-last-row (- (window-height) 2) | |
304 | window-last-col (- (window-width) 2)) | |
305 | (track-mouse | |
306 | (while (progn | |
307 | (setq event (read-event) | |
308 | end (event-end event) | |
309 | row (cdr (posn-col-row end)) | |
310 | col (car (posn-col-row end))) | |
311 | (or (mouse-movement-p event) | |
312 | (eq (car-safe event) 'switch-frame))) | |
313 | ;; Scroll if see if we're on the edge. | |
314 | ;; NEEDSWORK: should handle mouse-in-other window. | |
315 | (cond | |
316 | ((not (eq start-window (posn-window end))) | |
317 | t) ; wait for return to original window | |
318 | ((<= row 0) (mouse-drag-repeatedly-safe-scroll -1 0)) | |
319 | ((>= row window-last-row) (mouse-drag-repeatedly-safe-scroll 1 0)) | |
320 | ((and col-scrolling-p (<= col 1)) (mouse-drag-repeatedly-safe-scroll 0 -1)) | |
321 | ((and col-scrolling-p (>= col window-last-col)) (mouse-drag-repeatedly-safe-scroll 0 1)) | |
322 | (t | |
323 | (setq scroll-delta (- row start-row) | |
324 | start-row row) | |
325 | (if col-scrolling-p | |
326 | (setq scroll-col-delta (- col start-col) | |
327 | start-col col)) | |
328 | (if (or (/= 0 scroll-delta) | |
329 | (/= 0 scroll-col-delta)) | |
330 | (progn | |
331 | (setq have-scrolled t) | |
332 | (mouse-drag-safe-scroll scroll-delta scroll-col-delta))))))) | |
333 | ;; If it was a click and not a drag, prepare to pass the event on. | |
e35afc97 | 334 | ;; Is there a more correct way to reconstruct the event? |
84f19a49 RS |
335 | (if (and (not have-scrolled) |
336 | (mouse-drag-events-are-point-events-p start-posn end)) | |
e35afc97 RS |
337 | (push (cons (event-basic-type start-event) (cdr start-event)) |
338 | unread-command-events)) | |
84f19a49 | 339 | ;; Now restore the old window. |
e35afc97 RS |
340 | (select-window old-selected-window))) |
341 | ||
84f19a49 RS |
342 | |
343 | (provide 'mouse-drag) | |
344 | ||
ab5796a9 | 345 | ;;; arch-tag: e47354ff-82f5-42c4-b3dc-88dd9c04b770 |
84f19a49 | 346 | ;;; mouse-drag.el ends here |