Mercurial > emacs
annotate lisp/mouse-drag.el @ 16842:72276b334084 before-thomas-posix1996 glibc-2_0_2 libc-970108 libc-970109 libc-970110 libc-970111 libc-970112 libc-970113 libc-970114 libc-970115 libc-970116 libc-970117 libc-970118 libc-970119 libc-970120 libc-970121 libc-970122 libc-970123 libc-970124 libc-970125 libc-970126 libc-970127 libc-970128 libc-970129 libc-970130 libc-970131 libc-970201 libc-970202 libc-970203 libc-970204 libc-970205 libc-970206 libc-970207 libc-970208 libc-970209 libc-970210 libc-970211 libc-970212 libc-970213 libc-970214 libc-970215 libc-970216 libc-970217 libc-970218 libc-970219 libc-970220 libc-970221 libc-970222 libc-970223 libc-970224 libc-970225 libc-970226 libc-970227 libc-970228 libc-970301 libc-970302 libc-970303 libc-970304 libc-970305 libc-970306 libc-970307 libc-970308 libc-970309 libc-970310 libc-970311 libc-970312 libc-970313 libc-970314 libc-970315 libc-970316 libc-970317 libc-970318 libc-970319 libc-970320 libc-970321 libc-970322 libc-970323 libc-970324 libc20x-970306 libc20x-97031 libc20x-970316 libc20x-970318 libc20x-970319 libc20x-970404 root-libc-2_0_x-branch
Add hppa1.1-hitachi-hiuxmpp support, passed along by rms.
author | David J. MacKenzie <djm@gnu.org> |
---|---|
date | Tue, 07 Jan 1997 19:29:28 +0000 |
parents | f4be70df6bb6 |
children | 8f952e921136 |
rev | line source |
---|---|
16322 | 1 ;;; mouse-drag.el -- use mouse-2 to do a new style of scrolling |
2 ;; Copyright (C) 1996 Free Software Foundation, Inc. | |
16319 | 3 |
16322 | 4 ;; Author: John Heidemann <johnh@ISI.EDU> |
5 ;; Keywords: mouse | |
16319 | 6 |
7 ;; This file is part of GNU Emacs. | |
8 | |
9 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
10 ;; it under the terms of the GNU General Public License as published by | |
11 ;; the Free Software Foundation; either version 2, or (at your option) | |
12 ;; any later version. | |
13 | |
14 ;; GNU Emacs is distributed in the hope that it will be useful, | |
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
17 ;; GNU General Public License for more details. | |
18 | |
19 ;; You should have received a copy of the GNU General Public License | |
20 ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
22 ;; Boston, MA 02111-1307, USA. | |
23 | |
24 ;;; Commentary: | |
25 | |
26 ;;; What is ``mouse-drag.el''? | |
27 ;;; | |
28 ;;; Doesn't that scroll bar seem far away when you want to scroll? | |
29 ;;; This module overloads mouse-2 to do ``throw'' scrolling. You | |
30 ;;; click and drag. The distance you move from your original click | |
31 ;;; turns into a scroll amount. The scroll amount is scaled | |
32 ;;; exponentially to make both large moves and short adjustments easy. | |
33 ;;; What this boils down to is that you can easily scroll around the | |
34 ;;; buffer without much mouse movement. Finally, clicks which aren't | |
35 ;;; drags are passed off to the old mouse-2 binding, so old mouse-2 | |
36 ;;; operations (find-file in dired-mode, yanking in most other modes) | |
37 ;;; still work. | |
38 ;;; | |
39 ;;; There is an alternative way to scroll, ``drag'' scrolling. You | |
40 ;;; can click on a character and then drag it around, scrolling the | |
41 ;;; buffer with you. The character always stays under the mouse. | |
42 ;;; Compared to throw-scrolling, this approach provides direct | |
43 ;;; manipulation (nice) but requires more mouse movement | |
44 ;;; (unfortunate). It is offered as an alternative for those who | |
45 ;;; prefer it. | |
46 ;;; | |
47 ;;; If you like mouse-drag, you should also check out mouse-copy | |
48 ;;; for ``one-click text copy and move''. | |
49 ;;; | |
50 ;;; To use mouse-drag, place the following in your .emacs file: | |
51 ;;; (require 'mouse-drag) | |
52 ;;; -and either- | |
53 ;;; (global-set-key [down-mouse-2] 'mouse-drag-throw) | |
54 ;;; -or- | |
55 ;;; (global-set-key [down-mouse-2] 'mouse-drag-drag) | |
56 ;;; | |
57 ;;; | |
58 ;;; | |
59 ;;; Options: | |
60 ;;; | |
61 ;;; - reverse the throw-scroll direction with \\[mouse-throw-with-scroll-bar] | |
62 ;;; - work around a bug with \\[mouse-extras-work-around-drag-bug] | |
63 ;;; | |
64 ;;; | |
65 ;;; History and related work: | |
66 ;;; | |
67 ;;; One-click copying and moving was inspired by lemacs-19.8. | |
68 ;;; Throw-scrolling was inspired by MacPaint's ``hand'' and by Tk's | |
69 ;;; mouse-2 scrolling. The package mouse-scroll.el by Tom Wurgler | |
70 ;;; <twurgler@goodyear.com> is similar to mouse-drag-throw, but | |
71 ;;; doesn't pass clicks through. | |
72 ;;; | |
73 ;;; These functions have been tested in emacs version 19.30, | |
74 ;;; and this package has run in the past on 19.25-19.29. | |
75 ;;; | |
76 ;;; Originally mouse-drag was part of a larger package. | |
77 ;;; As of 11 July 96 the scrolling functions were split out | |
78 ;;; in preparation for incorporation into (the future) emacs-19.32. | |
79 ;;; | |
80 ;;; | |
81 ;;; Thanks: | |
82 ;;; | |
83 ;;; Thanks to Kai Grossjohann | |
84 ;;; <grossjoh@dusty.informatik.uni-dortmund.de> for reporting bugs, to | |
85 ;;; Tom Wurgler <twurgler@goodyear.com> for reporting bugs and | |
86 ;;; suggesting fixes, and to Joel Graber <jgraber@ti.com> for | |
87 ;;; prompting me to do drag-scrolling and for an initial | |
88 ;;; implementation of horizontal drag-scrolling. | |
89 ;;; | |
90 ;;; -johnh@isi.edu, 11-Jul-96 | |
91 ;;; | |
92 ;;; | |
93 ;;; Old changes, for reference: | |
94 ;;; | |
95 ;;; What's new with mouse-extras 2.21? | |
96 ;;; | |
97 ;;; - support for emacs-19.{29,30} | |
98 ;;; - point now stays on the visible screen during horizontal scrolling | |
99 ;;; (bug identified and fix suggested by Tom Wurgler <twurgler@goodyear.com>) | |
100 ;;; - better work-around for lost-mouse-events bug (supports double/triple | |
101 ;;; clicks), see \\[mouse-extras-work-around-drag-bug] for details. | |
102 ;;; - work-around for lost-mouse-events bug now is OFF by default; | |
103 ;;; enable it if you have problems | |
104 ;;; | |
105 | |
106 | |
107 | |
108 ;;; Code: | |
109 | |
110 ;; | |
111 ;; scrolling code | |
112 ;; | |
113 | |
114 (defun mouse-drag-safe-scroll (row-delta &optional col-delta) | |
115 "* Scroll down ROW-DELTA lines and right COL-DELTA, ignoring buffer edge errors. | |
116 Keep the cursor on the screen as needed." | |
117 (if (and row-delta | |
118 (/= 0 row-delta)) | |
119 (condition-case nil ;; catch and ignore movement errors | |
120 (scroll-down row-delta) | |
121 (beginning-of-buffer (message "Beginning of buffer")) | |
122 (end-of-buffer (message "End of buffer")))) | |
123 (if (and col-delta | |
124 (/= 0 col-delta)) | |
125 (progn | |
126 (scroll-right col-delta) | |
127 ;; Make sure that the point stays on the visible screen | |
128 ;; (if truncation-lines in set). | |
129 ;; This code mimics the behavior we automatically get | |
130 ;; when doing vertical scrolling. | |
131 ;; Problem identified and a fix suggested by Tom Wurgler. | |
132 (cond | |
133 ((< (current-column) (window-hscroll)) | |
134 (move-to-column (window-hscroll))) ; make on left column | |
135 ((> (- (current-column) (window-hscroll) (window-width) -2) 0) | |
136 (move-to-column (+ (window-width) (window-hscroll) -3))))))) | |
137 | |
138 (defun mouse-drag-repeatedly-safe-scroll (row-delta &optional col-delta) | |
139 "* Scroll ROW-DELTA rows and COL-DELTA cols until an event happens." | |
140 (while (sit-for mouse-scroll-delay) | |
141 (mouse-drag-safe-scroll row-delta col-delta))) | |
142 | |
143 (defun mouse-drag-events-are-point-events-p (start-posn end-posn) | |
144 "* Determine if START-POSN and END-POSN are \"close\"." | |
145 (let* | |
146 ((start-col-row (posn-col-row start-posn)) | |
147 (end-col-row (posn-col-row end-posn))) | |
148 (and | |
149 ;; We no longer exclude things by time. | |
150 ;; (< (- (posn-timestamp end-posn) (posn-timestamp start-posn)) | |
151 ;; (if (numberp double-click-time) | |
152 ;; (* 2 double-click-time) ;; stretch it a little | |
153 ;; 999999)) ;; non-numeric => check by position alone | |
154 (= (car start-col-row) (car end-col-row)) | |
155 (= (cdr start-col-row) (cdr end-col-row))))) | |
156 | |
157 (defun mouse-drag-should-do-col-scrolling () | |
158 "* Determine if it's wise to enable col-scrolling for the current window." | |
159 (or truncate-lines | |
160 (> (window-hscroll (selected-window)) 0) | |
161 (< (window-width) (screen-width)))) | |
162 | |
163 (defvar mouse-throw-with-scroll-bar nil | |
164 "* Set direction of mouse-throwing. | |
165 If nil, the text moves in the direction the mouse moves. | |
166 If t, the scroll bar moves in the direction the mouse moves.") | |
167 (defconst mouse-throw-magnifier-with-scroll-bar | |
168 [-16 -8 -4 -2 -1 0 0 0 1 2 4 8 16]) | |
169 (defconst mouse-throw-magnifier-with-mouse-movement | |
170 [ 16 8 4 2 1 0 0 0 -1 -2 -4 -8 -16]) | |
171 (defconst mouse-throw-magnifier-min -6) | |
172 (defconst mouse-throw-magnifier-max 6) | |
173 | |
174 (defun mouse-drag-throw (start-event) | |
175 "\"Throw\" the page according to a mouse drag. | |
176 | |
177 A \"throw\" is scrolling the page at a speed relative to the distance | |
178 from the original mouse click to the current mouse location. Try it; | |
179 you'll like it. It's easier to observe than to explain. | |
180 | |
181 If the mouse is clicked and released in the same place of time we | |
182 assume that the user didn't want to scdebugroll but wanted to whatever | |
183 mouse-2 used to do, so we pass it through. | |
184 | |
185 Throw scrolling was inspired (but is not identical to) the \"hand\" | |
186 option in MacPaint, or the middle button in Tk text widgets. | |
187 | |
188 If `mouse-throw-with-scroll-bar' is non-nil, then this command scrolls | |
189 in the opposite direction. (Different people have different ideas | |
190 about which direction is natural. Perhaps it has to do with which | |
191 hemisphere you're in.) | |
192 | |
193 To test this function, evaluate: | |
194 (global-set-key [down-mouse-2] 'mouse-drag-throw)" | |
195 (interactive "e") | |
196 ;; we want to do save-selected-window, but that requires 19.29 | |
197 (let* ((start-posn (event-start start-event)) | |
198 (start-window (posn-window start-posn)) | |
199 (start-row (cdr (posn-col-row start-posn))) | |
200 (start-col (car (posn-col-row start-posn))) | |
201 (old-selected-window (selected-window)) | |
202 event end row mouse-delta scroll-delta | |
203 have-scrolled point-event-p old-binding | |
204 window-last-row | |
205 col mouse-col-delta window-last-col | |
206 (scroll-col-delta 0) | |
207 adjusted-mouse-col-delta | |
16320
56f494ed6b13
(mouse-drag-throw): Bind adjusted-mouse-delta.
Richard M. Stallman <rms@gnu.org>
parents:
16319
diff
changeset
|
208 adjusted-mouse-delta |
16319 | 209 ;; be conservative about allowing horizontal scrolling |
210 (col-scrolling-p (mouse-drag-should-do-col-scrolling))) | |
211 (select-window start-window) | |
212 (track-mouse | |
213 (while (progn | |
214 (setq event (read-event) | |
215 end (event-end event) | |
216 row (cdr (posn-col-row end)) | |
217 col (car (posn-col-row end))) | |
218 (or (mouse-movement-p event) | |
219 (eq (car-safe event) 'switch-frame))) | |
220 (if (eq start-window (posn-window end)) | |
221 (progn | |
222 (setq mouse-delta (- start-row row) | |
223 adjusted-mouse-delta | |
224 (- (cond | |
225 ((<= mouse-delta mouse-throw-magnifier-min) | |
226 mouse-throw-magnifier-min) | |
227 ((>= mouse-delta mouse-throw-magnifier-max) | |
228 mouse-throw-magnifier-max) | |
229 (t mouse-delta)) | |
230 mouse-throw-magnifier-min) | |
231 scroll-delta (aref (if mouse-throw-with-scroll-bar | |
232 mouse-throw-magnifier-with-scroll-bar | |
233 mouse-throw-magnifier-with-mouse-movement) | |
234 adjusted-mouse-delta)) | |
235 (if col-scrolling-p | |
236 (setq mouse-col-delta (- start-col col) | |
237 adjusted-mouse-col-delta | |
238 (- (cond | |
239 ((<= mouse-col-delta mouse-throw-magnifier-min) | |
240 mouse-throw-magnifier-min) | |
241 ((>= mouse-col-delta mouse-throw-magnifier-max) | |
242 mouse-throw-magnifier-max) | |
243 (t mouse-col-delta)) | |
244 mouse-throw-magnifier-min) | |
245 scroll-col-delta (aref (if mouse-throw-with-scroll-bar | |
246 mouse-throw-magnifier-with-scroll-bar | |
247 mouse-throw-magnifier-with-mouse-movement) | |
248 adjusted-mouse-col-delta))))) | |
249 (if (or (/= 0 scroll-delta) | |
250 (/= 0 scroll-col-delta)) | |
251 (progn | |
252 (setq have-scrolled t) | |
253 (mouse-drag-safe-scroll scroll-delta scroll-col-delta) | |
254 (mouse-drag-repeatedly-safe-scroll scroll-delta scroll-col-delta))))) ;xxx | |
255 ;; If it was a click and not a drag, prepare to pass the event on. | |
256 ;; Note: We must determine the pass-through event before restoring | |
257 ;; the window, but invoke it after. Sigh. | |
258 (if (and (not have-scrolled) | |
259 (mouse-drag-events-are-point-events-p start-posn end)) | |
260 (setq point-event-p t | |
261 old-binding (key-binding | |
262 (vector (event-basic-type start-event))))) | |
263 ;; Now restore the old window. | |
264 (select-window old-selected-window) | |
265 ;; For clicks, call the old function. | |
266 (if point-event-p | |
267 (call-interactively old-binding)))) | |
268 | |
269 (defun mouse-drag-drag (start-event) | |
270 "\"Drag\" the page according to a mouse drag. | |
271 | |
272 Drag scrolling moves the page according to the movement of the mouse. | |
273 You \"grab\" the character under the mouse and move it around. | |
274 | |
275 If the mouse is clicked and released in the same place of time we | |
276 assume that the user didn't want to scroll but wanted to whatever | |
277 mouse-2 used to do, so we pass it through. | |
278 | |
279 Drag scrolling is identical to the \"hand\" option in MacPaint, or the | |
280 middle button in Tk text widgets. | |
281 | |
282 To test this function, evaluate: | |
283 (global-set-key [down-mouse-2] 'mouse-drag-drag)" | |
284 (interactive "e") | |
285 ;; we want to do save-selected-window, but that requires 19.29 | |
286 (let* ((start-posn (event-start start-event)) | |
287 (start-window (posn-window start-posn)) | |
288 (start-row (cdr (posn-col-row start-posn))) | |
289 (start-col (car (posn-col-row start-posn))) | |
290 (old-selected-window (selected-window)) | |
291 event end row mouse-delta scroll-delta | |
292 have-scrolled point-event-p old-binding | |
293 window-last-row | |
294 col mouse-col-delta window-last-col | |
295 (scroll-col-delta 0) | |
296 ;; be conservative about allowing horizontal scrolling | |
297 (col-scrolling-p (mouse-drag-should-do-col-scrolling))) | |
298 (select-window start-window) | |
299 (setq window-last-row (- (window-height) 2) | |
300 window-last-col (- (window-width) 2)) | |
301 (track-mouse | |
302 (while (progn | |
303 (setq event (read-event) | |
304 end (event-end event) | |
305 row (cdr (posn-col-row end)) | |
306 col (car (posn-col-row end))) | |
307 (or (mouse-movement-p event) | |
308 (eq (car-safe event) 'switch-frame))) | |
309 ;; Scroll if see if we're on the edge. | |
310 ;; NEEDSWORK: should handle mouse-in-other window. | |
311 (cond | |
312 ((not (eq start-window (posn-window end))) | |
313 t) ; wait for return to original window | |
314 ((<= row 0) (mouse-drag-repeatedly-safe-scroll -1 0)) | |
315 ((>= row window-last-row) (mouse-drag-repeatedly-safe-scroll 1 0)) | |
316 ((and col-scrolling-p (<= col 1)) (mouse-drag-repeatedly-safe-scroll 0 -1)) | |
317 ((and col-scrolling-p (>= col window-last-col)) (mouse-drag-repeatedly-safe-scroll 0 1)) | |
318 (t | |
319 (setq scroll-delta (- row start-row) | |
320 start-row row) | |
321 (if col-scrolling-p | |
322 (setq scroll-col-delta (- col start-col) | |
323 start-col col)) | |
324 (if (or (/= 0 scroll-delta) | |
325 (/= 0 scroll-col-delta)) | |
326 (progn | |
327 (setq have-scrolled t) | |
328 (mouse-drag-safe-scroll scroll-delta scroll-col-delta))))))) | |
329 ;; If it was a click and not a drag, prepare to pass the event on. | |
330 ;; Note: We must determine the pass-through event before restoring | |
331 ;; the window, but invoke it after. Sigh. | |
332 (if (and (not have-scrolled) | |
333 (mouse-drag-events-are-point-events-p start-posn end)) | |
334 (setq point-event-p t | |
335 old-binding (key-binding | |
336 (vector (event-basic-type start-event))))) | |
337 ;; Now restore the old window. | |
338 (select-window old-selected-window) | |
339 ;; For clicks, call the old function. | |
340 (if point-event-p | |
341 (call-interactively old-binding)))) | |
342 | |
343 (provide 'mouse-drag) | |
344 | |
345 ;;; mouse-drag.el ends here |