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