Mercurial > emacs
annotate lisp/mouse-drag.el @ 24419:30e478cd167e
(shell-command-default-error-buffer): Renamed from
shell-command-on-region-default-error-buffer.
(shell-command-on-region): Mention in echo area when there
is some error output. Mention success or failure, too.
Accumulate multiple error outputs
going forward, with formfeed in between. Display the error buffer
when we have put something in it.
(shell-command): Add the ERROR-BUFFER argument feature.
author | Karl Heuer <kwzh@gnu.org> |
---|---|
date | Mon, 01 Mar 1999 03:19:32 +0000 |
parents | 2441b667abdd |
children | acc3474759c0 |
rev | line source |
---|---|
17517 | 1 ;;; mouse-drag.el --- use mouse-2 to do a new style of scrolling |
2 | |
18026
e3b0e7dc5efd
* mouse-drag.el (mouse-drag-electric-col-scrolling): New variable;
Karl Heuer <kwzh@gnu.org>
parents:
17517
diff
changeset
|
3 ;; Copyright (C) 1996, 1997 Free Software Foundation, Inc. |
16319 | 4 |
16322 | 5 ;; Author: John Heidemann <johnh@ISI.EDU> |
6 ;; Keywords: mouse | |
16319 | 7 |
8 ;; This file is part of GNU Emacs. | |
9 | |
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) | |
13 ;; any later version. | |
14 | |
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. | |
19 | |
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. | |
24 | |
25 ;;; Commentary: | |
26 | |
27 ;;; What is ``mouse-drag.el''? | |
28 ;;; | |
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) | |
38 ;;; still work. | |
39 ;;; | |
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 | |
46 ;;; prefer it. | |
47 ;;; | |
48 ;;; If you like mouse-drag, you should also check out mouse-copy | |
49 ;;; for ``one-click text copy and move''. | |
50 ;;; | |
51 ;;; To use mouse-drag, place the following in your .emacs file: | |
52 ;;; (require 'mouse-drag) | |
53 ;;; -and either- | |
54 ;;; (global-set-key [down-mouse-2] 'mouse-drag-throw) | |
55 ;;; -or- | |
56 ;;; (global-set-key [down-mouse-2] 'mouse-drag-drag) | |
57 ;;; | |
58 ;;; | |
59 ;;; | |
60 ;;; Options: | |
61 ;;; | |
62 ;;; - reverse the throw-scroll direction with \\[mouse-throw-with-scroll-bar] | |
63 ;;; - work around a bug with \\[mouse-extras-work-around-drag-bug] | |
18026
e3b0e7dc5efd
* mouse-drag.el (mouse-drag-electric-col-scrolling): New variable;
Karl Heuer <kwzh@gnu.org>
parents:
17517
diff
changeset
|
64 ;;; - auto-enable horizontal scrolling with |
e3b0e7dc5efd
* mouse-drag.el (mouse-drag-electric-col-scrolling): New variable;
Karl Heuer <kwzh@gnu.org>
parents:
17517
diff
changeset
|
65 ;;; \\[mouse-drag-electric-col-scrolling] |
16319 | 66 ;;; |
67 ;;; | |
68 ;;; History and related work: | |
69 ;;; | |
70 ;;; One-click copying and moving was inspired by lemacs-19.8. | |
71 ;;; Throw-scrolling was inspired by MacPaint's ``hand'' and by Tk's | |
72 ;;; mouse-2 scrolling. The package mouse-scroll.el by Tom Wurgler | |
73 ;;; <twurgler@goodyear.com> is similar to mouse-drag-throw, but | |
74 ;;; doesn't pass clicks through. | |
75 ;;; | |
76 ;;; These functions have been tested in emacs version 19.30, | |
77 ;;; and this package has run in the past on 19.25-19.29. | |
78 ;;; | |
79 ;;; Originally mouse-drag was part of a larger package. | |
80 ;;; As of 11 July 96 the scrolling functions were split out | |
81 ;;; in preparation for incorporation into (the future) emacs-19.32. | |
82 ;;; | |
83 ;;; | |
84 ;;; Thanks: | |
85 ;;; | |
86 ;;; Thanks to Kai Grossjohann | |
87 ;;; <grossjoh@dusty.informatik.uni-dortmund.de> for reporting bugs, to | |
88 ;;; Tom Wurgler <twurgler@goodyear.com> for reporting bugs and | |
89 ;;; suggesting fixes, and to Joel Graber <jgraber@ti.com> for | |
90 ;;; prompting me to do drag-scrolling and for an initial | |
91 ;;; implementation of horizontal drag-scrolling. | |
92 ;;; | |
93 ;;; -johnh@isi.edu, 11-Jul-96 | |
94 ;;; | |
95 ;;; | |
18026
e3b0e7dc5efd
* mouse-drag.el (mouse-drag-electric-col-scrolling): New variable;
Karl Heuer <kwzh@gnu.org>
parents:
17517
diff
changeset
|
96 ;;; What's new with mouse-drag 2.24? |
16319 | 97 ;;; |
18026
e3b0e7dc5efd
* mouse-drag.el (mouse-drag-electric-col-scrolling): New variable;
Karl Heuer <kwzh@gnu.org>
parents:
17517
diff
changeset
|
98 ;;; - mouse-drag-electric-col-scrolling (default: on) |
e3b0e7dc5efd
* mouse-drag.el (mouse-drag-electric-col-scrolling): New variable;
Karl Heuer <kwzh@gnu.org>
parents:
17517
diff
changeset
|
99 ;;; auto-enables horizontal scrolling when clicks on wrapped |
e3b0e7dc5efd
* mouse-drag.el (mouse-drag-electric-col-scrolling): New variable;
Karl Heuer <kwzh@gnu.org>
parents:
17517
diff
changeset
|
100 ;;; lines occur |
16319 | 101 |
102 ;;; Code: | |
103 | |
104 ;; | |
105 ;; scrolling code | |
106 ;; | |
107 | |
108 (defun mouse-drag-safe-scroll (row-delta &optional col-delta) | |
18134
2441b667abdd
(mouse-drag-safe-scroll): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
18026
diff
changeset
|
109 "Scroll down ROW-DELTA lines and right COL-DELTA, ignoring buffer edge errors. |
16319 | 110 Keep the cursor on the screen as needed." |
111 (if (and row-delta | |
112 (/= 0 row-delta)) | |
113 (condition-case nil ;; catch and ignore movement errors | |
114 (scroll-down row-delta) | |
115 (beginning-of-buffer (message "Beginning of buffer")) | |
116 (end-of-buffer (message "End of buffer")))) | |
117 (if (and col-delta | |
118 (/= 0 col-delta)) | |
119 (progn | |
120 (scroll-right col-delta) | |
121 ;; Make sure that the point stays on the visible screen | |
122 ;; (if truncation-lines in set). | |
18134
2441b667abdd
(mouse-drag-safe-scroll): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
18026
diff
changeset
|
123 ;; This code mimics the behavior we automatically get |
16319 | 124 ;; when doing vertical scrolling. |
125 ;; Problem identified and a fix suggested by Tom Wurgler. | |
126 (cond | |
127 ((< (current-column) (window-hscroll)) | |
128 (move-to-column (window-hscroll))) ; make on left column | |
129 ((> (- (current-column) (window-hscroll) (window-width) -2) 0) | |
130 (move-to-column (+ (window-width) (window-hscroll) -3))))))) | |
131 | |
132 (defun mouse-drag-repeatedly-safe-scroll (row-delta &optional col-delta) | |
18134
2441b667abdd
(mouse-drag-safe-scroll): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
18026
diff
changeset
|
133 "Scroll ROW-DELTA rows and COL-DELTA cols until an event happens." |
16319 | 134 (while (sit-for mouse-scroll-delay) |
135 (mouse-drag-safe-scroll row-delta col-delta))) | |
136 | |
137 (defun mouse-drag-events-are-point-events-p (start-posn end-posn) | |
18134
2441b667abdd
(mouse-drag-safe-scroll): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
18026
diff
changeset
|
138 "Determine if START-POSN and END-POSN are \"close\"." |
16319 | 139 (let* |
140 ((start-col-row (posn-col-row start-posn)) | |
141 (end-col-row (posn-col-row end-posn))) | |
142 (and | |
143 ;; We no longer exclude things by time. | |
144 ;; (< (- (posn-timestamp end-posn) (posn-timestamp start-posn)) | |
145 ;; (if (numberp double-click-time) | |
146 ;; (* 2 double-click-time) ;; stretch it a little | |
147 ;; 999999)) ;; non-numeric => check by position alone | |
148 (= (car start-col-row) (car end-col-row)) | |
149 (= (cdr start-col-row) (cdr end-col-row))))) | |
150 | |
18026
e3b0e7dc5efd
* mouse-drag.el (mouse-drag-electric-col-scrolling): New variable;
Karl Heuer <kwzh@gnu.org>
parents:
17517
diff
changeset
|
151 (defvar mouse-drag-electric-col-scrolling t |
e3b0e7dc5efd
* mouse-drag.el (mouse-drag-electric-col-scrolling): New variable;
Karl Heuer <kwzh@gnu.org>
parents:
17517
diff
changeset
|
152 "If non-nil, mouse-drag on a long line enables truncate-lines.") |
e3b0e7dc5efd
* mouse-drag.el (mouse-drag-electric-col-scrolling): New variable;
Karl Heuer <kwzh@gnu.org>
parents:
17517
diff
changeset
|
153 |
16319 | 154 (defun mouse-drag-should-do-col-scrolling () |
18134
2441b667abdd
(mouse-drag-safe-scroll): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
18026
diff
changeset
|
155 "Determine if it's wise to enable col-scrolling for the current window. |
18026
e3b0e7dc5efd
* mouse-drag.el (mouse-drag-electric-col-scrolling): New variable;
Karl Heuer <kwzh@gnu.org>
parents:
17517
diff
changeset
|
156 Basically, we check for existing horizontal scrolling." |
16319 | 157 (or truncate-lines |
158 (> (window-hscroll (selected-window)) 0) | |
18026
e3b0e7dc5efd
* mouse-drag.el (mouse-drag-electric-col-scrolling): New variable;
Karl Heuer <kwzh@gnu.org>
parents:
17517
diff
changeset
|
159 (< (window-width) (screen-width)) |
e3b0e7dc5efd
* mouse-drag.el (mouse-drag-electric-col-scrolling): New variable;
Karl Heuer <kwzh@gnu.org>
parents:
17517
diff
changeset
|
160 (and |
e3b0e7dc5efd
* mouse-drag.el (mouse-drag-electric-col-scrolling): New variable;
Karl Heuer <kwzh@gnu.org>
parents:
17517
diff
changeset
|
161 mouse-drag-electric-col-scrolling |
e3b0e7dc5efd
* mouse-drag.el (mouse-drag-electric-col-scrolling): New variable;
Karl Heuer <kwzh@gnu.org>
parents:
17517
diff
changeset
|
162 (save-excursion ;; on a long line? |
e3b0e7dc5efd
* mouse-drag.el (mouse-drag-electric-col-scrolling): New variable;
Karl Heuer <kwzh@gnu.org>
parents:
17517
diff
changeset
|
163 (let |
e3b0e7dc5efd
* mouse-drag.el (mouse-drag-electric-col-scrolling): New variable;
Karl Heuer <kwzh@gnu.org>
parents:
17517
diff
changeset
|
164 ((beg (progn (beginning-of-line) (point))) |
e3b0e7dc5efd
* mouse-drag.el (mouse-drag-electric-col-scrolling): New variable;
Karl Heuer <kwzh@gnu.org>
parents:
17517
diff
changeset
|
165 (end (progn (end-of-line) (point)))) |
e3b0e7dc5efd
* mouse-drag.el (mouse-drag-electric-col-scrolling): New variable;
Karl Heuer <kwzh@gnu.org>
parents:
17517
diff
changeset
|
166 (if (> (- end beg) (window-width)) |
e3b0e7dc5efd
* mouse-drag.el (mouse-drag-electric-col-scrolling): New variable;
Karl Heuer <kwzh@gnu.org>
parents:
17517
diff
changeset
|
167 (setq truncate-lines t) |
e3b0e7dc5efd
* mouse-drag.el (mouse-drag-electric-col-scrolling): New variable;
Karl Heuer <kwzh@gnu.org>
parents:
17517
diff
changeset
|
168 nil)))))) |
16319 | 169 |
170 (defvar mouse-throw-with-scroll-bar nil | |
18134
2441b667abdd
(mouse-drag-safe-scroll): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
18026
diff
changeset
|
171 "*Set direction of mouse-throwing. |
16319 | 172 If nil, the text moves in the direction the mouse moves. |
173 If t, the scroll bar moves in the direction the mouse moves.") | |
18134
2441b667abdd
(mouse-drag-safe-scroll): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
18026
diff
changeset
|
174 (defconst mouse-throw-magnifier-with-scroll-bar |
16319 | 175 [-16 -8 -4 -2 -1 0 0 0 1 2 4 8 16]) |
176 (defconst mouse-throw-magnifier-with-mouse-movement | |
177 [ 16 8 4 2 1 0 0 0 -1 -2 -4 -8 -16]) | |
178 (defconst mouse-throw-magnifier-min -6) | |
179 (defconst mouse-throw-magnifier-max 6) | |
180 | |
181 (defun mouse-drag-throw (start-event) | |
182 "\"Throw\" the page according to a mouse drag. | |
183 | |
184 A \"throw\" is scrolling the page at a speed relative to the distance | |
185 from the original mouse click to the current mouse location. Try it; | |
186 you'll like it. It's easier to observe than to explain. | |
187 | |
188 If the mouse is clicked and released in the same place of time we | |
189 assume that the user didn't want to scdebugroll but wanted to whatever | |
190 mouse-2 used to do, so we pass it through. | |
191 | |
192 Throw scrolling was inspired (but is not identical to) the \"hand\" | |
193 option in MacPaint, or the middle button in Tk text widgets. | |
194 | |
195 If `mouse-throw-with-scroll-bar' is non-nil, then this command scrolls | |
196 in the opposite direction. (Different people have different ideas | |
197 about which direction is natural. Perhaps it has to do with which | |
198 hemisphere you're in.) | |
199 | |
200 To test this function, evaluate: | |
201 (global-set-key [down-mouse-2] 'mouse-drag-throw)" | |
202 (interactive "e") | |
203 ;; we want to do save-selected-window, but that requires 19.29 | |
204 (let* ((start-posn (event-start start-event)) | |
205 (start-window (posn-window start-posn)) | |
206 (start-row (cdr (posn-col-row start-posn))) | |
207 (start-col (car (posn-col-row start-posn))) | |
208 (old-selected-window (selected-window)) | |
209 event end row mouse-delta scroll-delta | |
210 have-scrolled point-event-p old-binding | |
211 window-last-row | |
212 col mouse-col-delta window-last-col | |
213 (scroll-col-delta 0) | |
214 adjusted-mouse-col-delta | |
16320
56f494ed6b13
(mouse-drag-throw): Bind adjusted-mouse-delta.
Richard M. Stallman <rms@gnu.org>
parents:
16319
diff
changeset
|
215 adjusted-mouse-delta |
16319 | 216 ;; be conservative about allowing horizontal scrolling |
217 (col-scrolling-p (mouse-drag-should-do-col-scrolling))) | |
218 (select-window start-window) | |
219 (track-mouse | |
220 (while (progn | |
221 (setq event (read-event) | |
222 end (event-end event) | |
223 row (cdr (posn-col-row end)) | |
224 col (car (posn-col-row end))) | |
225 (or (mouse-movement-p event) | |
226 (eq (car-safe event) 'switch-frame))) | |
227 (if (eq start-window (posn-window end)) | |
228 (progn | |
229 (setq mouse-delta (- start-row row) | |
230 adjusted-mouse-delta | |
231 (- (cond | |
232 ((<= mouse-delta mouse-throw-magnifier-min) | |
233 mouse-throw-magnifier-min) | |
234 ((>= mouse-delta mouse-throw-magnifier-max) | |
235 mouse-throw-magnifier-max) | |
236 (t mouse-delta)) | |
237 mouse-throw-magnifier-min) | |
238 scroll-delta (aref (if mouse-throw-with-scroll-bar | |
239 mouse-throw-magnifier-with-scroll-bar | |
240 mouse-throw-magnifier-with-mouse-movement) | |
241 adjusted-mouse-delta)) | |
242 (if col-scrolling-p | |
243 (setq mouse-col-delta (- start-col col) | |
244 adjusted-mouse-col-delta | |
245 (- (cond | |
246 ((<= mouse-col-delta mouse-throw-magnifier-min) | |
247 mouse-throw-magnifier-min) | |
248 ((>= mouse-col-delta mouse-throw-magnifier-max) | |
249 mouse-throw-magnifier-max) | |
250 (t mouse-col-delta)) | |
251 mouse-throw-magnifier-min) | |
252 scroll-col-delta (aref (if mouse-throw-with-scroll-bar | |
253 mouse-throw-magnifier-with-scroll-bar | |
254 mouse-throw-magnifier-with-mouse-movement) | |
255 adjusted-mouse-col-delta))))) | |
256 (if (or (/= 0 scroll-delta) | |
257 (/= 0 scroll-col-delta)) | |
258 (progn | |
259 (setq have-scrolled t) | |
260 (mouse-drag-safe-scroll scroll-delta scroll-col-delta) | |
261 (mouse-drag-repeatedly-safe-scroll scroll-delta scroll-col-delta))))) ;xxx | |
262 ;; If it was a click and not a drag, prepare to pass the event on. | |
263 ;; Note: We must determine the pass-through event before restoring | |
264 ;; the window, but invoke it after. Sigh. | |
265 (if (and (not have-scrolled) | |
266 (mouse-drag-events-are-point-events-p start-posn end)) | |
267 (setq point-event-p t | |
268 old-binding (key-binding | |
269 (vector (event-basic-type start-event))))) | |
270 ;; Now restore the old window. | |
271 (select-window old-selected-window) | |
272 ;; For clicks, call the old function. | |
273 (if point-event-p | |
274 (call-interactively old-binding)))) | |
275 | |
276 (defun mouse-drag-drag (start-event) | |
277 "\"Drag\" the page according to a mouse drag. | |
278 | |
279 Drag scrolling moves the page according to the movement of the mouse. | |
280 You \"grab\" the character under the mouse and move it around. | |
281 | |
282 If the mouse is clicked and released in the same place of time we | |
283 assume that the user didn't want to scroll but wanted to whatever | |
284 mouse-2 used to do, so we pass it through. | |
285 | |
286 Drag scrolling is identical to the \"hand\" option in MacPaint, or the | |
287 middle button in Tk text widgets. | |
288 | |
289 To test this function, evaluate: | |
290 (global-set-key [down-mouse-2] 'mouse-drag-drag)" | |
291 (interactive "e") | |
292 ;; we want to do save-selected-window, but that requires 19.29 | |
293 (let* ((start-posn (event-start start-event)) | |
294 (start-window (posn-window start-posn)) | |
295 (start-row (cdr (posn-col-row start-posn))) | |
296 (start-col (car (posn-col-row start-posn))) | |
297 (old-selected-window (selected-window)) | |
298 event end row mouse-delta scroll-delta | |
299 have-scrolled point-event-p old-binding | |
300 window-last-row | |
301 col mouse-col-delta window-last-col | |
302 (scroll-col-delta 0) | |
303 ;; be conservative about allowing horizontal scrolling | |
304 (col-scrolling-p (mouse-drag-should-do-col-scrolling))) | |
305 (select-window start-window) | |
306 (setq window-last-row (- (window-height) 2) | |
307 window-last-col (- (window-width) 2)) | |
308 (track-mouse | |
309 (while (progn | |
310 (setq event (read-event) | |
311 end (event-end event) | |
312 row (cdr (posn-col-row end)) | |
313 col (car (posn-col-row end))) | |
314 (or (mouse-movement-p event) | |
315 (eq (car-safe event) 'switch-frame))) | |
316 ;; Scroll if see if we're on the edge. | |
317 ;; NEEDSWORK: should handle mouse-in-other window. | |
318 (cond | |
319 ((not (eq start-window (posn-window end))) | |
320 t) ; wait for return to original window | |
321 ((<= row 0) (mouse-drag-repeatedly-safe-scroll -1 0)) | |
322 ((>= row window-last-row) (mouse-drag-repeatedly-safe-scroll 1 0)) | |
323 ((and col-scrolling-p (<= col 1)) (mouse-drag-repeatedly-safe-scroll 0 -1)) | |
324 ((and col-scrolling-p (>= col window-last-col)) (mouse-drag-repeatedly-safe-scroll 0 1)) | |
325 (t | |
326 (setq scroll-delta (- row start-row) | |
327 start-row row) | |
328 (if col-scrolling-p | |
329 (setq scroll-col-delta (- col start-col) | |
330 start-col col)) | |
331 (if (or (/= 0 scroll-delta) | |
332 (/= 0 scroll-col-delta)) | |
333 (progn | |
334 (setq have-scrolled t) | |
335 (mouse-drag-safe-scroll scroll-delta scroll-col-delta))))))) | |
336 ;; If it was a click and not a drag, prepare to pass the event on. | |
337 ;; Note: We must determine the pass-through event before restoring | |
338 ;; the window, but invoke it after. Sigh. | |
339 (if (and (not have-scrolled) | |
340 (mouse-drag-events-are-point-events-p start-posn end)) | |
341 (setq point-event-p t | |
342 old-binding (key-binding | |
343 (vector (event-basic-type start-event))))) | |
344 ;; Now restore the old window. | |
345 (select-window old-selected-window) | |
346 ;; For clicks, call the old function. | |
347 (if point-event-p | |
348 (call-interactively old-binding)))) | |
349 | |
350 (provide 'mouse-drag) | |
351 | |
352 ;;; mouse-drag.el ends here |