diff options
| author | Karl Heuer | 1995-02-20 23:15:10 +0000 |
|---|---|---|
| committer | Karl Heuer | 1995-02-20 23:15:10 +0000 |
| commit | 6c2e12f452e42380f7126ba3e2d58a9a8a9614e7 (patch) | |
| tree | 1ac3d8324d28f236dc8d6ad4538da4004169d4d5 | |
| parent | fa2b2917332cc15fc559aa07e449f7fa257aceb5 (diff) | |
| download | emacs-6c2e12f452e42380f7126ba3e2d58a9a8a9614e7.tar.gz emacs-6c2e12f452e42380f7126ba3e2d58a9a8a9614e7.zip | |
Initial revision
| -rw-r--r-- | lisp/emulation/viper-ex.el | 1888 | ||||
| -rw-r--r-- | lisp/emulation/viper-keym.el | 525 | ||||
| -rw-r--r-- | lisp/emulation/viper-macs.el | 902 | ||||
| -rw-r--r-- | lisp/emulation/viper-mous.el | 457 | ||||
| -rw-r--r-- | lisp/emulation/viper-util.el | 798 | ||||
| -rw-r--r-- | lisp/emulation/viper.el | 5486 |
6 files changed, 10056 insertions, 0 deletions
diff --git a/lisp/emulation/viper-ex.el b/lisp/emulation/viper-ex.el new file mode 100644 index 00000000000..3cd5c9f3986 --- /dev/null +++ b/lisp/emulation/viper-ex.el | |||
| @@ -0,0 +1,1888 @@ | |||
| 1 | ;;; viper-ex.el -- functions implementing the Ex commands for Viper | ||
| 2 | |||
| 3 | ;; This file is part of GNU Emacs. | ||
| 4 | |||
| 5 | ;; GNU Emacs is free software; you can redistribute it and/or modify | ||
| 6 | ;; it under the terms of the GNU General Public License as published by | ||
| 7 | ;; the Free Software Foundation; either version 2, or (at your option) | ||
| 8 | ;; any later version. | ||
| 9 | |||
| 10 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 11 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 12 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 13 | ;; GNU General Public License for more details. | ||
| 14 | |||
| 15 | ;; You should have received a copy of the GNU General Public License | ||
| 16 | ;; along with GNU Emacs; see the file COPYING. If not, write to | ||
| 17 | ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | ||
| 18 | |||
| 19 | |||
| 20 | (require 'viper-util) | ||
| 21 | |||
| 22 | ;;; Variables | ||
| 23 | |||
| 24 | (defconst vip-ex-work-buf-name " *ex-working-space*") | ||
| 25 | (defconst vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) | ||
| 26 | |||
| 27 | |||
| 28 | ;;; Completion in :set command | ||
| 29 | |||
| 30 | ;; The list of Ex commands. Used for completing command names. | ||
| 31 | (defconst ex-token-alist | ||
| 32 | '(("!") ("=") (">") ("&") ("~") | ||
| 33 | ("yank") ("xit") ("WWrite") ("Write") ("write") ("wq") ("visual") | ||
| 34 | ("version") ("vglobal") ("unmap") ("undo") ("tag") ("transfer") ("suspend") | ||
| 35 | ("substitute") ("submitReport") ("stop") ("sr") ("source") ("shell") | ||
| 36 | ("set") ("rewind") ("recover") ("read") ("quit") ("pwd") | ||
| 37 | ("put") ("preserve") ("PreviousRelatedFile") ("RelatedFile") | ||
| 38 | ("next") ("Next") ("move") ("mark") ("map") ("kmark") ("join") | ||
| 39 | ("help") ("goto") ("global") ("file") ("edit") ("delete") ("copy") | ||
| 40 | ("chdir") ("cd") ("Buffer") ("buffer") ("args")) ) | ||
| 41 | |||
| 42 | ;; A-list of Ex variables that can be set using the :set command. | ||
| 43 | (defconst ex-variable-alist | ||
| 44 | '(("wrapscan") ("ws") ("wrapmargin") ("wm") | ||
| 45 | ("tab-stop-local") ("tsl") ("tabstop") ("ts") | ||
| 46 | ("showmatch") ("sm") ("shiftwidth") ("sw") ("shell") ("sh") | ||
| 47 | ("readonly") ("ro") | ||
| 48 | ("nowrapscan") ("nows") ("noshowmatch") ("nosm") | ||
| 49 | ("noreadonly") ("noro") ("nomagic") ("noma") | ||
| 50 | ("noignorecase") ("noic") ("noautoindent") ("noai") | ||
| 51 | ("magic") ("ma") ("ignorecase") ("ic") ("autoindent") ("ai") | ||
| 52 | )) | ||
| 53 | |||
| 54 | |||
| 55 | |||
| 56 | ;; Token recognized during parsing of Ex commands (e.g., "read", "comma") | ||
| 57 | (defvar ex-token nil) | ||
| 58 | |||
| 59 | ;; Type of token. | ||
| 60 | ;; If non-nil, gives type of address; if nil, it is a command. | ||
| 61 | (defvar ex-token-type nil) | ||
| 62 | |||
| 63 | ;; List of addresses passed to Ex command | ||
| 64 | (defvar ex-addresses nil) | ||
| 65 | |||
| 66 | ;; It seems that this flag is used only for `#', `print', and `list', which | ||
| 67 | ;; aren't implemented. Check later. | ||
| 68 | (defvar ex-flag nil) | ||
| 69 | |||
| 70 | ;; "buffer" where Ex commands keep deleted data. | ||
| 71 | ;; In Emacs terms, this is a register. | ||
| 72 | (defvar ex-buffer nil) | ||
| 73 | |||
| 74 | ;; Value of ex count. | ||
| 75 | (defvar ex-count nil) | ||
| 76 | |||
| 77 | ;; Flag for global command. | ||
| 78 | (defvar ex-g-flag nil) | ||
| 79 | |||
| 80 | ;; If t, global command is executed on lines not matching ex-g-pat. | ||
| 81 | (defvar ex-g-variant nil) | ||
| 82 | |||
| 83 | ;; Save reg-exp used in substitute. | ||
| 84 | (defvar ex-reg-exp nil) | ||
| 85 | |||
| 86 | |||
| 87 | ;; Replace pattern for substitute. | ||
| 88 | (defvar ex-repl nil) | ||
| 89 | |||
| 90 | ;; Pattern for global command. | ||
| 91 | (defvar ex-g-pat nil) | ||
| 92 | |||
| 93 | ;; `sh' doesn't seem to expand wildcards, like `*' | ||
| 94 | (defconst ex-find-file-shell "csh" | ||
| 95 | "Shell in which to interpret wildcards.") | ||
| 96 | (defvar ex-find-file-shell-options "-f" | ||
| 97 | "*Options to pass to `ex-find-file-shell'.") | ||
| 98 | |||
| 99 | ;; Remembers the previous Ex tag. | ||
| 100 | (defvar ex-tag nil) | ||
| 101 | |||
| 102 | ;; file used by Ex commands like :r, :w, :n | ||
| 103 | (defvar ex-file nil) | ||
| 104 | |||
| 105 | ;; If t, tells Ex that this is a variant-command, i.e., w>>, r!, etc. | ||
| 106 | (defvar ex-variant nil) | ||
| 107 | |||
| 108 | ;; Specified the offset of an Ex command, such as :read. | ||
| 109 | (defvar ex-offset nil) | ||
| 110 | |||
| 111 | ;; Tells Ex that this is a w>> command. | ||
| 112 | (defvar ex-append nil) | ||
| 113 | |||
| 114 | ;; File containing the shell command to be executed at Ex prompt, | ||
| 115 | ;; e.g., :r !date | ||
| 116 | (defvar ex-cmdfile nil) | ||
| 117 | |||
| 118 | ;; flag used in vip-ex-read-file-name to indicate that we may be reading | ||
| 119 | ;; multiple file names. Used for :edit and :next | ||
| 120 | (defvar vip-keep-reading-filename nil) | ||
| 121 | |||
| 122 | (defconst ex-cycle-other-window t | ||
| 123 | "*If t, :n and :b cycles through files and buffers in other window. | ||
| 124 | Then :N and :B cycles in the current window. If nil, this behavior is | ||
| 125 | reversed.") | ||
| 126 | |||
| 127 | (defconst ex-cycle-through-non-files nil | ||
| 128 | "*Cycle through *scratch* and other buffers that don't visit any file.") | ||
| 129 | |||
| 130 | ;; Last shell command executed with :! command. | ||
| 131 | (defvar vip-ex-last-shell-com nil) | ||
| 132 | |||
| 133 | ;; Indicates if Minibuffer was exited temporarily in Ex-command. | ||
| 134 | (defvar vip-incomplete-ex-cmd nil) | ||
| 135 | |||
| 136 | ;; Remembers the last ex-command prompt. | ||
| 137 | (defvar vip-last-ex-prompt "") | ||
| 138 | |||
| 139 | |||
| 140 | ;;; Code | ||
| 141 | |||
| 142 | (defun vip-check-sub (str) | ||
| 143 | "Check if ex-token is an initial segment of STR." | ||
| 144 | (let ((length (length ex-token))) | ||
| 145 | (if (and (<= length (length str)) | ||
| 146 | (string= ex-token (substring str 0 length))) | ||
| 147 | (setq ex-token str) | ||
| 148 | (setq ex-token-type 'non-command)))) | ||
| 149 | |||
| 150 | (defun vip-get-ex-com-subr () | ||
| 151 | "Get a complete ex command." | ||
| 152 | (let (case-fold-search) | ||
| 153 | (set-mark (point)) | ||
| 154 | (re-search-forward "[a-zA-Z][a-zA-Z]*") | ||
| 155 | (setq ex-token-type 'command) | ||
| 156 | (setq ex-token (buffer-substring (point) (mark t))) | ||
| 157 | (exchange-point-and-mark) | ||
| 158 | (cond ((looking-at "a") | ||
| 159 | (cond ((looking-at "ab") (vip-check-sub "abbreviate")) | ||
| 160 | ((looking-at "ar") (vip-check-sub "args")) | ||
| 161 | (t (vip-check-sub "append")))) | ||
| 162 | ((looking-at "h") (vip-check-sub "help")) | ||
| 163 | ((looking-at "c") | ||
| 164 | (cond ((looking-at "cd") (vip-check-sub "cd")) | ||
| 165 | ((looking-at "ch") (vip-check-sub "chdir")) | ||
| 166 | ((looking-at "co") (vip-check-sub "copy")) | ||
| 167 | (t (vip-check-sub "change")))) | ||
| 168 | ((looking-at "d") (vip-check-sub "delete")) | ||
| 169 | ((looking-at "b") (vip-check-sub "buffer")) | ||
| 170 | ((looking-at "B") (vip-check-sub "Buffer")) | ||
| 171 | ((looking-at "e") | ||
| 172 | (if (looking-at "ex") (vip-check-sub "ex") | ||
| 173 | (vip-check-sub "edit"))) | ||
| 174 | ((looking-at "f") (vip-check-sub "file")) | ||
| 175 | ((looking-at "g") (vip-check-sub "global")) | ||
| 176 | ((looking-at "i") (vip-check-sub "insert")) | ||
| 177 | ((looking-at "j") (vip-check-sub "join")) | ||
| 178 | ((looking-at "l") (vip-check-sub "list")) | ||
| 179 | ((looking-at "m") | ||
| 180 | (cond ((looking-at "map") (vip-check-sub "map")) | ||
| 181 | ((looking-at "mar") (vip-check-sub "mark")) | ||
| 182 | (t (vip-check-sub "move")))) | ||
| 183 | ((looking-at "k[a-z][^a-z]") | ||
| 184 | (setq ex-token "kmark") | ||
| 185 | (forward-char 1) | ||
| 186 | (exchange-point-and-mark)) ;; this is canceled out by another | ||
| 187 | ;; exchange-point-and-mark at the end | ||
| 188 | ((looking-at "k") (vip-check-sub "kmark")) | ||
| 189 | ((looking-at "n") (if (looking-at "nu") | ||
| 190 | (vip-check-sub "number") | ||
| 191 | (vip-check-sub "next"))) | ||
| 192 | ((looking-at "N") (vip-check-sub "Next")) | ||
| 193 | ((looking-at "o") (vip-check-sub "open")) | ||
| 194 | ((looking-at "p") | ||
| 195 | (cond ((looking-at "pre") (vip-check-sub "preserve")) | ||
| 196 | ((looking-at "pu") (vip-check-sub "put")) | ||
| 197 | ((looking-at "pw") (vip-check-sub "pwd")) | ||
| 198 | (t (vip-check-sub "print")))) | ||
| 199 | ((looking-at "P") (vip-check-sub "PreviousRelatedFile")) | ||
| 200 | ((looking-at "R") (vip-check-sub "RelatedFile")) | ||
| 201 | ((looking-at "q") (vip-check-sub "quit")) | ||
| 202 | ((looking-at "r") | ||
| 203 | (cond ((looking-at "rec") (vip-check-sub "recover")) | ||
| 204 | ((looking-at "rew") (vip-check-sub "rewind")) | ||
| 205 | (t (vip-check-sub "read")))) | ||
| 206 | ((looking-at "s") | ||
| 207 | (cond ((looking-at "se") (vip-check-sub "set")) | ||
| 208 | ((looking-at "sh") (vip-check-sub "shell")) | ||
| 209 | ((looking-at "so") (vip-check-sub "source")) | ||
| 210 | ((looking-at "sr") (vip-check-sub "sr")) | ||
| 211 | ((looking-at "st") (vip-check-sub "stop")) | ||
| 212 | ((looking-at "sus") (vip-check-sub "suspend")) | ||
| 213 | ((looking-at "subm") (vip-check-sub "submitReport")) | ||
| 214 | (t (vip-check-sub "substitute")))) | ||
| 215 | ((looking-at "t") | ||
| 216 | (if (looking-at "ta") (vip-check-sub "tag") | ||
| 217 | (vip-check-sub "transfer"))) | ||
| 218 | ((looking-at "u") | ||
| 219 | (cond ((looking-at "una") (vip-check-sub "unabbreviate")) | ||
| 220 | ((looking-at "unm") (vip-check-sub "unmap")) | ||
| 221 | (t (vip-check-sub "undo")))) | ||
| 222 | ((looking-at "v") | ||
| 223 | (cond ((looking-at "ve") (vip-check-sub "version")) | ||
| 224 | ((looking-at "vi") (vip-check-sub "visual")) | ||
| 225 | (t (vip-check-sub "vglobal")))) | ||
| 226 | ((looking-at "w") | ||
| 227 | (if (looking-at "wq") (vip-check-sub "wq") | ||
| 228 | (vip-check-sub "write"))) | ||
| 229 | ((looking-at "W") | ||
| 230 | (if (looking-at "WW") | ||
| 231 | (vip-check-sub "WWrite") | ||
| 232 | (vip-check-sub "Write"))) | ||
| 233 | ((looking-at "x") (vip-check-sub "xit")) | ||
| 234 | ((looking-at "y") (vip-check-sub "yank")) | ||
| 235 | ((looking-at "z") (vip-check-sub "z"))) | ||
| 236 | (exchange-point-and-mark) | ||
| 237 | )) | ||
| 238 | |||
| 239 | (defun vip-get-ex-token () | ||
| 240 | "Get an ex-token which is either an address or a command. | ||
| 241 | A token has a type, \(command, address, end-mark\), and a value." | ||
| 242 | (save-window-excursion | ||
| 243 | (set-buffer vip-ex-work-buf) | ||
| 244 | (skip-chars-forward " \t|") | ||
| 245 | (cond ((looking-at "#") | ||
| 246 | (setq ex-token-type 'command) | ||
| 247 | (setq ex-token (char-to-string (following-char))) | ||
| 248 | (forward-char 1)) | ||
| 249 | ((looking-at "[a-z]") (vip-get-ex-com-subr)) | ||
| 250 | ((looking-at "\\.") | ||
| 251 | (forward-char 1) | ||
| 252 | (setq ex-token-type 'dot)) | ||
| 253 | ((looking-at "[0-9]") | ||
| 254 | (set-mark (point)) | ||
| 255 | (re-search-forward "[0-9]*") | ||
| 256 | (setq ex-token-type | ||
| 257 | (cond ((eq ex-token-type 'plus) 'add-number) | ||
| 258 | ((eq ex-token-type 'minus) 'sub-number) | ||
| 259 | (t 'abs-number))) | ||
| 260 | (setq ex-token (string-to-int (buffer-substring (point) (mark t))))) | ||
| 261 | ((looking-at "\\$") | ||
| 262 | (forward-char 1) | ||
| 263 | (setq ex-token-type 'end)) | ||
| 264 | ((looking-at "%") | ||
| 265 | (forward-char 1) | ||
| 266 | (setq ex-token-type 'whole)) | ||
| 267 | ((looking-at "+") | ||
| 268 | (cond ((or (looking-at "+[-+]") (looking-at "+[\n|]")) | ||
| 269 | (forward-char 1) | ||
| 270 | (insert "1") | ||
| 271 | (backward-char 1) | ||
| 272 | (setq ex-token-type 'plus)) | ||
| 273 | ((looking-at "+[0-9]") | ||
| 274 | (forward-char 1) | ||
| 275 | (setq ex-token-type 'plus)) | ||
| 276 | (t | ||
| 277 | (error vip-BadAddress)))) | ||
| 278 | ((looking-at "-") | ||
| 279 | (cond ((or (looking-at "-[-+]") (looking-at "-[\n|]")) | ||
| 280 | (forward-char 1) | ||
| 281 | (insert "1") | ||
| 282 | (backward-char 1) | ||
| 283 | (setq ex-token-type 'minus)) | ||
| 284 | ((looking-at "-[0-9]") | ||
| 285 | (forward-char 1) | ||
| 286 | (setq ex-token-type 'minus)) | ||
| 287 | (t | ||
| 288 | (error vip-BadAddress)))) | ||
| 289 | ((looking-at "/") | ||
| 290 | (forward-char 1) | ||
| 291 | (set-mark (point)) | ||
| 292 | (let ((cont t)) | ||
| 293 | (while (and (not (eolp)) cont) | ||
| 294 | ;;(re-search-forward "[^/]*/") | ||
| 295 | (re-search-forward "[^/]*\\(/\\|\n\\)") | ||
| 296 | (if (not (vip-looking-back "[^\\\\]\\(\\\\\\\\\\)*\\\\/")) | ||
| 297 | (setq cont nil)))) | ||
| 298 | (backward-char 1) | ||
| 299 | (setq ex-token (buffer-substring (point) (mark t))) | ||
| 300 | (if (looking-at "/") (forward-char 1)) | ||
| 301 | (setq ex-token-type 'search-forward)) | ||
| 302 | ((looking-at "\\?") | ||
| 303 | (forward-char 1) | ||
| 304 | (set-mark (point)) | ||
| 305 | (let ((cont t)) | ||
| 306 | (while (and (not (eolp)) cont) | ||
| 307 | ;;(re-search-forward "[^\\?]*\\?") | ||
| 308 | (re-search-forward "[^\\?]*\\(\\?\\|\n\\)") | ||
| 309 | (if (not (vip-looking-back "[^\\\\]\\(\\\\\\\\\\)*\\\\\\?")) | ||
| 310 | (setq cont nil)) | ||
| 311 | (backward-char 1) | ||
| 312 | (if (not (looking-at "\n")) (forward-char 1)))) | ||
| 313 | (setq ex-token-type 'search-backward) | ||
| 314 | (setq ex-token (buffer-substring (1- (point)) (mark t)))) | ||
| 315 | ((looking-at ",") | ||
| 316 | (forward-char 1) | ||
| 317 | (setq ex-token-type 'comma)) | ||
| 318 | ((looking-at ";") | ||
| 319 | (forward-char 1) | ||
| 320 | (setq ex-token-type 'semi-colon)) | ||
| 321 | ((looking-at "[!=><&~]") | ||
| 322 | (setq ex-token-type 'command) | ||
| 323 | (setq ex-token (char-to-string (following-char))) | ||
| 324 | (forward-char 1)) | ||
| 325 | ((looking-at "'") | ||
| 326 | (setq ex-token-type 'goto-mark) | ||
| 327 | (forward-char 1) | ||
| 328 | (cond ((looking-at "'") (setq ex-token nil)) | ||
| 329 | ((looking-at "[a-z]") (setq ex-token (following-char))) | ||
| 330 | (t (error "Marks are ' and a-z"))) | ||
| 331 | (forward-char 1)) | ||
| 332 | ((looking-at "\n") | ||
| 333 | (setq ex-token-type 'end-mark) | ||
| 334 | (setq ex-token "goto")) | ||
| 335 | (t | ||
| 336 | (error vip-BadExCommand))))) | ||
| 337 | |||
| 338 | ;; Reads Ex command. Tries to determine if it has to exit because command | ||
| 339 | ;; is complete or invalid. If not, keeps reading command. | ||
| 340 | (defun ex-cmd-read-exit () | ||
| 341 | (interactive) | ||
| 342 | (setq vip-incomplete-ex-cmd t) | ||
| 343 | (let ((quit-regex1 (concat | ||
| 344 | "\\(" | ||
| 345 | "set[ \t]*" "\\|" "edit[ \t]*" "\\|" "[nN]ext[ \t]*" | ||
| 346 | "\\|" "unm[ \t]*" "\\|" "^[ \t]*rep" | ||
| 347 | "\\)")) | ||
| 348 | (quit-regex2 (concat | ||
| 349 | "[a-zA-Z][ \t]*" | ||
| 350 | "\\(" "!" "\\|" ">>" | ||
| 351 | "\\|" "\\+[0-9]+" | ||
| 352 | "\\)" | ||
| 353 | "*[ \t]*$")) | ||
| 354 | (stay-regex (concat | ||
| 355 | "\\(" | ||
| 356 | "^[ \t]*$" "\\|" "[ktgjmsz][ \t]*$" "\\|" "^[ \t]*ab.*" | ||
| 357 | "\\|" "tr[ansfer \t]*" "\\|" "sr[ \t]*" | ||
| 358 | "\\|" "mo.*" "\\|" "^[ \t]*k?ma[^p]*" | ||
| 359 | "\\|" "^[ \t]*fi.*" "\\|" "v?gl.*" "\\|" "[vg][ \t]*$" | ||
| 360 | "\\|" "jo.*" "\\|" "^[ \t]*ta.*" "\\|" "^[ \t]*una.*" | ||
| 361 | "\\|" "^[ \t]*su.*" "\\|['`][a-z][ \t]*" | ||
| 362 | "\\|" "![ \t]*[a-zA-Z].*" | ||
| 363 | "\\)" | ||
| 364 | "!*"))) | ||
| 365 | |||
| 366 | (save-window-excursion ;; put cursor at the end of the Ex working buffer | ||
| 367 | (set-buffer vip-ex-work-buf) | ||
| 368 | (goto-char (point-max))) | ||
| 369 | (cond ((vip-looking-back quit-regex1) (exit-minibuffer)) | ||
| 370 | ((vip-looking-back stay-regex) (insert " ")) | ||
| 371 | ((vip-looking-back quit-regex2) (exit-minibuffer)) | ||
| 372 | (t (insert " "))))) | ||
| 373 | |||
| 374 | ;; complete Ex command | ||
| 375 | (defun ex-cmd-complete () | ||
| 376 | (interactive) | ||
| 377 | (let (save-pos dist compl-list string-to-complete completion-result) | ||
| 378 | |||
| 379 | (save-excursion | ||
| 380 | (setq dist (skip-chars-backward "[a-zA-Z!=>&~]") | ||
| 381 | save-pos (point))) | ||
| 382 | |||
| 383 | (if (or (= dist 0) | ||
| 384 | (vip-looking-back "\\([ \t]*['`][ \t]*[a-z]*\\)") | ||
| 385 | (vip-looking-back | ||
| 386 | "^[ \t]*[a-zA-Z!=>&~][ \t]*[/?]*+[ \t]+[a-zA-Z!=>&~]+")) | ||
| 387 | ;; Preceding characters are not the ones allowed in an Ex command | ||
| 388 | ;; or we have typed past command name. | ||
| 389 | ;; Note: we didn't do parsing, so there may be surprises. | ||
| 390 | (if (or (vip-looking-back "[a-zA-Z!=>&~][ \t]*[/?]*[ \t]*") | ||
| 391 | (vip-looking-back "\\([ \t]*['`][ \t]*[a-z]*\\)") | ||
| 392 | (looking-at "[^ \t\n\C-m]")) | ||
| 393 | nil | ||
| 394 | (with-output-to-temp-buffer "*Completions*" | ||
| 395 | (display-completion-list | ||
| 396 | (vip-alist-to-list ex-token-alist)))) | ||
| 397 | ;; Preceding chars may be part of a command name | ||
| 398 | (setq string-to-complete (buffer-substring save-pos (point))) | ||
| 399 | (setq completion-result | ||
| 400 | (try-completion string-to-complete ex-token-alist)) | ||
| 401 | |||
| 402 | (cond ((eq completion-result t) ;; exact match--do nothing | ||
| 403 | (vip-tmp-insert-at-eob " (Sole completion)")) | ||
| 404 | ((eq completion-result nil) | ||
| 405 | (vip-tmp-insert-at-eob " (No match)")) | ||
| 406 | (t ;; partial completion | ||
| 407 | (goto-char save-pos) | ||
| 408 | (delete-region (point) (point-max)) | ||
| 409 | (insert completion-result) | ||
| 410 | (let (case-fold-search) | ||
| 411 | (setq compl-list | ||
| 412 | (vip-filter-alist (concat "^" completion-result) | ||
| 413 | ex-token-alist))) | ||
| 414 | (if (> (length compl-list) 1) | ||
| 415 | (with-output-to-temp-buffer "*Completions*" | ||
| 416 | (display-completion-list | ||
| 417 | (vip-alist-to-list (reverse compl-list))))))) | ||
| 418 | ))) | ||
| 419 | |||
| 420 | (defun vip-ex (&optional string) | ||
| 421 | "Ex commands within Viper." | ||
| 422 | (interactive) | ||
| 423 | (or string | ||
| 424 | (setq ex-g-flag nil | ||
| 425 | ex-g-variant nil)) | ||
| 426 | (let* ((map (copy-keymap minibuffer-local-map)) | ||
| 427 | (address nil) | ||
| 428 | (cont t) | ||
| 429 | (dot (point)) | ||
| 430 | com-str) | ||
| 431 | |||
| 432 | (vip-add-keymap vip-ex-cmd-map map) | ||
| 433 | |||
| 434 | (setq com-str (or string (vip-read-string-with-history | ||
| 435 | ":" | ||
| 436 | nil | ||
| 437 | 'vip-ex-history | ||
| 438 | (car vip-ex-history) | ||
| 439 | map))) | ||
| 440 | (save-window-excursion | ||
| 441 | ;; just a precaution | ||
| 442 | (or (vip-buffer-live-p vip-ex-work-buf) | ||
| 443 | (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name))) | ||
| 444 | (set-buffer vip-ex-work-buf) | ||
| 445 | (delete-region (point-min) (point-max)) | ||
| 446 | (insert com-str "\n") | ||
| 447 | (goto-char (point-min))) | ||
| 448 | (setq ex-token-type nil | ||
| 449 | ex-addresses nil) | ||
| 450 | (while cont | ||
| 451 | (vip-get-ex-token) | ||
| 452 | (cond ((memq ex-token-type '(command end-mark)) | ||
| 453 | (if address (setq ex-addresses (cons address ex-addresses))) | ||
| 454 | (cond ((string= ex-token "global") | ||
| 455 | (ex-global nil) | ||
| 456 | (setq cont nil)) | ||
| 457 | ((string= ex-token "vglobal") | ||
| 458 | (ex-global t) | ||
| 459 | (setq cont nil)) | ||
| 460 | (t | ||
| 461 | (vip-execute-ex-command) | ||
| 462 | (save-window-excursion | ||
| 463 | (set-buffer vip-ex-work-buf) | ||
| 464 | (skip-chars-forward " \t") | ||
| 465 | (cond ((looking-at "|") | ||
| 466 | (forward-char 1)) | ||
| 467 | ((looking-at "\n") | ||
| 468 | (setq cont nil)) | ||
| 469 | (t (error "`%s': %s" ex-token vip-SpuriousText))) | ||
| 470 | )) | ||
| 471 | )) | ||
| 472 | ((eq ex-token-type 'non-command) | ||
| 473 | (error (format "`%s': %s" ex-token vip-BadExCommand))) | ||
| 474 | ((eq ex-token-type 'whole) | ||
| 475 | (setq ex-addresses | ||
| 476 | (cons (point-max) (cons (point-min) ex-addresses)))) | ||
| 477 | ((eq ex-token-type 'comma) | ||
| 478 | (setq ex-addresses | ||
| 479 | (cons (if (null address) (point) address) ex-addresses))) | ||
| 480 | ((eq ex-token-type 'semi-colon) | ||
| 481 | (if address (setq dot address)) | ||
| 482 | (setq ex-addresses | ||
| 483 | (cons (if (null address) (point) address) ex-addresses))) | ||
| 484 | (t (let ((ans (vip-get-ex-address-subr address dot))) | ||
| 485 | (if ans (setq address ans)))))))) | ||
| 486 | |||
| 487 | (defun vip-get-ex-pat () | ||
| 488 | "Get a regular expression and set `ex-variant', if found." | ||
| 489 | (save-window-excursion | ||
| 490 | (set-buffer vip-ex-work-buf) | ||
| 491 | (skip-chars-forward " \t") | ||
| 492 | (if (looking-at "!") | ||
| 493 | (progn | ||
| 494 | (setq ex-g-variant (not ex-g-variant) | ||
| 495 | ex-g-flag (not ex-g-flag)) | ||
| 496 | (forward-char 1) | ||
| 497 | (skip-chars-forward " \t"))) | ||
| 498 | (let ((c (following-char))) | ||
| 499 | (if (string-match "[0-9A-Za-z]" (format "%c" c)) | ||
| 500 | (error | ||
| 501 | "Global regexp must be inside matching non-alphanumeric chars")) | ||
| 502 | (if (looking-at "[^\\\\\n]") | ||
| 503 | (progn | ||
| 504 | (forward-char 1) | ||
| 505 | (set-mark (point)) | ||
| 506 | (let ((cont t)) | ||
| 507 | (while (and (not (eolp)) cont) | ||
| 508 | (if (not (re-search-forward (format "[^%c]*%c" c c) nil t)) | ||
| 509 | (if (member ex-token '("global" "vglobal")) | ||
| 510 | (error | ||
| 511 | "Missing closing delimiter for global regexp") | ||
| 512 | (goto-char (point-max)))) | ||
| 513 | (if (not (vip-looking-back | ||
| 514 | (format "[^\\\\]\\(\\\\\\\\\\)*\\\\%c" c))) | ||
| 515 | (setq cont nil)))) | ||
| 516 | (setq ex-token | ||
| 517 | (if (= (mark t) (point)) "" | ||
| 518 | (buffer-substring (1- (point)) (mark t)))) | ||
| 519 | (backward-char 1)) | ||
| 520 | (setq ex-token nil)) | ||
| 521 | c))) | ||
| 522 | |||
| 523 | (defun vip-get-ex-command () | ||
| 524 | "get an ex command" | ||
| 525 | (save-window-excursion | ||
| 526 | (set-buffer vip-ex-work-buf) | ||
| 527 | (if (looking-at "/") (forward-char 1)) | ||
| 528 | (skip-chars-forward " \t") | ||
| 529 | (cond ((looking-at "[a-z]") | ||
| 530 | (vip-get-ex-com-subr) | ||
| 531 | (if (eq ex-token-type 'non-command) | ||
| 532 | (error "`%s': %s" ex-token vip-BadExCommand))) | ||
| 533 | ((looking-at "[!=><&~]") | ||
| 534 | (setq ex-token (char-to-string (following-char))) | ||
| 535 | (forward-char 1)) | ||
| 536 | (t (error vip-BadExCommand))))) | ||
| 537 | |||
| 538 | (defun vip-get-ex-opt-gc (c) | ||
| 539 | "Get an Ex option g or c." | ||
| 540 | (save-window-excursion | ||
| 541 | (set-buffer vip-ex-work-buf) | ||
| 542 | (if (looking-at (format "%c" c)) (forward-char 1)) | ||
| 543 | (skip-chars-forward " \t") | ||
| 544 | (cond ((looking-at "g") | ||
| 545 | (setq ex-token "g") | ||
| 546 | (forward-char 1) | ||
| 547 | t) | ||
| 548 | ((looking-at "c") | ||
| 549 | (setq ex-token "c") | ||
| 550 | (forward-char 1) | ||
| 551 | t) | ||
| 552 | (t nil)))) | ||
| 553 | |||
| 554 | (defun vip-default-ex-addresses (&optional whole-flag) | ||
| 555 | "Compute default addresses. WHOLE-FLAG means use the whole buffer." | ||
| 556 | (cond ((null ex-addresses) | ||
| 557 | (setq ex-addresses | ||
| 558 | (if whole-flag | ||
| 559 | (cons (point-max) (cons (point-min) nil)) | ||
| 560 | (cons (point) (cons (point) nil))))) | ||
| 561 | ((null (cdr ex-addresses)) | ||
| 562 | (setq ex-addresses | ||
| 563 | (cons (car ex-addresses) ex-addresses))))) | ||
| 564 | |||
| 565 | (defun vip-get-ex-address () | ||
| 566 | "Get an ex-address as a marker and set ex-flag if a flag is found." | ||
| 567 | (let ((address (point-marker)) (cont t)) | ||
| 568 | (setq ex-token "") | ||
| 569 | (setq ex-flag nil) | ||
| 570 | (while cont | ||
| 571 | (vip-get-ex-token) | ||
| 572 | (cond ((eq ex-token-type 'command) | ||
| 573 | (if (member ex-token '("print" "list" "#")) | ||
| 574 | (progn | ||
| 575 | (setq ex-flag t | ||
| 576 | cont nil)) | ||
| 577 | (error "Address expected in this Ex command"))) | ||
| 578 | ((eq ex-token-type 'end-mark) | ||
| 579 | (setq cont nil)) | ||
| 580 | ((eq ex-token-type 'whole) | ||
| 581 | (error "Trailing address expected")) | ||
| 582 | ((eq ex-token-type 'comma) | ||
| 583 | (error "`%s': %s" ex-token vip-SpuriousText)) | ||
| 584 | (t (let ((ans (vip-get-ex-address-subr address (point-marker)))) | ||
| 585 | (if ans (setq address ans)))))) | ||
| 586 | address)) | ||
| 587 | |||
| 588 | (defun vip-get-ex-address-subr (old-address dot) | ||
| 589 | "Returns an address as a point." | ||
| 590 | (let ((address nil)) | ||
| 591 | (if (null old-address) (setq old-address dot)) | ||
| 592 | (cond ((eq ex-token-type 'dot) | ||
| 593 | (setq address dot)) | ||
| 594 | ((eq ex-token-type 'add-number) | ||
| 595 | (save-excursion | ||
| 596 | (goto-char old-address) | ||
| 597 | (forward-line (if (= old-address 0) (1- ex-token) ex-token)) | ||
| 598 | (setq address (point-marker)))) | ||
| 599 | ((eq ex-token-type 'sub-number) | ||
| 600 | (save-excursion | ||
| 601 | (goto-char old-address) | ||
| 602 | (forward-line (- ex-token)) | ||
| 603 | (setq address (point-marker)))) | ||
| 604 | ((eq ex-token-type 'abs-number) | ||
| 605 | (save-excursion | ||
| 606 | (goto-char (point-min)) | ||
| 607 | (if (= ex-token 0) (setq address 0) | ||
| 608 | (forward-line (1- ex-token)) | ||
| 609 | (setq address (point-marker))))) | ||
| 610 | ((eq ex-token-type 'end) | ||
| 611 | (setq address (point-max-marker))) | ||
| 612 | ((eq ex-token-type 'plus) t);; do nothing | ||
| 613 | ((eq ex-token-type 'minus) t);; do nothing | ||
| 614 | ((eq ex-token-type 'search-forward) | ||
| 615 | (save-excursion | ||
| 616 | (ex-search-address t) | ||
| 617 | (setq address (point-marker)))) | ||
| 618 | ((eq ex-token-type 'search-backward) | ||
| 619 | (save-excursion | ||
| 620 | (ex-search-address nil) | ||
| 621 | (setq address (point-marker)))) | ||
| 622 | ((eq ex-token-type 'goto-mark) | ||
| 623 | (save-excursion | ||
| 624 | (if (null ex-token) | ||
| 625 | (exchange-point-and-mark) | ||
| 626 | (goto-char (vip-register-to-point | ||
| 627 | (1+ (- ex-token ?a)) 'enforce-buffer))) | ||
| 628 | (setq address (point-marker))))) | ||
| 629 | address)) | ||
| 630 | |||
| 631 | |||
| 632 | (defun ex-search-address (forward) | ||
| 633 | "Search pattern and set address." | ||
| 634 | (if (string= ex-token "") | ||
| 635 | (if (null vip-s-string) | ||
| 636 | (error vip-NoPrevSearch) | ||
| 637 | (setq ex-token vip-s-string)) | ||
| 638 | (setq vip-s-string ex-token)) | ||
| 639 | (if forward | ||
| 640 | (progn | ||
| 641 | (forward-line 1) | ||
| 642 | (re-search-forward ex-token)) | ||
| 643 | (forward-line -1) | ||
| 644 | (re-search-backward ex-token))) | ||
| 645 | |||
| 646 | (defun vip-get-ex-buffer () | ||
| 647 | "Get a buffer name and set `ex-count' and `ex-flag' if found." | ||
| 648 | (setq ex-buffer nil) | ||
| 649 | (setq ex-count nil) | ||
| 650 | (setq ex-flag nil) | ||
| 651 | (save-window-excursion | ||
| 652 | (set-buffer vip-ex-work-buf) | ||
| 653 | (skip-chars-forward " \t") | ||
| 654 | (if (looking-at "[a-zA-Z]") | ||
| 655 | (progn | ||
| 656 | (setq ex-buffer (following-char)) | ||
| 657 | (forward-char 1) | ||
| 658 | (skip-chars-forward " \t"))) | ||
| 659 | (if (looking-at "[0-9]") | ||
| 660 | (progn | ||
| 661 | (set-mark (point)) | ||
| 662 | (re-search-forward "[0-9][0-9]*") | ||
| 663 | (setq ex-count (string-to-int (buffer-substring (point) (mark t)))) | ||
| 664 | (skip-chars-forward " \t"))) | ||
| 665 | (if (looking-at "[pl#]") | ||
| 666 | (progn | ||
| 667 | (setq ex-flag t) | ||
| 668 | (forward-char 1))) | ||
| 669 | (if (not (looking-at "[\n|]")) | ||
| 670 | (error "`%s': %s" ex-token vip-SpuriousText)))) | ||
| 671 | |||
| 672 | (defun vip-get-ex-count () | ||
| 673 | (setq ex-variant nil | ||
| 674 | ex-count nil | ||
| 675 | ex-flag nil) | ||
| 676 | (save-window-excursion | ||
| 677 | (set-buffer vip-ex-work-buf) | ||
| 678 | (skip-chars-forward " \t") | ||
| 679 | (if (looking-at "!") | ||
| 680 | (progn | ||
| 681 | (setq ex-variant t) | ||
| 682 | (forward-char 1))) | ||
| 683 | (skip-chars-forward " \t") | ||
| 684 | (if (looking-at "[0-9]") | ||
| 685 | (progn | ||
| 686 | (set-mark (point)) | ||
| 687 | (re-search-forward "[0-9][0-9]*") | ||
| 688 | (setq ex-count (string-to-int (buffer-substring (point) (mark t)))) | ||
| 689 | (skip-chars-forward " \t"))) | ||
| 690 | (if (looking-at "[pl#]") | ||
| 691 | (progn | ||
| 692 | (setq ex-flag t) | ||
| 693 | (forward-char 1))) | ||
| 694 | (if (not (looking-at "[\n|]")) | ||
| 695 | (error "`%s': %s" | ||
| 696 | (buffer-substring (point-min) (1- (point-max))) vip-BadExCommand)))) | ||
| 697 | |||
| 698 | (defun ex-expand-filsyms (cmd buf) | ||
| 699 | "Expand \% and \# in ex command." | ||
| 700 | (let (cf pf ret) | ||
| 701 | (save-excursion | ||
| 702 | (set-buffer buf) | ||
| 703 | (setq cf buffer-file-name) | ||
| 704 | (setq pf (ex-next nil t))) ;; this finds alternative file name | ||
| 705 | (if (and (null cf) (string-match "[^\\]%\\|\\`%" cmd)) | ||
| 706 | (error "No current file to substitute for `\%'")) | ||
| 707 | (if (and (null pf) (string-match "[^\\]#\\|\\`#" cmd)) | ||
| 708 | (error "No alternate file to substitute for `#'")) | ||
| 709 | (save-excursion | ||
| 710 | (set-buffer (get-buffer-create " ex-tmp")) | ||
| 711 | (insert cmd) | ||
| 712 | (goto-char (point-min)) | ||
| 713 | (while (re-search-forward "%\\|#" nil t) | ||
| 714 | (let ((data (match-data)) | ||
| 715 | (char (buffer-substring (match-beginning 0) (match-end 0)))) | ||
| 716 | (if (vip-looking-back (concat "\\\\" char)) | ||
| 717 | (replace-match char) | ||
| 718 | (store-match-data data) | ||
| 719 | (if (string= char "%") | ||
| 720 | (replace-match cf) | ||
| 721 | (replace-match pf))))) | ||
| 722 | (end-of-line) | ||
| 723 | (setq ret (buffer-substring (point-min) (point))) | ||
| 724 | (kill-buffer (current-buffer)) | ||
| 725 | (message "%s" ret)) | ||
| 726 | ret)) | ||
| 727 | |||
| 728 | (defun vip-get-ex-file () | ||
| 729 | "Get a file name and set ex-variant, `ex-append' and `ex-offset' if found." | ||
| 730 | (let (prompt) | ||
| 731 | (setq ex-file nil | ||
| 732 | ex-variant nil | ||
| 733 | ex-append nil | ||
| 734 | ex-offset nil | ||
| 735 | ex-cmdfile nil) | ||
| 736 | (save-excursion | ||
| 737 | (save-window-excursion | ||
| 738 | (set-buffer vip-ex-work-buf) | ||
| 739 | (skip-chars-forward " \t") | ||
| 740 | (if (looking-at "!") | ||
| 741 | (if (not (vip-looking-back "[ \t]")) | ||
| 742 | (progn | ||
| 743 | (setq ex-variant t) | ||
| 744 | (forward-char 1) | ||
| 745 | (skip-chars-forward " \t")) | ||
| 746 | (setq ex-cmdfile t) | ||
| 747 | (forward-char 1) | ||
| 748 | (skip-chars-forward " \t"))) | ||
| 749 | (if (looking-at ">>") | ||
| 750 | (progn | ||
| 751 | (setq ex-append t | ||
| 752 | ex-variant t) | ||
| 753 | (forward-char 2) | ||
| 754 | (skip-chars-forward " \t"))) | ||
| 755 | (if (looking-at "+") | ||
| 756 | (progn | ||
| 757 | (forward-char 1) | ||
| 758 | (set-mark (point)) | ||
| 759 | (re-search-forward "[ \t\n]") | ||
| 760 | (backward-char 1) | ||
| 761 | (setq ex-offset (buffer-substring (point) (mark t))) | ||
| 762 | (forward-char 1) | ||
| 763 | (skip-chars-forward " \t"))) | ||
| 764 | ;; this takes care of :r, :w, etc., when they get file names | ||
| 765 | ;; from the history list | ||
| 766 | (if (member ex-token '("read" "write" "edit" "visual")) | ||
| 767 | (progn | ||
| 768 | (setq ex-file (buffer-substring (point) (1- (point-max)))) | ||
| 769 | (setq ex-file | ||
| 770 | ;; For :e, match multiple non-white strings separated | ||
| 771 | ;; by white. For others, find the first non-white string | ||
| 772 | (if (string-match | ||
| 773 | (if (string= ex-token "edit") | ||
| 774 | "[^ \t\n]+\\([ \t]+[^ \t\n]+\\)*" | ||
| 775 | "[^ \t\n]+") | ||
| 776 | ex-file) | ||
| 777 | (progn | ||
| 778 | ;; if file name comes from history, don't leave | ||
| 779 | ;; minibuffer when the user types space | ||
| 780 | (setq vip-incomplete-ex-cmd nil) | ||
| 781 | ;; this must be the last clause in this progn | ||
| 782 | (substring ex-file (match-beginning 0) (match-end 0)) | ||
| 783 | ) | ||
| 784 | "")) | ||
| 785 | ;; this leaves only the command name in the work area | ||
| 786 | ;; file names are gone | ||
| 787 | (delete-region (point) (1- (point-max))) | ||
| 788 | )) | ||
| 789 | (goto-char (point-max)) | ||
| 790 | (skip-chars-backward " \t\n") | ||
| 791 | (setq prompt (buffer-substring (point-min) (point))) | ||
| 792 | )) | ||
| 793 | |||
| 794 | (setq vip-last-ex-prompt prompt) | ||
| 795 | |||
| 796 | ;; If we just finished reading command, redisplay prompt | ||
| 797 | (if vip-incomplete-ex-cmd | ||
| 798 | (setq ex-file (vip-ex-read-file-name (format ":%s " prompt))) | ||
| 799 | ;; file was typed in-line | ||
| 800 | (setq ex-file (or ex-file ""))) | ||
| 801 | )) | ||
| 802 | |||
| 803 | |||
| 804 | ;; Completes file name or exits minibuffer. If Ex command accepts multiple | ||
| 805 | ;; file names, arranges to re-enter the minibuffer. | ||
| 806 | (defun vip-complete-filename-or-exit () | ||
| 807 | (interactive) | ||
| 808 | (setq vip-keep-reading-filename t) | ||
| 809 | ;; don't exit if directory---ex-commands don't | ||
| 810 | (cond ((ex-cmd-accepts-multiple-files-p ex-token) (exit-minibuffer)) | ||
| 811 | (t (minibuffer-complete-word)))) | ||
| 812 | |||
| 813 | |||
| 814 | (defun ex-cmd-accepts-multiple-files-p (token) | ||
| 815 | (member token '("edit" "next" "Next"))) | ||
| 816 | |||
| 817 | ;; If user doesn't enter anything, then "" is returned, i.e., the | ||
| 818 | ;; prompt-directory is not returned. | ||
| 819 | (defun vip-ex-read-file-name (prompt) | ||
| 820 | (let* ((str "") | ||
| 821 | (minibuffer-local-completion-map | ||
| 822 | (copy-keymap minibuffer-local-completion-map)) | ||
| 823 | beg end cont val) | ||
| 824 | |||
| 825 | (vip-add-keymap ex-read-filename-map minibuffer-local-completion-map) | ||
| 826 | |||
| 827 | (setq cont (setq vip-keep-reading-filename t)) | ||
| 828 | (while cont | ||
| 829 | (setq vip-keep-reading-filename nil | ||
| 830 | val (read-file-name (concat prompt str) nil default-directory) | ||
| 831 | str (concat str (if (equal val "") "" " ") | ||
| 832 | val (if (equal val "") "" " "))) | ||
| 833 | |||
| 834 | ;; Only edit, next, and Next commands accept multiple files. | ||
| 835 | ;; vip-keep-reading-filename is set in the anonymous function that is | ||
| 836 | ;; bound to " " in ex-read-filename-map. | ||
| 837 | (setq cont (and vip-keep-reading-filename | ||
| 838 | (ex-cmd-accepts-multiple-files-p ex-token))) | ||
| 839 | ) | ||
| 840 | |||
| 841 | (setq beg (string-match "[^ \t]" str) ;; delete leading blanks | ||
| 842 | end (string-match "[ \t]*$" str)) ;; delete trailing blanks | ||
| 843 | (if (member ex-token '("read" "write")) | ||
| 844 | (if (string-match "[\t ]*!" str) | ||
| 845 | ;; this is actually a shell command | ||
| 846 | (progn | ||
| 847 | (setq ex-cmdfile t) | ||
| 848 | (setq beg (1+ beg)) | ||
| 849 | (setq vip-last-ex-prompt (concat vip-last-ex-prompt " !"))))) | ||
| 850 | (substring str (or beg 0) end))) | ||
| 851 | |||
| 852 | (defun vip-execute-ex-command () | ||
| 853 | "Execute ex command using the value of addresses." | ||
| 854 | (vip-deactivate-mark) | ||
| 855 | (cond ((string= ex-token "args") (ex-args)) | ||
| 856 | ((string= ex-token "copy") (ex-copy nil)) | ||
| 857 | ((string= ex-token "cd") (ex-cd)) | ||
| 858 | ((string= ex-token "chdir") (ex-cd)) | ||
| 859 | ((string= ex-token "delete") (ex-delete)) | ||
| 860 | ((string= ex-token "edit") (ex-edit)) | ||
| 861 | ((string= ex-token "file") (vip-info-on-file)) | ||
| 862 | ((string= ex-token "goto") (ex-goto)) | ||
| 863 | ((string= ex-token "help") (ex-help)) | ||
| 864 | ((string= ex-token "join") (ex-line "join")) | ||
| 865 | ((string= ex-token "kmark") (ex-mark)) | ||
| 866 | ((string= ex-token "mark") (ex-mark)) | ||
| 867 | ((string= ex-token "map") (ex-map)) | ||
| 868 | ((string= ex-token "move") (ex-copy t)) | ||
| 869 | ((string= ex-token "next") (ex-next ex-cycle-other-window)) | ||
| 870 | ((string= ex-token "Next") (ex-next (not ex-cycle-other-window))) | ||
| 871 | ((string= ex-token "RelatedFile") (ex-next-related-buffer 1)) | ||
| 872 | ((string= ex-token "put") (ex-put)) | ||
| 873 | ((string= ex-token "pwd") (ex-pwd)) | ||
| 874 | ((string= ex-token "preserve") (ex-preserve)) | ||
| 875 | ((string= ex-token "PreviousRelatedFile") (ex-next-related-buffer -1)) | ||
| 876 | ((string= ex-token "quit") (ex-quit)) | ||
| 877 | ((string= ex-token "read") (ex-read)) | ||
| 878 | ((string= ex-token "recover") (ex-recover)) | ||
| 879 | ((string= ex-token "rewind") (ex-rewind)) | ||
| 880 | ((string= ex-token "submitReport") (vip-submit-report)) | ||
| 881 | ((string= ex-token "set") (ex-set)) | ||
| 882 | ((string= ex-token "shell") (ex-shell)) | ||
| 883 | ((string= ex-token "source") (ex-source)) | ||
| 884 | ((string= ex-token "sr") (ex-substitute t t)) | ||
| 885 | ((string= ex-token "substitute") (ex-substitute)) | ||
| 886 | ((string= ex-token "suspend") (suspend-emacs)) | ||
| 887 | ((string= ex-token "stop") (suspend-emacs)) | ||
| 888 | ((string= ex-token "transfer") (ex-copy nil)) | ||
| 889 | ((string= ex-token "buffer") (if ex-cycle-other-window | ||
| 890 | (vip-switch-to-buffer-other-window) | ||
| 891 | (vip-switch-to-buffer))) | ||
| 892 | ((string= ex-token "Buffer") (if ex-cycle-other-window | ||
| 893 | (vip-switch-to-buffer) | ||
| 894 | (vip-switch-to-buffer-other-window))) | ||
| 895 | ((string= ex-token "tag") (ex-tag)) | ||
| 896 | ((string= ex-token "undo") (vip-undo)) | ||
| 897 | ((string= ex-token "unmap") (ex-unmap)) | ||
| 898 | ((string= ex-token "version") (vip-version)) | ||
| 899 | ((string= ex-token "visual") (ex-edit)) | ||
| 900 | ((string= ex-token "write") (ex-write nil)) | ||
| 901 | ((string= ex-token "Write") (save-some-buffers)) | ||
| 902 | ((string= ex-token "wq") (ex-write t)) | ||
| 903 | ((string= ex-token "WWrite") (save-some-buffers t)) ; don't ask | ||
| 904 | ((string= ex-token "xit") (ex-write t)) | ||
| 905 | ((string= ex-token "yank") (ex-yank)) | ||
| 906 | ((string= ex-token "!") (ex-command)) | ||
| 907 | ((string= ex-token "=") (ex-line-no)) | ||
| 908 | ((string= ex-token ">") (ex-line "right")) | ||
| 909 | ((string= ex-token "<") (ex-line "left")) | ||
| 910 | ((string= ex-token "&") (ex-substitute t)) | ||
| 911 | ((string= ex-token "~") (ex-substitute t t)) | ||
| 912 | ((or (string= ex-token "append") | ||
| 913 | (string= ex-token "change") | ||
| 914 | (string= ex-token "insert") | ||
| 915 | (string= ex-token "open")) | ||
| 916 | (error | ||
| 917 | (format "`%s': Obsolete command, not supported by Viper" | ||
| 918 | ex-token))) | ||
| 919 | ((or (string= ex-token "abbreviate") | ||
| 920 | (string= ex-token "unabbreviate")) | ||
| 921 | (error | ||
| 922 | (format | ||
| 923 | "`%s': Vi's abbrevs are obsolete. Use more powerful Emacs' abbrevs" | ||
| 924 | ex-token))) | ||
| 925 | ((or (string= ex-token "list") | ||
| 926 | (string= ex-token "print") | ||
| 927 | (string= ex-token "z") | ||
| 928 | (string= ex-token "#")) | ||
| 929 | (error | ||
| 930 | (format "`%s': Command not implemented in Viper" ex-token))) | ||
| 931 | (t (error (format "`%s': %s" ex-token vip-BadExCommand))))) | ||
| 932 | |||
| 933 | (defun vip-undisplayed-files () | ||
| 934 | (mapcar | ||
| 935 | (function | ||
| 936 | (lambda (b) | ||
| 937 | (if (null (get-buffer-window b)) | ||
| 938 | (let ((f (buffer-file-name b))) | ||
| 939 | (if f f | ||
| 940 | (if ex-cycle-through-non-files | ||
| 941 | (let ((s (buffer-name b))) | ||
| 942 | (if (string= " " (substring s 0 1)) | ||
| 943 | nil | ||
| 944 | s)) | ||
| 945 | nil))) | ||
| 946 | nil))) | ||
| 947 | (buffer-list))) | ||
| 948 | |||
| 949 | |||
| 950 | (defun ex-args () | ||
| 951 | (let ((l (vip-undisplayed-files)) | ||
| 952 | (args "") | ||
| 953 | (file-count 1)) | ||
| 954 | (while (not (null l)) | ||
| 955 | (if (car l) | ||
| 956 | (setq args (format "%s %d) %s\n" args file-count (car l)) | ||
| 957 | file-count (1+ file-count))) | ||
| 958 | (setq l (cdr l))) | ||
| 959 | (if (string= args "") | ||
| 960 | (message "All files are already displayed") | ||
| 961 | (save-excursion | ||
| 962 | (save-window-excursion | ||
| 963 | (with-output-to-temp-buffer " *vip-info*" | ||
| 964 | (princ "\n\nThese files are not displayed in any window.\n") | ||
| 965 | (princ "\n=============\n") | ||
| 966 | (princ args) | ||
| 967 | (princ "\n=============\n") | ||
| 968 | (princ "\nThe numbers can be given as counts to :next. ") | ||
| 969 | (princ "\n\nPress any key to continue...\n\n")) | ||
| 970 | (vip-read-char-exclusive)))))) | ||
| 971 | |||
| 972 | (defun ex-cd () | ||
| 973 | "Ex cd command. Default directory of this buffer changes." | ||
| 974 | (vip-get-ex-file) | ||
| 975 | (if (string= ex-file "") | ||
| 976 | (setq ex-file "~")) | ||
| 977 | (setq default-directory (file-name-as-directory (expand-file-name ex-file)))) | ||
| 978 | |||
| 979 | (defun ex-copy (del-flag) | ||
| 980 | "Ex copy and move command. DEL-FLAG means delete." | ||
| 981 | (vip-default-ex-addresses) | ||
| 982 | (let ((address (vip-get-ex-address)) | ||
| 983 | (end (car ex-addresses)) (beg (car (cdr ex-addresses)))) | ||
| 984 | (goto-char end) | ||
| 985 | (save-excursion | ||
| 986 | (push-mark beg t) | ||
| 987 | (vip-enlarge-region (mark t) (point)) | ||
| 988 | (if del-flag | ||
| 989 | (kill-region (point) (mark t)) | ||
| 990 | (copy-region-as-kill (point) (mark t))) | ||
| 991 | (if ex-flag | ||
| 992 | (progn | ||
| 993 | (with-output-to-temp-buffer "*copy text*" | ||
| 994 | (princ | ||
| 995 | (if (or del-flag ex-g-flag ex-g-variant) | ||
| 996 | (current-kill 0) | ||
| 997 | (buffer-substring (point) (mark t))))) | ||
| 998 | (condition-case nil | ||
| 999 | (progn | ||
| 1000 | (read-string "[Hit return to continue] ") | ||
| 1001 | (save-excursion (kill-buffer "*copy text*"))) | ||
| 1002 | (quit (save-excursion (kill-buffer "*copy text*")) | ||
| 1003 | (signal 'quit nil)))))) | ||
| 1004 | (if (= address 0) | ||
| 1005 | (goto-char (point-min)) | ||
| 1006 | (goto-char address) | ||
| 1007 | (forward-line 1)) | ||
| 1008 | (insert (current-kill 0)))) | ||
| 1009 | |||
| 1010 | (defun ex-delete () | ||
| 1011 | "Ex delete command." | ||
| 1012 | (vip-default-ex-addresses) | ||
| 1013 | (vip-get-ex-buffer) | ||
| 1014 | (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses)))) | ||
| 1015 | (if (> beg end) (error vip-FirstAddrExceedsSecond)) | ||
| 1016 | (save-excursion | ||
| 1017 | (vip-enlarge-region beg end) | ||
| 1018 | (exchange-point-and-mark) | ||
| 1019 | (if ex-count | ||
| 1020 | (progn | ||
| 1021 | (set-mark (point)) | ||
| 1022 | (forward-line (1- ex-count))) | ||
| 1023 | (set-mark end)) | ||
| 1024 | (vip-enlarge-region (point) (mark t)) | ||
| 1025 | (if ex-flag | ||
| 1026 | ;; show text to be deleted and ask for confirmation | ||
| 1027 | (progn | ||
| 1028 | (with-output-to-temp-buffer " *delete text*" | ||
| 1029 | (princ (buffer-substring (point) (mark t)))) | ||
| 1030 | (condition-case nil | ||
| 1031 | (read-string "[Hit return to continue] ") | ||
| 1032 | (quit | ||
| 1033 | (save-excursion (kill-buffer " *delete text*")) | ||
| 1034 | (error ""))) | ||
| 1035 | (save-excursion (kill-buffer " *delete text*"))) | ||
| 1036 | (if ex-buffer | ||
| 1037 | (cond ((vip-valid-register ex-buffer '(Letter)) | ||
| 1038 | (vip-append-to-register | ||
| 1039 | (downcase ex-buffer) (point) (mark t))) | ||
| 1040 | ((vip-valid-register ex-buffer) | ||
| 1041 | (copy-to-register ex-buffer (point) (mark t) nil)) | ||
| 1042 | (t (error vip-InvalidRegister ex-buffer)))) | ||
| 1043 | (kill-region (point) (mark t)))))) | ||
| 1044 | |||
| 1045 | |||
| 1046 | |||
| 1047 | (defun ex-edit (&optional file) | ||
| 1048 | "Ex edit command. | ||
| 1049 | In Viper, `e' and `e!' behave identically. In both cases, the user is | ||
| 1050 | asked if current buffer should really be discarded. | ||
| 1051 | This command can take multiple file names. It replaces the current buffer | ||
| 1052 | with the first file in its argument list." | ||
| 1053 | (if (not file) | ||
| 1054 | (vip-get-ex-file)) | ||
| 1055 | (cond ((and (string= ex-file "") buffer-file-name) | ||
| 1056 | (setq ex-file (abbreviate-file-name (buffer-file-name)))) | ||
| 1057 | ((string= ex-file "") | ||
| 1058 | (error vip-NoFileSpecified))) | ||
| 1059 | |||
| 1060 | (let (msg do-edit) | ||
| 1061 | (if buffer-file-name | ||
| 1062 | (cond ((buffer-modified-p) | ||
| 1063 | (setq msg | ||
| 1064 | (format "Buffer %s is modified. Edit buffer? " | ||
| 1065 | (buffer-name)) | ||
| 1066 | do-edit t)) | ||
| 1067 | ((not (verify-visited-file-modtime (current-buffer))) | ||
| 1068 | (setq msg | ||
| 1069 | (format "File %s changed on disk. Reread from disk? " | ||
| 1070 | buffer-file-name) | ||
| 1071 | do-edit t)) | ||
| 1072 | (t (setq do-edit nil)))) | ||
| 1073 | |||
| 1074 | (if do-edit | ||
| 1075 | (if (yes-or-no-p msg) | ||
| 1076 | (progn | ||
| 1077 | (set-buffer-modified-p nil) | ||
| 1078 | (kill-buffer (current-buffer))) | ||
| 1079 | (message "Buffer %s was left intact" (buffer-name)))) | ||
| 1080 | ) ; let | ||
| 1081 | |||
| 1082 | (if (null (setq file (get-file-buffer ex-file))) | ||
| 1083 | (progn | ||
| 1084 | (ex-find-file ex-file) | ||
| 1085 | (vip-change-state-to-vi) | ||
| 1086 | (goto-char (point-min))) | ||
| 1087 | (switch-to-buffer file)) | ||
| 1088 | (if ex-offset | ||
| 1089 | (progn | ||
| 1090 | (save-window-excursion | ||
| 1091 | (set-buffer vip-ex-work-buf) | ||
| 1092 | (delete-region (point-min) (point-max)) | ||
| 1093 | (insert ex-offset "\n") | ||
| 1094 | (goto-char (point-min))) | ||
| 1095 | (goto-char (vip-get-ex-address)) | ||
| 1096 | (beginning-of-line))) | ||
| 1097 | (ex-fixup-history vip-last-ex-prompt ex-file)) | ||
| 1098 | |||
| 1099 | ;; splits the string FILESPEC into substrings separated by newlines `\012' | ||
| 1100 | ;; each line assumed to be a file name. find-file's each file thus obtained. | ||
| 1101 | (defun ex-find-file (filespec) | ||
| 1102 | (let (s f filebuf) | ||
| 1103 | (if (string-match "[^a-zA-Z0-9_.-/]" filespec) | ||
| 1104 | (progn | ||
| 1105 | (save-excursion | ||
| 1106 | (set-buffer (get-buffer-create " ex-tmp")) | ||
| 1107 | (call-process ex-find-file-shell nil t nil | ||
| 1108 | ex-find-file-shell-options | ||
| 1109 | "-c" | ||
| 1110 | (format "echo %s | tr ' ' '\\012'" filespec)) | ||
| 1111 | (goto-char (point-min)) | ||
| 1112 | (while (not (eobp)) | ||
| 1113 | (setq s (point)) | ||
| 1114 | (end-of-line) | ||
| 1115 | (setq f (buffer-substring s (point))) | ||
| 1116 | (setq filebuf (find-file-noselect f)) | ||
| 1117 | (forward-to-indentation 1)) | ||
| 1118 | (kill-buffer (current-buffer)))) | ||
| 1119 | (setq filebuf (find-file-noselect (setq f filespec)))) | ||
| 1120 | (switch-to-buffer filebuf) | ||
| 1121 | )) | ||
| 1122 | |||
| 1123 | (defun ex-global (variant) | ||
| 1124 | "Ex global command." | ||
| 1125 | (let ((gcommand ex-token)) | ||
| 1126 | (if (or ex-g-flag ex-g-variant) | ||
| 1127 | (error "`%s' within `global' is not allowed" gcommand) | ||
| 1128 | (if variant | ||
| 1129 | (setq ex-g-flag nil | ||
| 1130 | ex-g-variant t) | ||
| 1131 | (setq ex-g-flag t | ||
| 1132 | ex-g-variant nil))) | ||
| 1133 | (vip-get-ex-pat) | ||
| 1134 | (if (null ex-token) | ||
| 1135 | (error "`%s': Missing regular expression" gcommand))) | ||
| 1136 | |||
| 1137 | (if (string= ex-token "") | ||
| 1138 | (if (null vip-s-string) | ||
| 1139 | (error vip-NoPrevSearch) | ||
| 1140 | (setq ex-g-pat vip-s-string)) | ||
| 1141 | (setq ex-g-pat ex-token | ||
| 1142 | vip-s-string ex-token)) | ||
| 1143 | (if (null ex-addresses) | ||
| 1144 | (setq ex-addresses (list (point-max) (point-min))) | ||
| 1145 | (vip-default-ex-addresses)) | ||
| 1146 | (let ((marks nil) (mark-count 0) | ||
| 1147 | com-str (end (car ex-addresses)) (beg (car (cdr ex-addresses)))) | ||
| 1148 | (if (> beg end) (error vip-FirstAddrExceedsSecond)) | ||
| 1149 | (save-excursion | ||
| 1150 | (vip-enlarge-region beg end) | ||
| 1151 | (exchange-point-and-mark) | ||
| 1152 | (let ((cont t) (limit (point-marker))) | ||
| 1153 | (exchange-point-and-mark) | ||
| 1154 | ;; skip the last line if empty | ||
| 1155 | (beginning-of-line) | ||
| 1156 | (if (eobp) (vip-backward-char-carefully)) | ||
| 1157 | (while (and cont (not (bobp)) (>= (point) limit)) | ||
| 1158 | (beginning-of-line) | ||
| 1159 | (set-mark (point)) | ||
| 1160 | (end-of-line) | ||
| 1161 | (let ((found (re-search-backward ex-g-pat (mark t) t))) | ||
| 1162 | (if (or (and ex-g-flag found) | ||
| 1163 | (and ex-g-variant (not found))) | ||
| 1164 | (progn | ||
| 1165 | (end-of-line) | ||
| 1166 | (setq mark-count (1+ mark-count)) | ||
| 1167 | (setq marks (cons (point-marker) marks))))) | ||
| 1168 | (beginning-of-line) | ||
| 1169 | (if (bobp) (setq cont nil) | ||
| 1170 | (forward-line -1) | ||
| 1171 | (end-of-line))))) | ||
| 1172 | (save-window-excursion | ||
| 1173 | (set-buffer vip-ex-work-buf) | ||
| 1174 | (setq com-str (buffer-substring (1+ (point)) (1- (point-max))))) | ||
| 1175 | (while marks | ||
| 1176 | (goto-char (car marks)) | ||
| 1177 | (vip-ex com-str) | ||
| 1178 | (setq mark-count (1- mark-count)) | ||
| 1179 | (setq marks (cdr marks))))) | ||
| 1180 | |||
| 1181 | (defun ex-goto () | ||
| 1182 | "Ex goto command." | ||
| 1183 | (if (null ex-addresses) | ||
| 1184 | (setq ex-addresses (cons (point) nil))) | ||
| 1185 | (push-mark (point) t) | ||
| 1186 | (goto-char (car ex-addresses)) | ||
| 1187 | (beginning-of-line)) | ||
| 1188 | |||
| 1189 | (defun ex-line (com) | ||
| 1190 | "Ex line commands. COM is join, shift-right or shift-left." | ||
| 1191 | (vip-default-ex-addresses) | ||
| 1192 | (vip-get-ex-count) | ||
| 1193 | (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses))) point) | ||
| 1194 | (if (> beg end) (error vip-FirstAddrExceedsSecond)) | ||
| 1195 | (save-excursion | ||
| 1196 | (vip-enlarge-region beg end) | ||
| 1197 | (exchange-point-and-mark) | ||
| 1198 | (if ex-count | ||
| 1199 | (progn | ||
| 1200 | (set-mark (point)) | ||
| 1201 | (forward-line ex-count))) | ||
| 1202 | (if ex-flag | ||
| 1203 | ;; show text to be joined and ask for confirmation | ||
| 1204 | (progn | ||
| 1205 | (with-output-to-temp-buffer " *text*" | ||
| 1206 | (princ (buffer-substring (point) (mark t)))) | ||
| 1207 | (condition-case nil | ||
| 1208 | (progn | ||
| 1209 | (read-string "[Hit return to continue] ") | ||
| 1210 | (ex-line-subr com (point) (mark t))) | ||
| 1211 | (quit (ding))) | ||
| 1212 | (save-excursion (kill-buffer " *text*"))) | ||
| 1213 | (ex-line-subr com (point) (mark t))) | ||
| 1214 | (setq point (point))) | ||
| 1215 | (goto-char (1- point)) | ||
| 1216 | (beginning-of-line))) | ||
| 1217 | |||
| 1218 | (defun ex-line-subr (com beg end) | ||
| 1219 | (cond ((string= com "join") | ||
| 1220 | (goto-char (min beg end)) | ||
| 1221 | (while (and (not (eobp)) (< (point) (max beg end))) | ||
| 1222 | (end-of-line) | ||
| 1223 | (if (and (<= (point) (max beg end)) (not (eobp))) | ||
| 1224 | (progn | ||
| 1225 | (forward-line 1) | ||
| 1226 | (delete-region (point) (1- (point))) | ||
| 1227 | (if (not ex-variant) (fixup-whitespace)))))) | ||
| 1228 | ((or (string= com "right") (string= com "left")) | ||
| 1229 | (indent-rigidly | ||
| 1230 | (min beg end) (max beg end) | ||
| 1231 | (if (string= com "right") vip-shift-width (- vip-shift-width))) | ||
| 1232 | (goto-char (max beg end)) | ||
| 1233 | (end-of-line) | ||
| 1234 | (vip-forward-char-carefully)))) | ||
| 1235 | |||
| 1236 | |||
| 1237 | (defun ex-mark () | ||
| 1238 | "Ex mark command." | ||
| 1239 | (let (char) | ||
| 1240 | (if (null ex-addresses) | ||
| 1241 | (setq ex-addresses | ||
| 1242 | (cons (point) nil))) | ||
| 1243 | (save-window-excursion | ||
| 1244 | (set-buffer vip-ex-work-buf) | ||
| 1245 | (skip-chars-forward " \t") | ||
| 1246 | (if (looking-at "[a-z]") | ||
| 1247 | (progn | ||
| 1248 | (setq char (following-char)) | ||
| 1249 | (forward-char 1) | ||
| 1250 | (skip-chars-forward " \t") | ||
| 1251 | (if (not (looking-at "[\n|]")) | ||
| 1252 | (error "`%s': %s" ex-token vip-SpuriousText))) | ||
| 1253 | (error "`%s' requires a following letter" ex-token))) | ||
| 1254 | (save-excursion | ||
| 1255 | (goto-char (car ex-addresses)) | ||
| 1256 | (point-to-register (1+ (- char ?a)))))) | ||
| 1257 | |||
| 1258 | |||
| 1259 | |||
| 1260 | ;; Alternate file is the file next to the first one in the buffer ring | ||
| 1261 | (defun ex-next (cycle-other-window &optional find-alt-file) | ||
| 1262 | (catch 'ex-edit | ||
| 1263 | (let (count l) | ||
| 1264 | (if (not find-alt-file) | ||
| 1265 | (progn | ||
| 1266 | (vip-get-ex-file) | ||
| 1267 | (if (or (char-or-string-p ex-offset) | ||
| 1268 | (not (string= "" ex-file))) | ||
| 1269 | ;(and (not (string= "" ex-file)) | ||
| 1270 | ; (not (string-match "[0-9]+" ex-file)))) | ||
| 1271 | (progn | ||
| 1272 | (ex-edit t) | ||
| 1273 | (throw 'ex-edit nil)) | ||
| 1274 | (setq count (string-to-int ex-file)) | ||
| 1275 | (if (= count 0) (setq count 1)) | ||
| 1276 | (if (< count 0) (error "Usage: `next <count>' (count >= 0)")))) | ||
| 1277 | (setq count 1)) | ||
| 1278 | (setq l (vip-undisplayed-files)) | ||
| 1279 | (while (> count 0) | ||
| 1280 | (while (and (not (null l)) (null (car l))) | ||
| 1281 | (setq l (cdr l))) | ||
| 1282 | (setq count (1- count)) | ||
| 1283 | (if (> count 0) | ||
| 1284 | (setq l (cdr l)))) | ||
| 1285 | (if find-alt-file (car l) | ||
| 1286 | (progn | ||
| 1287 | (if (car l) | ||
| 1288 | (let* ((w (if cycle-other-window | ||
| 1289 | (get-lru-window) (selected-window))) | ||
| 1290 | (b (window-buffer w))) | ||
| 1291 | (set-window-buffer w (get-file-buffer (car l))) | ||
| 1292 | (bury-buffer b)) | ||
| 1293 | (error "Not that many undisplayed files"))))))) | ||
| 1294 | |||
| 1295 | |||
| 1296 | (defun ex-next-related-buffer (direction &optional no-recursion) | ||
| 1297 | |||
| 1298 | (vip-ring-rotate1 vip-related-files-and-buffers-ring direction) | ||
| 1299 | |||
| 1300 | (let ((file-or-buffer-name | ||
| 1301 | (vip-current-ring-item vip-related-files-and-buffers-ring)) | ||
| 1302 | (old-ring vip-related-files-and-buffers-ring) | ||
| 1303 | (old-win (selected-window)) | ||
| 1304 | skip-rest buf wind) | ||
| 1305 | |||
| 1306 | (or (and (ring-p vip-related-files-and-buffers-ring) | ||
| 1307 | (> (ring-length vip-related-files-and-buffers-ring) 0)) | ||
| 1308 | (error "This buffer has no related files or buffers")) | ||
| 1309 | |||
| 1310 | (or (stringp file-or-buffer-name) | ||
| 1311 | (error | ||
| 1312 | "File and buffer names must be strings, %S" file-or-buffer-name)) | ||
| 1313 | |||
| 1314 | (setq buf (cond ((get-buffer file-or-buffer-name)) | ||
| 1315 | ((file-exists-p file-or-buffer-name) | ||
| 1316 | (find-file-noselect file-or-buffer-name)) | ||
| 1317 | )) | ||
| 1318 | |||
| 1319 | (if (not (vip-buffer-live-p buf)) | ||
| 1320 | (error "Didn't find buffer %S or file %S" | ||
| 1321 | file-or-buffer-name | ||
| 1322 | (abbreviate-file-name (expand-file-name file-or-buffer-name)))) | ||
| 1323 | |||
| 1324 | (if (equal buf (current-buffer)) | ||
| 1325 | (or no-recursion | ||
| 1326 | ;; try again | ||
| 1327 | (setq skip-rest t) | ||
| 1328 | (ex-next-related-buffer direction 'norecursion))) | ||
| 1329 | |||
| 1330 | (if skip-rest | ||
| 1331 | () | ||
| 1332 | ;; setup buffer | ||
| 1333 | (if (setq wind (vip-get-visible-buffer-window buf)) | ||
| 1334 | () | ||
| 1335 | (setq wind (get-lru-window (if vip-xemacs-p nil 'visible))) | ||
| 1336 | (set-window-buffer wind buf)) | ||
| 1337 | |||
| 1338 | (if window-system | ||
| 1339 | (progn | ||
| 1340 | (vip-raise-frame (vip-window-frame wind)) | ||
| 1341 | (if (equal (vip-window-frame wind) (vip-window-frame old-win)) | ||
| 1342 | (save-window-excursion (select-window wind) (sit-for 1)) | ||
| 1343 | (select-window wind))) | ||
| 1344 | (save-window-excursion (select-window wind) (sit-for 1))) | ||
| 1345 | |||
| 1346 | (save-excursion | ||
| 1347 | (set-buffer buf) | ||
| 1348 | (setq vip-related-files-and-buffers-ring old-ring)) | ||
| 1349 | |||
| 1350 | (setq vip-local-search-start-marker (point-marker)) | ||
| 1351 | ))) | ||
| 1352 | |||
| 1353 | |||
| 1354 | (defun ex-preserve () | ||
| 1355 | "Force auto save." | ||
| 1356 | (message "Autosaving all buffers that need to be saved...") | ||
| 1357 | (do-auto-save t)) | ||
| 1358 | |||
| 1359 | (defun ex-put () | ||
| 1360 | "Ex put." | ||
| 1361 | (let ((point (if (null ex-addresses) (point) (car ex-addresses)))) | ||
| 1362 | (vip-get-ex-buffer) | ||
| 1363 | (setq vip-use-register ex-buffer) | ||
| 1364 | (goto-char point) | ||
| 1365 | (if (bobp) (vip-Put-back 1) (vip-put-back 1)))) | ||
| 1366 | |||
| 1367 | (defun ex-pwd () | ||
| 1368 | "Ex print working directory." | ||
| 1369 | (message default-directory)) | ||
| 1370 | |||
| 1371 | (defun ex-quit () | ||
| 1372 | "Ex quit command." | ||
| 1373 | (if (< vip-expert-level 3) | ||
| 1374 | (save-buffers-kill-emacs) | ||
| 1375 | (kill-buffer (current-buffer)))) | ||
| 1376 | |||
| 1377 | |||
| 1378 | (defun ex-read () | ||
| 1379 | "Ex read command." | ||
| 1380 | (vip-get-ex-file) | ||
| 1381 | (let ((point (if (null ex-addresses) (point) (car ex-addresses)))) | ||
| 1382 | (goto-char point) | ||
| 1383 | (vip-add-newline-at-eob-if-necessary) | ||
| 1384 | (if (not (or (bobp) (eobp))) (forward-line 1)) | ||
| 1385 | (if (and (not ex-variant) (string= ex-file "")) | ||
| 1386 | (progn | ||
| 1387 | (if (null buffer-file-name) | ||
| 1388 | (error vip-NoFileSpecified)) | ||
| 1389 | (setq ex-file buffer-file-name))) | ||
| 1390 | (if ex-cmdfile | ||
| 1391 | (shell-command ex-file t) | ||
| 1392 | (insert-file-contents ex-file))) | ||
| 1393 | (ex-fixup-history vip-last-ex-prompt ex-file)) | ||
| 1394 | |||
| 1395 | ;; this function fixes ex-history for some commands like ex-read, ex-edit | ||
| 1396 | (defun ex-fixup-history (&rest args) | ||
| 1397 | (setq vip-ex-history | ||
| 1398 | (cons (mapconcat 'identity args " ") (cdr vip-ex-history)))) | ||
| 1399 | |||
| 1400 | |||
| 1401 | (defun ex-recover () | ||
| 1402 | "Ex recover from emacs \#file\#." | ||
| 1403 | (vip-get-ex-file) | ||
| 1404 | (if (or ex-append ex-offset) | ||
| 1405 | (error "`recover': %s" vip-SpuriousText)) | ||
| 1406 | (if (string= ex-file "") | ||
| 1407 | (progn | ||
| 1408 | (if (null buffer-file-name) | ||
| 1409 | (error "This buffer isn't visiting any file")) | ||
| 1410 | (setq ex-file buffer-file-name)) | ||
| 1411 | (setq ex-file (expand-file-name ex-file))) | ||
| 1412 | (if (and (not (string= ex-file (buffer-file-name))) | ||
| 1413 | (buffer-modified-p) | ||
| 1414 | (not ex-variant)) | ||
| 1415 | (error "No write since last change \(:rec! overrides\)")) | ||
| 1416 | (recover-file ex-file)) | ||
| 1417 | |||
| 1418 | (defun ex-rewind () | ||
| 1419 | "Tell that `rewind' is obsolete and that one should use `:next count'" | ||
| 1420 | (message | ||
| 1421 | "Use `:n <count>' instead. Counts are obtained from the `:args' command")) | ||
| 1422 | |||
| 1423 | |||
| 1424 | ;; read variable name for ex-set | ||
| 1425 | (defun ex-set-read-variable () | ||
| 1426 | (let ((minibuffer-local-completion-map | ||
| 1427 | (copy-keymap minibuffer-local-completion-map)) | ||
| 1428 | (cursor-in-echo-area t) | ||
| 1429 | str batch) | ||
| 1430 | (define-key | ||
| 1431 | minibuffer-local-completion-map " " 'minibuffer-complete-and-exit) | ||
| 1432 | (define-key minibuffer-local-completion-map "=" 'exit-minibuffer) | ||
| 1433 | (if (vip-set-unread-command-events | ||
| 1434 | (ex-get-inline-cmd-args "[ \t]*[a-zA-Z]*[ \t]*" nil "\C-m")) | ||
| 1435 | (progn | ||
| 1436 | (setq batch t) | ||
| 1437 | (vip-set-unread-command-events ?\C-m))) | ||
| 1438 | (message ":set <Variable> [= <Value>]") | ||
| 1439 | (or batch (sit-for 2)) | ||
| 1440 | |||
| 1441 | (while (string-match "^[ \\t\\n]*$" | ||
| 1442 | (setq str | ||
| 1443 | (completing-read ":set " ex-variable-alist))) | ||
| 1444 | (message ":set <Variable> ") | ||
| 1445 | ;; if there are unread events, don't wait | ||
| 1446 | (or (vip-set-unread-command-events "") (sit-for 2)) | ||
| 1447 | ) ; while | ||
| 1448 | str)) | ||
| 1449 | |||
| 1450 | |||
| 1451 | (defun ex-set () | ||
| 1452 | (let ((var (ex-set-read-variable)) | ||
| 1453 | (val 0) | ||
| 1454 | (set-cmd "setq") | ||
| 1455 | (ask-if-save t) | ||
| 1456 | (auto-cmd-label "; don't touch or else...") | ||
| 1457 | (delete-turn-on-auto-fill-pattern | ||
| 1458 | "([ \t]*add-hook[ \t]+'vip-insert-state-hooks[ \t]+'turn-on-auto-fill.*)") | ||
| 1459 | actual-lisp-cmd lisp-cmd-del-pattern | ||
| 1460 | val2 orig-var) | ||
| 1461 | (setq orig-var var) | ||
| 1462 | (cond ((member var '("ai" "autoindent")) | ||
| 1463 | (setq var "vip-auto-indent" | ||
| 1464 | val "t")) | ||
| 1465 | ((member var '("noai" "noautoindent")) | ||
| 1466 | (setq var "vip-auto-indent" | ||
| 1467 | val "nil")) | ||
| 1468 | ((member var '("ic" "ignorecase")) | ||
| 1469 | (setq var "vip-case-fold-search" | ||
| 1470 | val "t")) | ||
| 1471 | ((member var '("noic" "noignorecase")) | ||
| 1472 | (setq var "vip-case-fold-search" | ||
| 1473 | val "nil")) | ||
| 1474 | ((member var '("ma" "magic")) | ||
| 1475 | (setq var "vip-re-search" | ||
| 1476 | val "t")) | ||
| 1477 | ((member var '("noma" "nomagic")) | ||
| 1478 | (setq var "vip-re-search" | ||
| 1479 | val "nil")) | ||
| 1480 | ((member var '("ro" "readonly")) | ||
| 1481 | (setq var "buffer-read-only" | ||
| 1482 | val "t")) | ||
| 1483 | ((member var '("noro" "noreadonly")) | ||
| 1484 | (setq var "buffer-read-only" | ||
| 1485 | val "nil")) | ||
| 1486 | ((member var '("sm" "showmatch")) | ||
| 1487 | (setq var "blink-matching-paren" | ||
| 1488 | val "t")) | ||
| 1489 | ((member var '("nosm" "noshowmatch")) | ||
| 1490 | (setq var "blink-matching-paren" | ||
| 1491 | val "nil")) | ||
| 1492 | ((member var '("ws" "wrapscan")) | ||
| 1493 | (setq var "vip-search-wrap-around-t" | ||
| 1494 | val "t")) | ||
| 1495 | ((member var '("nows" "nowrapscan")) | ||
| 1496 | (setq var "vip-search-wrap-around-t" | ||
| 1497 | val "nil"))) | ||
| 1498 | (if (eq val 0) ;; value must be set by the user | ||
| 1499 | (let ((cursor-in-echo-area t)) | ||
| 1500 | (message (format ":set %s = <Value>" var)) | ||
| 1501 | ;; if there are unread events, don't wait | ||
| 1502 | (or (vip-set-unread-command-events "") (sit-for 2)) | ||
| 1503 | (setq val (read-string (format ":set %s = " var))) | ||
| 1504 | (ex-fixup-history "set" orig-var val) | ||
| 1505 | |||
| 1506 | ;; check numerical values | ||
| 1507 | (if (member var | ||
| 1508 | '("sw" "shiftwidth" "ts" "tabstop" "wm" "wrapmargin")) | ||
| 1509 | (condition-case nil | ||
| 1510 | (or (numberp (setq val2 (car (read-from-string val)))) | ||
| 1511 | (error "%s: Invalid value, numberp, %S" var val)) | ||
| 1512 | (error | ||
| 1513 | (error "%s: Invalid value, numberp, %S" var val)))) | ||
| 1514 | |||
| 1515 | (cond | ||
| 1516 | ((member var '("sw" "shiftwidth")) | ||
| 1517 | (setq var "vip-shift-width")) | ||
| 1518 | ((member var '("ts" "tabstop")) | ||
| 1519 | ;; make it take effect in curr buff and new bufs | ||
| 1520 | (kill-local-variable 'tab-width) | ||
| 1521 | (setq var "tab-width" | ||
| 1522 | set-cmd "setq-default")) | ||
| 1523 | ((member var '("tsl" "tab-stop-local")) | ||
| 1524 | (setq var "tab-width" | ||
| 1525 | set-cmd "setq" | ||
| 1526 | ask-if-save nil)) | ||
| 1527 | ((member var '("wm" "wrapmargin")) | ||
| 1528 | ;; make it take effect in curr buff and new bufs | ||
| 1529 | (kill-local-variable 'fill-column) | ||
| 1530 | (setq var "fill-column" | ||
| 1531 | val (format "(- (window-width) %s)" val) | ||
| 1532 | set-cmd "setq-default")) | ||
| 1533 | ((member var '("sh" "shell")) | ||
| 1534 | (setq var "explicit-shell-file-name" | ||
| 1535 | val (format "\"%s\"" val))))) | ||
| 1536 | (ex-fixup-history "set" orig-var)) | ||
| 1537 | |||
| 1538 | (setq actual-lisp-cmd (format "\n(%s %s %s) %s" | ||
| 1539 | set-cmd var val auto-cmd-label)) | ||
| 1540 | (setq lisp-cmd-del-pattern | ||
| 1541 | (format "^\n?[ \t]*([ \t]*%s[ \t]+%s[ \t].*)[ \t]*%s" | ||
| 1542 | set-cmd var auto-cmd-label)) | ||
| 1543 | |||
| 1544 | (if (and ask-if-save | ||
| 1545 | (y-or-n-p (format "Do you want to save this setting in %s " | ||
| 1546 | vip-custom-file-name))) | ||
| 1547 | (progn | ||
| 1548 | (vip-save-string-in-file | ||
| 1549 | actual-lisp-cmd vip-custom-file-name | ||
| 1550 | ;; del pattern | ||
| 1551 | lisp-cmd-del-pattern) | ||
| 1552 | (if (string= var "fill-column") | ||
| 1553 | (if (> val2 0) | ||
| 1554 | (vip-save-string-in-file | ||
| 1555 | (concat | ||
| 1556 | "(add-hook 'vip-insert-state-hooks 'turn-on-auto-fill) " | ||
| 1557 | auto-cmd-label) | ||
| 1558 | vip-custom-file-name | ||
| 1559 | delete-turn-on-auto-fill-pattern) | ||
| 1560 | (vip-save-string-in-file | ||
| 1561 | nil vip-custom-file-name delete-turn-on-auto-fill-pattern) | ||
| 1562 | (vip-save-string-in-file | ||
| 1563 | nil vip-custom-file-name | ||
| 1564 | ;; del pattern | ||
| 1565 | lisp-cmd-del-pattern) | ||
| 1566 | )) | ||
| 1567 | )) | ||
| 1568 | |||
| 1569 | (message (format "%s %s %s" set-cmd var (if (string-match "^[ \t]*$" val) | ||
| 1570 | (format "%S" val) | ||
| 1571 | val))) | ||
| 1572 | (eval (car (read-from-string actual-lisp-cmd))) | ||
| 1573 | (if (string= var "fill-column") | ||
| 1574 | (if (> val2 0) | ||
| 1575 | (auto-fill-mode 1) | ||
| 1576 | (auto-fill-mode -1))) | ||
| 1577 | |||
| 1578 | )) | ||
| 1579 | |||
| 1580 | ;; In inline args, skip regex-forw and (optionally) chars-back. | ||
| 1581 | ;; Optional 3d arg is a string that should replace ' ' to prevent its | ||
| 1582 | ;; special meaning | ||
| 1583 | (defun ex-get-inline-cmd-args (regex-forw &optional chars-back replace-str) | ||
| 1584 | (save-excursion | ||
| 1585 | (set-buffer vip-ex-work-buf) | ||
| 1586 | (goto-char (point-min)) | ||
| 1587 | (re-search-forward regex-forw nil t) | ||
| 1588 | (let ((beg (point)) | ||
| 1589 | end) | ||
| 1590 | (goto-char (point-max)) | ||
| 1591 | (if chars-back | ||
| 1592 | (skip-chars-backward chars-back) | ||
| 1593 | (skip-chars-backward " \t\n\C-m")) | ||
| 1594 | (setq end (point)) | ||
| 1595 | ;; replace SPC with `=' to suppress the special meaning SPC has | ||
| 1596 | ;; in Ex commands | ||
| 1597 | (goto-char beg) | ||
| 1598 | (if replace-str | ||
| 1599 | (while (re-search-forward " +" nil t) | ||
| 1600 | (replace-match replace-str nil t) | ||
| 1601 | (vip-forward-char-carefully))) | ||
| 1602 | (goto-char end) | ||
| 1603 | (buffer-substring beg end)))) | ||
| 1604 | |||
| 1605 | |||
| 1606 | (defun ex-shell () | ||
| 1607 | "Ex shell command." | ||
| 1608 | (shell)) | ||
| 1609 | |||
| 1610 | (defun ex-help () | ||
| 1611 | "Viper help. Invokes Info." | ||
| 1612 | (condition-case nil | ||
| 1613 | (progn | ||
| 1614 | (pop-to-buffer (get-buffer-create "*info*")) | ||
| 1615 | (info vip-info-file-name) | ||
| 1616 | (message "Type `i' to search for a specific topic")) | ||
| 1617 | (error (beep 1) | ||
| 1618 | (with-output-to-temp-buffer " *vip-info*" | ||
| 1619 | (princ "The Info file for Viper does not seem to be installed. | ||
| 1620 | |||
| 1621 | This file is part of the distribution of Viper. If you do not | ||
| 1622 | have the full distribution, please obtain it from the `anonymous' | ||
| 1623 | FTP account at `archive.cis.ohio-state.edu': | ||
| 1624 | |||
| 1625 | /pub/gnu/emacs/elisp-archive/modes/viper.shar | ||
| 1626 | |||
| 1627 | The Info files for Viper should be installed as <name>, <name>-1, etc., | ||
| 1628 | where <name> is the value of `vip-info-file-name'."))))) | ||
| 1629 | |||
| 1630 | (defun ex-source () | ||
| 1631 | "Ex source command. Loads the file specified as argument or `~/.vip'." | ||
| 1632 | (vip-get-ex-file) | ||
| 1633 | (if (string= ex-file "") | ||
| 1634 | (load vip-custom-file-name) | ||
| 1635 | (load ex-file))) | ||
| 1636 | |||
| 1637 | (defun ex-substitute (&optional repeat r-flag) | ||
| 1638 | "Ex substitute command. | ||
| 1639 | If REPEAT use previous regexp which is ex-reg-exp or vip-s-string" | ||
| 1640 | (let ((opt-g nil) | ||
| 1641 | (opt-c nil) | ||
| 1642 | (matched-pos nil) | ||
| 1643 | (case-fold-search vip-case-fold-search) | ||
| 1644 | delim pat repl) | ||
| 1645 | (if repeat (setq ex-token nil) (setq delim (vip-get-ex-pat))) | ||
| 1646 | (if (null ex-token) | ||
| 1647 | (setq pat (if r-flag vip-s-string ex-reg-exp) | ||
| 1648 | repl ex-repl | ||
| 1649 | delim (string-to-char pat)) | ||
| 1650 | (setq pat (if (string= ex-token "") vip-s-string ex-token)) | ||
| 1651 | (setq vip-s-string pat | ||
| 1652 | ex-reg-exp pat) | ||
| 1653 | (setq delim (vip-get-ex-pat)) | ||
| 1654 | (if (null ex-token) | ||
| 1655 | (setq ex-token "" | ||
| 1656 | ex-repl "") | ||
| 1657 | (setq repl ex-token | ||
| 1658 | ex-repl ex-token))) | ||
| 1659 | (while (vip-get-ex-opt-gc delim) | ||
| 1660 | (if (string= ex-token "g") (setq opt-g t) (setq opt-c t))) | ||
| 1661 | (vip-get-ex-count) | ||
| 1662 | (if ex-count | ||
| 1663 | (save-excursion | ||
| 1664 | (if ex-addresses (goto-char (car ex-addresses))) | ||
| 1665 | (set-mark (point)) | ||
| 1666 | (forward-line (1- ex-count)) | ||
| 1667 | (setq ex-addresses (cons (point) (cons (mark t) nil)))) | ||
| 1668 | (if (null ex-addresses) | ||
| 1669 | (setq ex-addresses (cons (point) (cons (point) nil))) | ||
| 1670 | (if (null (cdr ex-addresses)) | ||
| 1671 | (setq ex-addresses (cons (car ex-addresses) ex-addresses))))) | ||
| 1672 | ;(setq G opt-g) | ||
| 1673 | (let ((beg (car ex-addresses)) | ||
| 1674 | (end (car (cdr ex-addresses))) | ||
| 1675 | eol-mark) | ||
| 1676 | (save-excursion | ||
| 1677 | (vip-enlarge-region beg end) | ||
| 1678 | (let ((limit (save-excursion | ||
| 1679 | (goto-char (max (point) (mark t))) | ||
| 1680 | (point-marker)))) | ||
| 1681 | (goto-char (min (point) (mark t))) | ||
| 1682 | (while (< (point) limit) | ||
| 1683 | (end-of-line) | ||
| 1684 | (setq eol-mark (point-marker)) | ||
| 1685 | (beginning-of-line) | ||
| 1686 | (if opt-g | ||
| 1687 | (progn | ||
| 1688 | (while (and (not (eolp)) | ||
| 1689 | (re-search-forward pat eol-mark t)) | ||
| 1690 | (if (or (not opt-c) (y-or-n-p "Replace? ")) | ||
| 1691 | (progn | ||
| 1692 | (setq matched-pos (point)) | ||
| 1693 | (if (not (stringp repl)) | ||
| 1694 | (error "Can't perform Ex substitution: No previous replacement pattern")) | ||
| 1695 | (replace-match repl t t)))) | ||
| 1696 | (end-of-line) | ||
| 1697 | (vip-forward-char-carefully)) | ||
| 1698 | (if (null pat) | ||
| 1699 | (error | ||
| 1700 | "Can't repeat Ex substitution: No previous regular expression")) | ||
| 1701 | (if (and (re-search-forward pat eol-mark t) | ||
| 1702 | (or (not opt-c) (y-or-n-p "Replace? "))) | ||
| 1703 | (progn | ||
| 1704 | (setq matched-pos (point)) | ||
| 1705 | (if (not (stringp repl)) | ||
| 1706 | (error "Can't perform Ex substitution: No previous replacement pattern")) | ||
| 1707 | (replace-match repl t t))) | ||
| 1708 | (end-of-line) | ||
| 1709 | (vip-forward-char-carefully)))))) | ||
| 1710 | (if matched-pos (goto-char matched-pos)) | ||
| 1711 | (beginning-of-line) | ||
| 1712 | (if opt-c (message "done")))) | ||
| 1713 | |||
| 1714 | (defun ex-tag () | ||
| 1715 | "Ex tag command." | ||
| 1716 | (let (tag) | ||
| 1717 | (save-window-excursion | ||
| 1718 | (set-buffer vip-ex-work-buf) | ||
| 1719 | (skip-chars-forward " \t") | ||
| 1720 | (set-mark (point)) | ||
| 1721 | (skip-chars-forward "^ |\t\n") | ||
| 1722 | (setq tag (buffer-substring (mark t) (point)))) | ||
| 1723 | (if (not (string= tag "")) (setq ex-tag tag)) | ||
| 1724 | (vip-change-state-to-emacs) | ||
| 1725 | (condition-case conds | ||
| 1726 | (progn | ||
| 1727 | (if (string= tag "") | ||
| 1728 | (find-tag ex-tag t) | ||
| 1729 | (find-tag-other-window ex-tag)) | ||
| 1730 | (vip-change-state-to-vi)) | ||
| 1731 | (error | ||
| 1732 | (vip-change-state-to-vi) | ||
| 1733 | (vip-message-conditions conds))))) | ||
| 1734 | |||
| 1735 | (defun ex-write (q-flag) | ||
| 1736 | "Ex write command." | ||
| 1737 | (vip-default-ex-addresses t) | ||
| 1738 | (vip-get-ex-file) | ||
| 1739 | (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses))) | ||
| 1740 | temp-buf writing-same-file region | ||
| 1741 | file-exists writing-whole-file) | ||
| 1742 | (if (> beg end) (error vip-FirstAddrExceedsSecond)) | ||
| 1743 | (if ex-cmdfile | ||
| 1744 | (progn | ||
| 1745 | (vip-enlarge-region beg end) | ||
| 1746 | (shell-command-on-region (point) (mark t) ex-file)) | ||
| 1747 | (if (and (string= ex-file "") (not (buffer-file-name))) | ||
| 1748 | (setq ex-file | ||
| 1749 | (read-file-name | ||
| 1750 | (format "Buffer %s isn't visiting any file. File to save in: " | ||
| 1751 | (buffer-name))))) | ||
| 1752 | |||
| 1753 | (setq writing-whole-file (and (= (point-min) beg) (= (point-max) end)) | ||
| 1754 | ex-file (if (string= ex-file "") | ||
| 1755 | (buffer-file-name) | ||
| 1756 | (expand-file-name ex-file)) | ||
| 1757 | file-exists (file-exists-p ex-file) | ||
| 1758 | writing-same-file (string= ex-file (buffer-file-name))) | ||
| 1759 | (if (and writing-whole-file writing-same-file) | ||
| 1760 | (if (not (buffer-modified-p)) | ||
| 1761 | (message "(No changes need to be saved)") | ||
| 1762 | (save-buffer) | ||
| 1763 | (ex-write-info file-exists ex-file beg end)) | ||
| 1764 | ;; writing some other file or portion of the currents | ||
| 1765 | ;; file---create temp buffer for it | ||
| 1766 | ;; disable undo in that buffer, for efficiency | ||
| 1767 | (buffer-disable-undo (setq temp-buf (create-file-buffer ex-file))) | ||
| 1768 | (unwind-protect | ||
| 1769 | (save-excursion | ||
| 1770 | (if (and file-exists | ||
| 1771 | (not writing-same-file) | ||
| 1772 | (not (yes-or-no-p | ||
| 1773 | (format "File %s exists. Overwrite? " ex-file)))) | ||
| 1774 | (error "Quit") | ||
| 1775 | (vip-enlarge-region beg end) | ||
| 1776 | (setq region (buffer-substring (point) (mark t))) | ||
| 1777 | (set-buffer temp-buf) | ||
| 1778 | (set-visited-file-name ex-file) | ||
| 1779 | (erase-buffer) | ||
| 1780 | (if (and file-exists ex-append) | ||
| 1781 | (insert-file-contents ex-file)) | ||
| 1782 | (goto-char (point-max)) | ||
| 1783 | (insert region) | ||
| 1784 | (save-buffer) | ||
| 1785 | (ex-write-info file-exists ex-file (point-min) (point-max)) | ||
| 1786 | ) | ||
| 1787 | (set-buffer temp-buf) | ||
| 1788 | (set-buffer-modified-p nil) | ||
| 1789 | (kill-buffer temp-buf) | ||
| 1790 | ) | ||
| 1791 | )) | ||
| 1792 | ;; this prevents the loss of data if writing part of the buffer | ||
| 1793 | (if (and (buffer-file-name) writing-same-file) | ||
| 1794 | (set-visited-file-modtime)) | ||
| 1795 | (or writing-whole-file | ||
| 1796 | (not writing-same-file) | ||
| 1797 | (set-buffer-modified-p t)) | ||
| 1798 | (if q-flag | ||
| 1799 | (if (< vip-expert-level 2) | ||
| 1800 | (save-buffers-kill-emacs) | ||
| 1801 | (kill-buffer (current-buffer)))) | ||
| 1802 | ))) | ||
| 1803 | |||
| 1804 | |||
| 1805 | (defun ex-write-info (exists file-name beg end) | ||
| 1806 | (message "`%s'%s %d lines, %d characters" | ||
| 1807 | (abbreviate-file-name file-name) | ||
| 1808 | (if exists "" " [New file]") | ||
| 1809 | (count-lines beg (min (1+ end) (point-max))) | ||
| 1810 | (- end beg))) | ||
| 1811 | |||
| 1812 | (defun ex-yank () | ||
| 1813 | "Ex yank command." | ||
| 1814 | (vip-default-ex-addresses) | ||
| 1815 | (vip-get-ex-buffer) | ||
| 1816 | (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses)))) | ||
| 1817 | (if (> beg end) (error vip-FirstAddrExceedsSecond)) | ||
| 1818 | (save-excursion | ||
| 1819 | (vip-enlarge-region beg end) | ||
| 1820 | (exchange-point-and-mark) | ||
| 1821 | (if (or ex-g-flag ex-g-variant) | ||
| 1822 | (error "Can't execute `yank' within `global'")) | ||
| 1823 | (if ex-count | ||
| 1824 | (progn | ||
| 1825 | (set-mark (point)) | ||
| 1826 | (forward-line (1- ex-count))) | ||
| 1827 | (set-mark end)) | ||
| 1828 | (vip-enlarge-region (point) (mark t)) | ||
| 1829 | (if ex-flag (error "`yank': %s" vip-SpuriousText)) | ||
| 1830 | (if ex-buffer | ||
| 1831 | (cond ((vip-valid-register ex-buffer '(Letter)) | ||
| 1832 | (vip-append-to-register | ||
| 1833 | (downcase ex-buffer) (point) (mark t))) | ||
| 1834 | ((vip-valid-register ex-buffer) | ||
| 1835 | (copy-to-register ex-buffer (point) (mark t) nil)) | ||
| 1836 | (t (error vip-InvalidRegister ex-buffer)))) | ||
| 1837 | (copy-region-as-kill (point) (mark t))))) | ||
| 1838 | |||
| 1839 | (defun ex-command () | ||
| 1840 | "Execute shell command." | ||
| 1841 | (let (command) | ||
| 1842 | (save-window-excursion | ||
| 1843 | (set-buffer vip-ex-work-buf) | ||
| 1844 | (skip-chars-forward " \t") | ||
| 1845 | (setq command (buffer-substring (point) (point-max))) | ||
| 1846 | (end-of-line)) | ||
| 1847 | (setq command (ex-expand-filsyms command (current-buffer))) | ||
| 1848 | (if (and (> (length command) 0) (string= "!" (substring command 0 1))) | ||
| 1849 | (if vip-ex-last-shell-com | ||
| 1850 | (setq command (concat vip-ex-last-shell-com (substring command 1))) | ||
| 1851 | (error "No previous shell command"))) | ||
| 1852 | (setq vip-ex-last-shell-com command) | ||
| 1853 | (if (null ex-addresses) | ||
| 1854 | (shell-command command) | ||
| 1855 | (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses)))) | ||
| 1856 | (if (null beg) (setq beg end)) | ||
| 1857 | (save-excursion | ||
| 1858 | (goto-char beg) | ||
| 1859 | (set-mark end) | ||
| 1860 | (vip-enlarge-region (point) (mark t)) | ||
| 1861 | (shell-command-on-region (point) (mark t) command t)) | ||
| 1862 | (goto-char beg))))) | ||
| 1863 | |||
| 1864 | (defun ex-line-no () | ||
| 1865 | "Print line number." | ||
| 1866 | (message "%d" | ||
| 1867 | (1+ (count-lines | ||
| 1868 | (point-min) | ||
| 1869 | (if (null ex-addresses) (point-max) (car ex-addresses)))))) | ||
| 1870 | |||
| 1871 | (defun vip-info-on-file () | ||
| 1872 | "Give information on the file visited by the current buffer." | ||
| 1873 | (interactive) | ||
| 1874 | (message "%s: pos=%d(%d) line=%d(%d) col=%d %s" | ||
| 1875 | (if (buffer-file-name) | ||
| 1876 | (abbreviate-file-name (buffer-file-name)) | ||
| 1877 | "[No visited file]") | ||
| 1878 | (point) (1- (point-max)) | ||
| 1879 | (count-lines (point-min) (vip-line-pos 'end)) | ||
| 1880 | (count-lines (point-min) (point-max)) | ||
| 1881 | (1+ (current-column)) | ||
| 1882 | (if (buffer-modified-p) "[Modified]" "[Unchanged]") | ||
| 1883 | )) | ||
| 1884 | |||
| 1885 | |||
| 1886 | (provide 'viper-ex) | ||
| 1887 | |||
| 1888 | ;;; viper-ex.el ends here | ||
diff --git a/lisp/emulation/viper-keym.el b/lisp/emulation/viper-keym.el new file mode 100644 index 00000000000..eb23130c44a --- /dev/null +++ b/lisp/emulation/viper-keym.el | |||
| @@ -0,0 +1,525 @@ | |||
| 1 | ;;; viper-keym.el -- Main Viper keymaps | ||
| 2 | |||
| 3 | ;; This file is part of GNU Emacs. | ||
| 4 | |||
| 5 | ;; GNU Emacs is free software; you can redistribute it and/or modify | ||
| 6 | ;; it under the terms of the GNU General Public License as published by | ||
| 7 | ;; the Free Software Foundation; either version 2, or (at your option) | ||
| 8 | ;; any later version. | ||
| 9 | |||
| 10 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 11 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 12 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 13 | ;; GNU General Public License for more details. | ||
| 14 | |||
| 15 | ;; You should have received a copy of the GNU General Public License | ||
| 16 | ;; along with GNU Emacs; see the file COPYING. If not, write to | ||
| 17 | ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | ||
| 18 | |||
| 19 | |||
| 20 | (require 'viper-util) | ||
| 21 | |||
| 22 | ;;; Variables | ||
| 23 | |||
| 24 | ;;; Keymaps | ||
| 25 | |||
| 26 | ;; Keymaps for vital things like \e and C-z. | ||
| 27 | ;; Not for users | ||
| 28 | (defvar vip-vi-intercept-map (make-sparse-keymap)) | ||
| 29 | (defvar vip-insert-intercept-map (make-sparse-keymap)) | ||
| 30 | (defvar vip-emacs-intercept-map (make-sparse-keymap)) | ||
| 31 | |||
| 32 | (vip-deflocalvar vip-vi-local-user-map (make-sparse-keymap) | ||
| 33 | "Keymap for user-defined local bindings. | ||
| 34 | Useful for changing bindings such as ZZ in certain major modes. | ||
| 35 | For instance, in letter-mode, one may want to bind ZZ to | ||
| 36 | mh-send-letter. In a newsreader such as gnus, tin, or rn, ZZ could be bound | ||
| 37 | to save-buffers-kill-emacs then post article, etc.") | ||
| 38 | (put 'vip-vi-local-user-map 'permanent-local t) | ||
| 39 | |||
| 40 | (defvar vip-vi-global-user-map (make-sparse-keymap) | ||
| 41 | "Keymap for user-defined global bindings. | ||
| 42 | These bindings are seen in all Viper buffers.") | ||
| 43 | |||
| 44 | (defvar vip-vi-basic-map (make-keymap) | ||
| 45 | "This is the main keymap in effect in Viper's Vi state. | ||
| 46 | This map is global, shared by all buffers.") | ||
| 47 | |||
| 48 | (defvar vip-vi-kbd-map (make-sparse-keymap) | ||
| 49 | "This keymap keeps keyboard macros defined via the :map command.") | ||
| 50 | |||
| 51 | (defvar vip-vi-diehard-map (make-sparse-keymap) | ||
| 52 | "This keymap is in use when the user asks Viper to simulate Vi very closely. | ||
| 53 | This happens when vip-expert-level is 1 or 2. See vip-set-expert-level.") | ||
| 54 | |||
| 55 | |||
| 56 | (vip-deflocalvar vip-insert-local-user-map (make-sparse-keymap) | ||
| 57 | "Auxiliary map for per-buffer user-defined keybindings in Insert state.") | ||
| 58 | (put 'vip-insert-local-user-map 'permanent-local t) | ||
| 59 | |||
| 60 | (defvar vip-insert-global-user-map (make-sparse-keymap) | ||
| 61 | "Auxiliary map for global user-defined bindings in Insert state.") | ||
| 62 | |||
| 63 | (defvar vip-insert-basic-map (make-sparse-keymap) | ||
| 64 | "The basic insert-mode keymap.") | ||
| 65 | |||
| 66 | (defvar vip-insert-diehard-map (make-keymap) | ||
| 67 | "Map used when user wants vi-style keys in insert mode. | ||
| 68 | Most of the Emacs keys are suppressed. This map overshadows | ||
| 69 | vip-insert-basic-map. Not recommended, except for novice users.") | ||
| 70 | |||
| 71 | (defvar vip-insert-kbd-map (make-sparse-keymap) | ||
| 72 | "This keymap keeps VI-style kbd macros for insert mode.") | ||
| 73 | |||
| 74 | (defvar vip-replace-map (make-sparse-keymap) | ||
| 75 | "Map used in Viper's replace state.") | ||
| 76 | |||
| 77 | (defvar vip-emacs-global-user-map (make-sparse-keymap) | ||
| 78 | "Auxiliary map for global user-defined bindings in Emacs state.") | ||
| 79 | |||
| 80 | (defvar vip-emacs-kbd-map (make-sparse-keymap) | ||
| 81 | "This keymap keeps Vi-style kbd macros for emacs mode.") | ||
| 82 | |||
| 83 | (vip-deflocalvar vip-emacs-local-user-map (make-sparse-keymap) | ||
| 84 | "Auxiliary map for local user-defined bindings in Emacs state.") | ||
| 85 | (put 'vip-emacs-local-user-map 'permanent-local t) | ||
| 86 | |||
| 87 | ;; This keymap should stay empty | ||
| 88 | (defvar vip-empty-keymap (make-sparse-keymap)) | ||
| 89 | |||
| 90 | |||
| 91 | ;;; Variables used by minor modes | ||
| 92 | |||
| 93 | ;; Association list of the form | ||
| 94 | ;; ((major-mode . keymap) (major-mode . keymap) ...) | ||
| 95 | ;; Viper uses these keymaps to make user-requested adjustments | ||
| 96 | ;; to its Vi state in various major modes.") | ||
| 97 | (defvar vip-vi-state-modifier-alist nil) | ||
| 98 | |||
| 99 | ;; Association list of the form | ||
| 100 | ;; ((major-mode . keymap) (major-mode . keymap) ...) | ||
| 101 | ;; Viper uses these keymaps to make user-requested adjustments | ||
| 102 | ;; to its Insert state in various major modes.") | ||
| 103 | (defvar vip-insert-state-modifier-alist nil) | ||
| 104 | |||
| 105 | ;; Association list of the form | ||
| 106 | ;; ((major-mode . keymap) (major-mode . keymap) ...) | ||
| 107 | ;; Viper uses these keymaps to make user-requested adjustments | ||
| 108 | ;; to its Emacs state in various major modes. | ||
| 109 | (defvar vip-emacs-state-modifier-alist nil) | ||
| 110 | |||
| 111 | ;; Tells vip-add-local-keys to create a new vip-vi-local-user-map for new | ||
| 112 | ;; buffers. Not a user option. | ||
| 113 | (vip-deflocalvar vip-need-new-vi-local-map t "") | ||
| 114 | (put 'vip-need-new-vi-local-map 'permanent-local t) | ||
| 115 | |||
| 116 | ;; Tells vip-add-local-keys to create a new vip-insert-local-user-map for new | ||
| 117 | ;; buffers. Not a user option. | ||
| 118 | (vip-deflocalvar vip-need-new-insert-local-map t "") | ||
| 119 | (put 'vip-need-new-insert-local-map 'permanent-local t) | ||
| 120 | |||
| 121 | ;; Tells vip-add-local-keys to create a new vip-emacs-local-user-map for new | ||
| 122 | ;; buffers. Not a user option. | ||
| 123 | (vip-deflocalvar vip-need-new-emacs-local-map t "") | ||
| 124 | (put 'vip-need-new-emacs-local-map 'permanent-local t) | ||
| 125 | |||
| 126 | |||
| 127 | |||
| 128 | ;; Insert mode keymap | ||
| 129 | |||
| 130 | ;; for novice users, pretend you are the real vi. | ||
| 131 | (define-key vip-insert-diehard-map "\t" 'vip-insert-tab) | ||
| 132 | (define-key vip-insert-diehard-map "\C-a" 'self-insert-command) | ||
| 133 | (define-key vip-insert-diehard-map "\C-b" 'self-insert-command) | ||
| 134 | (define-key vip-insert-diehard-map "\C-c" 'vip-change-state-to-vi) | ||
| 135 | (define-key vip-insert-diehard-map "\C-e" 'self-insert-command) | ||
| 136 | (define-key vip-insert-diehard-map "\C-f" 'self-insert-command) | ||
| 137 | (define-key vip-insert-diehard-map "\C-g" 'self-insert-command) | ||
| 138 | (define-key vip-insert-diehard-map "\C-i" 'self-insert-command) | ||
| 139 | (define-key vip-insert-diehard-map "\C-k" 'self-insert-command) | ||
| 140 | (define-key vip-insert-diehard-map "\C-l" 'self-insert-command) | ||
| 141 | (define-key vip-insert-diehard-map "\C-n" 'self-insert-command) | ||
| 142 | (define-key vip-insert-diehard-map "\C-o" 'self-insert-command) | ||
| 143 | (define-key vip-insert-diehard-map "\C-p" 'self-insert-command) | ||
| 144 | (define-key vip-insert-diehard-map "\C-q" 'self-insert-command) | ||
| 145 | (define-key vip-insert-diehard-map "\C-r" 'self-insert-command) | ||
| 146 | (define-key vip-insert-diehard-map "\C-s" 'self-insert-command) | ||
| 147 | (define-key vip-insert-diehard-map "\C-u" 'vip-erase-line) | ||
| 148 | (define-key vip-insert-diehard-map "\C-x" 'self-insert-command) | ||
| 149 | (define-key vip-insert-diehard-map "\C-y" 'self-insert-command) | ||
| 150 | (define-key vip-insert-diehard-map "\C-z" 'self-insert-command) | ||
| 151 | (define-key vip-insert-diehard-map "\C-]" 'self-insert-command) | ||
| 152 | (define-key vip-insert-diehard-map "\C-_" 'self-insert-command) | ||
| 153 | |||
| 154 | (let ((i ?\ )) | ||
| 155 | (while (<= i ?~) | ||
| 156 | (define-key vip-insert-diehard-map (make-string 1 i) 'self-insert-command) | ||
| 157 | (setq i (1+ i)))) | ||
| 158 | |||
| 159 | ;; Insert mode map when user wants emacs style | ||
| 160 | (define-key vip-insert-basic-map "\C-d" 'vip-backward-indent) | ||
| 161 | (define-key vip-insert-basic-map "\C-w" 'vip-delete-backward-word) | ||
| 162 | (define-key vip-insert-basic-map "\C-t" 'vip-forward-indent) | ||
| 163 | (define-key vip-insert-basic-map | ||
| 164 | (if vip-xemacs-p [(shift tab)] [S-tab]) 'vip-insert-tab) | ||
| 165 | (define-key vip-insert-basic-map "\C-v" 'quoted-insert) | ||
| 166 | (define-key vip-insert-basic-map "\C-?" 'vip-del-backward-char-in-insert) | ||
| 167 | (define-key vip-insert-basic-map "\C-c\M-p" | ||
| 168 | 'vip-insert-prev-from-insertion-ring) | ||
| 169 | (define-key vip-insert-basic-map "\C-c\M-n" | ||
| 170 | 'vip-insert-next-from-insertion-ring) | ||
| 171 | |||
| 172 | |||
| 173 | ;; Replace keymap | ||
| 174 | (define-key vip-replace-map "\C-t" 'vip-forward-indent) | ||
| 175 | (define-key vip-replace-map "\C-j" 'vip-replace-state-exit-cmd) | ||
| 176 | (define-key vip-replace-map "\C-m" 'vip-replace-state-exit-cmd) | ||
| 177 | (define-key vip-replace-map "\C-?" 'vip-del-backward-char-in-replace) | ||
| 178 | |||
| 179 | |||
| 180 | |||
| 181 | ;; Vi keymaps | ||
| 182 | |||
| 183 | (define-key vip-vi-basic-map "\C-^" | ||
| 184 | (function (lambda () (interactive) (vip-ex "e#")))) | ||
| 185 | (define-key vip-vi-basic-map "\C-b" 'vip-scroll-back) | ||
| 186 | (define-key vip-vi-basic-map "\C-d" 'vip-scroll-up) | ||
| 187 | (define-key vip-vi-basic-map "\C-e" 'vip-scroll-up-one) | ||
| 188 | (define-key vip-vi-basic-map "\C-f" 'vip-scroll) | ||
| 189 | (define-key vip-vi-basic-map "\C-m" 'vip-next-line-at-bol) | ||
| 190 | (define-key vip-vi-basic-map "\C-u" 'vip-scroll-down) | ||
| 191 | (define-key vip-vi-basic-map "\C-y" 'vip-scroll-down-one) | ||
| 192 | (define-key vip-vi-basic-map "\C-s" 'vip-isearch-forward) | ||
| 193 | (define-key vip-vi-basic-map "\C-r" 'vip-isearch-backward) | ||
| 194 | ;(define-key vip-vi-basic-map "\C-\\" 'universal-argument) | ||
| 195 | (define-key vip-vi-basic-map "\C-c/" 'vip-toggle-search-style) | ||
| 196 | (define-key vip-vi-basic-map "\C-cg" 'vip-info-on-file) | ||
| 197 | |||
| 198 | (define-key vip-vi-basic-map "\C-c\M-p" 'vip-prev-destructive-command) | ||
| 199 | (define-key vip-vi-basic-map "\C-c\M-n" 'vip-next-destructive-command) | ||
| 200 | |||
| 201 | |||
| 202 | (define-key vip-vi-basic-map " " 'vip-forward-char) | ||
| 203 | (define-key vip-vi-basic-map "!" 'vip-command-argument) | ||
| 204 | (define-key vip-vi-basic-map "\"" 'vip-command-argument) | ||
| 205 | (define-key vip-vi-basic-map "#" 'vip-command-argument) | ||
| 206 | (define-key vip-vi-basic-map "$" 'vip-goto-eol) | ||
| 207 | (define-key vip-vi-basic-map "%" 'vip-paren-match) | ||
| 208 | (define-key vip-vi-basic-map "&" | ||
| 209 | (function (lambda () (interactive) (vip-ex "&")))) | ||
| 210 | (define-key vip-vi-basic-map "'" 'vip-goto-mark-and-skip-white) | ||
| 211 | (define-key vip-vi-basic-map "(" 'vip-backward-sentence) | ||
| 212 | (define-key vip-vi-basic-map ")" 'vip-forward-sentence) | ||
| 213 | (define-key vip-vi-basic-map "*" 'call-last-kbd-macro) | ||
| 214 | (define-key vip-vi-basic-map "+" 'vip-next-line-at-bol) | ||
| 215 | (define-key vip-vi-basic-map "," 'vip-repeat-find-opposite) | ||
| 216 | (define-key vip-vi-basic-map "-" 'vip-previous-line-at-bol) | ||
| 217 | (define-key vip-vi-basic-map "." 'vip-repeat) | ||
| 218 | (define-key vip-vi-basic-map "/" 'vip-search-forward) | ||
| 219 | |||
| 220 | (define-key vip-vi-basic-map "0" 'vip-beginning-of-line) | ||
| 221 | (define-key vip-vi-basic-map "1" 'vip-digit-argument) | ||
| 222 | (define-key vip-vi-basic-map "2" 'vip-digit-argument) | ||
| 223 | (define-key vip-vi-basic-map "3" 'vip-digit-argument) | ||
| 224 | (define-key vip-vi-basic-map "4" 'vip-digit-argument) | ||
| 225 | (define-key vip-vi-basic-map "5" 'vip-digit-argument) | ||
| 226 | (define-key vip-vi-basic-map "6" 'vip-digit-argument) | ||
| 227 | (define-key vip-vi-basic-map "7" 'vip-digit-argument) | ||
| 228 | (define-key vip-vi-basic-map "8" 'vip-digit-argument) | ||
| 229 | (define-key vip-vi-basic-map "9" 'vip-digit-argument) | ||
| 230 | |||
| 231 | (define-key vip-vi-basic-map ":" 'vip-ex) | ||
| 232 | (define-key vip-vi-basic-map ";" 'vip-repeat-find) | ||
| 233 | (define-key vip-vi-basic-map "<" 'vip-command-argument) | ||
| 234 | (define-key vip-vi-basic-map "=" 'vip-command-argument) | ||
| 235 | (define-key vip-vi-basic-map ">" 'vip-command-argument) | ||
| 236 | (define-key vip-vi-basic-map "?" 'vip-search-backward) | ||
| 237 | (define-key vip-vi-basic-map "@" 'vip-register-macro) | ||
| 238 | |||
| 239 | (define-key vip-vi-basic-map "A" 'vip-Append) | ||
| 240 | (define-key vip-vi-basic-map "B" 'vip-backward-Word) | ||
| 241 | (define-key vip-vi-basic-map "C" 'vip-change-to-eol) | ||
| 242 | (define-key vip-vi-basic-map "D" 'vip-kill-line) | ||
| 243 | (define-key vip-vi-basic-map "E" 'vip-end-of-Word) | ||
| 244 | (define-key vip-vi-basic-map "F" 'vip-find-char-backward) | ||
| 245 | (define-key vip-vi-basic-map "G" 'vip-goto-line) | ||
| 246 | (define-key vip-vi-basic-map "H" 'vip-window-top) | ||
| 247 | (define-key vip-vi-basic-map "I" 'vip-Insert) | ||
| 248 | (define-key vip-vi-basic-map "J" 'vip-join-lines) | ||
| 249 | (define-key vip-vi-basic-map "K" 'vip-nil) | ||
| 250 | (define-key vip-vi-basic-map "L" 'vip-window-bottom) | ||
| 251 | (define-key vip-vi-basic-map "M" 'vip-window-middle) | ||
| 252 | (define-key vip-vi-basic-map "N" 'vip-search-Next) | ||
| 253 | (define-key vip-vi-basic-map "O" 'vip-Open-line) | ||
| 254 | (define-key vip-vi-basic-map "P" 'vip-Put-back) | ||
| 255 | (define-key vip-vi-basic-map "Q" 'vip-query-replace) | ||
| 256 | (define-key vip-vi-basic-map "R" 'vip-overwrite) | ||
| 257 | (define-key vip-vi-basic-map "S" 'vip-substitute-line) | ||
| 258 | (define-key vip-vi-basic-map "T" 'vip-goto-char-backward) | ||
| 259 | (define-key vip-vi-basic-map "U" 'vip-undo) | ||
| 260 | (define-key vip-vi-basic-map "V" 'find-file-other-window) | ||
| 261 | (define-key vip-vi-basic-map "W" 'vip-forward-Word) | ||
| 262 | (define-key vip-vi-basic-map "X" 'vip-delete-backward-char) | ||
| 263 | (define-key vip-vi-basic-map "Y" 'vip-yank-line) | ||
| 264 | (define-key vip-vi-basic-map "ZZ" 'vip-save-kill-buffer) | ||
| 265 | |||
| 266 | (define-key vip-vi-basic-map "\\" 'vip-escape-to-emacs) | ||
| 267 | (define-key vip-vi-basic-map "[" 'vip-brac-function) | ||
| 268 | (define-key vip-vi-basic-map "]" 'vip-ket-function) | ||
| 269 | (define-key vip-vi-basic-map "_" 'vip-alternate-ESC) | ||
| 270 | (define-key vip-vi-basic-map "^" 'vip-bol-and-skip-white) | ||
| 271 | (define-key vip-vi-basic-map "`" 'vip-goto-mark) | ||
| 272 | |||
| 273 | (define-key vip-vi-basic-map "a" 'vip-append) | ||
| 274 | (define-key vip-vi-basic-map "b" 'vip-backward-word) | ||
| 275 | (define-key vip-vi-basic-map "c" 'vip-command-argument) | ||
| 276 | (define-key vip-vi-basic-map "d" 'vip-command-argument) | ||
| 277 | (define-key vip-vi-basic-map "e" 'vip-end-of-word) | ||
| 278 | (define-key vip-vi-basic-map "f" 'vip-find-char-forward) | ||
| 279 | (define-key vip-vi-basic-map "g" 'vip-nil) | ||
| 280 | (define-key vip-vi-basic-map "h" 'vip-backward-char) | ||
| 281 | (define-key vip-vi-basic-map "i" 'vip-insert) | ||
| 282 | (define-key vip-vi-basic-map "j" 'vip-next-line) | ||
| 283 | (define-key vip-vi-basic-map "k" 'vip-previous-line) | ||
| 284 | (define-key vip-vi-basic-map "l" 'vip-forward-char) | ||
| 285 | (define-key vip-vi-basic-map "m" 'vip-mark-point) | ||
| 286 | (define-key vip-vi-basic-map "n" 'vip-search-next) | ||
| 287 | (define-key vip-vi-basic-map "o" 'vip-open-line) | ||
| 288 | (define-key vip-vi-basic-map "p" 'vip-put-back) | ||
| 289 | (define-key vip-vi-basic-map "q" 'vip-nil) | ||
| 290 | (define-key vip-vi-basic-map "r" 'vip-replace-char) | ||
| 291 | (define-key vip-vi-basic-map "s" 'vip-substitute) | ||
| 292 | (define-key vip-vi-basic-map "t" 'vip-goto-char-forward) | ||
| 293 | (define-key vip-vi-basic-map "u" 'vip-undo) | ||
| 294 | (define-key vip-vi-basic-map "v" 'find-file) | ||
| 295 | (define-key vip-vi-basic-map "\C-v" 'vip-find-file-other-frame) | ||
| 296 | (define-key vip-vi-basic-map "w" 'vip-forward-word) | ||
| 297 | (define-key vip-vi-basic-map "x" 'vip-delete-char) | ||
| 298 | (define-key vip-vi-basic-map "y" 'vip-command-argument) | ||
| 299 | (define-key vip-vi-basic-map "zH" 'vip-line-to-top) | ||
| 300 | (define-key vip-vi-basic-map "zM" 'vip-line-to-middle) | ||
| 301 | (define-key vip-vi-basic-map "zL" 'vip-line-to-bottom) | ||
| 302 | (define-key vip-vi-basic-map "z\C-m" 'vip-line-to-top) | ||
| 303 | (define-key vip-vi-basic-map "z." 'vip-line-to-middle) | ||
| 304 | (define-key vip-vi-basic-map "z-" 'vip-line-to-bottom) | ||
| 305 | |||
| 306 | (define-key vip-vi-basic-map "{" 'vip-backward-paragraph) | ||
| 307 | (define-key vip-vi-basic-map "|" 'vip-goto-col) | ||
| 308 | (define-key vip-vi-basic-map "}" 'vip-forward-paragraph) | ||
| 309 | (define-key vip-vi-basic-map "~" 'vip-toggle-case) | ||
| 310 | (define-key vip-vi-basic-map "\C-?" 'vip-backward-char) | ||
| 311 | |||
| 312 | ;;; Escape from Emacs to Vi for one command | ||
| 313 | (global-set-key "\M-\C-z" 'vip-escape-to-vi) ;; in emacs-state | ||
| 314 | |||
| 315 | ;;; This is vip-vi-diehard-map. Used when vip-vi-diehard-minor-mode is on. | ||
| 316 | |||
| 317 | (define-key vip-vi-diehard-map "\C-a" 'vip-nil) | ||
| 318 | (define-key vip-vi-diehard-map "\C-c" 'vip-nil) | ||
| 319 | (define-key vip-vi-diehard-map "\C-g" 'vip-info-on-file) | ||
| 320 | (define-key vip-vi-diehard-map "\C-i" 'vip-nil) | ||
| 321 | (define-key vip-vi-diehard-map "\C-k" 'vip-nil) | ||
| 322 | (define-key vip-vi-diehard-map "\C-l" 'redraw-display) | ||
| 323 | (define-key vip-vi-diehard-map "\C-n" 'vip-next-line) | ||
| 324 | (define-key vip-vi-diehard-map "\C-o" 'vip-nil) | ||
| 325 | (define-key vip-vi-diehard-map "\C-p" 'vip-previous-line) | ||
| 326 | (define-key vip-vi-diehard-map "\C-q" 'vip-nil) | ||
| 327 | (define-key vip-vi-diehard-map "\C-r" 'redraw-display) | ||
| 328 | (define-key vip-vi-diehard-map "\C-s" 'vip-nil) | ||
| 329 | (define-key vip-vi-diehard-map "\C-t" 'vip-nil) | ||
| 330 | (define-key vip-vi-diehard-map "\C-v" 'vip-nil) | ||
| 331 | (define-key vip-vi-diehard-map "\C-w" 'vip-nil) | ||
| 332 | (define-key vip-vi-diehard-map "@" 'vip-nil) | ||
| 333 | (define-key vip-vi-diehard-map "*" 'vip-nil) | ||
| 334 | (define-key vip-vi-diehard-map "#" 'vip-nil) | ||
| 335 | (define-key vip-vi-diehard-map "\C-_" 'vip-nil) | ||
| 336 | (define-key vip-vi-diehard-map "\C-]" 'vip-nil);; This is actually tags. | ||
| 337 | |||
| 338 | |||
| 339 | ;;; Minibuffer keymap | ||
| 340 | |||
| 341 | |||
| 342 | (defvar vip-minibuffer-map (make-sparse-keymap) | ||
| 343 | "Keymap used to modify keys when Minibuffer is in Insert state.") | ||
| 344 | |||
| 345 | (define-key vip-minibuffer-map "\C-m" 'vip-exit-minibuffer) | ||
| 346 | (define-key vip-minibuffer-map "\C-j" 'vip-exit-minibuffer) | ||
| 347 | |||
| 348 | ;; Map used to read Ex-style commands. | ||
| 349 | (defvar vip-ex-cmd-map (make-sparse-keymap)) | ||
| 350 | (define-key vip-ex-cmd-map " " 'ex-cmd-read-exit) | ||
| 351 | (define-key vip-ex-cmd-map "\t" 'ex-cmd-complete) | ||
| 352 | |||
| 353 | ;; Keymap for reading file names in Ex-style commands. | ||
| 354 | (defvar ex-read-filename-map (make-sparse-keymap)) | ||
| 355 | (define-key ex-read-filename-map " " 'vip-complete-filename-or-exit) | ||
| 356 | |||
| 357 | |||
| 358 | |||
| 359 | |||
| 360 | ;;; Code | ||
| 361 | |||
| 362 | (defun vip-add-local-keys (state alist) | ||
| 363 | "Override some vi-state or insert-state bindings in the current buffer. | ||
| 364 | The effect is seen in the current buffer only. | ||
| 365 | Useful for customizing mailer buffers, gnus, etc. | ||
| 366 | STATE is 'vi-state, 'insert-state, or 'emacs-state | ||
| 367 | ALIST is of the form ((key . func) (key . func) ...) | ||
| 368 | Normally, this would be called from a hook to a major mode or | ||
| 369 | on a per buffer basis. | ||
| 370 | Usage: | ||
| 371 | (vip-add-local-keys state '((key-str . func) (key-str . func)...)) " | ||
| 372 | |||
| 373 | (let (map) | ||
| 374 | (cond ((eq state 'vi-state) | ||
| 375 | (if vip-need-new-vi-local-map | ||
| 376 | (setq vip-vi-local-user-map (make-sparse-keymap))) | ||
| 377 | (setq vip-need-new-vi-local-map nil | ||
| 378 | map vip-vi-local-user-map)) | ||
| 379 | ((eq state 'insert-state) | ||
| 380 | (if vip-need-new-insert-local-map | ||
| 381 | (setq vip-insert-local-user-map (make-sparse-keymap))) | ||
| 382 | (setq vip-need-new-insert-local-map nil | ||
| 383 | map vip-insert-local-user-map)) | ||
| 384 | ((eq state 'emacs-state) | ||
| 385 | (if vip-need-new-emacs-local-map | ||
| 386 | (setq vip-emacs-local-user-map (make-sparse-keymap))) | ||
| 387 | (setq vip-need-new-emacs-local-map nil | ||
| 388 | map vip-emacs-local-user-map)) | ||
| 389 | (t | ||
| 390 | (error | ||
| 391 | "Invalid state in vip-add-local-keys: %S. Valid states: vi-state, insert-state or emacs-state" state))) | ||
| 392 | |||
| 393 | (vip-modify-keymap map alist) | ||
| 394 | (vip-normalize-minor-mode-map-alist) | ||
| 395 | (vip-set-mode-vars-for vip-current-state))) | ||
| 396 | |||
| 397 | |||
| 398 | (defun vip-modify-major-mode (mode state keymap) | ||
| 399 | "Modify key bindings in a major-mode in a Viper state using a keymap. | ||
| 400 | |||
| 401 | If the default for a major mode is emacs-state, then modifications to this | ||
| 402 | major mode may not take effect until the buffer switches state to Vi, | ||
| 403 | Insert or Emacs. If this happens, add vip-change-state-to-emacs to this | ||
| 404 | major mode's hook. If no such hook exists, you may have to put an advice on | ||
| 405 | the function that invokes the major mode. See vip-set-hooks for hints. | ||
| 406 | |||
| 407 | The above needs not to be done for major modes that come up in Vi or Insert | ||
| 408 | state by default. | ||
| 409 | |||
| 410 | Arguments: (major-mode vip-state keymap)" | ||
| 411 | (let ((alist | ||
| 412 | (cond ((eq state 'vi-state) 'vip-vi-state-modifier-alist) | ||
| 413 | ((eq state 'insert-state) 'vip-insert-state-modifier-alist) | ||
| 414 | ((eq state 'emacs-state) 'vip-emacs-state-modifier-alist))) | ||
| 415 | elt) | ||
| 416 | (if (setq elt (assoc mode (eval alist))) | ||
| 417 | (set alist (delq elt (eval alist)))) | ||
| 418 | (set alist (cons (cons mode keymap) (eval alist))) | ||
| 419 | |||
| 420 | ;; Normalization usually doesn't help here, since one needs to | ||
| 421 | ;; normalize in the actual buffer where changes to the keymap are | ||
| 422 | ;; to take place. However, it doesn't hurt, and it helps whenever this | ||
| 423 | ;; function is actually called from within the right buffer. | ||
| 424 | (vip-normalize-minor-mode-map-alist) | ||
| 425 | |||
| 426 | (vip-set-mode-vars-for vip-current-state))) | ||
| 427 | |||
| 428 | |||
| 429 | (defun vip-debug-keymaps () | ||
| 430 | "Displays variables that control Viper's keymaps." | ||
| 431 | (interactive) | ||
| 432 | (with-output-to-temp-buffer " *vip-debug*" | ||
| 433 | (princ (format "Buffer name: %s\n\n" (buffer-name))) | ||
| 434 | (princ "Variables: \n") | ||
| 435 | (princ (format "major-mode: %S\n" major-mode)) | ||
| 436 | (princ (format "vip-current-state: %S\n" vip-current-state)) | ||
| 437 | (princ (format "vip-mode-string: %S\n\n" vip-mode-string)) | ||
| 438 | (princ (format "vip-vi-intercept-minor-mode: %S\n" | ||
| 439 | vip-vi-intercept-minor-mode)) | ||
| 440 | (princ (format "vip-insert-intercept-minor-mode: %S\n" | ||
| 441 | vip-insert-intercept-minor-mode)) | ||
| 442 | (princ (format "vip-emacs-intercept-minor-mode: %S\n" | ||
| 443 | vip-emacs-intercept-minor-mode)) | ||
| 444 | (princ (format "vip-vi-minibuffer-minor-mode: %S\n" | ||
| 445 | vip-vi-minibuffer-minor-mode)) | ||
| 446 | (princ (format "vip-insert-minibuffer-minor-mode: %S\n\n" | ||
| 447 | vip-insert-minibuffer-minor-mode)) | ||
| 448 | (princ (format "vip-vi-local-user-minor-mode: %S\n" | ||
| 449 | vip-vi-local-user-minor-mode)) | ||
| 450 | (princ (format "vip-vi-global-user-minor-mode: %S\n" | ||
| 451 | vip-vi-global-user-minor-mode)) | ||
| 452 | (princ (format "vip-vi-kbd-minor-mode: %S\n" vip-vi-kbd-minor-mode)) | ||
| 453 | (princ (format "vip-vi-state-modifier-minor-mode: %S\n" | ||
| 454 | vip-vi-state-modifier-minor-mode)) | ||
| 455 | (princ (format "vip-vi-diehard-minor-mode: %S\n" | ||
| 456 | vip-vi-diehard-minor-mode)) | ||
| 457 | (princ (format "vip-vi-basic-minor-mode: %S\n" vip-vi-basic-minor-mode)) | ||
| 458 | (princ (format "vip-replace-minor-mode: %S\n" vip-replace-minor-mode)) | ||
| 459 | (princ (format "vip-insert-local-user-minor-mode: %S\n" | ||
| 460 | vip-insert-local-user-minor-mode)) | ||
| 461 | (princ (format "vip-insert-global-user-minor-mode: %S\n" | ||
| 462 | vip-insert-global-user-minor-mode)) | ||
| 463 | (princ (format "vip-insert-kbd-minor-mode: %S\n" | ||
| 464 | vip-insert-kbd-minor-mode)) | ||
| 465 | (princ (format "vip-insert-state-modifier-minor-mode: %S\n" | ||
| 466 | vip-insert-state-modifier-minor-mode)) | ||
| 467 | (princ (format "vip-insert-diehard-minor-mode: %S\n" | ||
| 468 | vip-insert-diehard-minor-mode)) | ||
| 469 | (princ (format "vip-insert-basic-minor-mode: %S\n" | ||
| 470 | vip-insert-basic-minor-mode)) | ||
| 471 | (princ (format "vip-emacs-local-user-minor-mode: %S\n" | ||
| 472 | vip-emacs-local-user-minor-mode)) | ||
| 473 | (princ (format "vip-emacs-kbd-minor-mode: %S\n" | ||
| 474 | vip-emacs-kbd-minor-mode)) | ||
| 475 | (princ (format "vip-emacs-global-user-minor-mode: %S\n" | ||
| 476 | vip-emacs-global-user-minor-mode)) | ||
| 477 | (princ (format "vip-emacs-state-modifier-minor-mode: %S\n" | ||
| 478 | vip-emacs-state-modifier-minor-mode)) | ||
| 479 | |||
| 480 | (princ (format "\nvip-expert-level %S\n" vip-expert-level)) | ||
| 481 | (princ (format "vip-no-multiple-ESC %S\n" vip-no-multiple-ESC)) | ||
| 482 | (princ (format "vip-always %S\n" vip-always)) | ||
| 483 | (princ (format "vip-ex-style-motion %S\n" | ||
| 484 | vip-ex-style-motion)) | ||
| 485 | (princ (format "vip-ex-style-editing-in-insert %S\n" | ||
| 486 | vip-ex-style-editing-in-insert)) | ||
| 487 | (princ (format "vip-want-emacs-keys-in-vi %S\n" | ||
| 488 | vip-want-emacs-keys-in-vi)) | ||
| 489 | (princ (format "vip-want-emacs-keys-in-insert %S\n" | ||
| 490 | vip-want-emacs-keys-in-insert)) | ||
| 491 | (princ (format "vip-want-ctl-h-help %S\n" vip-want-ctl-h-help)) | ||
| 492 | |||
| 493 | (princ "\n\n\n") | ||
| 494 | (princ (format "Default value for minor-mode-map-alist: \n%S\n\n" | ||
| 495 | (default-value 'minor-mode-map-alist))) | ||
| 496 | (princ (format "Actual value for minor-mode-map-alist: \n%S\n" | ||
| 497 | minor-mode-map-alist)) | ||
| 498 | )) | ||
| 499 | |||
| 500 | |||
| 501 | ;;; Keymap utils | ||
| 502 | |||
| 503 | (defun vip-add-keymap (mapsrc mapdst) | ||
| 504 | "Add contents of mapsrc to mapdst. It is assumed that mapsrc is sparse." | ||
| 505 | (if vip-xemacs-p | ||
| 506 | (map-keymap (function (lambda (key binding) | ||
| 507 | (define-key mapdst key binding))) | ||
| 508 | mapsrc) | ||
| 509 | (mapcar | ||
| 510 | (function (lambda (p) | ||
| 511 | (define-key mapdst (vector (car p)) (cdr p)) | ||
| 512 | )) | ||
| 513 | (cdr mapsrc)))) | ||
| 514 | |||
| 515 | (defun vip-modify-keymap (map alist) | ||
| 516 | "Modifies MAP with bindings specified in the ALIST. The alist has the | ||
| 517 | form ((key . function) (key . function) ... )." | ||
| 518 | (mapcar (function (lambda (p) | ||
| 519 | (define-key map (eval (car p)) (cdr p)))) | ||
| 520 | alist)) | ||
| 521 | |||
| 522 | |||
| 523 | (provide 'viper-keym) | ||
| 524 | |||
| 525 | ;;; viper-keym.el ends here | ||
diff --git a/lisp/emulation/viper-macs.el b/lisp/emulation/viper-macs.el new file mode 100644 index 00000000000..289cfd9d0a3 --- /dev/null +++ b/lisp/emulation/viper-macs.el | |||
| @@ -0,0 +1,902 @@ | |||
| 1 | ;;; viper-macs.el -- functions implementing keyboard macros for Viper | ||
| 2 | |||
| 3 | ;; This file is part of GNU Emacs. | ||
| 4 | |||
| 5 | ;; GNU Emacs is free software; you can redistribute it and/or modify | ||
| 6 | ;; it under the terms of the GNU General Public License as published by | ||
| 7 | ;; the Free Software Foundation; either version 2, or (at your option) | ||
| 8 | ;; any later version. | ||
| 9 | |||
| 10 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 11 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 12 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 13 | ;; GNU General Public License for more details. | ||
| 14 | |||
| 15 | ;; You should have received a copy of the GNU General Public License | ||
| 16 | ;; along with GNU Emacs; see the file COPYING. If not, write to | ||
| 17 | ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | ||
| 18 | |||
| 19 | |||
| 20 | (require 'viper-util) | ||
| 21 | |||
| 22 | ;;; Variables | ||
| 23 | |||
| 24 | ;; Register holding last macro. | ||
| 25 | (defvar vip-last-macro-reg nil) | ||
| 26 | |||
| 27 | ;; format of the elements of kbd alists: | ||
| 28 | ;; (name ((buf . macr)...(buf . macr)) ((maj-mode . macr)...) (t . macr)) | ||
| 29 | ;; kbd macro alist for Vi state | ||
| 30 | (defvar vip-vi-kbd-macro-alist nil) | ||
| 31 | ;; same for insert/replace state | ||
| 32 | (defvar vip-insert-kbd-macro-alist nil) | ||
| 33 | ;; same for emacs state | ||
| 34 | (defvar vip-emacs-kbd-macro-alist nil) | ||
| 35 | |||
| 36 | ;; Internal var that passes info between start-kbd-macro and end-kbd-macro | ||
| 37 | ;; in :map and :map! | ||
| 38 | (defvar vip-kbd-macro-parameters nil) | ||
| 39 | |||
| 40 | (defvar vip-this-kbd-macro nil | ||
| 41 | "Vector of keys representing the name of currently running Viper kbd macro.") | ||
| 42 | (defvar vip-last-kbd-macro nil | ||
| 43 | "Vector of keys representing the name of last Viper keyboard macro.") | ||
| 44 | |||
| 45 | (defconst vip-fast-keyseq-timeout 200 | ||
| 46 | "*Key sequences separated by this many miliseconds are interpreted as a macro, if such a macro is defined. | ||
| 47 | This also controls ESC-keysequences generated by keyboard function keys.") | ||
| 48 | |||
| 49 | |||
| 50 | (defvar vip-repeat-from-history-key 'f1 | ||
| 51 | "Prefix key for invocation of vip-repeat-from-history function, | ||
| 52 | which repeats previous destructive commands from the history of such | ||
| 53 | commands. | ||
| 54 | This function can then be invoked as <this-key> 1 or <this-key> 2. | ||
| 55 | The notation for these keys is borrowed from XEmacs. Basically, | ||
| 56 | a key is a symbol, e.g., `a', `\\1', `f2', etc., or a list, e.g., | ||
| 57 | `(meta control f1)'.") | ||
| 58 | |||
| 59 | |||
| 60 | |||
| 61 | ;;; Code | ||
| 62 | |||
| 63 | (defun ex-map () | ||
| 64 | "Ex map command." | ||
| 65 | (let ((mod-char "") | ||
| 66 | macro-name macro-body map-args ins) | ||
| 67 | (save-window-excursion | ||
| 68 | (set-buffer vip-ex-work-buf) | ||
| 69 | (if (looking-at "!") | ||
| 70 | (progn | ||
| 71 | (setq ins t | ||
| 72 | mod-char "!") | ||
| 73 | (forward-char 1)))) | ||
| 74 | (setq map-args (ex-map-read-args mod-char) | ||
| 75 | macro-name (car map-args) | ||
| 76 | macro-body (cdr map-args)) | ||
| 77 | (setq vip-kbd-macro-parameters (list ins mod-char macro-name macro-body)) | ||
| 78 | (if macro-body | ||
| 79 | (vip-end-mapping-kbd-macro 'ignore) | ||
| 80 | (ex-fixup-history (format "map%s %S" mod-char | ||
| 81 | (vip-display-macro macro-name))) | ||
| 82 | ;; if defining macro for insert, switch there for authentic WYSIWYG | ||
| 83 | (if ins (vip-change-state-to-insert)) | ||
| 84 | (start-kbd-macro nil) | ||
| 85 | (define-key vip-vi-intercept-map "\C-x)" 'vip-end-mapping-kbd-macro) | ||
| 86 | (define-key vip-insert-intercept-map "\C-x)" 'vip-end-mapping-kbd-macro) | ||
| 87 | (define-key vip-emacs-intercept-map "\C-x)" 'vip-end-mapping-kbd-macro) | ||
| 88 | (message "Mapping %S in %s state. Hit `C-x )' to complete the mapping" | ||
| 89 | (vip-display-macro macro-name) | ||
| 90 | (if ins "Insert" "Vi"))) | ||
| 91 | )) | ||
| 92 | |||
| 93 | |||
| 94 | (defun ex-unmap () | ||
| 95 | "Ex unmap." | ||
| 96 | (let ((mod-char "") | ||
| 97 | temp macro-name ins) | ||
| 98 | (save-window-excursion | ||
| 99 | (set-buffer vip-ex-work-buf) | ||
| 100 | (if (looking-at "!") | ||
| 101 | (progn | ||
| 102 | (setq ins t | ||
| 103 | mod-char "!") | ||
| 104 | (forward-char 1)))) | ||
| 105 | |||
| 106 | (setq macro-name (ex-unmap-read-args mod-char)) | ||
| 107 | (setq temp (vip-fixup-macro (vconcat macro-name))) ;; copy and fixup | ||
| 108 | (ex-fixup-history (format "unmap%s %S" mod-char | ||
| 109 | (vip-display-macro temp))) | ||
| 110 | (vip-unrecord-kbd-macro macro-name (if ins 'insert-state 'vi-state)) | ||
| 111 | )) | ||
| 112 | |||
| 113 | |||
| 114 | ;; read arguments for ex-map | ||
| 115 | (defun ex-map-read-args (variant) | ||
| 116 | (let ((cursor-in-echo-area t) | ||
| 117 | (key-seq []) | ||
| 118 | temp key event message | ||
| 119 | macro-name macro-body args) | ||
| 120 | |||
| 121 | (condition-case nil | ||
| 122 | (setq args (concat (ex-get-inline-cmd-args ".*map[!]*[ \t]?" "\n\C-m") | ||
| 123 | " nil nil ") | ||
| 124 | temp (read-from-string args) | ||
| 125 | macro-name (car temp) | ||
| 126 | macro-body (car (read-from-string args (cdr temp)))) | ||
| 127 | (error | ||
| 128 | (signal | ||
| 129 | 'error | ||
| 130 | '("map: Macro name and body must be a quoted string or a vector")))) | ||
| 131 | |||
| 132 | ;; We expect macro-name to be a vector, a string, or a quoted string. | ||
| 133 | ;; In the second case, it will emerge as a symbol when read from | ||
| 134 | ;; the above read-from-string. So we need to convert it into a string | ||
| 135 | (if macro-name | ||
| 136 | (cond ((vectorp macro-name) nil) | ||
| 137 | ((stringp macro-name) | ||
| 138 | (setq macro-name (vconcat macro-name))) | ||
| 139 | (t (setq macro-name (vconcat (prin1-to-string macro-name))))) | ||
| 140 | (message ":map%s <Name>" variant)(sit-for 2) | ||
| 141 | (while | ||
| 142 | (not (member key | ||
| 143 | '(?\C-m ?\n (control m) (control j) return linefeed))) | ||
| 144 | (setq key-seq (vconcat key-seq (if key (vector key) []))) | ||
| 145 | ;; the only keys available for editing are these-- no help while there | ||
| 146 | (if (member | ||
| 147 | key | ||
| 148 | '(?\b ?\d '^? '^H (control h) (control \?) backspace delete)) | ||
| 149 | (setq key-seq (subseq key-seq 0 (- (length key-seq) 2)))) | ||
| 150 | (setq message | ||
| 151 | (format ":map%s %s" | ||
| 152 | variant (if (> (length key-seq) 0) | ||
| 153 | (prin1-to-string (vip-display-macro key-seq)) | ||
| 154 | ""))) | ||
| 155 | (message message) | ||
| 156 | (setq event (vip-read-event)) | ||
| 157 | (setq key | ||
| 158 | (if (vip-mouse-event-p event) | ||
| 159 | (progn | ||
| 160 | (message "%s (No mouse---only keyboard keys, please)" | ||
| 161 | message) | ||
| 162 | (sit-for 2) | ||
| 163 | nil) | ||
| 164 | (vip-event-key event))) | ||
| 165 | ) | ||
| 166 | (setq macro-name key-seq)) | ||
| 167 | |||
| 168 | (if (= (length macro-name) 0) | ||
| 169 | (error "Can't map an empty macro name")) | ||
| 170 | (setq macro-name (vip-fixup-macro macro-name)) | ||
| 171 | (if (vip-char-array-p macro-name) | ||
| 172 | (setq macro-name (vip-char-array-to-macro macro-name))) | ||
| 173 | |||
| 174 | (if macro-body | ||
| 175 | (cond ((vip-char-array-p macro-body) | ||
| 176 | (setq macro-body (vip-char-array-to-macro macro-body))) | ||
| 177 | ((vectorp macro-body) nil) | ||
| 178 | (t (error "map: Invalid syntax in macro definition")))) | ||
| 179 | (cons macro-name macro-body) | ||
| 180 | )) | ||
| 181 | |||
| 182 | |||
| 183 | |||
| 184 | ;; read arguments for ex-unmap | ||
| 185 | (defun ex-unmap-read-args (variant) | ||
| 186 | (let ((cursor-in-echo-area t) | ||
| 187 | (macro-alist (if (string= variant "!") | ||
| 188 | vip-insert-kbd-macro-alist | ||
| 189 | vip-vi-kbd-macro-alist)) | ||
| 190 | ;; these are disabled just in case, to avoid surprises when doing | ||
| 191 | ;; completing-read | ||
| 192 | vip-vi-kbd-minor-mode vip-insert-kbd-minor-mode | ||
| 193 | vip-emacs-kbd-minor-mode | ||
| 194 | vip-vi-intercept-minor-mode vip-insert-intercept-minor-mode | ||
| 195 | vip-emacs-intercept-minor-mode | ||
| 196 | event message | ||
| 197 | key key-seq macro-name) | ||
| 198 | (setq macro-name (ex-get-inline-cmd-args ".*unma?p?[!]*[ \t]*")) | ||
| 199 | |||
| 200 | (if (> (length macro-name) 0) | ||
| 201 | () | ||
| 202 | (message ":unmap%s <Name>" variant) (sit-for 2) | ||
| 203 | (while | ||
| 204 | (not | ||
| 205 | (member key '(?\C-m ?\n (control m) (control j) return linefeed))) | ||
| 206 | (setq key-seq (vconcat key-seq (if key (vector key) []))) | ||
| 207 | ;; the only keys available for editing are these-- no help while there | ||
| 208 | (cond ((member | ||
| 209 | key | ||
| 210 | '(?\b ?\d '^? '^H (control h) (control \?) backspace delete)) | ||
| 211 | (setq key-seq (subseq key-seq 0 (- (length key-seq) 2)))) | ||
| 212 | ((member key '(tab (control i) ?\t)) | ||
| 213 | (setq key-seq (subseq key-seq 0 (1- (length key-seq)))) | ||
| 214 | (setq message | ||
| 215 | (format ":unmap%s %s" | ||
| 216 | variant (if (> (length key-seq) 0) | ||
| 217 | (prin1-to-string | ||
| 218 | (vip-display-macro key-seq)) | ||
| 219 | ""))) | ||
| 220 | (setq key-seq | ||
| 221 | (vip-do-sequence-completion key-seq macro-alist message)) | ||
| 222 | )) | ||
| 223 | (setq message | ||
| 224 | (format ":unmap%s %s" | ||
| 225 | variant (if (> (length key-seq) 0) | ||
| 226 | (prin1-to-string | ||
| 227 | (vip-display-macro key-seq)) | ||
| 228 | ""))) | ||
| 229 | (message message) | ||
| 230 | (setq event (vip-read-event)) | ||
| 231 | (setq key | ||
| 232 | (if (vip-mouse-event-p event) | ||
| 233 | (progn | ||
| 234 | (message "%s (No mouse---only keyboard keys, please)" | ||
| 235 | message) | ||
| 236 | (sit-for 2) | ||
| 237 | nil) | ||
| 238 | (vip-event-key event))) | ||
| 239 | ) | ||
| 240 | (setq macro-name key-seq)) | ||
| 241 | |||
| 242 | (if (= (length macro-name) 0) | ||
| 243 | (error "Can't unmap an empty macro name")) | ||
| 244 | |||
| 245 | ;; convert macro names into vector, if starts with a `[' | ||
| 246 | (if (memq (elt macro-name 0) '(?\[ ?\")) | ||
| 247 | (car (read-from-string macro-name)) | ||
| 248 | (vconcat macro-name)) | ||
| 249 | )) | ||
| 250 | |||
| 251 | |||
| 252 | |||
| 253 | (defun vip-end-mapping-kbd-macro (&optional ignore) | ||
| 254 | "Terminate kbd macro." | ||
| 255 | (interactive) | ||
| 256 | (define-key vip-vi-intercept-map "\C-x)" nil) | ||
| 257 | (define-key vip-insert-intercept-map "\C-x)" nil) | ||
| 258 | (define-key vip-emacs-intercept-map "\C-x)" nil) | ||
| 259 | (if (and (not ignore) | ||
| 260 | (or (not vip-kbd-macro-parameters) | ||
| 261 | (not defining-kbd-macro))) | ||
| 262 | (error "Not mapping a kbd-macro")) | ||
| 263 | (let ((mod-char (nth 1 vip-kbd-macro-parameters)) | ||
| 264 | (ins (nth 0 vip-kbd-macro-parameters)) | ||
| 265 | (macro-name (nth 2 vip-kbd-macro-parameters)) | ||
| 266 | (macro-body (nth 3 vip-kbd-macro-parameters))) | ||
| 267 | (setq vip-kbd-macro-parameters nil) | ||
| 268 | (or ignore | ||
| 269 | (progn | ||
| 270 | (end-kbd-macro nil) | ||
| 271 | (setq macro-body (vip-events-to-macro last-kbd-macro)) | ||
| 272 | ;; always go back to Vi, since this is where we started | ||
| 273 | ;; defining macro | ||
| 274 | (vip-change-state-to-vi))) | ||
| 275 | |||
| 276 | (vip-record-kbd-macro macro-name | ||
| 277 | (if ins 'insert-state 'vi-state) | ||
| 278 | (vip-display-macro macro-body)) | ||
| 279 | |||
| 280 | (ex-fixup-history (format "map%s %S %S" mod-char | ||
| 281 | (vip-display-macro macro-name) | ||
| 282 | (vip-display-macro macro-body))) | ||
| 283 | )) | ||
| 284 | |||
| 285 | |||
| 286 | |||
| 287 | (defadvice start-kbd-macro (after vip-kbd-advice activate) | ||
| 288 | "Remove Viper's intercepting bindings for C-x ). | ||
| 289 | This may be needed if the previous `:map' command terminated abnormally." | ||
| 290 | (define-key vip-vi-intercept-map "\C-x)" nil) | ||
| 291 | (define-key vip-insert-intercept-map "\C-x)" nil) | ||
| 292 | (define-key vip-emacs-intercept-map "\C-x)" nil)) | ||
| 293 | |||
| 294 | |||
| 295 | |||
| 296 | ;;; Recording, unrecording, executing | ||
| 297 | |||
| 298 | ;; accepts as macro names: strings and vectors. | ||
| 299 | ;; strings must be strings of characters; vectors must be vectors of keys | ||
| 300 | ;; in canonic form. the canonic form is essentially the form used in XEmacs | ||
| 301 | (defun vip-record-kbd-macro (macro-name state macro-body &optional scope) | ||
| 302 | "Record a Vi macro. Can be used in `.vip' file to define permanent macros. | ||
| 303 | MACRO-NAME is a string of characters or a vector of keys. STATE is | ||
| 304 | either `vi-state' or `insert-state'. It specifies the Viper state in which to | ||
| 305 | define the macro. MACRO-BODY is a string that represents the keyboard macro. | ||
| 306 | Optional SCOPE says whether the macro should be global \(t\), mode-specific | ||
| 307 | \(a major-mode symbol\), or buffer-specific \(buffer name, a string\). | ||
| 308 | If SCOPE is nil, the user is asked to specify the scope." | ||
| 309 | (let* (state-name keymap | ||
| 310 | (macro-alist-var | ||
| 311 | (cond ((eq state 'vi-state) | ||
| 312 | (setq state-name "Vi state" | ||
| 313 | keymap vip-vi-kbd-map) | ||
| 314 | 'vip-vi-kbd-macro-alist) | ||
| 315 | ((memq state '(insert-state replace-state)) | ||
| 316 | (setq state-name "Insert state" | ||
| 317 | keymap vip-insert-kbd-map) | ||
| 318 | 'vip-insert-kbd-macro-alist) | ||
| 319 | (t | ||
| 320 | (setq state-name "Emacs state" | ||
| 321 | keymap vip-emacs-kbd-map) | ||
| 322 | 'vip-emacs-kbd-macro-alist) | ||
| 323 | )) | ||
| 324 | new-elt old-elt old-sub-elt msg | ||
| 325 | temp lis lis2) | ||
| 326 | |||
| 327 | (if (= (length macro-name) 0) | ||
| 328 | (error "Can't map an empty macro name")) | ||
| 329 | |||
| 330 | ;; Macro-name is usually a vector. However, command history or macros | ||
| 331 | ;; recorded in ~/.vip may be recorded as strings. So, convert to vectors. | ||
| 332 | (setq macro-name (vip-fixup-macro macro-name)) | ||
| 333 | (if (vip-char-array-p macro-name) | ||
| 334 | (setq macro-name (vip-char-array-to-macro macro-name))) | ||
| 335 | (setq macro-body (vip-fixup-macro macro-body)) | ||
| 336 | (if (vip-char-array-p macro-body) | ||
| 337 | (setq macro-body (vip-char-array-to-macro macro-body))) | ||
| 338 | |||
| 339 | ;; don't ask if scope is given and is of the right type | ||
| 340 | (or (eq scope t) | ||
| 341 | (stringp scope) | ||
| 342 | (and scope (symbolp scope)) | ||
| 343 | (progn | ||
| 344 | (setq scope | ||
| 345 | (cond | ||
| 346 | ((y-or-n-p | ||
| 347 | (format | ||
| 348 | "Map this macro for buffer `%s' only? " | ||
| 349 | (buffer-name))) | ||
| 350 | (setq msg | ||
| 351 | (format | ||
| 352 | "%S is mapped to %s for %s in `%s'" | ||
| 353 | (vip-display-macro macro-name) | ||
| 354 | (vip-abbreviate-string | ||
| 355 | (format | ||
| 356 | "%S" | ||
| 357 | (setq temp (vip-display-macro macro-body))) | ||
| 358 | 14 "" "" | ||
| 359 | (if (stringp temp) " ....\"" " ....]")) | ||
| 360 | state-name (buffer-name))) | ||
| 361 | (buffer-name)) | ||
| 362 | ((y-or-n-p | ||
| 363 | (format | ||
| 364 | "Map this macro for the major mode `%S' only? " | ||
| 365 | major-mode)) | ||
| 366 | (setq msg | ||
| 367 | (format | ||
| 368 | "%S is mapped to %s for %s in `%S'" | ||
| 369 | (vip-display-macro macro-name) | ||
| 370 | (vip-abbreviate-string | ||
| 371 | (format | ||
| 372 | "%S" | ||
| 373 | (setq temp (vip-display-macro macro-body))) | ||
| 374 | 14 "" "" | ||
| 375 | (if (stringp macro-body) " ....\"" " ....]")) | ||
| 376 | state-name major-mode)) | ||
| 377 | major-mode) | ||
| 378 | (t | ||
| 379 | (setq msg | ||
| 380 | (format | ||
| 381 | "%S is globally mapped to %s in %s" | ||
| 382 | (vip-display-macro macro-name) | ||
| 383 | (vip-abbreviate-string | ||
| 384 | (format | ||
| 385 | "%S" | ||
| 386 | (setq temp (vip-display-macro macro-body))) | ||
| 387 | 14 "" "" | ||
| 388 | (if (stringp macro-body) " ....\"" " ....]")) | ||
| 389 | state-name)) | ||
| 390 | t))) | ||
| 391 | (if (y-or-n-p (format "Save this macro in %s? " | ||
| 392 | (abbreviate-file-name vip-custom-file-name))) | ||
| 393 | (vip-save-string-in-file | ||
| 394 | (format "\n(vip-record-kbd-macro %S '%S %s '%S)" | ||
| 395 | (vip-display-macro macro-name) | ||
| 396 | state macro-body scope) | ||
| 397 | vip-custom-file-name)) | ||
| 398 | |||
| 399 | (message msg) | ||
| 400 | )) | ||
| 401 | |||
| 402 | (setq new-elt | ||
| 403 | (cons macro-name | ||
| 404 | (cond ((eq scope t) (list nil nil (cons t nil))) | ||
| 405 | ((symbolp scope) | ||
| 406 | (list nil (list (cons scope nil)) (cons t nil))) | ||
| 407 | ((stringp scope) | ||
| 408 | (list (list (cons scope nil)) nil (cons t nil)))))) | ||
| 409 | (setq old-elt (assoc macro-name (eval macro-alist-var))) | ||
| 410 | |||
| 411 | (if (null old-elt) | ||
| 412 | (progn | ||
| 413 | ;; insert new-elt in macro-alist-var and keep the list sorted | ||
| 414 | (define-key | ||
| 415 | keymap | ||
| 416 | (vector (vip-key-to-emacs-key (aref macro-name 0))) | ||
| 417 | 'vip-exec-mapped-kbd-macro) | ||
| 418 | (setq lis (eval macro-alist-var)) | ||
| 419 | (while (and lis (string< (vip-array-to-string (car (car lis))) | ||
| 420 | (vip-array-to-string macro-name))) | ||
| 421 | (setq lis2 (cons (car lis) lis2)) | ||
| 422 | (setq lis (cdr lis))) | ||
| 423 | |||
| 424 | (setq lis2 (reverse lis2)) | ||
| 425 | (set macro-alist-var (append lis2 (cons new-elt lis))) | ||
| 426 | (setq old-elt new-elt))) | ||
| 427 | (setq old-sub-elt | ||
| 428 | (cond ((eq scope t) (vip-kbd-global-pair old-elt)) | ||
| 429 | ((symbolp scope) (assoc scope (vip-kbd-mode-alist old-elt))) | ||
| 430 | ((stringp scope) (assoc scope (vip-kbd-buf-alist old-elt))))) | ||
| 431 | (if old-sub-elt | ||
| 432 | (setcdr old-sub-elt macro-body) | ||
| 433 | (cond ((symbolp scope) (setcar (cdr (cdr old-elt)) | ||
| 434 | (cons (cons scope macro-body) | ||
| 435 | (vip-kbd-mode-alist old-elt)))) | ||
| 436 | ((stringp scope) (setcar (cdr old-elt) | ||
| 437 | (cons (cons scope macro-body) | ||
| 438 | (vip-kbd-buf-alist old-elt)))))) | ||
| 439 | )) | ||
| 440 | |||
| 441 | |||
| 442 | |||
| 443 | ;; macro name must be a vector of vip-style keys | ||
| 444 | (defun vip-unrecord-kbd-macro (macro-name state) | ||
| 445 | (let* (state-name keymap | ||
| 446 | (macro-alist-var | ||
| 447 | (cond ((eq state 'vi-state) | ||
| 448 | (setq state-name "Vi state" | ||
| 449 | keymap vip-vi-kbd-map) | ||
| 450 | 'vip-vi-kbd-macro-alist) | ||
| 451 | ((memq state '(insert-state replace-state)) | ||
| 452 | (setq state-name "Insert state" | ||
| 453 | keymap vip-insert-kbd-map) | ||
| 454 | 'vip-insert-kbd-macro-alist) | ||
| 455 | (t | ||
| 456 | (setq state-name "Emacs state" | ||
| 457 | keymap vip-emacs-kbd-map) | ||
| 458 | 'vip-emacs-kbd-macro-alist) | ||
| 459 | )) | ||
| 460 | buf-mapping mode-mapping global-mapping | ||
| 461 | macro-pair macro-entry) | ||
| 462 | |||
| 463 | ;; Macro-name is usually a vector. However, command history or macros | ||
| 464 | ;; recorded in ~/.vip may appear as strings. So, convert to vectors. | ||
| 465 | (setq macro-name (vip-fixup-macro macro-name)) | ||
| 466 | (if (vip-char-array-p macro-name) | ||
| 467 | (setq macro-name (vip-char-array-to-macro macro-name))) | ||
| 468 | |||
| 469 | (setq macro-entry (assoc macro-name (eval macro-alist-var))) | ||
| 470 | (if (= (length macro-name) 0) | ||
| 471 | (error "Can't unmap an empty macro name")) | ||
| 472 | (if (null macro-entry) | ||
| 473 | (error "%S is not mapped to a macro for %s in `%s'" | ||
| 474 | (vip-display-macro macro-name) | ||
| 475 | state-name (buffer-name))) | ||
| 476 | |||
| 477 | (setq buf-mapping (vip-kbd-buf-pair macro-entry) | ||
| 478 | mode-mapping (vip-kbd-mode-pair macro-entry) | ||
| 479 | global-mapping (vip-kbd-global-pair macro-entry)) | ||
| 480 | |||
| 481 | (cond ((and (cdr buf-mapping) | ||
| 482 | (or (and (not (cdr mode-mapping)) (not (cdr global-mapping))) | ||
| 483 | (y-or-n-p | ||
| 484 | (format "Unmap %S for `%s' only? " | ||
| 485 | (vip-display-macro macro-name) | ||
| 486 | (buffer-name))))) | ||
| 487 | (setq macro-pair buf-mapping) | ||
| 488 | (message "%S is unmapped for %s in `%s'" | ||
| 489 | (vip-display-macro macro-name) | ||
| 490 | state-name (buffer-name))) | ||
| 491 | ((and (cdr mode-mapping) | ||
| 492 | (or (not (cdr global-mapping)) | ||
| 493 | (y-or-n-p | ||
| 494 | (format "Unmap %S for the major mode `%S' only? " | ||
| 495 | (vip-display-macro macro-name) | ||
| 496 | major-mode)))) | ||
| 497 | (setq macro-pair mode-mapping) | ||
| 498 | (message "%S is unmapped for %s in %S" | ||
| 499 | (vip-display-macro macro-name) state-name major-mode)) | ||
| 500 | ((cdr (setq macro-pair (vip-kbd-global-pair macro-entry))) | ||
| 501 | (message | ||
| 502 | "Global mapping of %S for %s is removed" | ||
| 503 | (vip-display-macro macro-name) state-name)) | ||
| 504 | (t (error "%S is not mapped to a macro for %s in `%s'" | ||
| 505 | (vip-display-macro macro-name) | ||
| 506 | state-name (buffer-name)))) | ||
| 507 | (setcdr macro-pair nil) | ||
| 508 | (or (cdr buf-mapping) | ||
| 509 | (cdr mode-mapping) | ||
| 510 | (cdr global-mapping) | ||
| 511 | (progn | ||
| 512 | (set macro-alist-var (delq macro-entry (eval macro-alist-var))) | ||
| 513 | (if (vip-can-release-key (aref macro-name 0) | ||
| 514 | (eval macro-alist-var)) | ||
| 515 | (define-key | ||
| 516 | keymap | ||
| 517 | (vector (vip-key-to-emacs-key (aref macro-name 0))) | ||
| 518 | nil)) | ||
| 519 | )) | ||
| 520 | )) | ||
| 521 | |||
| 522 | ;; Checks if MACRO-ALIST has an entry for a macro name starting with | ||
| 523 | ;; CHAR. If not, this indicates that the binding for this char | ||
| 524 | ;; in vip-vi/insert-kbd-map can be released. | ||
| 525 | (defun vip-can-release-key (char macro-alist) | ||
| 526 | (let ((lis macro-alist) | ||
| 527 | (can-release t) | ||
| 528 | macro-name) | ||
| 529 | |||
| 530 | (while (and lis can-release) | ||
| 531 | (setq macro-name (car (car lis))) | ||
| 532 | (if (eq char (aref macro-name 0)) | ||
| 533 | (setq can-release nil)) | ||
| 534 | (setq lis (cdr lis))) | ||
| 535 | can-release)) | ||
| 536 | |||
| 537 | |||
| 538 | (defun vip-exec-mapped-kbd-macro (count) | ||
| 539 | "Dispatch kbd macro." | ||
| 540 | (interactive "P") | ||
| 541 | (let* ((macro-alist (cond ((eq vip-current-state 'vi-state) | ||
| 542 | vip-vi-kbd-macro-alist) | ||
| 543 | ((memq vip-current-state | ||
| 544 | '(insert-state replace-state)) | ||
| 545 | vip-insert-kbd-macro-alist) | ||
| 546 | (t | ||
| 547 | vip-emacs-kbd-macro-alist))) | ||
| 548 | (unmatched-suffix "") | ||
| 549 | ;; Macros and keys are executed with other macros turned off | ||
| 550 | ;; For macros, this is done to avoid macro recursion | ||
| 551 | vip-vi-kbd-minor-mode vip-insert-kbd-minor-mode | ||
| 552 | vip-emacs-kbd-minor-mode | ||
| 553 | next-best-match keyseq event-seq | ||
| 554 | macro-first-char macro-alist-elt macro-body | ||
| 555 | command) | ||
| 556 | |||
| 557 | (setq macro-first-char last-command-event | ||
| 558 | event-seq (vip-read-fast-keysequence macro-first-char macro-alist) | ||
| 559 | keyseq (vip-events-to-macro event-seq) | ||
| 560 | macro-alist-elt (assoc keyseq macro-alist) | ||
| 561 | next-best-match (vip-find-best-matching-macro macro-alist keyseq)) | ||
| 562 | |||
| 563 | (if (null macro-alist-elt) | ||
| 564 | (setq macro-alist-elt (car next-best-match) | ||
| 565 | unmatched-suffix (subseq event-seq (cdr next-best-match)))) | ||
| 566 | |||
| 567 | (cond ((null macro-alist-elt)) | ||
| 568 | ((setq macro-body (vip-kbd-buf-definition macro-alist-elt))) | ||
| 569 | ((setq macro-body (vip-kbd-mode-definition macro-alist-elt))) | ||
| 570 | ((setq macro-body (vip-kbd-global-definition macro-alist-elt)))) | ||
| 571 | |||
| 572 | ;; when defining keyboard macro, don't use the macro mappings | ||
| 573 | (if (and macro-body (not defining-kbd-macro)) | ||
| 574 | ;; block cmd executed as part of a macro from entering command history | ||
| 575 | (let ((command-history command-history)) | ||
| 576 | (setq vip-this-kbd-macro (car macro-alist-elt)) | ||
| 577 | (execute-kbd-macro (vip-macro-to-events macro-body) count) | ||
| 578 | (setq vip-this-kbd-macro nil | ||
| 579 | vip-last-kbd-macro (car macro-alist-elt)) | ||
| 580 | (vip-set-unread-command-events unmatched-suffix)) | ||
| 581 | ;; If not a macro, or the macro is suppressed while defining another | ||
| 582 | ;; macro, put keyseq back on the event queue | ||
| 583 | (vip-set-unread-command-events event-seq) | ||
| 584 | ;; if the user typed arg, then use it if prefix arg is not set by | ||
| 585 | ;; some other command (setting prefix arg can happen if we do, say, | ||
| 586 | ;; 2dw and there is a macro starting with 2. Then control will go to | ||
| 587 | ;; this routine | ||
| 588 | (or prefix-arg (setq prefix-arg count)) | ||
| 589 | (setq command (key-binding (read-key-sequence nil))) | ||
| 590 | (if (commandp command) | ||
| 591 | (command-execute command) | ||
| 592 | (beep 1))) | ||
| 593 | )) | ||
| 594 | |||
| 595 | |||
| 596 | |||
| 597 | ;;; Displaying and completing macros | ||
| 598 | |||
| 599 | (defun vip-describe-kbd-macros () | ||
| 600 | "Show currently defined keyboard macros." | ||
| 601 | (interactive) | ||
| 602 | (with-output-to-temp-buffer " *vip-info*" | ||
| 603 | (princ "Macros in Vi state:\n===================\n") | ||
| 604 | (mapcar 'vip-describe-one-macro vip-vi-kbd-macro-alist) | ||
| 605 | (princ "\n\nMacros in Insert and Replace states:\n====================================\n") | ||
| 606 | (mapcar 'vip-describe-one-macro vip-insert-kbd-macro-alist) | ||
| 607 | (princ "\n\nMacros in Emacs state:\n======================\n") | ||
| 608 | (mapcar 'vip-describe-one-macro vip-emacs-kbd-macro-alist) | ||
| 609 | )) | ||
| 610 | |||
| 611 | (defun vip-describe-one-macro (macro) | ||
| 612 | (princ (format "\n *** Mappings for %S:\n ------------\n" | ||
| 613 | (vip-display-macro (car macro)))) | ||
| 614 | (princ " ** Buffer-specific:") | ||
| 615 | (if (vip-kbd-buf-alist macro) | ||
| 616 | (mapcar 'vip-describe-one-macro-elt (vip-kbd-buf-alist macro)) | ||
| 617 | (princ " none\n")) | ||
| 618 | (princ "\n ** Mode-specific:") | ||
| 619 | (if (vip-kbd-mode-alist macro) | ||
| 620 | (mapcar 'vip-describe-one-macro-elt (vip-kbd-mode-alist macro)) | ||
| 621 | (princ " none\n")) | ||
| 622 | (princ "\n ** Global:") | ||
| 623 | (if (vip-kbd-global-definition macro) | ||
| 624 | (princ | ||
| 625 | (format "\n %S" | ||
| 626 | (cdr (vip-kbd-global-pair macro)))) | ||
| 627 | (princ " none")) | ||
| 628 | (princ "\n")) | ||
| 629 | |||
| 630 | (defun vip-describe-one-macro-elt (elt) | ||
| 631 | (let ((name (car elt)) | ||
| 632 | (defn (cdr elt))) | ||
| 633 | (princ (format "\n * %S:\n %S\n" name defn)))) | ||
| 634 | |||
| 635 | |||
| 636 | |||
| 637 | ;; check if SEQ is a prefix of some car of an element in ALIST | ||
| 638 | (defun vip-keyseq-is-a-possible-macro (seq alist) | ||
| 639 | (let ((converted-seq (vip-events-to-macro seq))) | ||
| 640 | (eval (cons 'or | ||
| 641 | (mapcar | ||
| 642 | (function (lambda (elt) | ||
| 643 | (vip-prefix-subseq-p converted-seq elt))) | ||
| 644 | (vip-this-buffer-macros alist)))))) | ||
| 645 | |||
| 646 | ;; whether SEQ1 is a prefix of SEQ2 | ||
| 647 | (defun vip-prefix-subseq-p (seq1 seq2) | ||
| 648 | (let ((len1 (length seq1)) | ||
| 649 | (len2 (length seq2))) | ||
| 650 | (if (<= len1 len2) | ||
| 651 | (equal seq1 (subseq seq2 0 len1))))) | ||
| 652 | |||
| 653 | ;; find the longest common prefix | ||
| 654 | (defun vip-common-seq-prefix (&rest seqs) | ||
| 655 | (let* ((first (car seqs)) | ||
| 656 | (rest (cdr seqs)) | ||
| 657 | (pref []) | ||
| 658 | (idx 0) | ||
| 659 | len) | ||
| 660 | (if (= (length seqs) 0) | ||
| 661 | (setq len 0) | ||
| 662 | (setq len (apply 'min (mapcar 'length seqs)))) | ||
| 663 | (while (< idx len) | ||
| 664 | (if (eval (cons 'and | ||
| 665 | (mapcar (function (lambda (s) | ||
| 666 | (equal (elt first idx) | ||
| 667 | (elt s idx)))) | ||
| 668 | rest))) | ||
| 669 | (setq pref (vconcat pref (vector (elt first idx))))) | ||
| 670 | (setq idx (1+ idx))) | ||
| 671 | pref)) | ||
| 672 | |||
| 673 | ;; get all sequences that match PREFIX from a given A-LIST | ||
| 674 | (defun vip-extract-matching-alist-members (pref alist) | ||
| 675 | (delq nil (mapcar (function (lambda (elt) | ||
| 676 | (if (vip-prefix-subseq-p pref elt) | ||
| 677 | elt))) | ||
| 678 | (vip-this-buffer-macros alist)))) | ||
| 679 | |||
| 680 | (defun vip-do-sequence-completion (seq alist compl-message) | ||
| 681 | (let* ((matches (vip-extract-matching-alist-members seq alist)) | ||
| 682 | (new-seq (apply 'vip-common-seq-prefix matches)) | ||
| 683 | ) | ||
| 684 | (cond ((and (equal seq new-seq) (= (length matches) 1)) | ||
| 685 | (message "%s (Sole completion)" compl-message) | ||
| 686 | (sit-for 2)) | ||
| 687 | ((null matches) | ||
| 688 | (message "%s (No match)" compl-message) | ||
| 689 | (sit-for 2) | ||
| 690 | (setq new-seq seq)) | ||
| 691 | ((member seq matches) | ||
| 692 | (message "%s (Complete, but not unique)" compl-message) | ||
| 693 | (sit-for 2) | ||
| 694 | (vip-display-vector-completions matches)) | ||
| 695 | ((equal seq new-seq) | ||
| 696 | (vip-display-vector-completions matches))) | ||
| 697 | new-seq)) | ||
| 698 | |||
| 699 | |||
| 700 | (defun vip-display-vector-completions (list) | ||
| 701 | (with-output-to-temp-buffer "*Completions*" | ||
| 702 | (display-completion-list | ||
| 703 | (mapcar 'prin1-to-string | ||
| 704 | (mapcar 'vip-display-macro list))))) | ||
| 705 | |||
| 706 | |||
| 707 | |||
| 708 | ;; alist is the alist of macros | ||
| 709 | ;; str is the fast key sequence entered | ||
| 710 | ;; returns: (matching-macro-def . unmatched-suffix-start-index) | ||
| 711 | (defun vip-find-best-matching-macro (alist str) | ||
| 712 | (let ((lis alist) | ||
| 713 | (def-len 0) | ||
| 714 | (str-len (length str)) | ||
| 715 | match unmatched-start-idx found macro-def) | ||
| 716 | (while (and (not found) lis) | ||
| 717 | (setq macro-def (car lis) | ||
| 718 | def-len (length (car macro-def))) | ||
| 719 | (if (and (>= str-len def-len) | ||
| 720 | (equal (car macro-def) (subseq str 0 def-len))) | ||
| 721 | (if (or (vip-kbd-buf-definition macro-def) | ||
| 722 | (vip-kbd-mode-definition macro-def) | ||
| 723 | (vip-kbd-global-definition macro-def)) | ||
| 724 | (setq found t)) | ||
| 725 | ) | ||
| 726 | (setq lis (cdr lis))) | ||
| 727 | |||
| 728 | (if found | ||
| 729 | (setq match macro-def | ||
| 730 | unmatched-start-idx def-len) | ||
| 731 | (setq match nil | ||
| 732 | unmatched-start-idx 0)) | ||
| 733 | |||
| 734 | (cons match unmatched-start-idx))) | ||
| 735 | |||
| 736 | |||
| 737 | |||
| 738 | ;; returns a list of names of macros defined for the current buffer | ||
| 739 | (defun vip-this-buffer-macros (macro-alist) | ||
| 740 | (let (candidates) | ||
| 741 | (setq candidates | ||
| 742 | (mapcar (function | ||
| 743 | (lambda (elt) | ||
| 744 | (if (or (vip-kbd-buf-definition elt) | ||
| 745 | (vip-kbd-mode-definition elt) | ||
| 746 | (vip-kbd-global-definition elt)) | ||
| 747 | (car elt)))) | ||
| 748 | macro-alist)) | ||
| 749 | (setq candidates (delq nil candidates)))) | ||
| 750 | |||
| 751 | |||
| 752 | ;; if seq of key symbols can be converted to a string--do so. Otherwise, do | ||
| 753 | ;; nothing. | ||
| 754 | (defun vip-display-macro (macro-name) | ||
| 755 | (cond ((vip-char-symbol-sequence-p macro-name) | ||
| 756 | (mapconcat 'symbol-name macro-name "")) | ||
| 757 | ((vip-char-array-p macro-name) | ||
| 758 | (mapconcat 'char-to-string macro-name "")) | ||
| 759 | (t macro-name))) | ||
| 760 | |||
| 761 | (defun vip-events-to-macro (event-seq) | ||
| 762 | (vconcat (mapcar 'vip-event-key event-seq))) | ||
| 763 | |||
| 764 | ;; convert strings of characters or arrays of characters to Viper macro form | ||
| 765 | (defun vip-char-array-to-macro (array) | ||
| 766 | (let ((vec (vconcat array)) | ||
| 767 | macro) | ||
| 768 | (if vip-xemacs-p | ||
| 769 | (setq macro (mapcar 'character-to-event vec)) | ||
| 770 | (setq macro vec)) | ||
| 771 | (vconcat (mapcar 'vip-event-key macro)))) | ||
| 772 | |||
| 773 | ;; For macros bodies and names, goes over and checks if all members are | ||
| 774 | ;; names of keys (actually, it only checks if they are symbols or lists | ||
| 775 | ;; if a digit is found, it is converted into a symbol (0 -> \0, etc). | ||
| 776 | ;; If not list or vector, doesn't change its argument | ||
| 777 | (defun vip-fixup-macro (macro) | ||
| 778 | (let ((len (length macro)) | ||
| 779 | (idx 0) | ||
| 780 | elt break) | ||
| 781 | (if (or (vectorp macro) (listp macro)) | ||
| 782 | (while (and (< idx len) (not break)) | ||
| 783 | (setq elt (elt macro idx)) | ||
| 784 | (cond ((numberp elt) | ||
| 785 | ;; fix number | ||
| 786 | (if (and (<= 0 elt) (<= elt 9)) | ||
| 787 | (cond ((arrayp macro) | ||
| 788 | (aset macro | ||
| 789 | idx | ||
| 790 | (intern (char-to-string (+ ?0 elt))))) | ||
| 791 | ((listp macro) | ||
| 792 | (setcar (nthcdr idx macro) | ||
| 793 | (intern (char-to-string (+ ?0 elt))))) | ||
| 794 | ))) | ||
| 795 | ;;(setq break t))) | ||
| 796 | ((listp elt) | ||
| 797 | (vip-fixup-macro elt)) | ||
| 798 | ((symbolp elt) nil) | ||
| 799 | (t (setq break t))) | ||
| 800 | (setq idx (1+ idx)))) | ||
| 801 | |||
| 802 | (if break | ||
| 803 | (error "Wrong type macro component, symbol-or-listp, %S" elt) | ||
| 804 | macro))) | ||
| 805 | |||
| 806 | (defun vip-char-array-p (array) | ||
| 807 | (eval (cons 'and (mapcar 'numberp array)))) | ||
| 808 | |||
| 809 | (defun vip-macro-to-events (macro-body) | ||
| 810 | (vconcat (mapcar 'vip-key-to-emacs-key macro-body))) | ||
| 811 | |||
| 812 | |||
| 813 | ;; check if vec is a vector of character symbols | ||
| 814 | (defun vip-char-symbol-sequence-p (vec) | ||
| 815 | (and | ||
| 816 | (sequencep vec) | ||
| 817 | (eval | ||
| 818 | (cons 'and | ||
| 819 | (mapcar | ||
| 820 | (function (lambda (elt) | ||
| 821 | (and (symbolp elt) (= (length (symbol-name elt)) 1)))) | ||
| 822 | vec))))) | ||
| 823 | |||
| 824 | |||
| 825 | ;; Check if vec is a vector of key-press events representing characters | ||
| 826 | ;; XEmacs only | ||
| 827 | (defun vip-event-vector-p (vec) | ||
| 828 | (and (vectorp vec) | ||
| 829 | (eval (cons 'and (mapcar '(lambda (elt) (if (eventp elt) t)) vec))))) | ||
| 830 | |||
| 831 | |||
| 832 | ;;; Reading fast key sequences | ||
| 833 | |||
| 834 | ;; Assuming that CHAR was the first character in a fast succession of key | ||
| 835 | ;; strokes, read the rest. Return the vector of keys that was entered in | ||
| 836 | ;; this fast succession of key strokes. | ||
| 837 | ;; A fast keysequence is one that is terminated by a pause longer than | ||
| 838 | ;; vip-fast-keyseq-timeout. | ||
| 839 | (defun vip-read-fast-keysequence (event macro-alist) | ||
| 840 | (let ((lis (vector event)) | ||
| 841 | next-event) | ||
| 842 | (while (and (vip-fast-keysequence-p) | ||
| 843 | (vip-keyseq-is-a-possible-macro lis macro-alist)) | ||
| 844 | (setq next-event (vip-read-event)) | ||
| 845 | (or (vip-mouse-event-p next-event) | ||
| 846 | (setq lis (vconcat lis (vector next-event))))) | ||
| 847 | lis)) | ||
| 848 | |||
| 849 | |||
| 850 | ;;; Keyboard macros in registers | ||
| 851 | |||
| 852 | ;; sets register to last-kbd-macro carefully. | ||
| 853 | (defun vip-set-register-macro (reg) | ||
| 854 | (if (get-register reg) | ||
| 855 | (if (y-or-n-p "Register contains data. Overwrite? ") | ||
| 856 | () | ||
| 857 | (error | ||
| 858 | "Macro not saved in register. Can still be invoked via `C-x e'"))) | ||
| 859 | (set-register reg last-kbd-macro)) | ||
| 860 | |||
| 861 | (defun vip-register-macro (count) | ||
| 862 | "Keyboard macros in registers - a modified \@ command." | ||
| 863 | (interactive "P") | ||
| 864 | (let ((reg (downcase (read-char)))) | ||
| 865 | (cond ((or (and (<= ?a reg) (<= reg ?z))) | ||
| 866 | (setq vip-last-macro-reg reg) | ||
| 867 | (if defining-kbd-macro | ||
| 868 | (progn | ||
| 869 | (end-kbd-macro) | ||
| 870 | (vip-set-register-macro reg)) | ||
| 871 | (execute-kbd-macro (get-register reg) count))) | ||
| 872 | ((or (= ?@ reg) (= ?\^j reg) (= ?\^m reg)) | ||
| 873 | (if vip-last-macro-reg | ||
| 874 | nil | ||
| 875 | (error "No previous kbd macro")) | ||
| 876 | (execute-kbd-macro (get-register vip-last-macro-reg) count)) | ||
| 877 | ((= ?\# reg) | ||
| 878 | (start-kbd-macro count)) | ||
| 879 | ((= ?! reg) | ||
| 880 | (setq reg (downcase (read-char))) | ||
| 881 | (if (or (and (<= ?a reg) (<= reg ?z))) | ||
| 882 | (progn | ||
| 883 | (setq vip-last-macro-reg reg) | ||
| 884 | (vip-set-register-macro reg)))) | ||
| 885 | (t | ||
| 886 | (error (format "`%c': Unknown register" reg)))))) | ||
| 887 | |||
| 888 | |||
| 889 | (defun vip-global-execute () | ||
| 890 | "Call last keyboad macro for each line in the region." | ||
| 891 | (if (> (point) (mark t)) (exchange-point-and-mark)) | ||
| 892 | (beginning-of-line) | ||
| 893 | (call-last-kbd-macro) | ||
| 894 | (while (< (point) (mark t)) | ||
| 895 | (forward-line 1) | ||
| 896 | (beginning-of-line) | ||
| 897 | (call-last-kbd-macro))) | ||
| 898 | |||
| 899 | |||
| 900 | (provide 'viper-macs) | ||
| 901 | |||
| 902 | ;;; viper-macs.el ends here | ||
diff --git a/lisp/emulation/viper-mous.el b/lisp/emulation/viper-mous.el new file mode 100644 index 00000000000..df2679d82a0 --- /dev/null +++ b/lisp/emulation/viper-mous.el | |||
| @@ -0,0 +1,457 @@ | |||
| 1 | ;;; viper-mous.el -- Mouse support for Viper | ||
| 2 | |||
| 3 | ;; This file is part of GNU Emacs. | ||
| 4 | |||
| 5 | ;; GNU Emacs is free software; you can redistribute it and/or modify | ||
| 6 | ;; it under the terms of the GNU General Public License as published by | ||
| 7 | ;; the Free Software Foundation; either version 2, or (at your option) | ||
| 8 | ;; any later version. | ||
| 9 | |||
| 10 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 11 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 12 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 13 | ;; GNU General Public License for more details. | ||
| 14 | |||
| 15 | ;; You should have received a copy of the GNU General Public License | ||
| 16 | ;; along with GNU Emacs; see the file COPYING. If not, write to | ||
| 17 | ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | ||
| 18 | |||
| 19 | |||
| 20 | (require 'viper-util) | ||
| 21 | |||
| 22 | |||
| 23 | ;;; Variables | ||
| 24 | |||
| 25 | ;; Variable used for catching the switch-frame event. | ||
| 26 | ;; If non-nil, indicates that previous-frame should be the selected | ||
| 27 | ;; one. Used by vip-mouse-click-get-word. Not a user option. | ||
| 28 | (defvar vip-frame-of-focus nil) | ||
| 29 | |||
| 30 | ;; Frame that was selected before the switch-frame event. | ||
| 31 | (defconst vip-pre-click-frame (vip-selected-frame)) | ||
| 32 | |||
| 33 | (defvar vip-surrounding-word-function 'vip-surrounding-word | ||
| 34 | "*Function that determines what constitutes a word for clicking events. | ||
| 35 | Takes two parameters: a COUNT, indicating how many words to return, | ||
| 36 | and CLICK-COUNT, telling whether this is the first click, a double-click, | ||
| 37 | or a tripple-click.") | ||
| 38 | |||
| 39 | ;; time interval in millisecond within which successive clicks are | ||
| 40 | ;; considered related | ||
| 41 | (defconst vip-multiclick-timeout (if vip-xemacs-p | ||
| 42 | 500 | ||
| 43 | double-click-time) | ||
| 44 | "*Time interval in millisecond within which successive clicks are | ||
| 45 | considered related.") | ||
| 46 | |||
| 47 | ;; current event click count; XEmacs only | ||
| 48 | (defvar vip-current-click-count 0) | ||
| 49 | ;; time stamp of the last click event; XEmacs only | ||
| 50 | (defvar vip-last-click-event-timestamp 0) | ||
| 51 | |||
| 52 | ;; Local variable used to toggle wraparound search on click. | ||
| 53 | (vip-deflocalvar vip-mouse-click-search-noerror t) | ||
| 54 | |||
| 55 | ;; Local variable used to delimit search after wraparound. | ||
| 56 | (vip-deflocalvar vip-mouse-click-search-limit nil) | ||
| 57 | |||
| 58 | ;; remembers prefix argument to pass along to commands invoked by second | ||
| 59 | ;; click. | ||
| 60 | ;; This is needed because in Emacs (not XEmacs), assigning to preix-arg | ||
| 61 | ;; causes Emacs to count the second click as if it was a single click | ||
| 62 | (defvar vip-global-prefix-argument nil) | ||
| 63 | |||
| 64 | |||
| 65 | |||
| 66 | ;;; Code | ||
| 67 | |||
| 68 | (defun vip-multiclick-p () | ||
| 69 | (not (vip-sit-for-short vip-multiclick-timeout t))) | ||
| 70 | |||
| 71 | (defun vip-surrounding-word (count click-count) | ||
| 72 | "Returns word surrounding point according to a heuristic. | ||
| 73 | COUNT indicates how many regions to return. | ||
| 74 | If CLICK-COUNT is 1, `word' is a word in Vi sense. If it is > 1, | ||
| 75 | then `word' is a Word in Vi sense. | ||
| 76 | If the character clicked on is a non-separator and is non-alphanumeric but | ||
| 77 | is adjacent to an alphanumeric symbol, then it is considered alphanumeric | ||
| 78 | for the purpose of this command. If this character has a matching | ||
| 79 | character, such as `\(' is a match for `\)', then the matching character is | ||
| 80 | also considered alphanumeric. | ||
| 81 | For convenience, in Lisp modes, `-' is considered alphanumeric." | ||
| 82 | (let* ((basic-alpha "_a-zA-Z0-9") ;; it is important for `_' to come first | ||
| 83 | (basic-alpha-B "[_a-zA-Z0-9]") | ||
| 84 | (basic-nonalphasep-B vip-NONALPHASEP-B) | ||
| 85 | (end-modifiers "") | ||
| 86 | (start-modifiers "") | ||
| 87 | vip-ALPHA vip-ALPHA-B | ||
| 88 | vip-NONALPHA vip-NONALPHA-B | ||
| 89 | vip-ALPHASEP vip-ALPHASEP-B | ||
| 90 | vip-NONALPHASEP vip-NONALPHASEP-B | ||
| 91 | skip-flag | ||
| 92 | one-char-word-func word-function-forw word-function-back word-beg) | ||
| 93 | |||
| 94 | (if (and (looking-at basic-nonalphasep-B) | ||
| 95 | (or (save-excursion (vip-backward-char-carefully) | ||
| 96 | (looking-at basic-alpha-B)) | ||
| 97 | (save-excursion (vip-forward-char-carefully) | ||
| 98 | (looking-at basic-alpha-B)))) | ||
| 99 | (setq start-modifiers | ||
| 100 | (cond ((looking-at "\\\\") "\\\\") | ||
| 101 | ((looking-at "-") "") | ||
| 102 | ((looking-at "[][]") "][") | ||
| 103 | ((looking-at "[()]") ")(") | ||
| 104 | ((looking-at "[{}]") "{}") | ||
| 105 | ((looking-at "[<>]") "<>") | ||
| 106 | ((looking-at "[`']") "`'") | ||
| 107 | ((looking-at "\\^") "") | ||
| 108 | ((looking-at vip-SEP-B) "") | ||
| 109 | (t (char-to-string (following-char)))) | ||
| 110 | end-modifiers | ||
| 111 | (cond ((looking-at "-") "C-C-") ;; note the C-C trick | ||
| 112 | ((looking-at "\\^") "^") | ||
| 113 | (t "")))) | ||
| 114 | |||
| 115 | ;; Add `-' to alphanum, if it wasn't added and in we are in Lisp | ||
| 116 | (or (looking-at "-") | ||
| 117 | (not (string-match "lisp" (symbol-name major-mode))) | ||
| 118 | (setq end-modifiers (concat end-modifiers "C-C-"))) | ||
| 119 | |||
| 120 | (setq vip-ALPHA | ||
| 121 | (format "%s%s%s" start-modifiers basic-alpha end-modifiers) | ||
| 122 | vip-ALPHA-B | ||
| 123 | (format "[%s%s%s]" start-modifiers basic-alpha end-modifiers) | ||
| 124 | vip-NONALPHA (concat "^" vip-ALPHA) | ||
| 125 | vip-NONALPHA-B (concat "[" vip-NONALPHA "]") | ||
| 126 | vip-ALPHASEP (concat vip-ALPHA vip-SEP) | ||
| 127 | vip-ALPHASEP-B | ||
| 128 | (format "[%s%s%s%s]" | ||
| 129 | start-modifiers basic-alpha vip-SEP end-modifiers) | ||
| 130 | vip-NONALPHASEP (format "^%s%s" vip-SEP vip-ALPHA) | ||
| 131 | vip-NONALPHASEP-B (format "[^%s%s]" vip-SEP vip-ALPHA) | ||
| 132 | ) | ||
| 133 | |||
| 134 | (if (> click-count 1) | ||
| 135 | (setq one-char-word-func 'vip-one-char-Word-p | ||
| 136 | word-function-forw 'vip-end-of-Word | ||
| 137 | word-function-back 'vip-backward-Word) | ||
| 138 | (setq one-char-word-func 'vip-one-char-word-p | ||
| 139 | word-function-forw 'vip-end-of-word | ||
| 140 | word-function-back 'vip-backward-word)) | ||
| 141 | |||
| 142 | (save-excursion | ||
| 143 | (cond ((> click-count 1) (skip-chars-backward vip-NONSEP)) | ||
| 144 | ((looking-at vip-ALPHA-B) (skip-chars-backward vip-ALPHA)) | ||
| 145 | ((looking-at vip-NONALPHASEP-B) | ||
| 146 | (skip-chars-backward vip-NONALPHASEP)) | ||
| 147 | (t (funcall word-function-back 1))) | ||
| 148 | |||
| 149 | (setq word-beg (point)) | ||
| 150 | |||
| 151 | (setq skip-flag t) | ||
| 152 | (while (> count 0) | ||
| 153 | ;; skip-flag and the test for 1-char word takes care of the | ||
| 154 | ;; special treatment that vip-end-of-word gives to 1-character | ||
| 155 | ;; words. Otherwise, clicking once on such a word will insert two | ||
| 156 | ;; words. | ||
| 157 | (if (and skip-flag (funcall one-char-word-func)) | ||
| 158 | (setq skip-flag (not skip-flag)) | ||
| 159 | (funcall word-function-forw 1)) | ||
| 160 | (setq count (1- count))) | ||
| 161 | |||
| 162 | (vip-forward-char-carefully) | ||
| 163 | (buffer-substring word-beg (point))) | ||
| 164 | )) | ||
| 165 | |||
| 166 | |||
| 167 | (defun vip-mouse-click-get-word (click &optional count click-count) | ||
| 168 | "Returns word surrounding the position of a mouse click. | ||
| 169 | Click may be in another window. Current window and buffer isn't changed." | ||
| 170 | |||
| 171 | (let ((click-word "") | ||
| 172 | (click-pos (vip-mouse-click-posn click)) | ||
| 173 | (click-buf (vip-mouse-click-window-buffer click))) | ||
| 174 | (or (numberp count) (setq count 1)) | ||
| 175 | (or (numberp click-count) (setq click-count 1)) | ||
| 176 | |||
| 177 | (save-excursion | ||
| 178 | (save-window-excursion | ||
| 179 | (if click-pos | ||
| 180 | (progn | ||
| 181 | (set-buffer click-buf) | ||
| 182 | |||
| 183 | (goto-char click-pos) | ||
| 184 | (setq click-word | ||
| 185 | (funcall vip-surrounding-word-function count click-count))) | ||
| 186 | (error "Click must be over a window.")) | ||
| 187 | click-word)))) | ||
| 188 | |||
| 189 | (defun vip-mouse-click-frame (click) | ||
| 190 | "Returns window where click occurs." | ||
| 191 | (vip-window-frame (vip-mouse-click-window click))) | ||
| 192 | |||
| 193 | (defun vip-mouse-click-window (click) | ||
| 194 | "Returns window where click occurs." | ||
| 195 | (if vip-xemacs-p | ||
| 196 | (event-window click) | ||
| 197 | (posn-window (event-start click)))) | ||
| 198 | |||
| 199 | (defun vip-mouse-click-window-buffer (click) | ||
| 200 | "Returns the buffer of the window where click occurs." | ||
| 201 | (window-buffer (vip-mouse-click-window click))) | ||
| 202 | |||
| 203 | (defun vip-mouse-click-window-buffer-name (click) | ||
| 204 | "Returns the name of the buffer in the window where click occurs." | ||
| 205 | (buffer-name (vip-mouse-click-window-buffer click))) | ||
| 206 | |||
| 207 | (defun vip-mouse-click-posn (click) | ||
| 208 | "Returns position of a click." | ||
| 209 | (interactive "e") | ||
| 210 | (if vip-xemacs-p | ||
| 211 | (event-point click) | ||
| 212 | (posn-point (event-start click)))) | ||
| 213 | |||
| 214 | (defun vip-mouse-click-insert-word (click arg) | ||
| 215 | "Insert word clicked or double-clicked on. | ||
| 216 | With prefix argument, N, insert that many words. | ||
| 217 | This command must be bound to a mouse click. | ||
| 218 | The double-click action of the same mouse button must not be bound | ||
| 219 | \(or it must be bound to the same function\). | ||
| 220 | See `vip-surrounding-word' for the definition of a word in this case." | ||
| 221 | (interactive "e\nP") | ||
| 222 | (if vip-frame-of-focus ;; to handle clicks in another frame | ||
| 223 | (vip-select-frame vip-frame-of-focus)) | ||
| 224 | |||
| 225 | ;; turn arg into a number | ||
| 226 | (cond ((numberp arg) nil) | ||
| 227 | ;; prefix arg is a list when one hits C-u then command | ||
| 228 | ((and (listp arg) (numberp (car arg))) | ||
| 229 | (setq arg (car arg))) | ||
| 230 | (t (setq arg 1))) | ||
| 231 | |||
| 232 | (let (click-count interrupting-event) | ||
| 233 | (if (and | ||
| 234 | (vip-multiclick-p) | ||
| 235 | ;; This trick checks if there is a pending mouse event | ||
| 236 | ;; if so, we use this latter event and discard the current mouse click | ||
| 237 | ;; If the next panding event is not a mouse event, we execute | ||
| 238 | ;; the current mouse event | ||
| 239 | (progn | ||
| 240 | (setq interrupting-event (vip-read-event)) | ||
| 241 | (vip-mouse-event-p last-input-event))) | ||
| 242 | (progn ;; interrupted wait | ||
| 243 | (setq vip-global-prefix-argument arg) | ||
| 244 | ;; count this click for XEmacs | ||
| 245 | (vip-event-click-count click)) | ||
| 246 | ;; uninterrupted wait or the interrupting event wasn't a mouse event | ||
| 247 | (setq click-count (vip-event-click-count click)) | ||
| 248 | (if (> click-count 1) | ||
| 249 | (setq arg vip-global-prefix-argument | ||
| 250 | vip-global-prefix-argument nil)) | ||
| 251 | (insert (vip-mouse-click-get-word click arg click-count)) | ||
| 252 | (if (and interrupting-event | ||
| 253 | (eventp interrupting-event) | ||
| 254 | (not (vip-mouse-event-p interrupting-event))) | ||
| 255 | (vip-set-unread-command-events interrupting-event)) | ||
| 256 | ))) | ||
| 257 | |||
| 258 | ;; arg is an event. accepts symbols and numbers, too | ||
| 259 | (defun vip-mouse-event-p (event) | ||
| 260 | (if (eventp event) | ||
| 261 | (string-match "\\(mouse-\\|frame\\|screen\\|track\\)" | ||
| 262 | (prin1-to-string (vip-event-key event))))) | ||
| 263 | |||
| 264 | ;; XEmacs has no double-click events. So, we must simulate. | ||
| 265 | ;; So, we have to simulate event-click-count. | ||
| 266 | (defun vip-event-click-count (click) | ||
| 267 | (if vip-xemacs-p | ||
| 268 | (progn | ||
| 269 | ;; if more than 1 second | ||
| 270 | (if (> (- (event-timestamp click) vip-last-click-event-timestamp) | ||
| 271 | vip-multiclick-timeout) | ||
| 272 | (setq vip-current-click-count 0)) | ||
| 273 | (setq vip-last-click-event-timestamp (event-timestamp click) | ||
| 274 | vip-current-click-count (1+ vip-current-click-count))) | ||
| 275 | (event-click-count click))) | ||
| 276 | |||
| 277 | |||
| 278 | |||
| 279 | (defun vip-mouse-click-search-word (click arg) | ||
| 280 | "Find the word clicked or double-clicked on. Word may be in another window. | ||
| 281 | With prefix argument, N, search for N-th occurrence. | ||
| 282 | This command must be bound to a mouse click. The double-click action of the | ||
| 283 | same button must not be bound \(or it must be bound to the same function\). | ||
| 284 | See `vip-surrounding-word' for the details on what constitutes a word for | ||
| 285 | this command." | ||
| 286 | (interactive "e\nP") | ||
| 287 | (if vip-frame-of-focus ;; to handle clicks in another frame | ||
| 288 | (vip-select-frame vip-frame-of-focus)) | ||
| 289 | (let (click-word click-count | ||
| 290 | (previous-search-string vip-s-string)) | ||
| 291 | |||
| 292 | (if (and | ||
| 293 | (vip-multiclick-p) | ||
| 294 | ;; This trick checks if there is a pending mouse event | ||
| 295 | ;; if so, we use this latter event and discard the current mouse click | ||
| 296 | ;; If the next panding event is not a mouse event, we execute | ||
| 297 | ;; the current mouse event | ||
| 298 | (progn | ||
| 299 | (vip-read-event) | ||
| 300 | (vip-mouse-event-p last-input-event))) | ||
| 301 | (progn ;; interrupted wait | ||
| 302 | (setq vip-global-prefix-argument arg) | ||
| 303 | ;; remember command that was before the multiclick | ||
| 304 | (setq this-command last-command) | ||
| 305 | ;; make sure we counted this event---needed for XEmacs only | ||
| 306 | (vip-event-click-count click)) | ||
| 307 | ;; uninterrupted wait | ||
| 308 | (setq click-count (vip-event-click-count click)) | ||
| 309 | (setq click-word (vip-mouse-click-get-word click nil click-count)) | ||
| 310 | |||
| 311 | (if (> click-count 1) | ||
| 312 | (setq arg vip-global-prefix-argument | ||
| 313 | vip-global-prefix-argument nil)) | ||
| 314 | (setq arg (or arg 1)) | ||
| 315 | |||
| 316 | (vip-deactivate-mark) | ||
| 317 | (if (or (not (string= click-word vip-s-string)) | ||
| 318 | (not (markerp vip-search-start-marker)) | ||
| 319 | (not (equal (marker-buffer vip-search-start-marker) | ||
| 320 | (current-buffer))) | ||
| 321 | (not (eq last-command 'vip-mouse-click-search-word))) | ||
| 322 | (progn | ||
| 323 | (setq vip-search-start-marker (point-marker) | ||
| 324 | vip-local-search-start-marker vip-search-start-marker | ||
| 325 | vip-mouse-click-search-noerror t | ||
| 326 | vip-mouse-click-search-limit nil) | ||
| 327 | |||
| 328 | ;; make search string known to Viper | ||
| 329 | (setq vip-s-string (if vip-re-search | ||
| 330 | (regexp-quote click-word) | ||
| 331 | click-word)) | ||
| 332 | (if (not (string= vip-s-string (car vip-search-history))) | ||
| 333 | (setq vip-search-history | ||
| 334 | (cons vip-s-string vip-search-history))) | ||
| 335 | )) | ||
| 336 | |||
| 337 | (push-mark nil t) | ||
| 338 | (while (> arg 0) | ||
| 339 | (vip-forward-word 1) | ||
| 340 | (condition-case nil | ||
| 341 | (progn | ||
| 342 | (if (not (search-forward click-word vip-mouse-click-search-limit | ||
| 343 | vip-mouse-click-search-noerror)) | ||
| 344 | (progn | ||
| 345 | (setq vip-mouse-click-search-noerror nil) | ||
| 346 | (setq vip-mouse-click-search-limit | ||
| 347 | (save-excursion | ||
| 348 | (if (and | ||
| 349 | (markerp vip-local-search-start-marker) | ||
| 350 | (marker-buffer vip-local-search-start-marker)) | ||
| 351 | (goto-char vip-local-search-start-marker)) | ||
| 352 | (vip-line-pos 'end))) | ||
| 353 | |||
| 354 | (goto-char (point-min)) | ||
| 355 | (search-forward click-word | ||
| 356 | vip-mouse-click-search-limit nil))) | ||
| 357 | (goto-char (match-beginning 0)) | ||
| 358 | (message "Searching for: %s" vip-s-string) | ||
| 359 | (if (<= arg 1) | ||
| 360 | (vip-flash-search-pattern)) | ||
| 361 | ) | ||
| 362 | (error (beep 1) | ||
| 363 | (if (or (not (string= click-word previous-search-string)) | ||
| 364 | (not (eq last-command 'vip-mouse-click-search-word))) | ||
| 365 | (message "`%s': String not found in %s" | ||
| 366 | vip-s-string (buffer-name (current-buffer))) | ||
| 367 | (message | ||
| 368 | "`%s': Last occurrence in %s. Back to beginning of search" | ||
| 369 | click-word (buffer-name (current-buffer))) | ||
| 370 | (setq arg 1) ;; to terminate the loop | ||
| 371 | (sit-for 2)) | ||
| 372 | (setq vip-mouse-click-search-noerror t) | ||
| 373 | (setq vip-mouse-click-search-limit nil) | ||
| 374 | (if (and (markerp vip-local-search-start-marker) | ||
| 375 | (marker-buffer vip-local-search-start-marker)) | ||
| 376 | (goto-char vip-local-search-start-marker)))) | ||
| 377 | (setq arg (1- arg))) | ||
| 378 | ))) | ||
| 379 | |||
| 380 | (defun vip-mouse-catch-frame-switch (event arg) | ||
| 381 | "Catch the event of switching frame. | ||
| 382 | Usually is bound to a 'down-mouse' event to work properly. See sample | ||
| 383 | bindings in viper.el and in the Viper manual." | ||
| 384 | (interactive "e\nP") | ||
| 385 | (setq vip-frame-of-focus nil) | ||
| 386 | ;; pass prefix arg along to vip-mouse-click-search/insert-word | ||
| 387 | (setq prefix-arg arg) | ||
| 388 | (if (eq last-command 'handle-switch-frame) | ||
| 389 | (setq vip-frame-of-focus vip-pre-click-frame)) | ||
| 390 | ;; make Emacs forget that it executed vip-mouse-catch-frame-switch | ||
| 391 | (setq this-command last-command)) | ||
| 392 | |||
| 393 | ;; Called just before switching frames. Saves the old selected frame. | ||
| 394 | ;; Sets last-command to handle-switch-frame (this is done automatically in | ||
| 395 | ;; Emacs. | ||
| 396 | ;; The semantics of switching frames is different in Emacs and XEmacs. | ||
| 397 | ;; In Emacs, if you select-frame A while mouse is over frame B and then | ||
| 398 | ;; start typing, input goes to frame B, which becomes selected. | ||
| 399 | ;; In XEmacs, input will go to frame A. This may be a bug in one of the | ||
| 400 | ;; Emacsen, but also may be a design decision. | ||
| 401 | ;; Also, in Emacs sending input to frame B generates handle-switch-frame | ||
| 402 | ;; event, while in XEmacs it doesn't. | ||
| 403 | ;; All this accounts for the difference in the behavior of | ||
| 404 | ;; vip-mouse-click-* commands when you click in a frame other than the one | ||
| 405 | ;; that was the last to receive input. In Emacs, focus will be in frame A | ||
| 406 | ;; until you do something other than vip-mouse-click-* command. | ||
| 407 | ;; In XEmacs, you have to manually select frame B (with the mouse click) in | ||
| 408 | ;; order to shift focus to frame B. | ||
| 409 | (defun vip-save-pre-click-frame (frame) | ||
| 410 | (setq last-command 'handle-switch-frame) | ||
| 411 | (setq vip-pre-click-frame (vip-selected-frame))) | ||
| 412 | |||
| 413 | |||
| 414 | (cond (window-system | ||
| 415 | (let* ((search-key (if vip-xemacs-p [(meta button1up)] [S-mouse-1])) | ||
| 416 | (search-key-catch (if vip-xemacs-p | ||
| 417 | [(meta button1)] [S-down-mouse-1])) | ||
| 418 | (insert-key (if vip-xemacs-p [(meta button2up)] [S-mouse-2])) | ||
| 419 | (insert-key-catch (if vip-xemacs-p | ||
| 420 | [(meta button2)] [S-down-mouse-2])) | ||
| 421 | (search-key-unbound (and (not (key-binding search-key)) | ||
| 422 | (not (key-binding search-key-catch)))) | ||
| 423 | (insert-key-unbound (and (not (key-binding insert-key)) | ||
| 424 | (not (key-binding insert-key-catch)))) | ||
| 425 | ) | ||
| 426 | |||
| 427 | (if search-key-unbound | ||
| 428 | (global-set-key search-key 'vip-mouse-click-search-word)) | ||
| 429 | (if insert-key-unbound | ||
| 430 | (global-set-key insert-key 'vip-mouse-click-insert-word)) | ||
| 431 | |||
| 432 | ;; The following would be needed if you want to use the above two | ||
| 433 | ;; while clicking in another frame. If you only want to use them | ||
| 434 | ;; by clicking in another window, not frame, the bindings below | ||
| 435 | ;; aren't necessary. | ||
| 436 | |||
| 437 | ;; These must be bound to mouse-down event for the same mouse | ||
| 438 | ;; buttons as 'vip-mouse-click-search-word and | ||
| 439 | ;; 'vip-mouse-click-insert-word | ||
| 440 | (if search-key-unbound | ||
| 441 | (global-set-key search-key-catch 'vip-mouse-catch-frame-switch)) | ||
| 442 | (if insert-key-unbound | ||
| 443 | (global-set-key insert-key-catch 'vip-mouse-catch-frame-switch)) | ||
| 444 | |||
| 445 | (if vip-xemacs-p | ||
| 446 | (add-hook 'mouse-leave-screen-hook | ||
| 447 | 'vip-save-pre-click-frame) | ||
| 448 | (defadvice handle-switch-frame (before vip-frame-advice activate) | ||
| 449 | "Remember the selected frame before the switch-frame event." | ||
| 450 | (vip-save-pre-click-frame (vip-selected-frame)))) | ||
| 451 | ))) | ||
| 452 | |||
| 453 | |||
| 454 | |||
| 455 | (provide 'viper-mous) | ||
| 456 | |||
| 457 | ;;; viper-mous.el ends here | ||
diff --git a/lisp/emulation/viper-util.el b/lisp/emulation/viper-util.el new file mode 100644 index 00000000000..8f9d3491aae --- /dev/null +++ b/lisp/emulation/viper-util.el | |||
| @@ -0,0 +1,798 @@ | |||
| 1 | ;;; viper-util.el --- Utilities used by viper.el | ||
| 2 | |||
| 3 | ;; This file is part of GNU Emacs. | ||
| 4 | |||
| 5 | ;; GNU Emacs is free software; you can redistribute it and/or modify | ||
| 6 | ;; it under the terms of the GNU General Public License as published by | ||
| 7 | ;; the Free Software Foundation; either version 2, or (at your option) | ||
| 8 | ;; any later version. | ||
| 9 | |||
| 10 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 11 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 12 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 13 | ;; GNU General Public License for more details. | ||
| 14 | |||
| 15 | ;; You should have received a copy of the GNU General Public License | ||
| 16 | ;; along with GNU Emacs; see the file COPYING. If not, write to | ||
| 17 | ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | ||
| 18 | |||
| 19 | (require 'ring) | ||
| 20 | |||
| 21 | (defconst vip-xemacs-p (string-match "\\(Lucid\\|Xemacs\\)" emacs-version) | ||
| 22 | "Whether it is XEmacs or not.") | ||
| 23 | (defconst vip-emacs-p (not vip-xemacs-p) | ||
| 24 | "Whether it is Emacs or not.") | ||
| 25 | |||
| 26 | |||
| 27 | ;;; Macros | ||
| 28 | |||
| 29 | (defmacro vip-deflocalvar (var default-value &optional documentation) | ||
| 30 | (` (progn | ||
| 31 | (defvar (, var) (, default-value) | ||
| 32 | (, (format "%s\n\(buffer local\)" documentation))) | ||
| 33 | (make-variable-buffer-local '(, var)) | ||
| 34 | ))) | ||
| 35 | |||
| 36 | (defmacro vip-loop (count body) | ||
| 37 | "(vip-loop COUNT BODY) Execute BODY COUNT times." | ||
| 38 | (list 'let (list (list 'count count)) | ||
| 39 | (list 'while '(> count 0) | ||
| 40 | body | ||
| 41 | '(setq count (1- count)) | ||
| 42 | ))) | ||
| 43 | |||
| 44 | (defmacro vip-buffer-live-p (buf) | ||
| 45 | (` (and (, buf) (get-buffer (, buf)) (buffer-name (get-buffer (, buf)))))) | ||
| 46 | |||
| 47 | ;; return buffer-specific macro definition, given a full macro definition | ||
| 48 | (defmacro vip-kbd-buf-alist (macro-elt) | ||
| 49 | (` (nth 1 (, macro-elt)))) | ||
| 50 | ;; get a pair: (curr-buffer . macro-definition) | ||
| 51 | (defmacro vip-kbd-buf-pair (macro-elt) | ||
| 52 | (` (assoc (buffer-name) (vip-kbd-buf-alist (, macro-elt))))) | ||
| 53 | ;; get macro definition for current buffer | ||
| 54 | (defmacro vip-kbd-buf-definition (macro-elt) | ||
| 55 | (` (cdr (vip-kbd-buf-pair (, macro-elt))))) | ||
| 56 | |||
| 57 | ;; return mode-specific macro definitions, given a full macro definition | ||
| 58 | (defmacro vip-kbd-mode-alist (macro-elt) | ||
| 59 | (` (nth 2 (, macro-elt)))) | ||
| 60 | ;; get a pair: (major-mode . macro-definition) | ||
| 61 | (defmacro vip-kbd-mode-pair (macro-elt) | ||
| 62 | (` (assoc major-mode (vip-kbd-mode-alist (, macro-elt))))) | ||
| 63 | ;; get macro definition for the current major mode | ||
| 64 | (defmacro vip-kbd-mode-definition (macro-elt) | ||
| 65 | (` (cdr (vip-kbd-mode-pair (, macro-elt))))) | ||
| 66 | |||
| 67 | ;; return global macro definition, given a full macro definition | ||
| 68 | (defmacro vip-kbd-global-pair (macro-elt) | ||
| 69 | (` (nth 3 (, macro-elt)))) | ||
| 70 | ;; get global macro definition from an elt of macro-alist | ||
| 71 | (defmacro vip-kbd-global-definition (macro-elt) | ||
| 72 | (` (cdr (vip-kbd-global-pair (, macro-elt))))) | ||
| 73 | |||
| 74 | ;; last elt of a sequence | ||
| 75 | (defsubst vip-seq-last-elt (seq) | ||
| 76 | (elt seq (1- (length seq)))) | ||
| 77 | |||
| 78 | ;; Check if arg is a valid character for register | ||
| 79 | ;; TYPE is a list that can contain `letter', `Letter', and `digit'. | ||
| 80 | ;; Letter means lowercase letters, Letter means uppercase letters, and | ||
| 81 | ;; digit means digits from 1 to 9. | ||
| 82 | ;; If TYPE is nil, then down/uppercase letters and digits are allowed. | ||
| 83 | (defun vip-valid-register (reg &optional type) | ||
| 84 | (or type (setq type '(letter Letter digit))) | ||
| 85 | (or (if (memq 'letter type) | ||
| 86 | (and (<= ?a reg) (<= reg ?z))) | ||
| 87 | (if (memq 'digit type) | ||
| 88 | (and (<= ?1 reg) (<= reg ?9))) | ||
| 89 | (if (memq 'Letter type) | ||
| 90 | (and (<= ?A reg) (<= reg ?Z))) | ||
| 91 | )) | ||
| 92 | |||
| 93 | (defun vip-valid-marker (marker) | ||
| 94 | (if (markerp marker) | ||
| 95 | (let ((buf (marker-buffer marker)) | ||
| 96 | (pos (marker-position marker))) | ||
| 97 | (save-excursion | ||
| 98 | (set-buffer buf) | ||
| 99 | (and (<= pos (point-max)) (<= (point-min) pos)))))) | ||
| 100 | |||
| 101 | |||
| 102 | (defvar vip-minibuffer-overlay-priority 300) | ||
| 103 | (defvar vip-replace-overlay-priority 400) | ||
| 104 | (defvar vip-search-overlay-priority 500) | ||
| 105 | |||
| 106 | |||
| 107 | ;;; XEmacs support | ||
| 108 | |||
| 109 | (if vip-xemacs-p | ||
| 110 | (progn | ||
| 111 | (fset 'vip-read-event (symbol-function 'next-command-event)) | ||
| 112 | (fset 'vip-make-overlay (symbol-function 'make-extent)) | ||
| 113 | (fset 'vip-overlay-start (symbol-function 'extent-start-position)) | ||
| 114 | (fset 'vip-overlay-end (symbol-function 'extent-end-position)) | ||
| 115 | (fset 'vip-overlay-put (symbol-function 'set-extent-property)) | ||
| 116 | (fset 'vip-overlay-p (symbol-function 'extentp)) | ||
| 117 | (fset 'vip-overlay-get (symbol-function 'extent-property)) | ||
| 118 | (fset 'vip-move-overlay (symbol-function 'set-extent-endpoints)) | ||
| 119 | (if window-system | ||
| 120 | (fset 'vip-iconify (symbol-function 'iconify-screen))) | ||
| 121 | (fset 'vip-raise-frame (symbol-function 'raise-screen)) | ||
| 122 | (fset 'vip-window-frame (symbol-function 'window-screen)) | ||
| 123 | (fset 'vip-select-frame (symbol-function 'select-screen)) | ||
| 124 | (fset 'vip-selected-frame (symbol-function 'selected-screen)) | ||
| 125 | (fset 'vip-frame-selected-window | ||
| 126 | (symbol-function 'screen-selected-window)) | ||
| 127 | (fset 'vip-frame-parameters (symbol-function 'screen-parameters)) | ||
| 128 | (fset 'vip-modify-frame-parameters | ||
| 129 | (symbol-function 'modify-screen-parameters)) | ||
| 130 | (cond (window-system | ||
| 131 | (fset 'vip-get-face (symbol-function 'get-face)) | ||
| 132 | (fset 'vip-color-defined-p | ||
| 133 | (symbol-function 'x-valid-color-name-p)) | ||
| 134 | (fset 'vip-display-color-p | ||
| 135 | (symbol-function 'x-color-display-p))))) | ||
| 136 | (fset 'vip-read-event (symbol-function 'read-event)) | ||
| 137 | (fset 'vip-make-overlay (symbol-function 'make-overlay)) | ||
| 138 | (fset 'vip-overlay-start (symbol-function 'overlay-start)) | ||
| 139 | (fset 'vip-overlay-end (symbol-function 'overlay-end)) | ||
| 140 | (fset 'vip-overlay-put (symbol-function 'overlay-put)) | ||
| 141 | (fset 'vip-overlay-p (symbol-function 'overlayp)) | ||
| 142 | (fset 'vip-overlay-get (symbol-function 'overlay-get)) | ||
| 143 | (fset 'vip-move-overlay (symbol-function 'move-overlay)) | ||
| 144 | (if window-system | ||
| 145 | (fset 'vip-iconify (symbol-function 'iconify-or-deiconify-frame))) | ||
| 146 | (fset 'vip-raise-frame (symbol-function 'raise-frame)) | ||
| 147 | (fset 'vip-window-frame (symbol-function 'window-frame)) | ||
| 148 | (fset 'vip-select-frame (symbol-function 'select-frame)) | ||
| 149 | (fset 'vip-selected-frame (symbol-function 'selected-frame)) | ||
| 150 | (fset 'vip-frame-selected-window (symbol-function 'frame-selected-window)) | ||
| 151 | (fset 'vip-frame-parameters (symbol-function 'frame-parameters)) | ||
| 152 | (fset 'vip-modify-frame-parameters | ||
| 153 | (symbol-function 'modify-frame-parameters)) | ||
| 154 | (cond (window-system | ||
| 155 | (fset 'vip-get-face (symbol-function 'internal-get-face)) | ||
| 156 | (fset 'vip-color-defined-p (symbol-function 'x-color-defined-p)) | ||
| 157 | (fset 'vip-display-color-p (symbol-function 'x-display-color-p))))) | ||
| 158 | |||
| 159 | ;; OS/2 | ||
| 160 | (cond ((eq window-system 'pm) | ||
| 161 | (fset 'vip-color-defined-p | ||
| 162 | (function (lambda (color) (assoc color pm-color-alist)))))) | ||
| 163 | |||
| 164 | ;; needed to smooth out the difference between Emacs and XEmacs | ||
| 165 | (defsubst vip-italicize-face (face) | ||
| 166 | (if vip-xemacs-p | ||
| 167 | (make-face-italic face) | ||
| 168 | (make-face-italic face nil 'noerror))) | ||
| 169 | |||
| 170 | ;; test if display is color and the colors are defined | ||
| 171 | (defsubst vip-can-use-colors (&rest colors) | ||
| 172 | (if (vip-display-color-p) | ||
| 173 | (not (memq nil (mapcar 'vip-color-defined-p colors))) | ||
| 174 | )) | ||
| 175 | |||
| 176 | ;; currently doesn't work for XEmacs | ||
| 177 | (defun vip-change-cursor-color (new-color) | ||
| 178 | (if (and window-system (vip-display-color-p) | ||
| 179 | (stringp new-color) (vip-color-defined-p new-color)) | ||
| 180 | (vip-modify-frame-parameters | ||
| 181 | (vip-selected-frame) (list (cons 'cursor-color new-color))))) | ||
| 182 | |||
| 183 | (defsubst vip-save-cursor-color () | ||
| 184 | (if (and window-system (vip-display-color-p)) | ||
| 185 | (let ((color (cdr (assoc 'cursor-color (vip-frame-parameters))))) | ||
| 186 | (if (and (stringp color) (vip-color-defined-p color) | ||
| 187 | (not (string= color vip-replace-overlay-cursor-color))) | ||
| 188 | (vip-overlay-put vip-replace-overlay 'vip-cursor-color color))))) | ||
| 189 | |||
| 190 | (defsubst vip-restore-cursor-color () | ||
| 191 | (vip-change-cursor-color | ||
| 192 | (vip-overlay-get vip-replace-overlay 'vip-cursor-color))) | ||
| 193 | |||
| 194 | |||
| 195 | ;; Check the current version against the major and minor version numbers | ||
| 196 | ;; using op: cur-vers op major.minor If emacs-major-version or | ||
| 197 | ;; emacs-minor-version are not defined, we assume that the current version | ||
| 198 | ;; is hopelessly outdated. We assume that emacs-major-version and | ||
| 199 | ;; emacs-minor-version are defined. Otherwise, for Emacs/XEmacs 19, if the | ||
| 200 | ;; current minor version is < 10 (xemacs) or < 23 (emacs) the return value | ||
| 201 | ;; will be nil (when op is =, >, or >=) and t (when op is <, <=), which may be | ||
| 202 | ;; incorrect. However, this gives correct result in our cases, since we are | ||
| 203 | ;; testing for sufficiently high Emacs versions. | ||
| 204 | (defun vip-check-version (op major minor &optional type-of-emacs) | ||
| 205 | (if (and (boundp 'emacs-major-version) (boundp 'emacs-minor-version)) | ||
| 206 | (and (cond ((eq type-of-emacs 'xemacs) vip-xemacs-p) | ||
| 207 | ((eq type-of-emacs 'emacs) vip-emacs-p) | ||
| 208 | (t t)) | ||
| 209 | (cond ((eq op '=) (and (= emacs-minor-version minor) | ||
| 210 | (= emacs-major-version major))) | ||
| 211 | ((memq op '(> >= < <=)) | ||
| 212 | (and (or (funcall op emacs-major-version major) | ||
| 213 | (= emacs-major-version major)) | ||
| 214 | (if (= emacs-major-version major) | ||
| 215 | (funcall op emacs-minor-version minor) | ||
| 216 | t))) | ||
| 217 | (t | ||
| 218 | (error "%S: Invalid op in vip-check-version" op)))) | ||
| 219 | (cond ((memq op '(= > >=)) nil) | ||
| 220 | ((memq op '(< <=)) t)))) | ||
| 221 | |||
| 222 | |||
| 223 | ;; Early versions of XEmacs didn't have window-live-p (or it didn't work right) | ||
| 224 | (if (vip-check-version '< 19 11 'xemacs) | ||
| 225 | (defun window-live-p (win) | ||
| 226 | (let ((visible nil)) | ||
| 227 | (walk-windows | ||
| 228 | '(lambda (walk-win) | ||
| 229 | (if(equal walk-win win) | ||
| 230 | (setq visible t))) | ||
| 231 | nil 'all-screens) | ||
| 232 | visible)) | ||
| 233 | ) | ||
| 234 | |||
| 235 | |||
| 236 | (defun vip-get-visible-buffer-window (wind) | ||
| 237 | (if vip-xemacs-p | ||
| 238 | (get-buffer-window wind t) | ||
| 239 | (get-buffer-window wind 'visible))) | ||
| 240 | |||
| 241 | |||
| 242 | (defun vip-line-pos (pos) | ||
| 243 | "Return line position. | ||
| 244 | If pos is 'start then returns position of line start. | ||
| 245 | If pos is 'end, returns line end. If pos is 'mid, returns line center. | ||
| 246 | Pos = 'indent returns beginning of indentation. | ||
| 247 | Otherwise, returns point. Current point is not moved in any case." | ||
| 248 | (let ((cur-pos (point)) | ||
| 249 | (result)) | ||
| 250 | (cond | ||
| 251 | ((equal pos 'start) | ||
| 252 | (beginning-of-line)) | ||
| 253 | ((equal pos 'end) | ||
| 254 | (end-of-line)) | ||
| 255 | ((equal pos 'mid) | ||
| 256 | (goto-char (+ (vip-line-pos 'start) (vip-line-pos 'end) 2))) | ||
| 257 | ((equal pos 'indent) | ||
| 258 | (back-to-indentation)) | ||
| 259 | (t nil)) | ||
| 260 | (setq result (point)) | ||
| 261 | (goto-char cur-pos) | ||
| 262 | result)) | ||
| 263 | |||
| 264 | |||
| 265 | (defun vip-move-marker-locally (var pos &optional buffer) | ||
| 266 | "Like move-marker but creates a virgin marker if arg isn't already a marker. | ||
| 267 | The first argument must eval to a variable name. | ||
| 268 | Arguments: (var-name position &optional buffer). | ||
| 269 | |||
| 270 | This is useful for moving markers that are supposed to be local. | ||
| 271 | For this, VAR-NAME should be made buffer-local with nil as a default. | ||
| 272 | Then, each time this var is used in `vip-move-marker-locally' in a new | ||
| 273 | buffer, a new marker will be created." | ||
| 274 | (if (markerp (eval var)) | ||
| 275 | () | ||
| 276 | (set var (make-marker))) | ||
| 277 | (move-marker (eval var) pos buffer)) | ||
| 278 | |||
| 279 | |||
| 280 | (defun vip-message-conditions (conditions) | ||
| 281 | "Print CONDITIONS as a message." | ||
| 282 | (let ((case (car conditions)) (msg (cdr conditions))) | ||
| 283 | (if (null msg) | ||
| 284 | (message "%s" case) | ||
| 285 | (message "%s: %s" case (mapconcat 'prin1-to-string msg " "))) | ||
| 286 | (beep 1))) | ||
| 287 | |||
| 288 | |||
| 289 | ;;; List/alist utilities | ||
| 290 | |||
| 291 | (defun vip-list-to-alist (lst) | ||
| 292 | "Convert LIST to an alist." | ||
| 293 | (let ((alist)) | ||
| 294 | (while lst | ||
| 295 | (setq alist (cons (list (car lst)) alist)) | ||
| 296 | (setq lst (cdr lst))) | ||
| 297 | alist)) | ||
| 298 | |||
| 299 | (defun vip-alist-to-list (alst) | ||
| 300 | "Convert ALIST to a list." | ||
| 301 | (let ((lst)) | ||
| 302 | (while alst | ||
| 303 | (setq lst (cons (car (car alst)) lst)) | ||
| 304 | (setq alst (cdr alst))) | ||
| 305 | lst)) | ||
| 306 | |||
| 307 | (defun vip-filter-alist (regexp alst) | ||
| 308 | "Filter ALIST using REGEXP. Return alist whose elements match the regexp." | ||
| 309 | (interactive "s x") | ||
| 310 | (let ((outalst) (inalst alst)) | ||
| 311 | (while (car inalst) | ||
| 312 | (if (string-match regexp (car (car inalst))) | ||
| 313 | (setq outalst (cons (car inalst) outalst))) | ||
| 314 | (setq inalst (cdr inalst))) | ||
| 315 | outalst)) | ||
| 316 | |||
| 317 | (defun vip-filter-list (regexp lst) | ||
| 318 | "Filter LIST using REGEXP. Return list whose elements match the regexp." | ||
| 319 | (interactive "s x") | ||
| 320 | (let ((outlst) (inlst lst)) | ||
| 321 | (while (car inlst) | ||
| 322 | (if (string-match regexp (car inlst)) | ||
| 323 | (setq outlst (cons (car inlst) outlst))) | ||
| 324 | (setq inlst (cdr inlst))) | ||
| 325 | outlst)) | ||
| 326 | |||
| 327 | |||
| 328 | ;; Append LIS2 to LIS1, both alists, by side-effect and returns LIS1 | ||
| 329 | ;; LIS2 is modified by filtering it: deleting its members of the form | ||
| 330 | ;; \(car elt\) such that (car elt') is in LIS1. | ||
| 331 | (defun vip-append-filter-alist (lis1 lis2) | ||
| 332 | (let ((temp lis1) | ||
| 333 | elt) | ||
| 334 | |||
| 335 | ;;filter-append the second list | ||
| 336 | (while temp | ||
| 337 | ;; delete all occurrences | ||
| 338 | (while (setq elt (assoc (car (car temp)) lis2)) | ||
| 339 | (setq lis2 (delq elt lis2))) | ||
| 340 | (setq temp (cdr temp))) | ||
| 341 | |||
| 342 | (nconc lis1 lis2))) | ||
| 343 | |||
| 344 | |||
| 345 | |||
| 346 | |||
| 347 | ;;; Insertion ring | ||
| 348 | |||
| 349 | ;; Rotate RING's index. DIRection can be positive or negative. | ||
| 350 | (defun vip-ring-rotate1 (ring dir) | ||
| 351 | (if (and (ring-p ring) (> (ring-length ring) 0)) | ||
| 352 | (progn | ||
| 353 | (setcar ring (cond ((> dir 0) | ||
| 354 | (ring-plus1 (car ring) (ring-length ring))) | ||
| 355 | ((< dir 0) | ||
| 356 | (ring-minus1 (car ring) (ring-length ring))) | ||
| 357 | ;; don't rotate if dir = 0 | ||
| 358 | (t (car ring)))) | ||
| 359 | (vip-current-ring-item ring) | ||
| 360 | ))) | ||
| 361 | |||
| 362 | (defun vip-special-ring-rotate1 (ring dir) | ||
| 363 | (if (memq vip-intermediate-command | ||
| 364 | '(repeating-display-destructive-command | ||
| 365 | repeating-insertion-from-ring)) | ||
| 366 | (vip-ring-rotate1 ring dir) | ||
| 367 | ;; don't rotate otherwise | ||
| 368 | (vip-ring-rotate1 ring 0))) | ||
| 369 | |||
| 370 | ;; current ring item; if N is given, then so many items back from the | ||
| 371 | ;; current | ||
| 372 | (defun vip-current-ring-item (ring &optional n) | ||
| 373 | (setq n (or n 0)) | ||
| 374 | (if (and (ring-p ring) (> (ring-length ring) 0)) | ||
| 375 | (aref (cdr (cdr ring)) (mod (- (car ring) 1 n) (ring-length ring))))) | ||
| 376 | |||
| 377 | ;; push item onto ring. the second argument is a ring-variable, not value. | ||
| 378 | (defun vip-push-onto-ring (item ring-var) | ||
| 379 | (or (ring-p (eval ring-var)) | ||
| 380 | (set ring-var (make-ring (eval (intern (format "%S-size" ring-var)))))) | ||
| 381 | (or (null item) ; don't push nil | ||
| 382 | (and (stringp item) (string= item "")) ; or empty strings | ||
| 383 | (equal item (vip-current-ring-item (eval ring-var))) ; or old stuff | ||
| 384 | ;; Since vip-set-destructive-command checks if we are inside vip-repeat, | ||
| 385 | ;; we don't check whether this-command-keys is a `.'. | ||
| 386 | ;; The cmd vip-repeat makes a call to the current function only if | ||
| 387 | ;; `.' is executing a command from the command history. It doesn't | ||
| 388 | ;; call the push-onto-ring function if `.' is simply repeating the | ||
| 389 | ;; last destructive command. | ||
| 390 | ;; We only check for ESC (which happens when we do insert with a | ||
| 391 | ;; prefix argument, or if this-command-keys doesn't give anything | ||
| 392 | ;; meaningful (in that case we don't know what to show to the user). | ||
| 393 | (and (eq ring-var 'vip-command-ring) | ||
| 394 | (string-match "\\([0-9]*\e\\|^[ \t]*$\\|escape\\)" | ||
| 395 | (vip-array-to-string (this-command-keys)))) | ||
| 396 | (vip-ring-insert (eval ring-var) item)) | ||
| 397 | ) | ||
| 398 | |||
| 399 | |||
| 400 | ;; removing elts from ring seems to break it | ||
| 401 | (defun vip-cleanup-ring (ring) | ||
| 402 | (or (< (ring-length ring) 2) | ||
| 403 | (null (vip-current-ring-item ring)) | ||
| 404 | ;; last and previous equal | ||
| 405 | (if (equal (vip-current-ring-item ring) (vip-current-ring-item ring 1)) | ||
| 406 | (vip-ring-pop ring)))) | ||
| 407 | |||
| 408 | ;; ring-remove seems to be buggy, so we concocted this for our purposes. | ||
| 409 | (defun vip-ring-pop (ring) | ||
| 410 | (let* ((ln (ring-length ring)) | ||
| 411 | (vec (cdr (cdr ring))) | ||
| 412 | (veclen (length vec)) | ||
| 413 | (hd (car ring)) | ||
| 414 | (idx (max 0 (ring-minus1 hd ln))) | ||
| 415 | (top-elt (aref vec idx))) | ||
| 416 | |||
| 417 | ;; shift elements | ||
| 418 | (while (< (1+ idx) veclen) | ||
| 419 | (aset vec idx (aref vec (1+ idx))) | ||
| 420 | (setq idx (1+ idx))) | ||
| 421 | (aset vec idx nil) | ||
| 422 | |||
| 423 | (setq hd (max 0 (ring-minus1 hd ln))) | ||
| 424 | (if (= hd (1- ln)) (setq hd 0)) | ||
| 425 | (setcar ring hd) ; move head | ||
| 426 | (setcar (cdr ring) (max 0 (1- ln))) ; adjust length | ||
| 427 | top-elt | ||
| 428 | )) | ||
| 429 | |||
| 430 | (defun vip-ring-insert (ring item) | ||
| 431 | (let* ((ln (ring-length ring)) | ||
| 432 | (vec (cdr (cdr ring))) | ||
| 433 | (veclen (length vec)) | ||
| 434 | (hd (car ring)) | ||
| 435 | (vecpos-after-hd (if (= hd 0) ln hd)) | ||
| 436 | (idx ln)) | ||
| 437 | |||
| 438 | (if (= ln veclen) | ||
| 439 | (progn | ||
| 440 | (aset vec hd item) ; hd is always 1+ the actual head index in vec | ||
| 441 | (setcar ring (ring-plus1 hd ln))) | ||
| 442 | (setcar (cdr ring) (1+ ln)) | ||
| 443 | (setcar ring (ring-plus1 vecpos-after-hd (1+ ln))) | ||
| 444 | (while (and (>= idx vecpos-after-hd) (> ln 0)) | ||
| 445 | (aset vec idx (aref vec (1- idx))) | ||
| 446 | (setq idx (1- idx))) | ||
| 447 | (aset vec vecpos-after-hd item)) | ||
| 448 | item)) | ||
| 449 | |||
| 450 | |||
| 451 | ;;; String utilities | ||
| 452 | |||
| 453 | ;; If STRING is longer than MAX-LEN, truncate it and print ...... instead | ||
| 454 | ;; PRE-STRING is a string to prepend to the abbrev string. | ||
| 455 | ;; POST-STRING is a string to append to the abbrev string. | ||
| 456 | ;; ABBREV_SIGN is a string to be inserted before POST-STRING | ||
| 457 | ;; if the orig string was truncated. | ||
| 458 | (defun vip-abbreviate-string (string max-len | ||
| 459 | pre-string post-string abbrev-sign) | ||
| 460 | (let (truncated-str) | ||
| 461 | (setq truncated-str | ||
| 462 | (if (stringp string) | ||
| 463 | (substring string 0 (min max-len (length string))))) | ||
| 464 | (cond ((null truncated-str) "") | ||
| 465 | ((> (length string) max-len) | ||
| 466 | (format "%s%s%s%s" | ||
| 467 | pre-string truncated-str abbrev-sign post-string)) | ||
| 468 | (t (format "%s%s%s" pre-string truncated-str post-string))))) | ||
| 469 | |||
| 470 | |||
| 471 | ;;; Saving settings in custom file | ||
| 472 | |||
| 473 | (defun vip-save-setting (var message custom-file &optional erase-msg) | ||
| 474 | "Save the current setting of VAR in CUSTOM-FILE. | ||
| 475 | If given, MESSAGE is a message to be displayed after that. | ||
| 476 | This message is erased after 2 secs, if erase-msg is non-nil. | ||
| 477 | Arguments: (vip-save-setting var message custom-file &optional erase-message)" | ||
| 478 | (let* ((var-name (symbol-name var)) | ||
| 479 | (var-val (if (boundp var) (eval var))) | ||
| 480 | (regexp (format "^[^;]*%s[ \t\n]*[a-zA-Z---_']*[ \t\n)]" var-name)) | ||
| 481 | (buf (find-file-noselect (substitute-in-file-name custom-file))) | ||
| 482 | ) | ||
| 483 | (message message) | ||
| 484 | (save-excursion | ||
| 485 | (set-buffer buf) | ||
| 486 | (goto-char (point-min)) | ||
| 487 | (if (re-search-forward regexp nil t) | ||
| 488 | (let ((reg-end (1- (match-end 0)))) | ||
| 489 | (search-backward var-name) | ||
| 490 | (delete-region (match-beginning 0) reg-end) | ||
| 491 | (goto-char (match-beginning 0)) | ||
| 492 | (insert (format "%s '%S" var-name var-val))) | ||
| 493 | (goto-char (point-max)) | ||
| 494 | (if (not (bolp)) (insert "\n")) | ||
| 495 | (insert (format "(setq %s '%S)\n" var-name var-val))) | ||
| 496 | (save-buffer)) | ||
| 497 | (kill-buffer buf) | ||
| 498 | (if erase-msg | ||
| 499 | (progn | ||
| 500 | (sit-for 2) | ||
| 501 | (message ""))) | ||
| 502 | )) | ||
| 503 | |||
| 504 | ;; Save STRING in CUSTOM-FILE. If PATTERN is non-nil, remove strings that | ||
| 505 | ;; match this pattern. | ||
| 506 | (defun vip-save-string-in-file (string custom-file &optional pattern) | ||
| 507 | (let ((buf (find-file-noselect (substitute-in-file-name custom-file)))) | ||
| 508 | (save-excursion | ||
| 509 | (set-buffer buf) | ||
| 510 | (goto-char (point-min)) | ||
| 511 | (if pattern (delete-matching-lines pattern)) | ||
| 512 | (goto-char (point-max)) | ||
| 513 | (if string (insert string)) | ||
| 514 | (save-buffer)) | ||
| 515 | (kill-buffer buf) | ||
| 516 | )) | ||
| 517 | |||
| 518 | |||
| 519 | ;;; Overlays | ||
| 520 | |||
| 521 | ;; Search | ||
| 522 | |||
| 523 | (defun vip-flash-search-pattern () | ||
| 524 | (if (vip-overlay-p vip-search-overlay) | ||
| 525 | (vip-move-overlay vip-search-overlay (match-beginning 0) (match-end 0)) | ||
| 526 | (setq vip-search-overlay | ||
| 527 | (vip-make-overlay | ||
| 528 | (match-beginning 0) (match-end 0) (current-buffer)))) | ||
| 529 | |||
| 530 | (vip-overlay-put vip-search-overlay 'priority vip-search-overlay-priority) | ||
| 531 | (if window-system | ||
| 532 | (progn | ||
| 533 | (vip-overlay-put vip-search-overlay 'face vip-search-face) | ||
| 534 | (sit-for 2) | ||
| 535 | (vip-overlay-put vip-search-overlay 'face nil)))) | ||
| 536 | |||
| 537 | ;; Replace state | ||
| 538 | |||
| 539 | (defun vip-set-replace-overlay (beg end) | ||
| 540 | (if (vip-overlay-p vip-replace-overlay) | ||
| 541 | (vip-move-replace-overlay beg end) | ||
| 542 | (setq vip-replace-overlay (vip-make-overlay beg end (current-buffer))) | ||
| 543 | (vip-overlay-put vip-replace-overlay | ||
| 544 | 'vip-start | ||
| 545 | (move-marker (make-marker) | ||
| 546 | (vip-overlay-start vip-replace-overlay))) | ||
| 547 | (vip-overlay-put vip-replace-overlay | ||
| 548 | 'vip-end | ||
| 549 | (move-marker (make-marker) | ||
| 550 | (vip-overlay-end vip-replace-overlay))) | ||
| 551 | (vip-overlay-put | ||
| 552 | vip-replace-overlay 'priority vip-replace-overlay-priority)) | ||
| 553 | (if window-system | ||
| 554 | (vip-overlay-put vip-replace-overlay 'face vip-replace-overlay-face)) | ||
| 555 | (vip-save-cursor-color) | ||
| 556 | (vip-change-cursor-color vip-replace-overlay-cursor-color) | ||
| 557 | ) | ||
| 558 | |||
| 559 | |||
| 560 | (defsubst vip-hide-replace-overlay () | ||
| 561 | (vip-restore-cursor-color) | ||
| 562 | (if window-system | ||
| 563 | (vip-overlay-put vip-replace-overlay 'face nil))) | ||
| 564 | |||
| 565 | |||
| 566 | |||
| 567 | (defsubst vip-replace-start () | ||
| 568 | (vip-overlay-get vip-replace-overlay 'vip-start)) | ||
| 569 | (defsubst vip-replace-end () | ||
| 570 | (vip-overlay-get vip-replace-overlay 'vip-end)) | ||
| 571 | |||
| 572 | (defsubst vip-move-replace-overlay (beg end) | ||
| 573 | (vip-move-overlay vip-replace-overlay beg end) | ||
| 574 | (move-marker (vip-replace-start) (vip-overlay-start vip-replace-overlay)) | ||
| 575 | (move-marker (vip-replace-end) (vip-overlay-end vip-replace-overlay))) | ||
| 576 | |||
| 577 | |||
| 578 | ;; Minibuffer | ||
| 579 | |||
| 580 | (defun vip-set-minibuffer-overlay () | ||
| 581 | (vip-check-minibuffer-overlay) | ||
| 582 | ;; We always move the minibuffer overlay, since in XEmacs | ||
| 583 | ;; this overlay may get detached. Moving will reattach it. | ||
| 584 | ;; This overlay is also moved via the post-command-hook, | ||
| 585 | ;; to insure taht it covers the whole minibuffer. | ||
| 586 | (vip-move-minibuffer-overlay) | ||
| 587 | (if window-system | ||
| 588 | (progn | ||
| 589 | (vip-overlay-put | ||
| 590 | vip-minibuffer-overlay 'face vip-minibuffer-current-face) | ||
| 591 | (vip-overlay-put | ||
| 592 | vip-minibuffer-overlay 'priority vip-minibuffer-overlay-priority)) | ||
| 593 | )) | ||
| 594 | |||
| 595 | (defun vip-check-minibuffer-overlay () | ||
| 596 | (if (vip-overlay-p vip-minibuffer-overlay) | ||
| 597 | () | ||
| 598 | (setq vip-minibuffer-overlay | ||
| 599 | (vip-make-overlay 1 (1+ (buffer-size)) (current-buffer))))) | ||
| 600 | |||
| 601 | ;; arguments to this function are dummies. they are needed just because | ||
| 602 | ;; it is used as a insert-in-front-hook to vip-minibuffer-overlay, and such | ||
| 603 | ;; hooks require 3 arguments. | ||
| 604 | (defun vip-move-minibuffer-overlay (&optional overl beg end) | ||
| 605 | (if (vip-is-in-minibuffer) | ||
| 606 | (progn | ||
| 607 | (vip-check-minibuffer-overlay) | ||
| 608 | (vip-move-overlay vip-minibuffer-overlay 1 (1+ (buffer-size)))))) | ||
| 609 | |||
| 610 | (defsubst vip-is-in-minibuffer () | ||
| 611 | (string-match "\*Minibuf-" (buffer-name))) | ||
| 612 | |||
| 613 | |||
| 614 | |||
| 615 | ;;; XEmacs compatibility | ||
| 616 | |||
| 617 | ;; Sit for VAL miliseconds. XEmacs doesn't support the milisecond arg to | ||
| 618 | ;; sit-for, so this is for compatibility. | ||
| 619 | (defsubst vip-sit-for-short (val &optional nodisp) | ||
| 620 | (if vip-xemacs-p | ||
| 621 | (sit-for (/ val 1000.0) nodisp) | ||
| 622 | (sit-for 0 val nodisp))) | ||
| 623 | |||
| 624 | ;; EVENT may be a single event of a sequence of events | ||
| 625 | (defsubst vip-ESC-event-p (event) | ||
| 626 | (let ((ESC-keys '(?\e (control \[) escape)) | ||
| 627 | (key (vip-event-key event))) | ||
| 628 | (member key ESC-keys))) | ||
| 629 | |||
| 630 | ;; like (set-mark-command nil) but doesn't push twice, if (car mark-ring) | ||
| 631 | ;; is the same as (mark t). | ||
| 632 | (defsubst vip-set-mark-if-necessary () | ||
| 633 | (setq mark-ring (delete (vip-mark-marker) mark-ring)) | ||
| 634 | (set-mark-command nil)) | ||
| 635 | |||
| 636 | (defsubst vip-mark-marker () | ||
| 637 | (if vip-xemacs-p | ||
| 638 | (mark-marker t) | ||
| 639 | (mark-marker))) | ||
| 640 | |||
| 641 | ;; In transient mark mode (zmacs mode), it is annoying when regions become | ||
| 642 | ;; highlighted due to Viper's pushing marks. So, we deactivate marks, unless | ||
| 643 | ;; the user explicitly wants highlighting, e.g., by hitting '' or `` | ||
| 644 | (defun vip-deactivate-mark () | ||
| 645 | (if vip-xemacs-p | ||
| 646 | (zmacs-deactivate-region) | ||
| 647 | (deactivate-mark))) | ||
| 648 | |||
| 649 | |||
| 650 | (defsubst vip-events-to-keys (events) | ||
| 651 | (cond (vip-xemacs-p (events-to-keys events)) | ||
| 652 | (t events))) | ||
| 653 | |||
| 654 | |||
| 655 | (defun vip-eval-after-load (file form) | ||
| 656 | (if vip-emacs-p | ||
| 657 | (eval-after-load file form) | ||
| 658 | (or (assoc file after-load-alist) | ||
| 659 | (setq after-load-alist (cons (list file) after-load-alist))) | ||
| 660 | (let ((elt (assoc file after-load-alist))) | ||
| 661 | (or (member form (cdr elt)) | ||
| 662 | (setq elt (nconc elt (list form))))) | ||
| 663 | form | ||
| 664 | )) | ||
| 665 | |||
| 666 | |||
| 667 | ;; like read-event, but in XEmacs also try to convert to char, if possible | ||
| 668 | (defun vip-read-event-convert-to-char () | ||
| 669 | (let (event) | ||
| 670 | (if vip-emacs-p | ||
| 671 | (read-event) | ||
| 672 | (setq event (next-command-event)) | ||
| 673 | (or (event-to-character event) | ||
| 674 | event)) | ||
| 675 | )) | ||
| 676 | |||
| 677 | |||
| 678 | ;; Enacs has a bug in eventp, which causes (eventp nil) to return (nil) | ||
| 679 | ;; instead of nil, if '(nil) was previously inadvertantly assigned to | ||
| 680 | ;; unread-command-events | ||
| 681 | (defun vip-event-key (event) | ||
| 682 | (or (and event (eventp event)) | ||
| 683 | (error "vip-event-key: Wrong type argument, eventp, %S" event)) | ||
| 684 | (let ((mod (event-modifiers event)) | ||
| 685 | basis) | ||
| 686 | (setq basis | ||
| 687 | (cond | ||
| 688 | (vip-xemacs-p | ||
| 689 | (cond ((key-press-event-p event) | ||
| 690 | (event-key event)) | ||
| 691 | ((button-event-p event) | ||
| 692 | (concat "mouse-" (event-button event))) | ||
| 693 | (t | ||
| 694 | (error "vip-event-key: Unknown event, %S" event)))) | ||
| 695 | (t | ||
| 696 | ;; Emacs doesn't handle capital letters correctly, since | ||
| 697 | ;; \S-a isn't considered the same as A (it behaves as | ||
| 698 | ;; plain `a' instead). So we take care of this here | ||
| 699 | (if (and (numberp event) (<= ?A event) (<= event ?Z)) | ||
| 700 | (setq mod nil | ||
| 701 | event event) | ||
| 702 | (event-basic-type event))))) | ||
| 703 | |||
| 704 | (if (numberp basis) | ||
| 705 | (setq basis | ||
| 706 | (if (= basis ?\C-?) | ||
| 707 | (list 'control '\?) ; taking care of an emacs bug | ||
| 708 | (intern (char-to-string basis))))) | ||
| 709 | |||
| 710 | (if mod | ||
| 711 | (append mod (list basis)) | ||
| 712 | basis) | ||
| 713 | )) | ||
| 714 | |||
| 715 | (defun vip-key-to-emacs-key (key) | ||
| 716 | (let (key-name char-p modifiers mod-char-list base-key base-key-name) | ||
| 717 | (cond (vip-xemacs-p key) | ||
| 718 | ((symbolp key) | ||
| 719 | (setq key-name (symbol-name key)) | ||
| 720 | (if (= (length key-name) 1) ; character event | ||
| 721 | (string-to-char key-name) | ||
| 722 | key)) | ||
| 723 | ((listp key) | ||
| 724 | (setq modifiers (subseq key 0 (1- (length key))) | ||
| 725 | base-key (vip-seq-last-elt key) | ||
| 726 | base-key-name (symbol-name base-key) | ||
| 727 | char-p (= (length base-key-name) 1)) | ||
| 728 | (setq mod-char-list | ||
| 729 | (mapcar | ||
| 730 | '(lambda (elt) (upcase (substring (symbol-name elt) 0 1))) | ||
| 731 | modifiers)) | ||
| 732 | (if char-p | ||
| 733 | (setq key-name | ||
| 734 | (car (read-from-string | ||
| 735 | (concat | ||
| 736 | "?\\" | ||
| 737 | (mapconcat 'identity mod-char-list "-\\") | ||
| 738 | "-" | ||
| 739 | base-key-name)))) | ||
| 740 | (setq key-name | ||
| 741 | (intern | ||
| 742 | (concat | ||
| 743 | (mapconcat 'identity mod-char-list "-") | ||
| 744 | "-" | ||
| 745 | base-key-name)))))) | ||
| 746 | )) | ||
| 747 | |||
| 748 | |||
| 749 | ;; Args can be a sequence of events, a string, or a Viper macro. Will try to | ||
| 750 | ;; convert events to keys and, if all keys are regular printable | ||
| 751 | ;; characters, will return a string. Otherwise, will return a string | ||
| 752 | ;; representing a vector of converted events. If the input was a Viper macro, | ||
| 753 | ;; will return a string that represents this macro as a vector. | ||
| 754 | (defun vip-array-to-string (event-seq &optional representation) | ||
| 755 | (let (temp) | ||
| 756 | (cond ((stringp event-seq) event-seq) | ||
| 757 | ((vip-event-vector-p event-seq) | ||
| 758 | (setq temp (mapcar 'vip-event-key event-seq)) | ||
| 759 | (if (vip-char-symbol-sequence-p temp) | ||
| 760 | (mapconcat 'symbol-name temp "") | ||
| 761 | (prin1-to-string (vconcat temp)))) | ||
| 762 | ((vip-char-symbol-sequence-p event-seq) | ||
| 763 | (mapconcat 'symbol-name event-seq "")) | ||
| 764 | (t (prin1-to-string event-seq))))) | ||
| 765 | |||
| 766 | |||
| 767 | (defsubst vip-fast-keysequence-p () | ||
| 768 | (not (vip-sit-for-short vip-fast-keyseq-timeout t))) | ||
| 769 | |||
| 770 | (defun vip-read-char-exclusive () | ||
| 771 | (let (char | ||
| 772 | (echo-keystrokes 1)) | ||
| 773 | (while (null char) | ||
| 774 | (condition-case nil | ||
| 775 | (setq char (read-char)) | ||
| 776 | (error | ||
| 777 | ;; skip event if not char | ||
| 778 | (vip-read-event)))) | ||
| 779 | char)) | ||
| 780 | |||
| 781 | |||
| 782 | |||
| 783 | (defun vip-setup-master-buffer (&rest other-files-or-buffers) | ||
| 784 | "Set up the current buffer as a master buffer. | ||
| 785 | Arguments become related buffers. This function should normally be used in | ||
| 786 | the `Local variables' section of a file." | ||
| 787 | (setq vip-related-files-and-buffers-ring | ||
| 788 | (make-ring (1+ (length other-files-or-buffers)))) | ||
| 789 | (mapcar '(lambda (elt) | ||
| 790 | (vip-ring-insert vip-related-files-and-buffers-ring elt)) | ||
| 791 | other-files-or-buffers) | ||
| 792 | (vip-ring-insert vip-related-files-and-buffers-ring (buffer-name)) | ||
| 793 | ) | ||
| 794 | |||
| 795 | |||
| 796 | (provide 'viper-util) | ||
| 797 | |||
| 798 | ;;; viper-util.el ends here | ||
diff --git a/lisp/emulation/viper.el b/lisp/emulation/viper.el new file mode 100644 index 00000000000..b0533fbfd61 --- /dev/null +++ b/lisp/emulation/viper.el | |||
| @@ -0,0 +1,5486 @@ | |||
| 1 | ;;; viper.el --- A full-featured Vi emulator for GNU Emacs 19 and XEmacs 19, | ||
| 2 | ;; a VI Plan for Emacs Rescue, | ||
| 3 | ;; and a venomous VI PERil. | ||
| 4 | ;; Viper Is also a Package for Emacs Rebels. | ||
| 5 | |||
| 6 | ;; Version: 2.71 | ||
| 7 | ;; Keywords: emulations | ||
| 8 | ;; Author: Michael Kifer <kifer@cs.sunysb.edu> | ||
| 9 | |||
| 10 | ;; LCD Archive Entry: | ||
| 11 | ;; viper|Michael Kifer|kifer@cs.sunysb.edu| | ||
| 12 | ;; A full-featured Vi emulator for GNU Emacs 19 and XEmacs 19| | ||
| 13 | ;; 17-February-95|2.71|~/modes/viper.tar.Z| | ||
| 14 | |||
| 15 | (defconst viper-version "2.71 of February 17, 1995" | ||
| 16 | "The current version of Viper") | ||
| 17 | |||
| 18 | ;; This file is part of GNU Emacs. | ||
| 19 | |||
| 20 | ;; GNU Emacs is free software; you can redistribute it and/or modify | ||
| 21 | ;; it under the terms of the GNU General Public License as published by | ||
| 22 | ;; the Free Software Foundation; either version 2, or (at your option) | ||
| 23 | ;; any later version. | ||
| 24 | |||
| 25 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 26 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 27 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 28 | ;; GNU General Public License for more details. | ||
| 29 | |||
| 30 | ;; You should have received a copy of the GNU General Public License | ||
| 31 | ;; along with GNU Emacs; see the file COPYING. If not, write to | ||
| 32 | ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | ||
| 33 | |||
| 34 | ;;; Commentary: | ||
| 35 | |||
| 36 | ;; Viper is a full-featured Vi emulator for Emacs 19. It emulates and | ||
| 37 | ;; improves upon the standard features of Vi and, at the same time, allows | ||
| 38 | ;; full access to all Emacs facilities. Viper supports multiple undo, | ||
| 39 | ;; file name completion, command, file, and search history and it extends | ||
| 40 | ;; Vi in many other ways. Viper is highly customizable through the various | ||
| 41 | ;; hooks, user variables, and keymaps. It is implemented as a collection | ||
| 42 | ;; of minor modes and it is designed to provide full access to all Emacs | ||
| 43 | ;; major and minor modes. | ||
| 44 | ;; | ||
| 45 | ;;; History | ||
| 46 | ;; | ||
| 47 | ;; Viper is a new name for a package formerly known as VIP-19, | ||
| 48 | ;; which was a successor of VIP version 3.5 by Masahiko Sato | ||
| 49 | ;; <ms@sail.stanford.edu> and VIP version 4.2 by Aamod Sane | ||
| 50 | ;; <sane@cs.uiuc.edu>. Some ideas from vip 4.4.2 by Aamod Sane | ||
| 51 | ;; were also shamelessly plagiarized. | ||
| 52 | ;; | ||
| 53 | ;; Viper maintains some degree of compatibility with these older | ||
| 54 | ;; packages. See the documentation for customization. | ||
| 55 | ;; | ||
| 56 | ;; The main difference between Viper and these older packages are: | ||
| 57 | ;; | ||
| 58 | ;; 1. Viper emulates Vi at several levels, from almost complete conformity | ||
| 59 | ;; to a rather loose Vi-compliance. | ||
| 60 | ;; | ||
| 61 | ;; 2. Viper provides full access to all major and minor modes of Emacs | ||
| 62 | ;; without the need to type extra keys. | ||
| 63 | ;; The older versions of VIP (and other Vi emulators) do not work with | ||
| 64 | ;; some major and minor modes. | ||
| 65 | ;; | ||
| 66 | ;; 3. Viper supports vi-style undo. | ||
| 67 | ;; | ||
| 68 | ;; 4. Viper fully emulates (and improves upon) vi's replacement mode. | ||
| 69 | ;; | ||
| 70 | ;; 5. Viper has a better interface to ex, including command, variable, and | ||
| 71 | ;; file name completion. | ||
| 72 | ;; | ||
| 73 | ;; 6. Viper uses native Emacs history and completion features; it doesn't | ||
| 74 | ;; rely on other packages (such as gmhist.el and completer.el) to provide | ||
| 75 | ;; these features. | ||
| 76 | ;; | ||
| 77 | ;; 7. Viper supports Vi-style editing in the minibuffer, by allowing the | ||
| 78 | ;; user to switch from Insert state to Vi state to Replace state, etc. | ||
| 79 | ;; | ||
| 80 | ;; 8. Viper keeps history of recently inserted pieces of text and recently | ||
| 81 | ;; executed Vi-style destructive commands, such as `i', `d', etc. | ||
| 82 | ;; These pieces of text can be inserted in later insertion commands; | ||
| 83 | ;; the previous destructive commands can be re-executed. | ||
| 84 | ;; | ||
| 85 | ;; 9. Viper has Vi-style keyboard macros, which enhances the similar | ||
| 86 | ;; facility in the original Vi. | ||
| 87 | ;; First, one can execute any Emacs command while defining a | ||
| 88 | ;; macro, not just the Vi commands. Second, macros are defined in a | ||
| 89 | ;; WYSYWYG mode, using an interface to Emacs' WYSIWYG style of defining | ||
| 90 | ;; macros. Third, in Viper, one can define macros that are specific to | ||
| 91 | ;; a given buffer, a given major mode, or macros defined for all buffers. | ||
| 92 | ;; The same macro name can have several different definitions: | ||
| 93 | ;; one global, several definitions for various major modes, and | ||
| 94 | ;; definitions for specific buffers. | ||
| 95 | ;; Bffer-specific definitions override mode-specific | ||
| 96 | ;; definitions, which, in turn, override global definitions. | ||
| 97 | ;; | ||
| 98 | ;; | ||
| 99 | ;;; Installation: | ||
| 100 | ;; ------------- | ||
| 101 | ;; | ||
| 102 | ;; (require 'viper) | ||
| 103 | ;; | ||
| 104 | |||
| 105 | ;;; Acknowledgements: | ||
| 106 | ;; ----------------- | ||
| 107 | ;; Bug reports and ideas contributed by the following users | ||
| 108 | ;; have helped improve Viper and the various versions of VIP: | ||
| 109 | ;; | ||
| 110 | ;; jjm@hplb.hpl.hp.com (Jean-Jacques Moreau), jl@cse.ogi.edu (John | ||
| 111 | ;; Launchbury), rxga@ulysses.att.com, jamesm@bga.com (D.J. Miller II), | ||
| 112 | ;; ascott@fws214.intel.com (Andy Scott), toma@convex.convex.com, | ||
| 113 | ;; gvr@cs.brown.edu, dave@hellgate.utah.edu, cook@biostat.wisc.edu | ||
| 114 | ;; (Tom Cook), lindstro@biostat.wisc.edu (Mary Lindstrom), | ||
| 115 | ;; edmonds@edmonds.home.cs.ubc.ca (Brian Edmonds), mveiga@dit.upm.es | ||
| 116 | ;; (Marcelino Veiga Tuimil), dwight@toolucky.llnl.gov (Dwight Shih), | ||
| 117 | ;; phil_brooks@MENTORG.COM (Phil Brooks), kin@isi.com (Kin Cho), | ||
| 118 | ;; ahg@panix.com (Al Gelders), dwallach@cs.princeton.edu (Dan Wallach), | ||
| 119 | ;; hpz@ibmhpz.aug.ipp-garching.mpg.de (Hans-Peter Zehrfeld), | ||
| 120 | ;; simonb@prl.philips.co.uk (Simon Blanchard), Mark.Bordas@East.Sun.COM | ||
| 121 | ;; (Mark Bordas), gviswana@cs.wisc.edu (Guhan Viswanathan) | ||
| 122 | ;; | ||
| 123 | ;; Special thanks to Marcelino Veiga Tuimil <mveiga@dit.upm.es> for | ||
| 124 | ;; suggesting a way of intercepting ESC sequences on dumb terminals. Due to | ||
| 125 | ;; this, Viper can now handle arrow keys, F-keys, etc., in Xterm windows | ||
| 126 | ;; and on dumb terminals. This also made it possible to implement Vi-style | ||
| 127 | ;; timeout macros. | ||
| 128 | ;; | ||
| 129 | ;; | ||
| 130 | ;;; Notes: | ||
| 131 | ;; | ||
| 132 | ;; 1. Major modes. | ||
| 133 | ;; In most cases, Viper handles major modes correctly, i.e., they come up | ||
| 134 | ;; in the right state (either vi-state or emacs-state). For instance, text | ||
| 135 | ;; files come up in vi-state, while, say, Dired appears in emacs-state by | ||
| 136 | ;; default. | ||
| 137 | ;; However, some modes do not appear in the right mode in the beginning, | ||
| 138 | ;; usually because they neglect to follow Emacs conventions (e.g., they don't | ||
| 139 | ;; use (kill-all-local-variables) when they start. Some major modes | ||
| 140 | ;; may fail to come up in emacs-state if they call hooks, such as | ||
| 141 | ;; text-hook, for no good reason. | ||
| 142 | ;; | ||
| 143 | ;; As an immediate solution, you can hit C-z to bring about the right mode. | ||
| 144 | ;; An interim solution is to add an appropriate hook to the mode like this: | ||
| 145 | ;; | ||
| 146 | ;; (add-hook 'your-favorite-mode 'viper-mode) | ||
| 147 | ;; or | ||
| 148 | ;; (add-hook 'your-favorite-mode 'vip-change-state-to-emacs) | ||
| 149 | ;; | ||
| 150 | ;; whichever applies. The right thing to do, however, is to complain to the | ||
| 151 | ;; author of the respective package. (Sometimes they also neglect to equip | ||
| 152 | ;; their modes with hooks, which is one more reason for complaining.) | ||
| 153 | ;; | ||
| 154 | ;; 2. Keymap handling | ||
| 155 | ;; Because Emacs 19 has an elegant mechanism for turning minor mode keymaps | ||
| 156 | ;; on and off, implementation of Viper has been greatly simplified. Viper | ||
| 157 | ;; has several minor modes. | ||
| 158 | ;; | ||
| 159 | ;; Viper's Vi state consists of seven minor modes: | ||
| 160 | ;; | ||
| 161 | ;; vip-vi-intercept-minor-mode | ||
| 162 | ;; vip-vi-local-user-minor-mode | ||
| 163 | ;; vip-vi-global-user-minor-mode | ||
| 164 | ;; vip-vi-kbd-minor-mode | ||
| 165 | ;; vip-vi-state-modifier-minor-mode | ||
| 166 | ;; vip-vi-diehard-minor-mode | ||
| 167 | ;; vip-vi-basic-minor-mode | ||
| 168 | ;; | ||
| 169 | ;; Bindings done to the keymap of the first mode overshadow those done to | ||
| 170 | ;; the second, which, in turn, overshadows those done to the third, etc. | ||
| 171 | ;; | ||
| 172 | ;; The last vip-vi-basic-minor-mode contains most of the usual Vi bindings | ||
| 173 | ;; in its edit mode. This mode provides access to all Emacs facilities. | ||
| 174 | ;; Novice users, however, may want to set their vip-expert-level to 1 | ||
| 175 | ;; in their .vip file. This will enable vip-vi-diehard-minor-mode. This | ||
| 176 | ;; minor mode's bindings make Viper simulate the usual Vi very closely. | ||
| 177 | ;; For instance, C-c will not have its standard Emacs binding | ||
| 178 | ;; and so many of the goodies of Emacs are not available. | ||
| 179 | ;; | ||
| 180 | ;; An skilled user, should set vip-expert-level to at least 3. This will | ||
| 181 | ;; enable ;; C-c and many Emacs facilities will become available. | ||
| 182 | ;; In this case, vip-vi-diehard-minor-mode is inactive. | ||
| 183 | ;; | ||
| 184 | ;; Viper gurus should have at least | ||
| 185 | ;; (setq vip-expert-level 4) | ||
| 186 | ;; in their ~/.vip files. This will unsuppress all Emacs keys that are not | ||
| 187 | ;; essential for VI-style editing. | ||
| 188 | ;; Pick-and-choose users may want to put | ||
| 189 | ;; (setq vip-expert-level 5) | ||
| 190 | ;; in ~/.vip. Viper will then leave it up to the user to set the variables | ||
| 191 | ;; vip-want-* See vip-set-expert-level for details. | ||
| 192 | ;; | ||
| 193 | ;; The very first minor mode, vip-vi-intercept-minor-mode, is of no | ||
| 194 | ;; concern for the user. It is needed to bind Viper's vital keys, such as | ||
| 195 | ;; ESC and C-z. | ||
| 196 | ;; | ||
| 197 | ;; The second mode, vip-vi-local-user-minor-mode, usually has an | ||
| 198 | ;; empty keymap. However, the user can set bindings in this keymap, which | ||
| 199 | ;; will overshadow the corresponding bindings in the other two minor | ||
| 200 | ;; modes. This is useful, for example, for setting up ZZ in gnus, | ||
| 201 | ;; rmail, mh-e, etc., to send message instead of saving it in a file. | ||
| 202 | ;; Likewise, in Dired mode, you may want to bind ZN and ZP to commands | ||
| 203 | ;; that would visit the next or the previous file in the Dired buffer. | ||
| 204 | ;; Setting local keys is tricky, so don't do it directly. Instead, use | ||
| 205 | ;; vip-add-local-keys function (see its doc). | ||
| 206 | ;; | ||
| 207 | ;; The third minor mode, vip-vi-global-user-minor-mode, is also intended | ||
| 208 | ;; for the users but, unlike vip-vi-local-user-minor-mode, its key | ||
| 209 | ;; bindings are seen in all Viper buffers. This mode keys can be done | ||
| 210 | ;; with define-key command. | ||
| 211 | ;; | ||
| 212 | ;; The fourth minor mode, vip-vi-kbd-minor-mode, is used by keyboard | ||
| 213 | ;; macros. Users are NOT supposed to modify this keymap directly. | ||
| 214 | ;; | ||
| 215 | ;; The fifth mode, vip-vi-state-modifier-minor-mode, can be used to set | ||
| 216 | ;; key bindings that are visible in some major modes but not in others. | ||
| 217 | ;; | ||
| 218 | ;; Users are allowed to modify keymaps that belong to | ||
| 219 | ;; vip-vi-local-user-minor-mode, vip-vi-global-user-minor-mode, | ||
| 220 | ;; and vip-vi-state-modifier-minor-mode only. | ||
| 221 | ;; | ||
| 222 | ;; Viper's Insert state also has seven minor modes: | ||
| 223 | ;; | ||
| 224 | ;; vip-insert-intercept-minor-mode | ||
| 225 | ;; vip-insert-local-user-minor-mode | ||
| 226 | ;; vip-insert-global-user-minor-mode | ||
| 227 | ;; vip-insert-kbd-minor-mode | ||
| 228 | ;; vip-insert-state-modifier-minor-mode | ||
| 229 | ;; vip-insert-diehard-minor-mode | ||
| 230 | ;; vip-insert-basic-minor-mode | ||
| 231 | ;; | ||
| 232 | ;; As with VI's editing modes, the first mode, vip-insert-intercept-minor-mode | ||
| 233 | ;; is used to bind vital keys that are not to be changed by the user. | ||
| 234 | ;; | ||
| 235 | ;; The next mode, vip-insert-local-user-minor-mode, is used to customize | ||
| 236 | ;; bindings in the insert state of Viper. The third mode, | ||
| 237 | ;; vip-insert-global-user-minor-mode is like | ||
| 238 | ;; vip-insert-local-user-minor-mode, except that its bindings are seen in | ||
| 239 | ;; all Viper buffers. As with vip-vi-local-user-minor-mode, its bindings | ||
| 240 | ;; should be done via the function vip-add-local-keys. Bindings for | ||
| 241 | ;; vip-insert-global-user-minor-mode can be set with the define-key command. | ||
| 242 | ;; | ||
| 243 | ;; The next minor mode, vip-insert-kbd-minor-mode, | ||
| 244 | ;; is used for keyboard VI-style macros defined with :map!. | ||
| 245 | ;; | ||
| 246 | ;; The fifth minor mode, vip-insert-state-modifier-minor-mode, is like | ||
| 247 | ;; vip-vi-state-modifier-minor-mode, except that it is used in the Insert | ||
| 248 | ;; state; it can be used to modify keys in a mode-specific fashion. | ||
| 249 | ;; | ||
| 250 | ;; The minor mode vip-insert-diehard-minor-mode is in effect when | ||
| 251 | ;; the user wants a high degree of Vi compatibility (a bad idea, really!). | ||
| 252 | ;; The last minor mode, vip-insert-basic-minor-mode, is always in effect | ||
| 253 | ;; when Viper is in insert state. It binds a small number of keys needed for | ||
| 254 | ;; Viper's operation. | ||
| 255 | ;; | ||
| 256 | ;; Finally, Viper provides minor modes for overriding bindings set by Emacs | ||
| 257 | ;; modes when Viper is in Emacs state: | ||
| 258 | ;; | ||
| 259 | ;; vip-emacs-local-user-minor-mode | ||
| 260 | ;; vip-emacs-global-user-minor-mode | ||
| 261 | ;; vip-emacs-kbd-minor-mode | ||
| 262 | ;; vip-emacs-state-modifier-minor-mode | ||
| 263 | ;; | ||
| 264 | ;; These minor modes are in effect when Viper is in Emacs state. The keymap | ||
| 265 | ;; associated with vip-emacs-global-user-minor-mode, | ||
| 266 | ;; vip-emacs-global-user-map, overrides the global and local keymaps as | ||
| 267 | ;; well as the minor mode keymaps set by other modes. The keymap of | ||
| 268 | ;; vip-emacs-local-user-minor-mode, vip-emacs-local-user-map, overrides | ||
| 269 | ;; everything, but it is used on a per buffer basis. | ||
| 270 | ;; The keymap associated with vip-emacs-state-modifier-minor-mode | ||
| 271 | ;; overrides keys on a per-major-mode basis. The mode | ||
| 272 | ;; vip-emacs-kbd-minor-mode is used to define Vi-style macros in Emacs | ||
| 273 | ;; state. | ||
| 274 | ;; | ||
| 275 | ;; 3. There is also one minor mode that is used when Viper is in its | ||
| 276 | ;; replace-state (used for commands like cw, C, etc.). This mode is | ||
| 277 | ;; called | ||
| 278 | ;; | ||
| 279 | ;; vip-replace-minor-mode | ||
| 280 | ;; | ||
| 281 | ;; and its keymap is vip-replace-map. Replace minor mode is always | ||
| 282 | ;; used in conjunction with the minor modes for insert-state, and its | ||
| 283 | ;; keymap overshadows the keymaps for insert minor modes. | ||
| 284 | ;; | ||
| 285 | ;; 4. Defining buffer-local bindings in Vi and Insert modes. | ||
| 286 | ;; As mentioned before, sometimes, it is convenient to have | ||
| 287 | ;; buffer-specific of mode-specific key bindings in Vi and insert modes. | ||
| 288 | ;; Viper provides a special function, vip-add-local-keys, to do precisely | ||
| 289 | ;; this. For instance, is you need to add couple of mode-specific bindings | ||
| 290 | ;; to Insert mode, you can put | ||
| 291 | ;; | ||
| 292 | ;; (vip-add-local-keys 'insert-state '((key1 . func1) (key2 .func2))) | ||
| 293 | ;; | ||
| 294 | ;; somewhere in a hook of this major mode. If you put something like this | ||
| 295 | ;; in your own elisp function, this will define bindings specific to the | ||
| 296 | ;; buffer that was current at the time of the call to vip-add-local-keys. | ||
| 297 | ;; The only thing to make sure here is that the major mode of this buffer | ||
| 298 | ;; is written according to Emacs conventions, which includes a call to | ||
| 299 | ;; (kill-all-local-variables). See vip-add-local-keys for more details. | ||
| 300 | ;; | ||
| 301 | ;; | ||
| 302 | ;; TO DO (volunteers?): | ||
| 303 | ;; | ||
| 304 | ;; 1. Some of the code that is inherited from VIP-3.5 is rather | ||
| 305 | ;; convoluted. Instead of vip-command-argument, keymaps should bind the | ||
| 306 | ;; actual commands. E.g., "dw" should be bound to a generic command | ||
| 307 | ;; vip-delete that will delete things based on the value of | ||
| 308 | ;; last-command-char. This would greatly simplify the logic and the code. | ||
| 309 | ;; | ||
| 310 | ;; 2. Somebody should venture to write a customization package a la | ||
| 311 | ;; options.el that would allow the user to change values of variables | ||
| 312 | ;; that meet certain specs (e.g., match a regexp) and whose doc string | ||
| 313 | ;; starts with a '*'. Then, the user should be offered to save | ||
| 314 | ;; variables that were changed. This will make user's customization job | ||
| 315 | ;; much easier. | ||
| 316 | ;; | ||
| 317 | |||
| 318 | |||
| 319 | (require 'advice) | ||
| 320 | (require 'cl) | ||
| 321 | (require 'ring) | ||
| 322 | |||
| 323 | (require 'viper-util) | ||
| 324 | |||
| 325 | |||
| 326 | ;;; Variables | ||
| 327 | |||
| 328 | ;; Is t until viper-mode executes for the very first time. | ||
| 329 | ;; Prevents recursive descend into startup messages. | ||
| 330 | (defvar vip-first-time t) | ||
| 331 | |||
| 332 | (defvar vip-expert-level 0 | ||
| 333 | "User's expert level. | ||
| 334 | The minor mode vip-vi-diehard-minor-mode is in effect when | ||
| 335 | vip-expert-level is 1 or 2 or when vip-want-emacs-keys-in-vi is t. | ||
| 336 | The minor mode vip-insert-diehard-minor-mode is in effect when | ||
| 337 | vip-expert-level is 1 or 2 or if vip-want-emacs-keys-in-insert is t. | ||
| 338 | Use `M-x vip-set-expert-level' to change this.") | ||
| 339 | |||
| 340 | ;; Max expert level supported by Viper. This is NOT a user option. | ||
| 341 | ;; It is here to make it hard for the user from resetting it. | ||
| 342 | (defconst vip-max-expert-level 5) | ||
| 343 | |||
| 344 | ;; Contains user settings for vars affected by vip-set-expert-level function. | ||
| 345 | ;; Not a user option. | ||
| 346 | (defvar vip-saved-user-settings nil) | ||
| 347 | |||
| 348 | |||
| 349 | ;;; Viper minor modes | ||
| 350 | |||
| 351 | ;; for some reason, this is not local in Emacs, so I made it so. | ||
| 352 | (make-variable-buffer-local 'minor-mode-map-alist) | ||
| 353 | |||
| 354 | ;; Ideally, minor-mode-map-alist should be permanent-local. But Emacs has a | ||
| 355 | ;; bug that precludes that. So, there is a workaround in | ||
| 356 | ;; vip-harness-minor-mode. | ||
| 357 | ;;(put 'minor-mode-map-alist 'permanent-local t) | ||
| 358 | |||
| 359 | ;; Mode for vital things like \e, C-z. | ||
| 360 | (vip-deflocalvar vip-vi-intercept-minor-mode nil) | ||
| 361 | |||
| 362 | (vip-deflocalvar vip-vi-basic-minor-mode nil | ||
| 363 | "Viper's minor mode for Vi bindings.") | ||
| 364 | |||
| 365 | (vip-deflocalvar vip-vi-local-user-minor-mode nil | ||
| 366 | "Auxiliary minor mode for user-defined local bindings in Vi state.") | ||
| 367 | |||
| 368 | (vip-deflocalvar vip-vi-global-user-minor-mode nil | ||
| 369 | "Auxiliary minor mode for user-defined global bindings in Vi state.") | ||
| 370 | |||
| 371 | (vip-deflocalvar vip-vi-state-modifier-minor-mode nil | ||
| 372 | "Minor mode used to make major-mode-specific modification to Vi state.") | ||
| 373 | |||
| 374 | (vip-deflocalvar vip-vi-diehard-minor-mode nil | ||
| 375 | "This minor mode is in effect when the user wants Viper to be Vi.") | ||
| 376 | |||
| 377 | (vip-deflocalvar vip-vi-kbd-minor-mode nil | ||
| 378 | "Minor mode for Ex command macros Vi state. | ||
| 379 | The corresponding keymap stores key bindings of Vi macros defined with | ||
| 380 | the Ex command :map.") | ||
| 381 | |||
| 382 | ;; Mode for vital things like \e, C-z. | ||
| 383 | (vip-deflocalvar vip-insert-intercept-minor-mode nil) | ||
| 384 | |||
| 385 | (vip-deflocalvar vip-insert-basic-minor-mode nil | ||
| 386 | "Viper's minor mode for bindings in Insert mode.") | ||
| 387 | |||
| 388 | (vip-deflocalvar vip-insert-local-user-minor-mode nil | ||
| 389 | "Auxiliary minor mode for buffer-local user-defined bindings in Insert state. | ||
| 390 | This is a way to overshadow normal Insert mode bindings locally to certain | ||
| 391 | designated buffers.") | ||
| 392 | |||
| 393 | (vip-deflocalvar vip-insert-global-user-minor-mode nil | ||
| 394 | "Auxiliary minor mode for global user-defined bindings in Insert state.") | ||
| 395 | |||
| 396 | (vip-deflocalvar vip-insert-state-modifier-minor-mode nil | ||
| 397 | "Minor mode used to make major-mode-specific modification to Insert state.") | ||
| 398 | |||
| 399 | (vip-deflocalvar vip-insert-diehard-minor-mode nil | ||
| 400 | "Minor mode that simulates Vi very closely. | ||
| 401 | Not recommened, except for the novice user.") | ||
| 402 | |||
| 403 | (vip-deflocalvar vip-insert-kbd-minor-mode nil | ||
| 404 | "Minor mode for Ex command macros Insert state. | ||
| 405 | The corresponding keymap stores key bindings of Vi macros defined with | ||
| 406 | the Ex command :map!.") | ||
| 407 | |||
| 408 | (vip-deflocalvar vip-replace-minor-mode nil | ||
| 409 | "Minor mode in effect in replace state (cw, C, and the like commands).") | ||
| 410 | |||
| 411 | ;; Mode for vital things like \C-z and \C-x) | ||
| 412 | ;; This is t, by default. So, any new buffer will have C-z defined as | ||
| 413 | ;; switch to Vi, unless we switched states in this buffer | ||
| 414 | (vip-deflocalvar vip-emacs-intercept-minor-mode t) | ||
| 415 | |||
| 416 | (vip-deflocalvar vip-emacs-local-user-minor-mode t | ||
| 417 | "Minor mode for local user bindings effective in Emacs state. | ||
| 418 | Users can use it to override Emacs bindings when Viper is in its Emacs | ||
| 419 | state.") | ||
| 420 | |||
| 421 | (vip-deflocalvar vip-emacs-global-user-minor-mode t | ||
| 422 | "Minor mode for global user bindings in effect in Emacs state. | ||
| 423 | Users can use it to override Emacs bindings when Viper is in its Emacs | ||
| 424 | state.") | ||
| 425 | |||
| 426 | (vip-deflocalvar vip-emacs-kbd-minor-mode t | ||
| 427 | "Minor mode for Vi style macros in Emacs state. | ||
| 428 | The corresponding keymap stores key bindings of Vi macros defined with | ||
| 429 | `vip-record-kbd-macro' command. There is no Ex-level command to do this | ||
| 430 | interactively.") | ||
| 431 | |||
| 432 | (vip-deflocalvar vip-emacs-state-modifier-minor-mode t | ||
| 433 | "Minor mode used to make major-mode-specific modification to Emacs state. | ||
| 434 | For instance, a Vi purist may want to bind `dd' in Dired mode to a function | ||
| 435 | that deletes a file.") | ||
| 436 | |||
| 437 | |||
| 438 | |||
| 439 | ;;; ISO characters | ||
| 440 | |||
| 441 | (defvar vip-automatic-iso-accents nil | ||
| 442 | "*If non-nil, ISO accents will be turned on in insert/replace emacs states and turned off in vi-state. | ||
| 443 | For some users, this behavior may be too primitive. In this case, use | ||
| 444 | insert/emacs/vi state hooks.") | ||
| 445 | |||
| 446 | |||
| 447 | ;;; Emacs keys in other states. | ||
| 448 | |||
| 449 | (defvar vip-want-emacs-keys-in-insert t | ||
| 450 | "*Set to nil if you want complete Vi compatibility in insert mode. | ||
| 451 | Complete compatibility with Vi is not recommended for power use of Viper.") | ||
| 452 | |||
| 453 | (defvar vip-want-emacs-keys-in-vi t | ||
| 454 | "*Set to nil if you want complete Vi compatibility in Vi mode. | ||
| 455 | Full Vi compatibility is not recommended for power use of Viper.") | ||
| 456 | |||
| 457 | |||
| 458 | |||
| 459 | ;; VI-style Undo | ||
| 460 | |||
| 461 | ;; Used to 'undo' complex commands, such as replace and insert commands. | ||
| 462 | (vip-deflocalvar vip-undo-needs-adjustment nil) | ||
| 463 | (put 'vip-undo-needs-adjustment 'permanent-local t) | ||
| 464 | |||
| 465 | ;; A mark that Viper puts on buffer-undo-list. Marks the beginning of a | ||
| 466 | ;; complex command that must be undone atomically. If inserted, it is | ||
| 467 | ;; erased by vip-change-state-to-vi and vip-repeat. | ||
| 468 | (defconst vip-buffer-undo-list-mark 'viper) | ||
| 469 | |||
| 470 | (defvar vip-keep-point-on-undo nil | ||
| 471 | "*Non-nil means not to move point while undoing commands. | ||
| 472 | This style is different from Emacs and Vi. Try it to see if | ||
| 473 | it better fits your working style.") | ||
| 474 | |||
| 475 | ;; Replace mode and changing text | ||
| 476 | |||
| 477 | ;; Viper's own after/before change functions, which get add-hook'ed to Emacs' | ||
| 478 | (vip-deflocalvar vip-after-change-functions nil "") | ||
| 479 | (vip-deflocalvar vip-before-change-functions nil "") | ||
| 480 | (vip-deflocalvar vip-post-command-hooks nil "") | ||
| 481 | (vip-deflocalvar vip-pre-command-hooks nil "") | ||
| 482 | |||
| 483 | ;; Can be used to pass global states around for short period of time | ||
| 484 | (vip-deflocalvar vip-intermediate-command nil "") | ||
| 485 | |||
| 486 | ;; Indicates that the current destructive command has started in replace mode. | ||
| 487 | (vip-deflocalvar vip-began-as-replace nil "") | ||
| 488 | |||
| 489 | (defvar vip-replace-overlay-cursor-color "Red" | ||
| 490 | "*Color to use in Replace state") | ||
| 491 | |||
| 492 | |||
| 493 | (vip-deflocalvar vip-replace-overlay nil "") | ||
| 494 | (put 'vip-replace-overlay 'permanent-local t) | ||
| 495 | |||
| 496 | (if window-system | ||
| 497 | (progn | ||
| 498 | (make-face 'vip-replace-overlay-face) | ||
| 499 | (or (face-differs-from-default-p 'vip-replace-overlay-face) | ||
| 500 | (progn | ||
| 501 | (if (vip-can-use-colors "darkseagreen2" "Black") | ||
| 502 | (progn | ||
| 503 | (set-face-background | ||
| 504 | 'vip-replace-overlay-face "darkseagreen2") | ||
| 505 | (set-face-foreground 'vip-replace-overlay-face "Black"))) | ||
| 506 | (set-face-underline-p 'vip-replace-overlay-face t)) | ||
| 507 | ))) | ||
| 508 | |||
| 509 | (defvar vip-replace-overlay-face 'vip-replace-overlay-face | ||
| 510 | "*Face for highlighting replace regions on a window display.") | ||
| 511 | |||
| 512 | (defvar vip-replace-region-end-symbol | ||
| 513 | (if (and window-system (vip-display-color-p)) "" "$") | ||
| 514 | "*Symbol to mark the end of a replacement region. A string. | ||
| 515 | At present, only the first character of a non-empty string is used to | ||
| 516 | actually mark the region.") | ||
| 517 | (defvar vip-replace-region-start-symbol "" | ||
| 518 | "*Symbol to mark the beginning of a replacement region. A string. | ||
| 519 | Not yet implemented.") | ||
| 520 | |||
| 521 | ;; These are local marker that must be initialized to nil and moved with | ||
| 522 | ;; `vip-move-marker-locally' | ||
| 523 | ;; | ||
| 524 | ;; Remember the last position inside the replace region. | ||
| 525 | (vip-deflocalvar vip-last-posn-in-replace-region nil) | ||
| 526 | ;; Remember the last position while inserting | ||
| 527 | (vip-deflocalvar vip-last-posn-while-in-insert-state nil) | ||
| 528 | (put 'vip-last-posn-in-replace-region 'permanent-local t) | ||
| 529 | (put 'vip-last-posn-while-in-insert-state 'permanent-local t) | ||
| 530 | |||
| 531 | (vip-deflocalvar vip-sitting-in-replace nil "") | ||
| 532 | (put 'vip-sitting-in-replace 'permanent-local t) | ||
| 533 | |||
| 534 | ;; Remember the number of characters that have to be deleted in replace | ||
| 535 | ;; mode to compensate for the inserted characters. | ||
| 536 | (vip-deflocalvar vip-replace-chars-to-delete 0 "") | ||
| 537 | (vip-deflocalvar vip-replace-chars-deleted 0 "") | ||
| 538 | |||
| 539 | ;; Insertion ring and command ring | ||
| 540 | (defvar vip-insertion-ring-size 14 | ||
| 541 | "The size of the insertion ring.") | ||
| 542 | ;; The insertion ring. | ||
| 543 | (defvar vip-insertion-ring nil) | ||
| 544 | ;; This is temp insertion ring. Used to do rotation for display purposes. | ||
| 545 | ;; When rotation just started, it is initialized to vip-insertion-ring. | ||
| 546 | (defvar vip-temp-insertion-ring nil) | ||
| 547 | (defvar vip-last-inserted-string-from-insertion-ring "") | ||
| 548 | |||
| 549 | (defvar vip-command-ring-size 14 | ||
| 550 | "The size of the command ring.") | ||
| 551 | ;; The command ring. | ||
| 552 | (defvar vip-command-ring nil) | ||
| 553 | ;; This is temp command ring. Used to do rotation for display purposes. | ||
| 554 | ;; When rotation just started, it is initialized to vip-command-ring. | ||
| 555 | (defvar vip-temp-command-ring nil) | ||
| 556 | |||
| 557 | ;; Modes and related variables | ||
| 558 | |||
| 559 | ;; Current mode. One of: `emacs-state', `vi-state', `insert-state' | ||
| 560 | (vip-deflocalvar vip-current-state 'emacs-state) | ||
| 561 | |||
| 562 | |||
| 563 | (defvar vip-toggle-key "\C-z" | ||
| 564 | "The key used to change states from emacs to Vi and back. | ||
| 565 | In insert mode, this key also functions as Meta. | ||
| 566 | Must be set in .vip file or prior to loading Viper. | ||
| 567 | This setting cannot be changed interactively.") | ||
| 568 | |||
| 569 | (defvar vip-ESC-key "\e" | ||
| 570 | "Key used to ESC. | ||
| 571 | Must be set in .vip file or prior to loading Viper. | ||
| 572 | This setting cannot be changed interactively.") | ||
| 573 | |||
| 574 | (defvar vip-no-multiple-ESC t | ||
| 575 | "*If true, multiple ESC in Vi mode will cause bell to ring. | ||
| 576 | \_ is then mapped to Meta. | ||
| 577 | This is set to t on a windowing terminal and to 'twice on a dumb | ||
| 578 | terminal (unless the user level is 1, 2, or 5). On a dumb terminal, this | ||
| 579 | enables cursor keys and is generally more convenient, as terminals usually | ||
| 580 | don't have a convenient Meta key. | ||
| 581 | Setting vip-no-multiple-ESC to nil will allow as many multiple ESC, | ||
| 582 | as is allowed by the major mode in effect.") | ||
| 583 | |||
| 584 | |||
| 585 | (defvar vip-want-ctl-h-help nil | ||
| 586 | "*If t then C-h is bound to help-command in insert mode, if nil then it is | ||
| 587 | bound to delete-backward-char.") | ||
| 588 | |||
| 589 | ;; Autoindent in insert | ||
| 590 | |||
| 591 | ;; Variable that keeps track of whether C-t has been pressed. | ||
| 592 | (vip-deflocalvar vip-cted nil "") | ||
| 593 | |||
| 594 | ;; Preserve the indent value, used by C-d in insert mode. | ||
| 595 | (vip-deflocalvar vip-current-indent 0) | ||
| 596 | |||
| 597 | ;; Whether to preserve the indent, used by C-d in insert mode. | ||
| 598 | (vip-deflocalvar vip-preserve-indent nil) | ||
| 599 | |||
| 600 | (defconst vip-auto-indent nil | ||
| 601 | "*Autoindent if t.") | ||
| 602 | |||
| 603 | (defconst vip-shift-width 8 | ||
| 604 | "*The shiftwidth variable.") | ||
| 605 | |||
| 606 | ;; Variables for repeating destructive commands | ||
| 607 | |||
| 608 | (defconst vip-keep-point-on-repeat t | ||
| 609 | "*If t, don't move point when repeating previous command. | ||
| 610 | This is useful for doing repeated changes with the '.' key. | ||
| 611 | The user can change this to nil, if she likes when the cursor moves | ||
| 612 | to a new place after repeating previous Vi command.") | ||
| 613 | |||
| 614 | ;; Remember insert point as a marker. This is a local marker that must be | ||
| 615 | ;; initialized to nil and moved with `vip-move-marker-locally'. | ||
| 616 | (vip-deflocalvar vip-insert-point nil) | ||
| 617 | (put 'vip-insert-point 'permanent-local t) | ||
| 618 | |||
| 619 | ;; This remembers the point before dabbrev-expand was called. | ||
| 620 | ;; If vip-insert-point turns out to be bigger than that, it is reset | ||
| 621 | ;; back to vip-pre-command-point. | ||
| 622 | ;; The reason this is needed is because dabbrev-expand (and possibly | ||
| 623 | ;; others) may jump to before the insertion point, delete something and | ||
| 624 | ;; then reinsert a bigger piece. For instance: bla^blo | ||
| 625 | ;; If dabbrev-expand is called after `blo' and ^ undicates vip-insert-point, | ||
| 626 | ;; then point jumps to the beginning of `blo'. If expansion is found, `blablo' | ||
| 627 | ;; is deleted, and we have |^, where | denotes point. Next, dabbrev-expand | ||
| 628 | ;; will insert the expansion, and we get: blablo^ | ||
| 629 | ;; Whatever we insert next goes before the ^, i.e., before the | ||
| 630 | ;; vip-insert-point marker. So, Viper will think that nothing was | ||
| 631 | ;; inserted. Remembering the orig position of the marker circumvents the | ||
| 632 | ;; problem. | ||
| 633 | ;; We don't know of any command, except dabbrev-expand, that has the same | ||
| 634 | ;; problem. However, the same trick can be used if such a command is | ||
| 635 | ;; discovered later. | ||
| 636 | ;; | ||
| 637 | (vip-deflocalvar vip-pre-command-point nil) | ||
| 638 | (put 'vip-pre-command-point 'permanent-local t) ; this is probably an overkill | ||
| 639 | |||
| 640 | ;; This is used for saving inserted text. | ||
| 641 | (defvar vip-last-insertion nil) | ||
| 642 | |||
| 643 | ;; Remembers the last replaced region. | ||
| 644 | (defvar vip-last-replace-region "") | ||
| 645 | |||
| 646 | ;; Remember com point as a marker. | ||
| 647 | ;; This is a local marker. Should be moved with `vip-move-marker-locally' | ||
| 648 | (vip-deflocalvar vip-com-point nil) | ||
| 649 | |||
| 650 | ;; If non-nil, the value is a list (M-COM VAL COM REG inserted-text cmd-keys) | ||
| 651 | ;; It is used to re-execute last destructive command. | ||
| 652 | ;; M-COM is a Lisp symbol representing the function to be executed. | ||
| 653 | ;; VAL is the prefix argument that was used with that command. | ||
| 654 | ;; COM is an internal descriptor, such as ?r, ?c, ?C, which contains | ||
| 655 | ;; additional information on how the function in M-COM is to be handled. | ||
| 656 | ;; REG is the register used by command | ||
| 657 | ;; INSERTED-TEXT is text inserted by that command (in case of o, c, C, i, r | ||
| 658 | ;; commands). | ||
| 659 | ;; COMMAND-KEYS are the keys that were typed to invoke the command. | ||
| 660 | (defvar vip-d-com nil) | ||
| 661 | |||
| 662 | ;; The character remembered by the Vi `r' command. | ||
| 663 | (defvar vip-d-char nil) | ||
| 664 | |||
| 665 | ;; Name of register to store deleted or yanked strings | ||
| 666 | (defvar vip-use-register nil) | ||
| 667 | |||
| 668 | |||
| 669 | |||
| 670 | ;; Variables for Moves and Searches | ||
| 671 | |||
| 672 | ;; For use by `;' command. | ||
| 673 | (defvar vip-f-char nil) | ||
| 674 | |||
| 675 | ;; For use by `.' command. | ||
| 676 | (defvar vip-F-char nil) | ||
| 677 | |||
| 678 | ;; For use by `;' command. | ||
| 679 | (defvar vip-f-forward nil) | ||
| 680 | |||
| 681 | ;; For use by `;' command. | ||
| 682 | (defvar vip-f-offset nil) | ||
| 683 | |||
| 684 | ;; Last search string | ||
| 685 | (defvar vip-s-string "") | ||
| 686 | |||
| 687 | (defvar vip-quote-string "> " | ||
| 688 | "String inserted at the beginning of quoted region.") | ||
| 689 | |||
| 690 | ;; If t, search is forward. | ||
| 691 | (defvar vip-s-forward nil) | ||
| 692 | |||
| 693 | (defconst vip-case-fold-search nil | ||
| 694 | "*If t, search ignores cases.") | ||
| 695 | |||
| 696 | (defconst vip-re-search t | ||
| 697 | "*If t, search is reg-exp search, otherwise vanilla search.") | ||
| 698 | |||
| 699 | (defconst vip-re-query-replace t | ||
| 700 | "*If t then do regexp replace, if nil then do string replace.") | ||
| 701 | |||
| 702 | (defconst vip-re-replace t | ||
| 703 | "*If t, do regexp replace. nil means do string replace.") | ||
| 704 | |||
| 705 | (vip-deflocalvar vip-ex-style-motion t | ||
| 706 | "*Ex-style: the commands l,h do not cross lines, etc.") | ||
| 707 | |||
| 708 | (vip-deflocalvar vip-ex-style-editing-in-insert t | ||
| 709 | "*The keys ^H, ^? don't jump lines in insert, ESC moves cursor back, etc. | ||
| 710 | Note: this doesn't preclude ^H and ^? from deleting characters by moving | ||
| 711 | past the insertion point. This is a feature, not a bug. ") | ||
| 712 | |||
| 713 | (vip-deflocalvar vip-delete-backwards-in-replace nil | ||
| 714 | "*If t, DEL key will delete characters while moving the cursor backwards. | ||
| 715 | If nil, the cursor will move backwards without deleting anything.") | ||
| 716 | |||
| 717 | (defconst vip-buffer-search-char nil | ||
| 718 | "*Key bound for buffer-searching.") | ||
| 719 | |||
| 720 | (defconst vip-search-wrap-around-t t | ||
| 721 | "*If t, search wraps around.") | ||
| 722 | |||
| 723 | (vip-deflocalvar vip-related-files-and-buffers-ring nil | ||
| 724 | "*Ring of file and buffer names that are considered to be related to the | ||
| 725 | current buffer. | ||
| 726 | These buffers can be cycled through via :R and :P commands.") | ||
| 727 | (put 'vip-related-files-and-buffers-ring 'permanent-local t) | ||
| 728 | |||
| 729 | ;; Used to find out if we are done with searching the current buffer. | ||
| 730 | (vip-deflocalvar vip-local-search-start-marker nil) | ||
| 731 | ;; As above, but global | ||
| 732 | (defvar vip-search-start-marker (make-marker)) | ||
| 733 | |||
| 734 | ;; the search overlay | ||
| 735 | (vip-deflocalvar vip-search-overlay nil) | ||
| 736 | |||
| 737 | |||
| 738 | (defvar vip-heading-start | ||
| 739 | (concat "^\\s-*(\\s-*defun\\s-\\|" ;; lisp | ||
| 740 | "^{\\s-*$\\|^[_a-zA-Z][^()]*[()].*{\\s-*$\\|" ;; C/C++ | ||
| 741 | "^\\s-*class.*{\\|^\\s-*struct.*{\\|^\\s-*enum.*{\\|" | ||
| 742 | "^\\\\[sb][a-z]*{.*}\\s-*$\\|" ;; latex | ||
| 743 | "^@node\\|@table\\|^@m?enu\\|^@itemize\\|^@if\\|" ;; texinfo | ||
| 744 | "^.+:-") ;; prolog | ||
| 745 | "*Regexps for Headings. Used by \[\[ and \]\].") | ||
| 746 | |||
| 747 | (defvar vip-heading-end | ||
| 748 | (concat "^}\\|" ;; C/C++ | ||
| 749 | "^\\\\end{\\|" ;; latex | ||
| 750 | "^@end \\|" ;; texinfo | ||
| 751 | ")\n\n[ \t\n]*\\|" ;; lisp | ||
| 752 | "\\.\\s-*$") ;; prolog | ||
| 753 | "*Regexps to end Headings/Sections. Used by \[\].") | ||
| 754 | |||
| 755 | |||
| 756 | ;; These two vars control the interaction of jumps performed by ' and `. | ||
| 757 | ;; In this new version, '' doesn't erase the marks set by ``, so one can | ||
| 758 | ;; use both kinds of jumps interchangeably and without loosing positions | ||
| 759 | ;; inside the lines. | ||
| 760 | |||
| 761 | ;; Remembers position of the last jump done using ``'. | ||
| 762 | (vip-deflocalvar vip-last-jump nil) | ||
| 763 | ;; Remembers position of the last jump done using `''. | ||
| 764 | (vip-deflocalvar vip-last-jump-ignore 0) | ||
| 765 | |||
| 766 | ;; Some common error messages | ||
| 767 | |||
| 768 | (defconst vip-SpuriousText "Spurious text after command" "") | ||
| 769 | (defconst vip-BadExCommand "Not an editor command" "") | ||
| 770 | (defconst vip-InvalidCommandArgument "Invalid command argument" "") | ||
| 771 | (defconst vip-NoPrevSearch "No previous search string" "") | ||
| 772 | (defconst vip-EmptyRegister "`%c': Nothing in this register" "") | ||
| 773 | (defconst vip-InvalidRegister "`%c': Invalid register" "") | ||
| 774 | (defconst vip-EmptyTextmarker "`%c': Text marker doesn't point anywhere" "") | ||
| 775 | (defconst vip-InvalidTextmarker "`%c': Invalid text marker" "") | ||
| 776 | (defconst vip-InvalidViCommand "Invalid command" "") | ||
| 777 | (defconst vip-BadAddress "Ill-formed address" "") | ||
| 778 | (defconst vip-FirstAddrExceedsSecond "First address exceeds second" "") | ||
| 779 | (defconst vip-NoFileSpecified "No file specified" "") | ||
| 780 | |||
| 781 | |||
| 782 | ;; History variables | ||
| 783 | |||
| 784 | (defvar vip-history nil) | ||
| 785 | ;; History of search strings. | ||
| 786 | (defvar vip-search-history (list "")) | ||
| 787 | ;; History of query-replace strings used as a source. | ||
| 788 | (defvar vip-replace1-history nil) | ||
| 789 | ;; History of query-replace strings used as replacement. | ||
| 790 | (defvar vip-replace2-history nil) | ||
| 791 | ;; History of region quoting strings. | ||
| 792 | (defvar vip-quote-region-history (list vip-quote-string)) | ||
| 793 | ;; History of Ex-style commands. | ||
| 794 | (defvar vip-ex-history nil) | ||
| 795 | ;; History of shell commands. | ||
| 796 | (defvar vip-shell-history nil) | ||
| 797 | |||
| 798 | |||
| 799 | ;; Last shell command. There are two of these, one for Ex (in viper-ex) | ||
| 800 | ;; and one for Vi. | ||
| 801 | |||
| 802 | ;; Last shell command executed with ! command. | ||
| 803 | (defvar vip-last-shell-com nil) | ||
| 804 | |||
| 805 | |||
| 806 | |||
| 807 | ;;; Miscellaneous | ||
| 808 | |||
| 809 | ;; setup emacs-supported vi-style feel | ||
| 810 | (setq mark-even-if-inactive t | ||
| 811 | next-line-add-newlines nil | ||
| 812 | require-final-newline t) | ||
| 813 | |||
| 814 | (defvar vip-inhibit-startup-message nil | ||
| 815 | "Whether Viper startup message should be inhibited.") | ||
| 816 | |||
| 817 | (defvar vip-always t | ||
| 818 | "t means, arrange that vi-state will be a default.") | ||
| 819 | |||
| 820 | (defvar vip-custom-file-name "~/.vip" | ||
| 821 | "Viper customisation file. | ||
| 822 | This variable must be set _before_ loading Viper.") | ||
| 823 | |||
| 824 | (defvar vip-info-file-name "viper" | ||
| 825 | "The name prefix for Viper Info files.") | ||
| 826 | |||
| 827 | (defvar vip-spell-function 'ispell-region | ||
| 828 | "Spell function used by #s<move> command to spell.") | ||
| 829 | |||
| 830 | (defvar vip-tags-file-name "TAGS") | ||
| 831 | |||
| 832 | ;; Minibuffer | ||
| 833 | |||
| 834 | (defvar vip-vi-style-in-minibuffer t | ||
| 835 | "If t, use vi-style editing in minibuffer. | ||
| 836 | Should be set in `~/.vip' file.") | ||
| 837 | |||
| 838 | ;; overlay used in the minibuffer to indicate which state it is in | ||
| 839 | (vip-deflocalvar vip-minibuffer-overlay nil) | ||
| 840 | |||
| 841 | ;; Hook, specific to Viper, which is run just *before* exiting the minibuffer. | ||
| 842 | ;; Beginning with Emacs 19.26, the standard `minibuffer-exit-hook' is run | ||
| 843 | ;; *after* exiting the minibuffer | ||
| 844 | (defvar vip-minibuffer-exit-hook nil) | ||
| 845 | |||
| 846 | (vip-deflocalvar vip-vi-minibuffer-minor-mode nil | ||
| 847 | "Minor mode that forces Vi-style when the Minibuffer is in Vi state.") | ||
| 848 | (vip-deflocalvar vip-insert-minibuffer-minor-mode nil | ||
| 849 | "Minor mode that forces Vi-style when the Minibuffer is in Insert state.") | ||
| 850 | |||
| 851 | (vip-deflocalvar vip-add-newline-at-eob t | ||
| 852 | "If t, always add a newline at the end of buffer. | ||
| 853 | Usually, Viper adds a newline character at the end of the last | ||
| 854 | line in a buffer, if it's missing. In some major modes, however, like | ||
| 855 | shell-mode, this is undesirable and must be set to nil. See vip-set-hooks.") | ||
| 856 | |||
| 857 | |||
| 858 | ;; Mode line | ||
| 859 | (defconst vip-vi-state-id "<V> " | ||
| 860 | "Mode line tag identifying the Vi mode of Viper.") | ||
| 861 | (defconst vip-emacs-state-id "<E> " | ||
| 862 | "Mode line tag identifying the Emacs mode of Viper.") | ||
| 863 | (defconst vip-insert-state-id "<I> " | ||
| 864 | "Mode line tag identifying the Insert mode of Viper.") | ||
| 865 | (defconst vip-replace-state-id "<R> " | ||
| 866 | "Mode line tag identifying the Replace mode of Viper.") | ||
| 867 | |||
| 868 | ;; Viper changes the default mode-line-buffer-identification | ||
| 869 | (setq-default mode-line-buffer-identification '(" %b")) | ||
| 870 | |||
| 871 | ;; Variable displaying the current Viper state in the mode line. | ||
| 872 | (vip-deflocalvar vip-mode-string vip-emacs-state-id) | ||
| 873 | (or (memq 'vip-mode-string global-mode-string) | ||
| 874 | (setq global-mode-string | ||
| 875 | (append '("" vip-mode-string) (cdr global-mode-string)))) | ||
| 876 | |||
| 877 | |||
| 878 | (defvar vip-vi-state-hooks nil | ||
| 879 | "*Hooks run just before the switch to Vi mode is completed.") | ||
| 880 | (defvar vip-insert-state-hooks nil | ||
| 881 | "*Hooks run just before the switch to Insert mode is completed.") | ||
| 882 | (defvar vip-replace-state-hooks nil | ||
| 883 | "*Hooks run just before the switch to Replace mode is completed.") | ||
| 884 | (defvar vip-emacs-state-hooks nil | ||
| 885 | "*Hooks run just before the switch to Emacs mode is completed.") | ||
| 886 | |||
| 887 | (defvar vip-load-hooks nil | ||
| 888 | "Hooks run just after loading Viper.") | ||
| 889 | |||
| 890 | |||
| 891 | ;; Generic predicates | ||
| 892 | |||
| 893 | ;; These test functions are shamelessly lifted from vip 4.4.2 by Aamod Sane | ||
| 894 | |||
| 895 | ;; generate test functions | ||
| 896 | ;; given symbol foo, foo-p is the test function, foos is the set of | ||
| 897 | ;; Viper command keys | ||
| 898 | ;; (macroexpand '(vip-test-com-defun foo)) | ||
| 899 | ;; (defun foo-p (com) (consp (memq (if (< com 0) (- com) com) foos))) | ||
| 900 | |||
| 901 | (defmacro vip-test-com-defun (name) | ||
| 902 | (let* (;;(snm (make-symbol "s1")) | ||
| 903 | (snm (symbol-name name)) | ||
| 904 | ;;(nm-p (make-symbol "s2")) | ||
| 905 | (nm-p (intern (concat snm "-p"))) | ||
| 906 | ;;(nms (make-symbol "s3")) | ||
| 907 | (nms (intern (concat snm "s")))) | ||
| 908 | (` (defun (, nm-p) (com) | ||
| 909 | (consp (memq (if (< com 0) (- com) com) (, nms))))))) | ||
| 910 | |||
| 911 | ;; Variables for defining VI commands | ||
| 912 | |||
| 913 | (defconst vip-prefix-commands '(?c ?d ?y ?! ?= ?# ?< ?> ?\") | ||
| 914 | "Modifying commands that can be prefixes to movement commands") | ||
| 915 | (vip-test-com-defun vip-prefix-command) | ||
| 916 | |||
| 917 | (defconst vip-charpair-commands '(?c ?d ?y ?! ?= ?< ?> ?r ?R) | ||
| 918 | "Commands that are pairs eg. dd. r and R here are a hack") | ||
| 919 | (vip-test-com-defun vip-charpair-command) | ||
| 920 | |||
| 921 | (defconst vip-movement-commands '(?b ?B ?e ?E ?f ?F ?G ?h ?H ?j ?k ?l | ||
| 922 | ?H ?M ?n ?t ?T ?w ?W ?$ ?% | ||
| 923 | ?^ ?( ?) ?- ?+ ?| ?{ ?} ?[ ?] ?' ?` | ||
| 924 | ?; ?, ?0 ?? ?/ | ||
| 925 | ) | ||
| 926 | "Movement commands") | ||
| 927 | (vip-test-com-defun vip-movement-command) | ||
| 928 | |||
| 929 | (defconst vip-dotable-commands '(?c ?d ?C ?D ?> ?<) | ||
| 930 | "Commands that can be repeated by .(dotted)") | ||
| 931 | (vip-test-com-defun vip-dotable-command) | ||
| 932 | |||
| 933 | (defconst vip-hash-cmds '(?c ?C ?g ?q ?S) | ||
| 934 | "Commands that can follow a #") | ||
| 935 | (vip-test-com-defun vip-hash-cmd) | ||
| 936 | |||
| 937 | (defconst vip-regsuffix-commands '(?d ?y ?Y ?D ?p ?P ?x ?X) | ||
| 938 | "Commands that may have registers as prefix") | ||
| 939 | (vip-test-com-defun vip-regsuffix-command) | ||
| 940 | |||
| 941 | |||
| 942 | |||
| 943 | ;;; Arrange the keymaps | ||
| 944 | (require 'viper-keym) | ||
| 945 | |||
| 946 | |||
| 947 | ;;;; CODE | ||
| 948 | |||
| 949 | ;; changing mode | ||
| 950 | |||
| 951 | ;; Change state to NEW-STATE---either emacs-state, vi-state, or insert-state. | ||
| 952 | (defun vip-change-state (new-state) | ||
| 953 | ;; keep them always fresh | ||
| 954 | (add-hook 'post-command-hook 'vip-post-command-sentinel t) | ||
| 955 | (add-hook 'pre-command-hook 'vip-pre-command-sentinel t) | ||
| 956 | ;; These hooks will be added back if switching to insert/replace mode | ||
| 957 | (remove-hook 'vip-post-command-hooks | ||
| 958 | 'vip-insert-state-post-command-sentinel) | ||
| 959 | (remove-hook 'vip-pre-command-hooks | ||
| 960 | 'vip-insert-state-pre-command-sentinel) | ||
| 961 | (cond ((eq new-state 'vi-state) | ||
| 962 | (cond ((member vip-current-state '(insert-state replace-state)) | ||
| 963 | |||
| 964 | ;; move vip-last-posn-while-in-insert-state | ||
| 965 | ;; This is a normal hook that is executed in insert/replace | ||
| 966 | ;; states after each command. In Vi/Emacs state, it does | ||
| 967 | ;; nothing. We need to execute it here to make sure that | ||
| 968 | ;; the last posn was recorded when we hit ESC. | ||
| 969 | ;; It may be left unrecorded if the last thing done in | ||
| 970 | ;; insert/repl state was dabbrev-expansion or abbrev | ||
| 971 | ;; expansion caused by hitting ESC | ||
| 972 | (vip-insert-state-post-command-sentinel) | ||
| 973 | |||
| 974 | (condition-case conds | ||
| 975 | (progn | ||
| 976 | (vip-save-last-insertion | ||
| 977 | vip-insert-point | ||
| 978 | vip-last-posn-while-in-insert-state) | ||
| 979 | (if vip-began-as-replace | ||
| 980 | (setq vip-began-as-replace nil) | ||
| 981 | ;; repeat insert commands if numerical arg > 1 | ||
| 982 | (save-excursion | ||
| 983 | (vip-repeat-insert-command)))) | ||
| 984 | (error | ||
| 985 | (vip-message-conditions conds))) | ||
| 986 | |||
| 987 | (if (> (length vip-last-insertion) 0) | ||
| 988 | (vip-push-onto-ring vip-last-insertion | ||
| 989 | 'vip-insertion-ring)) | ||
| 990 | |||
| 991 | (if vip-ex-style-editing-in-insert | ||
| 992 | (or (bolp) (backward-char 1)))) | ||
| 993 | )) | ||
| 994 | |||
| 995 | ;; insert or replace | ||
| 996 | ((memq new-state '(insert-state replace-state)) | ||
| 997 | (if (memq vip-current-state '(emacs-state vi-state)) | ||
| 998 | (vip-move-marker-locally 'vip-insert-point (point))) | ||
| 999 | (vip-move-marker-locally 'vip-last-posn-while-in-insert-state (point)) | ||
| 1000 | (add-hook 'vip-post-command-hooks | ||
| 1001 | 'vip-insert-state-post-command-sentinel t) | ||
| 1002 | (add-hook 'vip-pre-command-hooks | ||
| 1003 | 'vip-insert-state-pre-command-sentinel t) | ||
| 1004 | ) | ||
| 1005 | ) ; outermost cond | ||
| 1006 | |||
| 1007 | ;; Nothing needs to be done to switch to emacs mode! Just set some | ||
| 1008 | ;; variables, which is done in vip-change-state-to-emacs! | ||
| 1009 | |||
| 1010 | (setq vip-current-state new-state) | ||
| 1011 | (vip-normalize-minor-mode-map-alist) | ||
| 1012 | (vip-adjust-keys-for new-state) | ||
| 1013 | (vip-set-mode-vars-for new-state) | ||
| 1014 | (vip-refresh-mode-line) | ||
| 1015 | ) | ||
| 1016 | |||
| 1017 | |||
| 1018 | |||
| 1019 | (defun vip-adjust-keys-for (state) | ||
| 1020 | "Make necessary adjustments to keymaps before entering STATE." | ||
| 1021 | (cond ((memq state '(insert-state replace-state)) | ||
| 1022 | (if vip-auto-indent | ||
| 1023 | (progn | ||
| 1024 | (define-key vip-insert-basic-map "\C-m" 'vip-autoindent) | ||
| 1025 | (if vip-want-emacs-keys-in-insert | ||
| 1026 | ;; expert | ||
| 1027 | (define-key vip-insert-basic-map "\C-j" nil) | ||
| 1028 | ;; novice | ||
| 1029 | (define-key vip-insert-basic-map "\C-j" 'vip-autoindent)))) | ||
| 1030 | |||
| 1031 | (setq vip-insert-diehard-minor-mode | ||
| 1032 | (not vip-want-emacs-keys-in-insert)) | ||
| 1033 | |||
| 1034 | (if vip-want-ctl-h-help | ||
| 1035 | (progn | ||
| 1036 | (define-key vip-insert-basic-map "\C-h" 'help-command) | ||
| 1037 | (define-key vip-replace-map "\C-h" 'help-command)) | ||
| 1038 | (define-key vip-insert-basic-map | ||
| 1039 | "\C-h" 'vip-del-backward-char-in-insert) | ||
| 1040 | (define-key vip-replace-map | ||
| 1041 | "\C-h" 'vip-del-backward-char-in-replace))) | ||
| 1042 | |||
| 1043 | (t | ||
| 1044 | (setq vip-vi-diehard-minor-mode (not vip-want-emacs-keys-in-vi)) | ||
| 1045 | (if vip-want-ctl-h-help | ||
| 1046 | (define-key vip-vi-basic-map "\C-h" 'help-command) | ||
| 1047 | (define-key vip-vi-basic-map "\C-h" 'vip-backward-char))) | ||
| 1048 | )) | ||
| 1049 | |||
| 1050 | |||
| 1051 | (defun vip-normalize-minor-mode-map-alist () | ||
| 1052 | "Normalizes minor-mode-map-alist by putting Viper keymaps first. | ||
| 1053 | This ensures that Viper bindings are in effect, regardless of which minor | ||
| 1054 | modes were turned on by the user or by other packages." | ||
| 1055 | (setq minor-mode-map-alist | ||
| 1056 | (vip-append-filter-alist | ||
| 1057 | (list | ||
| 1058 | (cons 'vip-vi-intercept-minor-mode vip-vi-intercept-map) | ||
| 1059 | (cons 'vip-vi-minibuffer-minor-mode vip-minibuffer-map) | ||
| 1060 | (cons 'vip-vi-local-user-minor-mode vip-vi-local-user-map) | ||
| 1061 | (cons 'vip-vi-kbd-minor-mode vip-vi-kbd-map) | ||
| 1062 | (cons 'vip-vi-global-user-minor-mode vip-vi-global-user-map) | ||
| 1063 | (cons 'vip-vi-state-modifier-minor-mode | ||
| 1064 | (if (keymapp | ||
| 1065 | (cdr (assoc major-mode vip-vi-state-modifier-alist))) | ||
| 1066 | (cdr (assoc major-mode vip-vi-state-modifier-alist)) | ||
| 1067 | vip-empty-keymap)) | ||
| 1068 | (cons 'vip-vi-diehard-minor-mode vip-vi-diehard-map) | ||
| 1069 | (cons 'vip-vi-basic-minor-mode vip-vi-basic-map) | ||
| 1070 | (cons 'vip-insert-intercept-minor-mode vip-insert-intercept-map) | ||
| 1071 | (cons 'vip-replace-minor-mode vip-replace-map) | ||
| 1072 | ;; vip-insert-minibuffer-minor-mode must come after | ||
| 1073 | ;; vip-replace-minor-mode | ||
| 1074 | (cons 'vip-insert-minibuffer-minor-mode | ||
| 1075 | vip-minibuffer-map) | ||
| 1076 | (cons 'vip-insert-local-user-minor-mode | ||
| 1077 | vip-insert-local-user-map) | ||
| 1078 | (cons 'vip-insert-kbd-minor-mode vip-insert-kbd-map) | ||
| 1079 | (cons 'vip-insert-global-user-minor-mode | ||
| 1080 | vip-insert-global-user-map) | ||
| 1081 | (cons 'vip-insert-state-modifier-minor-mode | ||
| 1082 | (if (keymapp | ||
| 1083 | (cdr | ||
| 1084 | (assoc major-mode vip-insert-state-modifier-alist))) | ||
| 1085 | (cdr | ||
| 1086 | (assoc major-mode vip-insert-state-modifier-alist)) | ||
| 1087 | vip-empty-keymap)) | ||
| 1088 | (cons 'vip-insert-diehard-minor-mode vip-insert-diehard-map) | ||
| 1089 | (cons 'vip-insert-basic-minor-mode vip-insert-basic-map) | ||
| 1090 | (cons 'vip-emacs-intercept-minor-mode | ||
| 1091 | vip-emacs-intercept-map) | ||
| 1092 | (cons 'vip-emacs-local-user-minor-mode | ||
| 1093 | vip-emacs-local-user-map) | ||
| 1094 | (cons 'vip-emacs-kbd-minor-mode vip-emacs-kbd-map) | ||
| 1095 | (cons 'vip-emacs-global-user-minor-mode | ||
| 1096 | vip-emacs-global-user-map) | ||
| 1097 | (cons 'vip-emacs-state-modifier-minor-mode | ||
| 1098 | (if (keymapp | ||
| 1099 | (cdr | ||
| 1100 | (assoc major-mode vip-emacs-state-modifier-alist))) | ||
| 1101 | (cdr | ||
| 1102 | (assoc major-mode vip-emacs-state-modifier-alist)) | ||
| 1103 | vip-empty-keymap)) | ||
| 1104 | ) | ||
| 1105 | minor-mode-map-alist))) | ||
| 1106 | |||
| 1107 | |||
| 1108 | |||
| 1109 | |||
| 1110 | |||
| 1111 | ;; Viper mode-changing commands and utilities | ||
| 1112 | |||
| 1113 | (defun vip-refresh-mode-line () | ||
| 1114 | "Modifies mode-line-buffer-identification." | ||
| 1115 | (setq vip-mode-string | ||
| 1116 | (cond ((eq vip-current-state 'emacs-state) vip-emacs-state-id) | ||
| 1117 | ((eq vip-current-state 'vi-state) vip-vi-state-id) | ||
| 1118 | ((eq vip-current-state 'replace-state) vip-replace-state-id) | ||
| 1119 | ((eq vip-current-state 'insert-state) vip-insert-state-id))) | ||
| 1120 | |||
| 1121 | ;; Sets Viper mode string in global-mode-string | ||
| 1122 | (force-mode-line-update)) | ||
| 1123 | |||
| 1124 | ;;;###autoload | ||
| 1125 | (defun viper-mode () | ||
| 1126 | "Turn on Viper emulation of Vi." | ||
| 1127 | (interactive) | ||
| 1128 | (if (not noninteractive) | ||
| 1129 | (progn | ||
| 1130 | (if vip-first-time ; This check is important. Without it, startup and | ||
| 1131 | (progn ; expert-level msgs mix up when viper-mode recurses | ||
| 1132 | (setq vip-first-time nil) | ||
| 1133 | (if (not vip-inhibit-startup-message) | ||
| 1134 | (save-window-excursion | ||
| 1135 | (setq vip-inhibit-startup-message t) | ||
| 1136 | (delete-other-windows) | ||
| 1137 | (switch-to-buffer "Viper Startup Message") | ||
| 1138 | (erase-buffer) | ||
| 1139 | (insert | ||
| 1140 | (substitute-command-keys | ||
| 1141 | "Viper Is a Package for Emacs Rebels. | ||
| 1142 | It is also a VI Plan for Emacs Rescue and a venomous VI PERil. | ||
| 1143 | |||
| 1144 | Technically speaking, Viper is a Vi emulation package for GNU Emacs 19 and | ||
| 1145 | XEmacs 19. It supports virtually all of Vi and Ex functionality, extending | ||
| 1146 | and improving upon much of it. | ||
| 1147 | |||
| 1148 | 1. Viper supports Vi at several levels. Level 1 is the closest to | ||
| 1149 | Vi, level 5 provides the most flexibility to depart from many Vi | ||
| 1150 | conventions. | ||
| 1151 | |||
| 1152 | You will be asked to specify your user level in a following screen. | ||
| 1153 | |||
| 1154 | If you select user level 1 then the keys ^X, ^C, ^Z, and ^G will | ||
| 1155 | behave as in VI, to smooth transition to Viper for the beginners. | ||
| 1156 | However, to use Emacs productively, you are advised to reach user | ||
| 1157 | level 3 or higher. | ||
| 1158 | |||
| 1159 | If your user level is 2 or higher, ^X and ^C will invoke Emacs | ||
| 1160 | functions,as usual in Emacs; ^Z will toggle vi/emacs modes, and | ||
| 1161 | ^G will be the usual Emacs's keyboard-quit (something like ^C in VI). | ||
| 1162 | |||
| 1163 | 2. Vi exit functions (e.g., :wq, ZZ) work on INDIVIDUAL files -- they | ||
| 1164 | do not cause Emacs to quit, except at user level 1 (a novice). | ||
| 1165 | 3. ^X^C EXITS EMACS. | ||
| 1166 | 4. Viper supports multiple undo: `u' will undo. Typing `.' will repeat | ||
| 1167 | undo. Another `u' changes direction. | ||
| 1168 | |||
| 1169 | 6. Emacs Meta functions are invoked by typing `_' or `\\ ESC'. | ||
| 1170 | On a window system, the best way is to use the Meta-key. | ||
| 1171 | 7. Try \\[keyboard-quit] and \\[abort-recursive-edit] repeatedly, | ||
| 1172 | if something funny happens. This would abort the current editing | ||
| 1173 | command. | ||
| 1174 | |||
| 1175 | You can get more information on Viper by: | ||
| 1176 | |||
| 1177 | a. Typing `:help' in Vi state | ||
| 1178 | b. Printing Viper manual, found in ./etc/viper.dvi | ||
| 1179 | c. Printing ViperCard, the Quick Reference, found in ./etc/viperCard.dvi | ||
| 1180 | |||
| 1181 | This startup message appears whenever you load Viper, unless you type `y' now." | ||
| 1182 | )) | ||
| 1183 | (goto-char (point-min)) | ||
| 1184 | (if (y-or-n-p "Inhibit Viper startup message? ") | ||
| 1185 | (vip-save-setting | ||
| 1186 | 'vip-inhibit-startup-message | ||
| 1187 | "Viper startup message inhibited" | ||
| 1188 | vip-custom-file-name t)) | ||
| 1189 | (kill-buffer (current-buffer)))) | ||
| 1190 | (message " ") | ||
| 1191 | (vip-set-expert-level 'dont-change-unless))) | ||
| 1192 | (vip-change-state-to-vi)))) | ||
| 1193 | |||
| 1194 | ;;;###autoload | ||
| 1195 | (defalias 'vip-mode 'viper-mode) | ||
| 1196 | |||
| 1197 | |||
| 1198 | (defun vip-exit-insert-state () | ||
| 1199 | "Switch from Insert state to Vi state." | ||
| 1200 | (interactive) | ||
| 1201 | (vip-change-state-to-vi)) | ||
| 1202 | |||
| 1203 | (defun vip-set-mode-vars-for (state) | ||
| 1204 | "Sets Viper minor mode variables to put Viper's state STATE in effect." | ||
| 1205 | |||
| 1206 | ;; Emacs state | ||
| 1207 | (setq vip-vi-minibuffer-minor-mode nil | ||
| 1208 | vip-insert-minibuffer-minor-mode nil | ||
| 1209 | vip-vi-intercept-minor-mode nil | ||
| 1210 | vip-insert-intercept-minor-mode nil | ||
| 1211 | |||
| 1212 | vip-vi-local-user-minor-mode nil | ||
| 1213 | vip-vi-kbd-minor-mode nil | ||
| 1214 | vip-vi-global-user-minor-mode nil | ||
| 1215 | vip-vi-state-modifier-minor-mode nil | ||
| 1216 | vip-vi-diehard-minor-mode nil | ||
| 1217 | vip-vi-basic-minor-mode nil | ||
| 1218 | |||
| 1219 | vip-replace-minor-mode nil | ||
| 1220 | |||
| 1221 | vip-insert-local-user-minor-mode nil | ||
| 1222 | vip-insert-kbd-minor-mode nil | ||
| 1223 | vip-insert-global-user-minor-mode nil | ||
| 1224 | vip-insert-state-modifier-minor-mode nil | ||
| 1225 | vip-insert-diehard-minor-mode nil | ||
| 1226 | vip-insert-basic-minor-mode nil | ||
| 1227 | vip-emacs-intercept-minor-mode t | ||
| 1228 | vip-emacs-local-user-minor-mode t | ||
| 1229 | vip-emacs-kbd-minor-mode (not (vip-is-in-minibuffer)) | ||
| 1230 | vip-emacs-global-user-minor-mode t | ||
| 1231 | vip-emacs-state-modifier-minor-mode t | ||
| 1232 | ) | ||
| 1233 | |||
| 1234 | ;; Vi state | ||
| 1235 | (if (eq state 'vi-state) ; adjust for vi-state | ||
| 1236 | (setq | ||
| 1237 | vip-vi-intercept-minor-mode t | ||
| 1238 | vip-vi-minibuffer-minor-mode (vip-is-in-minibuffer) | ||
| 1239 | vip-vi-local-user-minor-mode t | ||
| 1240 | vip-vi-kbd-minor-mode (not (vip-is-in-minibuffer)) | ||
| 1241 | vip-vi-global-user-minor-mode t | ||
| 1242 | vip-vi-state-modifier-minor-mode t | ||
| 1243 | ;; don't let the diehard keymap block command completion | ||
| 1244 | ;; and other things in the minibuffer | ||
| 1245 | vip-vi-diehard-minor-mode (not | ||
| 1246 | (or vip-want-emacs-keys-in-vi | ||
| 1247 | (vip-is-in-minibuffer))) | ||
| 1248 | vip-vi-basic-minor-mode t | ||
| 1249 | vip-emacs-intercept-minor-mode nil | ||
| 1250 | vip-emacs-local-user-minor-mode nil | ||
| 1251 | vip-emacs-kbd-minor-mode nil | ||
| 1252 | vip-emacs-global-user-minor-mode nil | ||
| 1253 | vip-emacs-state-modifier-minor-mode nil | ||
| 1254 | )) | ||
| 1255 | |||
| 1256 | ;; Insert and Replace states | ||
| 1257 | (if (member state '(insert-state replace-state)) | ||
| 1258 | (setq | ||
| 1259 | vip-insert-intercept-minor-mode t | ||
| 1260 | vip-replace-minor-mode (eq state 'replace-state) | ||
| 1261 | vip-insert-minibuffer-minor-mode (vip-is-in-minibuffer) | ||
| 1262 | vip-insert-local-user-minor-mode t | ||
| 1263 | vip-insert-kbd-minor-mode (not (vip-is-in-minibuffer)) | ||
| 1264 | vip-insert-global-user-minor-mode t | ||
| 1265 | vip-insert-state-modifier-minor-mode t | ||
| 1266 | ;; don't let the diehard keymap block command completion | ||
| 1267 | ;; and other things in the minibuffer | ||
| 1268 | vip-insert-diehard-minor-mode (not | ||
| 1269 | (or vip-want-emacs-keys-in-insert | ||
| 1270 | (vip-is-in-minibuffer))) | ||
| 1271 | vip-insert-basic-minor-mode t | ||
| 1272 | vip-emacs-intercept-minor-mode nil | ||
| 1273 | vip-emacs-local-user-minor-mode nil | ||
| 1274 | vip-emacs-kbd-minor-mode nil | ||
| 1275 | vip-emacs-global-user-minor-mode nil | ||
| 1276 | vip-emacs-state-modifier-minor-mode nil | ||
| 1277 | )) | ||
| 1278 | |||
| 1279 | ;; minibuffer faces | ||
| 1280 | (if window-system | ||
| 1281 | (setq vip-minibuffer-current-face | ||
| 1282 | (cond ((eq state 'emacs-state) vip-minibuffer-emacs-face) | ||
| 1283 | ((eq state 'vi-state) vip-minibuffer-vi-face) | ||
| 1284 | ((memq state '(insert-state replace-state)) | ||
| 1285 | vip-minibuffer-insert-face)))) | ||
| 1286 | |||
| 1287 | (if (vip-is-in-minibuffer) | ||
| 1288 | (vip-set-minibuffer-overlay)) | ||
| 1289 | ) | ||
| 1290 | |||
| 1291 | ;; This also takes care of the annoying incomplete lines in files. | ||
| 1292 | ;; Also, this fixed 'undo' to work vi-style for complex commands. | ||
| 1293 | (defun vip-change-state-to-vi () | ||
| 1294 | "Change Viper state to Vi." | ||
| 1295 | (interactive) | ||
| 1296 | (if (and vip-first-time (not (vip-is-in-minibuffer))) | ||
| 1297 | (viper-mode) | ||
| 1298 | (if overwrite-mode (overwrite-mode nil)) | ||
| 1299 | (if abbrev-mode (expand-abbrev)) | ||
| 1300 | (if (and auto-fill-function (> (current-column) fill-column)) | ||
| 1301 | (funcall auto-fill-function)) | ||
| 1302 | (vip-add-newline-at-eob-if-necessary) | ||
| 1303 | (if vip-undo-needs-adjustment (vip-adjust-undo)) | ||
| 1304 | (vip-change-state 'vi-state) | ||
| 1305 | (if (and vip-automatic-iso-accents (fboundp 'iso-accents-mode)) | ||
| 1306 | (iso-accents-mode -1)) ; turn off iso accents | ||
| 1307 | |||
| 1308 | ;; Protection against user errors in hooks | ||
| 1309 | (condition-case conds | ||
| 1310 | (run-hooks 'vip-vi-state-hooks) | ||
| 1311 | (error | ||
| 1312 | (vip-message-conditions conds))))) | ||
| 1313 | |||
| 1314 | (defun vip-change-state-to-insert () | ||
| 1315 | "Change Viper state to Insert." | ||
| 1316 | (interactive) | ||
| 1317 | (vip-change-state 'insert-state) | ||
| 1318 | (if (and vip-automatic-iso-accents (fboundp 'iso-accents-mode)) | ||
| 1319 | (iso-accents-mode 1)) ; turn iso accents on | ||
| 1320 | |||
| 1321 | ;; Protection against user errors in hooks | ||
| 1322 | (condition-case conds | ||
| 1323 | (run-hooks 'vip-insert-state-hooks) | ||
| 1324 | (error | ||
| 1325 | (vip-message-conditions conds)))) | ||
| 1326 | |||
| 1327 | (defsubst vip-downgrade-to-insert () | ||
| 1328 | (setq vip-current-state 'insert-state | ||
| 1329 | vip-replace-minor-mode nil) | ||
| 1330 | ) | ||
| 1331 | |||
| 1332 | |||
| 1333 | |||
| 1334 | ;; Change to replace state. When the end of replacement region is reached, | ||
| 1335 | ;; replace state changes to insert state. | ||
| 1336 | (defun vip-change-state-to-replace (&optional non-R-cmd) | ||
| 1337 | (vip-change-state 'replace-state) | ||
| 1338 | (if (and vip-automatic-iso-accents (fboundp 'iso-accents-mode)) | ||
| 1339 | (iso-accents-mode 1)) ; turn iso accents on | ||
| 1340 | ;; Run insert-state-hook | ||
| 1341 | (condition-case conds | ||
| 1342 | (run-hooks 'vip-insert-state-hooks 'vip-replace-state-hooks) | ||
| 1343 | (error | ||
| 1344 | (vip-message-conditions conds))) | ||
| 1345 | |||
| 1346 | (if non-R-cmd | ||
| 1347 | (vip-start-replace) | ||
| 1348 | ;; 'R' is implemented using Emacs's overwrite-mode | ||
| 1349 | (vip-start-R-mode)) | ||
| 1350 | ) | ||
| 1351 | |||
| 1352 | |||
| 1353 | (defun vip-change-state-to-emacs () | ||
| 1354 | "Change Viper state to Emacs." | ||
| 1355 | (interactive) | ||
| 1356 | (vip-change-state 'emacs-state) | ||
| 1357 | (if (and vip-automatic-iso-accents (fboundp 'iso-accents-mode)) | ||
| 1358 | (iso-accents-mode 1)) ; turn iso accents on | ||
| 1359 | |||
| 1360 | ;; Protection agains user errors in hooks | ||
| 1361 | (condition-case conds | ||
| 1362 | (run-hooks 'vip-emacs-state-hooks) | ||
| 1363 | (error | ||
| 1364 | (vip-message-conditions conds)))) | ||
| 1365 | |||
| 1366 | ;; escape to emacs mode termporarily | ||
| 1367 | (defun vip-escape-to-emacs (arg &optional events) | ||
| 1368 | "Escape to Emacs state from Vi state for one Emacs command. | ||
| 1369 | ARG is used as the prefix value for the executed command. If | ||
| 1370 | EVENTS is a list of events, which become the beginning of the command." | ||
| 1371 | (interactive "P") | ||
| 1372 | (vip-escape-to-state arg events 'emacs-state)) | ||
| 1373 | |||
| 1374 | ;; escape to Vi mode termporarily | ||
| 1375 | (defun vip-escape-to-vi () | ||
| 1376 | "Escape from Emacs state to Vi state for one Vi 1-character command. | ||
| 1377 | This doesn't work with prefix arguments or most complex commands like | ||
| 1378 | cw, dw, etc. But it does work with some 2-character commands, | ||
| 1379 | like dd or dr." | ||
| 1380 | (interactive) | ||
| 1381 | (vip-escape-to-state nil nil 'vi-state)) | ||
| 1382 | |||
| 1383 | ;; Escape to STATE mode for one Emacs command. | ||
| 1384 | (defun vip-escape-to-state (arg events state) | ||
| 1385 | (let (com key prefix-arg) | ||
| 1386 | ;; this temporarily turns off Viper's minor mode keymaps | ||
| 1387 | (vip-set-mode-vars-for state) | ||
| 1388 | (vip-normalize-minor-mode-map-alist) | ||
| 1389 | (if events (vip-set-unread-command-events events)) | ||
| 1390 | |||
| 1391 | ;; protect against keyboard quit and other errors | ||
| 1392 | (condition-case nil | ||
| 1393 | (progn | ||
| 1394 | (unwind-protect | ||
| 1395 | (progn | ||
| 1396 | (setq com (key-binding (setq key | ||
| 1397 | (if vip-xemacs-p | ||
| 1398 | (read-key-sequence nil) | ||
| 1399 | (read-key-sequence nil t))))) | ||
| 1400 | ;; In case of indirection--chase definitions. | ||
| 1401 | ;; Have to do it here because we execute this command under | ||
| 1402 | ;; different keymaps, so command-execute may not do the | ||
| 1403 | ;; right thing there | ||
| 1404 | (while (vectorp com) (setq com (key-binding com)))) | ||
| 1405 | nil) | ||
| 1406 | ;; exec command in the right Viper state | ||
| 1407 | ;; otherwise, if we switch buffers in the escaped command, | ||
| 1408 | ;; Viper's mode vars will remain those of `state'. When we return | ||
| 1409 | ;; to the orig buffer, the bindings will be screwed up. | ||
| 1410 | (vip-set-mode-vars-for vip-current-state) | ||
| 1411 | |||
| 1412 | ;; this-command, last-command-char, last-command-event | ||
| 1413 | (setq this-command com) | ||
| 1414 | (if vip-xemacs-p ; XEmacs represents key sequences as vectors | ||
| 1415 | (setq last-command-event (vip-seq-last-elt key) | ||
| 1416 | last-command-char (event-to-character last-command-event)) | ||
| 1417 | ;; Emacs represents them as sequences (str or vec) | ||
| 1418 | (setq last-command-event (vip-seq-last-elt key) | ||
| 1419 | last-command-char last-command-event)) | ||
| 1420 | |||
| 1421 | (if (commandp com) | ||
| 1422 | (progn | ||
| 1423 | (setq prefix-arg arg) | ||
| 1424 | (command-execute com))) | ||
| 1425 | ) | ||
| 1426 | (quit (ding)) | ||
| 1427 | (error (beep 1)))) | ||
| 1428 | (vip-set-mode-vars-for vip-current-state)) ; set state in new buffer | ||
| 1429 | |||
| 1430 | (defun vip-exec-form-in-emacs (form) | ||
| 1431 | "Execute FORM in Emacs, temporarily disabling Viper's minor modes. | ||
| 1432 | Similar to vip-escape-to-emacs, but accepts forms rather than keystrokes." | ||
| 1433 | (let ((buff (current-buffer)) | ||
| 1434 | result) | ||
| 1435 | (vip-set-mode-vars-for 'emacs-state) | ||
| 1436 | (setq result (eval form)) | ||
| 1437 | (if (not (equal buff (current-buffer))) ; cmd switched buffer | ||
| 1438 | (save-excursion | ||
| 1439 | (set-buffer buff) | ||
| 1440 | (vip-set-mode-vars-for vip-current-state))) | ||
| 1441 | (vip-set-mode-vars-for vip-current-state) | ||
| 1442 | result)) | ||
| 1443 | |||
| 1444 | |||
| 1445 | |||
| 1446 | ;; This is needed because minor modes sometimes override essential Viper | ||
| 1447 | ;; bindings. By letting Viper know which files these modes are in, it will | ||
| 1448 | ;; arrange to reorganize minor-mode-map-alist so that things will work right. | ||
| 1449 | (defun vip-harness-minor-mode (load-file) | ||
| 1450 | "Familiarize Viper with a minor mode defined in LOAD_FILE. | ||
| 1451 | Minor modes that have their own keymaps may overshadow Viper keymaps. | ||
| 1452 | This function is designed to make Viper aware of the packages that define | ||
| 1453 | such minor modes. | ||
| 1454 | Usage: | ||
| 1455 | (vip-harness-minor-mode load-file) | ||
| 1456 | |||
| 1457 | LOAD-FILE is a name of the file where the specific minor mode is defined. | ||
| 1458 | Suffixes such as .el or .elc should be stripped." | ||
| 1459 | |||
| 1460 | (interactive "sEnter name of the load file: ") | ||
| 1461 | |||
| 1462 | (vip-eval-after-load load-file '(vip-normalize-minor-mode-map-alist)) | ||
| 1463 | |||
| 1464 | ;; This is a work-around the emacs bug that doesn't let us make | ||
| 1465 | ;; minor-mode-map-alist permanent-local. | ||
| 1466 | ;; This workaround changes the default for minor-mode-map-alist | ||
| 1467 | ;; each time a harnessed minor mode adds its own keymap to the a-list. | ||
| 1468 | (vip-eval-after-load load-file '(setq-default minor-mode-map-alist | ||
| 1469 | minor-mode-map-alist)) | ||
| 1470 | ) | ||
| 1471 | |||
| 1472 | ;; This doesn't work, i.e., doesn't replace vip-harness-minor-mode | ||
| 1473 | ;; function, since autoloaded files don't seem to be loaded with lisp's | ||
| 1474 | ;; `load' function. | ||
| 1475 | ;;(defadvice load (after vip-load-advice activate) | ||
| 1476 | ;; "Rearrange `minor-mode-map-alist' after loading a file or a library." | ||
| 1477 | ;; (vip-normalize-minor-mode-map-alist) | ||
| 1478 | ;; (setq-default minor-mode-map-alist minor-mode-map-alist)) | ||
| 1479 | |||
| 1480 | |||
| 1481 | |||
| 1482 | (defun vip-ESC (arg) | ||
| 1483 | "Emulate ESC key in Emacs. | ||
| 1484 | Prevents multiple escape keystrokes if vip-no-multiple-ESC is true. In that | ||
| 1485 | case \@ will be bound to ESC. If vip-no-multiple-ESC is 'twice double ESC | ||
| 1486 | would dings in vi-state. Other ESC sequences are emulated via the current | ||
| 1487 | Emacs's major mode keymap. This is more convenient on dumb terminals and in | ||
| 1488 | Emacs -nw, since this won't block functional keys such as up,down, | ||
| 1489 | etc. Meta key also will work. When vip-no-multiple-ESC is nil, ESC key | ||
| 1490 | behaves as in Emacs, any number of multiple escapes is allowed." | ||
| 1491 | (interactive "P") | ||
| 1492 | (let (char) | ||
| 1493 | (cond ((and (not vip-no-multiple-ESC) (eq vip-current-state 'vi-state)) | ||
| 1494 | (setq char (vip-read-char-exclusive)) | ||
| 1495 | (vip-escape-to-emacs arg (list ?\e char) )) | ||
| 1496 | ((and (eq vip-no-multiple-ESC 'twice) | ||
| 1497 | (eq vip-current-state 'vi-state)) | ||
| 1498 | (setq char (vip-read-char-exclusive)) | ||
| 1499 | (if (= char (string-to-char vip-ESC-key)) | ||
| 1500 | (ding) | ||
| 1501 | (vip-escape-to-emacs arg (list ?\e char) ))) | ||
| 1502 | (t (ding))) | ||
| 1503 | )) | ||
| 1504 | |||
| 1505 | (defun vip-alternate-ESC (arg) | ||
| 1506 | "ESC key without checking for multiple keystrokes." | ||
| 1507 | (interactive "P") | ||
| 1508 | (vip-escape-to-emacs arg '(?\e))) | ||
| 1509 | |||
| 1510 | |||
| 1511 | ;; Intercept ESC sequences on dumb terminals. | ||
| 1512 | ;; Based on the idea contributed by Marcelino Veiga Tuimil <mveiga@dit.upm.es> | ||
| 1513 | |||
| 1514 | ;; Check if last key was ESC and if so try to reread it as a function key. | ||
| 1515 | ;; But only if there are characters to read during a very short time. | ||
| 1516 | ;; Returns the last event, if any. | ||
| 1517 | (defun vip-envelop-ESC-key () | ||
| 1518 | (let ((event last-input-event) | ||
| 1519 | (keyseq [nil]) | ||
| 1520 | inhibit-quit) | ||
| 1521 | (if (vip-ESC-event-p event) | ||
| 1522 | (progn | ||
| 1523 | (if (vip-fast-keysequence-p) | ||
| 1524 | (progn | ||
| 1525 | (let ((vip-vi-intercept-minor-mode nil) | ||
| 1526 | (vip-insert-intercept-minor-mode nil) | ||
| 1527 | (vip-emacs-intercept-minor-mode nil) | ||
| 1528 | (vip-vi-state-modifier-minor-mode nil) | ||
| 1529 | (vip-vi-global-user-minor-mode nil) | ||
| 1530 | (vip-vi-local-user-minor-mode nil) | ||
| 1531 | (vip-replace-minor-mode nil) ; actually unnecessary | ||
| 1532 | (vip-insert-state-modifier-minor-mode nil) | ||
| 1533 | (vip-insert-global-user-minor-mode nil) | ||
| 1534 | (vip-insert-local-user-minor-mode nil) | ||
| 1535 | (vip-emacs-state-modifier-minor-mode nil) | ||
| 1536 | (vip-emacs-global-user-minor-mode nil) | ||
| 1537 | (vip-emacs-local-user-minor-mode nil) | ||
| 1538 | ) | ||
| 1539 | ;; The treatment of XEmacs, below, is temporary, since we | ||
| 1540 | ;; don't know how XEmacs will implement dumb terminals. | ||
| 1541 | ;; Note: the treatment of fast keysequences here is | ||
| 1542 | ;; needed only on dumb terminals in order to be able to | ||
| 1543 | ;; handle function keys correctly. | ||
| 1544 | (if vip-xemacs-p | ||
| 1545 | (setq keyseq (vector event)) | ||
| 1546 | (vip-set-unread-command-events event) | ||
| 1547 | (setq keyseq | ||
| 1548 | (funcall | ||
| 1549 | (ad-get-orig-definition 'read-key-sequence) nil)) | ||
| 1550 | )) | ||
| 1551 | ;; If keyseq translates into something that still has ESC | ||
| 1552 | ;; in the beginning, separate ESC from the rest of the seq. | ||
| 1553 | ;; | ||
| 1554 | ;; This is needed for the following reason: | ||
| 1555 | ;; If ESC is the first symbol, we interpret it as if the | ||
| 1556 | ;; user typed ESC and then quickly some other symbols. | ||
| 1557 | ;; If ESC is not the first one, then the key sequence | ||
| 1558 | ;; entered was apparently translated into a function key or | ||
| 1559 | ;; something (e.g., one may have | ||
| 1560 | ;; (define-key function-key-map "\e[192z" [f11]) | ||
| 1561 | ;; which would translate the escape-sequence generated by | ||
| 1562 | ;; f11 in an xterm window into the symbolic key f11. | ||
| 1563 | (if (vip-ESC-event-p (elt keyseq 0)) | ||
| 1564 | (progn | ||
| 1565 | ;; put keys following ESC on the unread list | ||
| 1566 | ;; and return ESC as the key-sequence | ||
| 1567 | (vip-set-unread-command-events (subseq keyseq 1)) | ||
| 1568 | (setq last-input-event event | ||
| 1569 | keyseq "\e"))) | ||
| 1570 | ) ; end progn | ||
| 1571 | |||
| 1572 | ;; this is escape event with nothing after it | ||
| 1573 | ;; put in unread-command-event and then re-read | ||
| 1574 | (vip-set-unread-command-events event) | ||
| 1575 | (setq keyseq | ||
| 1576 | (funcall (ad-get-orig-definition 'read-key-sequence) nil)) | ||
| 1577 | )) | ||
| 1578 | ;; not an escape event | ||
| 1579 | (setq keyseq (vector event))) | ||
| 1580 | keyseq)) | ||
| 1581 | |||
| 1582 | |||
| 1583 | |||
| 1584 | (defadvice read-key-sequence (around vip-read-key-sequence-ad activate) | ||
| 1585 | (let (inhibit-quit event keyseq) | ||
| 1586 | (setq keyseq ad-do-it) | ||
| 1587 | (setq event (if vip-xemacs-p | ||
| 1588 | (elt keyseq 0) ; XEmacs returns vector of events | ||
| 1589 | (elt (listify-key-sequence keyseq) 0))) | ||
| 1590 | (if (vip-ESC-event-p event) | ||
| 1591 | (let (unread-command-events unread-command-event) | ||
| 1592 | (vip-set-unread-command-events keyseq) | ||
| 1593 | (if (vip-fast-keysequence-p) | ||
| 1594 | (let ((vip-vi-global-user-minor-mode nil) | ||
| 1595 | (vip-vi-local-user-minor-mode nil) | ||
| 1596 | (vip-replace-minor-mode nil) ; actually unnecessary | ||
| 1597 | (vip-insert-global-user-minor-mode nil) | ||
| 1598 | (vip-insert-local-user-minor-mode nil)) | ||
| 1599 | (setq keyseq ad-do-it)) | ||
| 1600 | (setq keyseq ad-do-it)))) | ||
| 1601 | keyseq)) | ||
| 1602 | |||
| 1603 | (defadvice describe-key (before vip-read-key-sequence-ad protect activate) | ||
| 1604 | "Force `describe-key' to read key via `read-key-sequence'." | ||
| 1605 | (interactive (list (vip-events-to-keys | ||
| 1606 | (read-key-sequence "Describe key: "))))) | ||
| 1607 | |||
| 1608 | (defadvice describe-key-briefly | ||
| 1609 | (before vip-read-key-sequence-ad protect activate) | ||
| 1610 | "Force `describe-key-briefly' to read key via `read-key-sequence'." | ||
| 1611 | (interactive (list (vip-events-to-keys | ||
| 1612 | (read-key-sequence "Describe key briefly: "))))) | ||
| 1613 | |||
| 1614 | (defun vip-intercept-ESC-key () | ||
| 1615 | "Listen to ESC key. | ||
| 1616 | If a sequence of keys starting with ESC is issued with very short delays, | ||
| 1617 | interpret these keys in Emacs mode, so ESC won't be interpreted as a Vi key." | ||
| 1618 | (interactive) | ||
| 1619 | (let ((cmd (or (key-binding (vip-envelop-ESC-key)) | ||
| 1620 | '(lambda () (interactive) (error ""))))) | ||
| 1621 | |||
| 1622 | ;; call the actual function to execute ESC (if no other symbols followed) | ||
| 1623 | ;; or the key bound to the ESC sequence (if the sequence was issued | ||
| 1624 | ;; with very short delay between characters. | ||
| 1625 | (if (eq cmd 'vip-intercept-ESC-key) | ||
| 1626 | (setq cmd | ||
| 1627 | (cond ((eq vip-current-state 'vi-state) | ||
| 1628 | 'vip-ESC) | ||
| 1629 | ((eq vip-current-state 'insert-state) | ||
| 1630 | 'vip-exit-insert-state) | ||
| 1631 | ((eq vip-current-state 'replace-state) | ||
| 1632 | 'vip-replace-state-exit-cmd) | ||
| 1633 | (t 'vip-change-state-to-vi) | ||
| 1634 | ))) | ||
| 1635 | (call-interactively cmd))) | ||
| 1636 | |||
| 1637 | |||
| 1638 | |||
| 1639 | ;; prefix argument for Vi mode | ||
| 1640 | |||
| 1641 | ;; In Vi mode, prefix argument is a dotted pair (NUM . COM) where NUM | ||
| 1642 | ;; represents the numeric value of the prefix argument and COM represents | ||
| 1643 | ;; command prefix such as "c", "d", "m" and "y". | ||
| 1644 | |||
| 1645 | (defun vip-prefix-arg-value (event com) | ||
| 1646 | "Compute numeric prefix arg value. | ||
| 1647 | Invoked by CHAR. COM is the command part obtained so far." | ||
| 1648 | (let (value) | ||
| 1649 | ;; read while number | ||
| 1650 | (while (and (numberp event) (>= event ?0) (<= event ?9)) | ||
| 1651 | (setq value (+ (* (if (numberp value) value 0) 10) (- event ?0))) | ||
| 1652 | (setq event (vip-read-event-convert-to-char))) | ||
| 1653 | |||
| 1654 | (setq prefix-arg value) | ||
| 1655 | (if com (setq prefix-arg (cons prefix-arg com))) | ||
| 1656 | (while (eq event ?U) | ||
| 1657 | (vip-describe-arg prefix-arg) | ||
| 1658 | (setq event (vip-read-event-convert-to-char))) | ||
| 1659 | (vip-set-unread-command-events event))) | ||
| 1660 | |||
| 1661 | (defun vip-prefix-arg-com (char value com) | ||
| 1662 | "Vi operator as prefix argument." | ||
| 1663 | (let ((cont t)) | ||
| 1664 | (while (and cont | ||
| 1665 | (memq char | ||
| 1666 | (list ?c ?d ?y ?! ?< ?> ?= ?# ?r ?R ?\" | ||
| 1667 | vip-buffer-search-char))) | ||
| 1668 | (if com | ||
| 1669 | ;; this means that we already have a command character, so we | ||
| 1670 | ;; construct a com list and exit while. however, if char is " | ||
| 1671 | ;; it is an error. | ||
| 1672 | (progn | ||
| 1673 | ;; new com is (CHAR . OLDCOM) | ||
| 1674 | (if (memq char '(?# ?\")) (error "")) | ||
| 1675 | (setq com (cons char com)) | ||
| 1676 | (setq cont nil)) | ||
| 1677 | ;; If com is nil we set com as char, and read more. Again, if char | ||
| 1678 | ;; is ", we read the name of register and store it in vip-use-register. | ||
| 1679 | ;; if char is !, =, or #, a complete com is formed so we exit the | ||
| 1680 | ;; while loop. | ||
| 1681 | (cond ((memq char '(?! ?=)) | ||
| 1682 | (setq com char) | ||
| 1683 | (setq char (read-char)) | ||
| 1684 | (setq cont nil)) | ||
| 1685 | ((= char ?#) | ||
| 1686 | ;; read a char and encode it as com | ||
| 1687 | (setq com (+ 128 (read-char))) | ||
| 1688 | (setq char (read-char))) | ||
| 1689 | ((= char ?\") | ||
| 1690 | (let ((reg (read-char))) | ||
| 1691 | (if (vip-valid-register reg) | ||
| 1692 | (setq vip-use-register reg) | ||
| 1693 | (error "")) | ||
| 1694 | (setq char (read-char)))) | ||
| 1695 | (t | ||
| 1696 | (setq com char) | ||
| 1697 | (setq char (vip-read-char-exclusive))))))) | ||
| 1698 | (if (atom com) | ||
| 1699 | ;; com is a single char, so we construct prefix-arg | ||
| 1700 | ;; and if char is ?, describe prefix arg, otherwise exit by | ||
| 1701 | ;; pushing the char back | ||
| 1702 | (progn | ||
| 1703 | (setq prefix-arg (cons value com)) | ||
| 1704 | (while (= char ?U) | ||
| 1705 | (vip-describe-arg prefix-arg) | ||
| 1706 | (setq char (read-char))) | ||
| 1707 | (vip-set-unread-command-events char) | ||
| 1708 | ) | ||
| 1709 | ;; as com is non-nil, this means that we have a command to execute | ||
| 1710 | (if (memq (car com) '(?r ?R)) | ||
| 1711 | ;; execute apropriate region command. | ||
| 1712 | (let ((char (car com)) (com (cdr com))) | ||
| 1713 | (setq prefix-arg (cons value com)) | ||
| 1714 | (if (= char ?r) (vip-region prefix-arg) | ||
| 1715 | (vip-Region prefix-arg)) | ||
| 1716 | ;; reset prefix-arg | ||
| 1717 | (setq prefix-arg nil)) | ||
| 1718 | ;; otherwise, reset prefix arg and call appropriate command | ||
| 1719 | (setq value (if (null value) 1 value)) | ||
| 1720 | (setq prefix-arg nil) | ||
| 1721 | (cond ((equal com '(?c . ?c)) (vip-line (cons value ?C))) | ||
| 1722 | ((equal com '(?d . ?d)) (vip-line (cons value ?D))) | ||
| 1723 | ((equal com '(?d . ?y)) (vip-yank-defun)) | ||
| 1724 | ((equal com '(?y . ?y)) (vip-line (cons value ?Y))) | ||
| 1725 | ((equal com '(?< . ?<)) (vip-line (cons value ?<))) | ||
| 1726 | ((equal com '(?> . ?>)) (vip-line (cons value ?>))) | ||
| 1727 | ((equal com '(?! . ?!)) (vip-line (cons value ?!))) | ||
| 1728 | ((equal com '(?= . ?=)) (vip-line (cons value ?=))) | ||
| 1729 | (t (error "")))))) | ||
| 1730 | |||
| 1731 | (defun vip-describe-arg (arg) | ||
| 1732 | (let (val com) | ||
| 1733 | (setq val (vip-P-val arg) | ||
| 1734 | com (vip-getcom arg)) | ||
| 1735 | (if (null val) | ||
| 1736 | (if (null com) | ||
| 1737 | (message "Value is nil, and command is nil") | ||
| 1738 | (message "Value is nil, and command is `%c'" com)) | ||
| 1739 | (if (null com) | ||
| 1740 | (message "Value is `%d', and command is nil" val) | ||
| 1741 | (message "Value is `%d', and command is `%c'" val com))))) | ||
| 1742 | |||
| 1743 | (defun vip-digit-argument (arg) | ||
| 1744 | "Begin numeric argument for the next command." | ||
| 1745 | (interactive "P") | ||
| 1746 | (vip-prefix-arg-value last-command-char | ||
| 1747 | (if (consp arg) (cdr arg) nil))) | ||
| 1748 | |||
| 1749 | (defun vip-command-argument (arg) | ||
| 1750 | "Accept a motion command as an argument." | ||
| 1751 | (interactive "P") | ||
| 1752 | (condition-case nil | ||
| 1753 | (vip-prefix-arg-com | ||
| 1754 | last-command-char | ||
| 1755 | (cond ((null arg) nil) | ||
| 1756 | ((consp arg) (car arg)) | ||
| 1757 | ((numberp arg) arg) | ||
| 1758 | (t (error vip-InvalidCommandArgument))) | ||
| 1759 | (cond ((null arg) nil) | ||
| 1760 | ((consp arg) (cdr arg)) | ||
| 1761 | ((numberp arg) nil) | ||
| 1762 | (t (error vip-InvalidCommandArgument)))) | ||
| 1763 | (quit (setq vip-use-register nil) | ||
| 1764 | (signal 'quit nil))) | ||
| 1765 | (vip-deactivate-mark)) | ||
| 1766 | |||
| 1767 | ;; Get value part of prefix-argument ARG. | ||
| 1768 | (defsubst vip-p-val (arg) | ||
| 1769 | (cond ((null arg) 1) | ||
| 1770 | ((consp arg) (if (null (car arg)) 1 (car arg))) | ||
| 1771 | (t arg))) | ||
| 1772 | |||
| 1773 | ;; Get raw value part of prefix-argument ARG. | ||
| 1774 | (defsubst vip-P-val (arg) | ||
| 1775 | (cond ((consp arg) (car arg)) | ||
| 1776 | (t arg))) | ||
| 1777 | |||
| 1778 | ;; Get com part of prefix-argument ARG. | ||
| 1779 | (defsubst vip-getcom (arg) | ||
| 1780 | (cond ((null arg) nil) | ||
| 1781 | ((consp arg) (cdr arg)) | ||
| 1782 | (t nil))) | ||
| 1783 | |||
| 1784 | ;; Get com part of prefix-argument ARG and modify it. | ||
| 1785 | (defun vip-getCom (arg) | ||
| 1786 | (let ((com (vip-getcom arg))) | ||
| 1787 | (cond ((equal com ?c) ?C) | ||
| 1788 | ((equal com ?d) ?D) | ||
| 1789 | ((equal com ?y) ?Y) | ||
| 1790 | (t com)))) | ||
| 1791 | |||
| 1792 | |||
| 1793 | ;; repeat last destructive command | ||
| 1794 | |||
| 1795 | ;; Append region to text in register REG. | ||
| 1796 | ;; START and END are buffer positions indicating what to append. | ||
| 1797 | (defsubst vip-append-to-register (reg start end) | ||
| 1798 | (set-register reg (concat (or (get-register reg) "") | ||
| 1799 | (buffer-substring start end)))) | ||
| 1800 | |||
| 1801 | ;; define functions to be executed | ||
| 1802 | |||
| 1803 | ;; invoked by C command | ||
| 1804 | (defun vip-exec-change (m-com com) | ||
| 1805 | ;; handle C cmd at the eol and at eob. | ||
| 1806 | (if (or (and (eolp) (= vip-com-point (point))) | ||
| 1807 | (= vip-com-point (point-max))) | ||
| 1808 | (progn | ||
| 1809 | (insert " ")(backward-char 1))) | ||
| 1810 | (if (= vip-com-point (point)) | ||
| 1811 | (vip-forward-char-carefully)) | ||
| 1812 | (if (= com ?c) | ||
| 1813 | (vip-change vip-com-point (point)) | ||
| 1814 | (vip-change-subr vip-com-point (point)))) | ||
| 1815 | |||
| 1816 | ;; this is invoked by vip-substitute-line | ||
| 1817 | (defun vip-exec-Change (m-com com) | ||
| 1818 | (save-excursion | ||
| 1819 | (set-mark vip-com-point) | ||
| 1820 | (vip-enlarge-region (mark t) (point)) | ||
| 1821 | (if vip-use-register | ||
| 1822 | (progn | ||
| 1823 | (cond ((vip-valid-register vip-use-register '(letter digit)) | ||
| 1824 | ;;(vip-valid-register vip-use-register '(letter) | ||
| 1825 | (copy-to-register | ||
| 1826 | vip-use-register (mark t) (point) nil)) | ||
| 1827 | ((vip-valid-register vip-use-register '(Letter)) | ||
| 1828 | (vip-append-to-register | ||
| 1829 | (downcase vip-use-register) (mark t) (point))) | ||
| 1830 | (t (setq vip-use-register nil) | ||
| 1831 | (error vip-InvalidRegister vip-use-register))) | ||
| 1832 | (setq vip-use-register nil))) | ||
| 1833 | (delete-region (mark t) (point))) | ||
| 1834 | (open-line 1) | ||
| 1835 | (if (= com ?C) (vip-change-mode-to-insert) (vip-yank-last-insertion))) | ||
| 1836 | |||
| 1837 | (defun vip-exec-delete (m-com com) | ||
| 1838 | (if vip-use-register | ||
| 1839 | (progn | ||
| 1840 | (cond ((vip-valid-register vip-use-register '(letter digit)) | ||
| 1841 | ;;(vip-valid-register vip-use-register '(letter)) | ||
| 1842 | (copy-to-register | ||
| 1843 | vip-use-register vip-com-point (point) nil)) | ||
| 1844 | ((vip-valid-register vip-use-register '(Letter)) | ||
| 1845 | (vip-append-to-register | ||
| 1846 | (downcase vip-use-register) vip-com-point (point))) | ||
| 1847 | (t (setq vip-use-register nil) | ||
| 1848 | (error vip-InvalidRegister vip-use-register))) | ||
| 1849 | (setq vip-use-register nil))) | ||
| 1850 | (setq last-command | ||
| 1851 | (if (eq last-command 'd-command) 'kill-region nil)) | ||
| 1852 | (kill-region vip-com-point (point)) | ||
| 1853 | (setq this-command 'd-command) | ||
| 1854 | (if vip-ex-style-motion | ||
| 1855 | (if (and (eolp) (not (bolp))) (backward-char 1)))) | ||
| 1856 | |||
| 1857 | (defun vip-exec-Delete (m-com com) | ||
| 1858 | (save-excursion | ||
| 1859 | (set-mark vip-com-point) | ||
| 1860 | (vip-enlarge-region (mark t) (point)) | ||
| 1861 | (if vip-use-register | ||
| 1862 | (progn | ||
| 1863 | (cond ((vip-valid-register vip-use-register '(letter digit)) | ||
| 1864 | ;;(vip-valid-register vip-use-register '(letter)) | ||
| 1865 | (copy-to-register | ||
| 1866 | vip-use-register (mark t) (point) nil)) | ||
| 1867 | ((vip-valid-register vip-use-register '(Letter)) | ||
| 1868 | (vip-append-to-register | ||
| 1869 | (downcase vip-use-register) (mark t) (point))) | ||
| 1870 | (t (setq vip-use-register nil) | ||
| 1871 | (error vip-InvalidRegister vip-use-register))) | ||
| 1872 | (setq vip-use-register nil))) | ||
| 1873 | (setq last-command | ||
| 1874 | (if (eq last-command 'D-command) 'kill-region nil)) | ||
| 1875 | (kill-region (mark t) (point)) | ||
| 1876 | (if (eq m-com 'vip-line) (setq this-command 'D-command))) | ||
| 1877 | (back-to-indentation)) | ||
| 1878 | |||
| 1879 | (defun vip-exec-yank (m-com com) | ||
| 1880 | (if vip-use-register | ||
| 1881 | (progn | ||
| 1882 | (cond ((vip-valid-register vip-use-register '(letter digit)) | ||
| 1883 | ;; (vip-valid-register vip-use-register '(letter)) | ||
| 1884 | (copy-to-register | ||
| 1885 | vip-use-register vip-com-point (point) nil)) | ||
| 1886 | ((vip-valid-register vip-use-register '(Letter)) | ||
| 1887 | (vip-append-to-register | ||
| 1888 | (downcase vip-use-register) vip-com-point (point))) | ||
| 1889 | (t (setq vip-use-register nil) | ||
| 1890 | (error vip-InvalidRegister vip-use-register))) | ||
| 1891 | (setq vip-use-register nil))) | ||
| 1892 | (setq last-command nil) | ||
| 1893 | (copy-region-as-kill vip-com-point (point)) | ||
| 1894 | (goto-char vip-com-point)) | ||
| 1895 | |||
| 1896 | (defun vip-exec-Yank (m-com com) | ||
| 1897 | (save-excursion | ||
| 1898 | (set-mark vip-com-point) | ||
| 1899 | (vip-enlarge-region (mark t) (point)) | ||
| 1900 | (if vip-use-register | ||
| 1901 | (progn | ||
| 1902 | (cond ((vip-valid-register vip-use-register '(letter digit)) | ||
| 1903 | ;;(vip-valid-register vip-use-register '(letter)) | ||
| 1904 | (copy-to-register | ||
| 1905 | vip-use-register (mark t) (point) nil)) | ||
| 1906 | ((vip-valid-register vip-use-register '(Letter)) | ||
| 1907 | (vip-append-to-register | ||
| 1908 | (downcase vip-use-register) (mark t) (point))) | ||
| 1909 | (t (setq vip-use-register nil) | ||
| 1910 | (error vip-InvalidRegister vip-use-register))) | ||
| 1911 | (setq vip-use-register nil))) | ||
| 1912 | (setq last-command nil) | ||
| 1913 | (copy-region-as-kill (mark t) (point))) | ||
| 1914 | (goto-char vip-com-point)) | ||
| 1915 | |||
| 1916 | (defun vip-exec-bang (m-com com) | ||
| 1917 | (save-excursion | ||
| 1918 | (set-mark vip-com-point) | ||
| 1919 | (vip-enlarge-region (mark t) (point)) | ||
| 1920 | (shell-command-on-region | ||
| 1921 | (mark t) (point) | ||
| 1922 | (if (= com ?!) | ||
| 1923 | (setq vip-last-shell-com | ||
| 1924 | (vip-read-string-with-history | ||
| 1925 | "!" | ||
| 1926 | nil | ||
| 1927 | 'vip-shell-history | ||
| 1928 | (car vip-shell-history) | ||
| 1929 | )) | ||
| 1930 | vip-last-shell-com) | ||
| 1931 | t))) | ||
| 1932 | |||
| 1933 | (defun vip-exec-equals (m-com com) | ||
| 1934 | (save-excursion | ||
| 1935 | (set-mark vip-com-point) | ||
| 1936 | (vip-enlarge-region (mark t) (point)) | ||
| 1937 | (if (> (mark t) (point)) (exchange-point-and-mark)) | ||
| 1938 | (indent-region (mark t) (point) nil))) | ||
| 1939 | |||
| 1940 | (defun vip-exec-shift (m-com com) | ||
| 1941 | (save-excursion | ||
| 1942 | (set-mark vip-com-point) | ||
| 1943 | (vip-enlarge-region (mark t) (point)) | ||
| 1944 | (if (> (mark t) (point)) (exchange-point-and-mark)) | ||
| 1945 | (indent-rigidly (mark t) (point) | ||
| 1946 | (if (= com ?>) | ||
| 1947 | vip-shift-width | ||
| 1948 | (- vip-shift-width))))) | ||
| 1949 | |||
| 1950 | ;; this is needed because some commands fake com by setting it to ?r, which | ||
| 1951 | ;; denotes repeated insert command. | ||
| 1952 | (defsubst vip-exec-dummy (m-com com) | ||
| 1953 | nil) | ||
| 1954 | |||
| 1955 | (defun vip-exec-buffer-search (m-com com) | ||
| 1956 | (setq vip-s-string (buffer-substring (point) vip-com-point)) | ||
| 1957 | (setq vip-s-forward t) | ||
| 1958 | (setq vip-search-history (cons vip-s-string vip-search-history)) | ||
| 1959 | (vip-search vip-s-string vip-s-forward 1)) | ||
| 1960 | |||
| 1961 | (defvar vip-exec-array (make-vector 128 nil)) | ||
| 1962 | |||
| 1963 | ;; Using a dispatch array allows adding functions like buffer search | ||
| 1964 | ;; without affecting other functions. Buffer search can now be bound | ||
| 1965 | ;; to any character. | ||
| 1966 | |||
| 1967 | (aset vip-exec-array ?c 'vip-exec-change) | ||
| 1968 | (aset vip-exec-array ?C 'vip-exec-Change) | ||
| 1969 | (aset vip-exec-array ?d 'vip-exec-delete) | ||
| 1970 | (aset vip-exec-array ?D 'vip-exec-Delete) | ||
| 1971 | (aset vip-exec-array ?y 'vip-exec-yank) | ||
| 1972 | (aset vip-exec-array ?Y 'vip-exec-Yank) | ||
| 1973 | (aset vip-exec-array ?r 'vip-exec-dummy) | ||
| 1974 | (aset vip-exec-array ?! 'vip-exec-bang) | ||
| 1975 | (aset vip-exec-array ?< 'vip-exec-shift) | ||
| 1976 | (aset vip-exec-array ?> 'vip-exec-shift) | ||
| 1977 | (aset vip-exec-array ?= 'vip-exec-equals) | ||
| 1978 | |||
| 1979 | |||
| 1980 | |||
| 1981 | ;; This function is called by various movement commands to execute a | ||
| 1982 | ;; destructive command on the region specified by the movement command. For | ||
| 1983 | ;; instance, if the user types cw, then the command vip-forward-word will | ||
| 1984 | ;; call vip-execute-com to execute vip-exec-change, which eventually will | ||
| 1985 | ;; call vip-change to invoke the replace mode on the region. | ||
| 1986 | ;; | ||
| 1987 | ;; The list (M-COM VAL COM REG INSETED-TEXT COMMAND-KEYS) is set to | ||
| 1988 | ;; vip-d-com for later use by vip-repeat. | ||
| 1989 | (defun vip-execute-com (m-com val com) | ||
| 1990 | (let ((reg vip-use-register)) | ||
| 1991 | ;; this is the special command `#' | ||
| 1992 | (if (> com 128) | ||
| 1993 | (vip-special-prefix-com (- com 128)) | ||
| 1994 | (let ((fn (aref vip-exec-array (if (< com 0) (- com) com)))) | ||
| 1995 | (if (null fn) | ||
| 1996 | (error "%c: %s" com vip-InvalidViCommand) | ||
| 1997 | (funcall fn m-com com)))) | ||
| 1998 | (if (vip-dotable-command-p com) | ||
| 1999 | (vip-set-destructive-command | ||
| 2000 | (list m-com val | ||
| 2001 | (if (memq com (list ?c ?C ?!)) (- com) com) | ||
| 2002 | reg nil nil))) | ||
| 2003 | )) | ||
| 2004 | |||
| 2005 | |||
| 2006 | (defun vip-repeat (arg) | ||
| 2007 | "Re-execute last destructive command. | ||
| 2008 | Use the info in vip-d-com, which has the form | ||
| 2009 | \(com val ch reg inserted-text command-keys\), | ||
| 2010 | where `com' is the command to be re-executed, `val' is the | ||
| 2011 | argument to `com', `ch' is a flag for repeat, and `reg' is optional; | ||
| 2012 | if it exists, it is the name of the register for `com'. | ||
| 2013 | If the prefix argument, ARG, is non-nil, it is used instead of `val'." | ||
| 2014 | (interactive "P") | ||
| 2015 | (let ((save-point (point)) ; save point before repeating prev cmd | ||
| 2016 | ;; Pass along that we are repeating a destructive command | ||
| 2017 | ;; This tells vip-set-destructive-command not to update | ||
| 2018 | ;; vip-command-ring | ||
| 2019 | (vip-intermediate-command 'vip-repeat)) | ||
| 2020 | (if (eq last-command 'vip-undo) | ||
| 2021 | ;; if the last command was vip-undo, then undo-more | ||
| 2022 | (vip-undo-more) | ||
| 2023 | ;; otherwise execute the command stored in vip-d-com. if arg is non-nil | ||
| 2024 | ;; its prefix value is used as new prefix value for the command. | ||
| 2025 | (let ((m-com (car vip-d-com)) | ||
| 2026 | (val (vip-P-val arg)) | ||
| 2027 | (com (nth 2 vip-d-com)) | ||
| 2028 | (reg (nth 3 vip-d-com))) | ||
| 2029 | (if (null val) (setq val (nth 1 vip-d-com))) | ||
| 2030 | (if (null m-com) (error "No previous command to repeat.")) | ||
| 2031 | (setq vip-use-register reg) | ||
| 2032 | (if (nth 4 vip-d-com) ; text inserted by command | ||
| 2033 | (setq vip-last-insertion (nth 4 vip-d-com) | ||
| 2034 | vip-d-char (nth 4 vip-d-com))) | ||
| 2035 | (funcall m-com (cons val com)) | ||
| 2036 | (if (and vip-keep-point-on-repeat (< save-point (point))) | ||
| 2037 | (goto-char save-point)) ; go back to before repeat. | ||
| 2038 | (if (and (eolp) (not (bolp))) | ||
| 2039 | (backward-char 1)) | ||
| 2040 | )) | ||
| 2041 | (if vip-undo-needs-adjustment (vip-adjust-undo)) ; take care of undo | ||
| 2042 | ;; If the prev cmd was rotating the command ring, this means that `.' has | ||
| 2043 | ;; just executed a command from that ring. So, push it on the ring again. | ||
| 2044 | ;; If we are just executing previous command , then don't push vip-d-com | ||
| 2045 | ;; because vip-d-com is not fully constructed in this case (its keys and | ||
| 2046 | ;; the inserted text may be nil). Besides, in this case, the command | ||
| 2047 | ;; executed by `.' is already on the ring. | ||
| 2048 | (if (eq last-command 'vip-display-current-destructive-command) | ||
| 2049 | (vip-push-onto-ring vip-d-com 'vip-command-ring)) | ||
| 2050 | (vip-deactivate-mark) | ||
| 2051 | )) | ||
| 2052 | |||
| 2053 | (defun vip-repeat-from-history () | ||
| 2054 | "Repeat a destructive command from history. | ||
| 2055 | Doesn't change vip-command-ring in any way, so `.' will work as before | ||
| 2056 | executing this command. | ||
| 2057 | This command is supposed to be bound to a two-character Vi macro where | ||
| 2058 | the second character is a digit 0 to 9. The digit indicates which | ||
| 2059 | history command to execute. `<char>0' is equivalent to `.', `<char>1' | ||
| 2060 | invokes the command before that, etc." | ||
| 2061 | (interactive) | ||
| 2062 | (let* ((vip-intermediate-command 'repeating-display-destructive-command) | ||
| 2063 | (idx (cond (vip-this-kbd-macro | ||
| 2064 | (string-to-number | ||
| 2065 | (symbol-name (elt vip-this-kbd-macro 1)))) | ||
| 2066 | (t 0))) | ||
| 2067 | (num idx) | ||
| 2068 | (vip-d-com vip-d-com)) | ||
| 2069 | |||
| 2070 | (or (and (numberp num) (<= 0 num) (<= num 9)) | ||
| 2071 | (setq idx 0 | ||
| 2072 | num 0) | ||
| 2073 | (message | ||
| 2074 | "`vip-repeat-from-history' must be invoked as a Vi macro bound to `<key><digit>'")) | ||
| 2075 | (while (< 0 num) | ||
| 2076 | (setq vip-d-com (vip-special-ring-rotate1 vip-command-ring -1)) | ||
| 2077 | (setq num (1- num))) | ||
| 2078 | (vip-repeat nil) | ||
| 2079 | (while (> idx num) | ||
| 2080 | (vip-special-ring-rotate1 vip-command-ring 1) | ||
| 2081 | (setq num (1+ num))) | ||
| 2082 | )) | ||
| 2083 | |||
| 2084 | |||
| 2085 | (defun vip-special-prefix-com (char) | ||
| 2086 | "This command is invoked interactively by the key sequence #<char>." | ||
| 2087 | (cond ((= char ?c) | ||
| 2088 | (downcase-region (min vip-com-point (point)) | ||
| 2089 | (max vip-com-point (point)))) | ||
| 2090 | ((= char ?C) | ||
| 2091 | (upcase-region (min vip-com-point (point)) | ||
| 2092 | (max vip-com-point (point)))) | ||
| 2093 | ((= char ?g) | ||
| 2094 | (push-mark vip-com-point t) | ||
| 2095 | (vip-global-execute)) | ||
| 2096 | ((= char ?q) | ||
| 2097 | (push-mark vip-com-point t) | ||
| 2098 | (vip-quote-region)) | ||
| 2099 | ((= char ?s) (funcall vip-spell-function vip-com-point (point))) | ||
| 2100 | (t (error "#%c: %s" char vip-InvalidViCommand)))) | ||
| 2101 | |||
| 2102 | |||
| 2103 | ;; undoing | ||
| 2104 | |||
| 2105 | (defun vip-undo () | ||
| 2106 | "Undo previous change." | ||
| 2107 | (interactive) | ||
| 2108 | (message "undo!") | ||
| 2109 | (let ((modified (buffer-modified-p)) | ||
| 2110 | (before-undo-pt (point-marker)) | ||
| 2111 | (after-change-functions after-change-functions) | ||
| 2112 | undo-beg-posn undo-end-posn) | ||
| 2113 | |||
| 2114 | ;; no need to remove this hook, since this var has scope inside a let. | ||
| 2115 | (add-hook 'after-change-functions | ||
| 2116 | '(lambda (beg end len) | ||
| 2117 | (setq undo-beg-posn beg | ||
| 2118 | undo-end-posn (or end beg)))) | ||
| 2119 | |||
| 2120 | (undo-start) | ||
| 2121 | (undo-more 2) | ||
| 2122 | (setq undo-beg-posn (or undo-beg-posn before-undo-pt) | ||
| 2123 | undo-end-posn (or undo-end-posn undo-beg-posn)) | ||
| 2124 | |||
| 2125 | (goto-char undo-beg-posn) | ||
| 2126 | (sit-for 0) | ||
| 2127 | (if (and vip-keep-point-on-undo | ||
| 2128 | (pos-visible-in-window-p before-undo-pt)) | ||
| 2129 | (progn | ||
| 2130 | (push-mark (point-marker) t) | ||
| 2131 | (vip-sit-for-short 300) | ||
| 2132 | (goto-char undo-end-posn) | ||
| 2133 | (vip-sit-for-short 300) | ||
| 2134 | (if (and (> (abs (- undo-beg-posn before-undo-pt)) 1) | ||
| 2135 | (> (abs (- undo-end-posn before-undo-pt)) 1)) | ||
| 2136 | (goto-char before-undo-pt) | ||
| 2137 | (goto-char undo-beg-posn))) | ||
| 2138 | (push-mark before-undo-pt t)) | ||
| 2139 | (if (and (eolp) (not (bolp))) (backward-char 1)) | ||
| 2140 | (if (not modified) (set-buffer-modified-p t))) | ||
| 2141 | (setq this-command 'vip-undo)) | ||
| 2142 | |||
| 2143 | (defun vip-undo-more () | ||
| 2144 | "Continue undoing previous changes." | ||
| 2145 | (message "undo more!") | ||
| 2146 | (condition-case nil | ||
| 2147 | (undo-more 1) | ||
| 2148 | (error (beep) | ||
| 2149 | (message "No further undo information in this buffer"))) | ||
| 2150 | (if (and (eolp) (not (bolp))) (backward-char 1)) | ||
| 2151 | (setq this-command 'vip-undo)) | ||
| 2152 | |||
| 2153 | ;; The following two functions are used to set up undo properly. | ||
| 2154 | ;; In VI, unlike Emacs, if you open a line, say, and add a bunch of lines, | ||
| 2155 | ;; they are undone all at once. | ||
| 2156 | (defun vip-adjust-undo () | ||
| 2157 | (let ((inhibit-quit t) | ||
| 2158 | tmp tmp2) | ||
| 2159 | (setq vip-undo-needs-adjustment nil) | ||
| 2160 | (if (listp buffer-undo-list) | ||
| 2161 | (if (setq tmp (memq vip-buffer-undo-list-mark buffer-undo-list)) | ||
| 2162 | (progn | ||
| 2163 | (setq tmp2 (cdr tmp)) ; the part after mark | ||
| 2164 | |||
| 2165 | ;; cut tail from buffer-undo-list temporarily by direct | ||
| 2166 | ;; manipulation with pointers in buffer-undo-list | ||
| 2167 | (setcdr tmp nil) | ||
| 2168 | |||
| 2169 | (setq buffer-undo-list (delq nil buffer-undo-list)) | ||
| 2170 | (setq buffer-undo-list | ||
| 2171 | (delq vip-buffer-undo-list-mark buffer-undo-list)) | ||
| 2172 | ;; restore tail of buffer-undo-list | ||
| 2173 | (setq buffer-undo-list (nconc buffer-undo-list tmp2))) | ||
| 2174 | (setq buffer-undo-list (delq nil buffer-undo-list)))))) | ||
| 2175 | |||
| 2176 | |||
| 2177 | (defun vip-set-complex-command-for-undo () | ||
| 2178 | (if (listp buffer-undo-list) | ||
| 2179 | (if (not vip-undo-needs-adjustment) | ||
| 2180 | (let ((inhibit-quit t)) | ||
| 2181 | (setq buffer-undo-list | ||
| 2182 | (cons vip-buffer-undo-list-mark buffer-undo-list)) | ||
| 2183 | (setq vip-undo-needs-adjustment t))))) | ||
| 2184 | |||
| 2185 | |||
| 2186 | |||
| 2187 | |||
| 2188 | (defun vip-display-current-destructive-command () | ||
| 2189 | (let ((text (nth 4 vip-d-com)) | ||
| 2190 | (keys (nth 5 vip-d-com)) | ||
| 2191 | (max-text-len 30)) | ||
| 2192 | |||
| 2193 | (setq this-command 'vip-display-current-destructive-command) | ||
| 2194 | |||
| 2195 | (message " `.' runs %s%s" | ||
| 2196 | (concat "`" (vip-array-to-string keys) "'") | ||
| 2197 | (vip-abbreviate-string text max-text-len | ||
| 2198 | " inserting `" "'" " .......")) | ||
| 2199 | )) | ||
| 2200 | |||
| 2201 | |||
| 2202 | ;; don't change vip-d-com if it was vip-repeat command invoked with `.' | ||
| 2203 | ;; or in some other way (non-interactively). | ||
| 2204 | (defun vip-set-destructive-command (list) | ||
| 2205 | (or (eq vip-intermediate-command 'vip-repeat) | ||
| 2206 | (progn | ||
| 2207 | (setq vip-d-com list) | ||
| 2208 | (setcar (nthcdr 5 vip-d-com) | ||
| 2209 | (vip-array-to-string (this-command-keys))) | ||
| 2210 | (vip-push-onto-ring vip-d-com 'vip-command-ring)))) | ||
| 2211 | |||
| 2212 | (defun vip-prev-destructive-command (next) | ||
| 2213 | "Find previous destructive command in the history of destructive commands. | ||
| 2214 | With prefix argument, find next destructive command." | ||
| 2215 | (interactive "P") | ||
| 2216 | (let (cmd vip-intermediate-command) | ||
| 2217 | (if (eq last-command 'vip-display-current-destructive-command) | ||
| 2218 | ;; repeated search through command history | ||
| 2219 | (setq vip-intermediate-command 'repeating-display-destructive-command) | ||
| 2220 | ;; first search through command history--set temp ring | ||
| 2221 | (setq vip-temp-command-ring (copy-list vip-command-ring))) | ||
| 2222 | (setq cmd (if next | ||
| 2223 | (vip-special-ring-rotate1 vip-temp-command-ring 1) | ||
| 2224 | (vip-special-ring-rotate1 vip-temp-command-ring -1))) | ||
| 2225 | (if (null cmd) | ||
| 2226 | () | ||
| 2227 | (setq vip-d-com cmd)) | ||
| 2228 | (vip-display-current-destructive-command))) | ||
| 2229 | |||
| 2230 | (defun vip-next-destructive-command () | ||
| 2231 | "Find next destructive command in the history of destructive commands." | ||
| 2232 | (interactive) | ||
| 2233 | (vip-prev-destructive-command 'next)) | ||
| 2234 | |||
| 2235 | (defun vip-insert-prev-from-insertion-ring (arg) | ||
| 2236 | "Cycles through insertion ring in the direction of older insertions. | ||
| 2237 | Undoes previous insertion and inserts new. | ||
| 2238 | With prefix argument, cycles in the direction of newer elements. | ||
| 2239 | In minibuffer, this command executes whatever the invocation key is bound | ||
| 2240 | to in the global map, instead of cycling through the insertion ring." | ||
| 2241 | (interactive "P") | ||
| 2242 | (let (vip-intermediate-command) | ||
| 2243 | (if (eq last-command 'vip-insert-from-insertion-ring) | ||
| 2244 | (progn ; repeated search through insertion history | ||
| 2245 | (setq vip-intermediate-command 'repeating-insertion-from-ring) | ||
| 2246 | (if (eq vip-current-state 'replace-state) | ||
| 2247 | (undo 1) | ||
| 2248 | (if vip-last-inserted-string-from-insertion-ring | ||
| 2249 | (backward-delete-char | ||
| 2250 | (length vip-last-inserted-string-from-insertion-ring)))) | ||
| 2251 | ) | ||
| 2252 | ;;first search through insertion history | ||
| 2253 | (setq vip-temp-insertion-ring (copy-list vip-insertion-ring))) | ||
| 2254 | (setq this-command 'vip-insert-from-insertion-ring) | ||
| 2255 | ;; so that things will be undone properly | ||
| 2256 | (setq buffer-undo-list (cons nil buffer-undo-list)) | ||
| 2257 | (setq vip-last-inserted-string-from-insertion-ring | ||
| 2258 | (vip-special-ring-rotate1 vip-temp-insertion-ring (if arg 1 -1))) | ||
| 2259 | |||
| 2260 | ;; this change of vip-intermediate-command must come after | ||
| 2261 | ;; vip-special-ring-rotate1, so that the ring will rotate, but before the | ||
| 2262 | ;; insertion. | ||
| 2263 | (setq vip-intermediate-command nil) | ||
| 2264 | (if vip-last-inserted-string-from-insertion-ring | ||
| 2265 | (insert vip-last-inserted-string-from-insertion-ring)) | ||
| 2266 | )) | ||
| 2267 | |||
| 2268 | (defun vip-insert-next-from-insertion-ring () | ||
| 2269 | "Cycles through insertion ring in the direction of older insertions. Undoes previous insertion and inserts new." | ||
| 2270 | (interactive) | ||
| 2271 | (vip-insert-prev-from-insertion-ring 'next)) | ||
| 2272 | |||
| 2273 | |||
| 2274 | ;; some region utilities | ||
| 2275 | |||
| 2276 | (defun vip-add-newline-at-eob-if-necessary () | ||
| 2277 | "If at the last line of buffer, add \\n before eob, if newline is missing." | ||
| 2278 | (save-excursion | ||
| 2279 | (end-of-line) | ||
| 2280 | ;; make sure all lines end with newline, unless in the minibuffer or | ||
| 2281 | ;; when requested otherwise (vip-add-newline-at-eob is nil) | ||
| 2282 | (if (and | ||
| 2283 | (eobp) | ||
| 2284 | (not (bolp)) | ||
| 2285 | vip-add-newline-at-eob | ||
| 2286 | (not (vip-is-in-minibuffer))) | ||
| 2287 | (insert "\n")))) | ||
| 2288 | |||
| 2289 | (defun vip-yank-defun () | ||
| 2290 | (mark-defun) | ||
| 2291 | (copy-region-as-kill (point) (mark t))) | ||
| 2292 | |||
| 2293 | (defun vip-enlarge-region (beg end) | ||
| 2294 | "Enlarge region between BEG and END." | ||
| 2295 | (or beg (setq beg end)) ; if beg is nil, set to end | ||
| 2296 | (or end (setq end beg)) ; if end is nil, set to beg | ||
| 2297 | |||
| 2298 | (if (< beg end) | ||
| 2299 | (progn (goto-char beg) (set-mark end)) | ||
| 2300 | (goto-char end) | ||
| 2301 | (set-mark beg)) | ||
| 2302 | (beginning-of-line) | ||
| 2303 | (exchange-point-and-mark) | ||
| 2304 | (if (or (not (eobp)) (not (bolp))) (forward-line 1)) | ||
| 2305 | (if (not (eobp)) (beginning-of-line)) | ||
| 2306 | (if (> beg end) (exchange-point-and-mark))) | ||
| 2307 | |||
| 2308 | |||
| 2309 | (defun vip-quote-region () | ||
| 2310 | "Quote region by each line with a user supplied string." | ||
| 2311 | (setq vip-quote-string | ||
| 2312 | (vip-read-string-with-history | ||
| 2313 | "Quote string: " | ||
| 2314 | nil | ||
| 2315 | 'vip-quote-region-history | ||
| 2316 | vip-quote-string)) | ||
| 2317 | (vip-enlarge-region (point) (mark t)) | ||
| 2318 | (if (> (point) (mark t)) (exchange-point-and-mark)) | ||
| 2319 | (insert vip-quote-string) | ||
| 2320 | (beginning-of-line) | ||
| 2321 | (forward-line 1) | ||
| 2322 | (while (and (< (point) (mark t)) (bolp)) | ||
| 2323 | (insert vip-quote-string) | ||
| 2324 | (beginning-of-line) | ||
| 2325 | (forward-line 1))) | ||
| 2326 | |||
| 2327 | |||
| 2328 | ;; Tells whether BEG is on the same line as END. | ||
| 2329 | ;; If one of the args is nil, it'll return nil. | ||
| 2330 | (defun vip-same-line (beg end) | ||
| 2331 | (let ((selective-display nil)) | ||
| 2332 | (cond ((and beg end) | ||
| 2333 | ;; This 'if' is needed because Emacs treats the next empty line | ||
| 2334 | ;; as part of the previous line. | ||
| 2335 | (if (or (> beg (point-max)) (> end (point-max))) ; out of range | ||
| 2336 | () | ||
| 2337 | (if (and (> end beg) (= (vip-line-pos 'start) end)) | ||
| 2338 | (setq end (min (1+ end) (point-max)))) | ||
| 2339 | (if (and (> beg end) (= (vip-line-pos 'start) beg)) | ||
| 2340 | (setq beg (min (1+ beg) (point-max)))) | ||
| 2341 | (<= (count-lines beg end) 1) )) | ||
| 2342 | |||
| 2343 | (t nil)) | ||
| 2344 | )) | ||
| 2345 | |||
| 2346 | |||
| 2347 | ;; Check if the string ends with a newline. | ||
| 2348 | (defun vip-end-with-a-newline-p (string) | ||
| 2349 | (or (string= string "") | ||
| 2350 | (= (vip-seq-last-elt string) ?\n))) | ||
| 2351 | |||
| 2352 | (defun vip-tmp-insert-at-eob (msg) | ||
| 2353 | (let ((savemax (point-max))) | ||
| 2354 | (goto-char savemax) | ||
| 2355 | (insert msg) | ||
| 2356 | (sit-for 2) | ||
| 2357 | (goto-char savemax) (delete-region (point) (point-max)) | ||
| 2358 | )) | ||
| 2359 | |||
| 2360 | |||
| 2361 | |||
| 2362 | ;;; Minibuffer business | ||
| 2363 | |||
| 2364 | (defsubst vip-set-minibuffer-style () | ||
| 2365 | (add-hook 'minibuffer-setup-hook 'vip-minibuffer-setup-sentinel)) | ||
| 2366 | |||
| 2367 | |||
| 2368 | (defun vip-minibuffer-setup-sentinel () | ||
| 2369 | (let ((hook (if vip-vi-style-in-minibuffer | ||
| 2370 | 'vip-change-state-to-insert | ||
| 2371 | 'vip-change-state-to-emacs))) | ||
| 2372 | (funcall hook) | ||
| 2373 | |||
| 2374 | ;; Make sure the minibufer overlay is kept up-to-date. In XEmacs also | ||
| 2375 | ;; guards against the possibility of detaching this overlay. | ||
| 2376 | (add-hook 'vip-post-command-hooks 'vip-move-minibuffer-overlay) | ||
| 2377 | )) | ||
| 2378 | |||
| 2379 | ;; Interpret last event in the local map | ||
| 2380 | (defun vip-exit-minibuffer () | ||
| 2381 | (interactive) | ||
| 2382 | (let (command) | ||
| 2383 | (setq command (local-key-binding (char-to-string last-command-char))) | ||
| 2384 | (if command | ||
| 2385 | (command-execute command) | ||
| 2386 | (exit-minibuffer)))) | ||
| 2387 | |||
| 2388 | |||
| 2389 | (defun vip-set-search-face () | ||
| 2390 | (if (not window-system) | ||
| 2391 | () | ||
| 2392 | (defvar vip-search-face | ||
| 2393 | (progn | ||
| 2394 | (make-face 'vip-search-face) | ||
| 2395 | (or (face-differs-from-default-p 'vip-search-face) | ||
| 2396 | ;; face wasn't set in .vip or .Xdefaults | ||
| 2397 | (if (vip-can-use-colors "Black" "khaki") | ||
| 2398 | (progn | ||
| 2399 | (set-face-background 'vip-search-face "khaki") | ||
| 2400 | (set-face-foreground 'vip-search-face "Black")) | ||
| 2401 | (copy-face 'italic 'vip-search-face) | ||
| 2402 | (set-face-underline-p 'vip-search-face t))) | ||
| 2403 | 'vip-search-face) | ||
| 2404 | "*Face used to flash out the search pattern.") | ||
| 2405 | )) | ||
| 2406 | |||
| 2407 | |||
| 2408 | (defun vip-set-minibuffer-faces () | ||
| 2409 | (if (not window-system) | ||
| 2410 | () | ||
| 2411 | (defvar vip-minibuffer-emacs-face | ||
| 2412 | (progn | ||
| 2413 | (make-face 'vip-minibuffer-emacs-face) | ||
| 2414 | (or (face-differs-from-default-p 'vip-minibuffer-emacs-face) | ||
| 2415 | ;; face wasn't set in .vip or .Xdefaults | ||
| 2416 | (if vip-vi-style-in-minibuffer | ||
| 2417 | ;; emacs state is an exception in the minibuffer | ||
| 2418 | (if (vip-can-use-colors "darkseagreen2" "Black") | ||
| 2419 | (progn | ||
| 2420 | (set-face-background | ||
| 2421 | 'vip-minibuffer-emacs-face "darkseagreen2") | ||
| 2422 | (set-face-foreground | ||
| 2423 | 'vip-minibuffer-emacs-face "Black")) | ||
| 2424 | (copy-face 'highlight 'vip-minibuffer-emacs-face)) | ||
| 2425 | ;; emacs state is the main state in the minibuffer | ||
| 2426 | (if (vip-can-use-colors "Black" "pink") | ||
| 2427 | (progn | ||
| 2428 | (set-face-background 'vip-minibuffer-emacs-face "pink") | ||
| 2429 | (set-face-foreground | ||
| 2430 | 'vip-minibuffer-emacs-face "Black")) | ||
| 2431 | (copy-face 'italic 'vip-minibuffer-emacs-face)) | ||
| 2432 | )) | ||
| 2433 | 'vip-minibuffer-emacs-face) | ||
| 2434 | "Face used in the Minibuffer when it is in Emacs state.") | ||
| 2435 | |||
| 2436 | (defvar vip-minibuffer-insert-face | ||
| 2437 | (progn | ||
| 2438 | (make-face 'vip-minibuffer-insert-face) | ||
| 2439 | (or (face-differs-from-default-p 'vip-minibuffer-insert-face) | ||
| 2440 | (if vip-vi-style-in-minibuffer | ||
| 2441 | (if (vip-can-use-colors "Black" "pink") | ||
| 2442 | (progn | ||
| 2443 | (set-face-background 'vip-minibuffer-insert-face "pink") | ||
| 2444 | (set-face-foreground | ||
| 2445 | 'vip-minibuffer-insert-face "Black")) | ||
| 2446 | (copy-face 'italic 'vip-minibuffer-insert-face)) | ||
| 2447 | ;; If Insert state is an exception | ||
| 2448 | (if (vip-can-use-colors "darkseagreen2" "Black") | ||
| 2449 | (progn | ||
| 2450 | (set-face-background | ||
| 2451 | 'vip-minibuffer-insert-face "darkseagreen2") | ||
| 2452 | (set-face-foreground | ||
| 2453 | 'vip-minibuffer-insert-face "Black")) | ||
| 2454 | (copy-face 'highlight 'vip-minibuffer-insert-face)) | ||
| 2455 | (vip-italicize-face 'vip-minibuffer-insert-face))) | ||
| 2456 | 'vip-minibuffer-insert-face) | ||
| 2457 | "Face used in the Minibuffer when it is in Insert state.") | ||
| 2458 | |||
| 2459 | (defvar vip-minibuffer-vi-face | ||
| 2460 | (progn | ||
| 2461 | (make-face 'vip-minibuffer-vi-face) | ||
| 2462 | (or (face-differs-from-default-p 'vip-minibuffer-vi-face) | ||
| 2463 | (if vip-vi-style-in-minibuffer | ||
| 2464 | (if (vip-can-use-colors "Black" "grey") | ||
| 2465 | (progn | ||
| 2466 | (set-face-background 'vip-minibuffer-vi-face "grey") | ||
| 2467 | (set-face-foreground 'vip-minibuffer-vi-face "Black")) | ||
| 2468 | (copy-face 'bold 'vip-minibuffer-vi-face)) | ||
| 2469 | (copy-face 'bold 'vip-minibuffer-vi-face) | ||
| 2470 | (invert-face 'vip-minibuffer-vi-face))) | ||
| 2471 | 'vip-minibuffer-vi-face) | ||
| 2472 | "Face used in the Minibuffer when it is in Vi state.") | ||
| 2473 | |||
| 2474 | ;; the current face used in the minibuffer | ||
| 2475 | (vip-deflocalvar vip-minibuffer-current-face vip-minibuffer-emacs-face "") | ||
| 2476 | )) | ||
| 2477 | |||
| 2478 | |||
| 2479 | |||
| 2480 | ;;; Reading string with history | ||
| 2481 | |||
| 2482 | (defun vip-read-string-with-history (prompt &optional initial | ||
| 2483 | history-var default keymap) | ||
| 2484 | ;; Reads string, prompting with PROMPT and inserting the INITIAL | ||
| 2485 | ;; value. Uses HISTORY-VAR. DEFAULT is the default value to accept if the | ||
| 2486 | ;; input is an empty string. Uses KEYMAP, if given, or the | ||
| 2487 | ;; minibuffer-local-map. | ||
| 2488 | ;; Default value is displayed until the user types something in the | ||
| 2489 | ;; minibuffer. | ||
| 2490 | (let ((minibuffer-setup-hook | ||
| 2491 | '(lambda () | ||
| 2492 | (if (stringp initial) | ||
| 2493 | (progn | ||
| 2494 | (sit-for 840) | ||
| 2495 | (erase-buffer) | ||
| 2496 | (insert initial))) | ||
| 2497 | (vip-minibuffer-setup-sentinel))) | ||
| 2498 | (val "") | ||
| 2499 | (padding "") | ||
| 2500 | temp-msg) | ||
| 2501 | |||
| 2502 | (setq keymap (or keymap minibuffer-local-map) | ||
| 2503 | initial (or initial "") | ||
| 2504 | temp-msg (if default | ||
| 2505 | (format "(default: %s) " default) | ||
| 2506 | "")) | ||
| 2507 | |||
| 2508 | (setq vip-incomplete-ex-cmd nil) | ||
| 2509 | (setq val (read-from-minibuffer prompt | ||
| 2510 | (concat temp-msg initial val padding) | ||
| 2511 | keymap nil history-var)) | ||
| 2512 | (setq minibuffer-setup-hook nil | ||
| 2513 | padding (vip-array-to-string (this-command-keys)) | ||
| 2514 | temp-msg "") | ||
| 2515 | ;; the following overcomes a glaring bug in history handling | ||
| 2516 | ;; in XEmacs 19.11 | ||
| 2517 | (if (not (string= val (car (eval history-var)))) | ||
| 2518 | (set history-var (cons val (eval history-var)))) | ||
| 2519 | (if (or (string= (nth 0 (eval history-var)) (nth 1 (eval history-var))) | ||
| 2520 | (string= (nth 0 (eval history-var)) "")) | ||
| 2521 | (set history-var (cdr (eval history-var)))) | ||
| 2522 | (if (string= val "") | ||
| 2523 | (or default "") | ||
| 2524 | val))) | ||
| 2525 | |||
| 2526 | |||
| 2527 | |||
| 2528 | ;; insertion commands | ||
| 2529 | |||
| 2530 | ;; Called when state changes from Insert Vi command mode. | ||
| 2531 | ;; Repeats the insertion command if Insert state was entered with prefix | ||
| 2532 | ;; argument > 1. | ||
| 2533 | (defun vip-repeat-insert-command () | ||
| 2534 | (let ((i-com (car vip-d-com)) | ||
| 2535 | (val (nth 1 vip-d-com)) | ||
| 2536 | (char (nth 2 vip-d-com))) | ||
| 2537 | (if (and val (> val 1)) ; first check that val is non-nil | ||
| 2538 | (progn | ||
| 2539 | (setq vip-d-com (list i-com (1- val) ?r nil nil nil)) | ||
| 2540 | (vip-repeat nil) | ||
| 2541 | (setq vip-d-com (list i-com val char nil nil nil)) | ||
| 2542 | )))) | ||
| 2543 | |||
| 2544 | (defun vip-insert (arg) | ||
| 2545 | "Insert before point." | ||
| 2546 | (interactive "P") | ||
| 2547 | (vip-set-complex-command-for-undo) | ||
| 2548 | (let ((val (vip-p-val arg)) | ||
| 2549 | (com (vip-getcom arg))) | ||
| 2550 | (vip-set-destructive-command (list 'vip-insert val ?r nil nil nil)) | ||
| 2551 | (if com | ||
| 2552 | (vip-loop val (vip-yank-last-insertion)) | ||
| 2553 | (vip-change-state-to-insert)))) | ||
| 2554 | |||
| 2555 | (defun vip-append (arg) | ||
| 2556 | "Append after point." | ||
| 2557 | (interactive "P") | ||
| 2558 | (vip-set-complex-command-for-undo) | ||
| 2559 | (let ((val (vip-p-val arg)) | ||
| 2560 | (com (vip-getcom arg))) | ||
| 2561 | (vip-set-destructive-command (list 'vip-append val ?r nil nil nil)) | ||
| 2562 | (if (not (eolp)) (forward-char)) | ||
| 2563 | (if (equal com ?r) | ||
| 2564 | (vip-loop val (vip-yank-last-insertion)) | ||
| 2565 | (vip-change-state-to-insert)))) | ||
| 2566 | |||
| 2567 | (defun vip-Append (arg) | ||
| 2568 | "Append at end of line." | ||
| 2569 | (interactive "P") | ||
| 2570 | (vip-set-complex-command-for-undo) | ||
| 2571 | (let ((val (vip-p-val arg)) | ||
| 2572 | (com (vip-getcom arg))) | ||
| 2573 | (vip-set-destructive-command (list 'vip-Append val ?r nil nil nil)) | ||
| 2574 | (end-of-line) | ||
| 2575 | (if (equal com ?r) | ||
| 2576 | (vip-loop val (vip-yank-last-insertion)) | ||
| 2577 | (vip-change-state-to-insert)))) | ||
| 2578 | |||
| 2579 | (defun vip-Insert (arg) | ||
| 2580 | "Insert before first non-white." | ||
| 2581 | (interactive "P") | ||
| 2582 | (vip-set-complex-command-for-undo) | ||
| 2583 | (let ((val (vip-p-val arg)) | ||
| 2584 | (com (vip-getcom arg))) | ||
| 2585 | (vip-set-destructive-command (list 'vip-Insert val ?r nil nil nil)) | ||
| 2586 | (back-to-indentation) | ||
| 2587 | (if (equal com ?r) | ||
| 2588 | (vip-loop val (vip-yank-last-insertion)) | ||
| 2589 | (vip-change-state-to-insert)))) | ||
| 2590 | |||
| 2591 | (defun vip-open-line (arg) | ||
| 2592 | "Open line below." | ||
| 2593 | (interactive "P") | ||
| 2594 | (vip-set-complex-command-for-undo) | ||
| 2595 | (let ((val (vip-p-val arg)) | ||
| 2596 | (com (vip-getcom arg))) | ||
| 2597 | (vip-set-destructive-command (list 'vip-open-line val ?r nil nil nil)) | ||
| 2598 | (let ((col (current-indentation))) | ||
| 2599 | (if (equal com ?r) | ||
| 2600 | (vip-loop val | ||
| 2601 | (progn | ||
| 2602 | (end-of-line) | ||
| 2603 | (newline 1) | ||
| 2604 | (if vip-auto-indent | ||
| 2605 | (progn (setq vip-cted t) (indent-to col))) | ||
| 2606 | (vip-yank-last-insertion))) | ||
| 2607 | (end-of-line) | ||
| 2608 | (newline 1) | ||
| 2609 | (if vip-auto-indent (progn (setq vip-cted t) (indent-to col))) | ||
| 2610 | (vip-change-state-to-insert) | ||
| 2611 | )))) | ||
| 2612 | |||
| 2613 | (defun vip-Open-line (arg) | ||
| 2614 | "Open line above." | ||
| 2615 | (interactive "P") | ||
| 2616 | (vip-set-complex-command-for-undo) | ||
| 2617 | (let ((val (vip-p-val arg)) | ||
| 2618 | (com (vip-getcom arg))) | ||
| 2619 | (vip-set-destructive-command (list 'vip-Open-line val ?r nil nil nil)) | ||
| 2620 | (let ((col (current-indentation))) | ||
| 2621 | (if (equal com ?r) | ||
| 2622 | (vip-loop val | ||
| 2623 | (progn | ||
| 2624 | (beginning-of-line) | ||
| 2625 | (open-line 1) | ||
| 2626 | (if vip-auto-indent | ||
| 2627 | (progn (setq vip-cted t) (indent-to col))) | ||
| 2628 | (vip-yank-last-insertion))) | ||
| 2629 | (beginning-of-line) | ||
| 2630 | (open-line 1) | ||
| 2631 | (if vip-auto-indent (progn (setq vip-cted t) (indent-to col))) | ||
| 2632 | (vip-change-state-to-insert))))) | ||
| 2633 | |||
| 2634 | (defun vip-open-line-at-point (arg) | ||
| 2635 | "Open line at point." | ||
| 2636 | (interactive "P") | ||
| 2637 | (vip-set-complex-command-for-undo) | ||
| 2638 | (let ((val (vip-p-val arg)) | ||
| 2639 | (com (vip-getcom arg))) | ||
| 2640 | (vip-set-destructive-command | ||
| 2641 | (list 'vip-open-line-at-point val ?r nil nil nil)) | ||
| 2642 | (if (equal com ?r) | ||
| 2643 | (vip-loop val | ||
| 2644 | (progn | ||
| 2645 | (open-line 1) | ||
| 2646 | (vip-yank-last-insertion))) | ||
| 2647 | (open-line 1) | ||
| 2648 | (vip-change-state-to-insert)))) | ||
| 2649 | |||
| 2650 | (defun vip-substitute (arg) | ||
| 2651 | "Substitute characters." | ||
| 2652 | (interactive "P") | ||
| 2653 | (let ((val (vip-p-val arg)) | ||
| 2654 | (com (vip-getcom arg))) | ||
| 2655 | (push-mark nil t) | ||
| 2656 | (forward-char val) | ||
| 2657 | (if (equal com ?r) | ||
| 2658 | (vip-change-subr (mark t) (point)) | ||
| 2659 | (vip-change (mark t) (point))) | ||
| 2660 | (vip-set-destructive-command (list 'vip-substitute val ?r nil nil nil)) | ||
| 2661 | )) | ||
| 2662 | |||
| 2663 | (defun vip-substitute-line (arg) | ||
| 2664 | "Substitute lines." | ||
| 2665 | (interactive "p") | ||
| 2666 | (vip-set-complex-command-for-undo) | ||
| 2667 | (vip-line (cons arg ?C))) | ||
| 2668 | |||
| 2669 | ;; Prepare for replace | ||
| 2670 | (defun vip-start-replace () | ||
| 2671 | (setq vip-began-as-replace t | ||
| 2672 | vip-sitting-in-replace t | ||
| 2673 | vip-replace-chars-to-delete 0 | ||
| 2674 | vip-replace-chars-deleted 0) | ||
| 2675 | (add-hook 'vip-after-change-functions 'vip-replace-mode-spy-after t) | ||
| 2676 | (add-hook 'vip-before-change-functions 'vip-replace-mode-spy-before t) | ||
| 2677 | ;; this will get added repeatedly, but no harm | ||
| 2678 | (add-hook 'after-change-functions 'vip-after-change-sentinel t) | ||
| 2679 | (add-hook 'before-change-functions 'vip-before-change-sentinel t) | ||
| 2680 | (vip-move-marker-locally 'vip-last-posn-in-replace-region | ||
| 2681 | (vip-replace-start)) | ||
| 2682 | (add-hook 'vip-post-command-hooks 'vip-replace-state-post-command-sentinel t) | ||
| 2683 | (add-hook 'vip-pre-command-hooks 'vip-replace-state-pre-command-sentinel t) | ||
| 2684 | ) | ||
| 2685 | |||
| 2686 | ;; Runs vip-after-change-functions inside after-change-functions | ||
| 2687 | (defun vip-after-change-sentinel (beg end len) | ||
| 2688 | (let ((list vip-after-change-functions)) | ||
| 2689 | (while list | ||
| 2690 | (funcall (car list) beg end len) | ||
| 2691 | (setq list (cdr list))))) | ||
| 2692 | |||
| 2693 | ;; Runs vip-before-change-functions inside before-change-functions | ||
| 2694 | (defun vip-before-change-sentinel (beg end) | ||
| 2695 | (let ((list vip-before-change-functions)) | ||
| 2696 | (while list | ||
| 2697 | (funcall (car list) beg end) | ||
| 2698 | (setq list (cdr list))))) | ||
| 2699 | |||
| 2700 | (defun vip-post-command-sentinel () | ||
| 2701 | (run-hooks 'vip-post-command-hooks)) | ||
| 2702 | |||
| 2703 | (defun vip-pre-command-sentinel () | ||
| 2704 | (run-hooks 'vip-pre-command-hooks)) | ||
| 2705 | |||
| 2706 | ;; Needed so that Viper will be able to figure the last inserted | ||
| 2707 | ;; chunk of text with reasonable accuracy. | ||
| 2708 | (defun vip-insert-state-post-command-sentinel () | ||
| 2709 | (if (and (memq vip-current-state '(insert-state replace-state)) | ||
| 2710 | vip-insert-point | ||
| 2711 | (>= (point) vip-insert-point)) | ||
| 2712 | (setq vip-last-posn-while-in-insert-state (point-marker))) | ||
| 2713 | (if (and (eq this-command 'dabbrev-expand) | ||
| 2714 | (integerp vip-pre-command-point) | ||
| 2715 | (> vip-insert-point vip-pre-command-point)) | ||
| 2716 | (move-marker vip-insert-point vip-pre-command-point)) | ||
| 2717 | ) | ||
| 2718 | |||
| 2719 | (defun vip-insert-state-pre-command-sentinel () | ||
| 2720 | (if (and (eq this-command 'dabbrev-expand) | ||
| 2721 | (markerp vip-insert-point) | ||
| 2722 | (marker-position vip-insert-point)) | ||
| 2723 | (setq vip-pre-command-point (marker-position vip-insert-point)))) | ||
| 2724 | |||
| 2725 | (defun vip-R-state-post-command-sentinel () | ||
| 2726 | ;; This is needed despite vip-replace-state-pre-command-sentinel | ||
| 2727 | ;; When you jump to another buffer in another frame, the pre-command | ||
| 2728 | ;; hook won't change cursor color to default in that other frame. | ||
| 2729 | ;; So, if the second frame cursor was red and we set the point | ||
| 2730 | ;; outside the replacement region, then the cursor color woll remain | ||
| 2731 | ;; red. Restoring the default, below, prevents this. | ||
| 2732 | (vip-restore-cursor-color) | ||
| 2733 | (if (and (<= (vip-replace-start) (point)) | ||
| 2734 | (<= (point) (vip-replace-end))) | ||
| 2735 | (vip-change-cursor-color vip-replace-overlay-cursor-color))) | ||
| 2736 | |||
| 2737 | (defun vip-replace-state-pre-command-sentinel () | ||
| 2738 | (vip-restore-cursor-color)) | ||
| 2739 | |||
| 2740 | (defun vip-replace-state-post-command-sentinel () | ||
| 2741 | ;; This is needed despite vip-replace-state-pre-command-sentinel | ||
| 2742 | ;; When you jump to another buffer in another frame, the pre-command | ||
| 2743 | ;; hook won't change cursor color to default in that other frame. | ||
| 2744 | ;; So, if the second frame cursor was red and we set the point | ||
| 2745 | ;; outside the replacement region, then the cursor color woll remain | ||
| 2746 | ;; red. Restoring the default, below, prevents this. | ||
| 2747 | (vip-restore-cursor-color) | ||
| 2748 | (cond | ||
| 2749 | ((eq vip-current-state 'replace-state) | ||
| 2750 | ;; delete characters to compensate for inserted chars. | ||
| 2751 | (let ((replace-boundary | ||
| 2752 | ;; distinguish empty repl-reg-end-symbol from non-empty | ||
| 2753 | (- (vip-replace-end) | ||
| 2754 | (if (eq (length vip-replace-region-end-symbol) 0) | ||
| 2755 | 0 1))) | ||
| 2756 | ) | ||
| 2757 | |||
| 2758 | (save-excursion | ||
| 2759 | (goto-char vip-last-posn-in-replace-region) | ||
| 2760 | (delete-char vip-replace-chars-to-delete) | ||
| 2761 | (setq vip-replace-chars-to-delete 0 | ||
| 2762 | vip-replace-chars-deleted 0) | ||
| 2763 | ;; terminate replace mode if reached replace limit | ||
| 2764 | (if (= vip-last-posn-in-replace-region | ||
| 2765 | (vip-replace-end)) | ||
| 2766 | (vip-finish-change vip-last-posn-in-replace-region))) | ||
| 2767 | |||
| 2768 | (if (and (<= (vip-replace-start) (point)) | ||
| 2769 | (<= (point) replace-boundary)) | ||
| 2770 | (progn | ||
| 2771 | ;; the state may have changed in vip-finish-change above | ||
| 2772 | (if (eq vip-current-state 'replace-state) | ||
| 2773 | (vip-change-cursor-color vip-replace-overlay-cursor-color)) | ||
| 2774 | (setq vip-last-posn-in-replace-region (point-marker)))) | ||
| 2775 | )) | ||
| 2776 | |||
| 2777 | (t ;; terminate replace mode if changed Viper states. | ||
| 2778 | (vip-finish-change vip-last-posn-in-replace-region))) | ||
| 2779 | ) | ||
| 2780 | |||
| 2781 | |||
| 2782 | ;; checks how many chars were deleted by the last change | ||
| 2783 | (defun vip-replace-mode-spy-before (beg end) | ||
| 2784 | (setq vip-replace-chars-deleted (- end beg | ||
| 2785 | (max 0 (- end (vip-replace-end))) | ||
| 2786 | (max 0 (- (vip-replace-start) beg)) | ||
| 2787 | )) | ||
| 2788 | ) | ||
| 2789 | |||
| 2790 | ;; Invoked as an after-change-function to set up parameters of the last change | ||
| 2791 | (defun vip-replace-mode-spy-after (beg end length) | ||
| 2792 | (if (memq vip-intermediate-command '(repeating-insertion-from-ring)) | ||
| 2793 | (progn | ||
| 2794 | (setq vip-replace-chars-to-delete 0) | ||
| 2795 | (vip-move-marker-locally | ||
| 2796 | 'vip-last-posn-in-replace-region (point))) | ||
| 2797 | |||
| 2798 | (let (beg-col end-col real-end chars-to-delete) | ||
| 2799 | (setq real-end (min end (vip-replace-end))) | ||
| 2800 | (save-excursion | ||
| 2801 | (goto-char beg) | ||
| 2802 | (setq beg-col (current-column)) | ||
| 2803 | (goto-char real-end) | ||
| 2804 | (setq end-col (current-column))) | ||
| 2805 | |||
| 2806 | ;; If beg of change is outside the replacement region, then don't | ||
| 2807 | ;; delete anything in the repl region (set chars-to-delete to 0). | ||
| 2808 | ;; | ||
| 2809 | ;; This works fine except that we have to take special care of | ||
| 2810 | ;; dabbrev-expand. The problem stems from new-dabbrev.el, which | ||
| 2811 | ;; sometimes simply shifts the repl region rightwards, without | ||
| 2812 | ;; deleting an equal amount of characters. | ||
| 2813 | ;; | ||
| 2814 | ;; The reason why new-dabbrev.el causes this are this: | ||
| 2815 | ;; if one dinamically completes a partial word that starts before the | ||
| 2816 | ;; replacement region (but ends inside)then new-dabbrev.el first | ||
| 2817 | ;; moves cursor backwards, to the beginning of the word to be | ||
| 2818 | ;; completed (say, pt A). Then it inserts the | ||
| 2819 | ;; completed word and then deletes the old, incomplete part. | ||
| 2820 | ;; Since the complete word is inserted at position before the repl | ||
| 2821 | ;; region, the next If-statement would have set chars-to-delete to 0 | ||
| 2822 | ;; unless we check for the current command, which must be | ||
| 2823 | ;; dabbrev-expand. | ||
| 2824 | ;; | ||
| 2825 | ;; We should be able deal with these problems in a better way | ||
| 2826 | ;; when emacs will have overlays with sticky back ends. | ||
| 2827 | ;; In fact, it would be also useful to add overlays for insert | ||
| 2828 | ;; regions as well, since this will let us capture the situation when | ||
| 2829 | ;; dabbrev-expand goes back past the insertion point to find the | ||
| 2830 | ;; beginning of the word to be expanded. | ||
| 2831 | (if (or (and (<= (vip-replace-start) beg) | ||
| 2832 | (<= beg (vip-replace-end))) | ||
| 2833 | (and (= length 0) (eq this-command 'dabbrev-expand))) | ||
| 2834 | (setq chars-to-delete | ||
| 2835 | (max (- end-col beg-col) (- real-end beg) 0)) | ||
| 2836 | (setq chars-to-delete 0)) | ||
| 2837 | |||
| 2838 | ;; if beg = last change position, it means that we are within the | ||
| 2839 | ;; same command that does multiple changes. Moreover, it means | ||
| 2840 | ;; that we have two subsequent changes (insert/delete) that | ||
| 2841 | ;; complement each other. | ||
| 2842 | (if (= beg (marker-position vip-last-posn-in-replace-region)) | ||
| 2843 | (setq vip-replace-chars-to-delete | ||
| 2844 | (- (+ chars-to-delete vip-replace-chars-to-delete) | ||
| 2845 | vip-replace-chars-deleted)) | ||
| 2846 | (setq vip-replace-chars-to-delete chars-to-delete)) | ||
| 2847 | |||
| 2848 | (vip-move-marker-locally | ||
| 2849 | 'vip-last-posn-in-replace-region | ||
| 2850 | (max (if (> end (vip-replace-end)) (vip-replace-start) end) | ||
| 2851 | (or (marker-position vip-last-posn-in-replace-region) | ||
| 2852 | (vip-replace-start)) | ||
| 2853 | )) | ||
| 2854 | |||
| 2855 | (setq vip-replace-chars-to-delete | ||
| 2856 | (max 0 (min vip-replace-chars-to-delete | ||
| 2857 | (- (vip-replace-end) | ||
| 2858 | vip-last-posn-in-replace-region)))) | ||
| 2859 | ))) | ||
| 2860 | |||
| 2861 | |||
| 2862 | ;; Delete stuff between posn and the end of vip-replace-overlay-marker, if | ||
| 2863 | ;; posn is within the overlay. | ||
| 2864 | (defun vip-finish-change (posn) | ||
| 2865 | (remove-hook 'vip-after-change-functions 'vip-replace-mode-spy-after) | ||
| 2866 | (remove-hook 'vip-before-change-functions 'vip-replace-mode-spy-before) | ||
| 2867 | (remove-hook 'vip-post-command-hooks | ||
| 2868 | 'vip-replace-state-post-command-sentinel) | ||
| 2869 | (remove-hook 'vip-pre-command-hooks 'vip-replace-state-pre-command-sentinel) | ||
| 2870 | (vip-restore-cursor-color) | ||
| 2871 | (setq vip-sitting-in-replace nil) ; just in case we'll need to know it | ||
| 2872 | (save-excursion | ||
| 2873 | (if (and | ||
| 2874 | vip-replace-overlay | ||
| 2875 | (>= posn (vip-replace-start)) | ||
| 2876 | (< posn (vip-replace-end))) | ||
| 2877 | (delete-region posn (vip-replace-end))) | ||
| 2878 | ) | ||
| 2879 | |||
| 2880 | (if (eq vip-current-state 'replace-state) | ||
| 2881 | (vip-downgrade-to-insert)) | ||
| 2882 | ;; replace mode ended => nullify vip-last-posn-in-replace-region | ||
| 2883 | (vip-move-marker-locally 'vip-last-posn-in-replace-region nil) | ||
| 2884 | (vip-hide-replace-overlay) | ||
| 2885 | (vip-refresh-mode-line) | ||
| 2886 | (vip-put-string-on-kill-ring vip-last-replace-region) | ||
| 2887 | ) | ||
| 2888 | |||
| 2889 | (defun vip-put-string-on-kill-ring (string) | ||
| 2890 | "Make STRING be the first element of the kill ring." | ||
| 2891 | (setq kill-ring (cons string kill-ring)) | ||
| 2892 | (if (> (length kill-ring) kill-ring-max) | ||
| 2893 | (setcdr (nthcdr (1- kill-ring-max) kill-ring) nil)) | ||
| 2894 | (setq kill-ring-yank-pointer kill-ring)) | ||
| 2895 | |||
| 2896 | (defun vip-finish-R-mode () | ||
| 2897 | (remove-hook 'vip-post-command-hooks 'vip-R-state-post-command-sentinel) | ||
| 2898 | (remove-hook 'vip-pre-command-hooks 'vip-replace-state-pre-command-sentinel) | ||
| 2899 | (vip-downgrade-to-insert)) | ||
| 2900 | |||
| 2901 | (defun vip-start-R-mode () | ||
| 2902 | ;; Leave arg as 1, not t: XEmacs insists that it must be a pos number | ||
| 2903 | (overwrite-mode 1) | ||
| 2904 | (add-hook 'vip-post-command-hooks 'vip-R-state-post-command-sentinel t) | ||
| 2905 | (add-hook 'vip-pre-command-hooks 'vip-replace-state-pre-command-sentinel t) | ||
| 2906 | ) | ||
| 2907 | |||
| 2908 | |||
| 2909 | |||
| 2910 | (defun vip-replace-state-exit-cmd () | ||
| 2911 | "Binding for keys that cause Replace state to switch to Vi or to Insert. | ||
| 2912 | These keys are ESC, RET, and LineFeed" | ||
| 2913 | (interactive) | ||
| 2914 | (if overwrite-mode ;; If you are in replace mode invoked via 'R' | ||
| 2915 | (vip-finish-R-mode) | ||
| 2916 | (vip-finish-change vip-last-posn-in-replace-region)) | ||
| 2917 | (let (com) | ||
| 2918 | (if (eq this-command 'vip-intercept-ESC-key) | ||
| 2919 | (setq com 'vip-exit-insert-state) | ||
| 2920 | (vip-set-unread-command-events last-input-char) | ||
| 2921 | (setq com (key-binding (read-key-sequence nil)))) | ||
| 2922 | |||
| 2923 | (condition-case conds | ||
| 2924 | (command-execute com) | ||
| 2925 | (error | ||
| 2926 | (vip-message-conditions conds))) | ||
| 2927 | ) | ||
| 2928 | (vip-hide-replace-overlay)) | ||
| 2929 | |||
| 2930 | |||
| 2931 | (defun vip-overwrite (arg) | ||
| 2932 | "This is the function bound to 'R'---unlimited replace. | ||
| 2933 | Similar to Emacs's own overwrite-mode." | ||
| 2934 | (interactive "P") | ||
| 2935 | (let ((val (vip-p-val arg)) | ||
| 2936 | (com (vip-getcom arg)) (len)) | ||
| 2937 | (vip-set-destructive-command (list 'vip-overwrite val ?r nil nil nil)) | ||
| 2938 | (if com | ||
| 2939 | (progn | ||
| 2940 | ;; Viper saves inserted text in vip-last-insertion | ||
| 2941 | (setq len (length vip-last-insertion)) | ||
| 2942 | (delete-char len) | ||
| 2943 | (vip-loop val (vip-yank-last-insertion))) | ||
| 2944 | (setq last-command 'vip-overwrite) | ||
| 2945 | (vip-set-complex-command-for-undo) | ||
| 2946 | (vip-set-replace-overlay (point) (vip-line-pos 'end)) | ||
| 2947 | (vip-change-state-to-replace) | ||
| 2948 | ))) | ||
| 2949 | |||
| 2950 | |||
| 2951 | ;; line commands | ||
| 2952 | |||
| 2953 | (defun vip-line (arg) | ||
| 2954 | (let ((val (car arg)) | ||
| 2955 | (com (cdr arg))) | ||
| 2956 | (vip-move-marker-locally 'vip-com-point (point)) | ||
| 2957 | (if (not (eobp)) | ||
| 2958 | (next-line (1- val))) | ||
| 2959 | ;; this ensures that dd, cc, D, yy will do the right thing on the last | ||
| 2960 | ;; line of buffer when this line has no \n. | ||
| 2961 | (vip-add-newline-at-eob-if-necessary) | ||
| 2962 | (vip-execute-com 'vip-line val com)) | ||
| 2963 | (if (and (eobp) (not (bobp))) (forward-line -1)) | ||
| 2964 | ) | ||
| 2965 | |||
| 2966 | (defun vip-yank-line (arg) | ||
| 2967 | "Yank ARG lines (in Vi's sense)." | ||
| 2968 | (interactive "P") | ||
| 2969 | (let ((val (vip-p-val arg))) | ||
| 2970 | (vip-line (cons val ?Y)))) | ||
| 2971 | |||
| 2972 | |||
| 2973 | ;; region commands | ||
| 2974 | |||
| 2975 | (defun vip-region (arg) | ||
| 2976 | (interactive "P") | ||
| 2977 | (let ((val (vip-P-val arg)) | ||
| 2978 | (com (vip-getcom arg))) | ||
| 2979 | (vip-move-marker-locally 'vip-com-point (point)) | ||
| 2980 | (exchange-point-and-mark) | ||
| 2981 | (vip-execute-com 'vip-region val com))) | ||
| 2982 | |||
| 2983 | (defun vip-Region (arg) | ||
| 2984 | (interactive "P") | ||
| 2985 | (let ((val (vip-P-val arg)) | ||
| 2986 | (com (vip-getCom arg))) | ||
| 2987 | (vip-move-marker-locally 'vip-com-point (point)) | ||
| 2988 | (exchange-point-and-mark) | ||
| 2989 | (vip-execute-com 'vip-Region val com))) | ||
| 2990 | |||
| 2991 | (defun vip-replace-char (arg) | ||
| 2992 | "Replace the following ARG chars by the character read." | ||
| 2993 | (interactive "P") | ||
| 2994 | (if (and (eolp) (bolp)) (error "I see no character to replace here")) | ||
| 2995 | (let ((val (vip-p-val arg)) | ||
| 2996 | (com (vip-getcom arg))) | ||
| 2997 | (vip-replace-char-subr (if (equal com ?r) vip-d-char (read-char)) val) | ||
| 2998 | (if (and (eolp) (not (bolp))) (forward-char 1)) | ||
| 2999 | (vip-set-destructive-command | ||
| 3000 | (list 'vip-replace-char val ?r nil vip-d-char nil)) | ||
| 3001 | )) | ||
| 3002 | |||
| 3003 | (defun vip-replace-char-subr (char arg) | ||
| 3004 | (delete-char arg t) | ||
| 3005 | (setq vip-d-char char) | ||
| 3006 | (vip-loop (if (> arg 0) arg (- arg)) | ||
| 3007 | (if (eq char ?\C-m) (insert "\n") (insert char))) | ||
| 3008 | (backward-char arg)) | ||
| 3009 | |||
| 3010 | (defun vip-replace-string () | ||
| 3011 | "The old replace string function. | ||
| 3012 | If you supply null string as the string to be replaced, | ||
| 3013 | the query replace mode will toggle between string replace and regexp replace. | ||
| 3014 | This function comes from VIP 3.5 and is not used in Viper. A nostalgic user | ||
| 3015 | can bind it to a key, if necessary." | ||
| 3016 | (interactive) | ||
| 3017 | (let (str) | ||
| 3018 | (setq str (vip-read-string-with-history | ||
| 3019 | (if vip-re-replace "Replace regexp: " "Replace string: ") | ||
| 3020 | nil ; no initial | ||
| 3021 | 'vip-replace1-history | ||
| 3022 | (car vip-replace1-history) ; default | ||
| 3023 | )) | ||
| 3024 | (if (string= str "") | ||
| 3025 | (progn | ||
| 3026 | (setq vip-re-replace (not vip-re-replace)) | ||
| 3027 | (message (format "Replace mode changed to %s" | ||
| 3028 | (if vip-re-replace "regexp replace" | ||
| 3029 | "string replace")))) | ||
| 3030 | (if vip-re-replace | ||
| 3031 | (replace-regexp | ||
| 3032 | str | ||
| 3033 | (vip-read-string-with-history | ||
| 3034 | (format "Replace regexp `%s' with: " str) | ||
| 3035 | nil ; no initial | ||
| 3036 | 'vip-replace2-history | ||
| 3037 | (car vip-replace2-history) ; default | ||
| 3038 | )) | ||
| 3039 | (replace-string | ||
| 3040 | str | ||
| 3041 | (vip-read-string-with-history | ||
| 3042 | (format "Replace `%s' with: " str) | ||
| 3043 | nil ; no initial | ||
| 3044 | 'vip-replace2-history | ||
| 3045 | (car vip-replace2-history) ; default | ||
| 3046 | ))) | ||
| 3047 | ))) | ||
| 3048 | |||
| 3049 | |||
| 3050 | ;; basic cursor movement. j, k, l, h commands. | ||
| 3051 | |||
| 3052 | (defun vip-forward-char (arg) | ||
| 3053 | "Move point right ARG characters (left if ARG negative). | ||
| 3054 | On reaching end of line, stop and signal error." | ||
| 3055 | (interactive "P") | ||
| 3056 | (let ((val (vip-p-val arg)) | ||
| 3057 | (com (vip-getcom arg))) | ||
| 3058 | (if com (vip-move-marker-locally 'vip-com-point (point))) | ||
| 3059 | (if vip-ex-style-motion | ||
| 3060 | (progn | ||
| 3061 | ;; the boundary condition check gets weird here because | ||
| 3062 | ;; forward-char may be the parameter of a delete, and 'dl' works | ||
| 3063 | ;; just like 'x' for the last char on a line, so we have to allow | ||
| 3064 | ;; the forward motion before the 'vip-execute-com', but, of | ||
| 3065 | ;; course, 'dl' doesn't work on an empty line, so we have to | ||
| 3066 | ;; catch that condition before 'vip-execute-com' | ||
| 3067 | (if (and (eolp) (bolp)) (error "") (forward-char val)) | ||
| 3068 | (if com (vip-execute-com 'vip-forward-char val com)) | ||
| 3069 | (if (eolp) (progn (backward-char 1) (error "")))) | ||
| 3070 | (forward-char val) | ||
| 3071 | (if com (vip-execute-com 'vip-forward-char val com))))) | ||
| 3072 | |||
| 3073 | (defun vip-backward-char (arg) | ||
| 3074 | "Move point left ARG characters (right if ARG negative). | ||
| 3075 | On reaching beginning of line, stop and signal error." | ||
| 3076 | (interactive "P") | ||
| 3077 | (let ((val (vip-p-val arg)) | ||
| 3078 | (com (vip-getcom arg))) | ||
| 3079 | (if com (vip-move-marker-locally 'vip-com-point (point))) | ||
| 3080 | (if vip-ex-style-motion | ||
| 3081 | (progn | ||
| 3082 | (if (bolp) (error "") (backward-char val)) | ||
| 3083 | (if com (vip-execute-com 'vip-backward-char val com))) | ||
| 3084 | (backward-char val) | ||
| 3085 | (if com (vip-execute-com 'vip-backward-char val com))))) | ||
| 3086 | |||
| 3087 | (defun vip-forward-char-carefully (&optional arg) | ||
| 3088 | "Like forward-char, but doesn't move at end of buffer." | ||
| 3089 | (setq arg (or arg 1)) | ||
| 3090 | (if (>= (point-max) (+ (point) arg)) | ||
| 3091 | (forward-char arg) | ||
| 3092 | (goto-char (point-max)))) | ||
| 3093 | |||
| 3094 | (defun vip-backward-char-carefully (&optional arg) | ||
| 3095 | "Like backward-char, but doesn't move at end of buffer." | ||
| 3096 | (setq arg (or arg 1)) | ||
| 3097 | (if (<= (point-min) (- (point) arg)) | ||
| 3098 | (backward-char arg) | ||
| 3099 | (goto-char (point-min)))) | ||
| 3100 | |||
| 3101 | |||
| 3102 | |||
| 3103 | ;;; Word command | ||
| 3104 | |||
| 3105 | ;; Words are formed from alpha's and nonalphas - <sp>,\t\n are separators | ||
| 3106 | ;; for word movement. When executed with a destructive command, \n is | ||
| 3107 | ;; usually left untouched for the last word. | ||
| 3108 | |||
| 3109 | ;; skip only one \n | ||
| 3110 | (defun vip-skip-separators (forward) | ||
| 3111 | (if forward | ||
| 3112 | (progn | ||
| 3113 | (skip-chars-forward " \t") | ||
| 3114 | (if (looking-at "\n") | ||
| 3115 | (progn | ||
| 3116 | (forward-char) | ||
| 3117 | (skip-chars-forward " \t")))) | ||
| 3118 | (skip-chars-backward " \t") | ||
| 3119 | (backward-char) | ||
| 3120 | (if (looking-at "\n") | ||
| 3121 | (skip-chars-backward " \t") | ||
| 3122 | (forward-char)))) | ||
| 3123 | |||
| 3124 | (defconst vip-ALPHA "a-zA-Z0-9_") | ||
| 3125 | (defconst vip-ALPHA-B (concat "[" vip-ALPHA "]")) | ||
| 3126 | (defconst vip-NONALPHA (concat "^" vip-ALPHA)) | ||
| 3127 | (defconst vip-NONALPHA-B (concat "[" vip-NONALPHA "]")) | ||
| 3128 | (defconst vip-SEP " \t\n") | ||
| 3129 | (defconst vip-SEP-B (concat "[" vip-SEP "]")) | ||
| 3130 | (defconst vip-NONSEP (concat "^" vip-SEP)) | ||
| 3131 | (defconst vip-NONSEP-B (concat "[" vip-NONSEP "]")) | ||
| 3132 | (defconst vip-ALPHASEP (concat vip-ALPHA vip-SEP)) | ||
| 3133 | (defconst vip-ALPHASEP-B (concat "[" vip-ALPHASEP "]")) | ||
| 3134 | (defconst vip-NONALPHASEP (concat "^" vip-ALPHASEP )) | ||
| 3135 | (defconst vip-NONALPHASEP-B (concat "[" vip-NONALPHASEP "]")) | ||
| 3136 | |||
| 3137 | |||
| 3138 | (defun vip-forward-word-kernel (val) | ||
| 3139 | (while (> val 0) | ||
| 3140 | (cond ((looking-at vip-ALPHA-B) | ||
| 3141 | (skip-chars-forward vip-ALPHA) | ||
| 3142 | (vip-skip-separators t)) | ||
| 3143 | ((looking-at vip-SEP-B) | ||
| 3144 | (vip-skip-separators t)) | ||
| 3145 | ((looking-at vip-NONALPHASEP-B) | ||
| 3146 | (skip-chars-forward vip-NONALPHASEP) | ||
| 3147 | (vip-skip-separators t))) | ||
| 3148 | (setq val (1- val)))) | ||
| 3149 | |||
| 3150 | (defun vip-fwd-skip (pat aux-pat lim) | ||
| 3151 | (if (and (save-excursion | ||
| 3152 | (re-search-backward pat lim t)) | ||
| 3153 | (= (point) (match-end 0))) | ||
| 3154 | (goto-char (match-beginning 0))) | ||
| 3155 | (skip-chars-backward aux-pat lim) | ||
| 3156 | (if (= (point) lim) | ||
| 3157 | (vip-forward-char-carefully)) | ||
| 3158 | ) | ||
| 3159 | |||
| 3160 | |||
| 3161 | (defun vip-forward-word (arg) | ||
| 3162 | "Forward word." | ||
| 3163 | (interactive "P") | ||
| 3164 | (let ((val (vip-p-val arg)) | ||
| 3165 | (com (vip-getcom arg))) | ||
| 3166 | (if com (vip-move-marker-locally 'vip-com-point (point))) | ||
| 3167 | (vip-forward-word-kernel val) | ||
| 3168 | (if com (progn | ||
| 3169 | (cond ((memq com (list ?c (- ?c) ?y (- ?y))) | ||
| 3170 | (vip-fwd-skip "\n[ \t]*" " \t" vip-com-point)) | ||
| 3171 | ((vip-dotable-command-p com) | ||
| 3172 | (vip-fwd-skip "\n[ \t]*" "" vip-com-point))) | ||
| 3173 | (vip-execute-com 'vip-forward-word val com))))) | ||
| 3174 | |||
| 3175 | |||
| 3176 | (defun vip-forward-Word (arg) | ||
| 3177 | "Forward word delimited by white character." | ||
| 3178 | (interactive "P") | ||
| 3179 | (let ((val (vip-p-val arg)) | ||
| 3180 | (com (vip-getcom arg))) | ||
| 3181 | (if com (vip-move-marker-locally 'vip-com-point (point))) | ||
| 3182 | (vip-loop val | ||
| 3183 | (progn | ||
| 3184 | (skip-chars-forward vip-NONSEP) | ||
| 3185 | (vip-skip-separators t))) | ||
| 3186 | (if com (progn | ||
| 3187 | (cond ((memq com (list ?c (- ?c) ?y (- ?y))) | ||
| 3188 | (vip-fwd-skip "\n[ \t]*" " \t" vip-com-point)) | ||
| 3189 | ((vip-dotable-command-p com) | ||
| 3190 | (vip-fwd-skip "\n[ \t]*" "" vip-com-point))) | ||
| 3191 | (vip-execute-com 'vip-forward-Word val com))))) | ||
| 3192 | |||
| 3193 | |||
| 3194 | ;; this is a bit different from Vi, but Vi's end of word | ||
| 3195 | ;; makes no sense whatsoever | ||
| 3196 | (defun vip-end-of-word-kernel () | ||
| 3197 | (if (vip-end-of-word-p) (forward-char)) | ||
| 3198 | (if (looking-at "[ \t\n]") | ||
| 3199 | (skip-chars-forward vip-SEP)) | ||
| 3200 | |||
| 3201 | (cond ((looking-at vip-ALPHA-B) (skip-chars-forward vip-ALPHA)) | ||
| 3202 | ((looking-at vip-NONALPHASEP-B) | ||
| 3203 | (skip-chars-forward vip-NONALPHASEP))) | ||
| 3204 | (vip-backward-char-carefully)) | ||
| 3205 | |||
| 3206 | (defun vip-end-of-word-p () | ||
| 3207 | (if (eobp) t | ||
| 3208 | (save-excursion | ||
| 3209 | (cond ((looking-at vip-ALPHA-B) | ||
| 3210 | (forward-char) | ||
| 3211 | (looking-at vip-NONALPHA-B)) | ||
| 3212 | ((looking-at vip-NONALPHASEP-B) | ||
| 3213 | (forward-char) | ||
| 3214 | (looking-at vip-ALPHASEP-B)))))) | ||
| 3215 | |||
| 3216 | (defun vip-one-char-word-p () | ||
| 3217 | (let ((step 2)) | ||
| 3218 | (save-excursion | ||
| 3219 | (cond ((looking-at vip-ALPHA-B) | ||
| 3220 | (if (bobp) (setq step 1) (backward-char)) | ||
| 3221 | (if (or (bobp) (looking-at vip-NONALPHA-B)) | ||
| 3222 | (progn | ||
| 3223 | (forward-char step) | ||
| 3224 | (looking-at vip-NONALPHA-B)) | ||
| 3225 | nil)) | ||
| 3226 | ((looking-at vip-NONALPHASEP-B) | ||
| 3227 | (if (bobp) (setq step 1) (backward-char)) | ||
| 3228 | (if (or (bobp) (looking-at vip-ALPHASEP-B)) | ||
| 3229 | (progn | ||
| 3230 | (forward-char step) | ||
| 3231 | (looking-at vip-ALPHASEP-B)) | ||
| 3232 | nil)))))) | ||
| 3233 | |||
| 3234 | (defun vip-one-char-Word-p () | ||
| 3235 | (and (looking-at vip-NONSEP-B) | ||
| 3236 | (save-excursion | ||
| 3237 | (if (bobp) | ||
| 3238 | t | ||
| 3239 | (backward-char) | ||
| 3240 | (looking-at vip-SEP-B))) | ||
| 3241 | (save-excursion | ||
| 3242 | (forward-char) | ||
| 3243 | (or (eobp) | ||
| 3244 | (looking-at vip-SEP-B))))) | ||
| 3245 | |||
| 3246 | (defun vip-end-of-word (arg &optional careful) | ||
| 3247 | "Move point to end of current word." | ||
| 3248 | (interactive "P") | ||
| 3249 | (let ((val (vip-p-val arg)) | ||
| 3250 | (com (vip-getcom arg))) | ||
| 3251 | (if com (vip-move-marker-locally 'vip-com-point (point))) | ||
| 3252 | (vip-loop val (vip-end-of-word-kernel)) | ||
| 3253 | (if com | ||
| 3254 | (progn | ||
| 3255 | (forward-char) | ||
| 3256 | (vip-execute-com 'vip-end-of-word val com))))) | ||
| 3257 | |||
| 3258 | (defun vip-end-of-Word (arg) | ||
| 3259 | "Forward to end of word delimited by white character." | ||
| 3260 | (interactive "P") | ||
| 3261 | (let ((val (vip-p-val arg)) | ||
| 3262 | (com (vip-getcom arg))) | ||
| 3263 | (if com (vip-move-marker-locally 'vip-com-point (point))) | ||
| 3264 | (vip-loop val | ||
| 3265 | (progn | ||
| 3266 | (vip-end-of-word-kernel) | ||
| 3267 | (if (not (re-search-forward | ||
| 3268 | vip-SEP-B nil t 1)) | ||
| 3269 | (goto-char (point-max))) | ||
| 3270 | (skip-chars-backward vip-SEP) | ||
| 3271 | (backward-char))) | ||
| 3272 | (if com | ||
| 3273 | (progn | ||
| 3274 | (forward-char) | ||
| 3275 | (vip-execute-com 'vip-end-of-Word val com))))) | ||
| 3276 | |||
| 3277 | (defun vip-backward-word-kernel (val) | ||
| 3278 | (while (> val 0) | ||
| 3279 | (backward-char) | ||
| 3280 | (cond ((looking-at vip-ALPHA-B) | ||
| 3281 | (skip-chars-backward vip-ALPHA)) | ||
| 3282 | ((looking-at vip-SEP-B) | ||
| 3283 | (forward-char) | ||
| 3284 | (vip-skip-separators nil) | ||
| 3285 | (backward-char) | ||
| 3286 | (cond ((looking-at vip-ALPHA-B) | ||
| 3287 | (skip-chars-backward vip-ALPHA)) | ||
| 3288 | ((looking-at vip-NONALPHASEP-B) | ||
| 3289 | (skip-chars-backward vip-NONALPHASEP)) | ||
| 3290 | (t (forward-char)))) | ||
| 3291 | ((looking-at vip-NONALPHASEP-B) | ||
| 3292 | (skip-chars-backward vip-NONALPHASEP))) | ||
| 3293 | (setq val (1- val)))) | ||
| 3294 | |||
| 3295 | (defun vip-backward-word (arg) | ||
| 3296 | "Backward word." | ||
| 3297 | (interactive "P") | ||
| 3298 | (let ((val (vip-p-val arg)) | ||
| 3299 | (com (vip-getcom arg))) | ||
| 3300 | (if com | ||
| 3301 | (let (i) | ||
| 3302 | (if (setq i (save-excursion (backward-char) (looking-at "\n"))) | ||
| 3303 | (backward-char)) | ||
| 3304 | (vip-move-marker-locally 'vip-com-point (point)) | ||
| 3305 | (if i (forward-char)))) | ||
| 3306 | (vip-backward-word-kernel val) | ||
| 3307 | (if com (vip-execute-com 'vip-backward-word val com)))) | ||
| 3308 | |||
| 3309 | (defun vip-backward-Word (arg) | ||
| 3310 | "Backward word delimited by white character." | ||
| 3311 | (interactive "P") | ||
| 3312 | (let ((val (vip-p-val arg)) | ||
| 3313 | (com (vip-getcom arg))) | ||
| 3314 | (if com | ||
| 3315 | (let (i) | ||
| 3316 | (if (setq i (save-excursion (backward-char) (looking-at "\n"))) | ||
| 3317 | (backward-char)) | ||
| 3318 | (vip-move-marker-locally 'vip-com-point (point)) | ||
| 3319 | (if i (forward-char)))) | ||
| 3320 | (vip-loop val | ||
| 3321 | (progn | ||
| 3322 | (vip-skip-separators nil) | ||
| 3323 | (skip-chars-backward vip-NONSEP))) | ||
| 3324 | (if com (vip-execute-com 'vip-backward-Word val com)))) | ||
| 3325 | |||
| 3326 | |||
| 3327 | |||
| 3328 | ;; line commands | ||
| 3329 | |||
| 3330 | (defun vip-beginning-of-line (arg) | ||
| 3331 | "Go to beginning of line." | ||
| 3332 | (interactive "P") | ||
| 3333 | (let ((val (vip-p-val arg)) | ||
| 3334 | (com (vip-getcom arg))) | ||
| 3335 | (if com (vip-move-marker-locally 'vip-com-point (point))) | ||
| 3336 | (beginning-of-line val) | ||
| 3337 | (if com (vip-execute-com 'vip-beginning-of-line val com)))) | ||
| 3338 | |||
| 3339 | (defun vip-bol-and-skip-white (arg) | ||
| 3340 | "Beginning of line at first non-white character." | ||
| 3341 | (interactive "P") | ||
| 3342 | (let ((val (vip-p-val arg)) | ||
| 3343 | (com (vip-getcom arg))) | ||
| 3344 | (if com (vip-move-marker-locally 'vip-com-point (point))) | ||
| 3345 | (forward-to-indentation (1- val)) | ||
| 3346 | (if com (vip-execute-com 'vip-bol-and-skip-white val com)))) | ||
| 3347 | |||
| 3348 | (defun vip-goto-eol (arg) | ||
| 3349 | "Go to end of line." | ||
| 3350 | (interactive "P") | ||
| 3351 | (let ((val (vip-p-val arg)) | ||
| 3352 | (com (vip-getcom arg))) | ||
| 3353 | (if com (vip-move-marker-locally 'vip-com-point (point))) | ||
| 3354 | (end-of-line val) | ||
| 3355 | (if com (vip-execute-com 'vip-goto-eol val com)) | ||
| 3356 | (if vip-ex-style-motion | ||
| 3357 | (if (and (eolp) (not (bolp)) | ||
| 3358 | ;; a fix for vip-change-to-eol | ||
| 3359 | (not (equal vip-current-state 'insert-state))) | ||
| 3360 | (backward-char 1) | ||
| 3361 | )))) | ||
| 3362 | |||
| 3363 | |||
| 3364 | (defun vip-goto-col (arg) | ||
| 3365 | "Go to ARG's column." | ||
| 3366 | (interactive "P") | ||
| 3367 | (let ((val (vip-p-val arg)) | ||
| 3368 | (com (vip-getcom arg))) | ||
| 3369 | (save-excursion | ||
| 3370 | (end-of-line) | ||
| 3371 | (if (> val (1+ (current-column))) (error ""))) | ||
| 3372 | (if com (vip-move-marker-locally 'vip-com-point (point))) | ||
| 3373 | (beginning-of-line) | ||
| 3374 | (forward-char (1- val)) | ||
| 3375 | (if com (vip-execute-com 'vip-goto-col val com)))) | ||
| 3376 | |||
| 3377 | |||
| 3378 | (defun vip-next-line (arg) | ||
| 3379 | "Go to next line." | ||
| 3380 | (interactive "P") | ||
| 3381 | (let ((val (vip-p-val arg)) | ||
| 3382 | (com (vip-getCom arg))) | ||
| 3383 | (if com (vip-move-marker-locally 'vip-com-point (point))) | ||
| 3384 | (next-line val) | ||
| 3385 | (if vip-ex-style-motion | ||
| 3386 | (if (and (eolp) (not (bolp))) (backward-char 1))) | ||
| 3387 | (setq this-command 'next-line) | ||
| 3388 | (if com (vip-execute-com 'vip-next-line val com)))) | ||
| 3389 | |||
| 3390 | (defun vip-next-line-at-bol (arg) | ||
| 3391 | "Next line at beginning of line." | ||
| 3392 | (interactive "P") | ||
| 3393 | (save-excursion | ||
| 3394 | (end-of-line) | ||
| 3395 | (if (eobp) (error "Last line in buffer"))) | ||
| 3396 | (let ((val (vip-p-val arg)) | ||
| 3397 | (com (vip-getCom arg))) | ||
| 3398 | (if com (vip-move-marker-locally 'vip-com-point (point))) | ||
| 3399 | (forward-line val) | ||
| 3400 | (back-to-indentation) | ||
| 3401 | (if com (vip-execute-com 'vip-next-line-at-bol val com)))) | ||
| 3402 | |||
| 3403 | (defun vip-previous-line (arg) | ||
| 3404 | "Go to previous line." | ||
| 3405 | (interactive "P") | ||
| 3406 | (let ((val (vip-p-val arg)) | ||
| 3407 | (com (vip-getCom arg))) | ||
| 3408 | (if com (vip-move-marker-locally 'vip-com-point (point))) | ||
| 3409 | (previous-line val) | ||
| 3410 | (if vip-ex-style-motion | ||
| 3411 | (if (and (eolp) (not (bolp))) (backward-char 1))) | ||
| 3412 | (setq this-command 'previous-line) | ||
| 3413 | (if com (vip-execute-com 'vip-previous-line val com)))) | ||
| 3414 | |||
| 3415 | |||
| 3416 | (defun vip-previous-line-at-bol (arg) | ||
| 3417 | "Previous line at beginning of line." | ||
| 3418 | (interactive "P") | ||
| 3419 | (save-excursion | ||
| 3420 | (beginning-of-line) | ||
| 3421 | (if (bobp) (error "First line in buffer"))) | ||
| 3422 | (let ((val (vip-p-val arg)) | ||
| 3423 | (com (vip-getCom arg))) | ||
| 3424 | (if com (vip-move-marker-locally 'vip-com-point (point))) | ||
| 3425 | (forward-line (- val)) | ||
| 3426 | (back-to-indentation) | ||
| 3427 | (if com (vip-execute-com 'vip-previous-line val com)))) | ||
| 3428 | |||
| 3429 | (defun vip-change-to-eol (arg) | ||
| 3430 | "Change to end of line." | ||
| 3431 | (interactive "P") | ||
| 3432 | (vip-goto-eol (cons arg ?c))) | ||
| 3433 | |||
| 3434 | (defun vip-kill-line (arg) | ||
| 3435 | "Delete line." | ||
| 3436 | (interactive "P") | ||
| 3437 | (vip-goto-eol (cons arg ?d))) | ||
| 3438 | |||
| 3439 | (defun vip-erase-line (arg) | ||
| 3440 | "Erase line." | ||
| 3441 | (interactive "P") | ||
| 3442 | (vip-beginning-of-line (cons arg ?d))) | ||
| 3443 | |||
| 3444 | |||
| 3445 | ;; moving around | ||
| 3446 | |||
| 3447 | (defun vip-goto-line (arg) | ||
| 3448 | "Go to ARG's line. Without ARG go to end of buffer." | ||
| 3449 | (interactive "P") | ||
| 3450 | (let ((val (vip-P-val arg)) | ||
| 3451 | (com (vip-getCom arg))) | ||
| 3452 | (vip-move-marker-locally 'vip-com-point (point)) | ||
| 3453 | (vip-deactivate-mark) | ||
| 3454 | (push-mark nil t) | ||
| 3455 | (if (null val) | ||
| 3456 | (goto-char (point-max)) | ||
| 3457 | (goto-char (point-min)) | ||
| 3458 | (forward-line (1- val))) | ||
| 3459 | (if (and (eobp) (bolp) (not (bobp))) (forward-line -1)) | ||
| 3460 | (back-to-indentation) | ||
| 3461 | (if com (vip-execute-com 'vip-goto-line val com)))) | ||
| 3462 | |||
| 3463 | (defun vip-find-char (arg char forward offset) | ||
| 3464 | "Find ARG's occurrence of CHAR on the current line. | ||
| 3465 | If FORWARD then search is forward, otherwise backward. OFFSET is used to | ||
| 3466 | adjust point after search." | ||
| 3467 | (or (char-or-string-p char) (error "")) | ||
| 3468 | (let ((arg (if forward arg (- arg))) | ||
| 3469 | (cmd (if (eq vip-intermediate-command 'vip-repeat) | ||
| 3470 | (nth 5 vip-d-com) | ||
| 3471 | (vip-array-to-string (this-command-keys)))) | ||
| 3472 | point) | ||
| 3473 | (save-excursion | ||
| 3474 | (save-restriction | ||
| 3475 | (if (> arg 0) | ||
| 3476 | (narrow-to-region | ||
| 3477 | ;; forward search begins here | ||
| 3478 | (if (eolp) (error "Command `%s': At end of line" cmd) (point)) | ||
| 3479 | ;; forward search ends here | ||
| 3480 | (progn (end-of-line) (point))) | ||
| 3481 | (narrow-to-region | ||
| 3482 | ;; backward search begins from here | ||
| 3483 | (if (bolp) | ||
| 3484 | (error "Command `%s': At beginning of line" cmd) (point)) | ||
| 3485 | ;; backward search ends here | ||
| 3486 | (progn (beginning-of-line) (point)))) | ||
| 3487 | ;; if arg > 0, point is forwarded before search. | ||
| 3488 | (if (> arg 0) (goto-char (1+ (point-min))) | ||
| 3489 | (goto-char (point-max))) | ||
| 3490 | (if (let ((case-fold-search nil)) | ||
| 3491 | (search-forward (char-to-string char) nil 0 arg)) | ||
| 3492 | (setq point (point)) | ||
| 3493 | (error "Command `%s': `%c' not found" cmd char)))) | ||
| 3494 | (goto-char (+ point (if (> arg 0) (if offset -2 -1) (if offset 1 0)))))) | ||
| 3495 | |||
| 3496 | (defun vip-find-char-forward (arg) | ||
| 3497 | "Find char on the line. | ||
| 3498 | If called interactively read the char to find from the terminal, and if | ||
| 3499 | called from vip-repeat, the char last used is used. This behaviour is | ||
| 3500 | controlled by the sign of prefix numeric value." | ||
| 3501 | (interactive "P") | ||
| 3502 | (let ((val (vip-p-val arg)) | ||
| 3503 | (com (vip-getcom arg))) | ||
| 3504 | (if (> val 0) | ||
| 3505 | ;; this means that the function was called interactively | ||
| 3506 | (setq vip-f-char (read-char) | ||
| 3507 | vip-f-forward t | ||
| 3508 | vip-f-offset nil) | ||
| 3509 | ;; vip-repeat --- set vip-F-char from command-keys | ||
| 3510 | (setq vip-F-char (if (stringp (nth 5 vip-d-com)) | ||
| 3511 | (vip-seq-last-elt (nth 5 vip-d-com)) | ||
| 3512 | vip-F-char) | ||
| 3513 | vip-f-char vip-F-char) | ||
| 3514 | (setq val (- val))) | ||
| 3515 | (if com (vip-move-marker-locally 'vip-com-point (point))) | ||
| 3516 | (vip-find-char val (if (> (vip-p-val arg) 0) vip-f-char vip-F-char) t nil) | ||
| 3517 | (setq val (- val)) | ||
| 3518 | (if com | ||
| 3519 | (progn | ||
| 3520 | (setq vip-F-char vip-f-char) ; set new vip-F-char | ||
| 3521 | (forward-char) | ||
| 3522 | (vip-execute-com 'vip-find-char-forward val com))))) | ||
| 3523 | |||
| 3524 | (defun vip-goto-char-forward (arg) | ||
| 3525 | "Go up to char ARG forward on line." | ||
| 3526 | (interactive "P") | ||
| 3527 | (let ((val (vip-p-val arg)) | ||
| 3528 | (com (vip-getcom arg))) | ||
| 3529 | (if (> val 0) | ||
| 3530 | ;; this means that the function was called interactively | ||
| 3531 | (setq vip-f-char (read-char) | ||
| 3532 | vip-f-forward t | ||
| 3533 | vip-f-offset t) | ||
| 3534 | ;; vip-repeat --- set vip-F-char from command-keys | ||
| 3535 | (setq vip-F-char (if (stringp (nth 5 vip-d-com)) | ||
| 3536 | (vip-seq-last-elt (nth 5 vip-d-com)) | ||
| 3537 | vip-F-char) | ||
| 3538 | vip-f-char vip-F-char) | ||
| 3539 | (setq val (- val))) | ||
| 3540 | (if com (vip-move-marker-locally 'vip-com-point (point))) | ||
| 3541 | (vip-find-char val (if (> (vip-p-val arg) 0) vip-f-char vip-F-char) t t) | ||
| 3542 | (setq val (- val)) | ||
| 3543 | (if com | ||
| 3544 | (progn | ||
| 3545 | (setq vip-F-char vip-f-char) ; set new vip-F-char | ||
| 3546 | (forward-char) | ||
| 3547 | (vip-execute-com 'vip-goto-char-forward val com))))) | ||
| 3548 | |||
| 3549 | (defun vip-find-char-backward (arg) | ||
| 3550 | "Find char ARG on line backward." | ||
| 3551 | (interactive "P") | ||
| 3552 | (let ((val (vip-p-val arg)) | ||
| 3553 | (com (vip-getcom arg))) | ||
| 3554 | (if (> val 0) | ||
| 3555 | ;; this means that the function was called interactively | ||
| 3556 | (setq vip-f-char (read-char) | ||
| 3557 | vip-f-forward nil | ||
| 3558 | vip-f-offset nil) | ||
| 3559 | ;; vip-repeat --- set vip-F-char from command-keys | ||
| 3560 | (setq vip-F-char (if (stringp (nth 5 vip-d-com)) | ||
| 3561 | (vip-seq-last-elt (nth 5 vip-d-com)) | ||
| 3562 | vip-F-char) | ||
| 3563 | vip-f-char vip-F-char) | ||
| 3564 | (setq val (- val))) | ||
| 3565 | (if com (vip-move-marker-locally 'vip-com-point (point))) | ||
| 3566 | (vip-find-char | ||
| 3567 | val (if (> (vip-p-val arg) 0) vip-f-char vip-F-char) nil nil) | ||
| 3568 | (setq val (- val)) | ||
| 3569 | (if com | ||
| 3570 | (progn | ||
| 3571 | (setq vip-F-char vip-f-char) ; set new vip-F-char | ||
| 3572 | (vip-execute-com 'vip-find-char-backward val com))))) | ||
| 3573 | |||
| 3574 | (defun vip-goto-char-backward (arg) | ||
| 3575 | "Go up to char ARG backward on line." | ||
| 3576 | (interactive "P") | ||
| 3577 | (let ((val (vip-p-val arg)) | ||
| 3578 | (com (vip-getcom arg))) | ||
| 3579 | (if (> val 0) | ||
| 3580 | ;; this means that the function was called interactively | ||
| 3581 | (setq vip-f-char (read-char) | ||
| 3582 | vip-f-forward nil | ||
| 3583 | vip-f-offset t) | ||
| 3584 | ;; vip-repeat --- set vip-F-char from command-keys | ||
| 3585 | (setq vip-F-char (if (stringp (nth 5 vip-d-com)) | ||
| 3586 | (vip-seq-last-elt (nth 5 vip-d-com)) | ||
| 3587 | vip-F-char) | ||
| 3588 | vip-f-char vip-F-char) | ||
| 3589 | (setq val (- val))) | ||
| 3590 | (if com (vip-move-marker-locally 'vip-com-point (point))) | ||
| 3591 | (vip-find-char val (if (> (vip-p-val arg) 0) vip-f-char vip-F-char) nil t) | ||
| 3592 | (setq val (- val)) | ||
| 3593 | (if com | ||
| 3594 | (progn | ||
| 3595 | (setq vip-F-char vip-f-char) ; set new vip-F-char | ||
| 3596 | (vip-execute-com 'vip-goto-char-backward val com))))) | ||
| 3597 | |||
| 3598 | (defun vip-repeat-find (arg) | ||
| 3599 | "Repeat previous find command." | ||
| 3600 | (interactive "P") | ||
| 3601 | (let ((val (vip-p-val arg)) | ||
| 3602 | (com (vip-getcom arg))) | ||
| 3603 | (vip-deactivate-mark) | ||
| 3604 | (if com (vip-move-marker-locally 'vip-com-point (point))) | ||
| 3605 | (vip-find-char val vip-f-char vip-f-forward vip-f-offset) | ||
| 3606 | (if com | ||
| 3607 | (progn | ||
| 3608 | (if vip-f-forward (forward-char)) | ||
| 3609 | (vip-execute-com 'vip-repeat-find val com))))) | ||
| 3610 | |||
| 3611 | (defun vip-repeat-find-opposite (arg) | ||
| 3612 | "Repeat previous find command in the opposite direction." | ||
| 3613 | (interactive "P") | ||
| 3614 | (let ((val (vip-p-val arg)) | ||
| 3615 | (com (vip-getcom arg))) | ||
| 3616 | (vip-deactivate-mark) | ||
| 3617 | (if com (vip-move-marker-locally 'vip-com-point (point))) | ||
| 3618 | (vip-find-char val vip-f-char (not vip-f-forward) vip-f-offset) | ||
| 3619 | (if com | ||
| 3620 | (progn | ||
| 3621 | (if vip-f-forward (forward-char)) | ||
| 3622 | (vip-execute-com 'vip-repeat-find-opposite val com))))) | ||
| 3623 | |||
| 3624 | |||
| 3625 | ;; window scrolling etc. | ||
| 3626 | |||
| 3627 | (defun vip-other-window (arg) | ||
| 3628 | "Switch to other window." | ||
| 3629 | (interactive "p") | ||
| 3630 | (other-window arg) | ||
| 3631 | (or (not (eq vip-current-state 'emacs-state)) | ||
| 3632 | (string= (buffer-name (current-buffer)) " *Minibuf-1*") | ||
| 3633 | (vip-change-state-to-vi))) | ||
| 3634 | |||
| 3635 | (defun vip-window-top (arg) | ||
| 3636 | "Go to home window line." | ||
| 3637 | (interactive "P") | ||
| 3638 | (let ((val (vip-p-val arg)) | ||
| 3639 | (com (vip-getCom arg))) | ||
| 3640 | (if com (vip-move-marker-locally 'vip-com-point (point))) | ||
| 3641 | (push-mark nil t) | ||
| 3642 | (move-to-window-line (1- val)) | ||
| 3643 | (if (not com) (back-to-indentation)) | ||
| 3644 | (if com (vip-execute-com 'vip-window-top val com)))) | ||
| 3645 | |||
| 3646 | (defun vip-window-middle (arg) | ||
| 3647 | "Go to middle window line." | ||
| 3648 | (interactive "P") | ||
| 3649 | (let ((val (vip-p-val arg)) | ||
| 3650 | (com (vip-getCom arg))) | ||
| 3651 | (if com (vip-move-marker-locally 'vip-com-point (point))) | ||
| 3652 | (push-mark nil t) | ||
| 3653 | (move-to-window-line (+ (/ (1- (window-height)) 2) (1- val))) | ||
| 3654 | (if (not com) (back-to-indentation)) | ||
| 3655 | (if com (vip-execute-com 'vip-window-middle val com)))) | ||
| 3656 | |||
| 3657 | (defun vip-window-bottom (arg) | ||
| 3658 | "Go to last window line." | ||
| 3659 | (interactive "P") | ||
| 3660 | (let ((val (vip-p-val arg)) | ||
| 3661 | (com (vip-getCom arg))) | ||
| 3662 | (if com (vip-move-marker-locally 'vip-com-point (point))) | ||
| 3663 | (push-mark nil t) | ||
| 3664 | (move-to-window-line (- val)) | ||
| 3665 | (if (not com) (back-to-indentation)) | ||
| 3666 | (if com (vip-execute-com 'vip-window-bottom val com)))) | ||
| 3667 | |||
| 3668 | (defun vip-line-to-top (arg) | ||
| 3669 | "Put current line on the home line." | ||
| 3670 | (interactive "p") | ||
| 3671 | (recenter (1- arg))) | ||
| 3672 | |||
| 3673 | (defun vip-line-to-middle (arg) | ||
| 3674 | "Put current line on the middle line." | ||
| 3675 | (interactive "p") | ||
| 3676 | (recenter (+ (1- arg) (/ (1- (window-height)) 2)))) | ||
| 3677 | |||
| 3678 | (defun vip-line-to-bottom (arg) | ||
| 3679 | "Put current line on the last line." | ||
| 3680 | (interactive "p") | ||
| 3681 | (recenter (- (window-height) (1+ arg)))) | ||
| 3682 | |||
| 3683 | |||
| 3684 | ;; paren match | ||
| 3685 | ;; must correct this to only match ( to ) etc. On the other hand | ||
| 3686 | ;; it is good that paren match gets confused, because that way you | ||
| 3687 | ;; catch _all_ imbalances. | ||
| 3688 | |||
| 3689 | (defun vip-paren-match (arg) | ||
| 3690 | "Go to the matching parenthesis." | ||
| 3691 | (interactive "P") | ||
| 3692 | (let ((com (vip-getcom arg))) | ||
| 3693 | (if (numberp arg) | ||
| 3694 | (if (or (> arg 99) (< arg 1)) | ||
| 3695 | (error "Prefix must be between 1 and 99") | ||
| 3696 | (goto-char | ||
| 3697 | (if (> (point-max) 80000) | ||
| 3698 | (* (/ (point-max) 100) arg) | ||
| 3699 | (/ (* (point-max) arg) 100))) | ||
| 3700 | (back-to-indentation)) | ||
| 3701 | (let (lim) | ||
| 3702 | (if (and (eolp) (not (bolp))) (forward-char -1)) | ||
| 3703 | (save-excursion | ||
| 3704 | (end-of-line) | ||
| 3705 | (setq lim (point))) | ||
| 3706 | (if (re-search-forward "[][(){}]" lim t) | ||
| 3707 | (backward-char) | ||
| 3708 | (error "No matching character on line"))) | ||
| 3709 | (cond ((looking-at "[\(\[{]") | ||
| 3710 | (if com (vip-move-marker-locally 'vip-com-point (point))) | ||
| 3711 | (forward-sexp 1) | ||
| 3712 | (if com | ||
| 3713 | (vip-execute-com 'vip-paren-match nil com) | ||
| 3714 | (backward-char))) | ||
| 3715 | ((looking-at "[])}]") | ||
| 3716 | (forward-char) | ||
| 3717 | (if com (vip-move-marker-locally 'vip-com-point (point))) | ||
| 3718 | (backward-sexp 1) | ||
| 3719 | (if com (vip-execute-com 'vip-paren-match nil com))) | ||
| 3720 | (t (error "")))))) | ||
| 3721 | |||
| 3722 | |||
| 3723 | ;; sentence ,paragraph and heading | ||
| 3724 | |||
| 3725 | (defun vip-forward-sentence (arg) | ||
| 3726 | "Forward sentence." | ||
| 3727 | (interactive "P") | ||
| 3728 | (push-mark nil t) | ||
| 3729 | (let ((val (vip-p-val arg)) | ||
| 3730 | (com (vip-getcom arg))) | ||
| 3731 | (if com (vip-move-marker-locally 'vip-com-point (point))) | ||
| 3732 | (forward-sentence val) | ||
| 3733 | (if com (vip-execute-com 'vip-forward-sentence nil com)))) | ||
| 3734 | |||
| 3735 | (defun vip-backward-sentence (arg) | ||
| 3736 | "Backward sentence." | ||
| 3737 | (interactive "P") | ||
| 3738 | (push-mark nil t) | ||
| 3739 | (let ((val (vip-p-val arg)) | ||
| 3740 | (com (vip-getcom arg))) | ||
| 3741 | (if com (vip-move-marker-locally 'vip-com-point (point))) | ||
| 3742 | (backward-sentence val) | ||
| 3743 | (if com (vip-execute-com 'vip-backward-sentence nil com)))) | ||
| 3744 | |||
| 3745 | (defun vip-forward-paragraph (arg) | ||
| 3746 | "Forward paragraph." | ||
| 3747 | (interactive "P") | ||
| 3748 | (push-mark nil t) | ||
| 3749 | (let ((val (vip-p-val arg)) | ||
| 3750 | (com (vip-getCom arg))) | ||
| 3751 | (if com (vip-move-marker-locally 'vip-com-point (point))) | ||
| 3752 | (forward-paragraph val) | ||
| 3753 | (if com (vip-execute-com 'vip-forward-paragraph nil com)))) | ||
| 3754 | |||
| 3755 | (defun vip-backward-paragraph (arg) | ||
| 3756 | "Backward paragraph." | ||
| 3757 | (interactive "P") | ||
| 3758 | (push-mark nil t) | ||
| 3759 | (let ((val (vip-p-val arg)) | ||
| 3760 | (com (vip-getCom arg))) | ||
| 3761 | (if com (vip-move-marker-locally 'vip-com-point (point))) | ||
| 3762 | (backward-paragraph val) | ||
| 3763 | (if com (vip-execute-com 'vip-backward-paragraph nil com)))) | ||
| 3764 | |||
| 3765 | ;; should be mode-specific etc. | ||
| 3766 | |||
| 3767 | (defun vip-prev-heading (arg) | ||
| 3768 | (interactive "P") | ||
| 3769 | (let ((val (vip-p-val arg)) | ||
| 3770 | (com (vip-getCom arg))) | ||
| 3771 | (if com (vip-move-marker-locally 'vip-com-point (point))) | ||
| 3772 | (re-search-backward vip-heading-start nil t val) | ||
| 3773 | (goto-char (match-beginning 0)) | ||
| 3774 | (if com (vip-execute-com 'vip-prev-heading nil com)))) | ||
| 3775 | |||
| 3776 | (defun vip-heading-end (arg) | ||
| 3777 | (interactive "P") | ||
| 3778 | (let ((val (vip-p-val arg)) | ||
| 3779 | (com (vip-getCom arg))) | ||
| 3780 | (if com (vip-move-marker-locally 'vip-com-point (point))) | ||
| 3781 | (re-search-forward vip-heading-end nil t val) | ||
| 3782 | (goto-char (match-beginning 0)) | ||
| 3783 | (if com (vip-execute-com 'vip-heading-end nil com)))) | ||
| 3784 | |||
| 3785 | (defun vip-next-heading (arg) | ||
| 3786 | (interactive "P") | ||
| 3787 | (let ((val (vip-p-val arg)) | ||
| 3788 | (com (vip-getCom arg))) | ||
| 3789 | (if com (vip-move-marker-locally 'vip-com-point (point))) | ||
| 3790 | (end-of-line) | ||
| 3791 | (re-search-forward vip-heading-start nil t val) | ||
| 3792 | (goto-char (match-beginning 0)) | ||
| 3793 | (if com (vip-execute-com 'vip-next-heading nil com)))) | ||
| 3794 | |||
| 3795 | |||
| 3796 | ;; scrolling | ||
| 3797 | |||
| 3798 | (setq scroll-step 1) | ||
| 3799 | |||
| 3800 | (defun vip-scroll (arg) | ||
| 3801 | "Scroll to next screen." | ||
| 3802 | (interactive "p") | ||
| 3803 | (if (> arg 0) | ||
| 3804 | (while (> arg 0) | ||
| 3805 | (scroll-up) | ||
| 3806 | (setq arg (1- arg))) | ||
| 3807 | (while (> 0 arg) | ||
| 3808 | (scroll-down) | ||
| 3809 | (setq arg (1+ arg))))) | ||
| 3810 | |||
| 3811 | (defun vip-scroll-back (arg) | ||
| 3812 | "Scroll to previous screen." | ||
| 3813 | (interactive "p") | ||
| 3814 | (vip-scroll (- arg))) | ||
| 3815 | |||
| 3816 | (defun vip-scroll-down (arg) | ||
| 3817 | "Pull down half screen." | ||
| 3818 | (interactive "P") | ||
| 3819 | (condition-case nil | ||
| 3820 | (if (null arg) | ||
| 3821 | (scroll-down (/ (window-height) 2)) | ||
| 3822 | (scroll-down arg)) | ||
| 3823 | (error (beep 1) | ||
| 3824 | (message "Beginning of buffer") | ||
| 3825 | (goto-char (point-min))))) | ||
| 3826 | |||
| 3827 | (defun vip-scroll-down-one (arg) | ||
| 3828 | "Scroll up one line." | ||
| 3829 | (interactive "p") | ||
| 3830 | (scroll-down arg)) | ||
| 3831 | |||
| 3832 | (defun vip-scroll-up (arg) | ||
| 3833 | "Pull up half screen." | ||
| 3834 | (interactive "P") | ||
| 3835 | (condition-case nil | ||
| 3836 | (if (null arg) | ||
| 3837 | (scroll-up (/ (window-height) 2)) | ||
| 3838 | (scroll-up arg)) | ||
| 3839 | (error (beep 1) | ||
| 3840 | (message "End of buffer") | ||
| 3841 | (goto-char (point-max))))) | ||
| 3842 | |||
| 3843 | (defun vip-scroll-up-one (arg) | ||
| 3844 | "Scroll down one line." | ||
| 3845 | (interactive "p") | ||
| 3846 | (scroll-up arg)) | ||
| 3847 | |||
| 3848 | |||
| 3849 | ;; searching | ||
| 3850 | |||
| 3851 | (defun vip-if-string (prompt) | ||
| 3852 | (let ((s (vip-read-string-with-history | ||
| 3853 | prompt | ||
| 3854 | nil ; no initial | ||
| 3855 | 'vip-search-history | ||
| 3856 | (car vip-search-history)))) | ||
| 3857 | (if (not (string= s "")) | ||
| 3858 | (setq vip-s-string s)))) | ||
| 3859 | |||
| 3860 | |||
| 3861 | (defun vip-toggle-search-style (arg) | ||
| 3862 | "Toggle the value of vip-case-fold-search/vip-re-search. | ||
| 3863 | Without prefix argument, will ask which search style to toggle. With prefix | ||
| 3864 | arg 1,toggles vip-case-fold-search; with arg 2 toggles vip-re-search. | ||
| 3865 | |||
| 3866 | Although this function is bound to \\[vip-toggle-search-style], the most | ||
| 3867 | convenient way to use it is to bind `//' to the macro | ||
| 3868 | `1 M-x vip-toggle-search-style' and `///' to | ||
| 3869 | `2 M-x vip-toggle-search-style'. In this way, hitting `//' quickly will | ||
| 3870 | toggle case-fold-search and hitting `/' three times witth toggle regexp | ||
| 3871 | search. Macros are more convenient in this case because they don't affect | ||
| 3872 | the Emacs binding of `/'." | ||
| 3873 | (interactive "P") | ||
| 3874 | (let (msg) | ||
| 3875 | (cond ((or (eq arg 1) | ||
| 3876 | (and (null arg) | ||
| 3877 | (y-or-n-p (format "Search style: '%s'. Want '%s'? " | ||
| 3878 | (if vip-case-fold-search | ||
| 3879 | "case-insensitive" "case-sensitive") | ||
| 3880 | (if vip-case-fold-search | ||
| 3881 | "case-sensitive" | ||
| 3882 | "case-insensitive"))))) | ||
| 3883 | (setq vip-case-fold-search (null vip-case-fold-search)) | ||
| 3884 | (if vip-case-fold-search | ||
| 3885 | (setq msg "Search becomes case-insensitive") | ||
| 3886 | (setq msg "Search becomes case-sensitive"))) | ||
| 3887 | ((or (eq arg 2) | ||
| 3888 | (and (null arg) | ||
| 3889 | (y-or-n-p (format "Search style: '%s'. Want '%s'? " | ||
| 3890 | (if vip-re-search | ||
| 3891 | "regexp-search" "vanilla-search") | ||
| 3892 | (if vip-re-search | ||
| 3893 | "vanilla-search" | ||
| 3894 | "regexp-search"))))) | ||
| 3895 | (setq vip-re-search (null vip-re-search)) | ||
| 3896 | (if vip-re-search | ||
| 3897 | (setq msg "Search becomes regexp-style") | ||
| 3898 | (setq msg "Search becomes vanilla-style"))) | ||
| 3899 | (t | ||
| 3900 | (setq msg "Search style remains unchanged"))) | ||
| 3901 | (prin1 msg t))) | ||
| 3902 | |||
| 3903 | |||
| 3904 | (defun vip-search-forward (arg) | ||
| 3905 | "Search a string forward. | ||
| 3906 | ARG is used to find the ARG's occurrence of the string. | ||
| 3907 | Null string will repeat previous search." | ||
| 3908 | (interactive "P") | ||
| 3909 | (let ((val (vip-P-val arg)) | ||
| 3910 | (com (vip-getcom arg)) | ||
| 3911 | (old-str vip-s-string)) | ||
| 3912 | (setq vip-s-forward t) | ||
| 3913 | (vip-if-string "/") | ||
| 3914 | ;; this is not used at present, but may be used later | ||
| 3915 | (if (or (not (equal old-str vip-s-string)) | ||
| 3916 | (not (markerp vip-local-search-start-marker)) | ||
| 3917 | (not (marker-buffer vip-local-search-start-marker))) | ||
| 3918 | (setq vip-local-search-start-marker (point-marker))) | ||
| 3919 | (vip-search vip-s-string t val) | ||
| 3920 | (if com | ||
| 3921 | (progn | ||
| 3922 | (vip-move-marker-locally 'vip-com-point (mark t)) | ||
| 3923 | (vip-execute-com 'vip-search-next val com))))) | ||
| 3924 | |||
| 3925 | (defun vip-search-backward (arg) | ||
| 3926 | "Search a string backward. | ||
| 3927 | ARG is used to find the ARG's occurrence of the string. | ||
| 3928 | Null string will repeat previous search." | ||
| 3929 | (interactive "P") | ||
| 3930 | (let ((val (vip-P-val arg)) | ||
| 3931 | (com (vip-getcom arg)) | ||
| 3932 | (old-str vip-s-string)) | ||
| 3933 | (setq vip-s-forward nil) | ||
| 3934 | (vip-if-string "?") | ||
| 3935 | ;; this is not used at present, but may be used later | ||
| 3936 | (if (or (not (equal old-str vip-s-string)) | ||
| 3937 | (not (markerp vip-local-search-start-marker)) | ||
| 3938 | (not (marker-buffer vip-local-search-start-marker))) | ||
| 3939 | (setq vip-local-search-start-marker (point-marker))) | ||
| 3940 | (vip-search vip-s-string nil val) | ||
| 3941 | (if com | ||
| 3942 | (progn | ||
| 3943 | (vip-move-marker-locally 'vip-com-point (mark t)) | ||
| 3944 | (vip-execute-com 'vip-search-next val com))))) | ||
| 3945 | |||
| 3946 | |||
| 3947 | (defun vip-search (string forward arg &optional no-offset init-point) | ||
| 3948 | "Search for COUNT's occurrence of STRING. | ||
| 3949 | Search is forward if FORWARD is non-nil, otherwise backward. | ||
| 3950 | INIT-POINT is the position where search is to start. | ||
| 3951 | Arguments: (STRING FORWARD COUNT &optional NO-OFFSET INIT-POINT LIMIT)." | ||
| 3952 | (if (not (equal string "")) | ||
| 3953 | (let ((val (vip-p-val arg)) | ||
| 3954 | (com (vip-getcom arg)) | ||
| 3955 | (null-arg (null (vip-P-val arg))) (offset (not no-offset)) | ||
| 3956 | (case-fold-search vip-case-fold-search) | ||
| 3957 | (start-point (or init-point (point)))) | ||
| 3958 | (vip-deactivate-mark) | ||
| 3959 | (if forward | ||
| 3960 | (condition-case nil | ||
| 3961 | (progn | ||
| 3962 | (if offset (vip-forward-char-carefully)) | ||
| 3963 | (if vip-re-search | ||
| 3964 | (progn | ||
| 3965 | (re-search-forward string nil nil val) | ||
| 3966 | (re-search-backward string)) | ||
| 3967 | (search-forward string nil nil val) | ||
| 3968 | (search-backward string)) | ||
| 3969 | (vip-flash-search-pattern) | ||
| 3970 | (if (not (equal start-point (point))) | ||
| 3971 | (push-mark start-point t))) | ||
| 3972 | (search-failed | ||
| 3973 | (if (and null-arg vip-search-wrap-around-t) | ||
| 3974 | (progn | ||
| 3975 | (message "Search wrapped around end of buffer") | ||
| 3976 | (goto-char (point-min)) | ||
| 3977 | (vip-search string forward (cons 1 com) t start-point) | ||
| 3978 | ;; delete the wrapped around message | ||
| 3979 | (sit-for 2)(message "") | ||
| 3980 | ) | ||
| 3981 | (goto-char start-point) | ||
| 3982 | (error "`%s': %s not found" | ||
| 3983 | string | ||
| 3984 | (if vip-re-search "Pattern" "String")) | ||
| 3985 | ))) | ||
| 3986 | ;; backward | ||
| 3987 | (condition-case nil | ||
| 3988 | (progn | ||
| 3989 | (if vip-re-search | ||
| 3990 | (re-search-backward string nil nil val) | ||
| 3991 | (search-backward string nil nil val)) | ||
| 3992 | (vip-flash-search-pattern) | ||
| 3993 | (if (not (equal start-point (point))) | ||
| 3994 | (push-mark start-point t))) | ||
| 3995 | (search-failed | ||
| 3996 | (if (and null-arg vip-search-wrap-around-t) | ||
| 3997 | (progn | ||
| 3998 | (message "Search wrapped around beginning of buffer") | ||
| 3999 | (goto-char (point-max)) | ||
| 4000 | (vip-search string forward (cons 1 com) t start-point) | ||
| 4001 | ;; delete the wrapped around message | ||
| 4002 | (sit-for 2)(message "") | ||
| 4003 | ) | ||
| 4004 | (goto-char start-point) | ||
| 4005 | (error "`%s': %s not found" | ||
| 4006 | string | ||
| 4007 | (if vip-re-search "Pattern" "String")) | ||
| 4008 | ))))))) | ||
| 4009 | |||
| 4010 | (defun vip-search-next (arg) | ||
| 4011 | "Repeat previous search." | ||
| 4012 | (interactive "P") | ||
| 4013 | (let ((val (vip-p-val arg)) | ||
| 4014 | (com (vip-getcom arg))) | ||
| 4015 | (if (null vip-s-string) (error vip-NoPrevSearch)) | ||
| 4016 | (vip-search vip-s-string vip-s-forward arg) | ||
| 4017 | (if com | ||
| 4018 | (progn | ||
| 4019 | (vip-move-marker-locally 'vip-com-point (mark t)) | ||
| 4020 | (vip-execute-com 'vip-search-next val com))))) | ||
| 4021 | |||
| 4022 | (defun vip-search-Next (arg) | ||
| 4023 | "Repeat previous search in the reverse direction." | ||
| 4024 | (interactive "P") | ||
| 4025 | (let ((val (vip-p-val arg)) | ||
| 4026 | (com (vip-getcom arg))) | ||
| 4027 | (if (null vip-s-string) (error vip-NoPrevSearch)) | ||
| 4028 | (vip-search vip-s-string (not vip-s-forward) arg) | ||
| 4029 | (if com | ||
| 4030 | (progn | ||
| 4031 | (vip-move-marker-locally 'vip-com-point (mark t)) | ||
| 4032 | (vip-execute-com 'vip-search-Next val com))))) | ||
| 4033 | |||
| 4034 | |||
| 4035 | ;; Search contents of buffer defined by one of Viper's motion commands. | ||
| 4036 | ;; Repeatable via `n' and `N'. | ||
| 4037 | (defun vip-buffer-search-enable (&optional c) | ||
| 4038 | (cond (c (setq vip-buffer-search-char c)) | ||
| 4039 | ((null vip-buffer-search-char) | ||
| 4040 | (setq vip-buffer-search-char ?g))) | ||
| 4041 | (define-key vip-vi-basic-map | ||
| 4042 | (char-to-string vip-buffer-search-char) 'vip-command-argument) | ||
| 4043 | (aset vip-exec-array vip-buffer-search-char 'vip-exec-buffer-search) | ||
| 4044 | (setq vip-prefix-commands (cons vip-buffer-search-char vip-prefix-commands))) | ||
| 4045 | |||
| 4046 | (defun vip-isearch-forward (arg) | ||
| 4047 | "This is a Viper wrap-around for isearch-forward." | ||
| 4048 | (interactive "P") | ||
| 4049 | ;; emacs bug workaround | ||
| 4050 | (if (listp arg) (setq arg (car arg))) | ||
| 4051 | (vip-exec-form-in-emacs (list 'isearch-forward arg))) | ||
| 4052 | |||
| 4053 | (defun vip-isearch-backward (arg) | ||
| 4054 | "This is a Viper wrap-around for isearch-backward." | ||
| 4055 | (interactive "P") | ||
| 4056 | ;; emacs bug workaround | ||
| 4057 | (if (listp arg) (setq arg (car arg))) | ||
| 4058 | (vip-exec-form-in-emacs (list 'isearch-backward arg))) | ||
| 4059 | |||
| 4060 | |||
| 4061 | ;; visiting and killing files, buffers | ||
| 4062 | |||
| 4063 | (defun vip-switch-to-buffer () | ||
| 4064 | "Switch to buffer in the current window." | ||
| 4065 | (interactive) | ||
| 4066 | (let (buffer) | ||
| 4067 | (setq buffer | ||
| 4068 | (read-buffer | ||
| 4069 | (format "Switch to buffer in this window \(%s\): " | ||
| 4070 | (buffer-name (other-buffer (current-buffer)))))) | ||
| 4071 | (switch-to-buffer buffer) | ||
| 4072 | )) | ||
| 4073 | |||
| 4074 | (defun vip-switch-to-buffer-other-window () | ||
| 4075 | "Switch to buffer in another window." | ||
| 4076 | (interactive) | ||
| 4077 | (let (buffer) | ||
| 4078 | (setq buffer | ||
| 4079 | (read-buffer | ||
| 4080 | (format "Switch to buffer in another window \(%s\): " | ||
| 4081 | (buffer-name (other-buffer (current-buffer)))))) | ||
| 4082 | (switch-to-buffer-other-window buffer) | ||
| 4083 | )) | ||
| 4084 | |||
| 4085 | (defun vip-kill-buffer () | ||
| 4086 | "Kill a buffer." | ||
| 4087 | (interactive) | ||
| 4088 | (let (buffer buffer-name) | ||
| 4089 | (setq buffer-name | ||
| 4090 | (read-buffer | ||
| 4091 | (format "Kill buffer \(%s\): " | ||
| 4092 | (buffer-name (current-buffer))))) | ||
| 4093 | (setq buffer | ||
| 4094 | (if (null buffer-name) | ||
| 4095 | (current-buffer) | ||
| 4096 | (get-buffer buffer-name))) | ||
| 4097 | (if (null buffer) (error "`%s': No such buffer" buffer-name)) | ||
| 4098 | (if (or (not (buffer-modified-p buffer)) | ||
| 4099 | (y-or-n-p | ||
| 4100 | (format | ||
| 4101 | "Buffer `%s' is modified, are you sure you want to kill it? " | ||
| 4102 | buffer-name))) | ||
| 4103 | (kill-buffer buffer) | ||
| 4104 | (error "Buffer not killed")))) | ||
| 4105 | |||
| 4106 | |||
| 4107 | (defvar vip-smart-suffix-list '("" "tex" "c" "cc" "el" "p") | ||
| 4108 | "*List of suffixes that Viper automatically tries to append to filenames ending with a `.'. | ||
| 4109 | This is useful when you the current directory contains files with the same | ||
| 4110 | prefix and many different suffixes. Usually, only one of the suffixes | ||
| 4111 | represents an editable file. However, file completion will stop at the `.' | ||
| 4112 | The smart suffix feature lets you hit RET in such a case, and Viper will | ||
| 4113 | select the appropriate suffix. | ||
| 4114 | |||
| 4115 | Suffixes are tried in the order given and the first suffix for which a | ||
| 4116 | corresponding file exists is selected. If no file exists for any of the | ||
| 4117 | suffixes, the user is asked to confirm. | ||
| 4118 | |||
| 4119 | To turn this feature off, set this variable to nil.") | ||
| 4120 | |||
| 4121 | ;; Try to add suffix to files ending with a `.' | ||
| 4122 | ;; Useful when the user hits RET on a non-completed file name. | ||
| 4123 | (defun vip-file-add-suffix () | ||
| 4124 | (let ((count 0) | ||
| 4125 | (len (length vip-smart-suffix-list)) | ||
| 4126 | (file (buffer-string)) | ||
| 4127 | found key cmd suff) | ||
| 4128 | (goto-char (point-max)) | ||
| 4129 | (if (and vip-smart-suffix-list (string-match "\\.$" file)) | ||
| 4130 | (progn | ||
| 4131 | (while (and (not found) (< count len)) | ||
| 4132 | (setq suff (nth count vip-smart-suffix-list) | ||
| 4133 | count (1+ count)) | ||
| 4134 | (if (file-exists-p (format "%s%s" file suff)) | ||
| 4135 | (progn | ||
| 4136 | (setq found t) | ||
| 4137 | (insert suff)))) | ||
| 4138 | |||
| 4139 | (if found | ||
| 4140 | () | ||
| 4141 | (vip-tmp-insert-at-eob " [Please complete file name]") | ||
| 4142 | (unwind-protect | ||
| 4143 | (while (not (memq cmd '(exit-minibuffer vip-exit-minibuffer))) | ||
| 4144 | (setq cmd | ||
| 4145 | (key-binding (setq key (read-key-sequence nil)))) | ||
| 4146 | (cond ((eq cmd 'self-insert-command) | ||
| 4147 | (if vip-xemacs-p | ||
| 4148 | (insert (events-to-keys key)) | ||
| 4149 | (insert key))) | ||
| 4150 | ((memq cmd '(exit-minibuffer vip-exit-minibuffer)) | ||
| 4151 | nil) | ||
| 4152 | (t (command-execute cmd))) | ||
| 4153 | ))) | ||
| 4154 | )) | ||
| 4155 | )) | ||
| 4156 | |||
| 4157 | |||
| 4158 | ;; Advice for use in find-file and read-file-name commands. | ||
| 4159 | (defadvice exit-minibuffer (before vip-exit-minibuffer-advice activate) | ||
| 4160 | "Runs vip-minibuffer-exit-hook just before exiting the minibuffer. | ||
| 4161 | Beginning with Emacs 19.26, the standard `minibuffer-exit-hook' is run | ||
| 4162 | *after* exiting the minibuffer." | ||
| 4163 | (run-hooks 'vip-minibuffer-exit-hook)) | ||
| 4164 | |||
| 4165 | (defadvice find-file (before vip-add-suffix-advice activate) | ||
| 4166 | "Uses read-file-name to read arguments." | ||
| 4167 | (interactive (list (read-file-name "Find file: " | ||
| 4168 | nil default-directory)))) | ||
| 4169 | |||
| 4170 | (defadvice find-file-other-window (before vip-add-suffix-advice activate) | ||
| 4171 | "Uses read-file-name to read arguments." | ||
| 4172 | (interactive (list (read-file-name "Find file in other window: " | ||
| 4173 | nil default-directory)))) | ||
| 4174 | |||
| 4175 | ;; find-file-other-screen doesn't need advice because it apparently uses | ||
| 4176 | ;; read-file-name to read its argument. | ||
| 4177 | (defadvice find-file-other-frame (before vip-add-suffix-advice activate) | ||
| 4178 | "Uses read-file-name to read arguments." | ||
| 4179 | (interactive (list (read-file-name "Find file in other frame: " | ||
| 4180 | nil default-directory)))) | ||
| 4181 | |||
| 4182 | (defadvice read-file-name (around vip-suffix-advice activate) | ||
| 4183 | "Makes exit-minibuffer run `vip-file-add-suffix' as a hook." | ||
| 4184 | (let ((vip-minibuffer-exit-hook 'vip-file-add-suffix)) | ||
| 4185 | ad-do-it)) | ||
| 4186 | |||
| 4187 | ;; must be after we did advice or else the advice won't take hold | ||
| 4188 | (if vip-xemacs-p | ||
| 4189 | (fset 'vip-find-file-other-frame | ||
| 4190 | (symbol-function 'find-file-other-screen)) | ||
| 4191 | (fset 'vip-find-file-other-frame | ||
| 4192 | (symbol-function 'find-file-other-frame))) | ||
| 4193 | |||
| 4194 | |||
| 4195 | |||
| 4196 | ;; yank and pop | ||
| 4197 | |||
| 4198 | (defsubst vip-yank (text) | ||
| 4199 | "Yank TEXT silently. This works correctly with Emacs's yank-pop command." | ||
| 4200 | (insert text) | ||
| 4201 | (setq this-command 'yank)) | ||
| 4202 | |||
| 4203 | (defun vip-put-back (arg) | ||
| 4204 | "Put back after point/below line." | ||
| 4205 | (interactive "P") | ||
| 4206 | (let ((val (vip-p-val arg)) | ||
| 4207 | (text (if vip-use-register | ||
| 4208 | (cond ((vip-valid-register vip-use-register '(digit)) | ||
| 4209 | (current-kill (- vip-use-register ?1) 'do-not-rotate)) | ||
| 4210 | ((vip-valid-register vip-use-register) | ||
| 4211 | (get-register (downcase vip-use-register))) | ||
| 4212 | (t (error vip-InvalidRegister vip-use-register))) | ||
| 4213 | (current-kill 0)))) | ||
| 4214 | (if (null text) | ||
| 4215 | (if vip-use-register | ||
| 4216 | (let ((reg vip-use-register)) | ||
| 4217 | (setq vip-use-register nil) | ||
| 4218 | (error vip-EmptyRegister reg)) | ||
| 4219 | (error ""))) | ||
| 4220 | (setq vip-use-register nil) | ||
| 4221 | (if (vip-end-with-a-newline-p text) | ||
| 4222 | (progn | ||
| 4223 | (if (eobp) | ||
| 4224 | (insert "\n") | ||
| 4225 | (forward-line 1)) | ||
| 4226 | (beginning-of-line)) | ||
| 4227 | (if (not (eolp)) (vip-forward-char-carefully))) | ||
| 4228 | (set-marker (vip-mark-marker) (point) (current-buffer)) | ||
| 4229 | (vip-set-destructive-command | ||
| 4230 | (list 'vip-put-back val nil vip-use-register nil nil)) | ||
| 4231 | (vip-loop val (vip-yank text))) | ||
| 4232 | (exchange-point-and-mark) | ||
| 4233 | (vip-deactivate-mark)) | ||
| 4234 | |||
| 4235 | (defun vip-Put-back (arg) | ||
| 4236 | "Put back at point/above line." | ||
| 4237 | (interactive "P") | ||
| 4238 | (let ((val (vip-p-val arg)) | ||
| 4239 | (text (if vip-use-register | ||
| 4240 | (cond ((vip-valid-register vip-use-register '(digit)) | ||
| 4241 | (current-kill (- vip-use-register ?1) 'do-not-rotate)) | ||
| 4242 | ((vip-valid-register vip-use-register) | ||
| 4243 | (get-register (downcase vip-use-register))) | ||
| 4244 | (t (error vip-InvalidRegister vip-use-register))) | ||
| 4245 | (current-kill 0)))) | ||
| 4246 | (if (null text) | ||
| 4247 | (if vip-use-register | ||
| 4248 | (let ((reg vip-use-register)) | ||
| 4249 | (setq vip-use-register nil) | ||
| 4250 | (error vip-EmptyRegister reg)) | ||
| 4251 | (error ""))) | ||
| 4252 | (setq vip-use-register nil) | ||
| 4253 | (if (vip-end-with-a-newline-p text) (beginning-of-line)) | ||
| 4254 | (vip-set-destructive-command | ||
| 4255 | (list 'vip-Put-back val nil vip-use-register nil nil)) | ||
| 4256 | (set-marker (vip-mark-marker) (point) (current-buffer)) | ||
| 4257 | (vip-loop val (vip-yank text))) | ||
| 4258 | (exchange-point-and-mark) | ||
| 4259 | (vip-deactivate-mark)) | ||
| 4260 | |||
| 4261 | |||
| 4262 | (defun vip-copy-region-as-kill (beg end) | ||
| 4263 | "Copy region to kill-ring. | ||
| 4264 | If BEG and END do not belong to the same buffer, copy empty region." | ||
| 4265 | (condition-case nil | ||
| 4266 | (copy-region-as-kill beg end) | ||
| 4267 | (error (copy-region-as-kill beg beg)))) | ||
| 4268 | |||
| 4269 | (defun vip-save-last-insertion (beg end) | ||
| 4270 | "Saves last inserted text for possible use by vip-repeat command." | ||
| 4271 | (setq vip-last-insertion (buffer-substring beg end)) | ||
| 4272 | (or (< (length vip-d-com) 5) | ||
| 4273 | (setcar (nthcdr 4 vip-d-com) vip-last-insertion)) | ||
| 4274 | (or (null vip-command-ring) | ||
| 4275 | (ring-empty-p vip-command-ring) | ||
| 4276 | (progn | ||
| 4277 | (setcar (nthcdr 4 (vip-current-ring-item vip-command-ring)) | ||
| 4278 | vip-last-insertion) | ||
| 4279 | ;; del most recent elt, if identical to the second most-recent | ||
| 4280 | (vip-cleanup-ring vip-command-ring))) | ||
| 4281 | ) | ||
| 4282 | |||
| 4283 | (defsubst vip-yank-last-insertion () | ||
| 4284 | "Inserts the text saved by the previous vip-save-last-insertion command." | ||
| 4285 | (condition-case nil | ||
| 4286 | (insert vip-last-insertion) | ||
| 4287 | (error nil))) | ||
| 4288 | |||
| 4289 | |||
| 4290 | (defun vip-delete-char (arg) | ||
| 4291 | "Delete character." | ||
| 4292 | (interactive "P") | ||
| 4293 | (let ((val (vip-p-val arg))) | ||
| 4294 | (vip-set-destructive-command (list 'vip-delete-char val nil nil nil nil)) | ||
| 4295 | (if (> val 1) | ||
| 4296 | (save-excursion | ||
| 4297 | (let ((here (point))) | ||
| 4298 | (end-of-line) | ||
| 4299 | (if (> val (- (point) here)) | ||
| 4300 | (setq val (- (point) here)))))) | ||
| 4301 | (if (and (eq val 0) (not vip-ex-style-motion)) (setq val 1)) | ||
| 4302 | (if (and vip-ex-style-motion (eolp)) | ||
| 4303 | (if (bolp) (error "") (setq val 0))) ; not bol---simply back 1 ch | ||
| 4304 | (if vip-use-register | ||
| 4305 | (progn | ||
| 4306 | (cond ((vip-valid-register vip-use-register '((Letter))) | ||
| 4307 | (vip-append-to-register | ||
| 4308 | (downcase vip-use-register) (point) (- (point) val))) | ||
| 4309 | ((vip-valid-register vip-use-register) | ||
| 4310 | (copy-to-register | ||
| 4311 | vip-use-register (point) (- (point) val) nil)) | ||
| 4312 | (t (error vip-InvalidRegister vip-use-register))) | ||
| 4313 | (setq vip-use-register nil))) | ||
| 4314 | (if vip-ex-style-motion | ||
| 4315 | (progn | ||
| 4316 | (delete-char val t) | ||
| 4317 | (if (and (eolp) (not (bolp))) (backward-char 1))) | ||
| 4318 | (if (eolp) | ||
| 4319 | (delete-backward-char val t) | ||
| 4320 | (delete-char val t))))) | ||
| 4321 | |||
| 4322 | (defun vip-delete-backward-char (arg) | ||
| 4323 | "Delete previous character. On reaching beginning of line, stop and beep." | ||
| 4324 | (interactive "P") | ||
| 4325 | (let ((val (vip-p-val arg))) | ||
| 4326 | (vip-set-destructive-command | ||
| 4327 | (list 'vip-delete-backward-char val nil nil nil nil)) | ||
| 4328 | (if (> val 1) | ||
| 4329 | (save-excursion | ||
| 4330 | (let ((here (point))) | ||
| 4331 | (beginning-of-line) | ||
| 4332 | (if (> val (- here (point))) | ||
| 4333 | (setq val (- here (point))))))) | ||
| 4334 | (if vip-use-register | ||
| 4335 | (progn | ||
| 4336 | (cond ((vip-valid-register vip-use-register '(Letter)) | ||
| 4337 | (vip-append-to-register | ||
| 4338 | (downcase vip-use-register) (point) (+ (point) val))) | ||
| 4339 | ((vip-valid-register vip-use-register) | ||
| 4340 | (copy-to-register | ||
| 4341 | vip-use-register (point) (+ (point) val) nil)) | ||
| 4342 | (t (error vip-InvalidRegister vip-use-register))) | ||
| 4343 | (setq vip-use-register nil))) | ||
| 4344 | (if (bolp) (ding) | ||
| 4345 | (delete-backward-char val t)))) | ||
| 4346 | |||
| 4347 | (defun vip-del-backward-char-in-insert () | ||
| 4348 | "Delete 1 char backwards while in insert mode." | ||
| 4349 | (interactive) | ||
| 4350 | (if (and vip-ex-style-editing-in-insert (bolp)) | ||
| 4351 | (beep 1) | ||
| 4352 | (delete-backward-char 1 t))) | ||
| 4353 | |||
| 4354 | (defun vip-del-backward-char-in-replace () | ||
| 4355 | "Delete one character in replace mode. | ||
| 4356 | If `vip-delete-backwards-in-replace' is t, then DEL key actually deletes | ||
| 4357 | charecters. If it is nil, then the cursor just moves backwards, similarly | ||
| 4358 | to Vi. The variable `vip-ex-style-editing-in-insert', if t, doesn't let the | ||
| 4359 | cursor move past the beginning of the replacement region." | ||
| 4360 | (interactive) | ||
| 4361 | (cond (vip-delete-backwards-in-replace | ||
| 4362 | (cond ((not (bolp)) | ||
| 4363 | (delete-backward-char 1 t)) | ||
| 4364 | (vip-ex-style-editing-in-insert | ||
| 4365 | (beep 1)) | ||
| 4366 | ((bobp) | ||
| 4367 | (beep 1)) | ||
| 4368 | (t | ||
| 4369 | (delete-backward-char 1 t)))) | ||
| 4370 | (vip-ex-style-editing-in-insert | ||
| 4371 | (if (bolp) | ||
| 4372 | (beep 1) | ||
| 4373 | (backward-char 1))) | ||
| 4374 | (t | ||
| 4375 | (backward-char 1)))) | ||
| 4376 | |||
| 4377 | |||
| 4378 | |||
| 4379 | ;; join lines. | ||
| 4380 | |||
| 4381 | (defun vip-join-lines (arg) | ||
| 4382 | "Join this line to next, if ARG is nil. Otherwise, join ARG lines." | ||
| 4383 | (interactive "*P") | ||
| 4384 | (let ((val (vip-P-val arg))) | ||
| 4385 | (vip-set-destructive-command (list 'vip-join-lines val nil nil nil nil)) | ||
| 4386 | (vip-loop (if (null val) 1 (1- val)) | ||
| 4387 | (progn | ||
| 4388 | (end-of-line) | ||
| 4389 | (if (not (eobp)) | ||
| 4390 | (progn | ||
| 4391 | (forward-line 1) | ||
| 4392 | (delete-region (point) (1- (point))) | ||
| 4393 | (fixup-whitespace))))))) | ||
| 4394 | |||
| 4395 | |||
| 4396 | ;; Replace state | ||
| 4397 | |||
| 4398 | (defun vip-change (beg end) | ||
| 4399 | (if (markerp beg) (setq beg (marker-position beg))) | ||
| 4400 | (if (markerp end) (setq end (marker-position end))) | ||
| 4401 | ;; beg is sometimes (mark t), which may be nil | ||
| 4402 | (or beg (setq beg end)) | ||
| 4403 | |||
| 4404 | (vip-set-complex-command-for-undo) | ||
| 4405 | (if vip-use-register | ||
| 4406 | (progn | ||
| 4407 | (copy-to-register vip-use-register beg end nil) | ||
| 4408 | (setq vip-use-register nil))) | ||
| 4409 | (vip-set-replace-overlay beg end) | ||
| 4410 | (setq last-command nil) ; separate repl text from prev kills | ||
| 4411 | |||
| 4412 | (if (= (vip-replace-start) (point-max)) | ||
| 4413 | (error "End of buffer")) | ||
| 4414 | |||
| 4415 | (setq vip-last-replace-region | ||
| 4416 | (buffer-substring (vip-replace-start) | ||
| 4417 | (vip-replace-end))) | ||
| 4418 | |||
| 4419 | ;; protect against error while inserting "@" and other disasters | ||
| 4420 | ;; (e.g., read-only buff) | ||
| 4421 | (condition-case conds | ||
| 4422 | (if (vip-same-line (vip-replace-start) | ||
| 4423 | (vip-replace-end)) | ||
| 4424 | (let ((delim-end (if (= (length vip-replace-region-end-symbol) 0) | ||
| 4425 | "" | ||
| 4426 | (substring vip-replace-region-end-symbol 0 1)))) | ||
| 4427 | |||
| 4428 | ;; tabs cause problems in replace, so untabify | ||
| 4429 | (goto-char (vip-replace-end)) | ||
| 4430 | (insert-before-markers "@") ; put placeholder after the TAB | ||
| 4431 | |||
| 4432 | (untabify (vip-replace-start) (point)) | ||
| 4433 | ;; del @ and the char under the '$'; don't put on kill ring | ||
| 4434 | (delete-backward-char (1+ (length delim-end))) | ||
| 4435 | (insert delim-end) | ||
| 4436 | ;; this move takes care of the last posn in the overlay, which | ||
| 4437 | ;; has to be shifted because of insert. We can't simply insert | ||
| 4438 | ;; "$" before-markers because then overlay-start will shift the | ||
| 4439 | ;; beginning of the overlay in case we are replacing a single | ||
| 4440 | ;; character. This fixes the bug with `s' and `cl' commands. | ||
| 4441 | (vip-move-replace-overlay (vip-replace-start) (point)) | ||
| 4442 | (goto-char (vip-replace-start)) | ||
| 4443 | (vip-change-state-to-replace t)) | ||
| 4444 | (kill-region (vip-replace-start) | ||
| 4445 | (vip-replace-end)) | ||
| 4446 | (vip-change-state-to-insert)) | ||
| 4447 | (error ;; make sure that the overlay doesn't stay. | ||
| 4448 | ;; go back to the original point | ||
| 4449 | (goto-char (vip-replace-start)) | ||
| 4450 | (vip-hide-replace-overlay) | ||
| 4451 | (vip-message-conditions conds)))) | ||
| 4452 | |||
| 4453 | |||
| 4454 | (defun vip-change-subr (beg end) | ||
| 4455 | ;; beg is sometimes (mark t), which may be nil | ||
| 4456 | (or beg (setq beg end)) | ||
| 4457 | |||
| 4458 | (if vip-use-register | ||
| 4459 | (progn | ||
| 4460 | (copy-to-register vip-use-register beg end nil) | ||
| 4461 | (setq vip-use-register nil))) | ||
| 4462 | (kill-region beg end) | ||
| 4463 | (setq this-command 'vip-change) | ||
| 4464 | (vip-yank-last-insertion)) | ||
| 4465 | |||
| 4466 | (defun vip-toggle-case (arg) | ||
| 4467 | "Toggle character case." | ||
| 4468 | (interactive "P") | ||
| 4469 | (let ((val (vip-p-val arg)) (c)) | ||
| 4470 | (vip-set-destructive-command (list 'vip-toggle-case val nil nil nil nil)) | ||
| 4471 | (while (> val 0) | ||
| 4472 | (setq c (following-char)) | ||
| 4473 | (delete-char 1 nil) | ||
| 4474 | (if (eq c (upcase c)) | ||
| 4475 | (insert-char (downcase c) 1) | ||
| 4476 | (insert-char (upcase c) 1)) | ||
| 4477 | (setq val (1- val))))) | ||
| 4478 | |||
| 4479 | |||
| 4480 | ;; query replace | ||
| 4481 | |||
| 4482 | (defun vip-query-replace () | ||
| 4483 | "Query replace. | ||
| 4484 | If a null string is suplied as the string to be replaced, | ||
| 4485 | the query replace mode will toggle between string replace | ||
| 4486 | and regexp replace." | ||
| 4487 | (interactive) | ||
| 4488 | (let (str) | ||
| 4489 | (setq str (vip-read-string-with-history | ||
| 4490 | (if vip-re-query-replace "Query replace regexp: " | ||
| 4491 | "Query replace: ") | ||
| 4492 | nil ; no initial | ||
| 4493 | 'vip-replace1-history | ||
| 4494 | (car vip-replace1-history) ; default | ||
| 4495 | )) | ||
| 4496 | (if (string= str "") | ||
| 4497 | (progn | ||
| 4498 | (setq vip-re-query-replace (not vip-re-query-replace)) | ||
| 4499 | (message "Query replace mode changed to %s" | ||
| 4500 | (if vip-re-query-replace "regexp replace" | ||
| 4501 | "string replace"))) | ||
| 4502 | (if vip-re-query-replace | ||
| 4503 | (query-replace-regexp | ||
| 4504 | str | ||
| 4505 | (vip-read-string-with-history | ||
| 4506 | (format "Query replace regexp `%s' with: " str) | ||
| 4507 | nil ; no initial | ||
| 4508 | 'vip-replace1-history | ||
| 4509 | (car vip-replace1-history) ; default | ||
| 4510 | )) | ||
| 4511 | (query-replace | ||
| 4512 | str | ||
| 4513 | (vip-read-string-with-history | ||
| 4514 | (format "Query replace `%s' with: " str) | ||
| 4515 | nil ; no initial | ||
| 4516 | 'vip-replace1-history | ||
| 4517 | (car vip-replace1-history) ; default | ||
| 4518 | )))))) | ||
| 4519 | |||
| 4520 | |||
| 4521 | ;; marking | ||
| 4522 | |||
| 4523 | (defun vip-mark-beginning-of-buffer () | ||
| 4524 | (interactive) | ||
| 4525 | (push-mark (point)) | ||
| 4526 | (goto-char (point-min)) | ||
| 4527 | (exchange-point-and-mark) | ||
| 4528 | (message "Mark set at the beginning of buffer")) | ||
| 4529 | |||
| 4530 | (defun vip-mark-end-of-buffer () | ||
| 4531 | (interactive) | ||
| 4532 | (push-mark (point)) | ||
| 4533 | (goto-char (point-max)) | ||
| 4534 | (exchange-point-and-mark) | ||
| 4535 | (message "Mark set at the end of buffer")) | ||
| 4536 | |||
| 4537 | (defun vip-mark-point () | ||
| 4538 | (interactive) | ||
| 4539 | (let ((char (vip-read-char-exclusive))) | ||
| 4540 | (cond ((and (<= ?a char) (<= char ?z)) | ||
| 4541 | (point-to-register (1+ (- char ?a)))) | ||
| 4542 | ((= char ?<) (vip-mark-beginning-of-buffer)) | ||
| 4543 | ((= char ?>) (vip-mark-end-of-buffer)) | ||
| 4544 | ((= char ?.) (vip-set-mark-if-necessary)) | ||
| 4545 | ((= char ?,) (vip-cycle-through-mark-ring)) | ||
| 4546 | ((= char ?D) (mark-defun)) | ||
| 4547 | (t (error "")) | ||
| 4548 | ))) | ||
| 4549 | |||
| 4550 | ;; Algorithm: If first invocation of this command save mark on ring, goto | ||
| 4551 | ;; mark, M0, and pop the most recent elt from the mark ring into mark, | ||
| 4552 | ;; making it into the new mark, M1. | ||
| 4553 | ;; Push this mark back and set mark to the original point position, p1. | ||
| 4554 | ;; So, if you hit '' or `` then you can return to p1. | ||
| 4555 | ;; | ||
| 4556 | ;; If repeated command, pop top elt from the ring into mark and | ||
| 4557 | ;; jump there. This forgets the position, p1, and puts M1 back into mark. | ||
| 4558 | ;; Then we save the current pos, which is M0, jump to M1 and pop M2 from | ||
| 4559 | ;; the ring into mark. Push M2 back on the ring and set mark to M0. | ||
| 4560 | ;; etc. | ||
| 4561 | (defun vip-cycle-through-mark-ring () | ||
| 4562 | "Visit previous locations on the mark ring. | ||
| 4563 | One can use `` and '' to temporarily jump 1 step back." | ||
| 4564 | (let* ((sv-pt (point))) | ||
| 4565 | ;; if repeated `m,' command, pop the previously saved mark. | ||
| 4566 | ;; Prev saved mark is actually prev saved point. It is used if the | ||
| 4567 | ;; user types `` or '' and is discarded | ||
| 4568 | ;; from the mark ring by the next `m,' command. | ||
| 4569 | ;; In any case, go to the previous or previously saved mark. | ||
| 4570 | ;; Then push the current mark (popped off the ring) and set current | ||
| 4571 | ;; point to be the mark. Current pt as mark is discarded by the next | ||
| 4572 | ;; m, command. | ||
| 4573 | (if (eq last-command 'vip-cycle-through-mark-ring) | ||
| 4574 | () | ||
| 4575 | ;; save current mark if the first iteration | ||
| 4576 | (setq mark-ring (delete (vip-mark-marker) mark-ring)) | ||
| 4577 | (if (mark t) | ||
| 4578 | (push-mark (mark t) t)) ) | ||
| 4579 | (pop-mark) | ||
| 4580 | (set-mark-command 1) | ||
| 4581 | ;; don't duplicate mark on the ring | ||
| 4582 | (setq mark-ring (delete (vip-mark-marker) mark-ring)) | ||
| 4583 | (push-mark sv-pt t) | ||
| 4584 | (vip-deactivate-mark) | ||
| 4585 | (setq this-command 'vip-cycle-through-mark-ring) | ||
| 4586 | )) | ||
| 4587 | |||
| 4588 | |||
| 4589 | (defun vip-goto-mark (arg) | ||
| 4590 | "Go to mark." | ||
| 4591 | (interactive "P") | ||
| 4592 | (let ((char (read-char)) | ||
| 4593 | (com (vip-getcom arg))) | ||
| 4594 | (vip-goto-mark-subr char com nil))) | ||
| 4595 | |||
| 4596 | (defun vip-goto-mark-and-skip-white (arg) | ||
| 4597 | "Go to mark and skip to first non-white character on line." | ||
| 4598 | (interactive "P") | ||
| 4599 | (let ((char (read-char)) | ||
| 4600 | (com (vip-getCom arg))) | ||
| 4601 | (vip-goto-mark-subr char com t))) | ||
| 4602 | |||
| 4603 | (defun vip-goto-mark-subr (char com skip-white) | ||
| 4604 | (if (eobp) | ||
| 4605 | (if (bobp) | ||
| 4606 | (error "Empty buffer") | ||
| 4607 | (backward-char 1))) | ||
| 4608 | (cond ((vip-valid-register char '(letter)) | ||
| 4609 | (let* ((buff (current-buffer)) | ||
| 4610 | (reg (1+ (- char ?a))) | ||
| 4611 | (text-marker (get-register reg))) | ||
| 4612 | (if com (vip-move-marker-locally 'vip-com-point (point))) | ||
| 4613 | (if (not (vip-valid-marker text-marker)) | ||
| 4614 | (error (format vip-EmptyTextmarker char))) | ||
| 4615 | (if (and (vip-same-line (point) vip-last-jump) | ||
| 4616 | (= (point) vip-last-jump-ignore)) | ||
| 4617 | (push-mark vip-last-jump t) | ||
| 4618 | (push-mark nil t)) ; no msg | ||
| 4619 | (vip-register-to-point reg) | ||
| 4620 | (setq vip-last-jump (point-marker)) | ||
| 4621 | (cond (skip-white | ||
| 4622 | (back-to-indentation) | ||
| 4623 | (setq vip-last-jump-ignore (point)))) | ||
| 4624 | (if com | ||
| 4625 | (if (equal buff (current-buffer)) | ||
| 4626 | (vip-execute-com (if skip-white | ||
| 4627 | 'vip-goto-mark-and-skip-white | ||
| 4628 | 'vip-goto-mark) | ||
| 4629 | nil com) | ||
| 4630 | (switch-to-buffer buff) | ||
| 4631 | (goto-char vip-com-point) | ||
| 4632 | (vip-change-state-to-vi) | ||
| 4633 | (error ""))))) | ||
| 4634 | ((and (not skip-white) (= char ?`)) | ||
| 4635 | (if com (vip-move-marker-locally 'vip-com-point (point))) | ||
| 4636 | (if (and (vip-same-line (point) vip-last-jump) | ||
| 4637 | (= (point) vip-last-jump-ignore)) | ||
| 4638 | (goto-char vip-last-jump)) | ||
| 4639 | (if (= (point) (mark t)) (pop-mark)) | ||
| 4640 | (exchange-point-and-mark) | ||
| 4641 | (setq vip-last-jump (point-marker) | ||
| 4642 | vip-last-jump-ignore 0) | ||
| 4643 | (if com (vip-execute-com 'vip-goto-mark nil com))) | ||
| 4644 | ((and skip-white (= char ?')) | ||
| 4645 | (if com (vip-move-marker-locally 'vip-com-point (point))) | ||
| 4646 | (if (and (vip-same-line (point) vip-last-jump) | ||
| 4647 | (= (point) vip-last-jump-ignore)) | ||
| 4648 | (goto-char vip-last-jump)) | ||
| 4649 | (if (= (point) (mark t)) (pop-mark)) | ||
| 4650 | (exchange-point-and-mark) | ||
| 4651 | (setq vip-last-jump (point)) | ||
| 4652 | (back-to-indentation) | ||
| 4653 | (setq vip-last-jump-ignore (point)) | ||
| 4654 | (if com (vip-execute-com 'vip-goto-mark-and-skip-white nil com))) | ||
| 4655 | (t (error vip-InvalidTextmarker char)))) | ||
| 4656 | |||
| 4657 | (defun vip-insert-tab () | ||
| 4658 | (interactive) | ||
| 4659 | (insert-tab)) | ||
| 4660 | |||
| 4661 | (defun vip-exchange-point-and-mark () | ||
| 4662 | (interactive) | ||
| 4663 | (exchange-point-and-mark) | ||
| 4664 | (back-to-indentation)) | ||
| 4665 | |||
| 4666 | ;; Input Mode Indentation | ||
| 4667 | |||
| 4668 | (defun vip-forward-indent () | ||
| 4669 | "Indent forward -- `C-t' in Vi." | ||
| 4670 | (interactive) | ||
| 4671 | (setq vip-cted t) | ||
| 4672 | (indent-to (+ (current-column) vip-shift-width))) | ||
| 4673 | |||
| 4674 | (defun vip-backward-indent () | ||
| 4675 | "Backtab, C-d in VI" | ||
| 4676 | (interactive) | ||
| 4677 | (if vip-cted | ||
| 4678 | (let ((p (point)) (c (current-column)) bol (indent t)) | ||
| 4679 | (if (vip-looking-back "[0^]") | ||
| 4680 | (progn | ||
| 4681 | (if (= ?^ (preceding-char)) (setq vip-preserve-indent t)) | ||
| 4682 | (delete-backward-char 1) | ||
| 4683 | (setq p (point)) | ||
| 4684 | (setq indent nil))) | ||
| 4685 | (save-excursion | ||
| 4686 | (beginning-of-line) | ||
| 4687 | (setq bol (point))) | ||
| 4688 | (if (re-search-backward "[^ \t]" bol 1) (forward-char)) | ||
| 4689 | (delete-region (point) p) | ||
| 4690 | (if indent | ||
| 4691 | (indent-to (- c vip-shift-width))) | ||
| 4692 | (if (or (bolp) (vip-looking-back "[^ \t]")) | ||
| 4693 | (setq vip-cted nil))))) | ||
| 4694 | |||
| 4695 | (defun vip-autoindent () | ||
| 4696 | "Auto Indentation, Vi-style." | ||
| 4697 | (interactive) | ||
| 4698 | (let ((col (current-indentation))) | ||
| 4699 | (if (not vip-preserve-indent) | ||
| 4700 | (setq vip-current-indent col) | ||
| 4701 | (setq vip-preserve-indent nil)) | ||
| 4702 | (newline 1) | ||
| 4703 | (if vip-auto-indent | ||
| 4704 | (progn | ||
| 4705 | (setq vip-cted t) | ||
| 4706 | (indent-to vip-current-indent))))) | ||
| 4707 | |||
| 4708 | |||
| 4709 | ;; Viewing registers | ||
| 4710 | |||
| 4711 | (defun vip-ket-function (arg) | ||
| 4712 | "Function called by \], the ket. View registers and call \]\]." | ||
| 4713 | (interactive "P") | ||
| 4714 | (let ((reg (read-char))) | ||
| 4715 | (cond ((vip-valid-register reg '(letter Letter)) | ||
| 4716 | (view-register (downcase reg))) | ||
| 4717 | ((vip-valid-register reg '(digit)) | ||
| 4718 | (let ((text (current-kill (- reg ?1) 'do-not-rotate))) | ||
| 4719 | (save-excursion | ||
| 4720 | (set-buffer (get-buffer-create "*Output*")) | ||
| 4721 | (delete-region (point-min) (point-max)) | ||
| 4722 | (insert (format "Register %c contains the string:\n" reg)) | ||
| 4723 | (insert text) | ||
| 4724 | (goto-char (point-min))) | ||
| 4725 | (display-buffer "*Output*"))) | ||
| 4726 | ((= ?\] reg) | ||
| 4727 | (vip-next-heading arg)) | ||
| 4728 | (t (error | ||
| 4729 | vip-InvalidRegister reg))))) | ||
| 4730 | |||
| 4731 | (defun vip-brac-function (arg) | ||
| 4732 | "Function called by \[, the brac. View textmarkers and call \[\[" | ||
| 4733 | (interactive "P") | ||
| 4734 | (let ((reg (read-char))) | ||
| 4735 | (cond ((= ?\[ reg) | ||
| 4736 | (vip-prev-heading arg)) | ||
| 4737 | ((= ?\] reg) | ||
| 4738 | (vip-heading-end arg)) | ||
| 4739 | ((vip-valid-register reg '(letter)) | ||
| 4740 | (let* ((val (get-register (1+ (- reg ?a)))) | ||
| 4741 | (buf (if (not val) | ||
| 4742 | (error | ||
| 4743 | (format vip-EmptyTextmarker reg)) | ||
| 4744 | (marker-buffer val))) | ||
| 4745 | (pos (marker-position val)) | ||
| 4746 | line-no text (s pos) (e pos)) | ||
| 4747 | (save-excursion | ||
| 4748 | (set-buffer (get-buffer-create "*Output*")) | ||
| 4749 | (delete-region (point-min) (point-max)) | ||
| 4750 | (if (and buf pos) | ||
| 4751 | (progn | ||
| 4752 | (save-excursion | ||
| 4753 | (set-buffer buf) | ||
| 4754 | (setq line-no (1+ (count-lines (point-min) val))) | ||
| 4755 | (goto-char pos) | ||
| 4756 | (beginning-of-line) | ||
| 4757 | (if (re-search-backward "[^ \t]" nil t) | ||
| 4758 | (progn | ||
| 4759 | (beginning-of-line) | ||
| 4760 | (setq s (point)))) | ||
| 4761 | (goto-char pos) | ||
| 4762 | (forward-line 1) | ||
| 4763 | (if (re-search-forward "[^ \t]" nil t) | ||
| 4764 | (progn | ||
| 4765 | (end-of-line) | ||
| 4766 | (setq e (point)))) | ||
| 4767 | (setq text (buffer-substring s e)) | ||
| 4768 | (setq text (format "%s<%c>%s" | ||
| 4769 | (substring text 0 (- pos s)) | ||
| 4770 | reg (substring text (- pos s))))) | ||
| 4771 | (insert | ||
| 4772 | (format | ||
| 4773 | "Textmarker `%c' is in buffer `%s' at line %d.\n" | ||
| 4774 | reg (buffer-name buf) line-no)) | ||
| 4775 | (insert (format "Here is some text around %c:\n\n %s" | ||
| 4776 | reg text))) | ||
| 4777 | (insert (format vip-EmptyTextmarker reg))) | ||
| 4778 | (goto-char (point-min))) | ||
| 4779 | (display-buffer "*Output*"))) | ||
| 4780 | (t (error vip-InvalidTextmarker reg))))) | ||
| 4781 | |||
| 4782 | |||
| 4783 | |||
| 4784 | ;; commands in insertion mode | ||
| 4785 | |||
| 4786 | (defun vip-delete-backward-word (arg) | ||
| 4787 | "Delete previous word." | ||
| 4788 | (interactive "p") | ||
| 4789 | (save-excursion | ||
| 4790 | (push-mark nil t) | ||
| 4791 | (backward-word arg) | ||
| 4792 | (delete-region (point) (mark t)) | ||
| 4793 | (pop-mark))) | ||
| 4794 | |||
| 4795 | |||
| 4796 | (defun vip-set-expert-level (&optional dont-change-unless) | ||
| 4797 | "Sets the expert level for a Viper user. | ||
| 4798 | Can be called interactively to change (temporarily or permanently) the | ||
| 4799 | current expert level. | ||
| 4800 | |||
| 4801 | The optional argument DONT-CHANGE-UNLESS if not nil, says that | ||
| 4802 | the level should not be changed, unless its current value is | ||
| 4803 | meaningless (i.e., not one of 1,2,3,4,5). | ||
| 4804 | |||
| 4805 | User level determines the setting of Viper variables that are most | ||
| 4806 | sensitive for VI-style look-and-feel." | ||
| 4807 | |||
| 4808 | (interactive) | ||
| 4809 | |||
| 4810 | (if (not (numberp vip-expert-level)) (setq vip-expert-level 0)) | ||
| 4811 | |||
| 4812 | (save-window-excursion | ||
| 4813 | (delete-other-windows) | ||
| 4814 | ;; if 0 < vip-expert-level < vip-max-expert-level | ||
| 4815 | ;; & dont-change-unless = t -- use it; else ask | ||
| 4816 | (vip-ask-level dont-change-unless)) | ||
| 4817 | |||
| 4818 | (setq vip-always t | ||
| 4819 | vip-ex-style-motion t | ||
| 4820 | vip-ex-style-editing-in-insert t | ||
| 4821 | vip-want-ctl-h-help nil) | ||
| 4822 | |||
| 4823 | (cond | ||
| 4824 | ;; a novice or a beginner | ||
| 4825 | ((eq vip-expert-level 1) | ||
| 4826 | (global-set-key vip-toggle-key ;; in emacs-state | ||
| 4827 | (if window-system | ||
| 4828 | 'vip-iconify | ||
| 4829 | 'suspend-emacs)) | ||
| 4830 | (setq vip-no-multiple-ESC t | ||
| 4831 | vip-re-search t | ||
| 4832 | vip-vi-style-in-minibuffer t | ||
| 4833 | vip-search-wrap-around-t t | ||
| 4834 | vip-want-emacs-keys-in-vi nil | ||
| 4835 | vip-want-emacs-keys-in-insert nil)) | ||
| 4836 | |||
| 4837 | ;; an intermediate to guru | ||
| 4838 | ((and (> vip-expert-level 1) (< vip-expert-level 5)) | ||
| 4839 | (setq vip-no-multiple-ESC (if window-system t 'twice) | ||
| 4840 | vip-want-emacs-keys-in-vi t | ||
| 4841 | vip-want-emacs-keys-in-insert (> vip-expert-level 2)) | ||
| 4842 | |||
| 4843 | (if (eq vip-expert-level 4) ; respect user's ex-style motions | ||
| 4844 | ; and vip-no-multiple-ESC | ||
| 4845 | (progn | ||
| 4846 | (setq-default vip-ex-style-editing-in-insert | ||
| 4847 | (cdr (assoc 'vip-ex-style-editing-in-insert | ||
| 4848 | vip-saved-user-settings)) | ||
| 4849 | vip-ex-style-motion | ||
| 4850 | (cdr (assoc 'vip-ex-style-motion | ||
| 4851 | vip-saved-user-settings))) | ||
| 4852 | (setq vip-ex-style-motion | ||
| 4853 | (cdr (assoc 'vip-ex-style-motion vip-saved-user-settings)) | ||
| 4854 | vip-ex-style-editing-in-insert | ||
| 4855 | (cdr (assoc 'vip-ex-style-editing-in-insert | ||
| 4856 | vip-saved-user-settings)) | ||
| 4857 | vip-re-search | ||
| 4858 | (cdr (assoc 'vip-re-search vip-saved-user-settings)) | ||
| 4859 | vip-no-multiple-ESC | ||
| 4860 | (cdr (assoc 'vip-no-multiple-ESC | ||
| 4861 | vip-saved-user-settings)))))) | ||
| 4862 | |||
| 4863 | ;; A wizard | ||
| 4864 | ;; Ideally, if 5 is selected, a buffer should pop up to let the | ||
| 4865 | ;; user toggle variable values. | ||
| 4866 | (t (setq-default vip-ex-style-editing-in-insert | ||
| 4867 | (cdr (assoc 'vip-ex-style-editing-in-insert | ||
| 4868 | vip-saved-user-settings)) | ||
| 4869 | vip-ex-style-motion | ||
| 4870 | (cdr (assoc 'vip-ex-style-motion | ||
| 4871 | vip-saved-user-settings))) | ||
| 4872 | (setq vip-want-ctl-h-help | ||
| 4873 | (cdr (assoc 'vip-want-ctl-h-help vip-saved-user-settings)) | ||
| 4874 | vip-always | ||
| 4875 | (cdr (assoc 'vip-always vip-saved-user-settings)) | ||
| 4876 | vip-no-multiple-ESC | ||
| 4877 | (cdr (assoc 'vip-no-multiple-ESC vip-saved-user-settings)) | ||
| 4878 | vip-ex-style-motion | ||
| 4879 | (cdr (assoc 'vip-ex-style-motion vip-saved-user-settings)) | ||
| 4880 | vip-ex-style-editing-in-insert | ||
| 4881 | (cdr (assoc 'vip-ex-style-editing-in-insert | ||
| 4882 | vip-saved-user-settings)) | ||
| 4883 | vip-re-search | ||
| 4884 | (cdr (assoc 'vip-re-search vip-saved-user-settings)) | ||
| 4885 | vip-want-emacs-keys-in-vi | ||
| 4886 | (cdr (assoc 'vip-want-emacs-keys-in-vi | ||
| 4887 | vip-saved-user-settings)) | ||
| 4888 | vip-want-emacs-keys-in-insert | ||
| 4889 | (cdr (assoc 'vip-want-emacs-keys-in-insert | ||
| 4890 | vip-saved-user-settings))))) | ||
| 4891 | (vip-set-mode-vars-for vip-current-state) | ||
| 4892 | (if (or vip-always | ||
| 4893 | (and (> vip-expert-level 0) (> 5 vip-expert-level))) | ||
| 4894 | (vip-set-hooks))) | ||
| 4895 | |||
| 4896 | (defun vip-ask-level (dont-change-unless) | ||
| 4897 | "Ask user expert level." | ||
| 4898 | (let ((ask-buffer " *vip-ask-level*") | ||
| 4899 | level-changed repeated) | ||
| 4900 | (save-window-excursion | ||
| 4901 | (switch-to-buffer ask-buffer) | ||
| 4902 | |||
| 4903 | (or (eq this-command 'vip-set-expert-level) | ||
| 4904 | (and | ||
| 4905 | (<= vip-expert-level vip-max-expert-level) | ||
| 4906 | (>= vip-expert-level 1)) | ||
| 4907 | (progn | ||
| 4908 | (insert " | ||
| 4909 | |||
| 4910 | *** Important Notice for VIP users*** | ||
| 4911 | |||
| 4912 | This is VIPER | ||
| 4913 | |||
| 4914 | @joke | ||
| 4915 | Viper Is a Package for Emacs Rebels, | ||
| 4916 | a VI Plan for Emacs Rescue, | ||
| 4917 | and a venomous VI PERil. | ||
| 4918 | @end joke | ||
| 4919 | |||
| 4920 | Technically speaking, Viper is a new Vi emulator that replaces | ||
| 4921 | the old VIP package. | ||
| 4922 | |||
| 4923 | Viper emulates Vi much better than VIP. It also significantly | ||
| 4924 | extends and improves upon Vi in many useful ways. | ||
| 4925 | |||
| 4926 | Although many VIP settings in your ~/.vip are compatible with Viper, | ||
| 4927 | you may have to change some of them. Please refer to the documentation, | ||
| 4928 | which can be obtained by executing | ||
| 4929 | |||
| 4930 | :help | ||
| 4931 | |||
| 4932 | when Viper is in Vi state. | ||
| 4933 | |||
| 4934 | If you will be so lucky as to find a bug, report it via the command | ||
| 4935 | |||
| 4936 | :submitReport | ||
| 4937 | |||
| 4938 | Type any key to continue... ") | ||
| 4939 | |||
| 4940 | (read-char) | ||
| 4941 | (erase-buffer))) | ||
| 4942 | |||
| 4943 | (while (or (> vip-expert-level vip-max-expert-level) | ||
| 4944 | (< vip-expert-level 1) | ||
| 4945 | (null dont-change-unless)) | ||
| 4946 | (erase-buffer) | ||
| 4947 | (if repeated | ||
| 4948 | (progn | ||
| 4949 | (message "Invalid user level") | ||
| 4950 | (beep 1)) | ||
| 4951 | (setq repeated t)) | ||
| 4952 | (setq dont-change-unless t | ||
| 4953 | level-changed t) | ||
| 4954 | (insert " | ||
| 4955 | Please specify your level of familiarity with the venomous VI PERil | ||
| 4956 | (and the VI Plan for Emacs Rescue). | ||
| 4957 | You can change it at any time by typing `M-x vip-set-expert-level RET' | ||
| 4958 | |||
| 4959 | 1 -- BEGINNER: Almost all Emacs features are suppressed. | ||
| 4960 | Feels almost like straight Vi. File name completion and | ||
| 4961 | command history in the minibuffer are thrown in as a bonus. | ||
| 4962 | To use Emacs productively, you must reach level 3 or higher. | ||
| 4963 | 2 -- MASTER: C-c now has its standard Emacs meaning in Vi command state, | ||
| 4964 | so most Emacs commands can be used when Viper is in Vi state. | ||
| 4965 | Good progress---you are well on the way to level 3! | ||
| 4966 | 3 -- GRAND MASTER: Like 3, but most Emacs commands are available also | ||
| 4967 | in Viper's insert state. | ||
| 4968 | 4 -- GURU: Like 3, but user settings are respected for vip-no-multiple-ESC, | ||
| 4969 | vip-re-search, vip-ex-style-motion, & vip-ex-style-editing-in-insert | ||
| 4970 | variables. Adjust these settings to your taste. | ||
| 4971 | 5 -- WIZARD: Like 4, but user settings are also respected for vip-always, | ||
| 4972 | vip-want-ctl-h-help, vip-want-emacs-keys-in-vi, and | ||
| 4973 | vip-want-emacs-keys-in-insert. Adjust these to your taste. | ||
| 4974 | |||
| 4975 | Please, specify your level now: ") | ||
| 4976 | |||
| 4977 | (setq vip-expert-level (- (vip-read-char-exclusive) ?0)) | ||
| 4978 | ) ; end while | ||
| 4979 | |||
| 4980 | ;; tell the user if level was changed | ||
| 4981 | (and level-changed | ||
| 4982 | (progn | ||
| 4983 | (insert | ||
| 4984 | (format "\n\n\n\n\n\t\tYou have selected user level %d" | ||
| 4985 | vip-expert-level)) | ||
| 4986 | (if (y-or-n-p "Do you wish to make this change permanent? ") | ||
| 4987 | ;; save the setting for vip-expert-level | ||
| 4988 | (vip-save-setting | ||
| 4989 | 'vip-expert-level | ||
| 4990 | (format "Saving user level %d ..." vip-expert-level) | ||
| 4991 | vip-custom-file-name)) | ||
| 4992 | )) | ||
| 4993 | (bury-buffer) ; remove ask-buffer from screen | ||
| 4994 | (message "") | ||
| 4995 | ))) | ||
| 4996 | |||
| 4997 | |||
| 4998 | (defun viper-version () | ||
| 4999 | (interactive) | ||
| 5000 | (message "Viper version is %s" viper-version)) | ||
| 5001 | |||
| 5002 | (defalias 'vip-version 'viper-version) | ||
| 5003 | |||
| 5004 | (defun vip-nil () | ||
| 5005 | (interactive) | ||
| 5006 | (beep 1)) | ||
| 5007 | |||
| 5008 | |||
| 5009 | ;; Returns t, if the string before point matches the regexp STR. | ||
| 5010 | (defsubst vip-looking-back (str) | ||
| 5011 | (and (save-excursion (re-search-backward str nil t)) | ||
| 5012 | (= (point) (match-end 0)))) | ||
| 5013 | |||
| 5014 | |||
| 5015 | |||
| 5016 | ;; if ENFORCE-BUFFER is not nil, error if CHAR is a marker in another buffer | ||
| 5017 | (defun vip-register-to-point (char &optional enforce-buffer) | ||
| 5018 | "Like jump-to-register, but switches to another buffer in another window." | ||
| 5019 | (interactive "cViper register to point: ") | ||
| 5020 | (let ((val (get-register char))) | ||
| 5021 | (cond | ||
| 5022 | ((and (fboundp 'frame-configuration-p) | ||
| 5023 | (frame-configuration-p val)) | ||
| 5024 | (set-frame-configuration val)) | ||
| 5025 | ((window-configuration-p val) | ||
| 5026 | (set-window-configuration val)) | ||
| 5027 | ((vip-valid-marker val) | ||
| 5028 | (if (and enforce-buffer | ||
| 5029 | (not (equal (current-buffer) (marker-buffer val)))) | ||
| 5030 | (error (concat vip-EmptyTextmarker " in this buffer") | ||
| 5031 | (1- (+ char ?a)))) | ||
| 5032 | (pop-to-buffer (marker-buffer val)) | ||
| 5033 | (goto-char val)) | ||
| 5034 | ((and (consp val) (eq (car val) 'file)) | ||
| 5035 | (find-file (cdr val))) | ||
| 5036 | (t | ||
| 5037 | (error vip-EmptyTextmarker (1- (+ char ?a))))))) | ||
| 5038 | |||
| 5039 | |||
| 5040 | (defun vip-save-kill-buffer () | ||
| 5041 | "Save then kill current buffer. " | ||
| 5042 | (interactive) | ||
| 5043 | (if (< vip-expert-level 2) | ||
| 5044 | (save-buffers-kill-emacs) | ||
| 5045 | (save-buffer) | ||
| 5046 | (kill-buffer (current-buffer)))) | ||
| 5047 | |||
| 5048 | |||
| 5049 | |||
| 5050 | ;;; Bug Report | ||
| 5051 | |||
| 5052 | (defun vip-submit-report () | ||
| 5053 | "Submit bug report on Viper." | ||
| 5054 | (interactive) | ||
| 5055 | (let ((reporter-prompt-for-summary-p t) | ||
| 5056 | color-display-p frame-parameters | ||
| 5057 | minibuffer-emacs-face minibuffer-vi-face minibuffer-insert-face | ||
| 5058 | varlist salutation window-config) | ||
| 5059 | |||
| 5060 | ;; If mode info is needed, add variable to `let' and then set it below, | ||
| 5061 | ;; like we did with color-display-p. | ||
| 5062 | (setq color-display-p (if window-system | ||
| 5063 | (vip-display-color-p) | ||
| 5064 | 'non-x) | ||
| 5065 | minibuffer-vi-face (if window-system | ||
| 5066 | (vip-get-face vip-minibuffer-vi-face) | ||
| 5067 | 'non-x) | ||
| 5068 | minibuffer-insert-face (if window-system | ||
| 5069 | (vip-get-face vip-minibuffer-insert-face) | ||
| 5070 | 'non-x) | ||
| 5071 | minibuffer-emacs-face (if window-system | ||
| 5072 | (vip-get-face vip-minibuffer-emacs-face) | ||
| 5073 | 'non-x) | ||
| 5074 | frame-parameters (if (fboundp 'vip-frame-parameters) | ||
| 5075 | (vip-frame-parameters (vip-selected-frame)))) | ||
| 5076 | |||
| 5077 | (setq varlist (list 'vip-vi-minibuffer-minor-mode | ||
| 5078 | 'vip-insert-minibuffer-minor-mode | ||
| 5079 | 'vip-vi-intercept-minor-mode | ||
| 5080 | 'vip-vi-local-user-minor-mode | ||
| 5081 | 'vip-vi-kbd-minor-mode | ||
| 5082 | 'vip-vi-global-user-minor-mode | ||
| 5083 | 'vip-vi-state-modifier-minor-mode | ||
| 5084 | 'vip-vi-diehard-minor-mode | ||
| 5085 | 'vip-vi-basic-minor-mode | ||
| 5086 | 'vip-replace-minor-mode | ||
| 5087 | 'vip-insert-intercept-minor-mode | ||
| 5088 | 'vip-insert-local-user-minor-mode | ||
| 5089 | 'vip-insert-kbd-minor-mode | ||
| 5090 | 'vip-insert-global-user-minor-mode | ||
| 5091 | 'vip-insert-state-modifier-minor-mode | ||
| 5092 | 'vip-insert-diehard-minor-mode | ||
| 5093 | 'vip-insert-basic-minor-mode | ||
| 5094 | 'vip-emacs-intercept-minor-mode | ||
| 5095 | 'vip-emacs-local-user-minor-mode | ||
| 5096 | 'vip-emacs-kbd-minor-mode | ||
| 5097 | 'vip-emacs-global-user-minor-mode | ||
| 5098 | 'vip-emacs-state-modifier-minor-mode | ||
| 5099 | 'vip-automatic-iso-accents | ||
| 5100 | 'vip-want-emacs-keys-in-insert | ||
| 5101 | 'vip-want-emacs-keys-in-vi | ||
| 5102 | 'vip-keep-point-on-undo | ||
| 5103 | 'vip-no-multiple-ESC | ||
| 5104 | 'vip-ESC-key | ||
| 5105 | 'vip-want-ctl-h-help | ||
| 5106 | 'vip-ex-style-editing-in-insert | ||
| 5107 | 'vip-delete-backwards-in-replace | ||
| 5108 | 'vip-vi-style-in-minibuffer | ||
| 5109 | 'vip-vi-state-hooks | ||
| 5110 | 'vip-insert-state-hooks | ||
| 5111 | 'vip-replace-state-hooks | ||
| 5112 | 'vip-emacs-state-hooks | ||
| 5113 | 'ex-cycle-other-window | ||
| 5114 | 'ex-cycle-through-non-files | ||
| 5115 | 'vip-expert-level | ||
| 5116 | 'major-mode | ||
| 5117 | 'window-system | ||
| 5118 | 'color-display-p | ||
| 5119 | 'frame-parameters | ||
| 5120 | 'minibuffer-vi-face | ||
| 5121 | 'minibuffer-insert-face | ||
| 5122 | 'minibuffer-emacs-face | ||
| 5123 | )) | ||
| 5124 | (setq salutation " | ||
| 5125 | Congratulations! You may have unearthed a bug in Viper! | ||
| 5126 | Please mail a concise, accurate summary of the problem to the address above. | ||
| 5127 | |||
| 5128 | -------------------------------------------------------------------") | ||
| 5129 | (setq window-config (current-window-configuration)) | ||
| 5130 | (with-output-to-temp-buffer " *vip-info*" | ||
| 5131 | (switch-to-buffer " *vip-info*") | ||
| 5132 | (delete-other-windows) | ||
| 5133 | (princ " | ||
| 5134 | PLEASE FOLLOW THESE PROCEDURES | ||
| 5135 | ------------------------------ | ||
| 5136 | |||
| 5137 | Before reporting a bug, please verify that it is related to Viper, and is | ||
| 5138 | not cause by other packages you are using. | ||
| 5139 | |||
| 5140 | Don't report compilation warnings, unless you are certain that there is a | ||
| 5141 | problem. These warnings are normal and unavoidable. | ||
| 5142 | |||
| 5143 | Please note that users should not modify variables and keymaps other than | ||
| 5144 | those advertised in the manual. Such `customization' is likely to crash | ||
| 5145 | Viper, as it would any other improperly customized Emacs package. | ||
| 5146 | |||
| 5147 | If you are reporting an error message received while executing one of the | ||
| 5148 | Viper commands, type: | ||
| 5149 | |||
| 5150 | M-x set-variable <Return> debug-on-error <Return> t <Return> | ||
| 5151 | |||
| 5152 | Then reproduce the error. The above command will cause Emacs to produce a | ||
| 5153 | back trace of the execution that leads to the error. Please include this | ||
| 5154 | trace in your bug report. | ||
| 5155 | |||
| 5156 | If you believe that one of Viper's commands goes into an infinite loop | ||
| 5157 | \(e.g., Emacs freezes\), type: | ||
| 5158 | |||
| 5159 | M-x set-variable <Return> debug-on-quit <Return> t <Return> | ||
| 5160 | |||
| 5161 | Then reproduce the problem. Wait for a few seconds, then type C-g to abort | ||
| 5162 | the current command. Include the resulting back trace in the bug report. | ||
| 5163 | |||
| 5164 | Mail anyway (y or n)? ") | ||
| 5165 | (if (y-or-n-p "Mail anyway? ") | ||
| 5166 | () | ||
| 5167 | (set-window-configuration window-config) | ||
| 5168 | (error "Bug report aborted"))) | ||
| 5169 | |||
| 5170 | (require 'reporter) | ||
| 5171 | (set-window-configuration window-config) | ||
| 5172 | |||
| 5173 | (reporter-submit-bug-report "kifer@cs.sunysb.edu" | ||
| 5174 | (vip-version) | ||
| 5175 | varlist | ||
| 5176 | nil 'delete-other-windows | ||
| 5177 | salutation) | ||
| 5178 | )) | ||
| 5179 | |||
| 5180 | |||
| 5181 | |||
| 5182 | |||
| 5183 | ;; Needed to smooth out the difference between Emacs' unread-command-events | ||
| 5184 | ;; and XEmacs unread-command-event. Arg is a character, an event, a list of | ||
| 5185 | ;; events or a sequence of keys. | ||
| 5186 | ;; The semantics of placing an event on unread-command-event in XEmacs is | ||
| 5187 | ;; not the same as placing (setq unread-command-event event) | ||
| 5188 | ;; on the event queue using enqueue-eval-event. For instance, an event | ||
| 5189 | ;; sitting in unread-command-event will be available to (next-event). | ||
| 5190 | ;; In contrast, evals placed on event queue are not evaluated until all | ||
| 5191 | ;; previous commands have been executed. This makes a difference when one | ||
| 5192 | ;; of the events placed on the event queue is bound to a function that | ||
| 5193 | ;; pauses for input, because these evals won't make input immediately | ||
| 5194 | ;; available | ||
| 5195 | ;; | ||
| 5196 | ;; Due to a bug in unread-command-events, a non-event symbol in | ||
| 5197 | ;; unread-command-evets list may cause Emacs to label this symbol to be an | ||
| 5198 | ;; event. Below, we delete nil from event lists, since nil is the most | ||
| 5199 | ;; common problem here. Hopefully, unread-command-evets will be fixed in | ||
| 5200 | ;; the next release. | ||
| 5201 | (defun vip-set-unread-command-events (arg) | ||
| 5202 | (if vip-emacs-p | ||
| 5203 | (setq unread-command-events | ||
| 5204 | (let ((new-events | ||
| 5205 | (cond ((eventp arg) (list arg)) | ||
| 5206 | ((listp arg) arg) | ||
| 5207 | ((sequencep arg) | ||
| 5208 | (listify-key-sequence arg)) | ||
| 5209 | (t (error | ||
| 5210 | "vip-set-unread-command-events: Invalid arg, %S" | ||
| 5211 | arg))))) | ||
| 5212 | (if (not (eventp nil)) | ||
| 5213 | (setq new-events (delq nil new-events))) | ||
| 5214 | (append new-events unread-command-events))) | ||
| 5215 | ;; XEmacs | ||
| 5216 | (cond ((numberp arg) | ||
| 5217 | (setq unread-command-event (character-to-event arg))) | ||
| 5218 | ((eventp arg) | ||
| 5219 | (setq unread-command-event arg)) | ||
| 5220 | ((sequencep arg) | ||
| 5221 | (let ((length (length arg)) | ||
| 5222 | (count 0)) | ||
| 5223 | (while (< count length) | ||
| 5224 | (enqueue-eval-event | ||
| 5225 | 'vip-fudge-event-list-in-xemacs | ||
| 5226 | (if (stringp arg) | ||
| 5227 | (character-to-event (elt arg count)) | ||
| 5228 | (elt arg count))) | ||
| 5229 | (setq count (1+ count)) | ||
| 5230 | ) ; while | ||
| 5231 | (if (> length 0) | ||
| 5232 | (or arg unread-command-event)))) | ||
| 5233 | (t (error "vip-set-unread-command-events: Invalid argument"))))) | ||
| 5234 | |||
| 5235 | (defun vip-fudge-event-list-in-xemacs (arg) | ||
| 5236 | (setq unread-command-event arg)) | ||
| 5237 | |||
| 5238 | |||
| 5239 | ;;; Bring in the rest of the files | ||
| 5240 | (require 'viper-mous) | ||
| 5241 | (require 'viper-macs) | ||
| 5242 | (require 'viper-ex) | ||
| 5243 | |||
| 5244 | |||
| 5245 | |||
| 5246 | ;; The following is provided for compatibility with older VIP's | ||
| 5247 | |||
| 5248 | (defalias 'vip-change-mode-to-vi 'vip-change-state-to-vi) | ||
| 5249 | (defalias 'vip-change-mode-to-insert 'vip-change-state-to-insert) | ||
| 5250 | (defalias 'vip-change-mode-to-emacs 'vip-change-state-to-emacs) | ||
| 5251 | |||
| 5252 | ;; This was the main Vi mode in old versions of VIP which may have been | ||
| 5253 | ;; extensively used by VIP users. We declare it as a global var | ||
| 5254 | ;; and, after .vip is loaded, we add this keymap to vip-vi-basic-map. | ||
| 5255 | (defvar vip-mode-map (make-sparse-keymap) | ||
| 5256 | "This was the main Vi-mode keymap in the old versions of VIP. | ||
| 5257 | Viper provides this variable for compatibility. Whatever the user defines | ||
| 5258 | for this map, is merged into Viper's vip-vi-basic-map after loading .vip") | ||
| 5259 | |||
| 5260 | |||
| 5261 | |||
| 5262 | ;; Load .vip and setup hooks | ||
| 5263 | (defun vip-shell-mode-hook () | ||
| 5264 | "Hook specifically designed to enable Vi-style editing in shell mode." | ||
| 5265 | (setq vip-add-newline-at-eob nil) | ||
| 5266 | ;; this is nicer in shell mode | ||
| 5267 | (setq vip-ex-style-editing-in-insert nil | ||
| 5268 | vip-ex-style-motion nil) | ||
| 5269 | (vip-add-local-keys 'vi-state | ||
| 5270 | '(("\C-m" . comint-send-input) ; return | ||
| 5271 | ("\C-d" . comint-delchar-or-maybe-eof))) ; \C-d | ||
| 5272 | (vip-add-local-keys 'insert-state | ||
| 5273 | '(("\C-m" . comint-send-input) ; return | ||
| 5274 | ("\C-d" . comint-delchar-or-maybe-eof))) ; \C-d | ||
| 5275 | ) | ||
| 5276 | |||
| 5277 | |||
| 5278 | ;; This sets major mode hooks to make them come up in vip-state. | ||
| 5279 | (defun vip-set-hooks () | ||
| 5280 | |||
| 5281 | ;; It is of course a misnomer to call viper-mode a `major mode'. | ||
| 5282 | ;; However, this has the effect that if the user didn't specify the | ||
| 5283 | ;; default mode, new buffers that fall back on the default will come up | ||
| 5284 | ;; in Fundamental Mode and Vi state. | ||
| 5285 | (setq default-major-mode 'viper-mode) | ||
| 5286 | |||
| 5287 | (defadvice fundamental-mode (after vip-fundamental-mode-ad activate) | ||
| 5288 | (vip-change-state-to-vi)) | ||
| 5289 | |||
| 5290 | ;; The following major modes should come up in vi-state | ||
| 5291 | (defvar emacs-lisp-mode-hook nil) | ||
| 5292 | (add-hook 'emacs-lisp-mode-hook 'viper-mode) | ||
| 5293 | |||
| 5294 | (defvar lisp-mode-hook nil) | ||
| 5295 | (add-hook 'lisp-mode-hook 'viper-mode) | ||
| 5296 | |||
| 5297 | (defvar bibtex-mode-hook nil) | ||
| 5298 | (add-hook 'bibtex-mode-hook 'viper-mode) | ||
| 5299 | |||
| 5300 | (defvar cc-mode-hook nil) | ||
| 5301 | (add-hook 'cc-mode-hook 'viper-mode) | ||
| 5302 | |||
| 5303 | (defvar c-mode-hook nil) | ||
| 5304 | (add-hook 'c-mode-hook 'viper-mode) | ||
| 5305 | |||
| 5306 | (defvar c++-mode-hook nil) | ||
| 5307 | (add-hook 'c++-mode-hook 'viper-mode) | ||
| 5308 | |||
| 5309 | (defvar lisp-interaction-mode-hook nil) | ||
| 5310 | (add-hook 'lisp-interaction-mode-hook 'viper-mode) | ||
| 5311 | |||
| 5312 | (defvar text-mode-hook nil) | ||
| 5313 | (add-hook 'text-mode-hook 'viper-mode) | ||
| 5314 | |||
| 5315 | (add-hook 'completion-list-mode-hook 'viper-mode) | ||
| 5316 | (add-hook 'compilation-mode-hook 'viper-mode) | ||
| 5317 | |||
| 5318 | (defvar emerge-startup-hook nil) | ||
| 5319 | (add-hook 'emerge-startup-hook 'vip-change-state-to-emacs) | ||
| 5320 | ;; Run vip-change-state-to-vi after quitting emerge. | ||
| 5321 | (vip-eval-after-load "emerge" | ||
| 5322 | '(defadvice emerge-quit (after vip-emerge-advice activate) | ||
| 5323 | "Run vip-change-state-to-vi after quitting emerge." | ||
| 5324 | (vip-change-state-to-vi))) | ||
| 5325 | ;; In case Emerge was loaded before Viper. | ||
| 5326 | (defadvice emerge-quit (after vip-emerge-advice activate) | ||
| 5327 | "Run vip-change-state-to-vi after quitting emerge." | ||
| 5328 | (vip-change-state-to-vi)) | ||
| 5329 | |||
| 5330 | (vip-eval-after-load "asm-mode" | ||
| 5331 | '(defadvice asm-mode (after vip-asm-mode-ad activate) | ||
| 5332 | "Run vip-change-state-to-vi on entry." | ||
| 5333 | (vip-change-state-to-vi))) | ||
| 5334 | |||
| 5335 | ;; passwd.el sets up its own buffer, which turns up in Vi mode, | ||
| 5336 | ;; overriding the local map. Noone needs Vi mode here. | ||
| 5337 | (vip-eval-after-load | ||
| 5338 | "passwd" | ||
| 5339 | '(defadvice read-passwd-1 (before vip-passwd-ad activate) | ||
| 5340 | "Vi-ism is prohibited when reading passwords, so switch to Emacs." | ||
| 5341 | (vip-change-state-to-emacs))) | ||
| 5342 | |||
| 5343 | ;; Emacs shell | ||
| 5344 | (defvar shell-mode-hook nil) | ||
| 5345 | (add-hook 'shell-mode-hook 'vip-change-state-to-insert) | ||
| 5346 | (add-hook 'shell-mode-hook 'vip-shell-mode-hook) | ||
| 5347 | |||
| 5348 | ;; Shell scripts | ||
| 5349 | (defvar sh-mode-hook nil) | ||
| 5350 | (add-hook 'sh-mode-hook 'viper-mode) | ||
| 5351 | |||
| 5352 | ;; Dired | ||
| 5353 | ;; This is only necessary when the user uses vip-modify-major-mode | ||
| 5354 | (add-hook 'dired-mode-hook 'vip-change-state-to-emacs) | ||
| 5355 | |||
| 5356 | (defvar view-hook nil | ||
| 5357 | "View hook. Run after view mode.") | ||
| 5358 | (add-hook 'view-hook 'vip-change-state-to-emacs) | ||
| 5359 | |||
| 5360 | ;; For VM users. | ||
| 5361 | ;; Put summary and other VM buffers in Emacs state. | ||
| 5362 | (defvar vm-mode-hooks nil | ||
| 5363 | "This hook is run after vm is started.") | ||
| 5364 | (defvar vm-summary-mode-hooks nil | ||
| 5365 | "This hook is run after vm switches to summary mode.") | ||
| 5366 | (add-hook 'vm-mode-hooks 'vip-change-state-to-emacs) | ||
| 5367 | (add-hook 'vm-summary-mode-hooks 'vip-change-state-to-emacs) | ||
| 5368 | |||
| 5369 | ;; For RMAIL users. | ||
| 5370 | ;; Put buf in Emacs state after edit. | ||
| 5371 | (vip-eval-after-load | ||
| 5372 | "rmailedit" | ||
| 5373 | '(defadvice rmail-cease-edit (after vip-rmail-advice activate) | ||
| 5374 | "Switch buffer to emacs-state after finishing with editing a message." | ||
| 5375 | (vip-change-state-to-emacs))) | ||
| 5376 | ;; In case RMAIL was loaded before Viper. | ||
| 5377 | (defadvice rmail-cease-edit (after vip-rmail-advice activate) | ||
| 5378 | "Switch buffer to emacs-state after finishing with editing a message." | ||
| 5379 | (vip-change-state-to-emacs)) | ||
| 5380 | ) ; vip-set-hooks | ||
| 5381 | |||
| 5382 | |||
| 5383 | ;; ~/.vip is loaded if it exists | ||
| 5384 | (if (and (file-exists-p vip-custom-file-name) | ||
| 5385 | (not noninteractive)) | ||
| 5386 | (load vip-custom-file-name)) | ||
| 5387 | |||
| 5388 | ;; VIP compatibility: merge whatever the user has in vip-mode-map into | ||
| 5389 | ;; Viper's basic map. | ||
| 5390 | (vip-add-keymap vip-mode-map vip-vi-global-user-map) | ||
| 5391 | |||
| 5392 | |||
| 5393 | ;; Applying Viper customization -- runs after (load .vip) | ||
| 5394 | |||
| 5395 | ;; Save user settings or Viper defaults for vars controled by vip-expert-level | ||
| 5396 | (setq vip-saved-user-settings | ||
| 5397 | (list (cons 'vip-want-ctl-h-help vip-want-ctl-h-help) | ||
| 5398 | (cons 'vip-always vip-always) | ||
| 5399 | (cons 'vip-no-multiple-ESC vip-no-multiple-ESC) | ||
| 5400 | (cons 'vip-ex-style-motion vip-ex-style-motion) | ||
| 5401 | (cons 'vip-ex-style-editing-in-insert | ||
| 5402 | vip-ex-style-editing-in-insert) | ||
| 5403 | (cons 'vip-want-emacs-keys-in-vi vip-want-emacs-keys-in-vi) | ||
| 5404 | (cons 'vip-want-emacs-keys-in-insert vip-want-emacs-keys-in-insert) | ||
| 5405 | (cons 'vip-re-search vip-re-search))) | ||
| 5406 | |||
| 5407 | |||
| 5408 | (vip-set-minibuffer-style) | ||
| 5409 | (vip-set-minibuffer-faces) | ||
| 5410 | (vip-set-search-face) | ||
| 5411 | |||
| 5412 | ;;; Familiarize Viper with some minor modes that have their own keymaps | ||
| 5413 | (vip-harness-minor-mode "compile") | ||
| 5414 | (vip-harness-minor-mode "outline") | ||
| 5415 | (vip-harness-minor-mode "allout") | ||
| 5416 | (vip-harness-minor-mode "xref") | ||
| 5417 | (vip-harness-minor-mode "lmenu") | ||
| 5418 | (vip-harness-minor-mode "vc") | ||
| 5419 | (vip-harness-minor-mode "ltx-math") ; LaTeX-math-mode in AUC-TeX | ||
| 5420 | (vip-harness-minor-mode "latex") ; latex they moved math mode here | ||
| 5421 | |||
| 5422 | |||
| 5423 | ;; Intercept maps could go in viper-keym.el | ||
| 5424 | ;; We keep them here in case someone redefines them in ~/.vip | ||
| 5425 | |||
| 5426 | (define-key vip-vi-intercept-map vip-ESC-key 'vip-intercept-ESC-key) | ||
| 5427 | (define-key vip-insert-intercept-map vip-ESC-key 'vip-intercept-ESC-key) | ||
| 5428 | |||
| 5429 | ;; This is taken care of by vip-insert-global-user-map. | ||
| 5430 | ;;(define-key vip-replace-map vip-ESC-key 'vip-intercept-ESC-key) | ||
| 5431 | |||
| 5432 | (define-key vip-insert-intercept-map vip-toggle-key 'vip-alternate-ESC) | ||
| 5433 | ;; The default vip-toggle-key is \C-z; for the novice, it suspends or | ||
| 5434 | ;; iconifies Emacs | ||
| 5435 | (define-key vip-vi-intercept-map vip-toggle-key | ||
| 5436 | '(lambda () (interactive) | ||
| 5437 | (if (and (< vip-expert-level 2) (equal vip-toggle-key "\C-z")) | ||
| 5438 | (if window-system (vip-iconify) (suspend-emacs)) | ||
| 5439 | (vip-change-state-to-emacs)))) | ||
| 5440 | |||
| 5441 | (define-key vip-emacs-intercept-map vip-toggle-key 'vip-change-state-to-vi) | ||
| 5442 | |||
| 5443 | |||
| 5444 | (if (or vip-always | ||
| 5445 | (and (< vip-expert-level 5) (> vip-expert-level 0))) | ||
| 5446 | (vip-set-hooks)) | ||
| 5447 | |||
| 5448 | ;; Let all minor modes take effect after loading | ||
| 5449 | ;; this may not be enough, so we also set default minor-mode-alist. | ||
| 5450 | ;; Without setting the default, new buffers that come up in emacs mode have | ||
| 5451 | ;; minor-mode-map-alist = nil, unless we call vip-change-state-* | ||
| 5452 | (if (eq vip-current-state 'emacs-state) | ||
| 5453 | (progn | ||
| 5454 | (vip-change-state-to-emacs) | ||
| 5455 | (setq-default minor-mode-map-alist minor-mode-map-alist) | ||
| 5456 | )) | ||
| 5457 | |||
| 5458 | ;; set some useful macros | ||
| 5459 | |||
| 5460 | ;; repeat the 2nd previous command without rotating the command history | ||
| 5461 | (vip-record-kbd-macro | ||
| 5462 | (vector vip-repeat-from-history-key '\1) 'vi-state | ||
| 5463 | [(meta x) v i p - r e p e a t - f r o m - h i s t o r y return] 't) | ||
| 5464 | ;; repeat the 3d previous command without rotating the command history | ||
| 5465 | (vip-record-kbd-macro | ||
| 5466 | (vector vip-repeat-from-history-key '\2) 'vi-state | ||
| 5467 | [(meta x) v i p - r e p e a t - f r o m - h i s t o r y return] 't) | ||
| 5468 | |||
| 5469 | ;; toggle case sensitivity in search | ||
| 5470 | (vip-record-kbd-macro | ||
| 5471 | "//" 'vi-state | ||
| 5472 | [1 (meta x) v i p - t o g g l e - s e a r c h - s t y l e return] 't) | ||
| 5473 | ;; toggle regexp/vanila search | ||
| 5474 | (vip-record-kbd-macro | ||
| 5475 | "///" 'vi-state | ||
| 5476 | [2 (meta x) v i p - t o g g l e - s e a r c h - s t y l e return] 't) | ||
| 5477 | |||
| 5478 | |||
| 5479 | (run-hooks 'vip-load-hooks) ; the last chance to change anything | ||
| 5480 | |||
| 5481 | (provide 'viper) | ||
| 5482 | (provide 'vip19) | ||
| 5483 | (provide 'vip) | ||
| 5484 | |||
| 5485 | ;;; viper.el ends here | ||
| 5486 | |||