Mercurial > emacs
comparison lisp/vcursor.el @ 21061:7813d4b7bea5
Some support for character terminals provided.
Various functions are smarter about using the correct windows
and the appropriate keymaps.
(vcursor-string): New variable, shows vcursor on dumb terminals.
(vcursor-map): New variable, holds keymap for vcursor commands.
(vcursor-use-vcursor-map): New variable, non-nil if vcursor
keys are overlaid onto main keymap.
(vcursor-toggle-vcursor-map): New function to implement this.
(vcursor-interpret-input): New variable, copy input as if typed.
(vcursor-window-funcall): With list instead of symbol, now calls interactively.
(vcursor-isearch-backward): New function to match forward isearch.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Tue, 03 Mar 1998 22:33:15 +0000 |
parents | e4a7b81d6c10 |
children | ac1673121774 |
comparison
equal
deleted
inserted
replaced
21060:29b4c6c23d92 | 21061:7813d4b7bea5 |
---|---|
1 ;;; vcursor.el --- manipulate an alternative ("virtual") cursor. | 1 ;;; vcursor.el --- manipulate an alternative ("virtual") cursor. |
2 | 2 |
3 ;; Copyright (C) 1994, 1996 Free Software Foundation, Inc. | 3 ;; Copyright (C) 1994, 1996, 1998 Free Software Foundation, Inc. |
4 | 4 |
5 ;; Author: Peter Stephenson <pws@ifh.de> | 5 ;; Author: Peter Stephenson <pws@ifh.de> |
6 ;; Keywords: virtual cursor, display, copying | 6 ;; Keywords: virtual cursor, display, copying |
7 | 7 |
8 ;; This file is part of GNU Emacs. | 8 ;; This file is part of GNU Emacs. |
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | 22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
23 ;; Boston, MA 02111-1307, USA. | 23 ;; Boston, MA 02111-1307, USA. |
24 | 24 |
25 ;;; Commentary: | 25 ;;; Commentary: |
26 | 26 |
27 ;; Latest changes (1.6) | |
28 ;; ==================== | |
29 ;; | |
30 ;; - works on dumb terminals with Emacs 19.29 and later | |
31 ;; - new keymap vcursor-map for binding to a prefix key | |
32 ;; - vcursor-compare-windows substantially improved | |
33 ;; - vcursor-execute-{key,command} much better about using the | |
34 ;; right keymaps and arranging for the correct windows to be used | |
35 ;; - vcursor-window-funcall can call functions interactively | |
36 ;; - vcursor-interpret-input for special effects | |
37 ;; | |
38 ;; Introduction | |
39 ;; ============ | |
40 ;; | |
27 ;; Virtual cursor commands. I got this idea from the old BBC micro. | 41 ;; 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 | 42 ;; You need Emacs 19 or 20 and a window system for the best effects. |
29 ;; system: I have tried X Windows and Oemacs but any system which | 43 ;; For character terminals, at least Emacs 19.29 is required |
30 ;; supports multiple windows should have the ability to run vcursor. | 44 ;; (special behaviour for the overlay property |
31 ;; In fact, only overlays are required to work, though some of the | 45 ;; "before-string" must be implemented). Search for "dumb terminals" |
32 ;; key-bindings may need changing. | 46 ;; for more information. |
33 ;; | 47 ;; |
34 ;; This is much easier to use than the instructions are to read. | 48 ;; 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 | 49 ;; 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 | 50 ;; 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 | 51 ;; what happens. (Find a scratch buffer before using C-S-tab: that |
59 ;; All the keybindings require you to hold down control and shift at | 73 ;; 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 | 74 ;; 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. | 75 ;; 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 | 76 ;; 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 | 77 ;; that: an intuitive binding is a prerequisite here. See below for |
64 ;; other alternatives (search for "Oemacs"). | 78 ;; other alternatives (search for "Oemacs"). There is also a keymap |
79 ;; which you can bind to a prefix key, which may give some more | |
80 ;; intuitive alternatives in some cases, see `The vcursor keymap' below. | |
65 ;; | 81 ;; |
66 ;; Holding down control and shift and pressing insert (vcursor-copy) | 82 ;; Holding down control and shift and pressing insert (vcursor-copy) |
67 ;; copies one character from wherever the virtual cursor is to point; | 83 ;; copies one character from wherever the virtual cursor is to point; |
68 ;; point and the virtual cursor advance in the separate and equal | 84 ;; point and the virtual cursor advance in the separate and equal |
69 ;; station to which... (etc.). M-C-S-return (vcursor-copy-line) | 85 ;; station to which... (etc.). M-C-S-return (vcursor-copy-line) |
85 ;; C-S-return (vcursor-disable) disables the virtual cursor, removing | 101 ;; C-S-return (vcursor-disable) disables the virtual cursor, removing |
86 ;; it so that it starts from point whenever you move it again --- note | 102 ;; 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 | 103 ;; that simply moving the cursor and virtual cursor on top of one |
88 ;; another does not have this effect. | 104 ;; another does not have this effect. |
89 ;; | 105 ;; |
90 ;; If you gave C-S-return a positive prefix arg, it will also delete the | 106 ;; If you give C-S-return a positive prefix arg, it will also delete the |
91 ;; window (unless it's the current one). Whenever the virtual cursor | 107 ;; 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 | 108 ;; 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. | 109 ;; 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 | 110 ;; However, point doesn't move unless the view in the window does, so |
95 ;; it's not tied to the virtual cursor location.) | 111 ;; it's not tied to the virtual cursor location.) |
146 ;; this file. (This feature partially emulates the way the "copy" key | 162 ;; this file. (This feature partially emulates the way the "copy" key |
147 ;; on the BBC micro worked; actually, the copy cursor was homed when | 163 ;; 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 | 164 ;; you hit return. This was in keeping with the line-by-line way of |
149 ;; entering BASIC, but is less appropriate here.) | 165 ;; entering BASIC, but is less appropriate here.) |
150 ;; | 166 ;; |
167 ;; vcursor-compare-windows is now a reliable adaption of | |
168 ;; compare-windows, which compares between point in the current buffer | |
169 ;; and the vcursor location in the other one. It is an error if | |
170 ;; vcursor is not set, however it will be brought up in another window | |
171 ;; if it is not currently visible. The prefix argument acts just like | |
172 ;; compare-windows, ignoring whitespace if set. (In versions before | |
173 ;; 1.6, this simply called compare-windows, which was much less likely | |
174 ;; to pick the two windows you wanted.) | |
175 ;; | |
151 ;; There is a way of moving the virtual cursor using ordinary | 176 ;; There is a way of moving the virtual cursor using ordinary |
152 ;; commands: C-S-f9 (vcursor-execute-key) reads a key string, | 177 ;; commands: C-S-f9 (vcursor-execute-key) reads a key string, |
153 ;; moves to the virtual cursor position, executes the command bound to | 178 ;; 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 | 179 ;; 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 | 180 ;; moves the virtual cursor back to the first non-whitespace character |
156 ;; on its line. As the command is called interactively all the usual | 181 ;; 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 | 182 ;; ways of passing information to the command called, such as by a |
158 ;; prefix argument, are available. C-S-f10 (C-S-x) | 183 ;; prefix argument, are available. This has many uses not necessarily |
159 ;; (vcursor-execute-command) behaves the same way but you enter the | 184 ;; related to moving the vcursor itself; it can do essentially |
160 ;; name of the command. Of course, only some commands are useful | 185 ;; everything that the \C-x 4 series of commands can do and a lot |
161 ;; here, mainly simple movement commands. Killing at the virtual | 186 ;; more. Note, however, that a new window is not used if the vcursor |
162 ;; cursor position in this way works as well; you can even save | 187 ;; is visible in the current one: this can lead to some strange effects, |
163 ;; another buffer with C-S-f9 C-x C-s. To do anything more | 188 ;; but it is preferable to making a new window every time the vcursor |
189 ;; is moved in this may. | |
190 ;; | |
191 ;; C-S-f10 (C-S-x) (vcursor-execute-command) behaves the same way but | |
192 ;; you enter the name of the command. To do anything really | |
164 ;; complicated, you are better off using M-C-S-tab | 193 ;; complicated, you are better off using M-C-S-tab |
165 ;; (vcursor-swap-point), doing whatever it is, then calling M-C-S-tab | 194 ;; (vcursor-swap-point), doing whatever it is, then calling M-C-S-tab |
166 ;; again. | 195 ;; again. |
167 ;; | 196 ;; |
168 ;; If you want to add your own moving or copying functions you should | 197 ;; 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 | 198 ;; 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 | 199 ;; (vcursor-copy) together with (vcursor-get-char-count). If you want to |
171 ;; do something in a different window, use (vcursor-window-funcall). | 200 ;; do something in a different window, use (vcursor-window-funcall). |
172 ;; | 201 ;; |
202 ;; Key bindings | |
203 ;; ============ | |
204 ;; | |
173 ;; There is an alternative set of key bindings which will be used | 205 ;; 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 | 206 ;; 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 | 207 ;; control, shift and meta keys with function keys 1 to 10. In |
176 ;; particular, movement keys are concentrated on f5 to f8 with (in | 208 ;; particular, movement keys are concentrated on f5 to f8 with (in |
177 ;; increasing order of distance travelled) C-, M- and S- as prefixes. | 209 ;; increasing order of distance travelled) C-, M- and S- as prefixes. |
186 ;; and you can define your own. The default is t, which makes vcursor | 218 ;; 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 | 219 ;; 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 | 220 ;; oemacs set will work on an X terminal with function keys, but the |
189 ;; xterm set will not work under Oemacs. | 221 ;; xterm set will not work under Oemacs. |
190 ;; | 222 ;; |
191 ;; Un-features: | 223 ;; Usage on dumb terminals |
224 ;; ======================= | |
225 ;; | |
226 ;; If Emacs has set the variable window-system to nil, vcursor will | |
227 ;; assume that overlays cannot be displayed in a different face, | |
228 ;; and will instead use an string (the variable vcursor-string, by | |
229 ;; default "**>") to show its position. This was first implemented | |
230 ;; in Emacs 19.29. Unlike the old-fashioned overlay arrow (as used | |
231 ;; by debuggers), this appears between existing text, which can | |
232 ;; make it hard to read if you're not used to it. (This seemed the | |
233 ;; better option here.) This means moving the vcursor up and down is | |
234 ;; a very efficient way of locating it! | |
235 ;; | |
236 ;; Everything else should function as expected, but there is no way to | |
237 ;; get an easy key binding for the vcursor keys on a generic terminal. | |
238 ;; Consequently a special keymap is defined for you to use traditional | |
239 ;; methods: the keymap, however, is available on any terminal type. | |
240 ;; | |
241 ;; The vcursor keymap | |
242 ;; ================== | |
243 ;; | |
244 ;; In addition to any other bindings, vcursor-map contains key definitions | |
245 ;; for handling the vcursor. You should assign this to a prefix key | |
246 ;; in the usual way, e.g. | |
247 ;; (global-set-key [f14] vcursor-map) | |
248 ;; and also as usual \C-h in this map will list the key definitions, which | |
249 ;; are designed to be easy to remember. | |
250 ;; | |
251 ;; A special feature is provided by (vcursor-toggle-vcursor-map), bound | |
252 ;; to t in that keymap. With this in effect, the main keymap | |
253 ;; is overridden by the vcursor map, so keys like \C-p and so on | |
254 ;; move the vcursor instead. Remember how to turn it off (type t), | |
255 ;; or you are in serious trouble! Note that the cursor keys are not | |
256 ;; bound by default in this keymap and will continue to move the | |
257 ;; ordinary cursor. | |
258 ;; | |
259 ;; Interpreted input | |
260 ;; ================= | |
261 ;; | |
262 ;; Just occasionally, you may want to pretend the strings copied from | |
263 ;; the vcursor position are to be interpreted as if you had typed them | |
264 ;; from the keyboard. Normally, they will just insert themselves anyway, | |
265 ;; but in some modes (Info and calc for example) typing ordinary characters | |
266 ;; does something else. To get this effect, set | |
267 ;; vcursor-interpret-input to t. This is normally not a good idea as | |
268 ;; interpreting input is very much slower than copying text. | |
269 ;; | |
270 ;; Un-features | |
271 ;; =========== | |
272 ;; | |
192 ;; - The vcursor will not move to point-max, since otherwise it would | 273 ;; - 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 | 274 ;; 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 | 275 ;; 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, | 276 ;; 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 | 277 ;; and if copying is on the last character (typically newline) will |
222 ;;; Code: | 303 ;;; Code: |
223 | 304 |
224 (or (memq 'vcursor (face-list)) | 305 (or (memq 'vcursor (face-list)) |
225 (progn | 306 (progn |
226 (copy-face 'modeline 'vcursor) | 307 (copy-face 'modeline 'vcursor) |
227 (if (or (fboundp 'oemacs-version) (x-display-color-p)) | 308 (if (or (fboundp 'oemacs-version) |
309 (and (eq window-system 'x) (x-display-color-p))) | |
228 (progn | 310 (progn |
229 (set-face-foreground 'vcursor "blue") | 311 (set-face-foreground 'vcursor "blue") |
230 (set-face-background 'vcursor "cyan"))) | 312 (set-face-background 'vcursor "cyan"))) |
231 (set-face-underline-p 'vcursor t))) | 313 (set-face-underline-p 'vcursor t))) |
232 | 314 |
238 "*How to bind keys when vcursor is loaded. | 320 "*How to bind keys when vcursor is loaded. |
239 If t (the default), guess; if xterm, use bindings suitable for an | 321 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. | 322 X terminal; if oemacs, use bindings which work on a PC with Oemacs. |
241 If nil, don't define any key bindings.") | 323 If nil, don't define any key bindings.") |
242 | 324 |
243 (defvar vcursor-overlay nil | 325 (defvar vcursor-interpret-input nil |
326 "*If non-nil, input from the vcursor is treated as interactive input. | |
327 This will cause text insertion to be much slower. Note that no special | |
328 interpretation of strings is done: \"\C-x\" is a string of four | |
329 characters. The default is simply to copy strings.") | |
330 | |
331 (defvar vcursor-string "**>" | |
332 "String used to show the vcursor position on dumb terminals.") | |
333 | |
334 (defvar vcursor-overlay nil | |
244 "Overlay for the virtual cursor. | 335 "Overlay for the virtual cursor. |
245 It is nil if that is not enabled.") | 336 It is nil if that is not enabled.") |
246 | 337 |
247 (defvar vcursor-window nil | 338 (defvar vcursor-window nil |
248 "Last window to have displayed the virtual cursor. | 339 "Last window to have displayed the virtual cursor. |
258 (defvar vcursor-copy-flag nil | 349 (defvar vcursor-copy-flag nil |
259 "*Non-nil means moving vcursor should copy characters moved over to point.") | 350 "*Non-nil means moving vcursor should copy characters moved over to point.") |
260 | 351 |
261 (defvar vcursor-temp-goal-column nil | 352 (defvar vcursor-temp-goal-column nil |
262 "Keeps track of temporary goal columns for the virtual cursor.") | 353 "Keeps track of temporary goal columns for the virtual cursor.") |
354 | |
355 (defvar vcursor-use-vcursor-map nil | |
356 "Non-nil if the vcursor map is mapped directly onto the main keymap. | |
357 See vcursor-toggle-vcursor-map.") | |
358 (make-variable-buffer-local 'vcursor-use-vcursor-map) | |
359 | |
360 (defvar vcursor-map nil "Keymap for vcursor command.") | |
361 (define-prefix-command 'vcursor-map) | |
362 | |
363 (define-key vcursor-map "t" 'vcursor-toggle-vcursor-map) | |
364 | |
365 (define-key vcursor-map "\C-p" 'vcursor-previous-line) | |
366 (define-key vcursor-map "\C-n" 'vcursor-next-line) | |
367 (define-key vcursor-map "\C-b" 'vcursor-backward-char) | |
368 (define-key vcursor-map "\C-f" 'vcursor-forward-char) | |
369 | |
370 (define-key vcursor-map "\r" 'vcursor-disable) | |
371 (define-key vcursor-map " " 'vcursor-copy) | |
372 (define-key vcursor-map "\C-y" 'vcursor-copy-word) | |
373 (define-key vcursor-map "\C-i" 'vcursor-toggle-copy) | |
374 (define-key vcursor-map "<" 'vcursor-beginning-of-buffer) | |
375 (define-key vcursor-map ">" 'vcursor-end-of-buffer) | |
376 (define-key vcursor-map "\M-v" 'vcursor-scroll-down) | |
377 (define-key vcursor-map "\C-v" 'vcursor-scroll-up) | |
378 (define-key vcursor-map "o" 'vcursor-other-window) | |
379 (define-key vcursor-map "g" 'vcursor-goto) | |
380 (define-key vcursor-map "x" 'vcursor-swap-point) | |
381 (define-key vcursor-map "\C-s" 'vcursor-isearch-forward) | |
382 (define-key vcursor-map "\C-r" 'vcursor-isearch-backward) | |
383 (define-key vcursor-map "\C-a" 'vcursor-beginning-of-line) | |
384 (define-key vcursor-map "\C-e" 'vcursor-end-of-line) | |
385 (define-key vcursor-map "\M-w" 'vcursor-forward-word) | |
386 (define-key vcursor-map "\M-b" 'vcursor-backward-word) | |
387 (define-key vcursor-map "\M-l" 'vcursor-copy-line) | |
388 (define-key vcursor-map "c" 'vcursor-compare-windows) | |
389 (define-key vcursor-map "k" 'vcursor-execute-key) | |
390 (define-key vcursor-map "\M-x" 'vcursor-execute-command) | |
263 | 391 |
264 (cond | 392 (cond |
265 ((not vcursor-key-bindings)) ;; don't set any key bindings | 393 ((not vcursor-key-bindings)) ;; don't set any key bindings |
266 ((or (eq vcursor-key-bindings 'oemacs) | 394 ((or (eq vcursor-key-bindings 'oemacs) |
267 (and (eq vcursor-key-bindings t) (fboundp 'oemacs-version))) | 395 (and (eq vcursor-key-bindings t) (fboundp 'oemacs-version))) |
443 vcursor-last-command t) | 571 vcursor-last-command t) |
444 (or nomsg (message "Copying from the vcursor is now %s." | 572 (or nomsg (message "Copying from the vcursor is now %s." |
445 (if vcursor-copy-flag "on" "off"))) | 573 (if vcursor-copy-flag "on" "off"))) |
446 ) | 574 ) |
447 | 575 |
448 (defun vcursor-move (pt) | 576 (defun vcursor-move (pt &optional leave-b leave-w) |
449 "Move the virtual cursor to the character to the right of PT. | 577 "Move the virtual cursor to the character to the right of PT. |
450 PT is an absolute location in the current buffer. | 578 PT is an absolute location in the current buffer. With optional |
579 LEAVE-B, PT is in the same buffer the vcursor is currently in. | |
451 | 580 |
452 If the new virtual cursor location would not be visible, display it in | 581 If the new virtual cursor location would not be visible, display it in |
453 another window." | 582 another window. With LEAVE-W, use the current `vcursor-window'." |
454 ;; this works even if we're on-mass-shell, but usually we won't be. | 583 ;; this works even if we're on-mass-shell, but usually we won't be. |
455 | 584 |
456 (if (eq pt (point-max)) (setq pt (1- pt))) | 585 (save-excursion |
457 (if (vcursor-check t) | 586 (and leave-b (vcursor-check t) |
458 (move-overlay vcursor-overlay pt (+ pt 1) (current-buffer)) | 587 (set-buffer (overlay-buffer vcursor-overlay))) |
459 (setq vcursor-overlay (make-overlay pt (+ pt 1))) | 588 (if (eq pt (point-max)) |
460 (overlay-put vcursor-overlay 'face 'vcursor)) | 589 (setq pt (1- pt))) |
461 (vcursor-find-window nil t) | 590 (if (vcursor-check t) |
462 ;; vcursor-window now contains the right buffer | 591 (move-overlay vcursor-overlay pt (+ pt 1) (current-buffer)) |
463 (or (pos-visible-in-window-p pt vcursor-window) | 592 (setq vcursor-overlay (make-overlay pt (+ pt 1))) |
464 (set-window-point vcursor-window pt)) | 593 (or window-system |
594 (overlay-put vcursor-overlay 'before-string vcursor-string)) | |
595 (overlay-put vcursor-overlay 'face 'vcursor)) | |
596 (or leave-w (vcursor-find-window nil t)) | |
597 ;; vcursor-window now contains the right buffer | |
598 (or (pos-visible-in-window-p pt vcursor-window) | |
599 (set-window-point vcursor-window pt))) | |
600 ) | |
601 | |
602 (defun vcursor-insert (text) | |
603 "Insert TEXT, respecting `vcursor-interpret-input'." | |
604 (if vcursor-interpret-input | |
605 (setq unread-command-events | |
606 (append (listify-key-sequence text) unread-command-events)) | |
607 (insert text)) | |
465 ) | 608 ) |
466 | 609 |
467 (defun vcursor-relative-move (fn &rest args) | 610 (defun vcursor-relative-move (fn &rest args) |
468 "Use FUNCTION with arbitrary ARG1 ... to move the virtual cursor. | 611 "Use FUNCTION with arbitrary ARG1 ... to move the virtual cursor. |
469 | 612 |
475 (apply fn args) | 618 (apply fn args) |
476 (and (eq opoint (point-max)) (eq opoint (point)) | 619 (and (eq opoint (point-max)) (eq opoint (point)) |
477 (signal 'end-of-buffer nil)) | 620 (signal 'end-of-buffer nil)) |
478 (vcursor-move (point)) | 621 (vcursor-move (point)) |
479 (if vcursor-copy-flag (setq text (buffer-substring opoint (point))))) | 622 (if vcursor-copy-flag (setq text (buffer-substring opoint (point))))) |
480 (if text (insert text))) | 623 (if text (vcursor-insert text))) |
481 (setq vcursor-last-command t) | 624 (setq vcursor-last-command t) |
482 ) | 625 ) |
483 | 626 |
484 (defun vcursor-goto (&optional arg) | 627 (defun vcursor-goto (&optional arg) |
485 "Move the real cursor to the virtual cursor position. | 628 "Move the real cursor to the virtual cursor position. |
534 | 677 |
535 (interactive "P") | 678 (interactive "P") |
536 (vcursor-window-funcall 'isearch-forward rep norecurs) | 679 (vcursor-window-funcall 'isearch-forward rep norecurs) |
537 ) | 680 ) |
538 | 681 |
682 (defun vcursor-isearch-backward (&optional rep norecurs) | |
683 "Perform backward incremental search in the virtual cursor window. | |
684 The virtual cursor is moved to the resulting point; the ordinary | |
685 cursor stays where it was." | |
686 | |
687 (interactive "P") | |
688 (vcursor-window-funcall 'isearch-backward rep norecurs) | |
689 ) | |
690 | |
539 (defun vcursor-window-funcall (func &rest args) | 691 (defun vcursor-window-funcall (func &rest args) |
540 "Call FUNC with ARGS ... in a virtual cursor window. | 692 "Call FUNC with ARGS ... in a virtual cursor window. |
541 A window other than the currently-selected one will always be used. | 693 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 | 694 The virtual cursor is moved to the value of point when the function |
543 returns." | 695 returns. |
544 | 696 |
545 (vcursor-find-window t t) | 697 If FUNC is a list, call the car of the list interactively, ignoring |
546 (let ((sw (selected-window)) text) | 698 ARGS. In this case, a new window will not be created if the vcursor |
547 ;; We can't use save-window-excursion because that would restore | 699 is visible in the current one." |
548 ;; the original display in the window we may want to alter. | 700 ;; that's to avoid messing up compatibility with old versions |
549 (unwind-protect | 701 ;; by introducing a new argument, which would have to come before ARGS. |
550 (let ((here (point))) | 702 |
551 (select-window vcursor-window) | 703 (vcursor-find-window (not (and (listp func) (vcursor-check t))) t) |
552 (vcursor-locate) | 704 (save-excursion |
553 (apply func args) | 705 (let ((sw (selected-window)) text) |
554 (if vcursor-copy-flag (setq text (buffer-substring here (point)))) | 706 ;; We can't use save-window-excursion because that would restore |
555 (vcursor-move (point))) | 707 ;; the original display in the window we may want to alter. |
556 (select-window sw)) | 708 (unwind-protect |
557 (if text (insert text))) | 709 (let ((here (point))) |
710 (select-window vcursor-window) | |
711 (vcursor-locate) | |
712 (if (listp func) | |
713 (call-interactively (car func)) | |
714 (apply func args)) | |
715 (setq vcursor-window (selected-window)) | |
716 (and vcursor-copy-flag | |
717 (eq (current-buffer) (overlay-buffer vcursor-overlay)) | |
718 (setq text (buffer-substring here (point)))) | |
719 ;; vcursor-window and the current buffer are definitely | |
720 ;; right, so make sure vcursor-move doesn't pick others. | |
721 (vcursor-move (point) nil t)) | |
722 (select-window sw)) | |
723 (if text (vcursor-insert text)))) | |
558 (setq vcursor-last-command t) | 724 (setq vcursor-last-command t) |
559 ) | 725 ) |
560 | 726 |
561 (defun vcursor-get-char-count (fn &rest args) | 727 (defun vcursor-get-char-count (fn &rest args) |
562 "Apply FN to ARG1 ... and return the number of characters moved. | 728 "Apply FN to ARG1 ... and return the number of characters moved. |
605 (setq vcursor-overlay nil))) | 771 (setq vcursor-overlay nil))) |
606 (cond | 772 (cond |
607 ((not (vcursor-find-window t))) | 773 ((not (vcursor-find-window t))) |
608 ((or (not arg) (< (prefix-numeric-value arg) 0))) | 774 ((or (not arg) (< (prefix-numeric-value arg) 0))) |
609 ((delete-window vcursor-window))) | 775 ((delete-window vcursor-window))) |
610 (and arg (< (prefix-numeric-value arg) 0) | 776 (cond |
611 (progn | 777 ((and arg (< (prefix-numeric-value arg) 0)) |
612 (vcursor-move (point)) | 778 (vcursor-move (point)) |
613 (setq vcursor-window (selected-window)))) | 779 (setq vcursor-window (selected-window))) |
780 (vcursor-use-vcursor-map (vcursor-toggle-vcursor-map 0))) | |
614 (setq vcursor-copy-flag nil) | 781 (setq vcursor-copy-flag nil) |
615 ) | 782 ) |
616 | 783 |
617 (defun vcursor-other-window (n &optional all-frames) | 784 (defun vcursor-other-window (n &optional all-frames) |
618 "Activate the virtual cursor in another window. | 785 "Activate the virtual cursor in another window. |
639 ;; else start from here | 806 ;; else start from here |
640 (other-window n all-frames) | 807 (other-window n all-frames) |
641 (vcursor-disable -1)))) | 808 (vcursor-disable -1)))) |
642 ) | 809 ) |
643 | 810 |
644 (defun vcursor-compare-windows (&optional arg) | 811 ;; vcursor-compare-windows is copied from compare-w.el with only |
645 "Call `compare-windows' in the vcursor window. | 812 ;; minor modifications; these are too bound up with the function |
646 This has the effect of comparing the vcursor window with whichever | 813 ;; to make it really useful to call compare-windows itself. |
647 window `next-window' returns there, which may not be the selected one. | 814 (defun vcursor-compare-windows (&optional ignore-whitespace) |
648 | 815 "Compare text in current window with text in window with vcursor. |
649 A prefix argument, if any, is passed to `compare-windows'." | 816 Compares the text starting at point in the current window and at the |
650 (interactive "P") | 817 vcursor position in the other window, moving over text in each one as |
651 (vcursor-window-funcall 'compare-windows arg)) | 818 far as they match. |
819 | |
820 A prefix argument, if any, means ignore changes in whitespace. | |
821 The variable `compare-windows-whitespace' controls how whitespace is skipped. | |
822 If `compare-ignore-case' is non-nil, changes in case are also ignored." | |
823 (interactive "P") | |
824 ;; (vcursor-window-funcall 'compare-windows arg) | |
825 (require 'compare-w) | |
826 (let* (p1 p2 maxp1 maxp2 b1 b2 w2 | |
827 success size | |
828 (opoint1 (point)) | |
829 opoint2 | |
830 (skip-whitespace (if ignore-whitespace | |
831 compare-windows-whitespace))) | |
832 (setq p1 (point) b1 (current-buffer)) | |
833 (setq w2 (vcursor-find-window t t)) | |
834 (if (or (eq w2 (selected-window)) (not w2)) | |
835 (error "No other window with vcursor")) | |
836 (save-excursion | |
837 (vcursor-locate) | |
838 (setq p2 (point) b2 (current-buffer))) | |
839 (setq opoint2 p2) | |
840 (setq maxp1 (point-max)) | |
841 (save-excursion | |
842 (set-buffer b2) | |
843 (setq maxp2 (point-max))) | |
844 | |
845 (setq success t) | |
846 (while success | |
847 (setq success nil) | |
848 ;; if interrupted, show how far we've gotten | |
849 (goto-char p1) | |
850 (vcursor-move p2 t) | |
851 | |
852 ;; If both buffers have whitespace next to point, | |
853 ;; optionally skip over it. | |
854 | |
855 (and skip-whitespace | |
856 (save-excursion | |
857 (let (p1a p2a w1 w2 result1 result2) | |
858 (setq result1 | |
859 (if (stringp skip-whitespace) | |
860 (compare-windows-skip-whitespace opoint1) | |
861 (funcall skip-whitespace opoint1))) | |
862 (setq p1a (point)) | |
863 (set-buffer b2) | |
864 (goto-char p2) | |
865 (setq result2 | |
866 (if (stringp skip-whitespace) | |
867 (compare-windows-skip-whitespace opoint2) | |
868 (funcall skip-whitespace opoint2))) | |
869 (setq p2a (point)) | |
870 (if (or (stringp skip-whitespace) | |
871 (and result1 result2 (eq result1 result2))) | |
872 (setq p1 p1a | |
873 p2 p2a))))) | |
874 | |
875 ;; Try advancing comparing 1000 chars at a time. | |
876 ;; When that fails, go 500 chars at a time, and so on. | |
877 (let ((size 1000) | |
878 success-1 | |
879 (case-fold-search compare-ignore-case)) | |
880 (while (> size 0) | |
881 (setq success-1 t) | |
882 ;; Try comparing SIZE chars at a time, repeatedly, till that fails. | |
883 (while success-1 | |
884 (setq size (min size (- maxp1 p1) (- maxp2 p2))) | |
885 (setq success-1 | |
886 (and (> size 0) | |
887 (= 0 (compare-buffer-substrings b2 p2 (+ size p2) | |
888 b1 p1 (+ size p1))))) | |
889 (if success-1 | |
890 (setq p1 (+ p1 size) p2 (+ p2 size) | |
891 success t))) | |
892 ;; If SIZE chars don't match, try fewer. | |
893 (setq size (/ size 2))))) | |
894 | |
895 (goto-char p1) | |
896 (vcursor-move p2 t) | |
897 (if (= (point) opoint1) | |
898 (ding))) | |
899 ) | |
652 | 900 |
653 (defun vcursor-next-line (arg) | 901 (defun vcursor-next-line (arg) |
654 "Move the virtual cursor forward ARG lines." | 902 "Move the virtual cursor forward ARG lines." |
655 ;; This is next-line rewritten for the vcursor. Maybe it would | 903 ;; This is next-line rewritten for the vcursor. Maybe it would |
656 ;; be easier simply to rewrite line-move. | 904 ;; be easier simply to rewrite line-move. |
674 (signal 'end-of-buffer nil)) | 922 (signal 'end-of-buffer nil)) |
675 (if vcursor-copy-flag (setq text (buffer-substring opoint (point)))) | 923 (if vcursor-copy-flag (setq text (buffer-substring opoint (point)))) |
676 (vcursor-move (point)) | 924 (vcursor-move (point)) |
677 (setq vcursor-temp-goal-column temporary-goal-column | 925 (setq vcursor-temp-goal-column temporary-goal-column |
678 vcursor-last-command t)) | 926 vcursor-last-command t)) |
679 (if text (insert text))) | 927 (if text (vcursor-insert text))) |
680 ) | 928 ) |
681 | 929 |
682 (defun vcursor-previous-line (arg) | 930 (defun vcursor-previous-line (arg) |
683 "Move the virtual cursor back ARG lines." | 931 "Move the virtual cursor back ARG lines." |
684 (interactive "p") | 932 (interactive "p") |
754 (defun vcursor-execute-command (cmd) | 1002 (defun vcursor-execute-command (cmd) |
755 "Execute COMMAND for the virtual cursor. | 1003 "Execute COMMAND for the virtual cursor. |
756 COMMAND is called interactively. Not all commands (in fact, only a | 1004 COMMAND is called interactively. Not all commands (in fact, only a |
757 small subset) are useful." | 1005 small subset) are useful." |
758 (interactive "CCommand: ") | 1006 (interactive "CCommand: ") |
759 (let (text opoint) | 1007 (vcursor-window-funcall (list cmd)) |
1008 ) | |
1009 | |
1010 (defun vcursor-execute-key () | |
1011 "Read a key sequence and execute the bound command for the virtual cursor. | |
1012 The key sequence is read at the vcursor location. The command found | |
1013 is called interactively, so prefix argument etc. are usable." | |
1014 (interactive) | |
1015 (let (cmd) | |
760 (save-excursion | 1016 (save-excursion |
761 (vcursor-locate) | 1017 ;; We'd like to avoid the display changing when we locate |
762 (setq opoint (point)) | 1018 ;; to the vcursor position and read a key sequence. |
763 (call-interactively cmd) | 1019 (vcursor-find-window (not (vcursor-check t)) t) |
764 (if vcursor-copy-flag (setq text (buffer-substring opoint (point)))) | 1020 (save-window-excursion |
765 (vcursor-move (point))) | 1021 (select-window vcursor-window) |
766 (if text (insert text))) | 1022 (vcursor-locate) |
767 (setq vcursor-last-command t) | 1023 (setq cmd (key-binding (read-key-sequence "Key sequence: "))))) |
768 ) | 1024 (vcursor-window-funcall (list cmd))) |
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 ) | 1025 ) |
779 | 1026 |
780 (defun vcursor-copy (arg) | 1027 (defun vcursor-copy (arg) |
781 "Copy ARG characters from the virtual cursor position to point." | 1028 "Copy ARG characters from the virtual cursor position to point." |
782 (interactive "p") | 1029 (interactive "p") |
783 (vcursor-check) | 1030 (vcursor-check) |
784 (insert | 1031 (vcursor-insert |
785 (save-excursion | 1032 (save-excursion |
786 (set-buffer (overlay-buffer vcursor-overlay)) | 1033 (set-buffer (overlay-buffer vcursor-overlay)) |
787 (let* ((ostart (overlay-start vcursor-overlay)) | 1034 (let* ((ostart (overlay-start vcursor-overlay)) |
788 (end (+ ostart arg))) | 1035 (end (+ ostart arg))) |
789 (prog1 | 1036 (prog1 |
810 (let* ((num (prefix-numeric-value arg)) | 1057 (let* ((num (prefix-numeric-value arg)) |
811 (count (vcursor-get-char-count 'end-of-line num))) | 1058 (count (vcursor-get-char-count 'end-of-line num))) |
812 (vcursor-copy (if (or (= count 0) arg) (1+ count) count))) | 1059 (vcursor-copy (if (or (= count 0) arg) (1+ count) count))) |
813 ) | 1060 ) |
814 | 1061 |
1062 (defun vcursor-toggle-vcursor-map (&optional force noredisp) | |
1063 "Toggle the state of the vcursor key map. | |
1064 When on, the keys defined in it are mapped directly on top of the main | |
1065 keymap, allowing you to move the vcursor with ordinary motion keys. | |
1066 An indication \"!VC\" appears in the mode list. The effect is | |
1067 local to the current buffer. | |
1068 With prefix FORCE, turn on, or off if it is 0. | |
1069 With NOREDISP, don't force redisplay. | |
1070 Disabling the vcursor automatically turns this off." | |
1071 (interactive "P") | |
1072 (let ((new (cond ((not force) (not vcursor-use-vcursor-map)) | |
1073 ((eq force 0) nil) | |
1074 (t)))) | |
1075 (or (eq new vcursor-use-vcursor-map) | |
1076 (progn | |
1077 (setq vcursor-use-vcursor-map new) | |
1078 (or (assq 'vcursor-use-vcursor-map minor-mode-map-alist) | |
1079 (setq minor-mode-map-alist | |
1080 (cons (cons 'vcursor-use-vcursor-map vcursor-map) | |
1081 minor-mode-map-alist))) | |
1082 (or (assq 'vcursor-use-vcursor-map minor-mode-alist) | |
1083 (setq minor-mode-alist | |
1084 (cons (list 'vcursor-use-vcursor-map " !VC") | |
1085 minor-mode-alist))) | |
1086 (or noredisp (redraw-display))))) | |
1087 ) | |
1088 | |
815 (defun vcursor-post-command () | 1089 (defun vcursor-post-command () |
816 (and vcursor-auto-disable (not vcursor-last-command) | 1090 (and vcursor-auto-disable (not vcursor-last-command) |
817 vcursor-overlay (vcursor-disable)) | 1091 vcursor-overlay (vcursor-disable)) |
818 (setq vcursor-last-command nil) | 1092 (setq vcursor-last-command nil) |
819 ) | 1093 ) |