Commit | Line | Data |
---|---|---|
55535639 | 1 | ;;; vcursor.el --- manipulate an alternative ("virtual") cursor |
bf078b46 | 2 | |
acaf905b | 3 | ;; Copyright (C) 1994, 1996, 1998, 2001-2012 Free Software Foundation, Inc. |
bf078b46 | 4 | |
2d6a4733 | 5 | ;; Author: Peter Stephenson <pws@ibmth.df.unipi.it> |
19b4af82 | 6 | ;; Maintainer: FSF |
949b810e | 7 | ;; Keywords: virtual cursor, convenience |
bf078b46 | 8 | |
83d7d14c RS |
9 | ;; This file is part of GNU Emacs. |
10 | ||
eb3fa2cf | 11 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
bf078b46 | 12 | ;; it under the terms of the GNU General Public License as published by |
eb3fa2cf GM |
13 | ;; the Free Software Foundation, either version 3 of the License, or |
14 | ;; (at your option) any later version. | |
bf078b46 | 15 | |
83d7d14c | 16 | ;; GNU Emacs is distributed in the hope that it will be useful, |
bf078b46 RS |
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 | |
eb3fa2cf | 22 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
bf078b46 RS |
23 | |
24 | ;;; Commentary: | |
25 | ||
2d6a4733 RS |
26 | ;; Latest changes |
27 | ;; ============== | |
29fddfff | 28 | ;; |
2d6a4733 RS |
29 | ;; - *IMPORTANT* vcursor-key-bindings is now nil by default, to avoid |
30 | ;; side-effects when the package is loaded. This means no keys are | |
31 | ;; bound by default. Use customize to change it to t to restore | |
fffa137c | 32 | ;; the old behavior. (If you do it by hand in .emacs, it |
2d6a4733 RS |
33 | ;; must come before vcursor is loaded.) |
34 | ;; - You can alter the main variables and the vcursor face via | |
35 | ;; M-x customize: go to the Editing group and find Vcursor. | |
36 | ;; - vcursor-auto-disable can now be 'copy (actually any value not nil | |
37 | ;; or t), which means that copying from the vcursor will be turned | |
38 | ;; off after any operation not involving the vcursor, but the | |
39 | ;; vcursor itself will be left alone. | |
29fddfff RS |
40 | ;; - works on dumb terminals with Emacs 19.29 and later |
41 | ;; - new keymap vcursor-map for binding to a prefix key | |
42 | ;; - vcursor-compare-windows substantially improved | |
43 | ;; - vcursor-execute-{key,command} much better about using the | |
44 | ;; right keymaps and arranging for the correct windows to be used | |
45 | ;; - vcursor-window-funcall can call functions interactively | |
46 | ;; - vcursor-interpret-input for special effects | |
47 | ;; | |
48 | ;; Introduction | |
49 | ;; ============ | |
50 | ;; | |
bf078b46 | 51 | ;; Virtual cursor commands. I got this idea from the old BBC micro. |
29fddfff RS |
52 | ;; You need Emacs 19 or 20 and a window system for the best effects. |
53 | ;; For character terminals, at least Emacs 19.29 is required | |
fffa137c | 54 | ;; (special behavior for the overlay property |
29fddfff RS |
55 | ;; "before-string" must be implemented). Search for "dumb terminals" |
56 | ;; for more information. | |
bf078b46 RS |
57 | ;; |
58 | ;; This is much easier to use than the instructions are to read. | |
2d6a4733 RS |
59 | ;; First, you need to let vcursor define some keys: setting |
60 | ;; vcursor-key-bindings to t before loading, or by customize, will | |
61 | ;; define various keys with the prefix C-S. You'll have to read | |
62 | ;; further if you don't want this. Then I suggest you simply load it | |
63 | ;; and play around with holding down Ctrl and Shift and pressing up, | |
64 | ;; down, left, right, tab, return, and see what happens. (Find a | |
65 | ;; scratch buffer before using C-S-tab: that toggles copying.) | |
bf078b46 RS |
66 | ;; |
67 | ;; Most of the functions described in this documentation are in | |
68 | ;; parentheses so that if you have the package loaded you can type C-h | |
69 | ;; f on top of them for help. | |
70 | ;; | |
71 | ;; Using the cursor keys with both control and shift held down moves | |
72 | ;; around a virtual cursor, which is initially at point. When active, | |
73 | ;; it appears with an underline through it to distinguish it from the | |
74 | ;; normal cursor. You can then use one of the other commands to copy | |
75 | ;; characters from the location of the virtual cursor to point. This | |
76 | ;; is very useful, for example, when copying some previous text while | |
77 | ;; making changes to it at the same time, since you never have to move | |
78 | ;; the "real" cursor away from where you are inserting. | |
79 | ;; | |
80 | ;; The remaining default key bindings are based around the PC-type | |
81 | ;; cluster found above the cursor keys on a lot of keyboards, the | |
82 | ;; function keys which my limited knowledge of X terminals expects to | |
83 | ;; find at the top. Some functions are duplicated in more obvious | |
84 | ;; places for the X version. | |
85 | ;; | |
86 | ;; All the keybindings require you to hold down control and shift at | |
87 | ;; once. I assumed this combination wouldn't be heavily bound by most | |
88 | ;; people and that it would be easy to type with the left hand. | |
89 | ;; Inevitably it will clash with some other packages, but I can't help | |
90 | ;; that: an intuitive binding is a prerequisite here. See below for | |
29fddfff RS |
91 | ;; other alternatives (search for "Oemacs"). There is also a keymap |
92 | ;; which you can bind to a prefix key, which may give some more | |
93 | ;; intuitive alternatives in some cases, see `The vcursor keymap' below. | |
d49e7392 | 94 | ;; |
bf078b46 RS |
95 | ;; Holding down control and shift and pressing insert (vcursor-copy) |
96 | ;; copies one character from wherever the virtual cursor is to point; | |
97 | ;; point and the virtual cursor advance in the separate and equal | |
98 | ;; station to which... (etc.). M-C-S-return (vcursor-copy-line) | |
99 | ;; copies to the end of the line instead of just one character, | |
100 | ;; C-S-delete or C-S-remove (vcursor-copy-word) copies a word. | |
d49e7392 | 101 | ;; |
bf078b46 RS |
102 | ;; A more general way of copying is to use C-S-tab, which is a toggle. |
103 | ;; In the "on" state, moving the virtual cursor will copy the | |
104 | ;; moved-over text to the normal cursor position (including when going | |
105 | ;; backwards, though each piece of text moved over is copied forwards: | |
fffa137c | 106 | ;; compare the behavior of C-S-up and C-S-left). |
bf078b46 RS |
107 | ;; |
108 | ;; However, that's just a small part of the magic. If the virtual | |
109 | ;; cursor goes off the display, it will be redisplayed in some other | |
110 | ;; window. (See the function (vcursor-find-window) for details of how | |
111 | ;; this window is chosen.) This gives you fingertip control over two | |
112 | ;; windows at once. | |
d49e7392 | 113 | ;; |
bf078b46 RS |
114 | ;; C-S-return (vcursor-disable) disables the virtual cursor, removing |
115 | ;; it so that it starts from point whenever you move it again --- note | |
116 | ;; that simply moving the cursor and virtual cursor on top of one | |
117 | ;; another does not have this effect. | |
d49e7392 | 118 | ;; |
29fddfff | 119 | ;; If you give C-S-return a positive prefix arg, it will also delete the |
bf078b46 RS |
120 | ;; window (unless it's the current one). Whenever the virtual cursor |
121 | ;; goes off-screen in its own window, point in that window is moved as | |
122 | ;; well to restore it to view. (It's easier that way, that's why. | |
123 | ;; However, point doesn't move unless the view in the window does, so | |
124 | ;; it's not tied to the virtual cursor location.) | |
125 | ;; | |
126 | ;; You can also use C-S-return with a negative prefix argument which | |
127 | ;; forces the vcursor to appear at point. This is particularly useful if | |
128 | ;; you actually want to edit in another window but would like to | |
129 | ;; remember the current cursor location for examining or copying from | |
130 | ;; that buffer. (I just hit C-S-right C-S-left, but I'm a hopeless | |
131 | ;; lowbrow.) | |
d49e7392 | 132 | ;; |
bf078b46 RS |
133 | ;; There is also C-S-f6 (vcursor-other-window) which behaves like |
134 | ;; C-x o on the virtual rather than the real cursor, except that it | |
135 | ;; will create another window if necessary. | |
136 | ;; | |
137 | ;; The keys C-S-prior (vcursor-scroll-down) and C-S-next | |
138 | ;; (vcursor-scroll-up) (i.e., PageUp and PageDown) will scroll the | |
139 | ;; virtual cursor window, appropriately chosen. They will always | |
140 | ;; create a new window or take over an old one if necessary. | |
141 | ;; Likewise, M-C-S-left and M-C-S-right move you to the | |
142 | ;; beginning or end of a line, C-S-home and C-S-end the | |
143 | ;; beginning or end of a buffer (these are also on M-C-S-up and | |
144 | ;; M-C-S-down for those of us stuck with DEC keyboards). | |
145 | ;; | |
146 | ;; C-S-f7 (vcursor-goto) will take you to the vcursor position | |
147 | ;; (swapping windows if it seems sensible) and (unless you give it a | |
148 | ;; prefix argument) delete the virtual cursor, so this is useful for | |
149 | ;; you to take over editing at the virtual cursor position. It is not | |
150 | ;; an error if the virtual cursor is not active; it simply leaves you | |
151 | ;; at point, because that is where the virtual cursor would start | |
152 | ;; from. | |
153 | ;; | |
154 | ;; In a similar vein, M-C-S-tab (hope your left hand's flexible; | |
155 | ;; C-S-select on DEC keyboards) (vcursor-swap-point) will take you to | |
156 | ;; the virtual cursor position but simultaneously put the virtual | |
157 | ;; cursor at the old cursor position. It is also supposed to ensure | |
158 | ;; that both are visible. | |
159 | ;; | |
160 | ;; C-S-f8 (C-S-find on DEC keyboards) (vcursor-isearch-forward) | |
161 | ;; allows you to do an isearch in another window. It works a bit like | |
162 | ;; vcursor-scroll-*; it moves into another window, calls isearch | |
163 | ;; there, and sets the virtual cursor position to the point found. In | |
164 | ;; other words, it works just like isearch but with the virtual cursor | |
165 | ;; instead of the real one (that's why it's called a "virtual | |
166 | ;; cursor"). While you are isearching, you are editing in the virtual | |
167 | ;; cursor window, but when you have finished you return to where you | |
168 | ;; started. Note that once you are in isearch all the keys are normal | |
169 | ;; --- use C-s, not C-S-f8, to search for the next occurrence. | |
170 | ;; | |
171 | ;; If you set the variable vcursor-auto-disable, then any command | |
172 | ;; which does not involve moving or copying from the virtual cursor | |
2d6a4733 RS |
173 | ;; causes the virtual cursor to be disabled. If you set it to non-nil |
174 | ;; but not t, then the vcursor itself will remain active, but copying | |
175 | ;; will be turned off, so that the next time the vcursor is moved no | |
176 | ;; text is copied over. Experience shows that this setting is | |
177 | ;; particularly useful. If you don't intend to use this, you can | |
178 | ;; comment out the `add-hook' line at the bottom of this file. (This | |
179 | ;; feature partially emulates the way the "copy" key on the BBC micro | |
180 | ;; worked; actually, the copy cursor was homed when you hit return. | |
181 | ;; This was in keeping with the line-by-line way of entering BASIC, | |
182 | ;; but is less appropriate here.) | |
bf078b46 | 183 | ;; |
29fddfff RS |
184 | ;; vcursor-compare-windows is now a reliable adaption of |
185 | ;; compare-windows, which compares between point in the current buffer | |
186 | ;; and the vcursor location in the other one. It is an error if | |
187 | ;; vcursor is not set, however it will be brought up in another window | |
188 | ;; if it is not currently visible. The prefix argument acts just like | |
189 | ;; compare-windows, ignoring whitespace if set. (In versions before | |
190 | ;; 1.6, this simply called compare-windows, which was much less likely | |
191 | ;; to pick the two windows you wanted.) | |
192 | ;; | |
bf078b46 RS |
193 | ;; There is a way of moving the virtual cursor using ordinary |
194 | ;; commands: C-S-f9 (vcursor-execute-key) reads a key string, | |
195 | ;; moves to the virtual cursor position, executes the command bound to | |
196 | ;; the string, then returns to the original point. Thus C-S-f9 M-m | |
197 | ;; moves the virtual cursor back to the first non-whitespace character | |
198 | ;; on its line. As the command is called interactively all the usual | |
199 | ;; ways of passing information to the command called, such as by a | |
29fddfff RS |
200 | ;; prefix argument, are available. This has many uses not necessarily |
201 | ;; related to moving the vcursor itself; it can do essentially | |
202 | ;; everything that the \C-x 4 series of commands can do and a lot | |
203 | ;; more. Note, however, that a new window is not used if the vcursor | |
204 | ;; is visible in the current one: this can lead to some strange effects, | |
205 | ;; but it is preferable to making a new window every time the vcursor | |
206 | ;; is moved in this may. | |
207 | ;; | |
208 | ;; C-S-f10 (C-S-x) (vcursor-execute-command) behaves the same way but | |
209 | ;; you enter the name of the command. To do anything really | |
bf078b46 RS |
210 | ;; complicated, you are better off using M-C-S-tab |
211 | ;; (vcursor-swap-point), doing whatever it is, then calling M-C-S-tab | |
212 | ;; again. | |
213 | ;; | |
214 | ;; If you want to add your own moving or copying functions you should | |
215 | ;; be able to do this fairly easily with (vcursor-relative-move) and | |
216 | ;; (vcursor-copy) together with (vcursor-get-char-count). If you want to | |
217 | ;; do something in a different window, use (vcursor-window-funcall). | |
218 | ;; | |
29fddfff RS |
219 | ;; Key bindings |
220 | ;; ============ | |
d49e7392 | 221 | ;; |
bf078b46 RS |
222 | ;; There is an alternative set of key bindings which will be used |
223 | ;; automatically for a PC if Oemacs is detected. This set uses separate | |
224 | ;; control, shift and meta keys with function keys 1 to 10. In | |
225 | ;; particular, movement keys are concentrated on f5 to f8 with (in | |
c80e3b4a | 226 | ;; increasing order of distance traveled) C-, M- and S- as prefixes. |
bf078b46 RS |
227 | ;; See the actual bindings below (search for C-f1). This is because the |
228 | ;; C-S- prefix is represented by weird key sequences and the set is | |
229 | ;; incomplete; if you don't mind that, some hints are given in comments | |
230 | ;; below. | |
231 | ;; | |
232 | ;; You can specify the usual or the Oemacs bindings by setting the | |
233 | ;; variable vcursor-key-bindings to `xterm' or `oemacs'. You can also set | |
234 | ;; it to nil, in which case vcursor will not make any key bindings | |
235 | ;; and you can define your own. The default is t, which makes vcursor | |
236 | ;; guess (it will use xterm unless it thinks Oemacs is running). The | |
237 | ;; oemacs set will work on an X terminal with function keys, but the | |
238 | ;; xterm set will not work under Oemacs. | |
239 | ;; | |
29fddfff RS |
240 | ;; Usage on dumb terminals |
241 | ;; ======================= | |
242 | ;; | |
243 | ;; If Emacs has set the variable window-system to nil, vcursor will | |
244 | ;; assume that overlays cannot be displayed in a different face, | |
d49e7392 | 245 | ;; and will instead use a string (the variable vcursor-string, by |
29fddfff RS |
246 | ;; default "**>") to show its position. This was first implemented |
247 | ;; in Emacs 19.29. Unlike the old-fashioned overlay arrow (as used | |
248 | ;; by debuggers), this appears between existing text, which can | |
249 | ;; make it hard to read if you're not used to it. (This seemed the | |
250 | ;; better option here.) This means moving the vcursor up and down is | |
251 | ;; a very efficient way of locating it! | |
252 | ;; | |
253 | ;; Everything else should function as expected, but there is no way to | |
254 | ;; get an easy key binding for the vcursor keys on a generic terminal. | |
255 | ;; Consequently a special keymap is defined for you to use traditional | |
256 | ;; methods: the keymap, however, is available on any terminal type. | |
d49e7392 | 257 | ;; |
29fddfff RS |
258 | ;; The vcursor keymap |
259 | ;; ================== | |
260 | ;; | |
261 | ;; In addition to any other bindings, vcursor-map contains key definitions | |
262 | ;; for handling the vcursor. You should assign this to a prefix key | |
263 | ;; in the usual way, e.g. | |
264 | ;; (global-set-key [f14] vcursor-map) | |
265 | ;; and also as usual \C-h in this map will list the key definitions, which | |
266 | ;; are designed to be easy to remember. | |
267 | ;; | |
ad141260 | 268 | ;; A special feature is provided by (vcursor-use-vcursor-map), bound |
29fddfff RS |
269 | ;; to t in that keymap. With this in effect, the main keymap |
270 | ;; is overridden by the vcursor map, so keys like \C-p and so on | |
271 | ;; move the vcursor instead. Remember how to turn it off (type t), | |
272 | ;; or you are in serious trouble! Note that the cursor keys are not | |
273 | ;; bound by default in this keymap and will continue to move the | |
274 | ;; ordinary cursor. | |
275 | ;; | |
276 | ;; Interpreted input | |
277 | ;; ================= | |
278 | ;; | |
279 | ;; Just occasionally, you may want to pretend the strings copied from | |
280 | ;; the vcursor position are to be interpreted as if you had typed them | |
281 | ;; from the keyboard. Normally, they will just insert themselves anyway, | |
282 | ;; but in some modes (Info and calc for example) typing ordinary characters | |
283 | ;; does something else. To get this effect, set | |
284 | ;; vcursor-interpret-input to t. This is normally not a good idea as | |
285 | ;; interpreting input is very much slower than copying text. | |
d49e7392 | 286 | ;; |
29fddfff RS |
287 | ;; Un-features |
288 | ;; =========== | |
289 | ;; | |
bf078b46 RS |
290 | ;; - The vcursor will not move to point-max, since otherwise it would |
291 | ;; disappear. However, no error is flagged as point-max is a valid | |
292 | ;; point in the buffer. Thus cursor right or down at the second | |
293 | ;; last point in the file does not flag an error, which is inconsistent, | |
294 | ;; and if copying is on the last character (typically newline) will | |
295 | ;; be repeatedly copied. (I've tried making it flag an error | |
296 | ;; instead and that's worse since often the vcursor is sent to | |
297 | ;; point in some other window, which may be point-max.) | |
298 | ;; - The vcursor widens when over a tab character or right at the | |
299 | ;; end of the line. You're welcome to consider this a feature; | |
300 | ;; it's just a part of how overlays work. | |
301 | ;; - The vcursor obscures the real cursor. Creative use of overlays | |
302 | ;; could cure this. | |
303 | ;; - The vcursor does not remember its own previous positions. If | |
304 | ;; you cycle it back into a window it was in before, it will be at | |
305 | ;; point in that window. Often, that is where a previous recenter | |
306 | ;; left point, not where the vcursor was before. | |
307 | ;; (Note, however, that the vcursor does remember where it *is*, | |
308 | ;; even if it's off-screen. This can also lead to surprises, but I | |
309 | ;; don't think it's a bug.) | |
310 | ;; - vcursor-window-funcall could perhaps be smarter about restoring | |
311 | ;; the previous window state on failure. | |
312 | ;; - The logic in vcursor-find-window is rather complicated and | |
313 | ;; therefore bug-prone, though in practice it seems to work OK. | |
314 | ;; | |
69e82404 | 315 | ;; Possible enhancements: |
bf078b46 RS |
316 | ;; It would be easy to implement vcursor-push (save vcursor position |
317 | ;; as mark and deactivate) and vcursor-pop (deactivate vcursor and | |
318 | ;; move to last pushed position) functions. | |
319 | ||
320 | ;;; Code: | |
321 | ||
46a610ab DL |
322 | (eval-when-compile (require 'compare-w)) |
323 | ||
4bef9110 SE |
324 | (defgroup vcursor nil |
325 | "Manipulate an alternative (\"virtual\") cursor." | |
326 | :prefix "vcursor-" | |
eba5b4dd | 327 | :group 'convenience) |
4bef9110 | 328 | |
2d6a4733 RS |
329 | (defface vcursor |
330 | '((((class color)) (:foreground "blue" :background "cyan" :underline t)) | |
331 | (t (:inverse-video t :underline t))) | |
332 | "Face for the virtual cursor." | |
333 | :group 'vcursor) | |
bf078b46 | 334 | |
4bef9110 | 335 | (defcustom vcursor-auto-disable nil |
ad141260 | 336 | "If non-nil, disable the virtual cursor after use. |
2d6a4733 RS |
337 | Any non-vcursor command will force `vcursor-disable' to be called. |
338 | If non-nil but not t, just make sure copying is toggled off, but don't | |
339 | disable the vcursor." | |
340 | :type '(choice (const t) (const nil) (const copy)) | |
4bef9110 | 341 | :group 'vcursor) |
bf078b46 | 342 | |
69e82404 | 343 | (defcustom vcursor-modifiers (list 'control 'shift) |
ad141260 | 344 | "A list of modifiers that are used to define vcursor key bindings." |
69e82404 EZ |
345 | :type '(repeat symbol) |
346 | :group 'vcursor) | |
347 | ||
2d6a4733 | 348 | ;; Needed for defcustom, must be up here |
df003ee6 | 349 | (defun vcursor-cs-binding (base &optional meta) |
69e82404 | 350 | (vector (let ((key (append vcursor-modifiers (list (intern base))))) |
df003ee6 DL |
351 | (if meta |
352 | (cons 'meta key) | |
353 | key)))) | |
2d6a4733 RS |
354 | |
355 | (defun vcursor-bind-keys (var value) | |
356 | "Alter the value of the variable VAR to VALUE, binding keys as required. | |
5a7383fd | 357 | VAR is usually `vcursor-key-bindings'. Normally this function is called |
2d6a4733 RS |
358 | on loading vcursor and from the customize package." |
359 | (set var value) | |
360 | (cond | |
361 | ((not value));; don't set any key bindings | |
362 | ((or (eq value 'oemacs) | |
363 | (and (eq value t) (fboundp 'oemacs-version))) | |
364 | (global-set-key [C-f1] 'vcursor-toggle-copy) | |
365 | (global-set-key [C-f2] 'vcursor-copy) | |
366 | (global-set-key [C-f3] 'vcursor-copy-word) | |
367 | (global-set-key [C-f4] 'vcursor-copy-line) | |
368 | ||
369 | (global-set-key [S-f1] 'vcursor-disable) | |
370 | (global-set-key [S-f2] 'vcursor-other-window) | |
371 | (global-set-key [S-f3] 'vcursor-goto) | |
372 | (global-set-key [S-f4] 'vcursor-swap-point) | |
373 | ||
374 | (global-set-key [C-f5] 'vcursor-backward-char) | |
375 | (global-set-key [C-f6] 'vcursor-previous-line) | |
376 | (global-set-key [C-f7] 'vcursor-next-line) | |
377 | (global-set-key [C-f8] 'vcursor-forward-char) | |
378 | ||
379 | (global-set-key [M-f5] 'vcursor-beginning-of-line) | |
380 | (global-set-key [M-f6] 'vcursor-backward-word) | |
381 | (global-set-key [M-f6] 'vcursor-forward-word) | |
382 | (global-set-key [M-f8] 'vcursor-end-of-line) | |
383 | ||
384 | (global-set-key [S-f5] 'vcursor-beginning-of-buffer) | |
385 | (global-set-key [S-f6] 'vcursor-scroll-down) | |
386 | (global-set-key [S-f7] 'vcursor-scroll-up) | |
387 | (global-set-key [S-f8] 'vcursor-end-of-buffer) | |
388 | ||
389 | (global-set-key [C-f9] 'vcursor-isearch-forward) | |
390 | ||
391 | (global-set-key [S-f9] 'vcursor-execute-key) | |
392 | (global-set-key [S-f10] 'vcursor-execute-command) | |
393 | ||
394 | ;;; Partial dictionary of Oemacs key sequences for you to roll your own, | |
395 | ;;; e.g C-S-up: (global-set-key "\M-[\C-f\M-\C-m" 'vcursor-previous-line) | |
396 | ;;; Sequence: Sends: | |
397 | ;;; "\M-[\C-f\M-\C-m" C-S-up | |
398 | ;;; "\M-[\C-f\M-\C-q" C-S-down | |
399 | ;;; "\M-[\C-fs" C-S-left | |
400 | ;;; "\M-[\C-ft" C-S-right | |
401 | ;;; | |
402 | ;;; "\M-[\C-fw" C-S-home | |
403 | ;;; "\M-[\C-b\C-o" S-tab | |
404 | ;;; "\M-[\C-f\M-\C-r" C-S-insert | |
405 | ;;; "\M-[\C-fu" C-S-end | |
406 | ;;; "\M-[\C-f\M-\C-s" C-S-delete | |
407 | ;;; "\M-[\C-f\M-\C-d" C-S-prior | |
408 | ;;; "\M-[\C-fv" C-S-next | |
d49e7392 | 409 | ;;; |
2d6a4733 RS |
410 | ;;; "\M-[\C-f^" C-S-f1 |
411 | ;;; "\M-[\C-f_" C-S-f2 | |
412 | ;;; "\M-[\C-f`" C-S-f3 | |
413 | ;;; "\M-[\C-fa" C-S-f4 | |
414 | ;;; "\M-[\C-fb" C-S-f5 | |
415 | ;;; "\M-[\C-fc" C-S-f6 | |
416 | ;;; "\M-[\C-fd" C-S-f7 | |
417 | ;;; "\M-[\C-fe" C-S-f8 | |
418 | ;;; "\M-[\C-ff" C-S-f9 | |
419 | ;;; "\M-[\C-fg" C-S-f10 | |
420 | ) | |
421 | (t | |
422 | (global-set-key (vcursor-cs-binding "up") 'vcursor-previous-line) | |
423 | (global-set-key (vcursor-cs-binding "down") 'vcursor-next-line) | |
424 | (global-set-key (vcursor-cs-binding "left") 'vcursor-backward-char) | |
425 | (global-set-key (vcursor-cs-binding "right") 'vcursor-forward-char) | |
d49e7392 | 426 | |
2d6a4733 RS |
427 | (global-set-key (vcursor-cs-binding "return") 'vcursor-disable) |
428 | (global-set-key (vcursor-cs-binding "insert") 'vcursor-copy) | |
429 | (global-set-key (vcursor-cs-binding "delete") 'vcursor-copy-word) | |
430 | (global-set-key (vcursor-cs-binding "remove") 'vcursor-copy-word) | |
431 | (global-set-key (vcursor-cs-binding "tab") 'vcursor-toggle-copy) | |
432 | (global-set-key (vcursor-cs-binding "backtab") 'vcursor-toggle-copy) | |
433 | (global-set-key (vcursor-cs-binding "home") 'vcursor-beginning-of-buffer) | |
434 | (global-set-key (vcursor-cs-binding "up" t) 'vcursor-beginning-of-buffer) | |
435 | (global-set-key (vcursor-cs-binding "end") 'vcursor-end-of-buffer) | |
436 | (global-set-key (vcursor-cs-binding "down" t) 'vcursor-end-of-buffer) | |
437 | (global-set-key (vcursor-cs-binding "prior") 'vcursor-scroll-down) | |
438 | (global-set-key (vcursor-cs-binding "next") 'vcursor-scroll-up) | |
d49e7392 | 439 | |
2d6a4733 RS |
440 | (global-set-key (vcursor-cs-binding "f6") 'vcursor-other-window) |
441 | (global-set-key (vcursor-cs-binding "f7") 'vcursor-goto) | |
442 | ||
d49e7392 | 443 | (global-set-key (vcursor-cs-binding "select") |
2d6a4733 RS |
444 | 'vcursor-swap-point) ; DEC keyboards |
445 | (global-set-key (vcursor-cs-binding "tab" t) 'vcursor-swap-point) | |
446 | ||
d49e7392 | 447 | (global-set-key (vcursor-cs-binding "find") |
2d6a4733 RS |
448 | 'vcursor-isearch-forward) ; DEC keyboards |
449 | (global-set-key (vcursor-cs-binding "f8") 'vcursor-isearch-forward) | |
450 | ||
451 | (global-set-key (vcursor-cs-binding "left" t) 'vcursor-beginning-of-line) | |
452 | (global-set-key (vcursor-cs-binding "right" t) 'vcursor-end-of-line) | |
453 | ||
454 | (global-set-key (vcursor-cs-binding "prior" t) 'vcursor-backward-word) | |
455 | (global-set-key (vcursor-cs-binding "next" t) 'vcursor-forward-word) | |
456 | ||
457 | (global-set-key (vcursor-cs-binding "return" t) 'vcursor-copy-line) | |
458 | ||
459 | (global-set-key (vcursor-cs-binding "f9") 'vcursor-execute-key) | |
460 | (global-set-key (vcursor-cs-binding "f10") 'vcursor-execute-command) | |
461 | ))) | |
462 | ||
463 | (defcustom vcursor-key-bindings nil | |
ad141260 | 464 | "How to bind keys when vcursor is loaded. |
5a7383fd JB |
465 | If t, guess; if `xterm', use bindings suitable for an X terminal; if |
466 | `oemacs', use bindings which work on a PC with Oemacs. If nil, don't | |
2d6a4733 RS |
467 | define any key bindings. |
468 | ||
469 | Default is nil." | |
470 | :type '(choice (const t) (const nil) (const xterm) (const oemacs)) | |
471 | :group 'vcursor | |
472 | :set 'vcursor-bind-keys | |
473 | :version "20.3") | |
bf078b46 | 474 | |
4bef9110 | 475 | (defcustom vcursor-interpret-input nil |
ad141260 | 476 | "If non-nil, input from the vcursor is treated as interactive input. |
29fddfff RS |
477 | This will cause text insertion to be much slower. Note that no special |
478 | interpretation of strings is done: \"\C-x\" is a string of four | |
4bef9110 SE |
479 | characters. The default is simply to copy strings." |
480 | :type 'boolean | |
cd32a7ba DN |
481 | :group 'vcursor |
482 | :version "20.3") | |
29fddfff | 483 | |
4bef9110 SE |
484 | (defcustom vcursor-string "**>" |
485 | "String used to show the vcursor position on dumb terminals." | |
486 | :type 'string | |
cd32a7ba DN |
487 | :group 'vcursor |
488 | :version "20.3") | |
29fddfff | 489 | |
d49e7392 | 490 | (defvar vcursor-overlay nil |
bf078b46 RS |
491 | "Overlay for the virtual cursor. |
492 | It is nil if that is not enabled.") | |
493 | ||
494 | (defvar vcursor-window nil | |
495 | "Last window to have displayed the virtual cursor. | |
496 | See the function `vcursor-find-window' for how this is used.") | |
497 | ||
498 | (defvar vcursor-last-command nil | |
499 | "Non-nil if last command was a vcursor command. | |
500 | The commands `vcursor-copy', `vcursor-relative-move' and the ones for | |
501 | scrolling set this. It is used by the `vcursor-auto-disable' code.") | |
502 | ;; could do some memq-ing with last-command instead, but this will | |
503 | ;; automatically handle any new commands using the primitives. | |
504 | ||
d49e7392 | 505 | (defcustom vcursor-copy-flag nil |
ad141260 | 506 | "Non-nil means moving vcursor should copy characters moved over to point." |
4bef9110 SE |
507 | :type 'boolean |
508 | :group 'vcursor) | |
bf078b46 RS |
509 | |
510 | (defvar vcursor-temp-goal-column nil | |
511 | "Keeps track of temporary goal columns for the virtual cursor.") | |
512 | ||
ad141260 SM |
513 | (defvar vcursor-map |
514 | (let ((map (make-sparse-keymap))) | |
515 | (define-key map "t" 'vcursor-use-vcursor-map) | |
516 | ||
517 | (define-key map "\C-p" 'vcursor-previous-line) | |
518 | (define-key map "\C-n" 'vcursor-next-line) | |
519 | (define-key map "\C-b" 'vcursor-backward-char) | |
520 | (define-key map "\C-f" 'vcursor-forward-char) | |
521 | ||
522 | (define-key map "\r" 'vcursor-disable) | |
523 | (define-key map " " 'vcursor-copy) | |
524 | (define-key map "\C-y" 'vcursor-copy-word) | |
525 | (define-key map "\C-i" 'vcursor-toggle-copy) | |
526 | (define-key map "<" 'vcursor-beginning-of-buffer) | |
527 | (define-key map ">" 'vcursor-end-of-buffer) | |
528 | (define-key map "\M-v" 'vcursor-scroll-down) | |
529 | (define-key map "\C-v" 'vcursor-scroll-up) | |
530 | (define-key map "o" 'vcursor-other-window) | |
531 | (define-key map "g" 'vcursor-goto) | |
532 | (define-key map "x" 'vcursor-swap-point) | |
533 | (define-key map "\C-s" 'vcursor-isearch-forward) | |
534 | (define-key map "\C-r" 'vcursor-isearch-backward) | |
535 | (define-key map "\C-a" 'vcursor-beginning-of-line) | |
536 | (define-key map "\C-e" 'vcursor-end-of-line) | |
537 | (define-key map "\M-w" 'vcursor-forward-word) | |
538 | (define-key map "\M-b" 'vcursor-backward-word) | |
539 | (define-key map "\M-l" 'vcursor-copy-line) | |
540 | (define-key map "c" 'vcursor-compare-windows) | |
541 | (define-key map "k" 'vcursor-execute-key) | |
542 | (define-key map "\M-x" 'vcursor-execute-command) | |
543 | map) | |
544 | "Keymap for vcursor command.") | |
545 | ;; This seems unused, but it was done as part of define-prefix-command, | |
546 | ;; so let's keep it for now. | |
547 | (fset 'vcursor-map vcursor-map) | |
29fddfff | 548 | |
2d6a4733 RS |
549 | ;; If vcursor-key-bindings is already set on loading, bind the keys now. |
550 | ;; This hybrid way of doing it retains compatibility while allowing | |
551 | ;; customize to work smoothly. | |
d49e7392 | 552 | (if vcursor-key-bindings |
2d6a4733 | 553 | (vcursor-bind-keys 'vcursor-key-bindings vcursor-key-bindings)) |
bf078b46 RS |
554 | |
555 | (defun vcursor-locate () | |
556 | "Go to the starting point of the virtual cursor. | |
557 | If that's disabled, don't go anywhere but don't complain." | |
558 | ;; This is where we go off-mass-shell. Assume there is a | |
559 | ;; save-excursion to get us back to the pole, er, point. | |
560 | ||
561 | (and (overlayp vcursor-overlay) | |
562 | (overlay-buffer vcursor-overlay) | |
563 | (set-buffer (overlay-buffer vcursor-overlay)) | |
564 | (goto-char (overlay-start vcursor-overlay))) | |
565 | ) | |
566 | ||
567 | (defun vcursor-find-window (&optional not-this new-win this-frame) | |
568 | "Return a suitable window for displaying the virtual cursor. | |
569 | This is the first window in cyclic order where the vcursor is visible. | |
570 | ||
571 | With optional NOT-THIS non-nil never return the current window. | |
572 | ||
573 | With NEW-WIN non-nil, display the virtual cursor buffer in another | |
574 | window if the virtual cursor is not currently visible \(note, however, | |
5a7383fd | 575 | that this function never changes `window-point'\). |
bf078b46 RS |
576 | |
577 | With THIS-FRAME non-nil, don't search other frames for a new window | |
578 | \(though if the vcursor is already off-frame then its current window is | |
579 | always considered, and the value of `pop-up-frames' is always respected\). | |
580 | ||
581 | Returns nil if the virtual cursor is not visible anywhere suitable. | |
582 | Set `vcursor-window' to the returned value as a side effect." | |
583 | ||
584 | ;; The order of priorities (respecting NOT-THIS) is (1) | |
585 | ;; vcursor-window if the virtual cursor is visible there (2) any | |
586 | ;; window displaying the virtual cursor (3) vcursor-window provided | |
587 | ;; it is still displaying the buffer containing the virtual cursor and | |
588 | ;; is not selected (4) any unselected window displaying the vcursor | |
589 | ;; buffer (5) with NEW-WIN, a window selected by display-buffer (so | |
590 | ;; the variables pop-up-windows and pop-up-frames are significant) | |
591 | ;; (6) nil. | |
592 | ||
593 | (let ((thiswin (selected-window)) winok winbuf) | |
594 | (save-excursion | |
595 | (vcursor-locate) | |
596 | (or (and (window-live-p vcursor-window) | |
597 | (eq (current-buffer) (window-buffer vcursor-window)) | |
598 | (not (and not-this (eq thiswin vcursor-window)))) | |
599 | (setq vcursor-window nil)) | |
600 | (or (and vcursor-window ; choice 1 | |
601 | (pos-visible-in-window-p (point) vcursor-window)) | |
602 | (progn | |
603 | (walk-windows | |
d49e7392 | 604 | (function |
bf078b46 RS |
605 | (lambda (win) |
606 | (and (not winok) | |
607 | (eq (current-buffer) (window-buffer win)) | |
608 | (not (and not-this (eq thiswin win))) | |
609 | (cond | |
610 | ((pos-visible-in-window-p (point) win) (setq winok win)) | |
611 | ((eq thiswin win)) | |
612 | ((not winbuf) (setq winbuf win)))))) | |
613 | nil (not this-frame)) | |
614 | (setq vcursor-window | |
615 | (cond | |
616 | (winok) ; choice 2 | |
617 | ((and vcursor-window ; choice 3 | |
618 | (not (eq thiswin vcursor-window))) vcursor-window) | |
619 | (winbuf) ; choice 4 | |
620 | (new-win (display-buffer (current-buffer) t)) ; choice 5 | |
621 | (t nil))))))) ; default (choice 6) | |
622 | vcursor-window | |
623 | ) | |
624 | ||
625 | (defun vcursor-toggle-copy (&optional arg nomsg) | |
626 | "Toggle copying to point when the vcursor is moved. | |
627 | With a prefix ARG, turn on if non-negative, off if negative. | |
628 | Display a message unless optional NOMSG is non-nil." | |
629 | (interactive "P") | |
630 | (setq vcursor-copy-flag | |
631 | (cond ((not arg) (not vcursor-copy-flag)) | |
632 | ((< (prefix-numeric-value arg) 0) nil) | |
633 | (t)) | |
634 | vcursor-last-command t) | |
635 | (or nomsg (message "Copying from the vcursor is now %s." | |
636 | (if vcursor-copy-flag "on" "off"))) | |
637 | ) | |
638 | ||
29fddfff | 639 | (defun vcursor-move (pt &optional leave-b leave-w) |
bf078b46 | 640 | "Move the virtual cursor to the character to the right of PT. |
29fddfff RS |
641 | PT is an absolute location in the current buffer. With optional |
642 | LEAVE-B, PT is in the same buffer the vcursor is currently in. | |
bf078b46 RS |
643 | |
644 | If the new virtual cursor location would not be visible, display it in | |
29fddfff | 645 | another window. With LEAVE-W, use the current `vcursor-window'." |
bf078b46 RS |
646 | ;; this works even if we're on-mass-shell, but usually we won't be. |
647 | ||
29fddfff RS |
648 | (save-excursion |
649 | (and leave-b (vcursor-check t) | |
650 | (set-buffer (overlay-buffer vcursor-overlay))) | |
651 | (if (eq pt (point-max)) | |
652 | (setq pt (1- pt))) | |
653 | (if (vcursor-check t) | |
654 | (move-overlay vcursor-overlay pt (+ pt 1) (current-buffer)) | |
655 | (setq vcursor-overlay (make-overlay pt (+ pt 1))) | |
656 | (or window-system | |
46a610ab | 657 | (display-color-p) |
29fddfff | 658 | (overlay-put vcursor-overlay 'before-string vcursor-string)) |
b49f886e LMI |
659 | (overlay-put vcursor-overlay 'face 'vcursor) |
660 | ;; 200 is purely an arbitrary "high" number. See bug#9663. | |
661 | (overlay-put vcursor-overlay 'priority 200)) | |
29fddfff RS |
662 | (or leave-w (vcursor-find-window nil t)) |
663 | ;; vcursor-window now contains the right buffer | |
664 | (or (pos-visible-in-window-p pt vcursor-window) | |
b49f886e | 665 | (set-window-point vcursor-window pt)))) |
29fddfff RS |
666 | |
667 | (defun vcursor-insert (text) | |
668 | "Insert TEXT, respecting `vcursor-interpret-input'." | |
669 | (if vcursor-interpret-input | |
670 | (setq unread-command-events | |
671 | (append (listify-key-sequence text) unread-command-events)) | |
672 | (insert text)) | |
bf078b46 RS |
673 | ) |
674 | ||
5a7383fd JB |
675 | (defun vcursor-relative-move (func &rest args) |
676 | "Call FUNC with arbitrary ARGS ... to move the virtual cursor. | |
bf078b46 RS |
677 | |
678 | This is called by most of the virtual-cursor motion commands." | |
679 | (let (text opoint) | |
680 | (save-excursion | |
681 | (vcursor-locate) | |
682 | (setq opoint (point)) | |
5a7383fd | 683 | (apply func args) |
bf078b46 RS |
684 | (and (eq opoint (point-max)) (eq opoint (point)) |
685 | (signal 'end-of-buffer nil)) | |
686 | (vcursor-move (point)) | |
687 | (if vcursor-copy-flag (setq text (buffer-substring opoint (point))))) | |
29fddfff | 688 | (if text (vcursor-insert text))) |
bf078b46 RS |
689 | (setq vcursor-last-command t) |
690 | ) | |
691 | ||
692 | (defun vcursor-goto (&optional arg) | |
693 | "Move the real cursor to the virtual cursor position. | |
694 | If the virtual cursor is (or was recently) visible in another window, | |
695 | switch to that first. Without a prefix ARG, disable the virtual | |
696 | cursor as well." | |
697 | ||
698 | (interactive "P") | |
699 | (and (vcursor-find-window) (select-window vcursor-window)) | |
700 | (let ((buf (and vcursor-overlay (overlay-buffer vcursor-overlay)))) | |
701 | (and buf (not (eq (current-buffer) buf)) (switch-to-buffer buf))) | |
702 | (vcursor-locate) | |
703 | (or arg (vcursor-disable)) | |
704 | ) | |
705 | ||
706 | (defun vcursor-swap-point () | |
707 | "Swap the location of point and that of the virtual cursor. | |
708 | ||
709 | The virtual cursor window becomes the selected window and the old | |
710 | window becomes the virtual cursor window. If the virtual cursor would | |
711 | not be visible otherwise, display it in another window." | |
712 | ||
713 | (interactive) | |
714 | (let ((buf (current-buffer)) (here (point)) (win (selected-window))) | |
715 | (vcursor-goto) ; will disable the vcursor | |
ad141260 | 716 | (with-current-buffer buf |
bf078b46 RS |
717 | (setq vcursor-window win) |
718 | (vcursor-move here))) | |
719 | ) | |
720 | ||
721 | (defun vcursor-scroll-up (&optional n) | |
722 | "Scroll up the vcursor window ARG lines or near full screen if none. | |
723 | The vcursor will always appear in an unselected window." | |
724 | ||
725 | (interactive "P") | |
726 | (vcursor-window-funcall 'scroll-up n) | |
727 | ) | |
728 | ||
729 | (defun vcursor-scroll-down (&optional n) | |
5a7383fd | 730 | "Scroll down the vcursor window ARG lines or near full screen if none. |
bf078b46 RS |
731 | The vcursor will always appear in an unselected window." |
732 | ||
733 | (interactive "P") | |
734 | (vcursor-window-funcall 'scroll-down n) | |
735 | ) | |
736 | ||
737 | (defun vcursor-isearch-forward (&optional rep norecurs) | |
738 | "Perform forward incremental search in the virtual cursor window. | |
739 | The virtual cursor is moved to the resulting point; the ordinary | |
740 | cursor stays where it was." | |
741 | ||
742 | (interactive "P") | |
743 | (vcursor-window-funcall 'isearch-forward rep norecurs) | |
744 | ) | |
745 | ||
29fddfff RS |
746 | (defun vcursor-isearch-backward (&optional rep norecurs) |
747 | "Perform backward incremental search in the virtual cursor window. | |
748 | The virtual cursor is moved to the resulting point; the ordinary | |
749 | cursor stays where it was." | |
750 | ||
751 | (interactive "P") | |
752 | (vcursor-window-funcall 'isearch-backward rep norecurs) | |
753 | ) | |
754 | ||
bf078b46 RS |
755 | (defun vcursor-window-funcall (func &rest args) |
756 | "Call FUNC with ARGS ... in a virtual cursor window. | |
757 | A window other than the currently-selected one will always be used. | |
758 | The virtual cursor is moved to the value of point when the function | |
29fddfff RS |
759 | returns. |
760 | ||
761 | If FUNC is a list, call the car of the list interactively, ignoring | |
762 | ARGS. In this case, a new window will not be created if the vcursor | |
763 | is visible in the current one." | |
764 | ;; that's to avoid messing up compatibility with old versions | |
765 | ;; by introducing a new argument, which would have to come before ARGS. | |
766 | ||
767 | (vcursor-find-window (not (and (listp func) (vcursor-check t))) t) | |
768 | (save-excursion | |
769 | (let ((sw (selected-window)) text) | |
770 | ;; We can't use save-window-excursion because that would restore | |
771 | ;; the original display in the window we may want to alter. | |
772 | (unwind-protect | |
773 | (let ((here (point))) | |
774 | (select-window vcursor-window) | |
775 | (vcursor-locate) | |
776 | (if (listp func) | |
777 | (call-interactively (car func)) | |
778 | (apply func args)) | |
779 | (setq vcursor-window (selected-window)) | |
780 | (and vcursor-copy-flag | |
781 | (eq (current-buffer) (overlay-buffer vcursor-overlay)) | |
782 | (setq text (buffer-substring here (point)))) | |
783 | ;; vcursor-window and the current buffer are definitely | |
784 | ;; right, so make sure vcursor-move doesn't pick others. | |
785 | (vcursor-move (point) nil t)) | |
786 | (select-window sw)) | |
787 | (if text (vcursor-insert text)))) | |
bf078b46 RS |
788 | (setq vcursor-last-command t) |
789 | ) | |
790 | ||
5a7383fd JB |
791 | (defun vcursor-get-char-count (func &rest args) |
792 | "Apply FUNC to ARGS ... and return the number of characters moved. | |
793 | Point is temporarily set to the virtual cursor position before FUNC | |
794 | is called. | |
bf078b46 RS |
795 | |
796 | This is called by most of the virtual-cursor copying commands to find | |
797 | out how much to copy." | |
798 | ||
799 | (vcursor-check) | |
ad141260 | 800 | (with-current-buffer (overlay-buffer vcursor-overlay) |
bf078b46 | 801 | (let ((start (goto-char (overlay-start vcursor-overlay)))) |
5a7383fd | 802 | (- (progn (apply func args) (point)) start))) |
bf078b46 RS |
803 | ) |
804 | ||
805 | ;; Make sure the virtual cursor is active. Unless arg is non-nil, | |
806 | ;; report an error if it is not. | |
807 | (defun vcursor-check (&optional arg) | |
808 | (cond | |
809 | ((and (overlayp vcursor-overlay) (overlay-start vcursor-overlay)) | |
810 | t) | |
811 | (arg nil) | |
55535639 | 812 | (t (error "The virtual cursor is not active now"))) |
bf078b46 RS |
813 | ) |
814 | ||
ad141260 SM |
815 | (define-minor-mode vcursor-use-vcursor-map |
816 | "Toggle the state of the vcursor key map. | |
e1ac4066 GM |
817 | With a prefix argument ARG, enable it if ARG is positive, and disable |
818 | it otherwise. If called from Lisp, enable it if ARG is omitted or nil. | |
ad141260 SM |
819 | When on, the keys defined in it are mapped directly on top of the main |
820 | keymap, allowing you to move the vcursor with ordinary motion keys. | |
821 | An indication \"!VC\" appears in the mode list. The effect is | |
822 | local to the current buffer. | |
823 | Disabling the vcursor automatically turns this off." | |
824 | :keymap vcursor-map | |
825 | :lighter " !VC") | |
826 | ||
bf078b46 RS |
827 | (defun vcursor-disable (&optional arg) |
828 | "Disable the virtual cursor. | |
829 | Next time you use it, it will start from point. | |
830 | ||
831 | With a positive prefix ARG, the first window in cyclic order | |
832 | displaying the virtual cursor (or which was recently displaying the | |
5a7383fd | 833 | virtual cursor) will be deleted unless it's the selected window. |
bf078b46 RS |
834 | |
835 | With a negative prefix argument, enable the virtual cursor: make it | |
836 | active at the same point as the real cursor. | |
837 | ||
5a7383fd | 838 | Copying mode is always turned off: the next use of the vcursor will |
bf078b46 RS |
839 | not copy text until you turn it on again." |
840 | ||
841 | (interactive "P") | |
842 | (if (overlayp vcursor-overlay) | |
843 | (progn | |
844 | (delete-overlay vcursor-overlay) | |
845 | (setq vcursor-overlay nil))) | |
846 | (cond | |
847 | ((not (vcursor-find-window t))) | |
848 | ((or (not arg) (< (prefix-numeric-value arg) 0))) | |
849 | ((delete-window vcursor-window))) | |
29fddfff RS |
850 | (cond |
851 | ((and arg (< (prefix-numeric-value arg) 0)) | |
852 | (vcursor-move (point)) | |
853 | (setq vcursor-window (selected-window))) | |
ad141260 | 854 | (vcursor-use-vcursor-map (vcursor-use-vcursor-map 0))) |
bf078b46 RS |
855 | (setq vcursor-copy-flag nil) |
856 | ) | |
857 | ||
858 | (defun vcursor-other-window (n &optional all-frames) | |
859 | "Activate the virtual cursor in another window. | |
d49e7392 | 860 | This is the next window cyclically after one currently showing the |
bf078b46 RS |
861 | virtual cursor, or else after the current selected window. If there |
862 | is no other window, the current window is split. | |
863 | ||
5a7383fd | 864 | Arguments N and optional ALL-FRAMES are the same as with `other-window'. |
bf078b46 RS |
865 | ALL-FRAMES is also used to decide whether to split the window." |
866 | ||
867 | (interactive "p") | |
868 | (if (if (fboundp 'oemacs-version) | |
869 | (one-window-p nil) | |
870 | (one-window-p nil all-frames)) | |
871 | (display-buffer (current-buffer) t)) | |
872 | (save-excursion | |
873 | (save-window-excursion | |
874 | ;; We don't use fancy vcursor-find-window trickery, since we're | |
875 | ;; quite happy to have the vcursor cycle back into the current | |
876 | ;; window. | |
ad141260 | 877 | (let ((win (vcursor-find-window nil nil (not all-frames)))) |
bf078b46 RS |
878 | (if win (select-window win)) |
879 | ;; else start from here | |
880 | (other-window n all-frames) | |
881 | (vcursor-disable -1)))) | |
882 | ) | |
883 | ||
d7fe6352 JB |
884 | (declare-function compare-windows-skip-whitespace "compare-w" (start)) |
885 | ||
29fddfff RS |
886 | ;; vcursor-compare-windows is copied from compare-w.el with only |
887 | ;; minor modifications; these are too bound up with the function | |
888 | ;; to make it really useful to call compare-windows itself. | |
889 | (defun vcursor-compare-windows (&optional ignore-whitespace) | |
890 | "Compare text in current window with text in window with vcursor. | |
891 | Compares the text starting at point in the current window and at the | |
892 | vcursor position in the other window, moving over text in each one as | |
893 | far as they match. | |
894 | ||
895 | A prefix argument, if any, means ignore changes in whitespace. | |
896 | The variable `compare-windows-whitespace' controls how whitespace is skipped. | |
897 | If `compare-ignore-case' is non-nil, changes in case are also ignored." | |
bf078b46 | 898 | (interactive "P") |
29fddfff RS |
899 | ;; (vcursor-window-funcall 'compare-windows arg) |
900 | (require 'compare-w) | |
901 | (let* (p1 p2 maxp1 maxp2 b1 b2 w2 | |
ad141260 | 902 | success |
29fddfff RS |
903 | (opoint1 (point)) |
904 | opoint2 | |
905 | (skip-whitespace (if ignore-whitespace | |
906 | compare-windows-whitespace))) | |
907 | (setq p1 (point) b1 (current-buffer)) | |
908 | (setq w2 (vcursor-find-window t t)) | |
909 | (if (or (eq w2 (selected-window)) (not w2)) | |
910 | (error "No other window with vcursor")) | |
911 | (save-excursion | |
912 | (vcursor-locate) | |
913 | (setq p2 (point) b2 (current-buffer))) | |
914 | (setq opoint2 p2) | |
915 | (setq maxp1 (point-max)) | |
ad141260 | 916 | (with-current-buffer b2 |
29fddfff RS |
917 | (setq maxp2 (point-max))) |
918 | ||
919 | (setq success t) | |
920 | (while success | |
921 | (setq success nil) | |
922 | ;; if interrupted, show how far we've gotten | |
923 | (goto-char p1) | |
924 | (vcursor-move p2 t) | |
925 | ||
926 | ;; If both buffers have whitespace next to point, | |
927 | ;; optionally skip over it. | |
928 | ||
929 | (and skip-whitespace | |
930 | (save-excursion | |
ad141260 | 931 | (let (p1a p2a result1 result2) |
29fddfff RS |
932 | (setq result1 |
933 | (if (stringp skip-whitespace) | |
934 | (compare-windows-skip-whitespace opoint1) | |
935 | (funcall skip-whitespace opoint1))) | |
936 | (setq p1a (point)) | |
937 | (set-buffer b2) | |
938 | (goto-char p2) | |
939 | (setq result2 | |
940 | (if (stringp skip-whitespace) | |
941 | (compare-windows-skip-whitespace opoint2) | |
942 | (funcall skip-whitespace opoint2))) | |
943 | (setq p2a (point)) | |
944 | (if (or (stringp skip-whitespace) | |
945 | (and result1 result2 (eq result1 result2))) | |
946 | (setq p1 p1a | |
947 | p2 p2a))))) | |
948 | ||
949 | ;; Try advancing comparing 1000 chars at a time. | |
950 | ;; When that fails, go 500 chars at a time, and so on. | |
951 | (let ((size 1000) | |
952 | success-1 | |
953 | (case-fold-search compare-ignore-case)) | |
954 | (while (> size 0) | |
955 | (setq success-1 t) | |
956 | ;; Try comparing SIZE chars at a time, repeatedly, till that fails. | |
957 | (while success-1 | |
958 | (setq size (min size (- maxp1 p1) (- maxp2 p2))) | |
959 | (setq success-1 | |
960 | (and (> size 0) | |
961 | (= 0 (compare-buffer-substrings b2 p2 (+ size p2) | |
962 | b1 p1 (+ size p1))))) | |
963 | (if success-1 | |
964 | (setq p1 (+ p1 size) p2 (+ p2 size) | |
965 | success t))) | |
966 | ;; If SIZE chars don't match, try fewer. | |
967 | (setq size (/ size 2))))) | |
968 | ||
969 | (goto-char p1) | |
970 | (vcursor-move p2 t) | |
971 | (if (= (point) opoint1) | |
972 | (ding))) | |
973 | ) | |
bf078b46 RS |
974 | |
975 | (defun vcursor-next-line (arg) | |
976 | "Move the virtual cursor forward ARG lines." | |
977 | ;; This is next-line rewritten for the vcursor. Maybe it would | |
978 | ;; be easier simply to rewrite line-move. | |
979 | (interactive "p") | |
980 | (let (temporary-goal-column opoint text) | |
981 | (save-excursion | |
982 | (vcursor-locate) | |
983 | (setq temporary-goal-column | |
984 | (if (or (eq last-command 'vcursor-next-line) | |
985 | (eq last-command 'vcursor-previous-line)) | |
986 | (progn | |
987 | (setq last-command 'next-line) ; trick line-move | |
988 | vcursor-temp-goal-column) | |
989 | (if (and track-eol (eolp) | |
990 | (or (not (bolp)) (eq last-command 'end-of-line))) | |
991 | 9999 | |
992 | (current-column))) | |
993 | opoint (point)) | |
994 | (line-move arg) | |
995 | (and (eq opoint (point-max)) (eq opoint (point)) | |
996 | (signal 'end-of-buffer nil)) | |
997 | (if vcursor-copy-flag (setq text (buffer-substring opoint (point)))) | |
998 | (vcursor-move (point)) | |
999 | (setq vcursor-temp-goal-column temporary-goal-column | |
1000 | vcursor-last-command t)) | |
29fddfff | 1001 | (if text (vcursor-insert text))) |
bf078b46 RS |
1002 | ) |
1003 | ||
1004 | (defun vcursor-previous-line (arg) | |
1005 | "Move the virtual cursor back ARG lines." | |
1006 | (interactive "p") | |
1007 | (vcursor-next-line (- arg)) | |
1008 | ) | |
1009 | ||
1010 | (defun vcursor-forward-char (arg) | |
1011 | "Move the virtual cursor forward ARG characters." | |
1012 | (interactive "p") | |
1013 | (vcursor-relative-move 'forward-char arg) | |
1014 | ) | |
1015 | ||
1016 | (defun vcursor-backward-char (arg) | |
1017 | "Move the virtual cursor backward ARG characters." | |
1018 | (interactive "p") | |
1019 | (vcursor-relative-move 'backward-char arg) | |
1020 | ) | |
1021 | ||
1022 | (defun vcursor-forward-word (arg) | |
1023 | "Move the virtual cursor forward ARG words." | |
1024 | (interactive "p") | |
1025 | (vcursor-relative-move 'forward-word arg) | |
1026 | ) | |
1027 | ||
1028 | (defun vcursor-backward-word (arg) | |
1029 | "Move the virtual cursor backward ARG words." | |
1030 | (interactive "p") | |
1031 | (vcursor-relative-move 'backward-word arg) | |
1032 | ) | |
1033 | ||
1034 | (defun vcursor-beginning-of-line (arg) | |
1035 | "Move the virtual cursor to beginning of its current line. | |
1036 | ARG is as for `beginning-of-line'." | |
1037 | (interactive "P") | |
1038 | (vcursor-relative-move 'beginning-of-line | |
1039 | (if arg (prefix-numeric-value arg))) | |
1040 | ) | |
1041 | ||
1042 | (defun vcursor-end-of-line (arg) | |
1043 | "Move the virtual cursor to end of its current line. | |
1044 | ARG is as for `end-of-line'." | |
1045 | (interactive "P") | |
1046 | (vcursor-relative-move 'end-of-line | |
1047 | (if arg (prefix-numeric-value arg))) | |
1048 | ) | |
1049 | ||
1050 | (defun vcursor-beginning-of-buffer (&optional arg) | |
1051 | "Move the virtual cursor to the beginning of its buffer. | |
5a7383fd | 1052 | ARG is as for `beginning-of-buffer'." |
bf078b46 RS |
1053 | (interactive "P") |
1054 | (vcursor-relative-move | |
1055 | (lambda (arg) | |
1056 | (goto-char (if arg (/ (* arg (- (point-max) (point-min))) 10) | |
1057 | (point-min)))) | |
1058 | (if arg (prefix-numeric-value arg))) | |
1059 | ) | |
1060 | ||
1061 | (defun vcursor-end-of-buffer (&optional arg) | |
1062 | "Move the virtual cursor to the end of its buffer. | |
5a7383fd | 1063 | ARG is as for `end-of-buffer'. |
bf078b46 RS |
1064 | |
1065 | Actually, the vcursor is moved to the second from last character or it | |
1066 | would be invisible." | |
1067 | (interactive "P") | |
1068 | (vcursor-relative-move | |
1069 | (lambda (arg) | |
1070 | (goto-char (if arg (- (point-max) | |
1071 | (/ (* arg (- (point-max) (point-min))) 10)) | |
1072 | (point-max)))) | |
1073 | (if arg (prefix-numeric-value arg))) | |
1074 | ) | |
1075 | ||
1076 | (defun vcursor-execute-command (cmd) | |
1077 | "Execute COMMAND for the virtual cursor. | |
1078 | COMMAND is called interactively. Not all commands (in fact, only a | |
1079 | small subset) are useful." | |
1080 | (interactive "CCommand: ") | |
29fddfff | 1081 | (vcursor-window-funcall (list cmd)) |
bf078b46 RS |
1082 | ) |
1083 | ||
29fddfff RS |
1084 | (defun vcursor-execute-key () |
1085 | "Read a key sequence and execute the bound command for the virtual cursor. | |
1086 | The key sequence is read at the vcursor location. The command found | |
1087 | is called interactively, so prefix argument etc. are usable." | |
1088 | (interactive) | |
1089 | (let (cmd) | |
1090 | (save-excursion | |
1091 | ;; We'd like to avoid the display changing when we locate | |
1092 | ;; to the vcursor position and read a key sequence. | |
1093 | (vcursor-find-window (not (vcursor-check t)) t) | |
1094 | (save-window-excursion | |
1095 | (select-window vcursor-window) | |
1096 | (vcursor-locate) | |
1097 | (setq cmd (key-binding (read-key-sequence "Key sequence: "))))) | |
1098 | (vcursor-window-funcall (list cmd))) | |
bf078b46 RS |
1099 | ) |
1100 | ||
1101 | (defun vcursor-copy (arg) | |
1102 | "Copy ARG characters from the virtual cursor position to point." | |
1103 | (interactive "p") | |
1104 | (vcursor-check) | |
29fddfff | 1105 | (vcursor-insert |
ad141260 | 1106 | (with-current-buffer (overlay-buffer vcursor-overlay) |
bf078b46 RS |
1107 | (let* ((ostart (overlay-start vcursor-overlay)) |
1108 | (end (+ ostart arg))) | |
1109 | (prog1 | |
1110 | (buffer-substring ostart end) | |
1111 | (vcursor-move end))))) | |
1112 | (setq vcursor-last-command t) | |
1113 | ) | |
1114 | ||
1115 | (defun vcursor-copy-word (arg) | |
1116 | "Copy ARG words from the virtual cursor position to point." | |
1117 | (interactive "p") | |
1118 | (vcursor-copy (vcursor-get-char-count 'forward-word arg)) | |
1119 | ) | |
1120 | ||
1121 | (defun vcursor-copy-line (arg) | |
1122 | "Copy up to ARGth line after virtual cursor position. | |
1123 | With no argument, copy to the end of the current line. | |
1124 | ||
491a5bba | 1125 | Behavior with regard to newlines is similar (but not identical) to |
bf078b46 RS |
1126 | `kill-line'; the main difference is that whitespace at the end of the |
1127 | line is treated like ordinary characters." | |
1128 | ||
1129 | (interactive "P") | |
1130 | (let* ((num (prefix-numeric-value arg)) | |
1131 | (count (vcursor-get-char-count 'end-of-line num))) | |
1132 | (vcursor-copy (if (or (= count 0) arg) (1+ count) count))) | |
1133 | ) | |
1134 | ||
ad141260 SM |
1135 | (define-obsolete-function-alias |
1136 | 'vcursor-toggle-vcursor-map 'vcursor-use-vcursor-map "23.1") | |
29fddfff | 1137 | |
bf078b46 RS |
1138 | (defun vcursor-post-command () |
1139 | (and vcursor-auto-disable (not vcursor-last-command) | |
2d6a4733 RS |
1140 | vcursor-overlay |
1141 | (if (eq vcursor-auto-disable t) | |
1142 | (vcursor-disable) | |
1143 | (vcursor-toggle-copy -1 t))) | |
bf078b46 RS |
1144 | (setq vcursor-last-command nil) |
1145 | ) | |
1146 | ||
1147 | (add-hook 'post-command-hook 'vcursor-post-command) | |
1148 | ||
1149 | (provide 'vcursor) | |
1150 | ||
55535639 | 1151 | ;;; vcursor.el ends here |