aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKarl Heuer1995-02-20 23:15:10 +0000
committerKarl Heuer1995-02-20 23:15:10 +0000
commit6c2e12f452e42380f7126ba3e2d58a9a8a9614e7 (patch)
tree1ac3d8324d28f236dc8d6ad4538da4004169d4d5
parentfa2b2917332cc15fc559aa07e449f7fa257aceb5 (diff)
downloademacs-6c2e12f452e42380f7126ba3e2d58a9a8a9614e7.tar.gz
emacs-6c2e12f452e42380f7126ba3e2d58a9a8a9614e7.zip
Initial revision
-rw-r--r--lisp/emulation/viper-ex.el1888
-rw-r--r--lisp/emulation/viper-keym.el525
-rw-r--r--lisp/emulation/viper-macs.el902
-rw-r--r--lisp/emulation/viper-mous.el457
-rw-r--r--lisp/emulation/viper-util.el798
-rw-r--r--lisp/emulation/viper.el5486
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.
124Then :N and :B cycles in the current window. If nil, this behavior is
125reversed.")
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.
241A 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.
1049In Viper, `e' and `e!' behave identically. In both cases, the user is
1050asked if current buffer should really be discarded.
1051This command can take multiple file names. It replaces the current buffer
1052with 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
1621This file is part of the distribution of Viper. If you do not
1622have the full distribution, please obtain it from the `anonymous'
1623FTP account at `archive.cis.ohio-state.edu':
1624
1625 /pub/gnu/emacs/elisp-archive/modes/viper.shar
1626
1627The Info files for Viper should be installed as <name>, <name>-1, etc.,
1628where <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.
1639If 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.
34Useful for changing bindings such as ZZ in certain major modes.
35For instance, in letter-mode, one may want to bind ZZ to
36mh-send-letter. In a newsreader such as gnus, tin, or rn, ZZ could be bound
37to 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.
42These 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.
46This 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.
53This 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.
68Most of the Emacs keys are suppressed. This map overshadows
69vip-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.
364The effect is seen in the current buffer only.
365Useful for customizing mailer buffers, gnus, etc.
366STATE is 'vi-state, 'insert-state, or 'emacs-state
367ALIST is of the form ((key . func) (key . func) ...)
368Normally, this would be called from a hook to a major mode or
369on a per buffer basis.
370Usage:
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
401If the default for a major mode is emacs-state, then modifications to this
402major mode may not take effect until the buffer switches state to Vi,
403Insert or Emacs. If this happens, add vip-change-state-to-emacs to this
404major mode's hook. If no such hook exists, you may have to put an advice on
405the function that invokes the major mode. See vip-set-hooks for hints.
406
407The above needs not to be done for major modes that come up in Vi or Insert
408state by default.
409
410Arguments: (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
517form ((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.
47This 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,
52which repeats previous destructive commands from the history of such
53commands.
54This function can then be invoked as <this-key> 1 or <this-key> 2.
55The notation for these keys is borrowed from XEmacs. Basically,
56a 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 ).
289This 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.
303MACRO-NAME is a string of characters or a vector of keys. STATE is
304either `vi-state' or `insert-state'. It specifies the Viper state in which to
305define the macro. MACRO-BODY is a string that represents the keyboard macro.
306Optional SCOPE says whether the macro should be global \(t\), mode-specific
307\(a major-mode symbol\), or buffer-specific \(buffer name, a string\).
308If 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.
35Takes two parameters: a COUNT, indicating how many words to return,
36and CLICK-COUNT, telling whether this is the first click, a double-click,
37or 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
45considered 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.
73COUNT indicates how many regions to return.
74If CLICK-COUNT is 1, `word' is a word in Vi sense. If it is > 1,
75then `word' is a Word in Vi sense.
76If the character clicked on is a non-separator and is non-alphanumeric but
77is adjacent to an alphanumeric symbol, then it is considered alphanumeric
78for the purpose of this command. If this character has a matching
79character, such as `\(' is a match for `\)', then the matching character is
80also considered alphanumeric.
81For 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.
169Click 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.
216With prefix argument, N, insert that many words.
217This command must be bound to a mouse click.
218The double-click action of the same mouse button must not be bound
219\(or it must be bound to the same function\).
220See `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.
281With prefix argument, N, search for N-th occurrence.
282This command must be bound to a mouse click. The double-click action of the
283same button must not be bound \(or it must be bound to the same function\).
284See `vip-surrounding-word' for the details on what constitutes a word for
285this 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.
382Usually is bound to a 'down-mouse' event to work properly. See sample
383bindings 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.
244If pos is 'start then returns position of line start.
245If pos is 'end, returns line end. If pos is 'mid, returns line center.
246Pos = 'indent returns beginning of indentation.
247Otherwise, 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.
267The first argument must eval to a variable name.
268Arguments: (var-name position &optional buffer).
269
270This is useful for moving markers that are supposed to be local.
271For this, VAR-NAME should be made buffer-local with nil as a default.
272Then, each time this var is used in `vip-move-marker-locally' in a new
273buffer, 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.
475If given, MESSAGE is a message to be displayed after that.
476This message is erased after 2 secs, if erase-msg is non-nil.
477Arguments: (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.
785Arguments become related buffers. This function should normally be used in
786the `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.
334The minor mode vip-vi-diehard-minor-mode is in effect when
335vip-expert-level is 1 or 2 or when vip-want-emacs-keys-in-vi is t.
336The minor mode vip-insert-diehard-minor-mode is in effect when
337vip-expert-level is 1 or 2 or if vip-want-emacs-keys-in-insert is t.
338Use `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.
379The corresponding keymap stores key bindings of Vi macros defined with
380the 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.
390This is a way to overshadow normal Insert mode bindings locally to certain
391designated 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.
401Not 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.
405The corresponding keymap stores key bindings of Vi macros defined with
406the 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.
418Users can use it to override Emacs bindings when Viper is in its Emacs
419state.")
420
421(vip-deflocalvar vip-emacs-global-user-minor-mode t
422 "Minor mode for global user bindings in effect in Emacs state.
423Users can use it to override Emacs bindings when Viper is in its Emacs
424state.")
425
426(vip-deflocalvar vip-emacs-kbd-minor-mode t
427 "Minor mode for Vi style macros in Emacs state.
428The 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
430interactively.")
431
432(vip-deflocalvar vip-emacs-state-modifier-minor-mode t
433 "Minor mode used to make major-mode-specific modification to Emacs state.
434For instance, a Vi purist may want to bind `dd' in Dired mode to a function
435that 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.
443For some users, this behavior may be too primitive. In this case, use
444insert/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.
451Complete 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.
455Full 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.
472This style is different from Emacs and Vi. Try it to see if
473it 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.
515At present, only the first character of a non-empty string is used to
516actually mark the region.")
517(defvar vip-replace-region-start-symbol ""
518 "*Symbol to mark the beginning of a replacement region. A string.
519Not 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.
565In insert mode, this key also functions as Meta.
566Must be set in .vip file or prior to loading Viper.
567This setting cannot be changed interactively.")
568
569(defvar vip-ESC-key "\e"
570 "Key used to ESC.
571Must be set in .vip file or prior to loading Viper.
572This 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.
577This is set to t on a windowing terminal and to 'twice on a dumb
578terminal (unless the user level is 1, 2, or 5). On a dumb terminal, this
579enables cursor keys and is generally more convenient, as terminals usually
580don't have a convenient Meta key.
581Setting vip-no-multiple-ESC to nil will allow as many multiple ESC,
582as 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
587bound 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.
610This is useful for doing repeated changes with the '.' key.
611The user can change this to nil, if she likes when the cursor moves
612to 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.
710Note: this doesn't preclude ^H and ^? from deleting characters by moving
711past 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.
715If 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
725current buffer.
726These 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.
822This 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.
836Should 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.
853Usually, Viper adds a newline character at the end of the last
854line in a buffer, if it's missing. In some major modes, however, like
855shell-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.
1053This ensures that Viper bindings are in effect, regardless of which minor
1054modes 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.
1142It is also a VI Plan for Emacs Rescue and a venomous VI PERil.
1143
1144Technically speaking, Viper is a Vi emulation package for GNU Emacs 19 and
1145XEmacs 19. It supports virtually all of Vi and Ex functionality, extending
1146and 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
1175You 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
1181This 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.
1369ARG is used as the prefix value for the executed command. If
1370EVENTS 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.
1377This doesn't work with prefix arguments or most complex commands like
1378cw, dw, etc. But it does work with some 2-character commands,
1379like 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.
1432Similar 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.
1451Minor modes that have their own keymaps may overshadow Viper keymaps.
1452This function is designed to make Viper aware of the packages that define
1453such minor modes.
1454Usage:
1455 (vip-harness-minor-mode load-file)
1456
1457LOAD-FILE is a name of the file where the specific minor mode is defined.
1458Suffixes 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.
1484Prevents multiple escape keystrokes if vip-no-multiple-ESC is true. In that
1485case \@ will be bound to ESC. If vip-no-multiple-ESC is 'twice double ESC
1486would dings in vi-state. Other ESC sequences are emulated via the current
1487Emacs's major mode keymap. This is more convenient on dumb terminals and in
1488Emacs -nw, since this won't block functional keys such as up,down,
1489etc. Meta key also will work. When vip-no-multiple-ESC is nil, ESC key
1490behaves 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.
1616If a sequence of keys starting with ESC is issued with very short delays,
1617interpret 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.
1647Invoked 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.
2008Use the info in vip-d-com, which has the form
2009\(com val ch reg inserted-text command-keys\),
2010where `com' is the command to be re-executed, `val' is the
2011argument to `com', `ch' is a flag for repeat, and `reg' is optional;
2012if it exists, it is the name of the register for `com'.
2013If 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.
2055Doesn't change vip-command-ring in any way, so `.' will work as before
2056executing this command.
2057This command is supposed to be bound to a two-character Vi macro where
2058the second character is a digit 0 to 9. The digit indicates which
2059history command to execute. `<char>0' is equivalent to `.', `<char>1'
2060invokes 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.
2214With 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.
2237Undoes previous insertion and inserts new.
2238With prefix argument, cycles in the direction of newer elements.
2239In minibuffer, this command executes whatever the invocation key is bound
2240to 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.
2912These 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.
2933Similar 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.
3012If you supply null string as the string to be replaced,
3013the query replace mode will toggle between string replace and regexp replace.
3014This function comes from VIP 3.5 and is not used in Viper. A nostalgic user
3015can 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).
3054On 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).
3075On 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.
3465If FORWARD then search is forward, otherwise backward. OFFSET is used to
3466adjust 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.
3498If called interactively read the char to find from the terminal, and if
3499called from vip-repeat, the char last used is used. This behaviour is
3500controlled 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.
3863Without prefix argument, will ask which search style to toggle. With prefix
3864arg 1,toggles vip-case-fold-search; with arg 2 toggles vip-re-search.
3865
3866Although this function is bound to \\[vip-toggle-search-style], the most
3867convenient 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
3870toggle case-fold-search and hitting `/' three times witth toggle regexp
3871search. Macros are more convenient in this case because they don't affect
3872the 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.
3906ARG is used to find the ARG's occurrence of the string.
3907Null 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.
3927ARG is used to find the ARG's occurrence of the string.
3928Null 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.
3949Search is forward if FORWARD is non-nil, otherwise backward.
3950INIT-POINT is the position where search is to start.
3951Arguments: (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 `.'.
4109This is useful when you the current directory contains files with the same
4110prefix and many different suffixes. Usually, only one of the suffixes
4111represents an editable file. However, file completion will stop at the `.'
4112The smart suffix feature lets you hit RET in such a case, and Viper will
4113select the appropriate suffix.
4114
4115Suffixes are tried in the order given and the first suffix for which a
4116corresponding file exists is selected. If no file exists for any of the
4117suffixes, the user is asked to confirm.
4118
4119To 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.
4161Beginning 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.
4264If 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.
4356If `vip-delete-backwards-in-replace' is t, then DEL key actually deletes
4357charecters. If it is nil, then the cursor just moves backwards, similarly
4358to Vi. The variable `vip-ex-style-editing-in-insert', if t, doesn't let the
4359cursor 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.
4484If a null string is suplied as the string to be replaced,
4485the query replace mode will toggle between string replace
4486and 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.
4563One 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.
4798Can be called interactively to change (temporarily or permanently) the
4799current expert level.
4800
4801The optional argument DONT-CHANGE-UNLESS if not nil, says that
4802the level should not be changed, unless its current value is
4803meaningless (i.e., not one of 1,2,3,4,5).
4804
4805User level determines the setting of Viper variables that are most
4806sensitive 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
4915Viper Is a Package for Emacs Rebels,
4916a VI Plan for Emacs Rescue,
4917and a venomous VI PERil.
4918@end joke
4919
4920Technically speaking, Viper is a new Vi emulator that replaces
4921the old VIP package.
4922
4923Viper emulates Vi much better than VIP. It also significantly
4924extends and improves upon Vi in many useful ways.
4925
4926Although many VIP settings in your ~/.vip are compatible with Viper,
4927you may have to change some of them. Please refer to the documentation,
4928which can be obtained by executing
4929
4930:help
4931
4932when Viper is in Vi state.
4933
4934If you will be so lucky as to find a bug, report it via the command
4935
4936:submitReport
4937
4938Type 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 "
4955Please specify your level of familiarity with the venomous VI PERil
4956(and the VI Plan for Emacs Rescue).
4957You 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
4975Please, 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 "
5125Congratulations! You may have unearthed a bug in Viper!
5126Please 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 "
5134PLEASE FOLLOW THESE PROCEDURES
5135------------------------------
5136
5137Before reporting a bug, please verify that it is related to Viper, and is
5138not cause by other packages you are using.
5139
5140Don't report compilation warnings, unless you are certain that there is a
5141problem. These warnings are normal and unavoidable.
5142
5143Please note that users should not modify variables and keymaps other than
5144those advertised in the manual. Such `customization' is likely to crash
5145Viper, as it would any other improperly customized Emacs package.
5146
5147If you are reporting an error message received while executing one of the
5148Viper commands, type:
5149
5150 M-x set-variable <Return> debug-on-error <Return> t <Return>
5151
5152Then reproduce the error. The above command will cause Emacs to produce a
5153back trace of the execution that leads to the error. Please include this
5154trace in your bug report.
5155
5156If 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
5161Then reproduce the problem. Wait for a few seconds, then type C-g to abort
5162the current command. Include the resulting back trace in the bug report.
5163
5164Mail 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.
5257Viper provides this variable for compatibility. Whatever the user defines
5258for 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