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 )