Mercurial > emacs
annotate lisp/vcursor.el @ 18066:eecd891e2b63
(set-language-environment): Add autoload cookie.
Renamed from setup-language-environment.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Sat, 31 May 1997 06:31:43 +0000 |
parents | e4a7b81d6c10 |
children | 7813d4b7bea5 |
rev | line source |
---|---|
17450 | 1 ;;; vcursor.el --- manipulate an alternative ("virtual") cursor. |
2 | |
17902
e4a7b81d6c10
Fix copyright and permission notice.
Richard M. Stallman <rms@gnu.org>
parents:
17450
diff
changeset
|
3 ;; Copyright (C) 1994, 1996 Free Software Foundation, Inc. |
17450 | 4 |
5 ;; Author: Peter Stephenson <pws@ifh.de> | |
6 ;; Keywords: virtual cursor, display, copying | |
7 | |
17902
e4a7b81d6c10
Fix copyright and permission notice.
Richard M. Stallman <rms@gnu.org>
parents:
17450
diff
changeset
|
8 ;; This file is part of GNU Emacs. |
e4a7b81d6c10
Fix copyright and permission notice.
Richard M. Stallman <rms@gnu.org>
parents:
17450
diff
changeset
|
9 |
e4a7b81d6c10
Fix copyright and permission notice.
Richard M. Stallman <rms@gnu.org>
parents:
17450
diff
changeset
|
10 ;; GNU Emacs is free software; you can redistribute it and/or modify |
17450 | 11 ;; it under the terms of the GNU General Public License as published by |
17902
e4a7b81d6c10
Fix copyright and permission notice.
Richard M. Stallman <rms@gnu.org>
parents:
17450
diff
changeset
|
12 ;; the Free Software Foundation; either version 2, or (at your option) |
e4a7b81d6c10
Fix copyright and permission notice.
Richard M. Stallman <rms@gnu.org>
parents:
17450
diff
changeset
|
13 ;; any later version. |
17450 | 14 |
17902
e4a7b81d6c10
Fix copyright and permission notice.
Richard M. Stallman <rms@gnu.org>
parents:
17450
diff
changeset
|
15 ;; GNU Emacs is distributed in the hope that it will be useful, |
17450 | 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 ;; Virtual cursor commands. I got this idea from the old BBC micro. | |
28 ;; You need Emacs 19 (I have not tried XEmacs) and a windowing | |
29 ;; system: I have tried X Windows and Oemacs but any system which | |
30 ;; supports multiple windows should have the ability to run vcursor. | |
31 ;; In fact, only overlays are required to work, though some of the | |
32 ;; key-bindings may need changing. | |
33 ;; | |
34 ;; This is much easier to use than the instructions are to read. | |
35 ;; I suggest you simply load it and play around with holding down Ctrl | |
36 ;; and Shift and pressing up, down, left, right, tab, return, and see | |
37 ;; what happens. (Find a scratch buffer before using C-S-tab: that | |
38 ;; toggles copying.) | |
39 ;; | |
40 ;; Most of the functions described in this documentation are in | |
41 ;; parentheses so that if you have the package loaded you can type C-h | |
42 ;; f on top of them for help. | |
43 ;; | |
44 ;; Using the cursor keys with both control and shift held down moves | |
45 ;; around a virtual cursor, which is initially at point. When active, | |
46 ;; it appears with an underline through it to distinguish it from the | |
47 ;; normal cursor. You can then use one of the other commands to copy | |
48 ;; characters from the location of the virtual cursor to point. This | |
49 ;; is very useful, for example, when copying some previous text while | |
50 ;; making changes to it at the same time, since you never have to move | |
51 ;; the "real" cursor away from where you are inserting. | |
52 ;; | |
53 ;; The remaining default key bindings are based around the PC-type | |
54 ;; cluster found above the cursor keys on a lot of keyboards, the | |
55 ;; function keys which my limited knowledge of X terminals expects to | |
56 ;; find at the top. Some functions are duplicated in more obvious | |
57 ;; places for the X version. | |
58 ;; | |
59 ;; All the keybindings require you to hold down control and shift at | |
60 ;; once. I assumed this combination wouldn't be heavily bound by most | |
61 ;; people and that it would be easy to type with the left hand. | |
62 ;; Inevitably it will clash with some other packages, but I can't help | |
63 ;; that: an intuitive binding is a prerequisite here. See below for | |
64 ;; other alternatives (search for "Oemacs"). | |
65 ;; | |
66 ;; Holding down control and shift and pressing insert (vcursor-copy) | |
67 ;; copies one character from wherever the virtual cursor is to point; | |
68 ;; point and the virtual cursor advance in the separate and equal | |
69 ;; station to which... (etc.). M-C-S-return (vcursor-copy-line) | |
70 ;; copies to the end of the line instead of just one character, | |
71 ;; C-S-delete or C-S-remove (vcursor-copy-word) copies a word. | |
72 ;; | |
73 ;; A more general way of copying is to use C-S-tab, which is a toggle. | |
74 ;; In the "on" state, moving the virtual cursor will copy the | |
75 ;; moved-over text to the normal cursor position (including when going | |
76 ;; backwards, though each piece of text moved over is copied forwards: | |
77 ;; compare the behaviour of C-S-up and C-S-left). | |
78 ;; | |
79 ;; However, that's just a small part of the magic. If the virtual | |
80 ;; cursor goes off the display, it will be redisplayed in some other | |
81 ;; window. (See the function (vcursor-find-window) for details of how | |
82 ;; this window is chosen.) This gives you fingertip control over two | |
83 ;; windows at once. | |
84 ;; | |
85 ;; C-S-return (vcursor-disable) disables the virtual cursor, removing | |
86 ;; it so that it starts from point whenever you move it again --- note | |
87 ;; that simply moving the cursor and virtual cursor on top of one | |
88 ;; another does not have this effect. | |
89 ;; | |
90 ;; If you gave C-S-return a positive prefix arg, it will also delete the | |
91 ;; window (unless it's the current one). Whenever the virtual cursor | |
92 ;; goes off-screen in its own window, point in that window is moved as | |
93 ;; well to restore it to view. (It's easier that way, that's why. | |
94 ;; However, point doesn't move unless the view in the window does, so | |
95 ;; it's not tied to the virtual cursor location.) | |
96 ;; | |
97 ;; You can also use C-S-return with a negative prefix argument which | |
98 ;; forces the vcursor to appear at point. This is particularly useful if | |
99 ;; you actually want to edit in another window but would like to | |
100 ;; remember the current cursor location for examining or copying from | |
101 ;; that buffer. (I just hit C-S-right C-S-left, but I'm a hopeless | |
102 ;; lowbrow.) | |
103 ;; | |
104 ;; There is also C-S-f6 (vcursor-other-window) which behaves like | |
105 ;; C-x o on the virtual rather than the real cursor, except that it | |
106 ;; will create another window if necessary. | |
107 ;; | |
108 ;; The keys C-S-prior (vcursor-scroll-down) and C-S-next | |
109 ;; (vcursor-scroll-up) (i.e., PageUp and PageDown) will scroll the | |
110 ;; virtual cursor window, appropriately chosen. They will always | |
111 ;; create a new window or take over an old one if necessary. | |
112 ;; Likewise, M-C-S-left and M-C-S-right move you to the | |
113 ;; beginning or end of a line, C-S-home and C-S-end the | |
114 ;; beginning or end of a buffer (these are also on M-C-S-up and | |
115 ;; M-C-S-down for those of us stuck with DEC keyboards). | |
116 ;; | |
117 ;; C-S-f7 (vcursor-goto) will take you to the vcursor position | |
118 ;; (swapping windows if it seems sensible) and (unless you give it a | |
119 ;; prefix argument) delete the virtual cursor, so this is useful for | |
120 ;; you to take over editing at the virtual cursor position. It is not | |
121 ;; an error if the virtual cursor is not active; it simply leaves you | |
122 ;; at point, because that is where the virtual cursor would start | |
123 ;; from. | |
124 ;; | |
125 ;; In a similar vein, M-C-S-tab (hope your left hand's flexible; | |
126 ;; C-S-select on DEC keyboards) (vcursor-swap-point) will take you to | |
127 ;; the virtual cursor position but simultaneously put the virtual | |
128 ;; cursor at the old cursor position. It is also supposed to ensure | |
129 ;; that both are visible. | |
130 ;; | |
131 ;; C-S-f8 (C-S-find on DEC keyboards) (vcursor-isearch-forward) | |
132 ;; allows you to do an isearch in another window. It works a bit like | |
133 ;; vcursor-scroll-*; it moves into another window, calls isearch | |
134 ;; there, and sets the virtual cursor position to the point found. In | |
135 ;; other words, it works just like isearch but with the virtual cursor | |
136 ;; instead of the real one (that's why it's called a "virtual | |
137 ;; cursor"). While you are isearching, you are editing in the virtual | |
138 ;; cursor window, but when you have finished you return to where you | |
139 ;; started. Note that once you are in isearch all the keys are normal | |
140 ;; --- use C-s, not C-S-f8, to search for the next occurrence. | |
141 ;; | |
142 ;; If you set the variable vcursor-auto-disable, then any command | |
143 ;; which does not involve moving or copying from the virtual cursor | |
144 ;; causes the virtual cursor to be disabled. If you don't intend to | |
145 ;; use this, you can comment out the `add-hook' line at the bottom of | |
146 ;; this file. (This feature partially emulates the way the "copy" key | |
147 ;; on the BBC micro worked; actually, the copy cursor was homed when | |
148 ;; you hit return. This was in keeping with the line-by-line way of | |
149 ;; entering BASIC, but is less appropriate here.) | |
150 ;; | |
151 ;; There is a way of moving the virtual cursor using ordinary | |
152 ;; commands: C-S-f9 (vcursor-execute-key) reads a key string, | |
153 ;; moves to the virtual cursor position, executes the command bound to | |
154 ;; the string, then returns to the original point. Thus C-S-f9 M-m | |
155 ;; moves the virtual cursor back to the first non-whitespace character | |
156 ;; on its line. As the command is called interactively all the usual | |
157 ;; ways of passing information to the command called, such as by a | |
158 ;; prefix argument, are available. C-S-f10 (C-S-x) | |
159 ;; (vcursor-execute-command) behaves the same way but you enter the | |
160 ;; name of the command. Of course, only some commands are useful | |
161 ;; here, mainly simple movement commands. Killing at the virtual | |
162 ;; cursor position in this way works as well; you can even save | |
163 ;; another buffer with C-S-f9 C-x C-s. To do anything more | |
164 ;; complicated, you are better off using M-C-S-tab | |
165 ;; (vcursor-swap-point), doing whatever it is, then calling M-C-S-tab | |
166 ;; again. | |
167 ;; | |
168 ;; If you want to add your own moving or copying functions you should | |
169 ;; be able to do this fairly easily with (vcursor-relative-move) and | |
170 ;; (vcursor-copy) together with (vcursor-get-char-count). If you want to | |
171 ;; do something in a different window, use (vcursor-window-funcall). | |
172 ;; | |
173 ;; There is an alternative set of key bindings which will be used | |
174 ;; automatically for a PC if Oemacs is detected. This set uses separate | |
175 ;; control, shift and meta keys with function keys 1 to 10. In | |
176 ;; particular, movement keys are concentrated on f5 to f8 with (in | |
177 ;; increasing order of distance travelled) C-, M- and S- as prefixes. | |
178 ;; See the actual bindings below (search for C-f1). This is because the | |
179 ;; C-S- prefix is represented by weird key sequences and the set is | |
180 ;; incomplete; if you don't mind that, some hints are given in comments | |
181 ;; below. | |
182 ;; | |
183 ;; You can specify the usual or the Oemacs bindings by setting the | |
184 ;; variable vcursor-key-bindings to `xterm' or `oemacs'. You can also set | |
185 ;; it to nil, in which case vcursor will not make any key bindings | |
186 ;; and you can define your own. The default is t, which makes vcursor | |
187 ;; guess (it will use xterm unless it thinks Oemacs is running). The | |
188 ;; oemacs set will work on an X terminal with function keys, but the | |
189 ;; xterm set will not work under Oemacs. | |
190 ;; | |
191 ;; Un-features: | |
192 ;; - The vcursor will not move to point-max, since otherwise it would | |
193 ;; disappear. However, no error is flagged as point-max is a valid | |
194 ;; point in the buffer. Thus cursor right or down at the second | |
195 ;; last point in the file does not flag an error, which is inconsistent, | |
196 ;; and if copying is on the last character (typically newline) will | |
197 ;; be repeatedly copied. (I've tried making it flag an error | |
198 ;; instead and that's worse since often the vcursor is sent to | |
199 ;; point in some other window, which may be point-max.) | |
200 ;; - The vcursor widens when over a tab character or right at the | |
201 ;; end of the line. You're welcome to consider this a feature; | |
202 ;; it's just a part of how overlays work. | |
203 ;; - The vcursor obscures the real cursor. Creative use of overlays | |
204 ;; could cure this. | |
205 ;; - The vcursor does not remember its own previous positions. If | |
206 ;; you cycle it back into a window it was in before, it will be at | |
207 ;; point in that window. Often, that is where a previous recenter | |
208 ;; left point, not where the vcursor was before. | |
209 ;; (Note, however, that the vcursor does remember where it *is*, | |
210 ;; even if it's off-screen. This can also lead to surprises, but I | |
211 ;; don't think it's a bug.) | |
212 ;; - vcursor-window-funcall could perhaps be smarter about restoring | |
213 ;; the previous window state on failure. | |
214 ;; - The logic in vcursor-find-window is rather complicated and | |
215 ;; therefore bug-prone, though in practice it seems to work OK. | |
216 ;; | |
217 ;; Possible enhnacements: | |
218 ;; It would be easy to implement vcursor-push (save vcursor position | |
219 ;; as mark and deactivate) and vcursor-pop (deactivate vcursor and | |
220 ;; move to last pushed position) functions. | |
221 | |
222 ;;; Code: | |
223 | |
224 (or (memq 'vcursor (face-list)) | |
225 (progn | |
226 (copy-face 'modeline 'vcursor) | |
227 (if (or (fboundp 'oemacs-version) (x-display-color-p)) | |
228 (progn | |
229 (set-face-foreground 'vcursor "blue") | |
230 (set-face-background 'vcursor "cyan"))) | |
231 (set-face-underline-p 'vcursor t))) | |
232 | |
233 (defvar vcursor-auto-disable nil | |
234 "*If non-nil, disable the virtual cursor after use. | |
235 Any non-vcursor command will force `vcursor-disable' to be called.") | |
236 | |
237 (defvar vcursor-key-bindings t | |
238 "*How to bind keys when vcursor is loaded. | |
239 If t (the default), guess; if xterm, use bindings suitable for an | |
240 X terminal; if oemacs, use bindings which work on a PC with Oemacs. | |
241 If nil, don't define any key bindings.") | |
242 | |
243 (defvar vcursor-overlay nil | |
244 "Overlay for the virtual cursor. | |
245 It is nil if that is not enabled.") | |
246 | |
247 (defvar vcursor-window nil | |
248 "Last window to have displayed the virtual cursor. | |
249 See the function `vcursor-find-window' for how this is used.") | |
250 | |
251 (defvar vcursor-last-command nil | |
252 "Non-nil if last command was a vcursor command. | |
253 The commands `vcursor-copy', `vcursor-relative-move' and the ones for | |
254 scrolling set this. It is used by the `vcursor-auto-disable' code.") | |
255 ;; could do some memq-ing with last-command instead, but this will | |
256 ;; automatically handle any new commands using the primitives. | |
257 | |
258 (defvar vcursor-copy-flag nil | |
259 "*Non-nil means moving vcursor should copy characters moved over to point.") | |
260 | |
261 (defvar vcursor-temp-goal-column nil | |
262 "Keeps track of temporary goal columns for the virtual cursor.") | |
263 | |
264 (cond | |
265 ((not vcursor-key-bindings)) ;; don't set any key bindings | |
266 ((or (eq vcursor-key-bindings 'oemacs) | |
267 (and (eq vcursor-key-bindings t) (fboundp 'oemacs-version))) | |
268 (global-set-key [C-f1] 'vcursor-toggle-copy) | |
269 (global-set-key [C-f2] 'vcursor-copy) | |
270 (global-set-key [C-f3] 'vcursor-copy-word) | |
271 (global-set-key [C-f4] 'vcursor-copy-line) | |
272 | |
273 (global-set-key [S-f1] 'vcursor-disable) | |
274 (global-set-key [S-f2] 'vcursor-other-window) | |
275 (global-set-key [S-f3] 'vcursor-goto) | |
276 (global-set-key [S-f4] 'vcursor-swap-point) | |
277 | |
278 (global-set-key [C-f5] 'vcursor-backward-char) | |
279 (global-set-key [C-f6] 'vcursor-previous-line) | |
280 (global-set-key [C-f7] 'vcursor-next-line) | |
281 (global-set-key [C-f8] 'vcursor-forward-char) | |
282 | |
283 (global-set-key [M-f5] 'vcursor-beginning-of-line) | |
284 (global-set-key [M-f6] 'vcursor-backward-word) | |
285 (global-set-key [M-f6] 'vcursor-forward-word) | |
286 (global-set-key [M-f8] 'vcursor-end-of-line) | |
287 | |
288 (global-set-key [S-f5] 'vcursor-beginning-of-buffer) | |
289 (global-set-key [S-f6] 'vcursor-scroll-down) | |
290 (global-set-key [S-f7] 'vcursor-scroll-up) | |
291 (global-set-key [S-f8] 'vcursor-end-of-buffer) | |
292 | |
293 (global-set-key [C-f9] 'vcursor-isearch-forward) | |
294 | |
295 (global-set-key [S-f9] 'vcursor-execute-key) | |
296 (global-set-key [S-f10] 'vcursor-execute-command) | |
297 | |
298 ;;; Partial dictionary of Oemacs key sequences for you to roll your own, | |
299 ;;; e.g C-S-up: (global-set-key "\M-[\C-f\M-\C-m" 'vcursor-previous-line) | |
300 ;;; Sequence: Sends: | |
301 ;;; "\M-[\C-f\M-\C-m" C-S-up | |
302 ;;; "\M-[\C-f\M-\C-q" C-S-down | |
303 ;;; "\M-[\C-fs" C-S-left | |
304 ;;; "\M-[\C-ft" C-S-right | |
305 ;;; | |
306 ;;; "\M-[\C-fw" C-S-home | |
307 ;;; "\M-[\C-b\C-o" S-tab | |
308 ;;; "\M-[\C-f\M-\C-r" C-S-insert | |
309 ;;; "\M-[\C-fu" C-S-end | |
310 ;;; "\M-[\C-f\M-\C-s" C-S-delete | |
311 ;;; "\M-[\C-f\M-\C-d" C-S-prior | |
312 ;;; "\M-[\C-fv" C-S-next | |
313 ;;; | |
314 ;;; "\M-[\C-f^" C-S-f1 | |
315 ;;; "\M-[\C-f_" C-S-f2 | |
316 ;;; "\M-[\C-f`" C-S-f3 | |
317 ;;; "\M-[\C-fa" C-S-f4 | |
318 ;;; "\M-[\C-fb" C-S-f5 | |
319 ;;; "\M-[\C-fc" C-S-f6 | |
320 ;;; "\M-[\C-fd" C-S-f7 | |
321 ;;; "\M-[\C-fe" C-S-f8 | |
322 ;;; "\M-[\C-ff" C-S-f9 | |
323 ;;; "\M-[\C-fg" C-S-f10 | |
324 ) | |
325 (t | |
326 (global-set-key [C-S-up] 'vcursor-previous-line) | |
327 (global-set-key [C-S-down] 'vcursor-next-line) | |
328 (global-set-key [C-S-left] 'vcursor-backward-char) | |
329 (global-set-key [C-S-right] 'vcursor-forward-char) | |
330 | |
331 (global-set-key [C-S-return] 'vcursor-disable) | |
332 (global-set-key [C-S-insert] 'vcursor-copy) | |
333 (global-set-key [C-S-delete] 'vcursor-copy-word) | |
334 (global-set-key [C-S-remove] 'vcursor-copy-word) | |
335 (global-set-key [C-S-tab] 'vcursor-toggle-copy) | |
336 (global-set-key [C-S-home] 'vcursor-beginning-of-buffer) | |
337 (global-set-key [M-C-S-up] 'vcursor-beginning-of-buffer) | |
338 (global-set-key [C-S-end] 'vcursor-end-of-buffer) | |
339 (global-set-key [M-C-S-down] 'vcursor-end-of-buffer) | |
340 (global-set-key [C-S-prior] 'vcursor-scroll-down) | |
341 (global-set-key [C-S-next] 'vcursor-scroll-up) | |
342 | |
343 (global-set-key [C-S-f6] 'vcursor-other-window) | |
344 (global-set-key [C-S-f7] 'vcursor-goto) | |
345 | |
346 (global-set-key [C-S-select] 'vcursor-swap-point) ; DEC keyboards | |
347 (global-set-key [M-C-S-tab] 'vcursor-swap-point) | |
348 | |
349 (global-set-key [C-S-find] 'vcursor-isearch-forward) ; DEC keyboards | |
350 (global-set-key [C-S-f8] 'vcursor-isearch-forward) | |
351 | |
352 (global-set-key [M-C-S-left] 'vcursor-beginning-of-line) | |
353 (global-set-key [M-C-S-right] 'vcursor-end-of-line) | |
354 | |
355 (global-set-key [M-C-S-prior] 'vcursor-backward-word) | |
356 (global-set-key [M-C-S-next] 'vcursor-forward-word) | |
357 | |
358 (global-set-key [M-C-S-return] 'vcursor-copy-line) | |
359 | |
360 (global-set-key [C-S-f9] 'vcursor-execute-key) | |
361 (global-set-key [C-S-f10] 'vcursor-execute-command) | |
362 )) | |
363 | |
364 (defun vcursor-locate () | |
365 "Go to the starting point of the virtual cursor. | |
366 If that's disabled, don't go anywhere but don't complain." | |
367 ;; This is where we go off-mass-shell. Assume there is a | |
368 ;; save-excursion to get us back to the pole, er, point. | |
369 | |
370 (and (overlayp vcursor-overlay) | |
371 (overlay-buffer vcursor-overlay) | |
372 (set-buffer (overlay-buffer vcursor-overlay)) | |
373 (goto-char (overlay-start vcursor-overlay))) | |
374 ) | |
375 | |
376 (defun vcursor-find-window (&optional not-this new-win this-frame) | |
377 "Return a suitable window for displaying the virtual cursor. | |
378 This is the first window in cyclic order where the vcursor is visible. | |
379 | |
380 With optional NOT-THIS non-nil never return the current window. | |
381 | |
382 With NEW-WIN non-nil, display the virtual cursor buffer in another | |
383 window if the virtual cursor is not currently visible \(note, however, | |
384 that this function never changes window-point\). | |
385 | |
386 With THIS-FRAME non-nil, don't search other frames for a new window | |
387 \(though if the vcursor is already off-frame then its current window is | |
388 always considered, and the value of `pop-up-frames' is always respected\). | |
389 | |
390 Returns nil if the virtual cursor is not visible anywhere suitable. | |
391 Set `vcursor-window' to the returned value as a side effect." | |
392 | |
393 ;; The order of priorities (respecting NOT-THIS) is (1) | |
394 ;; vcursor-window if the virtual cursor is visible there (2) any | |
395 ;; window displaying the virtual cursor (3) vcursor-window provided | |
396 ;; it is still displaying the buffer containing the virtual cursor and | |
397 ;; is not selected (4) any unselected window displaying the vcursor | |
398 ;; buffer (5) with NEW-WIN, a window selected by display-buffer (so | |
399 ;; the variables pop-up-windows and pop-up-frames are significant) | |
400 ;; (6) nil. | |
401 | |
402 (let ((thiswin (selected-window)) winok winbuf) | |
403 (save-excursion | |
404 (vcursor-locate) | |
405 (or (and (window-live-p vcursor-window) | |
406 (eq (current-buffer) (window-buffer vcursor-window)) | |
407 (not (and not-this (eq thiswin vcursor-window)))) | |
408 (setq vcursor-window nil)) | |
409 (or (and vcursor-window ; choice 1 | |
410 (pos-visible-in-window-p (point) vcursor-window)) | |
411 (progn | |
412 (walk-windows | |
413 (function | |
414 (lambda (win) | |
415 (and (not winok) | |
416 (eq (current-buffer) (window-buffer win)) | |
417 (not (and not-this (eq thiswin win))) | |
418 (cond | |
419 ((pos-visible-in-window-p (point) win) (setq winok win)) | |
420 ((eq thiswin win)) | |
421 ((not winbuf) (setq winbuf win)))))) | |
422 nil (not this-frame)) | |
423 (setq vcursor-window | |
424 (cond | |
425 (winok) ; choice 2 | |
426 ((and vcursor-window ; choice 3 | |
427 (not (eq thiswin vcursor-window))) vcursor-window) | |
428 (winbuf) ; choice 4 | |
429 (new-win (display-buffer (current-buffer) t)) ; choice 5 | |
430 (t nil))))))) ; default (choice 6) | |
431 vcursor-window | |
432 ) | |
433 | |
434 (defun vcursor-toggle-copy (&optional arg nomsg) | |
435 "Toggle copying to point when the vcursor is moved. | |
436 With a prefix ARG, turn on if non-negative, off if negative. | |
437 Display a message unless optional NOMSG is non-nil." | |
438 (interactive "P") | |
439 (setq vcursor-copy-flag | |
440 (cond ((not arg) (not vcursor-copy-flag)) | |
441 ((< (prefix-numeric-value arg) 0) nil) | |
442 (t)) | |
443 vcursor-last-command t) | |
444 (or nomsg (message "Copying from the vcursor is now %s." | |
445 (if vcursor-copy-flag "on" "off"))) | |
446 ) | |
447 | |
448 (defun vcursor-move (pt) | |
449 "Move the virtual cursor to the character to the right of PT. | |
450 PT is an absolute location in the current buffer. | |
451 | |
452 If the new virtual cursor location would not be visible, display it in | |
453 another window." | |
454 ;; this works even if we're on-mass-shell, but usually we won't be. | |
455 | |
456 (if (eq pt (point-max)) (setq pt (1- pt))) | |
457 (if (vcursor-check t) | |
458 (move-overlay vcursor-overlay pt (+ pt 1) (current-buffer)) | |
459 (setq vcursor-overlay (make-overlay pt (+ pt 1))) | |
460 (overlay-put vcursor-overlay 'face 'vcursor)) | |
461 (vcursor-find-window nil t) | |
462 ;; vcursor-window now contains the right buffer | |
463 (or (pos-visible-in-window-p pt vcursor-window) | |
464 (set-window-point vcursor-window pt)) | |
465 ) | |
466 | |
467 (defun vcursor-relative-move (fn &rest args) | |
468 "Use FUNCTION with arbitrary ARG1 ... to move the virtual cursor. | |
469 | |
470 This is called by most of the virtual-cursor motion commands." | |
471 (let (text opoint) | |
472 (save-excursion | |
473 (vcursor-locate) | |
474 (setq opoint (point)) | |
475 (apply fn args) | |
476 (and (eq opoint (point-max)) (eq opoint (point)) | |
477 (signal 'end-of-buffer nil)) | |
478 (vcursor-move (point)) | |
479 (if vcursor-copy-flag (setq text (buffer-substring opoint (point))))) | |
480 (if text (insert text))) | |
481 (setq vcursor-last-command t) | |
482 ) | |
483 | |
484 (defun vcursor-goto (&optional arg) | |
485 "Move the real cursor to the virtual cursor position. | |
486 If the virtual cursor is (or was recently) visible in another window, | |
487 switch to that first. Without a prefix ARG, disable the virtual | |
488 cursor as well." | |
489 | |
490 (interactive "P") | |
491 (and (vcursor-find-window) (select-window vcursor-window)) | |
492 (let ((buf (and vcursor-overlay (overlay-buffer vcursor-overlay)))) | |
493 (and buf (not (eq (current-buffer) buf)) (switch-to-buffer buf))) | |
494 (vcursor-locate) | |
495 (or arg (vcursor-disable)) | |
496 ) | |
497 | |
498 (defun vcursor-swap-point () | |
499 "Swap the location of point and that of the virtual cursor. | |
500 | |
501 The virtual cursor window becomes the selected window and the old | |
502 window becomes the virtual cursor window. If the virtual cursor would | |
503 not be visible otherwise, display it in another window." | |
504 | |
505 (interactive) | |
506 (let ((buf (current-buffer)) (here (point)) (win (selected-window))) | |
507 (vcursor-goto) ; will disable the vcursor | |
508 (save-excursion | |
509 (set-buffer buf) | |
510 (setq vcursor-window win) | |
511 (vcursor-move here))) | |
512 ) | |
513 | |
514 (defun vcursor-scroll-up (&optional n) | |
515 "Scroll up the vcursor window ARG lines or near full screen if none. | |
516 The vcursor will always appear in an unselected window." | |
517 | |
518 (interactive "P") | |
519 (vcursor-window-funcall 'scroll-up n) | |
520 ) | |
521 | |
522 (defun vcursor-scroll-down (&optional n) | |
523 "Scroll down the vcursor window ARG lines or near-full screen if none. | |
524 The vcursor will always appear in an unselected window." | |
525 | |
526 (interactive "P") | |
527 (vcursor-window-funcall 'scroll-down n) | |
528 ) | |
529 | |
530 (defun vcursor-isearch-forward (&optional rep norecurs) | |
531 "Perform forward incremental search in the virtual cursor window. | |
532 The virtual cursor is moved to the resulting point; the ordinary | |
533 cursor stays where it was." | |
534 | |
535 (interactive "P") | |
536 (vcursor-window-funcall 'isearch-forward rep norecurs) | |
537 ) | |
538 | |
539 (defun vcursor-window-funcall (func &rest args) | |
540 "Call FUNC with ARGS ... in a virtual cursor window. | |
541 A window other than the currently-selected one will always be used. | |
542 The virtual cursor is moved to the value of point when the function | |
543 returns." | |
544 | |
545 (vcursor-find-window t t) | |
546 (let ((sw (selected-window)) text) | |
547 ;; We can't use save-window-excursion because that would restore | |
548 ;; the original display in the window we may want to alter. | |
549 (unwind-protect | |
550 (let ((here (point))) | |
551 (select-window vcursor-window) | |
552 (vcursor-locate) | |
553 (apply func args) | |
554 (if vcursor-copy-flag (setq text (buffer-substring here (point)))) | |
555 (vcursor-move (point))) | |
556 (select-window sw)) | |
557 (if text (insert text))) | |
558 (setq vcursor-last-command t) | |
559 ) | |
560 | |
561 (defun vcursor-get-char-count (fn &rest args) | |
562 "Apply FN to ARG1 ... and return the number of characters moved. | |
563 Point is temporarily set to the virtual cursor position before FN is | |
564 called. | |
565 | |
566 This is called by most of the virtual-cursor copying commands to find | |
567 out how much to copy." | |
568 | |
569 (vcursor-check) | |
570 (save-excursion | |
571 (set-buffer (overlay-buffer vcursor-overlay)) | |
572 (let ((start (goto-char (overlay-start vcursor-overlay)))) | |
573 (- (progn (apply fn args) (point)) start))) | |
574 ) | |
575 | |
576 ;; Make sure the virtual cursor is active. Unless arg is non-nil, | |
577 ;; report an error if it is not. | |
578 (defun vcursor-check (&optional arg) | |
579 (cond | |
580 ((and (overlayp vcursor-overlay) (overlay-start vcursor-overlay)) | |
581 t) | |
582 (arg nil) | |
583 (t (error "The virtual cursor is not active now."))) | |
584 ) | |
585 | |
586 (defun vcursor-disable (&optional arg) | |
587 "Disable the virtual cursor. | |
588 Next time you use it, it will start from point. | |
589 | |
590 With a positive prefix ARG, the first window in cyclic order | |
591 displaying the virtual cursor (or which was recently displaying the | |
592 virutal cursor) will be deleted unless it's the selected | |
593 window. | |
594 | |
595 With a negative prefix argument, enable the virtual cursor: make it | |
596 active at the same point as the real cursor. | |
597 | |
598 Copying mode is always turned off: the next use of the vcursor will | |
599 not copy text until you turn it on again." | |
600 | |
601 (interactive "P") | |
602 (if (overlayp vcursor-overlay) | |
603 (progn | |
604 (delete-overlay vcursor-overlay) | |
605 (setq vcursor-overlay nil))) | |
606 (cond | |
607 ((not (vcursor-find-window t))) | |
608 ((or (not arg) (< (prefix-numeric-value arg) 0))) | |
609 ((delete-window vcursor-window))) | |
610 (and arg (< (prefix-numeric-value arg) 0) | |
611 (progn | |
612 (vcursor-move (point)) | |
613 (setq vcursor-window (selected-window)))) | |
614 (setq vcursor-copy-flag nil) | |
615 ) | |
616 | |
617 (defun vcursor-other-window (n &optional all-frames) | |
618 "Activate the virtual cursor in another window. | |
619 This is the next window cylically after one currently showing the | |
620 virtual cursor, or else after the current selected window. If there | |
621 is no other window, the current window is split. | |
622 | |
623 Arguments N and optional ALL-FRAMES are the same as with other-window. | |
624 ALL-FRAMES is also used to decide whether to split the window." | |
625 | |
626 (interactive "p") | |
627 (if (if (fboundp 'oemacs-version) | |
628 (one-window-p nil) | |
629 (one-window-p nil all-frames)) | |
630 (display-buffer (current-buffer) t)) | |
631 (save-excursion | |
632 (save-window-excursion | |
633 ;; We don't use fancy vcursor-find-window trickery, since we're | |
634 ;; quite happy to have the vcursor cycle back into the current | |
635 ;; window. | |
636 (let ((sw (selected-window)) | |
637 (win (vcursor-find-window nil nil (not all-frames)))) | |
638 (if win (select-window win)) | |
639 ;; else start from here | |
640 (other-window n all-frames) | |
641 (vcursor-disable -1)))) | |
642 ) | |
643 | |
644 (defun vcursor-compare-windows (&optional arg) | |
645 "Call `compare-windows' in the vcursor window. | |
646 This has the effect of comparing the vcursor window with whichever | |
647 window `next-window' returns there, which may not be the selected one. | |
648 | |
649 A prefix argument, if any, is passed to `compare-windows'." | |
650 (interactive "P") | |
651 (vcursor-window-funcall 'compare-windows arg)) | |
652 | |
653 (defun vcursor-next-line (arg) | |
654 "Move the virtual cursor forward ARG lines." | |
655 ;; This is next-line rewritten for the vcursor. Maybe it would | |
656 ;; be easier simply to rewrite line-move. | |
657 (interactive "p") | |
658 (let (temporary-goal-column opoint text) | |
659 (save-excursion | |
660 (vcursor-locate) | |
661 (setq temporary-goal-column | |
662 (if (or (eq last-command 'vcursor-next-line) | |
663 (eq last-command 'vcursor-previous-line)) | |
664 (progn | |
665 (setq last-command 'next-line) ; trick line-move | |
666 vcursor-temp-goal-column) | |
667 (if (and track-eol (eolp) | |
668 (or (not (bolp)) (eq last-command 'end-of-line))) | |
669 9999 | |
670 (current-column))) | |
671 opoint (point)) | |
672 (line-move arg) | |
673 (and (eq opoint (point-max)) (eq opoint (point)) | |
674 (signal 'end-of-buffer nil)) | |
675 (if vcursor-copy-flag (setq text (buffer-substring opoint (point)))) | |
676 (vcursor-move (point)) | |
677 (setq vcursor-temp-goal-column temporary-goal-column | |
678 vcursor-last-command t)) | |
679 (if text (insert text))) | |
680 ) | |
681 | |
682 (defun vcursor-previous-line (arg) | |
683 "Move the virtual cursor back ARG lines." | |
684 (interactive "p") | |
685 (vcursor-next-line (- arg)) | |
686 ) | |
687 | |
688 (defun vcursor-forward-char (arg) | |
689 "Move the virtual cursor forward ARG characters." | |
690 (interactive "p") | |
691 (vcursor-relative-move 'forward-char arg) | |
692 ) | |
693 | |
694 (defun vcursor-backward-char (arg) | |
695 "Move the virtual cursor backward ARG characters." | |
696 (interactive "p") | |
697 (vcursor-relative-move 'backward-char arg) | |
698 ) | |
699 | |
700 (defun vcursor-forward-word (arg) | |
701 "Move the virtual cursor forward ARG words." | |
702 (interactive "p") | |
703 (vcursor-relative-move 'forward-word arg) | |
704 ) | |
705 | |
706 (defun vcursor-backward-word (arg) | |
707 "Move the virtual cursor backward ARG words." | |
708 (interactive "p") | |
709 (vcursor-relative-move 'backward-word arg) | |
710 ) | |
711 | |
712 (defun vcursor-beginning-of-line (arg) | |
713 "Move the virtual cursor to beginning of its current line. | |
714 ARG is as for `beginning-of-line'." | |
715 (interactive "P") | |
716 (vcursor-relative-move 'beginning-of-line | |
717 (if arg (prefix-numeric-value arg))) | |
718 ) | |
719 | |
720 (defun vcursor-end-of-line (arg) | |
721 "Move the virtual cursor to end of its current line. | |
722 ARG is as for `end-of-line'." | |
723 (interactive "P") | |
724 (vcursor-relative-move 'end-of-line | |
725 (if arg (prefix-numeric-value arg))) | |
726 ) | |
727 | |
728 (defun vcursor-beginning-of-buffer (&optional arg) | |
729 "Move the virtual cursor to the beginning of its buffer. | |
730 ARG is as for beginning-of-buffer." | |
731 (interactive "P") | |
732 (vcursor-relative-move | |
733 (lambda (arg) | |
734 (goto-char (if arg (/ (* arg (- (point-max) (point-min))) 10) | |
735 (point-min)))) | |
736 (if arg (prefix-numeric-value arg))) | |
737 ) | |
738 | |
739 (defun vcursor-end-of-buffer (&optional arg) | |
740 "Move the virtual cursor to the end of its buffer. | |
741 ARG is as for end-of-buffer. | |
742 | |
743 Actually, the vcursor is moved to the second from last character or it | |
744 would be invisible." | |
745 (interactive "P") | |
746 (vcursor-relative-move | |
747 (lambda (arg) | |
748 (goto-char (if arg (- (point-max) | |
749 (/ (* arg (- (point-max) (point-min))) 10)) | |
750 (point-max)))) | |
751 (if arg (prefix-numeric-value arg))) | |
752 ) | |
753 | |
754 (defun vcursor-execute-command (cmd) | |
755 "Execute COMMAND for the virtual cursor. | |
756 COMMAND is called interactively. Not all commands (in fact, only a | |
757 small subset) are useful." | |
758 (interactive "CCommand: ") | |
759 (let (text opoint) | |
760 (save-excursion | |
761 (vcursor-locate) | |
762 (setq opoint (point)) | |
763 (call-interactively cmd) | |
764 (if vcursor-copy-flag (setq text (buffer-substring opoint (point)))) | |
765 (vcursor-move (point))) | |
766 (if text (insert text))) | |
767 (setq vcursor-last-command t) | |
768 ) | |
769 | |
770 (defun vcursor-execute-key (keys) | |
771 "Execute the command bound to KEYS for the virtual cursor. | |
772 The command found is called interactively, so prefix argument etc. | |
773 are usable." | |
774 | |
775 (interactive "kKey sequence: ") | |
776 (let ((cmd (key-binding keys))) | |
777 (if cmd (vcursor-execute-command (key-binding keys)))) | |
778 ) | |
779 | |
780 (defun vcursor-copy (arg) | |
781 "Copy ARG characters from the virtual cursor position to point." | |
782 (interactive "p") | |
783 (vcursor-check) | |
784 (insert | |
785 (save-excursion | |
786 (set-buffer (overlay-buffer vcursor-overlay)) | |
787 (let* ((ostart (overlay-start vcursor-overlay)) | |
788 (end (+ ostart arg))) | |
789 (prog1 | |
790 (buffer-substring ostart end) | |
791 (vcursor-move end))))) | |
792 (setq vcursor-last-command t) | |
793 ) | |
794 | |
795 (defun vcursor-copy-word (arg) | |
796 "Copy ARG words from the virtual cursor position to point." | |
797 (interactive "p") | |
798 (vcursor-copy (vcursor-get-char-count 'forward-word arg)) | |
799 ) | |
800 | |
801 (defun vcursor-copy-line (arg) | |
802 "Copy up to ARGth line after virtual cursor position. | |
803 With no argument, copy to the end of the current line. | |
804 | |
805 Behaviour with regard to newlines is similar (but not identical) to | |
806 `kill-line'; the main difference is that whitespace at the end of the | |
807 line is treated like ordinary characters." | |
808 | |
809 (interactive "P") | |
810 (let* ((num (prefix-numeric-value arg)) | |
811 (count (vcursor-get-char-count 'end-of-line num))) | |
812 (vcursor-copy (if (or (= count 0) arg) (1+ count) count))) | |
813 ) | |
814 | |
815 (defun vcursor-post-command () | |
816 (and vcursor-auto-disable (not vcursor-last-command) | |
817 vcursor-overlay (vcursor-disable)) | |
818 (setq vcursor-last-command nil) | |
819 ) | |
820 | |
821 (add-hook 'post-command-hook 'vcursor-post-command) | |
822 | |
823 (provide 'vcursor) | |
824 | |
825 ;; vcursor.el ends here |