1 ;;; mouse-drag.el --- use mouse-2 to do a new style of scrolling
3 ;; Copyright (C) 1996 Free Software Foundation, Inc.
5 ;; Author: John Heidemann <johnh@ISI.EDU>
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
27 ;;; What is ``mouse-drag.el''?
29 ;;; Doesn't that scroll bar seem far away when you want to scroll?
30 ;;; This module overloads mouse-2 to do ``throw'' scrolling. You
31 ;;; click and drag. The distance you move from your original click
32 ;;; turns into a scroll amount. The scroll amount is scaled
33 ;;; exponentially to make both large moves and short adjustments easy.
34 ;;; What this boils down to is that you can easily scroll around the
35 ;;; buffer without much mouse movement. Finally, clicks which aren't
36 ;;; drags are passed off to the old mouse-2 binding, so old mouse-2
37 ;;; operations (find-file in dired-mode, yanking in most other modes)
40 ;;; There is an alternative way to scroll, ``drag'' scrolling. You
41 ;;; can click on a character and then drag it around, scrolling the
42 ;;; buffer with you. The character always stays under the mouse.
43 ;;; Compared to throw-scrolling, this approach provides direct
44 ;;; manipulation (nice) but requires more mouse movement
45 ;;; (unfortunate). It is offered as an alternative for those who
48 ;;; If you like mouse-drag, you should also check out mouse-copy
49 ;;; for ``one-click text copy and move''.
51 ;;; To use mouse-drag, place the following in your .emacs file:
52 ;;; (require 'mouse-drag)
54 ;;; (global-set-key [down-mouse-2] 'mouse-drag-throw)
56 ;;; (global-set-key [down-mouse-2] 'mouse-drag-drag)
62 ;;; - reverse the throw-scroll direction with \\[mouse-throw-with-scroll-bar]
63 ;;; - work around a bug with \\[mouse-extras-work-around-drag-bug]
66 ;;; History and related work:
68 ;;; One-click copying and moving was inspired by lemacs-19.8.
69 ;;; Throw-scrolling was inspired by MacPaint's ``hand'' and by Tk's
70 ;;; mouse-2 scrolling. The package mouse-scroll.el by Tom Wurgler
71 ;;; <twurgler@goodyear.com> is similar to mouse-drag-throw, but
72 ;;; doesn't pass clicks through.
74 ;;; These functions have been tested in emacs version 19.30,
75 ;;; and this package has run in the past on 19.25-19.29.
77 ;;; Originally mouse-drag was part of a larger package.
78 ;;; As of 11 July 96 the scrolling functions were split out
79 ;;; in preparation for incorporation into (the future) emacs-19.32.
84 ;;; Thanks to Kai Grossjohann
85 ;;; <grossjoh@dusty.informatik.uni-dortmund.de> for reporting bugs, to
86 ;;; Tom Wurgler <twurgler@goodyear.com> for reporting bugs and
87 ;;; suggesting fixes, and to Joel Graber <jgraber@ti.com> for
88 ;;; prompting me to do drag-scrolling and for an initial
89 ;;; implementation of horizontal drag-scrolling.
91 ;;; -johnh@isi.edu, 11-Jul-96
94 ;;; Old changes, for reference:
96 ;;; What's new with mouse-extras 2.21?
98 ;;; - support for emacs-19.{29,30}
99 ;;; - point now stays on the visible screen during horizontal scrolling
100 ;;; (bug identified and fix suggested by Tom Wurgler <twurgler@goodyear.com>)
101 ;;; - better work-around for lost-mouse-events bug (supports double/triple
102 ;;; clicks), see \\[mouse-extras-work-around-drag-bug] for details.
103 ;;; - work-around for lost-mouse-events bug now is OFF by default;
104 ;;; enable it if you have problems
115 (defun mouse-drag-safe-scroll (row-delta &optional col-delta)
116 "* Scroll down ROW-DELTA lines and right COL-DELTA, ignoring buffer edge errors.
117 Keep the cursor on the screen as needed."
120 (condition-case nil ;; catch and ignore movement errors
121 (scroll-down row-delta)
122 (beginning-of-buffer (message "Beginning of buffer"))
123 (end-of-buffer (message "End of buffer"))))
127 (scroll-right col-delta)
128 ;; Make sure that the point stays on the visible screen
129 ;; (if truncation-lines in set).
130 ;; This code mimics the behavior we automatically get
131 ;; when doing vertical scrolling.
132 ;; Problem identified and a fix suggested by Tom Wurgler.
134 ((< (current-column) (window-hscroll))
135 (move-to-column (window-hscroll))) ; make on left column
136 ((> (- (current-column) (window-hscroll) (window-width) -2) 0)
137 (move-to-column (+ (window-width) (window-hscroll) -3)))))))
139 (defun mouse-drag-repeatedly-safe-scroll (row-delta &optional col-delta)
140 "* Scroll ROW-DELTA rows and COL-DELTA cols until an event happens."
141 (while (sit-for mouse-scroll-delay)
142 (mouse-drag-safe-scroll row-delta col-delta)))
144 (defun mouse-drag-events-are-point-events-p (start-posn end-posn)
145 "* Determine if START-POSN and END-POSN are \"close\"."
147 ((start-col-row (posn-col-row start-posn))
148 (end-col-row (posn-col-row end-posn)))
150 ;; We no longer exclude things by time.
151 ;; (< (- (posn-timestamp end-posn) (posn-timestamp start-posn))
152 ;; (if (numberp double-click-time)
153 ;; (* 2 double-click-time) ;; stretch it a little
154 ;; 999999)) ;; non-numeric => check by position alone
155 (= (car start-col-row) (car end-col-row))
156 (= (cdr start-col-row) (cdr end-col-row)))))
158 (defun mouse-drag-should-do-col-scrolling ()
159 "* Determine if it's wise to enable col-scrolling for the current window."
161 (> (window-hscroll (selected-window)) 0)
162 (< (window-width) (screen-width))))
164 (defvar mouse-throw-with-scroll-bar nil
165 "* Set direction of mouse-throwing.
166 If nil, the text moves in the direction the mouse moves.
167 If t, the scroll bar moves in the direction the mouse moves.")
168 (defconst mouse-throw-magnifier-with-scroll-bar
169 [-16 -8 -4 -2 -1 0 0 0 1 2 4 8 16])
170 (defconst mouse-throw-magnifier-with-mouse-movement
171 [ 16 8 4 2 1 0 0 0 -1 -2 -4 -8 -16])
172 (defconst mouse-throw-magnifier-min -6)
173 (defconst mouse-throw-magnifier-max 6)
175 (defun mouse-drag-throw (start-event)
176 "\"Throw\" the page according to a mouse drag.
178 A \"throw\" is scrolling the page at a speed relative to the distance
179 from the original mouse click to the current mouse location. Try it;
180 you'll like it. It's easier to observe than to explain.
182 If the mouse is clicked and released in the same place of time we
183 assume that the user didn't want to scdebugroll but wanted to whatever
184 mouse-2 used to do, so we pass it through.
186 Throw scrolling was inspired (but is not identical to) the \"hand\"
187 option in MacPaint, or the middle button in Tk text widgets.
189 If `mouse-throw-with-scroll-bar' is non-nil, then this command scrolls
190 in the opposite direction. (Different people have different ideas
191 about which direction is natural. Perhaps it has to do with which
192 hemisphere you're in.)
194 To test this function, evaluate:
195 (global-set-key [down-mouse-2] 'mouse-drag-throw)"
197 ;; we want to do save-selected-window, but that requires 19.29
198 (let* ((start-posn (event-start start-event))
199 (start-window (posn-window start-posn))
200 (start-row (cdr (posn-col-row start-posn)))
201 (start-col (car (posn-col-row start-posn)))
202 (old-selected-window (selected-window))
203 event end row mouse-delta scroll-delta
204 have-scrolled point-event-p old-binding
206 col mouse-col-delta window-last-col
208 adjusted-mouse-col-delta
210 ;; be conservative about allowing horizontal scrolling
211 (col-scrolling-p (mouse-drag-should-do-col-scrolling)))
212 (select-window start-window)
215 (setq event (read-event)
216 end (event-end event)
217 row (cdr (posn-col-row end))
218 col (car (posn-col-row end)))
219 (or (mouse-movement-p event)
220 (eq (car-safe event) 'switch-frame)))
221 (if (eq start-window (posn-window end))
223 (setq mouse-delta (- start-row row)
226 ((<= mouse-delta mouse-throw-magnifier-min)
227 mouse-throw-magnifier-min)
228 ((>= mouse-delta mouse-throw-magnifier-max)
229 mouse-throw-magnifier-max)
231 mouse-throw-magnifier-min)
232 scroll-delta (aref (if mouse-throw-with-scroll-bar
233 mouse-throw-magnifier-with-scroll-bar
234 mouse-throw-magnifier-with-mouse-movement)
235 adjusted-mouse-delta))
237 (setq mouse-col-delta (- start-col col)
238 adjusted-mouse-col-delta
240 ((<= mouse-col-delta mouse-throw-magnifier-min)
241 mouse-throw-magnifier-min)
242 ((>= mouse-col-delta mouse-throw-magnifier-max)
243 mouse-throw-magnifier-max)
245 mouse-throw-magnifier-min)
246 scroll-col-delta (aref (if mouse-throw-with-scroll-bar
247 mouse-throw-magnifier-with-scroll-bar
248 mouse-throw-magnifier-with-mouse-movement)
249 adjusted-mouse-col-delta)))))
250 (if (or (/= 0 scroll-delta)
251 (/= 0 scroll-col-delta))
253 (setq have-scrolled t)
254 (mouse-drag-safe-scroll scroll-delta scroll-col-delta)
255 (mouse-drag-repeatedly-safe-scroll scroll-delta scroll-col-delta))))) ;xxx
256 ;; If it was a click and not a drag, prepare to pass the event on.
257 ;; Note: We must determine the pass-through event before restoring
258 ;; the window, but invoke it after. Sigh.
259 (if (and (not have-scrolled)
260 (mouse-drag-events-are-point-events-p start-posn end))
261 (setq point-event-p t
262 old-binding (key-binding
263 (vector (event-basic-type start-event)))))
264 ;; Now restore the old window.
265 (select-window old-selected-window)
266 ;; For clicks, call the old function.
268 (call-interactively old-binding))))
270 (defun mouse-drag-drag (start-event)
271 "\"Drag\" the page according to a mouse drag.
273 Drag scrolling moves the page according to the movement of the mouse.
274 You \"grab\" the character under the mouse and move it around.
276 If the mouse is clicked and released in the same place of time we
277 assume that the user didn't want to scroll but wanted to whatever
278 mouse-2 used to do, so we pass it through.
280 Drag scrolling is identical to the \"hand\" option in MacPaint, or the
281 middle button in Tk text widgets.
283 To test this function, evaluate:
284 (global-set-key [down-mouse-2] 'mouse-drag-drag)"
286 ;; we want to do save-selected-window, but that requires 19.29
287 (let* ((start-posn (event-start start-event))
288 (start-window (posn-window start-posn))
289 (start-row (cdr (posn-col-row start-posn)))
290 (start-col (car (posn-col-row start-posn)))
291 (old-selected-window (selected-window))
292 event end row mouse-delta scroll-delta
293 have-scrolled point-event-p old-binding
295 col mouse-col-delta window-last-col
297 ;; be conservative about allowing horizontal scrolling
298 (col-scrolling-p (mouse-drag-should-do-col-scrolling)))
299 (select-window start-window)
300 (setq window-last-row (- (window-height) 2)
301 window-last-col (- (window-width) 2))
304 (setq event (read-event)
305 end (event-end event)
306 row (cdr (posn-col-row end))
307 col (car (posn-col-row end)))
308 (or (mouse-movement-p event)
309 (eq (car-safe event) 'switch-frame)))
310 ;; Scroll if see if we're on the edge.
311 ;; NEEDSWORK: should handle mouse-in-other window.
313 ((not (eq start-window (posn-window end)))
314 t) ; wait for return to original window
315 ((<= row 0) (mouse-drag-repeatedly-safe-scroll -1 0))
316 ((>= row window-last-row) (mouse-drag-repeatedly-safe-scroll 1 0))
317 ((and col-scrolling-p (<= col 1)) (mouse-drag-repeatedly-safe-scroll 0 -1))
318 ((and col-scrolling-p (>= col window-last-col)) (mouse-drag-repeatedly-safe-scroll 0 1))
320 (setq scroll-delta (- row start-row)
323 (setq scroll-col-delta (- col start-col)
325 (if (or (/= 0 scroll-delta)
326 (/= 0 scroll-col-delta))
328 (setq have-scrolled t)
329 (mouse-drag-safe-scroll scroll-delta scroll-col-delta)))))))
330 ;; If it was a click and not a drag, prepare to pass the event on.
331 ;; Note: We must determine the pass-through event before restoring
332 ;; the window, but invoke it after. Sigh.
333 (if (and (not have-scrolled)
334 (mouse-drag-events-are-point-events-p start-posn end))
335 (setq point-event-p t
336 old-binding (key-binding
337 (vector (event-basic-type start-event)))))
338 ;; Now restore the old window.
339 (select-window old-selected-window)
340 ;; For clicks, call the old function.
342 (call-interactively old-binding))))
344 (provide 'mouse-drag)
346 ;;; mouse-drag.el ends here