;;; vcursor.el --- manipulate an alternative ("virtual") cursor.
-;; Copyright (C) 1994, 1996 Free Software Foundation, Inc.
+;; Copyright (C) 1994, 1996, 1998 Free Software Foundation, Inc.
-;; Author: Peter Stephenson <pws@ifh.de>
-;; Keywords: virtual cursor, display, copying
+;; Author: Peter Stephenson <pws@ibmth.df.unipi.it>
+;; Maintainer: FSF
+;; Keywords: virtual cursor, convenience
;; This file is part of GNU Emacs.
;;; Commentary:
+;; Latest changes
+;; ==============
+;;
+;; - *IMPORTANT* vcursor-key-bindings is now nil by default, to avoid
+;; side-effects when the package is loaded. This means no keys are
+;; bound by default. Use customize to change it to t to restore
+;; the old behaviour. (If you do it by hand in .emacs, it
+;; must come before vcursor is loaded.)
+;; - You can alter the main variables and the vcursor face via
+;; M-x customize: go to the Editing group and find Vcursor.
+;; - vcursor-auto-disable can now be 'copy (actually any value not nil
+;; or t), which means that copying from the vcursor will be turned
+;; off after any operation not involving the vcursor, but the
+;; vcursor itself will be left alone.
+;; - works on dumb terminals with Emacs 19.29 and later
+;; - new keymap vcursor-map for binding to a prefix key
+;; - vcursor-compare-windows substantially improved
+;; - vcursor-execute-{key,command} much better about using the
+;; right keymaps and arranging for the correct windows to be used
+;; - vcursor-window-funcall can call functions interactively
+;; - vcursor-interpret-input for special effects
+;;
+;; Introduction
+;; ============
+;;
;; Virtual cursor commands. I got this idea from the old BBC micro.
-;; You need Emacs 19 (I have not tried XEmacs) and a windowing
-;; system: I have tried X Windows and Oemacs but any system which
-;; supports multiple windows should have the ability to run vcursor.
-;; In fact, only overlays are required to work, though some of the
-;; key-bindings may need changing.
+;; You need Emacs 19 or 20 and a window system for the best effects.
+;; For character terminals, at least Emacs 19.29 is required
+;; (special behaviour for the overlay property
+;; "before-string" must be implemented). Search for "dumb terminals"
+;; for more information.
;;
;; This is much easier to use than the instructions are to read.
-;; I suggest you simply load it and play around with holding down Ctrl
-;; and Shift and pressing up, down, left, right, tab, return, and see
-;; what happens. (Find a scratch buffer before using C-S-tab: that
-;; toggles copying.)
+;; First, you need to let vcursor define some keys: setting
+;; vcursor-key-bindings to t before loading, or by customize, will
+;; define various keys with the prefix C-S. You'll have to read
+;; further if you don't want this. Then I suggest you simply load it
+;; and play around with holding down Ctrl and Shift and pressing up,
+;; down, left, right, tab, return, and see what happens. (Find a
+;; scratch buffer before using C-S-tab: that toggles copying.)
;;
;; Most of the functions described in this documentation are in
;; parentheses so that if you have the package loaded you can type C-h
;; people and that it would be easy to type with the left hand.
;; Inevitably it will clash with some other packages, but I can't help
;; that: an intuitive binding is a prerequisite here. See below for
-;; other alternatives (search for "Oemacs").
+;; other alternatives (search for "Oemacs"). There is also a keymap
+;; which you can bind to a prefix key, which may give some more
+;; intuitive alternatives in some cases, see `The vcursor keymap' below.
;;
;; Holding down control and shift and pressing insert (vcursor-copy)
;; copies one character from wherever the virtual cursor is to point;
;; that simply moving the cursor and virtual cursor on top of one
;; another does not have this effect.
;;
-;; If you gave C-S-return a positive prefix arg, it will also delete the
+;; If you give C-S-return a positive prefix arg, it will also delete the
;; window (unless it's the current one). Whenever the virtual cursor
;; goes off-screen in its own window, point in that window is moved as
;; well to restore it to view. (It's easier that way, that's why.
;;
;; If you set the variable vcursor-auto-disable, then any command
;; which does not involve moving or copying from the virtual cursor
-;; causes the virtual cursor to be disabled. If you don't intend to
-;; use this, you can comment out the `add-hook' line at the bottom of
-;; this file. (This feature partially emulates the way the "copy" key
-;; on the BBC micro worked; actually, the copy cursor was homed when
-;; you hit return. This was in keeping with the line-by-line way of
-;; entering BASIC, but is less appropriate here.)
+;; causes the virtual cursor to be disabled. If you set it to non-nil
+;; but not t, then the vcursor itself will remain active, but copying
+;; will be turned off, so that the next time the vcursor is moved no
+;; text is copied over. Experience shows that this setting is
+;; particularly useful. If you don't intend to use this, you can
+;; comment out the `add-hook' line at the bottom of this file. (This
+;; feature partially emulates the way the "copy" key on the BBC micro
+;; worked; actually, the copy cursor was homed when you hit return.
+;; This was in keeping with the line-by-line way of entering BASIC,
+;; but is less appropriate here.)
+;;
+;; vcursor-compare-windows is now a reliable adaption of
+;; compare-windows, which compares between point in the current buffer
+;; and the vcursor location in the other one. It is an error if
+;; vcursor is not set, however it will be brought up in another window
+;; if it is not currently visible. The prefix argument acts just like
+;; compare-windows, ignoring whitespace if set. (In versions before
+;; 1.6, this simply called compare-windows, which was much less likely
+;; to pick the two windows you wanted.)
;;
;; There is a way of moving the virtual cursor using ordinary
;; commands: C-S-f9 (vcursor-execute-key) reads a key string,
;; moves the virtual cursor back to the first non-whitespace character
;; on its line. As the command is called interactively all the usual
;; ways of passing information to the command called, such as by a
-;; prefix argument, are available. C-S-f10 (C-S-x)
-;; (vcursor-execute-command) behaves the same way but you enter the
-;; name of the command. Of course, only some commands are useful
-;; here, mainly simple movement commands. Killing at the virtual
-;; cursor position in this way works as well; you can even save
-;; another buffer with C-S-f9 C-x C-s. To do anything more
+;; prefix argument, are available. This has many uses not necessarily
+;; related to moving the vcursor itself; it can do essentially
+;; everything that the \C-x 4 series of commands can do and a lot
+;; more. Note, however, that a new window is not used if the vcursor
+;; is visible in the current one: this can lead to some strange effects,
+;; but it is preferable to making a new window every time the vcursor
+;; is moved in this may.
+;;
+;; C-S-f10 (C-S-x) (vcursor-execute-command) behaves the same way but
+;; you enter the name of the command. To do anything really
;; complicated, you are better off using M-C-S-tab
;; (vcursor-swap-point), doing whatever it is, then calling M-C-S-tab
;; again.
;; (vcursor-copy) together with (vcursor-get-char-count). If you want to
;; do something in a different window, use (vcursor-window-funcall).
;;
+;; Key bindings
+;; ============
+;;
;; There is an alternative set of key bindings which will be used
;; automatically for a PC if Oemacs is detected. This set uses separate
;; control, shift and meta keys with function keys 1 to 10. In
;; oemacs set will work on an X terminal with function keys, but the
;; xterm set will not work under Oemacs.
;;
-;; Un-features:
+;; Usage on dumb terminals
+;; =======================
+;;
+;; If Emacs has set the variable window-system to nil, vcursor will
+;; assume that overlays cannot be displayed in a different face,
+;; and will instead use an string (the variable vcursor-string, by
+;; default "**>") to show its position. This was first implemented
+;; in Emacs 19.29. Unlike the old-fashioned overlay arrow (as used
+;; by debuggers), this appears between existing text, which can
+;; make it hard to read if you're not used to it. (This seemed the
+;; better option here.) This means moving the vcursor up and down is
+;; a very efficient way of locating it!
+;;
+;; Everything else should function as expected, but there is no way to
+;; get an easy key binding for the vcursor keys on a generic terminal.
+;; Consequently a special keymap is defined for you to use traditional
+;; methods: the keymap, however, is available on any terminal type.
+;;
+;; The vcursor keymap
+;; ==================
+;;
+;; In addition to any other bindings, vcursor-map contains key definitions
+;; for handling the vcursor. You should assign this to a prefix key
+;; in the usual way, e.g.
+;; (global-set-key [f14] vcursor-map)
+;; and also as usual \C-h in this map will list the key definitions, which
+;; are designed to be easy to remember.
+;;
+;; A special feature is provided by (vcursor-toggle-vcursor-map), bound
+;; to t in that keymap. With this in effect, the main keymap
+;; is overridden by the vcursor map, so keys like \C-p and so on
+;; move the vcursor instead. Remember how to turn it off (type t),
+;; or you are in serious trouble! Note that the cursor keys are not
+;; bound by default in this keymap and will continue to move the
+;; ordinary cursor.
+;;
+;; Interpreted input
+;; =================
+;;
+;; Just occasionally, you may want to pretend the strings copied from
+;; the vcursor position are to be interpreted as if you had typed them
+;; from the keyboard. Normally, they will just insert themselves anyway,
+;; but in some modes (Info and calc for example) typing ordinary characters
+;; does something else. To get this effect, set
+;; vcursor-interpret-input to t. This is normally not a good idea as
+;; interpreting input is very much slower than copying text.
+;;
+;; Un-features
+;; ===========
+;;
;; - The vcursor will not move to point-max, since otherwise it would
;; disappear. However, no error is flagged as point-max is a valid
;; point in the buffer. Thus cursor right or down at the second
;;; Code:
-(or (memq 'vcursor (face-list))
- (progn
- (copy-face 'modeline 'vcursor)
- (if (or (fboundp 'oemacs-version) (x-display-color-p))
- (progn
- (set-face-foreground 'vcursor "blue")
- (set-face-background 'vcursor "cyan")))
- (set-face-underline-p 'vcursor t)))
-
-(defvar vcursor-auto-disable nil
- "*If non-nil, disable the virtual cursor after use.
-Any non-vcursor command will force `vcursor-disable' to be called.")
-
-(defvar vcursor-key-bindings t
- "*How to bind keys when vcursor is loaded.
-If t (the default), guess; if xterm, use bindings suitable for an
-X terminal; if oemacs, use bindings which work on a PC with Oemacs.
-If nil, don't define any key bindings.")
-
-(defvar vcursor-overlay nil
- "Overlay for the virtual cursor.
-It is nil if that is not enabled.")
-
-(defvar vcursor-window nil
- "Last window to have displayed the virtual cursor.
-See the function `vcursor-find-window' for how this is used.")
-
-(defvar vcursor-last-command nil
- "Non-nil if last command was a vcursor command.
-The commands `vcursor-copy', `vcursor-relative-move' and the ones for
-scrolling set this. It is used by the `vcursor-auto-disable' code.")
-;; could do some memq-ing with last-command instead, but this will
-;; automatically handle any new commands using the primitives.
-
-(defvar vcursor-copy-flag nil
- "*Non-nil means moving vcursor should copy characters moved over to point.")
-
-(defvar vcursor-temp-goal-column nil
- "Keeps track of temporary goal columns for the virtual cursor.")
-
-(cond
- ((not vcursor-key-bindings)) ;; don't set any key bindings
- ((or (eq vcursor-key-bindings 'oemacs)
- (and (eq vcursor-key-bindings t) (fboundp 'oemacs-version)))
- (global-set-key [C-f1] 'vcursor-toggle-copy)
- (global-set-key [C-f2] 'vcursor-copy)
- (global-set-key [C-f3] 'vcursor-copy-word)
- (global-set-key [C-f4] 'vcursor-copy-line)
-
- (global-set-key [S-f1] 'vcursor-disable)
- (global-set-key [S-f2] 'vcursor-other-window)
- (global-set-key [S-f3] 'vcursor-goto)
- (global-set-key [S-f4] 'vcursor-swap-point)
-
- (global-set-key [C-f5] 'vcursor-backward-char)
- (global-set-key [C-f6] 'vcursor-previous-line)
- (global-set-key [C-f7] 'vcursor-next-line)
- (global-set-key [C-f8] 'vcursor-forward-char)
-
- (global-set-key [M-f5] 'vcursor-beginning-of-line)
- (global-set-key [M-f6] 'vcursor-backward-word)
- (global-set-key [M-f6] 'vcursor-forward-word)
- (global-set-key [M-f8] 'vcursor-end-of-line)
+(eval-when-compile (require 'compare-w))
- (global-set-key [S-f5] 'vcursor-beginning-of-buffer)
- (global-set-key [S-f6] 'vcursor-scroll-down)
- (global-set-key [S-f7] 'vcursor-scroll-up)
- (global-set-key [S-f8] 'vcursor-end-of-buffer)
+(defgroup vcursor nil
+ "Manipulate an alternative (\"virtual\") cursor."
+ :prefix "vcursor-"
+ :group 'editing)
- (global-set-key [C-f9] 'vcursor-isearch-forward)
+(defface vcursor
+ '((((class color)) (:foreground "blue" :background "cyan" :underline t))
+ (t (:inverse-video t :underline t)))
+ "Face for the virtual cursor."
+ :group 'vcursor)
- (global-set-key [S-f9] 'vcursor-execute-key)
- (global-set-key [S-f10] 'vcursor-execute-command)
+(defcustom vcursor-auto-disable nil
+ "*If non-nil, disable the virtual cursor after use.
+Any non-vcursor command will force `vcursor-disable' to be called.
+If non-nil but not t, just make sure copying is toggled off, but don't
+disable the vcursor."
+ :type '(choice (const t) (const nil) (const copy))
+ :group 'vcursor)
+
+;; Needed for defcustom, must be up here
+(defun vcursor-cs-binding (base &optional meta)
+ (vector (let ((key (list 'control 'shift (intern base))))
+ (if meta
+ (cons 'meta key)
+ key))))
+
+(defun vcursor-bind-keys (var value)
+ "Alter the value of the variable VAR to VALUE, binding keys as required.
+VAR is usually vcursor-key-bindings. Normally this function is called
+on loading vcursor and from the customize package."
+ (set var value)
+ (cond
+ ((not value));; don't set any key bindings
+ ((or (eq value 'oemacs)
+ (and (eq value t) (fboundp 'oemacs-version)))
+ (global-set-key [C-f1] 'vcursor-toggle-copy)
+ (global-set-key [C-f2] 'vcursor-copy)
+ (global-set-key [C-f3] 'vcursor-copy-word)
+ (global-set-key [C-f4] 'vcursor-copy-line)
+
+ (global-set-key [S-f1] 'vcursor-disable)
+ (global-set-key [S-f2] 'vcursor-other-window)
+ (global-set-key [S-f3] 'vcursor-goto)
+ (global-set-key [S-f4] 'vcursor-swap-point)
+
+ (global-set-key [C-f5] 'vcursor-backward-char)
+ (global-set-key [C-f6] 'vcursor-previous-line)
+ (global-set-key [C-f7] 'vcursor-next-line)
+ (global-set-key [C-f8] 'vcursor-forward-char)
+
+ (global-set-key [M-f5] 'vcursor-beginning-of-line)
+ (global-set-key [M-f6] 'vcursor-backward-word)
+ (global-set-key [M-f6] 'vcursor-forward-word)
+ (global-set-key [M-f8] 'vcursor-end-of-line)
+
+ (global-set-key [S-f5] 'vcursor-beginning-of-buffer)
+ (global-set-key [S-f6] 'vcursor-scroll-down)
+ (global-set-key [S-f7] 'vcursor-scroll-up)
+ (global-set-key [S-f8] 'vcursor-end-of-buffer)
+
+ (global-set-key [C-f9] 'vcursor-isearch-forward)
+
+ (global-set-key [S-f9] 'vcursor-execute-key)
+ (global-set-key [S-f10] 'vcursor-execute-command)
;;; Partial dictionary of Oemacs key sequences for you to roll your own,
;;; e.g C-S-up: (global-set-key "\M-[\C-f\M-\C-m" 'vcursor-previous-line)
;;; "\M-[\C-fe" C-S-f8
;;; "\M-[\C-ff" C-S-f9
;;; "\M-[\C-fg" C-S-f10
- )
- (t
- (global-set-key [C-S-up] 'vcursor-previous-line)
- (global-set-key [C-S-down] 'vcursor-next-line)
- (global-set-key [C-S-left] 'vcursor-backward-char)
- (global-set-key [C-S-right] 'vcursor-forward-char)
+ )
+ (t
+ (global-set-key (vcursor-cs-binding "up") 'vcursor-previous-line)
+ (global-set-key (vcursor-cs-binding "down") 'vcursor-next-line)
+ (global-set-key (vcursor-cs-binding "left") 'vcursor-backward-char)
+ (global-set-key (vcursor-cs-binding "right") 'vcursor-forward-char)
- (global-set-key [C-S-return] 'vcursor-disable)
- (global-set-key [C-S-insert] 'vcursor-copy)
- (global-set-key [C-S-delete] 'vcursor-copy-word)
- (global-set-key [C-S-remove] 'vcursor-copy-word)
- (global-set-key [C-S-tab] 'vcursor-toggle-copy)
- (global-set-key [C-S-home] 'vcursor-beginning-of-buffer)
- (global-set-key [M-C-S-up] 'vcursor-beginning-of-buffer)
- (global-set-key [C-S-end] 'vcursor-end-of-buffer)
- (global-set-key [M-C-S-down] 'vcursor-end-of-buffer)
- (global-set-key [C-S-prior] 'vcursor-scroll-down)
- (global-set-key [C-S-next] 'vcursor-scroll-up)
+ (global-set-key (vcursor-cs-binding "return") 'vcursor-disable)
+ (global-set-key (vcursor-cs-binding "insert") 'vcursor-copy)
+ (global-set-key (vcursor-cs-binding "delete") 'vcursor-copy-word)
+ (global-set-key (vcursor-cs-binding "remove") 'vcursor-copy-word)
+ (global-set-key (vcursor-cs-binding "tab") 'vcursor-toggle-copy)
+ (global-set-key (vcursor-cs-binding "backtab") 'vcursor-toggle-copy)
+ (global-set-key (vcursor-cs-binding "home") 'vcursor-beginning-of-buffer)
+ (global-set-key (vcursor-cs-binding "up" t) 'vcursor-beginning-of-buffer)
+ (global-set-key (vcursor-cs-binding "end") 'vcursor-end-of-buffer)
+ (global-set-key (vcursor-cs-binding "down" t) 'vcursor-end-of-buffer)
+ (global-set-key (vcursor-cs-binding "prior") 'vcursor-scroll-down)
+ (global-set-key (vcursor-cs-binding "next") 'vcursor-scroll-up)
- (global-set-key [C-S-f6] 'vcursor-other-window)
- (global-set-key [C-S-f7] 'vcursor-goto)
+ (global-set-key (vcursor-cs-binding "f6") 'vcursor-other-window)
+ (global-set-key (vcursor-cs-binding "f7") 'vcursor-goto)
- (global-set-key [C-S-select] 'vcursor-swap-point) ; DEC keyboards
- (global-set-key [M-C-S-tab] 'vcursor-swap-point)
+ (global-set-key (vcursor-cs-binding "select")
+ 'vcursor-swap-point) ; DEC keyboards
+ (global-set-key (vcursor-cs-binding "tab" t) 'vcursor-swap-point)
- (global-set-key [C-S-find] 'vcursor-isearch-forward) ; DEC keyboards
- (global-set-key [C-S-f8] 'vcursor-isearch-forward)
+ (global-set-key (vcursor-cs-binding "find")
+ 'vcursor-isearch-forward) ; DEC keyboards
+ (global-set-key (vcursor-cs-binding "f8") 'vcursor-isearch-forward)
- (global-set-key [M-C-S-left] 'vcursor-beginning-of-line)
- (global-set-key [M-C-S-right] 'vcursor-end-of-line)
+ (global-set-key (vcursor-cs-binding "left" t) 'vcursor-beginning-of-line)
+ (global-set-key (vcursor-cs-binding "right" t) 'vcursor-end-of-line)
- (global-set-key [M-C-S-prior] 'vcursor-backward-word)
- (global-set-key [M-C-S-next] 'vcursor-forward-word)
+ (global-set-key (vcursor-cs-binding "prior" t) 'vcursor-backward-word)
+ (global-set-key (vcursor-cs-binding "next" t) 'vcursor-forward-word)
- (global-set-key [M-C-S-return] 'vcursor-copy-line)
+ (global-set-key (vcursor-cs-binding "return" t) 'vcursor-copy-line)
- (global-set-key [C-S-f9] 'vcursor-execute-key)
- (global-set-key [C-S-f10] 'vcursor-execute-command)
- ))
+ (global-set-key (vcursor-cs-binding "f9") 'vcursor-execute-key)
+ (global-set-key (vcursor-cs-binding "f10") 'vcursor-execute-command)
+ )))
+
+(defcustom vcursor-key-bindings nil
+ "*How to bind keys when vcursor is loaded.
+If t, guess; if xterm, use bindings suitable for an X terminal; if
+oemacs, use bindings which work on a PC with Oemacs. If nil, don't
+define any key bindings.
+
+Default is nil."
+ :type '(choice (const t) (const nil) (const xterm) (const oemacs))
+ :group 'vcursor
+ :set 'vcursor-bind-keys
+ :version "20.3")
+
+(defcustom vcursor-interpret-input nil
+ "*If non-nil, input from the vcursor is treated as interactive input.
+This will cause text insertion to be much slower. Note that no special
+interpretation of strings is done: \"\C-x\" is a string of four
+characters. The default is simply to copy strings."
+ :type 'boolean
+ :group 'vcursor
+ :version "20.3")
+
+(defcustom vcursor-string "**>"
+ "String used to show the vcursor position on dumb terminals."
+ :type 'string
+ :group 'vcursor
+ :version "20.3")
+
+(defvar vcursor-overlay nil
+ "Overlay for the virtual cursor.
+It is nil if that is not enabled.")
+
+(defvar vcursor-window nil
+ "Last window to have displayed the virtual cursor.
+See the function `vcursor-find-window' for how this is used.")
+
+(defvar vcursor-last-command nil
+ "Non-nil if last command was a vcursor command.
+The commands `vcursor-copy', `vcursor-relative-move' and the ones for
+scrolling set this. It is used by the `vcursor-auto-disable' code.")
+;; could do some memq-ing with last-command instead, but this will
+;; automatically handle any new commands using the primitives.
+
+(defcustom vcursor-copy-flag nil
+ "*Non-nil means moving vcursor should copy characters moved over to point."
+ :type 'boolean
+ :group 'vcursor)
+
+(defvar vcursor-temp-goal-column nil
+ "Keeps track of temporary goal columns for the virtual cursor.")
+
+(defvar vcursor-use-vcursor-map nil
+ "Non-nil if the vcursor map is mapped directly onto the main keymap.
+See vcursor-toggle-vcursor-map.")
+(make-variable-buffer-local 'vcursor-use-vcursor-map)
+
+(defvar vcursor-map nil "Keymap for vcursor command.")
+(define-prefix-command 'vcursor-map)
+
+(define-key vcursor-map "t" 'vcursor-toggle-vcursor-map)
+
+(define-key vcursor-map "\C-p" 'vcursor-previous-line)
+(define-key vcursor-map "\C-n" 'vcursor-next-line)
+(define-key vcursor-map "\C-b" 'vcursor-backward-char)
+(define-key vcursor-map "\C-f" 'vcursor-forward-char)
+
+(define-key vcursor-map "\r" 'vcursor-disable)
+(define-key vcursor-map " " 'vcursor-copy)
+(define-key vcursor-map "\C-y" 'vcursor-copy-word)
+(define-key vcursor-map "\C-i" 'vcursor-toggle-copy)
+(define-key vcursor-map "<" 'vcursor-beginning-of-buffer)
+(define-key vcursor-map ">" 'vcursor-end-of-buffer)
+(define-key vcursor-map "\M-v" 'vcursor-scroll-down)
+(define-key vcursor-map "\C-v" 'vcursor-scroll-up)
+(define-key vcursor-map "o" 'vcursor-other-window)
+(define-key vcursor-map "g" 'vcursor-goto)
+(define-key vcursor-map "x" 'vcursor-swap-point)
+(define-key vcursor-map "\C-s" 'vcursor-isearch-forward)
+(define-key vcursor-map "\C-r" 'vcursor-isearch-backward)
+(define-key vcursor-map "\C-a" 'vcursor-beginning-of-line)
+(define-key vcursor-map "\C-e" 'vcursor-end-of-line)
+(define-key vcursor-map "\M-w" 'vcursor-forward-word)
+(define-key vcursor-map "\M-b" 'vcursor-backward-word)
+(define-key vcursor-map "\M-l" 'vcursor-copy-line)
+(define-key vcursor-map "c" 'vcursor-compare-windows)
+(define-key vcursor-map "k" 'vcursor-execute-key)
+(define-key vcursor-map "\M-x" 'vcursor-execute-command)
+
+;; If vcursor-key-bindings is already set on loading, bind the keys now.
+;; This hybrid way of doing it retains compatibility while allowing
+;; customize to work smoothly.
+(if vcursor-key-bindings
+ (vcursor-bind-keys 'vcursor-key-bindings vcursor-key-bindings))
(defun vcursor-locate ()
"Go to the starting point of the virtual cursor.
(if vcursor-copy-flag "on" "off")))
)
-(defun vcursor-move (pt)
+(defun vcursor-move (pt &optional leave-b leave-w)
"Move the virtual cursor to the character to the right of PT.
-PT is an absolute location in the current buffer.
+PT is an absolute location in the current buffer. With optional
+LEAVE-B, PT is in the same buffer the vcursor is currently in.
If the new virtual cursor location would not be visible, display it in
-another window."
+another window. With LEAVE-W, use the current `vcursor-window'."
;; this works even if we're on-mass-shell, but usually we won't be.
- (if (eq pt (point-max)) (setq pt (1- pt)))
- (if (vcursor-check t)
- (move-overlay vcursor-overlay pt (+ pt 1) (current-buffer))
- (setq vcursor-overlay (make-overlay pt (+ pt 1)))
- (overlay-put vcursor-overlay 'face 'vcursor))
- (vcursor-find-window nil t)
- ;; vcursor-window now contains the right buffer
- (or (pos-visible-in-window-p pt vcursor-window)
- (set-window-point vcursor-window pt))
+ (save-excursion
+ (and leave-b (vcursor-check t)
+ (set-buffer (overlay-buffer vcursor-overlay)))
+ (if (eq pt (point-max))
+ (setq pt (1- pt)))
+ (if (vcursor-check t)
+ (move-overlay vcursor-overlay pt (+ pt 1) (current-buffer))
+ (setq vcursor-overlay (make-overlay pt (+ pt 1)))
+ (or window-system
+ (display-color-p)
+ (overlay-put vcursor-overlay 'before-string vcursor-string))
+ (overlay-put vcursor-overlay 'face 'vcursor))
+ (or leave-w (vcursor-find-window nil t))
+ ;; vcursor-window now contains the right buffer
+ (or (pos-visible-in-window-p pt vcursor-window)
+ (set-window-point vcursor-window pt)))
+ )
+
+(defun vcursor-insert (text)
+ "Insert TEXT, respecting `vcursor-interpret-input'."
+ (if vcursor-interpret-input
+ (setq unread-command-events
+ (append (listify-key-sequence text) unread-command-events))
+ (insert text))
)
(defun vcursor-relative-move (fn &rest args)
(signal 'end-of-buffer nil))
(vcursor-move (point))
(if vcursor-copy-flag (setq text (buffer-substring opoint (point)))))
- (if text (insert text)))
+ (if text (vcursor-insert text)))
(setq vcursor-last-command t)
)
(vcursor-window-funcall 'isearch-forward rep norecurs)
)
+(defun vcursor-isearch-backward (&optional rep norecurs)
+ "Perform backward incremental search in the virtual cursor window.
+The virtual cursor is moved to the resulting point; the ordinary
+cursor stays where it was."
+
+ (interactive "P")
+ (vcursor-window-funcall 'isearch-backward rep norecurs)
+ )
+
(defun vcursor-window-funcall (func &rest args)
"Call FUNC with ARGS ... in a virtual cursor window.
A window other than the currently-selected one will always be used.
The virtual cursor is moved to the value of point when the function
-returns."
-
- (vcursor-find-window t t)
- (let ((sw (selected-window)) text)
- ;; We can't use save-window-excursion because that would restore
- ;; the original display in the window we may want to alter.
- (unwind-protect
- (let ((here (point)))
- (select-window vcursor-window)
- (vcursor-locate)
- (apply func args)
- (if vcursor-copy-flag (setq text (buffer-substring here (point))))
- (vcursor-move (point)))
- (select-window sw))
- (if text (insert text)))
+returns.
+
+If FUNC is a list, call the car of the list interactively, ignoring
+ARGS. In this case, a new window will not be created if the vcursor
+is visible in the current one."
+;; that's to avoid messing up compatibility with old versions
+;; by introducing a new argument, which would have to come before ARGS.
+
+ (vcursor-find-window (not (and (listp func) (vcursor-check t))) t)
+ (save-excursion
+ (let ((sw (selected-window)) text)
+ ;; We can't use save-window-excursion because that would restore
+ ;; the original display in the window we may want to alter.
+ (unwind-protect
+ (let ((here (point)))
+ (select-window vcursor-window)
+ (vcursor-locate)
+ (if (listp func)
+ (call-interactively (car func))
+ (apply func args))
+ (setq vcursor-window (selected-window))
+ (and vcursor-copy-flag
+ (eq (current-buffer) (overlay-buffer vcursor-overlay))
+ (setq text (buffer-substring here (point))))
+ ;; vcursor-window and the current buffer are definitely
+ ;; right, so make sure vcursor-move doesn't pick others.
+ (vcursor-move (point) nil t))
+ (select-window sw))
+ (if text (vcursor-insert text))))
(setq vcursor-last-command t)
)
((not (vcursor-find-window t)))
((or (not arg) (< (prefix-numeric-value arg) 0)))
((delete-window vcursor-window)))
- (and arg (< (prefix-numeric-value arg) 0)
- (progn
- (vcursor-move (point))
- (setq vcursor-window (selected-window))))
+ (cond
+ ((and arg (< (prefix-numeric-value arg) 0))
+ (vcursor-move (point))
+ (setq vcursor-window (selected-window)))
+ (vcursor-use-vcursor-map (vcursor-toggle-vcursor-map 0)))
(setq vcursor-copy-flag nil)
)
(vcursor-disable -1))))
)
-(defun vcursor-compare-windows (&optional arg)
- "Call `compare-windows' in the vcursor window.
-This has the effect of comparing the vcursor window with whichever
-window `next-window' returns there, which may not be the selected one.
-
-A prefix argument, if any, is passed to `compare-windows'."
+;; vcursor-compare-windows is copied from compare-w.el with only
+;; minor modifications; these are too bound up with the function
+;; to make it really useful to call compare-windows itself.
+(defun vcursor-compare-windows (&optional ignore-whitespace)
+ "Compare text in current window with text in window with vcursor.
+Compares the text starting at point in the current window and at the
+vcursor position in the other window, moving over text in each one as
+far as they match.
+
+A prefix argument, if any, means ignore changes in whitespace.
+The variable `compare-windows-whitespace' controls how whitespace is skipped.
+If `compare-ignore-case' is non-nil, changes in case are also ignored."
(interactive "P")
- (vcursor-window-funcall 'compare-windows arg))
+ ;; (vcursor-window-funcall 'compare-windows arg)
+ (require 'compare-w)
+ (let* (p1 p2 maxp1 maxp2 b1 b2 w2
+ success size
+ (opoint1 (point))
+ opoint2
+ (skip-whitespace (if ignore-whitespace
+ compare-windows-whitespace)))
+ (setq p1 (point) b1 (current-buffer))
+ (setq w2 (vcursor-find-window t t))
+ (if (or (eq w2 (selected-window)) (not w2))
+ (error "No other window with vcursor"))
+ (save-excursion
+ (vcursor-locate)
+ (setq p2 (point) b2 (current-buffer)))
+ (setq opoint2 p2)
+ (setq maxp1 (point-max))
+ (save-excursion
+ (set-buffer b2)
+ (setq maxp2 (point-max)))
+
+ (setq success t)
+ (while success
+ (setq success nil)
+ ;; if interrupted, show how far we've gotten
+ (goto-char p1)
+ (vcursor-move p2 t)
+
+ ;; If both buffers have whitespace next to point,
+ ;; optionally skip over it.
+
+ (and skip-whitespace
+ (save-excursion
+ (let (p1a p2a w1 w2 result1 result2)
+ (setq result1
+ (if (stringp skip-whitespace)
+ (compare-windows-skip-whitespace opoint1)
+ (funcall skip-whitespace opoint1)))
+ (setq p1a (point))
+ (set-buffer b2)
+ (goto-char p2)
+ (setq result2
+ (if (stringp skip-whitespace)
+ (compare-windows-skip-whitespace opoint2)
+ (funcall skip-whitespace opoint2)))
+ (setq p2a (point))
+ (if (or (stringp skip-whitespace)
+ (and result1 result2 (eq result1 result2)))
+ (setq p1 p1a
+ p2 p2a)))))
+
+ ;; Try advancing comparing 1000 chars at a time.
+ ;; When that fails, go 500 chars at a time, and so on.
+ (let ((size 1000)
+ success-1
+ (case-fold-search compare-ignore-case))
+ (while (> size 0)
+ (setq success-1 t)
+ ;; Try comparing SIZE chars at a time, repeatedly, till that fails.
+ (while success-1
+ (setq size (min size (- maxp1 p1) (- maxp2 p2)))
+ (setq success-1
+ (and (> size 0)
+ (= 0 (compare-buffer-substrings b2 p2 (+ size p2)
+ b1 p1 (+ size p1)))))
+ (if success-1
+ (setq p1 (+ p1 size) p2 (+ p2 size)
+ success t)))
+ ;; If SIZE chars don't match, try fewer.
+ (setq size (/ size 2)))))
+
+ (goto-char p1)
+ (vcursor-move p2 t)
+ (if (= (point) opoint1)
+ (ding)))
+)
(defun vcursor-next-line (arg)
"Move the virtual cursor forward ARG lines."
(vcursor-move (point))
(setq vcursor-temp-goal-column temporary-goal-column
vcursor-last-command t))
- (if text (insert text)))
+ (if text (vcursor-insert text)))
)
(defun vcursor-previous-line (arg)
COMMAND is called interactively. Not all commands (in fact, only a
small subset) are useful."
(interactive "CCommand: ")
- (let (text opoint)
- (save-excursion
- (vcursor-locate)
- (setq opoint (point))
- (call-interactively cmd)
- (if vcursor-copy-flag (setq text (buffer-substring opoint (point))))
- (vcursor-move (point)))
- (if text (insert text)))
- (setq vcursor-last-command t)
+ (vcursor-window-funcall (list cmd))
)
-(defun vcursor-execute-key (keys)
- "Execute the command bound to KEYS for the virtual cursor.
-The command found is called interactively, so prefix argument etc.
-are usable."
-
- (interactive "kKey sequence: ")
- (let ((cmd (key-binding keys)))
- (if cmd (vcursor-execute-command (key-binding keys))))
+(defun vcursor-execute-key ()
+ "Read a key sequence and execute the bound command for the virtual cursor.
+The key sequence is read at the vcursor location. The command found
+is called interactively, so prefix argument etc. are usable."
+ (interactive)
+ (let (cmd)
+ (save-excursion
+ ;; We'd like to avoid the display changing when we locate
+ ;; to the vcursor position and read a key sequence.
+ (vcursor-find-window (not (vcursor-check t)) t)
+ (save-window-excursion
+ (select-window vcursor-window)
+ (vcursor-locate)
+ (setq cmd (key-binding (read-key-sequence "Key sequence: ")))))
+ (vcursor-window-funcall (list cmd)))
)
(defun vcursor-copy (arg)
"Copy ARG characters from the virtual cursor position to point."
(interactive "p")
(vcursor-check)
- (insert
+ (vcursor-insert
(save-excursion
(set-buffer (overlay-buffer vcursor-overlay))
(let* ((ostart (overlay-start vcursor-overlay))
(vcursor-copy (if (or (= count 0) arg) (1+ count) count)))
)
+(defun vcursor-toggle-vcursor-map (&optional force noredisp)
+ "Toggle the state of the vcursor key map.
+When on, the keys defined in it are mapped directly on top of the main
+keymap, allowing you to move the vcursor with ordinary motion keys.
+An indication \"!VC\" appears in the mode list. The effect is
+local to the current buffer.
+With prefix FORCE, turn on, or off if it is 0.
+With NOREDISP, don't force redisplay.
+Disabling the vcursor automatically turns this off."
+ (interactive "P")
+ (let ((new (cond ((not force) (not vcursor-use-vcursor-map))
+ ((eq force 0) nil)
+ (t))))
+ (or (eq new vcursor-use-vcursor-map)
+ (progn
+ (setq vcursor-use-vcursor-map new)
+ (or (assq 'vcursor-use-vcursor-map minor-mode-map-alist)
+ (setq minor-mode-map-alist
+ (cons (cons 'vcursor-use-vcursor-map vcursor-map)
+ minor-mode-map-alist)))
+ (or (assq 'vcursor-use-vcursor-map minor-mode-alist)
+ (setq minor-mode-alist
+ (cons (list 'vcursor-use-vcursor-map " !VC")
+ minor-mode-alist)))
+ (or noredisp (redraw-display)))))
+ )
+
(defun vcursor-post-command ()
(and vcursor-auto-disable (not vcursor-last-command)
- vcursor-overlay (vcursor-disable))
+ vcursor-overlay
+ (if (eq vcursor-auto-disable t)
+ (vcursor-disable)
+ (vcursor-toggle-copy -1 t)))
(setq vcursor-last-command nil)
)