new version
[bpt/emacs.git] / lisp / emulation / vip.el
1 ;;; vip.el --- a VI Package for GNU Emacs
2
3 ;; Author: Masahiko Sato <ms@sail.stanford.edu>
4 ;; Version: 3.5
5 ;; Keywords: emulations
6
7 ;; This file is part of GNU Emacs.
8
9 ;; GNU Emacs is free software; you can redistribute it and/or modify
10 ;; it under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation; either version 2, or (at your option)
12 ;; any later version.
13
14 ;; GNU Emacs is distributed in the hope that it will be useful,
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ;; GNU General Public License for more details.
18
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with GNU Emacs; see the file COPYING. If not, write to the
21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22 ;; Boston, MA 02111-1307, USA.
23
24 ;;; Commentary:
25
26 ;; A full-featured vi(1) emulator.
27 ;;
28 ;; In Japan, the author's address is: masahiko@sato.riec.tohoku.junet
29 ;;
30 ;; Send suggestions and bug reports to one of the above addresses.
31 ;; When you report a bug, be sure to include the version number of VIP and
32 ;; Emacs you are using.
33
34 ;; Execute info command by typing "M-x info" to get information on VIP.
35
36 ;;; Code:
37
38 ;; external variables
39
40 (defvar vip-emacs-local-map nil
41 "Local map used in emacs mode. (Buffer-specific.)")
42
43 (defvar vip-insert-local-map nil
44 "Local map used in insert command mode. (Buffer-specific.)")
45
46 (make-variable-buffer-local 'vip-emacs-local-map)
47 (make-variable-buffer-local 'vip-insert-local-map)
48
49 (defvar vip-insert-point nil
50 "Remember insert point as a marker. (Buffer-specific.)")
51
52 (set-default 'vip-insert-point (make-marker))
53 (make-variable-buffer-local 'vip-insert-point)
54
55 (defvar vip-com-point nil
56 "Remember com point as a marker. (Buffer-specific.)")
57
58 (set-default 'vip-com-point (make-marker))
59 (make-variable-buffer-local 'vip-com-point)
60
61 (defvar vip-current-mode nil
62 "Current mode. One of `emacs-mode', `vi-mode', `insert-mode'.")
63
64 (make-variable-buffer-local 'vip-current-mode)
65 (setq-default vip-current-mode 'emacs-mode)
66
67 (defvar vip-emacs-mode-line-buffer-identification nil
68 "Value of mode-line-buffer-identification in Emacs mode within vip.")
69 (make-variable-buffer-local 'vip-emacs-mode-line-buffer-identification)
70 (setq-default vip-emacs-mode-line-buffer-identification
71 '("Emacs: %17b"))
72
73 (defvar vip-current-major-mode nil
74 "vip-current-major-mode is the major-mode vi considers it is now.
75 \(buffer specific\)")
76
77 (make-variable-buffer-local 'vip-current-major-mode)
78
79 (defvar vip-last-shell-com nil
80 "Last shell command executed by ! command.")
81
82 (defvar vip-use-register nil
83 "Name of register to store deleted or yanked strings.")
84
85 (defvar vip-d-com nil
86 "How to reexecute last destructive command. Value is list (M-COM VAL COM).")
87
88 (defconst vip-shift-width 8
89 "*The number of columns shifted by > and < command.")
90
91 (defconst vip-re-replace nil
92 "*If t then do regexp replace, if nil then do string replace.")
93
94 (defvar vip-d-char nil
95 "The character remembered by the vi \"r\" command.")
96
97 (defvar vip-f-char nil
98 "For use by \";\" command.")
99
100 (defvar vip-F-char nil
101 "For use by \".\" command.")
102
103 (defvar vip-f-forward nil
104 "For use by \";\" command.")
105
106 (defvar vip-f-offset nil
107 "For use by \";\" command.")
108
109 (defconst vip-search-wrap-around t
110 "*if t, search wraps around.")
111
112 (defconst vip-re-search nil
113 "*if t, search is reg-exp search, otherwise vanilla search.")
114
115 (defvar vip-s-string nil
116 "Last vip search string.")
117
118 (defvar vip-s-forward nil
119 "If t, search is forward.")
120
121 (defconst vip-case-fold-search nil
122 "*If t, search ignores cases.")
123
124 (defconst vip-re-query-replace nil
125 "*If t then do regexp replace, if nil then do string replace.")
126
127 (defconst vip-open-with-indent nil
128 "*If t, indent when open a new line.")
129
130 (defconst vip-help-in-insert-mode nil
131 "*If t then C-h is bound to help-command in insert mode.
132 If nil then it is bound to `delete-backward-char'.")
133
134 (defvar vip-quote-string "> "
135 "String inserted at the beginning of region.")
136
137 (defvar vip-tags-file-name "TAGS")
138
139 (defvar vip-inhibit-startup-message nil)
140
141 (defvar vip-startup-file (convert-standard-filename "~/.vip")
142 "Filename used as startup file for vip.")
143 \f
144 ;; key bindings
145
146 (defvar vip-mode-map (make-keymap))
147
148 (define-key vip-mode-map "\C-a" 'beginning-of-line)
149 (define-key vip-mode-map "\C-b" 'vip-scroll-back)
150 (define-key vip-mode-map "\C-c" 'vip-ctl-c)
151 (define-key vip-mode-map "\C-d" 'vip-scroll-up)
152 (define-key vip-mode-map "\C-e" 'vip-scroll-up-one)
153 (define-key vip-mode-map "\C-f" 'vip-scroll)
154 (define-key vip-mode-map "\C-g" 'vip-keyboard-quit)
155 (define-key vip-mode-map "\C-h" 'help-command)
156 (define-key vip-mode-map "\C-m" 'vip-scroll-back)
157 (define-key vip-mode-map "\C-n" 'vip-other-window)
158 (define-key vip-mode-map "\C-o" 'vip-open-line-at-point)
159 (define-key vip-mode-map "\C-u" 'vip-scroll-down)
160 (define-key vip-mode-map "\C-x" 'vip-ctl-x)
161 (define-key vip-mode-map "\C-y" 'vip-scroll-down-one)
162 (define-key vip-mode-map "\C-z" 'vip-change-mode-to-emacs)
163 (define-key vip-mode-map "\e" 'vip-ESC)
164
165 (define-key vip-mode-map " " 'vip-scroll)
166 (define-key vip-mode-map "!" 'vip-command-argument)
167 (define-key vip-mode-map "\"" 'vip-command-argument)
168 (define-key vip-mode-map "#" 'vip-command-argument)
169 (define-key vip-mode-map "$" 'vip-goto-eol)
170 (define-key vip-mode-map "%" 'vip-paren-match)
171 (define-key vip-mode-map "&" 'vip-nil)
172 (define-key vip-mode-map "'" 'vip-goto-mark-and-skip-white)
173 (define-key vip-mode-map "(" 'vip-backward-sentence)
174 (define-key vip-mode-map ")" 'vip-forward-sentence)
175 (define-key vip-mode-map "*" 'call-last-kbd-macro)
176 (define-key vip-mode-map "+" 'vip-next-line-at-bol)
177 (define-key vip-mode-map "," 'vip-repeat-find-opposite)
178 (define-key vip-mode-map "-" 'vip-previous-line-at-bol)
179 (define-key vip-mode-map "." 'vip-repeat)
180 (define-key vip-mode-map "/" 'vip-search-forward)
181
182 (define-key vip-mode-map "0" 'vip-beginning-of-line)
183 (define-key vip-mode-map "1" 'vip-digit-argument)
184 (define-key vip-mode-map "2" 'vip-digit-argument)
185 (define-key vip-mode-map "3" 'vip-digit-argument)
186 (define-key vip-mode-map "4" 'vip-digit-argument)
187 (define-key vip-mode-map "5" 'vip-digit-argument)
188 (define-key vip-mode-map "6" 'vip-digit-argument)
189 (define-key vip-mode-map "7" 'vip-digit-argument)
190 (define-key vip-mode-map "8" 'vip-digit-argument)
191 (define-key vip-mode-map "9" 'vip-digit-argument)
192
193 (define-key vip-mode-map ":" 'vip-ex)
194 (define-key vip-mode-map ";" 'vip-repeat-find)
195 (define-key vip-mode-map "<" 'vip-command-argument)
196 (define-key vip-mode-map "=" 'vip-command-argument)
197 (define-key vip-mode-map ">" 'vip-command-argument)
198 (define-key vip-mode-map "?" 'vip-search-backward)
199 (define-key vip-mode-map "@" 'vip-nil)
200
201 (define-key vip-mode-map "A" 'vip-Append)
202 (define-key vip-mode-map "B" 'vip-backward-Word)
203 (define-key vip-mode-map "C" 'vip-ctl-c-equivalent)
204 (define-key vip-mode-map "D" 'vip-kill-line)
205 (define-key vip-mode-map "E" 'vip-end-of-Word)
206 (define-key vip-mode-map "F" 'vip-find-char-backward)
207 (define-key vip-mode-map "G" 'vip-goto-line)
208 (define-key vip-mode-map "H" 'vip-window-top)
209 (define-key vip-mode-map "I" 'vip-Insert)
210 (define-key vip-mode-map "J" 'vip-join-lines)
211 (define-key vip-mode-map "K" 'vip-kill-buffer)
212 (define-key vip-mode-map "L" 'vip-window-bottom)
213 (define-key vip-mode-map "M" 'vip-window-middle)
214 (define-key vip-mode-map "N" 'vip-search-Next)
215 (define-key vip-mode-map "O" 'vip-Open-line)
216 (define-key vip-mode-map "P" 'vip-Put-back)
217 (define-key vip-mode-map "Q" 'vip-query-replace)
218 (define-key vip-mode-map "R" 'vip-replace-string)
219 (define-key vip-mode-map "S" 'vip-switch-to-buffer-other-window)
220 (define-key vip-mode-map "T" 'vip-goto-char-backward)
221 (define-key vip-mode-map "U" 'vip-nil)
222 (define-key vip-mode-map "V" 'vip-find-file-other-window)
223 (define-key vip-mode-map "W" 'vip-forward-Word)
224 (define-key vip-mode-map "X" 'vip-ctl-x-equivalent)
225 (define-key vip-mode-map "Y" 'vip-yank-line)
226 (define-key vip-mode-map "ZZ" 'save-buffers-kill-emacs)
227
228 (define-key vip-mode-map "[" 'vip-nil)
229 (define-key vip-mode-map "\\" 'vip-escape-to-emacs)
230 (define-key vip-mode-map "]" 'vip-nil)
231 (define-key vip-mode-map "^" 'vip-bol-and-skip-white)
232 (define-key vip-mode-map "_" 'vip-nil)
233 (define-key vip-mode-map "`" 'vip-goto-mark)
234
235 (define-key vip-mode-map "a" 'vip-append)
236 (define-key vip-mode-map "b" 'vip-backward-word)
237 (define-key vip-mode-map "c" 'vip-command-argument)
238 (define-key vip-mode-map "d" 'vip-command-argument)
239 (define-key vip-mode-map "e" 'vip-end-of-word)
240 (define-key vip-mode-map "f" 'vip-find-char-forward)
241 (define-key vip-mode-map "g" 'vip-info-on-file)
242 (define-key vip-mode-map "h" 'vip-backward-char)
243 (define-key vip-mode-map "i" 'vip-insert)
244 (define-key vip-mode-map "j" 'vip-next-line)
245 (define-key vip-mode-map "k" 'vip-previous-line)
246 (define-key vip-mode-map "l" 'vip-forward-char)
247 (define-key vip-mode-map "m" 'vip-mark-point)
248 (define-key vip-mode-map "n" 'vip-search-next)
249 (define-key vip-mode-map "o" 'vip-open-line)
250 (define-key vip-mode-map "p" 'vip-put-back)
251 (define-key vip-mode-map "q" 'vip-nil)
252 (define-key vip-mode-map "r" 'vip-replace-char)
253 (define-key vip-mode-map "s" 'vip-switch-to-buffer)
254 (define-key vip-mode-map "t" 'vip-goto-char-forward)
255 (define-key vip-mode-map "u" 'vip-undo)
256 (define-key vip-mode-map "v" 'vip-find-file)
257 (define-key vip-mode-map "w" 'vip-forward-word)
258 (define-key vip-mode-map "x" 'vip-delete-char)
259 (define-key vip-mode-map "y" 'vip-command-argument)
260 (define-key vip-mode-map "zH" 'vip-line-to-top)
261 (define-key vip-mode-map "zM" 'vip-line-to-middle)
262 (define-key vip-mode-map "zL" 'vip-line-to-bottom)
263 (define-key vip-mode-map "z\C-m" 'vip-line-to-top)
264 (define-key vip-mode-map "z." 'vip-line-to-middle)
265 (define-key vip-mode-map "z-" 'vip-line-to-bottom)
266
267 (define-key vip-mode-map "{" 'vip-backward-paragraph)
268 (define-key vip-mode-map "|" 'vip-goto-col)
269 (define-key vip-mode-map "}" 'vip-forward-paragraph)
270 (define-key vip-mode-map "~" 'vip-nil)
271 (define-key vip-mode-map "\177" 'vip-delete-backward-char)
272
273 (define-key ctl-x-map "3" 'vip-buffer-in-two-windows)
274 (define-key ctl-x-map "\C-i" 'insert-file)
275
276 (defun vip-version ()
277 (interactive)
278 (message "VIP version 3.5 of September 15, 1987"))
279
280 \f
281 ;; basic set up
282
283 (global-set-key "\C-z" 'vip-change-mode-to-vi)
284
285 (defmacro vip-loop (count body)
286 "(COUNT BODY) Execute BODY COUNT times."
287 (list 'let (list (list 'count count))
288 (list 'while (list '> 'count 0)
289 body
290 (list 'setq 'count (list '1- 'count)))))
291
292 (defun vip-push-mark-silent (&optional location)
293 "Set mark at LOCATION (point, by default) and push old mark on mark ring.
294 No message."
295 (if (null (mark t))
296 nil
297 (setq mark-ring (cons (copy-marker (mark-marker)) mark-ring))
298 (if (> (length mark-ring) mark-ring-max)
299 (progn
300 (move-marker (car (nthcdr mark-ring-max mark-ring)) nil)
301 (setcdr (nthcdr (1- mark-ring-max) mark-ring) nil))))
302 (set-mark (or location (point))))
303
304 (defun vip-goto-col (arg)
305 "Go to ARG's column."
306 (interactive "P")
307 (let ((val (vip-p-val arg))
308 (com (vip-getcom arg)))
309 (save-excursion
310 (end-of-line)
311 (if (> val (1+ (current-column))) (error "")))
312 (if com (move-marker vip-com-point (point)))
313 (beginning-of-line)
314 (forward-char (1- val))
315 (if com (vip-execute-com 'vip-goto-col val com))))
316
317 (defun vip-copy-keymap (map)
318 (if (null map) (make-sparse-keymap) (copy-keymap map)))
319
320 \f
321 ;; changing mode
322
323 (defun vip-change-mode (new-mode)
324 "Change mode to NEW-MODE---either emacs-mode, vi-mode, or insert-mode."
325 (or (eq new-mode vip-current-mode)
326 (progn
327 (cond ((eq new-mode 'vi-mode)
328 (if (eq vip-current-mode 'insert-mode)
329 (progn
330 (vip-copy-region-as-kill (point) vip-insert-point)
331 (vip-repeat-insert-command))
332 (setq vip-emacs-local-map (current-local-map)
333 vip-emacs-mode-line-buffer-identification
334 mode-line-buffer-identification
335 vip-insert-local-map (vip-copy-keymap
336 (current-local-map))))
337 (vip-change-mode-line "Vi: ")
338 (use-local-map vip-mode-map))
339 ((eq new-mode 'insert-mode)
340 (move-marker vip-insert-point (point))
341 (if (eq vip-current-mode 'emacs-mode)
342 (setq vip-emacs-local-map (current-local-map)
343 vip-emacs-mode-line-buffer-identification
344 mode-line-buffer-identification
345 vip-insert-local-map (vip-copy-keymap
346 (current-local-map)))
347 (setq vip-insert-local-map (vip-copy-keymap
348 vip-emacs-local-map)))
349 (vip-change-mode-line "Insert")
350 (use-local-map vip-insert-local-map)
351 (define-key vip-insert-local-map "\e" 'vip-change-mode-to-vi)
352 (define-key vip-insert-local-map "\C-z" 'vip-ESC)
353 (define-key vip-insert-local-map "\C-h"
354 (if vip-help-in-insert-mode 'help-command
355 'delete-backward-char))
356 (define-key vip-insert-local-map "\C-w"
357 'vip-delete-backward-word))
358 ((eq new-mode 'emacs-mode)
359 (vip-change-mode-line "Emacs:")
360 (use-local-map vip-emacs-local-map)))
361 (setq vip-current-mode new-mode)
362 (force-mode-line-update))))
363
364 (defun vip-copy-region-as-kill (beg end)
365 "If BEG and END do not belong to the same buffer, it copies empty region."
366 (condition-case nil
367 (copy-region-as-kill beg end)
368 (error (copy-region-as-kill beg beg))))
369
370 (defun vip-change-mode-line (string)
371 "Assuming that the mode line format contains the string \"Emacs:\", this
372 function replaces the string by \"Vi: \" etc."
373 (setq mode-line-buffer-identification
374 (if (string= string "Emacs:")
375 vip-emacs-mode-line-buffer-identification
376 (list (concat string " %17b")))))
377
378 ;;;###autoload
379 (defun vip-mode ()
380 "Turn on VIP emulation of VI."
381 (interactive)
382 (if (not vip-inhibit-startup-message)
383 (progn
384 (switch-to-buffer "VIP Startup Message")
385 (erase-buffer)
386 (insert
387 "VIP is a Vi emulation package for GNU Emacs. VIP provides most Vi commands
388 including Ex commands. VIP is however different from Vi in several points.
389 You can get more information on VIP by:
390 1. Typing `M-x info' and selecting menu item \"vip\".
391 2. Typing `C-h k' followed by a key whose description you want.
392 3. Printing VIP manual which can be found as GNU/man/vip.texinfo
393 4. Printing VIP Reference Card which can be found as GNU/etc/vipcard.tex
394
395 This startup message appears whenever you load VIP unless you type `y' now.
396 Type `n' to quit this window for now.\n")
397 (goto-char (point-min))
398 (if (y-or-n-p "Inhibit VIP startup message? ")
399 (progn
400 (save-excursion
401 (set-buffer
402 (find-file-noselect
403 (substitute-in-file-name vip-startup-file)))
404 (goto-char (point-max))
405 (insert "\n(setq vip-inhibit-startup-message t)\n")
406 (save-buffer)
407 (kill-buffer (current-buffer)))
408 (message "VIP startup message inhibited.")
409 (sit-for 2)))
410 (kill-buffer (current-buffer))
411 (message "")
412 (setq vip-inhibit-startup-message t)))
413 (vip-change-mode-to-vi))
414
415 (defun vip-change-mode-to-vi ()
416 "Change mode to vi mode."
417 (interactive)
418 (vip-change-mode 'vi-mode))
419
420 (defun vip-change-mode-to-insert ()
421 "Change mode to insert mode."
422 (interactive)
423 (vip-change-mode 'insert-mode))
424
425 (defun vip-change-mode-to-emacs ()
426 "Change mode to emacs mode."
427 (interactive)
428 (vip-change-mode 'emacs-mode))
429
430 \f
431 ;; escape to emacs mode temporarily
432
433 (defun vip-escape-to-emacs (arg &optional events)
434 "Escape to Emacs mode for one Emacs command.
435 ARG is used as the prefix value for the executed command. If
436 EVENTS is a list of events, which become the beginning of the command."
437 (interactive "P")
438 (let (com key (old-map (current-local-map)))
439 (if events (setq unread-command-events events))
440 (setq prefix-arg arg)
441 (use-local-map vip-emacs-local-map)
442 (unwind-protect
443 (setq com (key-binding (setq key (read-key-sequence nil))))
444 (use-local-map old-map))
445 (command-execute com prefix-arg)
446 (setq prefix-arg nil) ;; reset prefix arg
447 ))
448
449 (defun vip-message-conditions (conditions)
450 "Print CONDITIONS as a message."
451 (let ((case (car conditions)) (msg (cdr conditions)))
452 (if (null msg)
453 (message "%s" case)
454 (message "%s %s" case (prin1-to-string msg)))
455 (ding)))
456
457 (defun vip-ESC (arg)
458 "Emulate ESC key in Emacs mode."
459 (interactive "P")
460 (vip-escape-to-emacs arg '(?\e)))
461
462 (defun vip-ctl-c (arg)
463 "Emulate C-c key in Emacs mode."
464 (interactive "P")
465 (vip-escape-to-emacs arg '(?\C-c)))
466
467 (defun vip-ctl-x (arg)
468 "Emulate C-x key in Emacs mode."
469 (interactive "P")
470 (vip-escape-to-emacs arg '(?\C-x)))
471
472 (defun vip-ctl-h (arg)
473 "Emulate C-h key in Emacs mode."
474 (interactive "P")
475 (vip-escape-to-emacs arg '(?\C-h)))
476
477 \f
478 ;; prefix argument for vi mode
479
480 ;; In vi mode, prefix argument is a dotted pair (NUM . COM) where NUM
481 ;; represents the numeric value of the prefix argument and COM represents
482 ;; command prefix such as "c", "d", "m" and "y".
483
484 (defun vip-prefix-arg-value (char value com)
485 "Compute numeric prefix arg value. Invoked by CHAR. VALUE is the value
486 obtained so far, and COM is the command part obtained so far."
487 (while (and (>= char ?0) (<= char ?9))
488 (setq value (+ (* (if (numberp value) value 0) 10) (- char ?0)))
489 (setq char (read-char)))
490 (setq prefix-arg value)
491 (if com (setq prefix-arg (cons prefix-arg com)))
492 (while (= char ?U)
493 (vip-describe-arg prefix-arg)
494 (setq char (read-char)))
495 (setq unread-command-events (list char)))
496
497 (defun vip-prefix-arg-com (char value com)
498 "Vi operator as prefix argument."
499 (let ((cont t))
500 (while (and cont
501 (or (= char ?c) (= char ?d) (= char ?y)
502 (= char ?!) (= char ?<) (= char ?>) (= char ?=)
503 (= char ?#) (= char ?r) (= char ?R) (= char ?\")))
504 (if com
505 ;; this means that we already have a command character, so we
506 ;; construct a com list and exit while. however, if char is "
507 ;; it is an error.
508 (progn
509 ;; new com is (CHAR . OLDCOM)
510 (if (or (= char ?#) (= char ?\")) (error ""))
511 (setq com (cons char com))
512 (setq cont nil))
513 ;; if com is nil we set com as char, and read more. again, if char
514 ;; is ", we read the name of register and store it in vip-use-register.
515 ;; if char is !, =, or #, a complete com is formed so we exit while.
516 (cond ((or (= char ?!) (= char ?=))
517 (setq com char)
518 (setq char (read-char))
519 (setq cont nil))
520 ((= char ?#)
521 ;; read a char and encode it as com
522 (setq com (+ 128 (read-char)))
523 (setq char (read-char))
524 (setq cont nil))
525 ((or (= char ?<) (= char ?>))
526 (setq com char)
527 (setq char (read-char))
528 (if (= com char) (setq com (cons char com)))
529 (setq cont nil))
530 ((= char ?\")
531 (let ((reg (read-char)))
532 (if (or (and (<= ?A reg) (<= reg ?z))
533 (and (<= ?1 reg) (<= reg ?9)))
534 (setq vip-use-register reg)
535 (error ""))
536 (setq char (read-char))))
537 (t
538 (setq com char)
539 (setq char (read-char)))))))
540 (if (atom com)
541 ;; com is a single char, so we construct prefix-arg
542 ;; and if char is ?, describe prefix arg, otherwise exit by
543 ;; pushing the char back
544 (progn
545 (setq prefix-arg (cons value com))
546 (while (= char ?U)
547 (vip-describe-arg prefix-arg)
548 (setq char (read-char)))
549 (setq unread-command-events (list char)))
550 ;; as com is non-nil, this means that we have a command to execute
551 (if (or (= (car com) ?r) (= (car com) ?R))
552 ;; execute appropriate region command.
553 (let ((char (car com)) (com (cdr com)))
554 (setq prefix-arg (cons value com))
555 (if (= char ?r) (vip-region prefix-arg)
556 (vip-Region prefix-arg))
557 ;; reset prefix-arg
558 (setq prefix-arg nil))
559 ;; otherwise, reset prefix arg and call appropriate command
560 (setq value (if (null value) 1 value))
561 (setq prefix-arg nil)
562 (cond ((equal com '(?c . ?c)) (vip-line (cons value ?C)))
563 ((equal com '(?d . ?d)) (vip-line (cons value ?D)))
564 ((equal com '(?d . ?y)) (vip-yank-defun))
565 ((equal com '(?y . ?y)) (vip-line (cons value ?Y)))
566 ((equal com '(?< . ?<)) (vip-line (cons value ?<)))
567 ((equal com '(?> . ?>)) (vip-line (cons value ?>)))
568 ((equal com '(?! . ?!)) (vip-line (cons value ?!)))
569 ((equal com '(?= . ?=)) (vip-line (cons value ?=)))
570 (t (error ""))))))
571
572 (defun vip-describe-arg (arg)
573 (let (val com)
574 (setq val (vip-P-val arg)
575 com (vip-getcom arg))
576 (if (null val)
577 (if (null com)
578 (message "Value is nil, and command is nil.")
579 (message "Value is nil, and command is %c." com))
580 (if (null com)
581 (message "Value is %d, and command is nil." val)
582 (message "Value is %d, and command is %c." val com)))))
583
584 (defun vip-digit-argument (arg)
585 "Begin numeric argument for the next command."
586 (interactive "P")
587 (vip-prefix-arg-value last-command-char nil
588 (if (consp arg) (cdr arg) nil)))
589
590 (defun vip-command-argument (arg)
591 "Accept a motion command as an argument."
592 (interactive "P")
593 (condition-case conditions
594 (vip-prefix-arg-com
595 last-command-char
596 (cond ((null arg) nil)
597 ((consp arg) (car arg))
598 ((numberp arg) arg)
599 (t (error "strange arg")))
600 (cond ((null arg) nil)
601 ((consp arg) (cdr arg))
602 ((numberp arg) nil)
603 (t (error "strange arg"))))
604 (quit
605 (setq vip-use-register nil)
606 (signal 'quit nil))))
607
608 (defun vip-p-val (arg)
609 "Get value part of prefix-argument ARG."
610 (cond ((null arg) 1)
611 ((consp arg) (if (null (car arg)) 1 (car arg)))
612 (t arg)))
613
614 (defun vip-P-val (arg)
615 "Get value part of prefix-argument ARG."
616 (cond ((consp arg) (car arg))
617 (t arg)))
618
619 (defun vip-getcom (arg)
620 "Get com part of prefix-argument ARG."
621 (cond ((null arg) nil)
622 ((consp arg) (cdr arg))
623 (t nil)))
624
625 (defun vip-getCom (arg)
626 "Get com part of prefix-argument ARG and modify it."
627 (let ((com (vip-getcom arg)))
628 (cond ((equal com ?c) ?C)
629 ((equal com ?d) ?D)
630 ((equal com ?y) ?Y)
631 (t com))))
632
633 \f
634 ;; repeat last destructive command
635
636 (defun vip-append-to-register (reg start end)
637 "Append region to text in register REG.
638 START and END are buffer positions indicating what to append."
639 (set-register reg (concat (or (get-register reg) "")
640 (buffer-substring start end))))
641
642 (defun vip-execute-com (m-com val com)
643 "(M-COM VAL COM) Execute command COM. The list (M-COM VAL COM) is set
644 to vip-d-com for later use by vip-repeat"
645 (let ((reg vip-use-register))
646 (if com
647 (cond ((= com ?c) (vip-change vip-com-point (point)))
648 ((= com (- ?c)) (vip-change-subr vip-com-point (point)))
649 ((or (= com ?C) (= com (- ?C)))
650 (save-excursion
651 (set-mark vip-com-point)
652 (vip-enlarge-region (mark) (point))
653 (if vip-use-register
654 (progn
655 (cond ((and (<= ?a vip-use-register)
656 (<= vip-use-register ?z))
657 (copy-to-register
658 vip-use-register (mark) (point) nil))
659 ((and (<= ?A vip-use-register)
660 (<= vip-use-register ?Z))
661 (vip-append-to-register
662 (+ vip-use-register 32) (mark) (point)))
663 (t (setq vip-use-register nil)
664 (error "")))
665 (setq vip-use-register nil)))
666 (delete-region (mark) (point)))
667 (open-line 1)
668 (if (= com ?C) (vip-change-mode-to-insert) (yank)))
669 ((= com ?d)
670 (if vip-use-register
671 (progn
672 (cond ((and (<= ?a vip-use-register)
673 (<= vip-use-register ?z))
674 (copy-to-register
675 vip-use-register vip-com-point (point) nil))
676 ((and (<= ?A vip-use-register)
677 (<= vip-use-register ?Z))
678 (vip-append-to-register
679 (+ vip-use-register 32) vip-com-point (point)))
680 (t (setq vip-use-register nil)
681 (error "")))
682 (setq vip-use-register nil)))
683 (setq last-command
684 (if (eq last-command 'd-command) 'kill-region nil))
685 (kill-region vip-com-point (point))
686 (setq this-command 'd-command))
687 ((= com ?D)
688 (save-excursion
689 (set-mark vip-com-point)
690 (vip-enlarge-region (mark) (point))
691 (if vip-use-register
692 (progn
693 (cond ((and (<= ?a vip-use-register)
694 (<= vip-use-register ?z))
695 (copy-to-register
696 vip-use-register (mark) (point) nil))
697 ((and (<= ?A vip-use-register)
698 (<= vip-use-register ?Z))
699 (vip-append-to-register
700 (+ vip-use-register 32) (mark) (point)))
701 (t (setq vip-use-register nil)
702 (error "")))
703 (setq vip-use-register nil)))
704 (setq last-command
705 (if (eq last-command 'D-command) 'kill-region nil))
706 (kill-region (mark) (point))
707 (if (eq m-com 'vip-line) (setq this-command 'D-command)))
708 (back-to-indentation))
709 ((= com ?y)
710 (if vip-use-register
711 (progn
712 (cond ((and (<= ?a vip-use-register)
713 (<= vip-use-register ?z))
714 (copy-to-register
715 vip-use-register vip-com-point (point) nil))
716 ((and (<= ?A vip-use-register)
717 (<= vip-use-register ?Z))
718 (vip-append-to-register
719 (+ vip-use-register 32) vip-com-point (point)))
720 (t (setq vip-use-register nil)
721 (error "")))
722 (setq vip-use-register nil)))
723 (setq last-command nil)
724 (copy-region-as-kill vip-com-point (point))
725 (goto-char vip-com-point))
726 ((= com ?Y)
727 (save-excursion
728 (set-mark vip-com-point)
729 (vip-enlarge-region (mark) (point))
730 (if vip-use-register
731 (progn
732 (cond ((and (<= ?a vip-use-register)
733 (<= vip-use-register ?z))
734 (copy-to-register
735 vip-use-register (mark) (point) nil))
736 ((and (<= ?A vip-use-register)
737 (<= vip-use-register ?Z))
738 (vip-append-to-register
739 (+ vip-use-register 32) (mark) (point)))
740 (t (setq vip-use-register nil)
741 (error "")))
742 (setq vip-use-register nil)))
743 (setq last-command nil)
744 (copy-region-as-kill (mark) (point)))
745 (goto-char vip-com-point))
746 ((or (= com ?!) (= com (- ?!)))
747 (save-excursion
748 (set-mark vip-com-point)
749 (vip-enlarge-region (mark) (point))
750 (shell-command-on-region
751 (mark) (point)
752 (if (= com ?!)
753 (setq vip-last-shell-com (vip-read-string "!"))
754 vip-last-shell-com)
755 t)))
756 ((= com ?=)
757 (save-excursion
758 (set-mark vip-com-point)
759 (vip-enlarge-region (mark) (point))
760 (if (> (mark) (point)) (exchange-point-and-mark))
761 (indent-region (mark) (point) nil)))
762 ((= com ?<)
763 (save-excursion
764 (set-mark vip-com-point)
765 (vip-enlarge-region (mark) (point))
766 (indent-rigidly (mark) (point) (- vip-shift-width)))
767 (goto-char vip-com-point))
768 ((= com ?>)
769 (save-excursion
770 (set-mark vip-com-point)
771 (vip-enlarge-region (mark) (point))
772 (indent-rigidly (mark) (point) vip-shift-width))
773 (goto-char vip-com-point))
774 ((>= com 128)
775 ;; this is special command #
776 (vip-special-prefix-com (- com 128)))))
777 (setq vip-d-com (list m-com val (if (or (= com ?c) (= com ?C) (= com ?!))
778 (- com) com)
779 reg))))
780
781 (defun vip-repeat (arg)
782 "(ARG) Re-execute last destructive command. vip-d-com has the form
783 \(COM ARG CH REG), where COM is the command to be re-executed, ARG is the
784 argument for COM, CH is a flag for repeat, and REG is optional and if exists
785 is the name of the register for COM."
786 (interactive "P")
787 (if (eq last-command 'vip-undo)
788 ;; if the last command was vip-undo, then undo-more
789 (vip-undo-more)
790 ;; otherwise execute the command stored in vip-d-com. if arg is non-nil
791 ;; its prefix value is used as new prefix value for the command.
792 (let ((m-com (car vip-d-com))
793 (val (vip-P-val arg))
794 (com (car (cdr (cdr vip-d-com))))
795 (reg (nth 3 vip-d-com)))
796 (if (null val) (setq val (car (cdr vip-d-com))))
797 (if (null m-com) (error "No previous command to repeat."))
798 (setq vip-use-register reg)
799 (funcall m-com (cons val com)))))
800
801 (defun vip-special-prefix-com (char)
802 "This command is invoked interactively by the key sequence #<char>"
803 (cond ((= char ?c)
804 (downcase-region (min vip-com-point (point))
805 (max vip-com-point (point))))
806 ((= char ?C)
807 (upcase-region (min vip-com-point (point))
808 (max vip-com-point (point))))
809 ((= char ?g)
810 (set-mark vip-com-point)
811 (vip-global-execute))
812 ((= char ?q)
813 (set-mark vip-com-point)
814 (vip-quote-region))
815 ((= char ?s) (spell-region vip-com-point (point)))))
816
817 \f
818 ;; undoing
819
820 (defun vip-undo ()
821 "Undo previous change."
822 (interactive)
823 (message "undo!")
824 (undo-start)
825 (undo-more 2)
826 (setq this-command 'vip-undo))
827
828 (defun vip-undo-more ()
829 "Continue undoing previous changes."
830 (message "undo more!")
831 (undo-more 1)
832 (setq this-command 'vip-undo))
833
834 \f
835 ;; utilities
836
837 (defun vip-string-tail (str)
838 (if (or (null str) (string= str "")) nil
839 (substring str 1)))
840
841 (defun vip-yank-defun ()
842 (mark-defun)
843 (copy-region-as-kill (point) (mark)))
844
845 (defun vip-enlarge-region (beg end)
846 "Enlarge region between BEG and END."
847 (if (< beg end)
848 (progn (goto-char beg) (set-mark end))
849 (goto-char end)
850 (set-mark beg))
851 (beginning-of-line)
852 (exchange-point-and-mark)
853 (if (or (not (eobp)) (not (bolp))) (next-line 1))
854 (beginning-of-line)
855 (if (> beg end) (exchange-point-and-mark)))
856
857 (defun vip-global-execute ()
858 "Call last keyboad macro for each line in the region."
859 (if (> (point) (mark)) (exchange-point-and-mark))
860 (beginning-of-line)
861 (call-last-kbd-macro)
862 (while (< (point) (mark))
863 (forward-line 1)
864 (beginning-of-line)
865 (call-last-kbd-macro)))
866
867 (defun vip-quote-region ()
868 "Quote region by inserting the user supplied string at the beginning of
869 each line in the region."
870 (setq vip-quote-string
871 (let ((str
872 (vip-read-string (format "quote string \(default \"%s\"\): "
873 vip-quote-string))))
874 (if (string= str "") vip-quote-string str)))
875 (vip-enlarge-region (point) (mark))
876 (if (> (point) (mark)) (exchange-point-and-mark))
877 (insert vip-quote-string)
878 (beginning-of-line)
879 (forward-line 1)
880 (while (and (< (point) (mark)) (bolp))
881 (insert vip-quote-string)
882 (beginning-of-line)
883 (forward-line 1)))
884
885 (defun vip-end-with-a-newline-p (string)
886 "Check if the string ends with a newline."
887 (or (string= string "")
888 (= (aref string (1- (length string))) ?\n)))
889
890 (defvar vip-save-minibuffer-local-map)
891
892 (defun vip-read-string (prompt &optional init)
893 (setq vip-save-minibuffer-local-map (copy-keymap minibuffer-local-map))
894 (define-key minibuffer-local-map "\C-h" 'backward-char)
895 (define-key minibuffer-local-map "\C-w" 'backward-word)
896 (define-key minibuffer-local-map "\e" 'exit-minibuffer)
897 (let (str)
898 (condition-case conditions
899 (setq str (read-string prompt init))
900 (quit
901 (setq minibuffer-local-map vip-save-minibuffer-local-map)
902 (signal 'quit nil)))
903 (setq minibuffer-local-map vip-save-minibuffer-local-map)
904 str))
905
906 \f
907 ;; insertion commands
908
909 (defun vip-repeat-insert-command ()
910 "This function is called when mode changes from insertion mode to
911 vi command mode. It will repeat the insertion command if original insertion
912 command was invoked with argument > 1."
913 (let ((i-com (car vip-d-com)) (val (car (cdr vip-d-com))))
914 (if (and val (> val 1)) ;; first check that val is non-nil
915 (progn
916 (setq vip-d-com (list i-com (1- val) ?r))
917 (vip-repeat nil)
918 (setq vip-d-com (list i-com val ?r))))))
919
920 (defun vip-insert (arg) ""
921 (interactive "P")
922 (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
923 (setq vip-d-com (list 'vip-insert val ?r))
924 (if com (vip-loop val (yank))
925 (vip-change-mode-to-insert))))
926
927 (defun vip-append (arg)
928 "Append after point."
929 (interactive "P")
930 (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
931 (setq vip-d-com (list 'vip-append val ?r))
932 (if (not (eolp)) (forward-char))
933 (if (equal com ?r)
934 (vip-loop val (yank))
935 (vip-change-mode-to-insert))))
936
937 (defun vip-Append (arg)
938 "Append at end of line."
939 (interactive "P")
940 (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
941 (setq vip-d-com (list 'vip-Append val ?r))
942 (end-of-line)
943 (if (equal com ?r)
944 (vip-loop val (yank))
945 (vip-change-mode-to-insert))))
946
947 (defun vip-Insert (arg)
948 "Insert before first non-white."
949 (interactive "P")
950 (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
951 (setq vip-d-com (list 'vip-Insert val ?r))
952 (back-to-indentation)
953 (if (equal com ?r)
954 (vip-loop val (yank))
955 (vip-change-mode-to-insert))))
956
957 (defun vip-open-line (arg)
958 "Open line below."
959 (interactive "P")
960 (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
961 (setq vip-d-com (list 'vip-open-line val ?r))
962 (let ((col (current-indentation)))
963 (if (equal com ?r)
964 (vip-loop val
965 (progn
966 (end-of-line)
967 (newline 1)
968 (if vip-open-with-indent (indent-to col))
969 (yank)))
970 (end-of-line)
971 (newline 1)
972 (if vip-open-with-indent (indent-to col))
973 (vip-change-mode-to-insert)))))
974
975 (defun vip-Open-line (arg)
976 "Open line above."
977 (interactive "P")
978 (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
979 (setq vip-d-com (list 'vip-Open-line val ?r))
980 (let ((col (current-indentation)))
981 (if (equal com ?r)
982 (vip-loop val
983 (progn
984 (beginning-of-line)
985 (open-line 1)
986 (if vip-open-with-indent (indent-to col))
987 (yank)))
988 (beginning-of-line)
989 (open-line 1)
990 (if vip-open-with-indent (indent-to col))
991 (vip-change-mode-to-insert)))))
992
993 (defun vip-open-line-at-point (arg)
994 "Open line at point."
995 (interactive "P")
996 (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
997 (setq vip-d-com (list 'vip-open-line-at-point val ?r))
998 (if (equal com ?r)
999 (vip-loop val
1000 (progn
1001 (open-line 1)
1002 (yank)))
1003 (open-line 1)
1004 (vip-change-mode-to-insert))))
1005
1006 (defun vip-substitute (arg)
1007 "Substitute characters."
1008 (interactive "P")
1009 (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
1010 (save-excursion
1011 (set-mark (point))
1012 (forward-char val)
1013 (if (equal com ?r)
1014 (vip-change-subr (mark) (point))
1015 (vip-change (mark) (point))))
1016 (setq vip-d-com (list 'vip-substitute val ?r))))
1017
1018 (defun vip-substitute-line (arg)
1019 "Substitute lines."
1020 (interactive "p")
1021 (vip-line (cons arg ?C)))
1022
1023 \f
1024 ;; line command
1025
1026 (defun vip-line (arg)
1027 (let ((val (car arg)) (com (cdr arg)))
1028 (move-marker vip-com-point (point))
1029 (next-line (1- val))
1030 (vip-execute-com 'vip-line val com)))
1031
1032 (defun vip-yank-line (arg)
1033 "Yank ARG lines (in vi's sense)"
1034 (interactive "P")
1035 (let ((val (vip-p-val arg)))
1036 (vip-line (cons val ?Y))))
1037
1038 \f
1039 ;; region command
1040
1041 (defun vip-region (arg)
1042 (interactive "P")
1043 (let ((val (vip-P-val arg))
1044 (com (vip-getcom arg)))
1045 (move-marker vip-com-point (point))
1046 (exchange-point-and-mark)
1047 (vip-execute-com 'vip-region val com)))
1048
1049 (defun vip-Region (arg)
1050 (interactive "P")
1051 (let ((val (vip-P-val arg))
1052 (com (vip-getCom arg)))
1053 (move-marker vip-com-point (point))
1054 (exchange-point-and-mark)
1055 (vip-execute-com 'vip-Region val com)))
1056
1057 (defun vip-replace-char (arg)
1058 "Replace the following ARG chars by the character read."
1059 (interactive "P")
1060 (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
1061 (setq vip-d-com (list 'vip-replace-char val ?r))
1062 (vip-replace-char-subr (if (equal com ?r) vip-d-char (read-char)) val)))
1063
1064 (defun vip-replace-char-subr (char arg)
1065 (delete-char arg t)
1066 (setq vip-d-char char)
1067 (vip-loop (if (> arg 0) arg (- arg)) (insert char))
1068 (backward-char arg))
1069
1070 (defun vip-replace-string ()
1071 "Replace string. If you supply null string as the string to be replaced,
1072 the query replace mode will toggle between string replace and regexp replace."
1073 (interactive)
1074 (let (str)
1075 (setq str (vip-read-string
1076 (if vip-re-replace "Replace regexp: " "Replace string: ")))
1077 (if (string= str "")
1078 (progn
1079 (setq vip-re-replace (not vip-re-replace))
1080 (message "Replace mode changed to %s."
1081 (if vip-re-replace "regexp replace"
1082 "string replace")))
1083 (if vip-re-replace
1084 ;; (replace-regexp
1085 ;; str
1086 ;; (vip-read-string (format "Replace regexp \"%s\" with: " str)))
1087 (while (re-search-forward str nil t)
1088 (replace-match (vip-read-string
1089 (format "Replace regexp \"%s\" with: " str))
1090 nil nil))
1091 (replace-string
1092 str
1093 (vip-read-string (format "Replace \"%s\" with: " str)))))))
1094
1095 \f
1096 ;; basic cursor movement. j, k, l, m commands.
1097
1098 (defun vip-forward-char (arg)
1099 "Move point right ARG characters (left if ARG negative).On reaching end
1100 of buffer, stop and signal error."
1101 (interactive "P")
1102 (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
1103 (if com (move-marker vip-com-point (point)))
1104 (forward-char val)
1105 (if com (vip-execute-com 'vip-forward-char val com))))
1106
1107 (defun vip-backward-char (arg)
1108 "Move point left ARG characters (right if ARG negative). On reaching
1109 beginning of buffer, stop and signal error."
1110 (interactive "P")
1111 (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
1112 (if com (move-marker vip-com-point (point)))
1113 (backward-char val)
1114 (if com (vip-execute-com 'vip-backward-char val com))))
1115
1116 \f
1117 ;; word command
1118
1119 (defun vip-forward-word (arg)
1120 "Forward word."
1121 (interactive "P")
1122 (let ((val (vip-p-val arg))
1123 (com (vip-getcom arg)))
1124 (if com (move-marker vip-com-point (point)))
1125 (forward-word val)
1126 (skip-chars-forward " \t\n")
1127 (if com
1128 (progn
1129 (if (or (= com ?c) (= com (- ?c)))
1130 (progn (backward-word 1) (forward-word 1)))
1131 (if (or (= com ?d) (= com ?y))
1132 (progn
1133 (backward-word 1)
1134 (forward-word 1)
1135 (skip-chars-forward " \t")))
1136 (vip-execute-com 'vip-forward-word val com)))))
1137
1138 (defun vip-end-of-word (arg)
1139 "Move point to end of current word."
1140 (interactive "P")
1141 (let ((val (vip-p-val arg))
1142 (com (vip-getcom arg)))
1143 (if com (move-marker vip-com-point (point)))
1144 (forward-char)
1145 (forward-word val)
1146 (backward-char)
1147 (if com
1148 (progn
1149 (forward-char)
1150 (vip-execute-com 'vip-end-of-word val com)))))
1151
1152 (defun vip-backward-word (arg)
1153 "Backward word."
1154 (interactive "P")
1155 (let ((val (vip-p-val arg))
1156 (com (vip-getcom arg)))
1157 (if com (move-marker vip-com-point (point)))
1158 (backward-word val)
1159 (if com (vip-execute-com 'vip-backward-word val com))))
1160
1161 (defun vip-forward-Word (arg)
1162 "Forward word delimited by white character."
1163 (interactive "P")
1164 (let ((val (vip-p-val arg))
1165 (com (vip-getcom arg)))
1166 (if com (move-marker vip-com-point (point)))
1167 (re-search-forward "[^ \t\n]*[ \t\n]+" nil t val)
1168 (if com
1169 (progn
1170 (if (or (= com ?c) (= com (- ?c)))
1171 (progn (backward-word 1) (forward-word 1)))
1172 (if (or (= com ?d) (= com ?y))
1173 (progn
1174 (backward-word 1)
1175 (forward-word 1)
1176 (skip-chars-forward " \t")))
1177 (vip-execute-com 'vip-forward-Word val com)))))
1178
1179 (defun vip-end-of-Word (arg)
1180 "Move forward to end of word delimited by white character."
1181 (interactive "P")
1182 (let ((val (vip-p-val arg))
1183 (com (vip-getcom arg)))
1184 (if com (move-marker vip-com-point (point)))
1185 (forward-char)
1186 (if (re-search-forward "[^ \t\n]+" nil t val) (backward-char))
1187 (if com
1188 (progn
1189 (forward-char)
1190 (vip-execute-com 'vip-end-of-Word val com)))))
1191
1192 (defun vip-backward-Word (arg)
1193 "Backward word delimited by white character."
1194 (interactive "P")
1195 (let ((val (vip-p-val arg))
1196 (com (vip-getcom arg)))
1197 (if com (move-marker vip-com-point (point)))
1198 (if (re-search-backward "[ \t\n]+[^ \t\n]+" nil t val)
1199 (forward-char)
1200 (goto-char (point-min)))
1201 (if com (vip-execute-com 'vip-backward-Word val com))))
1202
1203 (defun vip-beginning-of-line (arg)
1204 "Go to beginning of line."
1205 (interactive "P")
1206 (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
1207 (if com (move-marker vip-com-point (point)))
1208 (beginning-of-line val)
1209 (if com (vip-execute-com 'vip-beginning-of-line val com))))
1210
1211 (defun vip-bol-and-skip-white (arg)
1212 "Beginning of line at first non-white character."
1213 (interactive "P")
1214 (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
1215 (if com (move-marker vip-com-point (point)))
1216 (back-to-indentation)
1217 (if com (vip-execute-com 'vip-bol-and-skip-white val com))))
1218
1219 (defun vip-goto-eol (arg)
1220 "Go to end of line."
1221 (interactive "P")
1222 (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
1223 (if com (move-marker vip-com-point (point)))
1224 (end-of-line val)
1225 (if com (vip-execute-com 'vip-goto-eol val com))))
1226
1227 (defun vip-next-line (arg)
1228 "Go to next line."
1229 (interactive "P")
1230 (let ((val (vip-p-val arg)) (com (vip-getCom arg)))
1231 (if com (move-marker vip-com-point (point)))
1232 (line-move val)
1233 (setq this-command 'next-line)
1234 (if com (vip-execute-com 'vip-next-line val com))))
1235
1236 (defun vip-next-line-at-bol (arg)
1237 "Next line at beginning of line."
1238 (interactive "P")
1239 (let ((val (vip-p-val arg)) (com (vip-getCom arg)))
1240 (if com (move-marker vip-com-point (point)))
1241 (next-line val)
1242 (back-to-indentation)
1243 (if com (vip-execute-com 'vip-next-line-at-bol val com))))
1244
1245 (defun vip-previous-line (arg)
1246 "Go to previous line."
1247 (interactive "P")
1248 (let ((val (vip-p-val arg)) (com (vip-getCom arg)))
1249 (if com (move-marker vip-com-point (point)))
1250 (next-line (- val))
1251 (setq this-command 'previous-line)
1252 (if com (vip-execute-com 'vip-previous-line val com))))
1253
1254 (defun vip-previous-line-at-bol (arg)
1255 "Previous line at beginning of line."
1256 (interactive "P")
1257 (let ((val (vip-p-val arg)) (com (vip-getCom arg)))
1258 (if com (move-marker vip-com-point (point)))
1259 (next-line (- val))
1260 (back-to-indentation)
1261 (if com (vip-execute-com 'vip-previous-line val com))))
1262
1263 (defun vip-change-to-eol (arg)
1264 "Change to end of line."
1265 (interactive "P")
1266 (vip-goto-eol (cons arg ?c)))
1267
1268 (defun vip-kill-line (arg)
1269 "Delete line."
1270 (interactive "P")
1271 (vip-goto-eol (cons arg ?d)))
1272
1273 \f
1274 ;; moving around
1275
1276 (defun vip-goto-line (arg)
1277 "Go to ARG's line. Without ARG go to end of buffer."
1278 (interactive "P")
1279 (let ((val (vip-P-val arg)) (com (vip-getCom arg)))
1280 (move-marker vip-com-point (point))
1281 (set-mark (point))
1282 (if (null val)
1283 (goto-char (point-max))
1284 (goto-char (point-min))
1285 (forward-line (1- val)))
1286 (back-to-indentation)
1287 (if com (vip-execute-com 'vip-goto-line val com))))
1288
1289 (defun vip-find-char (arg char forward offset)
1290 "Find ARG's occurrence of CHAR on the current line. If FORWARD then
1291 search is forward, otherwise backward. OFFSET is used to adjust point
1292 after search."
1293 (let ((arg (if forward arg (- arg))) point)
1294 (save-excursion
1295 (save-restriction
1296 (if (> arg 0)
1297 (narrow-to-region
1298 ;; forward search begins here
1299 (if (eolp) (error "") (point))
1300 ;; forward search ends here
1301 (progn (next-line 1) (beginning-of-line) (point)))
1302 (narrow-to-region
1303 ;; backward search begins from here
1304 (if (bolp) (error "") (point))
1305 ;; backward search ends here
1306 (progn (beginning-of-line) (point))))
1307 ;; if arg > 0, point is forwarded before search.
1308 (if (> arg 0) (goto-char (1+ (point-min)))
1309 (goto-char (point-max)))
1310 (let ((case-fold-search nil))
1311 (search-forward (char-to-string char) nil 0 arg))
1312 (setq point (point))
1313 (if (or (and (> arg 0) (= point (point-max)))
1314 (and (< arg 0) (= point (point-min))))
1315 (error ""))))
1316 (goto-char (+ point (if (> arg 0) (if offset -2 -1) (if offset 1 0))))))
1317
1318 (defun vip-find-char-forward (arg)
1319 "Find char on the line. If called interactively read the char to find
1320 from the terminal, and if called from vip-repeat, the char last used is
1321 used. This behaviour is controlled by the sign of prefix numeric value."
1322 (interactive "P")
1323 (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
1324 (if (> val 0)
1325 ;; this means that the function was called interactively
1326 (setq vip-f-char (read-char)
1327 vip-f-forward t
1328 vip-f-offset nil)
1329 (setq val (- val)))
1330 (if com (move-marker vip-com-point (point)))
1331 (vip-find-char val (if (> (vip-p-val arg) 0) vip-f-char vip-F-char) t nil)
1332 (setq val (- val))
1333 (if com
1334 (progn
1335 (setq vip-F-char vip-f-char);; set new vip-F-char
1336 (forward-char)
1337 (vip-execute-com 'vip-find-char-forward val com)))))
1338
1339 (defun vip-goto-char-forward (arg)
1340 "Go up to char ARG forward on line."
1341 (interactive "P")
1342 (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
1343 (if (> val 0)
1344 ;; this means that the function was called interactively
1345 (setq vip-f-char (read-char)
1346 vip-f-forward t
1347 vip-f-offset t)
1348 (setq val (- val)))
1349 (if com (move-marker vip-com-point (point)))
1350 (vip-find-char val (if (> (vip-p-val arg) 0) vip-f-char vip-F-char) t t)
1351 (setq val (- val))
1352 (if com
1353 (progn
1354 (setq vip-F-char vip-f-char);; set new vip-F-char
1355 (forward-char)
1356 (vip-execute-com 'vip-goto-char-forward val com)))))
1357
1358 (defun vip-find-char-backward (arg)
1359 "Find char ARG on line backward."
1360 (interactive "P")
1361 (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
1362 (if (> val 0)
1363 ;; this means that the function was called interactively
1364 (setq vip-f-char (read-char)
1365 vip-f-forward nil
1366 vip-f-offset nil)
1367 (setq val (- val)))
1368 (if com (move-marker vip-com-point (point)))
1369 (vip-find-char
1370 val (if (> (vip-p-val arg) 0) vip-f-char vip-F-char) nil nil)
1371 (setq val (- val))
1372 (if com
1373 (progn
1374 (setq vip-F-char vip-f-char);; set new vip-F-char
1375 (vip-execute-com 'vip-find-char-backward val com)))))
1376
1377 (defun vip-goto-char-backward (arg)
1378 "Go up to char ARG backward on line."
1379 (interactive "P")
1380 (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
1381 (if (> val 0)
1382 ;; this means that the function was called interactively
1383 (setq vip-f-char (read-char)
1384 vip-f-forward nil
1385 vip-f-offset t)
1386 (setq val (- val)))
1387 (if com (move-marker vip-com-point (point)))
1388 (vip-find-char val (if (> (vip-p-val arg) 0) vip-f-char vip-F-char) nil t)
1389 (setq val (- val))
1390 (if com
1391 (progn
1392 (setq vip-F-char vip-f-char);; set new vip-F-char
1393 (vip-execute-com 'vip-goto-char-backward val com)))))
1394
1395 (defun vip-repeat-find (arg)
1396 "Repeat previous find command."
1397 (interactive "P")
1398 (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
1399 (if com (move-marker vip-com-point (point)))
1400 (vip-find-char val vip-f-char vip-f-forward vip-f-offset)
1401 (if com
1402 (progn
1403 (if vip-f-forward (forward-char))
1404 (vip-execute-com 'vip-repeat-find val com)))))
1405
1406 (defun vip-repeat-find-opposite (arg)
1407 "Repeat previous find command in the opposite direction."
1408 (interactive "P")
1409 (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
1410 (if com (move-marker vip-com-point (point)))
1411 (vip-find-char val vip-f-char (not vip-f-forward) vip-f-offset)
1412 (if com
1413 (progn
1414 (if vip-f-forward (forward-char))
1415 (vip-execute-com 'vip-repeat-find-opposite val com)))))
1416
1417 \f
1418 ;; window scrolling etc.
1419
1420 (defun vip-other-window (arg)
1421 "Switch to other window."
1422 (interactive "p")
1423 (other-window arg)
1424 (or (not (eq vip-current-mode 'emacs-mode))
1425 (string= (buffer-name (current-buffer)) " *Minibuf-1*")
1426 (vip-change-mode-to-vi)))
1427
1428 (defun vip-window-top (arg)
1429 "Go to home window line."
1430 (interactive "P")
1431 (let ((val (vip-p-val arg))
1432 (com (vip-getCom arg)))
1433 (if com (move-marker vip-com-point (point)))
1434 (move-to-window-line (1- val))
1435 (if com (vip-execute-com 'vip-window-top val com))))
1436
1437 (defun vip-window-middle (arg)
1438 "Go to middle window line."
1439 (interactive "P")
1440 (let ((val (vip-p-val arg))
1441 (com (vip-getCom arg)))
1442 (if com (move-marker vip-com-point (point)))
1443 (move-to-window-line (+ (/ (1- (window-height)) 2) (1- val)))
1444 (if com (vip-execute-com 'vip-window-middle val com))))
1445
1446 (defun vip-window-bottom (arg)
1447 "Go to last window line."
1448 (interactive "P")
1449 (let ((val (vip-p-val arg))
1450 (com (vip-getCom arg)))
1451 (if com (move-marker vip-com-point (point)))
1452 (move-to-window-line (- val))
1453 (if com (vip-execute-com 'vip-window-bottom val com))))
1454
1455 (defun vip-line-to-top (arg)
1456 "Put current line on the home line."
1457 (interactive "p")
1458 (recenter (1- arg)))
1459
1460 (defun vip-line-to-middle (arg)
1461 "Put current line on the middle line."
1462 (interactive "p")
1463 (recenter (+ (1- arg) (/ (1- (window-height)) 2))))
1464
1465 (defun vip-line-to-bottom (arg)
1466 "Put current line on the last line."
1467 (interactive "p")
1468 (recenter (- (window-height) (1+ arg))))
1469
1470 \f
1471 ;; paren match
1472
1473 (defun vip-paren-match (arg)
1474 "Go to the matching parenthesis."
1475 (interactive "P")
1476 (let ((com (vip-getcom arg)))
1477 (if (numberp arg)
1478 (if (or (> arg 99) (< arg 1))
1479 (error "Prefix must be between 1 and 99.")
1480 (goto-char
1481 (if (> (point-max) 80000)
1482 (* (/ (point-max) 100) arg)
1483 (/ (* (point-max) arg) 100)))
1484 (back-to-indentation))
1485 (cond ((looking-at "[\(\[{]")
1486 (if com (move-marker vip-com-point (point)))
1487 (forward-sexp 1)
1488 (if com
1489 (vip-execute-com 'vip-paren-match nil com)
1490 (backward-char)))
1491 ((looking-at "[])}]")
1492 (forward-char)
1493 (if com (move-marker vip-com-point (point)))
1494 (backward-sexp 1)
1495 (if com (vip-execute-com 'vip-paren-match nil com)))
1496 (t (error ""))))))
1497
1498 \f
1499 ;; sentence and paragraph
1500
1501 (defun vip-forward-sentence (arg)
1502 "Forward sentence."
1503 (interactive "P")
1504 (let ((val (vip-p-val arg))
1505 (com (vip-getcom arg)))
1506 (if com (move-marker vip-com-point (point)))
1507 (forward-sentence val)
1508 (if com (vip-execute-com 'vip-forward-sentence nil com))))
1509
1510 (defun vip-backward-sentence (arg)
1511 "Backward sentence."
1512 (interactive "P")
1513 (let ((val (vip-p-val arg))
1514 (com (vip-getcom arg)))
1515 (if com (move-marker vip-com-point (point)))
1516 (backward-sentence val)
1517 (if com (vip-execute-com 'vip-backward-sentence nil com))))
1518
1519 (defun vip-forward-paragraph (arg)
1520 "Forward paragraph."
1521 (interactive "P")
1522 (let ((val (vip-p-val arg))
1523 (com (vip-getCom arg)))
1524 (if com (move-marker vip-com-point (point)))
1525 (forward-paragraph val)
1526 (if com (vip-execute-com 'vip-forward-paragraph nil com))))
1527
1528 (defun vip-backward-paragraph (arg)
1529 "Backward paragraph."
1530 (interactive "P")
1531 (let ((val (vip-p-val arg))
1532 (com (vip-getCom arg)))
1533 (if com (move-marker vip-com-point (point)))
1534 (backward-paragraph val)
1535 (if com (vip-execute-com 'vip-backward-paragraph nil com))))
1536
1537 \f
1538 ;; scrolling
1539
1540 (defun vip-scroll (arg)
1541 "Scroll to next screen."
1542 (interactive "p")
1543 (if (> arg 0)
1544 (while (> arg 0)
1545 (scroll-up)
1546 (setq arg (1- arg)))
1547 (while (> 0 arg)
1548 (scroll-down)
1549 (setq arg (1+ arg)))))
1550
1551 (defun vip-scroll-back (arg)
1552 "Scroll to previous screen."
1553 (interactive "p")
1554 (vip-scroll (- arg)))
1555
1556 (defun vip-scroll-down (arg)
1557 "Scroll up half screen."
1558 (interactive "P")
1559 (if (null arg) (scroll-down (/ (window-height) 2))
1560 (scroll-down arg)))
1561
1562 (defun vip-scroll-down-one (arg)
1563 "Scroll up one line."
1564 (interactive "p")
1565 (scroll-down arg))
1566
1567 (defun vip-scroll-up (arg)
1568 "Scroll down half screen."
1569 (interactive "P")
1570 (if (null arg) (scroll-up (/ (window-height) 2))
1571 (scroll-up arg)))
1572
1573 (defun vip-scroll-up-one (arg)
1574 "Scroll down one line."
1575 (interactive "p")
1576 (scroll-up arg))
1577
1578 \f
1579 ;; splitting window
1580
1581 (defun vip-buffer-in-two-windows ()
1582 "Show current buffer in two windows."
1583 (interactive)
1584 (delete-other-windows)
1585 (split-window-vertically nil))
1586
1587 \f
1588 ;; searching
1589
1590 (defun vip-search-forward (arg)
1591 "Search a string forward. ARG is used to find the ARG's occurrence
1592 of the string. Default is vanilla search. Search mode can be toggled by
1593 giving null search string."
1594 (interactive "P")
1595 (let ((val (vip-P-val arg)) (com (vip-getcom arg)))
1596 (setq vip-s-forward t
1597 vip-s-string (vip-read-string (if vip-re-search "RE-/" "/")))
1598 (if (string= vip-s-string "")
1599 (progn
1600 (setq vip-re-search (not vip-re-search))
1601 (message "Search mode changed to %s search."
1602 (if vip-re-search "regular expression"
1603 "vanilla")))
1604 (vip-search vip-s-string t val)
1605 (if com
1606 (progn
1607 (move-marker vip-com-point (mark))
1608 (vip-execute-com 'vip-search-next val com))))))
1609
1610 (defun vip-search-backward (arg)
1611 "Search a string backward. ARG is used to find the ARG's occurrence
1612 of the string. Default is vanilla search. Search mode can be toggled by
1613 giving null search string."
1614 (interactive "P")
1615 (let ((val (vip-P-val arg)) (com (vip-getcom arg)))
1616 (setq vip-s-forward nil
1617 vip-s-string (vip-read-string (if vip-re-search "RE-?" "?")))
1618 (if (string= vip-s-string "")
1619 (progn
1620 (setq vip-re-search (not vip-re-search))
1621 (message "Search mode changed to %s search."
1622 (if vip-re-search "regular expression"
1623 "vanilla")))
1624 (vip-search vip-s-string nil val)
1625 (if com
1626 (progn
1627 (move-marker vip-com-point (mark))
1628 (vip-execute-com 'vip-search-next val com))))))
1629
1630 (defun vip-search (string forward arg &optional no-offset init-point)
1631 "(STRING FORWARD COUNT &optional NO-OFFSET) Search COUNT's occurrence of
1632 STRING. Search will be forward if FORWARD, otherwise backward."
1633 (let ((val (vip-p-val arg)) (com (vip-getcom arg))
1634 (null-arg (null (vip-P-val arg))) (offset (not no-offset))
1635 (case-fold-search vip-case-fold-search)
1636 (start-point (or init-point (point))))
1637 (if forward
1638 (condition-case conditions
1639 (progn
1640 (if (and offset (not (eobp))) (forward-char))
1641 (if vip-re-search
1642 (progn
1643 (re-search-forward string nil nil val)
1644 (re-search-backward string))
1645 (search-forward string nil nil val)
1646 (search-backward string))
1647 (push-mark start-point))
1648 (search-failed
1649 (if (and null-arg vip-search-wrap-around)
1650 (progn
1651 (goto-char (point-min))
1652 (vip-search string forward (cons 1 com) t start-point))
1653 (goto-char start-point)
1654 (signal 'search-failed (cdr conditions)))))
1655 (condition-case conditions
1656 (progn
1657 (if vip-re-search
1658 (re-search-backward string nil nil val)
1659 (search-backward string nil nil val))
1660 (push-mark start-point))
1661 (search-failed
1662 (if (and null-arg vip-search-wrap-around)
1663 (progn
1664 (goto-char (point-max))
1665 (vip-search string forward (cons 1 com) t start-point))
1666 (goto-char start-point)
1667 (signal 'search-failed (cdr conditions))))))))
1668
1669 (defun vip-search-next (arg)
1670 "Repeat previous search."
1671 (interactive "P")
1672 (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
1673 (if (null vip-s-string) (error "No previous search string."))
1674 (vip-search vip-s-string vip-s-forward arg)
1675 (if com (vip-execute-com 'vip-search-next val com))))
1676
1677 (defun vip-search-Next (arg)
1678 "Repeat previous search in the reverse direction."
1679 (interactive "P")
1680 (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
1681 (if (null vip-s-string) (error "No previous search string."))
1682 (vip-search vip-s-string (not vip-s-forward) arg)
1683 (if com (vip-execute-com 'vip-search-Next val com))))
1684
1685 \f
1686 ;; visiting and killing files, buffers
1687
1688 (defun vip-switch-to-buffer ()
1689 "Switch to buffer in the current window."
1690 (interactive)
1691 (let (buffer)
1692 (setq buffer
1693 (read-buffer
1694 (format "switch to buffer \(%s\): "
1695 (buffer-name (other-buffer (current-buffer))))))
1696 (switch-to-buffer buffer)
1697 (vip-change-mode-to-vi)))
1698
1699 (defun vip-switch-to-buffer-other-window ()
1700 "Switch to buffer in another window."
1701 (interactive)
1702 (let (buffer)
1703 (setq buffer
1704 (read-buffer
1705 (format "Switch to buffer \(%s\): "
1706 (buffer-name (other-buffer (current-buffer))))))
1707 (switch-to-buffer-other-window buffer)
1708 (vip-change-mode-to-vi)))
1709
1710 (defun vip-kill-buffer ()
1711 "Kill a buffer."
1712 (interactive)
1713 (let (buffer buffer-name)
1714 (setq buffer-name
1715 (read-buffer
1716 (format "Kill buffer \(%s\): "
1717 (buffer-name (current-buffer)))))
1718 (setq buffer
1719 (if (null buffer-name)
1720 (current-buffer)
1721 (get-buffer buffer-name)))
1722 (if (null buffer) (error "Buffer %s nonexistent." buffer-name))
1723 (if (or (not (buffer-modified-p buffer))
1724 (y-or-n-p "Buffer is modified, are you sure? "))
1725 (kill-buffer buffer)
1726 (error "Buffer not killed."))))
1727
1728 (defun vip-find-file ()
1729 "Visit file in the current window."
1730 (interactive)
1731 (let (file)
1732 (setq file (read-file-name "visit file: "))
1733 (switch-to-buffer (find-file-noselect file))
1734 (vip-change-mode-to-vi)))
1735
1736 (defun vip-find-file-other-window ()
1737 "Visit file in another window."
1738 (interactive)
1739 (let (file)
1740 (setq file (read-file-name "Visit file: "))
1741 (switch-to-buffer-other-window (find-file-noselect file))
1742 (vip-change-mode-to-vi)))
1743
1744 (defun vip-info-on-file ()
1745 "Give information of the file associated to the current buffer."
1746 (interactive)
1747 (message "\"%s\" line %d of %d"
1748 (if (buffer-file-name) (buffer-file-name) "")
1749 (1+ (count-lines (point-min) (point)))
1750 (1+ (count-lines (point-min) (point-max)))))
1751
1752 \f
1753 ;; yank and pop
1754
1755 (defun vip-yank (text)
1756 "yank TEXT silently."
1757 (save-excursion
1758 (vip-push-mark-silent (point))
1759 (insert text)
1760 (exchange-point-and-mark))
1761 (skip-chars-forward " \t"))
1762
1763 (defun vip-put-back (arg)
1764 "Put back after point/below line."
1765 (interactive "P")
1766 (let ((val (vip-p-val arg))
1767 (text (if vip-use-register
1768 (if (and (<= ?1 vip-use-register) (<= vip-use-register ?9))
1769 (current-kill (- vip-use-register ?1) 'do-not-rotate)
1770 (get-register vip-use-register))
1771 (current-kill 0))))
1772 (if (null text)
1773 (if vip-use-register
1774 (let ((reg vip-use-register))
1775 (setq vip-use-register nil)
1776 (error "Nothing in register %c" reg))
1777 (error "")))
1778 (setq vip-use-register nil)
1779 (if (vip-end-with-a-newline-p text)
1780 (progn
1781 (next-line 1)
1782 (beginning-of-line))
1783 (if (and (not (eolp)) (not (eobp))) (forward-char)))
1784 (setq vip-d-com (list 'vip-put-back val nil vip-use-register))
1785 (vip-loop val (vip-yank text))))
1786
1787 (defun vip-Put-back (arg)
1788 "Put back at point/above line."
1789 (interactive "P")
1790 (let ((val (vip-p-val arg))
1791 (text (if vip-use-register
1792 (if (and (<= ?1 vip-use-register) (<= vip-use-register ?9))
1793 (current-kill (- vip-use-register ?1) 'do-not-rotate)
1794 (get-register vip-use-register))
1795 (current-kill 0))))
1796 (if (null text)
1797 (if vip-use-register
1798 (let ((reg vip-use-register))
1799 (setq vip-use-register nil)
1800 (error "Nothing in register %c" reg))
1801 (error "")))
1802 (setq vip-use-register nil)
1803 (if (vip-end-with-a-newline-p text) (beginning-of-line))
1804 (setq vip-d-com (list 'vip-Put-back val nil vip-use-register))
1805 (vip-loop val (vip-yank text))))
1806
1807 (defun vip-delete-char (arg)
1808 "Delete character."
1809 (interactive "P")
1810 (let ((val (vip-p-val arg)))
1811 (setq vip-d-com (list 'vip-delete-char val nil))
1812 (if vip-use-register
1813 (progn
1814 (if (and (<= ?A vip-use-register) (<= vip-use-register ?Z))
1815 (vip-append-to-register
1816 (+ vip-use-register 32) (point) (- (point) val))
1817 (copy-to-register vip-use-register (point) (- (point) val) nil))
1818 (setq vip-use-register nil)))
1819 (delete-char val t)))
1820
1821 (defun vip-delete-backward-char (arg)
1822 "Delete previous character."
1823 (interactive "P")
1824 (let ((val (vip-p-val arg)))
1825 (setq vip-d-com (list 'vip-delete-backward-char val nil))
1826 (if vip-use-register
1827 (progn
1828 (if (and (<= ?A vip-use-register) (<= vip-use-register ?Z))
1829 (vip-append-to-register
1830 (+ vip-use-register 32) (point) (+ (point) val))
1831 (copy-to-register vip-use-register (point) (+ (point) val) nil))
1832 (setq vip-use-register nil)))
1833 (delete-backward-char val t)))
1834
1835 \f
1836 ;; join lines.
1837
1838 (defun vip-join-lines (arg)
1839 "Join this line to next, if ARG is nil. Otherwise, join ARG lines"
1840 (interactive "*P")
1841 (let ((val (vip-P-val arg)))
1842 (setq vip-d-com (list 'vip-join-lines val nil))
1843 (vip-loop (if (null val) 1 (1- val))
1844 (progn
1845 (end-of-line)
1846 (if (not (eobp))
1847 (progn
1848 (forward-line 1)
1849 (delete-region (point) (1- (point)))
1850 (fixup-whitespace)))))))
1851
1852 \f
1853 ;; making small changes
1854
1855 (defvar vip-c-string)
1856
1857 (defun vip-change (beg end)
1858 (setq vip-c-string
1859 (vip-read-string (format "%s => " (buffer-substring beg end))))
1860 (vip-change-subr beg end))
1861
1862 (defun vip-change-subr (beg end)
1863 (if vip-use-register
1864 (progn
1865 (copy-to-register vip-use-register beg end nil)
1866 (setq vip-use-register nil)))
1867 (kill-region beg end)
1868 (setq this-command 'vip-change)
1869 (insert vip-c-string))
1870
1871 \f
1872 ;; query replace
1873
1874 (defun vip-query-replace ()
1875 "Query replace. If you supply null string as the string to be replaced,
1876 the query replace mode will toggle between string replace and regexp replace."
1877 (interactive)
1878 (let (str)
1879 (setq str (vip-read-string
1880 (if vip-re-query-replace "Query replace regexp: "
1881 "Query replace: ")))
1882 (if (string= str "")
1883 (progn
1884 (setq vip-re-query-replace (not vip-re-query-replace))
1885 (message "Query replace mode changed to %s."
1886 (if vip-re-query-replace "regexp replace"
1887 "string replace")))
1888 (if vip-re-query-replace
1889 (query-replace-regexp
1890 str
1891 (vip-read-string (format "Query replace regexp \"%s\" with: " str)))
1892 (query-replace
1893 str
1894 (vip-read-string (format "Query replace \"%s\" with: " str)))))))
1895
1896 \f
1897 ;; marking
1898
1899 (defun vip-mark-beginning-of-buffer ()
1900 (interactive)
1901 (set-mark (point))
1902 (goto-char (point-min))
1903 (exchange-point-and-mark)
1904 (message "mark set at the beginning of buffer"))
1905
1906 (defun vip-mark-end-of-buffer ()
1907 (interactive)
1908 (set-mark (point))
1909 (goto-char (point-max))
1910 (exchange-point-and-mark)
1911 (message "mark set at the end of buffer"))
1912
1913 (defun vip-mark-point (char)
1914 (interactive "c")
1915 (cond ((and (<= ?a char) (<= char ?z))
1916 (point-to-register (- char (- ?a ?\C-a)) nil))
1917 ((= char ?<) (vip-mark-beginning-of-buffer))
1918 ((= char ?>) (vip-mark-end-of-buffer))
1919 ((= char ?.) (push-mark))
1920 ((= char ?,) (set-mark-command 1))
1921 ((= char ?D) (mark-defun))
1922 (t (error ""))))
1923
1924 (defun vip-goto-mark (arg)
1925 "Go to mark."
1926 (interactive "P")
1927 (let ((char (read-char)) (com (vip-getcom arg)))
1928 (vip-goto-mark-subr char com nil)))
1929
1930 (defun vip-goto-mark-and-skip-white (arg)
1931 "Go to mark and skip to first non-white on line."
1932 (interactive "P")
1933 (let ((char (read-char)) (com (vip-getCom arg)))
1934 (vip-goto-mark-subr char com t)))
1935
1936 (defun vip-goto-mark-subr (char com skip-white)
1937 (cond ((and (<= ?a char) (<= char ?z))
1938 (let ((buff (current-buffer)))
1939 (if com (move-marker vip-com-point (point)))
1940 (goto-char (register-to-point (- char (- ?a ?\C-a))))
1941 (if skip-white (back-to-indentation))
1942 (vip-change-mode-to-vi)
1943 (if com
1944 (if (equal buff (current-buffer))
1945 (vip-execute-com (if skip-white
1946 'vip-goto-mark-and-skip-white
1947 'vip-goto-mark)
1948 nil com)
1949 (switch-to-buffer buff)
1950 (goto-char vip-com-point)
1951 (vip-change-mode-to-vi)
1952 (error "")))))
1953 ((and (not skip-white) (= char ?`))
1954 (if com (move-marker vip-com-point (point)))
1955 (exchange-point-and-mark)
1956 (if com (vip-execute-com 'vip-goto-mark nil com)))
1957 ((and skip-white (= char ?'))
1958 (if com (move-marker vip-com-point (point)))
1959 (exchange-point-and-mark)
1960 (back-to-indentation)
1961 (if com (vip-execute-com 'vip-goto-mark-and-skip-white nil com)))
1962 (t (error ""))))
1963
1964 (defun vip-exchange-point-and-mark ()
1965 (interactive)
1966 (exchange-point-and-mark)
1967 (back-to-indentation))
1968
1969 (defun vip-keyboard-quit ()
1970 "Abort partially formed or running command."
1971 (interactive)
1972 (setq vip-use-register nil)
1973 (keyboard-quit))
1974
1975 (defun vip-ctl-c-equivalent (arg)
1976 "Emulate C-c in Emacs mode."
1977 (interactive "P")
1978 (vip-ctl-key-equivalent "\C-c" arg))
1979
1980 (defun vip-ctl-x-equivalent (arg)
1981 "Emulate C-x in Emacs mode."
1982 (interactive "P")
1983 (vip-ctl-key-equivalent "\C-x" arg))
1984
1985 (defun vip-ctl-key-equivalent (key arg)
1986 (let ((char (read-char)))
1987 (if (and (<= ?A char) (<= char ?Z))
1988 (setq char (- char (- ?A ?\C-a))))
1989 (vip-escape-to-emacs arg (list (aref key 0) char))))
1990 \f
1991 ;; commands in insertion mode
1992
1993 (defun vip-delete-backward-word (arg)
1994 "Delete previous word."
1995 (interactive "p")
1996 (save-excursion
1997 (set-mark (point))
1998 (backward-word arg)
1999 (delete-region (point) (mark))))
2000
2001 \f
2002 ;; implement ex commands
2003
2004 (defvar ex-token-type nil
2005 "type of token. if non-nil, gives type of address. if nil, it
2006 is a command.")
2007
2008 (defvar ex-token nil
2009 "value of token.")
2010
2011 (defvar ex-addresses nil
2012 "list of ex addresses")
2013
2014 (defvar ex-flag nil
2015 "flag for ex flag")
2016
2017 (defvar ex-buffer nil
2018 "name of ex buffer")
2019
2020 (defvar ex-count nil
2021 "value of ex count")
2022
2023 (defvar ex-g-flag nil
2024 "flag for global command")
2025
2026 (defvar ex-g-variant nil
2027 "if t global command is executed on lines not matching ex-g-pat")
2028
2029 (defvar ex-reg-exp nil
2030 "save reg-exp used in substitute")
2031
2032 (defvar ex-repl nil
2033 "replace pattern for substitute")
2034
2035 (defvar ex-g-pat nil
2036 "pattern for global command")
2037
2038 (defvar ex-map (make-sparse-keymap)
2039 "save commands for mapped keys")
2040
2041 (defvar ex-tag nil
2042 "save ex tag")
2043
2044 (defvar ex-file nil)
2045
2046 (defvar ex-variant nil)
2047
2048 (defvar ex-offset nil)
2049
2050 (defvar ex-append nil)
2051
2052 (defun vip-nil ()
2053 (interactive)
2054 (error ""))
2055
2056 (defun vip-looking-back (str)
2057 "returns t if looking back reg-exp STR before point."
2058 (and (save-excursion (re-search-backward str nil t))
2059 (= (point) (match-end 0))))
2060
2061 (defun vip-check-sub (str)
2062 "check if ex-token is an initial segment of STR"
2063 (let ((length (length ex-token)))
2064 (if (and (<= length (length str))
2065 (string= ex-token (substring str 0 length)))
2066 (setq ex-token str)
2067 (setq ex-token-type "non-command"))))
2068
2069 (defun vip-get-ex-com-subr ()
2070 "get a complete ex command"
2071 (set-mark (point))
2072 (re-search-forward "[a-z][a-z]*")
2073 (setq ex-token-type "command")
2074 (setq ex-token (buffer-substring (point) (mark)))
2075 (exchange-point-and-mark)
2076 (cond ((looking-at "a")
2077 (cond ((looking-at "ab") (vip-check-sub "abbreviate"))
2078 ((looking-at "ar") (vip-check-sub "args"))
2079 (t (vip-check-sub "append"))))
2080 ((looking-at "[bh]") (setq ex-token-type "non-command"))
2081 ((looking-at "c")
2082 (if (looking-at "co") (vip-check-sub "copy")
2083 (vip-check-sub "change")))
2084 ((looking-at "d") (vip-check-sub "delete"))
2085 ((looking-at "e")
2086 (if (looking-at "ex") (vip-check-sub "ex")
2087 (vip-check-sub "edit")))
2088 ((looking-at "f") (vip-check-sub "file"))
2089 ((looking-at "g") (vip-check-sub "global"))
2090 ((looking-at "i") (vip-check-sub "insert"))
2091 ((looking-at "j") (vip-check-sub "join"))
2092 ((looking-at "l") (vip-check-sub "list"))
2093 ((looking-at "m")
2094 (cond ((looking-at "map") (vip-check-sub "map"))
2095 ((looking-at "mar") (vip-check-sub "mark"))
2096 (t (vip-check-sub "move"))))
2097 ((looking-at "n")
2098 (if (looking-at "nu") (vip-check-sub "number")
2099 (vip-check-sub "next")))
2100 ((looking-at "o") (vip-check-sub "open"))
2101 ((looking-at "p")
2102 (cond ((looking-at "pre") (vip-check-sub "preserve"))
2103 ((looking-at "pu") (vip-check-sub "put"))
2104 (t (vip-check-sub "print"))))
2105 ((looking-at "q") (vip-check-sub "quit"))
2106 ((looking-at "r")
2107 (cond ((looking-at "rec") (vip-check-sub "recover"))
2108 ((looking-at "rew") (vip-check-sub "rewind"))
2109 (t (vip-check-sub "read"))))
2110 ((looking-at "s")
2111 (cond ((looking-at "se") (vip-check-sub "set"))
2112 ((looking-at "sh") (vip-check-sub "shell"))
2113 ((looking-at "so") (vip-check-sub "source"))
2114 ((looking-at "st") (vip-check-sub "stop"))
2115 (t (vip-check-sub "substitute"))))
2116 ((looking-at "t")
2117 (if (looking-at "ta") (vip-check-sub "tag")
2118 (vip-check-sub "t")))
2119 ((looking-at "u")
2120 (cond ((looking-at "una") (vip-check-sub "unabbreviate"))
2121 ((looking-at "unm") (vip-check-sub "unmap"))
2122 (t (vip-check-sub "undo"))))
2123 ((looking-at "v")
2124 (cond ((looking-at "ve") (vip-check-sub "version"))
2125 ((looking-at "vi") (vip-check-sub "visual"))
2126 (t (vip-check-sub "v"))))
2127 ((looking-at "w")
2128 (if (looking-at "wq") (vip-check-sub "wq")
2129 (vip-check-sub "write")))
2130 ((looking-at "x") (vip-check-sub "xit"))
2131 ((looking-at "y") (vip-check-sub "yank"))
2132 ((looking-at "z") (vip-check-sub "z")))
2133 (exchange-point-and-mark))
2134
2135 (defun vip-get-ex-token ()
2136 "get an ex-token which is either an address or a command.
2137 a token has type \(command, address, end-mark\) and value."
2138 (save-window-excursion
2139 (set-buffer " *ex-working-space*")
2140 (skip-chars-forward " \t")
2141 (cond ((looking-at "[k#]")
2142 (setq ex-token-type "command")
2143 (setq ex-token (char-to-string (following-char)))
2144 (forward-char 1))
2145 ((looking-at "[a-z]") (vip-get-ex-com-subr))
2146 ((looking-at "\\.")
2147 (forward-char 1)
2148 (setq ex-token-type "dot"))
2149 ((looking-at "[0-9]")
2150 (set-mark (point))
2151 (re-search-forward "[0-9]*")
2152 (setq ex-token-type
2153 (cond ((string= ex-token-type "plus") "add-number")
2154 ((string= ex-token-type "minus") "sub-number")
2155 (t "abs-number")))
2156 (setq ex-token (string-to-int (buffer-substring (point) (mark)))))
2157 ((looking-at "\\$")
2158 (forward-char 1)
2159 (setq ex-token-type "end"))
2160 ((looking-at "%")
2161 (forward-char 1)
2162 (setq ex-token-type "whole"))
2163 ((looking-at "+")
2164 (cond ((or (looking-at "+[-+]") (looking-at "+[\n|]"))
2165 (forward-char 1)
2166 (insert "1")
2167 (backward-char 1)
2168 (setq ex-token-type "plus"))
2169 ((looking-at "+[0-9]")
2170 (forward-char 1)
2171 (setq ex-token-type "plus"))
2172 (t
2173 (error "Badly formed address"))))
2174 ((looking-at "-")
2175 (cond ((or (looking-at "-[-+]") (looking-at "-[\n|]"))
2176 (forward-char 1)
2177 (insert "1")
2178 (backward-char 1)
2179 (setq ex-token-type "minus"))
2180 ((looking-at "-[0-9]")
2181 (forward-char 1)
2182 (setq ex-token-type "minus"))
2183 (t
2184 (error "Badly formed address"))))
2185 ((looking-at "/")
2186 (forward-char 1)
2187 (set-mark (point))
2188 (let ((cont t))
2189 (while (and (not (eolp)) cont)
2190 ;;(re-search-forward "[^/]*/")
2191 (re-search-forward "[^/]*\\(/\\|\n\\)")
2192 (if (not (vip-looking-back "[^\\\\]\\(\\\\\\\\\\)*\\\\/"))
2193 (setq cont nil))))
2194 (backward-char 1)
2195 (setq ex-token (buffer-substring (point) (mark)))
2196 (if (looking-at "/") (forward-char 1))
2197 (setq ex-token-type "search-forward"))
2198 ((looking-at "\\?")
2199 (forward-char 1)
2200 (set-mark (point))
2201 (let ((cont t))
2202 (while (and (not (eolp)) cont)
2203 ;;(re-search-forward "[^\\?]*\\?")
2204 (re-search-forward "[^\\?]*\\(\\?\\|\n\\)")
2205 (if (not (vip-looking-back "[^\\\\]\\(\\\\\\\\\\)*\\\\\\?"))
2206 (setq cont nil))
2207 (backward-char 1)
2208 (if (not (looking-at "\n")) (forward-char 1))))
2209 (setq ex-token-type "search-backward")
2210 (setq ex-token (buffer-substring (1- (point)) (mark))))
2211 ((looking-at ",")
2212 (forward-char 1)
2213 (setq ex-token-type "comma"))
2214 ((looking-at ";")
2215 (forward-char 1)
2216 (setq ex-token-type "semi-colon"))
2217 ((looking-at "[!=><&~]")
2218 (setq ex-token-type "command")
2219 (setq ex-token (char-to-string (following-char)))
2220 (forward-char 1))
2221 ((looking-at "'")
2222 (setq ex-token-type "goto-mark")
2223 (forward-char 1)
2224 (cond ((looking-at "'") (setq ex-token nil))
2225 ((looking-at "[a-z]") (setq ex-token (following-char)))
2226 (t (error "Marks are ' and a-z")))
2227 (forward-char 1))
2228 ((looking-at "\n")
2229 (setq ex-token-type "end-mark")
2230 (setq ex-token "goto"))
2231 (t
2232 (error "illegal token")))))
2233
2234 (defun vip-ex (&optional string)
2235 "ex commands within VIP."
2236 (interactive)
2237 (or string
2238 (setq ex-g-flag nil
2239 ex-g-variant nil))
2240 (let ((com-str (or string (vip-read-string ":")))
2241 (address nil) (cont t) (dot (point)))
2242 (save-window-excursion
2243 (set-buffer (get-buffer-create " *ex-working-space*"))
2244 (delete-region (point-min) (point-max))
2245 (insert com-str "\n")
2246 (goto-char (point-min)))
2247 (setq ex-token-type "")
2248 (setq ex-addresses nil)
2249 (while cont
2250 (vip-get-ex-token)
2251 (cond ((or (string= ex-token-type "command")
2252 (string= ex-token-type "end-mark"))
2253 (if address (setq ex-addresses (cons address ex-addresses)))
2254 (cond ((string= ex-token "global")
2255 (ex-global nil)
2256 (setq cont nil))
2257 ((string= ex-token "v")
2258 (ex-global t)
2259 (setq cont nil))
2260 (t
2261 (vip-execute-ex-command)
2262 (save-window-excursion
2263 (set-buffer " *ex-working-space*")
2264 (skip-chars-forward " \t")
2265 (cond ((looking-at "|")
2266 (forward-char 1))
2267 ((looking-at "\n")
2268 (setq cont nil))
2269 (t (error "Extra character at end of a command")))))))
2270 ((string= ex-token-type "non-command")
2271 (error (format "%s: Not an editor command" ex-token)))
2272 ((string= ex-token-type "whole")
2273 (setq ex-addresses
2274 (cons (point-max) (cons (point-min) ex-addresses))))
2275 ((string= ex-token-type "comma")
2276 (setq ex-addresses
2277 (cons (if (null address) (point) address) ex-addresses)))
2278 ((string= ex-token-type "semi-colon")
2279 (if address (setq dot address))
2280 (setq ex-addresses
2281 (cons (if (null address) (point) address) ex-addresses)))
2282 (t (let ((ans (vip-get-ex-address-subr address dot)))
2283 (if ans (setq address ans))))))))
2284
2285 (defun vip-get-ex-pat ()
2286 "get a regular expression and set ex-variant if found"
2287 (save-window-excursion
2288 (set-buffer " *ex-working-space*")
2289 (skip-chars-forward " \t")
2290 (if (looking-at "!")
2291 (progn
2292 (setq ex-g-variant (not ex-g-variant)
2293 ex-g-flag (not ex-g-flag))
2294 (forward-char 1)
2295 (skip-chars-forward " \t")))
2296 (if (looking-at "/")
2297 (progn
2298 (forward-char 1)
2299 (set-mark (point))
2300 (let ((cont t))
2301 (while (and (not (eolp)) cont)
2302 (re-search-forward "[^/]*\\(/\\|\n\\)")
2303 ;;(re-search-forward "[^/]*/")
2304 (if (not (vip-looking-back "[^\\\\]\\(\\\\\\\\\\)*\\\\/"))
2305 (setq cont nil))))
2306 (setq ex-token
2307 (if (= (mark) (point)) ""
2308 (buffer-substring (1- (point)) (mark))))
2309 (backward-char 1))
2310 (setq ex-token nil))))
2311
2312 (defun vip-get-ex-command ()
2313 "get an ex command"
2314 (save-window-excursion
2315 (set-buffer " *ex-working-space*")
2316 (if (looking-at "/") (forward-char 1))
2317 (skip-chars-forward " \t")
2318 (cond ((looking-at "[a-z]")
2319 (vip-get-ex-com-subr)
2320 (if (string= ex-token-type "non-command")
2321 (error "%s: not an editor command" ex-token)))
2322 ((looking-at "[!=><&~]")
2323 (setq ex-token (char-to-string (following-char)))
2324 (forward-char 1))
2325 (t (error "Could not find an ex command")))))
2326
2327 (defun vip-get-ex-opt-gc ()
2328 "get an ex option g or c"
2329 (save-window-excursion
2330 (set-buffer " *ex-working-space*")
2331 (if (looking-at "/") (forward-char 1))
2332 (skip-chars-forward " \t")
2333 (cond ((looking-at "g")
2334 (setq ex-token "g")
2335 (forward-char 1)
2336 t)
2337 ((looking-at "c")
2338 (setq ex-token "c")
2339 (forward-char 1)
2340 t)
2341 (t nil))))
2342
2343 (defun vip-default-ex-addresses (&optional whole-flag)
2344 "compute default addresses. whole-flag means whole buffer."
2345 (cond ((null ex-addresses)
2346 (setq ex-addresses
2347 (if whole-flag
2348 (cons (point-max) (cons (point-min) nil))
2349 (cons (point) (cons (point) nil)))))
2350 ((null (cdr ex-addresses))
2351 (setq ex-addresses
2352 (cons (car ex-addresses) ex-addresses)))))
2353
2354 (defun vip-get-ex-address ()
2355 "get an ex-address as a marker and set ex-flag if a flag is found"
2356 (let ((address (point-marker)) (cont t))
2357 (setq ex-token "")
2358 (setq ex-flag nil)
2359 (while cont
2360 (vip-get-ex-token)
2361 (cond ((string= ex-token-type "command")
2362 (if (or (string= ex-token "print") (string= ex-token "list")
2363 (string= ex-token "#"))
2364 (progn
2365 (setq ex-flag t)
2366 (setq cont nil))
2367 (error "address expected")))
2368 ((string= ex-token-type "end-mark")
2369 (setq cont nil))
2370 ((string= ex-token-type "whole")
2371 (error "a trailing address is expected"))
2372 ((string= ex-token-type "comma")
2373 (error "Extra characters after an address"))
2374 (t (let ((ans (vip-get-ex-address-subr address (point-marker))))
2375 (if ans (setq address ans))))))
2376 address))
2377
2378 (defun vip-get-ex-address-subr (old-address dot)
2379 "returns an address as a point"
2380 (let ((address nil))
2381 (if (null old-address) (setq old-address dot))
2382 (cond ((string= ex-token-type "dot")
2383 (setq address dot))
2384 ((string= ex-token-type "add-number")
2385 (save-excursion
2386 (goto-char old-address)
2387 (forward-line (if (= old-address 0) (1- ex-token) ex-token))
2388 (setq address (point-marker))))
2389 ((string= ex-token-type "sub-number")
2390 (save-excursion
2391 (goto-char old-address)
2392 (forward-line (- ex-token))
2393 (setq address (point-marker))))
2394 ((string= ex-token-type "abs-number")
2395 (save-excursion
2396 (goto-char (point-min))
2397 (if (= ex-token 0) (setq address 0)
2398 (forward-line (1- ex-token))
2399 (setq address (point-marker)))))
2400 ((string= ex-token-type "end")
2401 (setq address (point-max-marker)))
2402 ((string= ex-token-type "plus") t);; do nothing
2403 ((string= ex-token-type "minus") t);; do nothing
2404 ((string= ex-token-type "search-forward")
2405 (save-excursion
2406 (ex-search-address t)
2407 (setq address (point-marker))))
2408 ((string= ex-token-type "search-backward")
2409 (save-excursion
2410 (ex-search-address nil)
2411 (setq address (point-marker))))
2412 ((string= ex-token-type "goto-mark")
2413 (save-excursion
2414 (if (null ex-token)
2415 (exchange-point-and-mark)
2416 (goto-char (register-to-point (- ex-token (- ?a ?\C-a)))))
2417 (setq address (point-marker)))))
2418 address))
2419
2420 (defun ex-search-address (forward)
2421 "search pattern and set address"
2422 (if (string= ex-token "")
2423 (if (null vip-s-string) (error "No previous search string")
2424 (setq ex-token vip-s-string))
2425 (setq vip-s-string ex-token))
2426 (if forward
2427 (progn
2428 (forward-line 1)
2429 (re-search-forward ex-token))
2430 (forward-line -1)
2431 (re-search-backward ex-token)))
2432
2433 (defun vip-get-ex-buffer ()
2434 "get a buffer name and set ex-count and ex-flag if found"
2435 (setq ex-buffer nil)
2436 (setq ex-count nil)
2437 (setq ex-flag nil)
2438 (save-window-excursion
2439 (set-buffer " *ex-working-space*")
2440 (skip-chars-forward " \t")
2441 (if (looking-at "[a-zA-Z]")
2442 (progn
2443 (setq ex-buffer (following-char))
2444 (forward-char 1)
2445 (skip-chars-forward " \t")))
2446 (if (looking-at "[0-9]")
2447 (progn
2448 (set-mark (point))
2449 (re-search-forward "[0-9][0-9]*")
2450 (setq ex-count (string-to-int (buffer-substring (point) (mark))))
2451 (skip-chars-forward " \t")))
2452 (if (looking-at "[pl#]")
2453 (progn
2454 (setq ex-flag t)
2455 (forward-char 1)))
2456 (if (not (looking-at "[\n|]"))
2457 (error "Illegal extra characters"))))
2458
2459 (defun vip-get-ex-count ()
2460 (setq ex-variant nil
2461 ex-count nil
2462 ex-flag nil)
2463 (save-window-excursion
2464 (set-buffer " *ex-working-space*")
2465 (skip-chars-forward " \t")
2466 (if (looking-at "!")
2467 (progn
2468 (setq ex-variant t)
2469 (forward-char 1)))
2470 (skip-chars-forward " \t")
2471 (if (looking-at "[0-9]")
2472 (progn
2473 (set-mark (point))
2474 (re-search-forward "[0-9][0-9]*")
2475 (setq ex-count (string-to-int (buffer-substring (point) (mark))))
2476 (skip-chars-forward " \t")))
2477 (if (looking-at "[pl#]")
2478 (progn
2479 (setq ex-flag t)
2480 (forward-char 1)))
2481 (if (not (looking-at "[\n|]"))
2482 (error "Illegal extra characters"))))
2483
2484 (defun vip-get-ex-file ()
2485 "get a file name and set ex-variant, ex-append and ex-offset if found"
2486 (setq ex-file nil
2487 ex-variant nil
2488 ex-append nil
2489 ex-offset nil)
2490 (save-window-excursion
2491 (set-buffer " *ex-working-space*")
2492 (skip-chars-forward " \t")
2493 (if (looking-at "!")
2494 (progn
2495 (setq ex-variant t)
2496 (forward-char 1)
2497 (skip-chars-forward " \t")))
2498 (if (looking-at ">>")
2499 (progn
2500 (setq ex-append t
2501 ex-variant t)
2502 (forward-char 2)
2503 (skip-chars-forward " \t")))
2504 (if (looking-at "+")
2505 (progn
2506 (forward-char 1)
2507 (set-mark (point))
2508 (re-search-forward "[ \t\n]")
2509 (backward-char 1)
2510 (setq ex-offset (buffer-substring (point) (mark)))
2511 (forward-char 1)
2512 (skip-chars-forward " \t")))
2513 (set-mark (point))
2514 (re-search-forward "[ \t\n]")
2515 (backward-char 1)
2516 (setq ex-file (buffer-substring (point) (mark)))))
2517
2518 (defun vip-execute-ex-command ()
2519 "execute ex command using the value of addresses."
2520 (cond ((string= ex-token "goto") (ex-goto))
2521 ((string= ex-token "copy") (ex-copy nil))
2522 ((string= ex-token "delete") (ex-delete))
2523 ((string= ex-token "edit") (ex-edit))
2524 ((string= ex-token "file") (vip-info-on-file))
2525 ;((string= ex-token "global") (ex-global nil))
2526 ((string= ex-token "join") (ex-line "join"))
2527 ((string= ex-token "k") (ex-mark))
2528 ((string= ex-token "mark") (ex-mark))
2529 ((string= ex-token "map") (ex-map))
2530 ((string= ex-token "move") (ex-copy t))
2531 ((string= ex-token "put") (ex-put))
2532 ((string= ex-token "quit") (ex-quit))
2533 ((string= ex-token "read") (ex-read))
2534 ((string= ex-token "set") (ex-set))
2535 ((string= ex-token "shell") (ex-shell))
2536 ((string= ex-token "substitute") (ex-substitute))
2537 ((string= ex-token "stop") (suspend-emacs))
2538 ((string= ex-token "t") (ex-copy nil))
2539 ((string= ex-token "tag") (ex-tag))
2540 ((string= ex-token "undo") (vip-undo))
2541 ((string= ex-token "unmap") (ex-unmap))
2542 ;((string= ex-token "v") (ex-global t))
2543 ((string= ex-token "version") (vip-version))
2544 ((string= ex-token "visual") (ex-edit))
2545 ((string= ex-token "write") (ex-write nil))
2546 ((string= ex-token "wq") (ex-write t))
2547 ((string= ex-token "yank") (ex-yank))
2548 ((string= ex-token "!") (ex-command))
2549 ((string= ex-token "=") (ex-line-no))
2550 ((string= ex-token ">") (ex-line "right"))
2551 ((string= ex-token "<") (ex-line "left"))
2552 ((string= ex-token "&") (ex-substitute t))
2553 ((string= ex-token "~") (ex-substitute t t))
2554 ((or (string= ex-token "append")
2555 (string= ex-token "args")
2556 (string= ex-token "change")
2557 (string= ex-token "insert")
2558 (string= ex-token "open")
2559 )
2560 (error "%s: no such command from VIP" ex-token))
2561 ((or (string= ex-token "abbreviate")
2562 (string= ex-token "list")
2563 (string= ex-token "next")
2564 (string= ex-token "print")
2565 (string= ex-token "preserve")
2566 (string= ex-token "recover")
2567 (string= ex-token "rewind")
2568 (string= ex-token "source")
2569 (string= ex-token "unabbreviate")
2570 (string= ex-token "xit")
2571 (string= ex-token "z")
2572 )
2573 (error "%s: not implemented in VIP" ex-token))
2574 (t (error "%s: Not an editor command" ex-token))))
2575
2576 (defun ex-goto ()
2577 "ex goto command"
2578 (if (null ex-addresses)
2579 (setq ex-addresses (cons (point) nil)))
2580 (push-mark (point))
2581 (goto-char (car ex-addresses))
2582 (beginning-of-line))
2583
2584 (defun ex-copy (del-flag)
2585 "ex copy and move command. DEL-FLAG means delete."
2586 (vip-default-ex-addresses)
2587 (let ((address (vip-get-ex-address))
2588 (end (car ex-addresses)) (beg (car (cdr ex-addresses))))
2589 (goto-char end)
2590 (save-excursion
2591 (set-mark beg)
2592 (vip-enlarge-region (mark) (point))
2593 (if del-flag (kill-region (point) (mark))
2594 (copy-region-as-kill (point) (mark)))
2595 (if ex-flag
2596 (progn
2597 (with-output-to-temp-buffer "*copy text*"
2598 (princ
2599 (if (or del-flag ex-g-flag ex-g-variant)
2600 (current-kill 0)
2601 (buffer-substring (point) (mark)))))
2602 (condition-case nil
2603 (progn
2604 (vip-read-string "[Hit return to continue] ")
2605 (save-excursion (kill-buffer "*copy text*")))
2606 (quit
2607 (save-excursion (kill-buffer "*copy text*"))
2608 (signal 'quit nil))))))
2609 (if (= address 0)
2610 (goto-char (point-min))
2611 (goto-char address)
2612 (forward-line 1))
2613 (insert (current-kill 0))))
2614
2615 (defun ex-delete ()
2616 "ex delete"
2617 (vip-default-ex-addresses)
2618 (vip-get-ex-buffer)
2619 (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses))))
2620 (if (> beg end) (error "First address exceeds second"))
2621 (save-excursion
2622 (vip-enlarge-region beg end)
2623 (exchange-point-and-mark)
2624 (if ex-count
2625 (progn
2626 (set-mark (point))
2627 (forward-line (1- ex-count)))
2628 (set-mark end))
2629 (vip-enlarge-region (point) (mark))
2630 (if ex-flag
2631 ;; show text to be deleted and ask for confirmation
2632 (progn
2633 (with-output-to-temp-buffer " *delete text*"
2634 (princ (buffer-substring (point) (mark))))
2635 (condition-case conditions
2636 (vip-read-string "[Hit return to continue] ")
2637 (quit
2638 (save-excursion (kill-buffer " *delete text*"))
2639 (error "")))
2640 (save-excursion (kill-buffer " *delete text*")))
2641 (if ex-buffer
2642 (if (and (<= ?A ex-buffer) (<= ex-buffer ?Z))
2643 (vip-append-to-register
2644 (+ ex-buffer 32) (point) (mark))
2645 (copy-to-register ex-buffer (point) (mark) nil)))
2646 (delete-region (point) (mark))))))
2647
2648 (defun ex-edit ()
2649 "ex-edit"
2650 (vip-get-ex-file)
2651 (if (and (not ex-variant) (buffer-modified-p) buffer-file-name)
2652 (error "No write since last change \(:e! overrides\)"))
2653 (vip-change-mode-to-emacs)
2654 (set-buffer
2655 (find-file-noselect (concat default-directory ex-file)))
2656 (vip-change-mode-to-vi)
2657 (goto-char (point-min))
2658 (if ex-offset
2659 (progn
2660 (save-window-excursion
2661 (set-buffer " *ex-working-space*")
2662 (delete-region (point-min) (point-max))
2663 (insert ex-offset "\n")
2664 (goto-char (point-min)))
2665 (goto-char (vip-get-ex-address))
2666 (beginning-of-line))))
2667
2668 (defun ex-global (variant)
2669 "ex global command"
2670 (if (or ex-g-flag ex-g-variant)
2671 (error "Global within global not allowed")
2672 (if variant
2673 (setq ex-g-flag nil
2674 ex-g-variant t)
2675 (setq ex-g-flag t
2676 ex-g-variant nil)))
2677 (vip-get-ex-pat)
2678 (if (null ex-token)
2679 (error "Missing regular expression for global command"))
2680 (if (string= ex-token "")
2681 (if (null vip-s-string) (error "No previous search string")
2682 (setq ex-g-pat vip-s-string))
2683 (setq ex-g-pat ex-token
2684 vip-s-string ex-token))
2685 (if (null ex-addresses)
2686 (setq ex-addresses (list (point-max) (point-min))))
2687 (let ((marks nil) (mark-count 0)
2688 com-str (end (car ex-addresses)) (beg (car (cdr ex-addresses))))
2689 (if (> beg end) (error "First address exceeds second"))
2690 (save-excursion
2691 (vip-enlarge-region beg end)
2692 (exchange-point-and-mark)
2693 (let ((cont t) (limit (point-marker)))
2694 (exchange-point-and-mark)
2695 ;; skip the last line if empty
2696 (beginning-of-line)
2697 (if (and (eobp) (not (bobp))) (backward-char 1))
2698 (while (and cont (not (bobp)) (>= (point) limit))
2699 (beginning-of-line)
2700 (set-mark (point))
2701 (end-of-line)
2702 (let ((found (re-search-backward ex-g-pat (mark) t)))
2703 (if (or (and ex-g-flag found)
2704 (and ex-g-variant (not found)))
2705 (progn
2706 (end-of-line)
2707 (setq mark-count (1+ mark-count))
2708 (setq marks (cons (point-marker) marks)))))
2709 (beginning-of-line)
2710 (if (bobp) (setq cont nil)
2711 (forward-line -1)
2712 (end-of-line)))))
2713 (save-window-excursion
2714 (set-buffer " *ex-working-space*")
2715 (setq com-str (buffer-substring (1+ (point)) (1- (point-max)))))
2716 (while marks
2717 (goto-char (car marks))
2718 ; report progress of execution on a slow machine.
2719 ;(message "Executing global command...")
2720 ;(if (zerop (% mark-count 10))
2721 ;(message "Executing global command...%d" mark-count))
2722 (vip-ex com-str)
2723 (setq mark-count (1- mark-count))
2724 (setq marks (cdr marks)))))
2725 ;(message "Executing global command...done")))
2726
2727 (defun ex-line (com)
2728 "ex line commands. COM is join, shift-right or shift-left."
2729 (vip-default-ex-addresses)
2730 (vip-get-ex-count)
2731 (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses))) point)
2732 (if (> beg end) (error "First address exceeds second"))
2733 (save-excursion
2734 (vip-enlarge-region beg end)
2735 (exchange-point-and-mark)
2736 (if ex-count
2737 (progn
2738 (set-mark (point))
2739 (forward-line ex-count)))
2740 (if ex-flag
2741 ;; show text to be joined and ask for confirmation
2742 (progn
2743 (with-output-to-temp-buffer " *text*"
2744 (princ (buffer-substring (point) (mark))))
2745 (condition-case conditions
2746 (progn
2747 (vip-read-string "[Hit return to continue] ")
2748 (ex-line-subr com (point) (mark)))
2749 (quit
2750 (ding)))
2751 (save-excursion (kill-buffer " *text*")))
2752 (ex-line-subr com (point) (mark)))
2753 (setq point (point)))
2754 (goto-char (1- point))
2755 (beginning-of-line)))
2756
2757 (defun ex-line-subr (com beg end)
2758 (cond ((string= com "join")
2759 (goto-char (min beg end))
2760 (while (and (not (eobp)) (< (point) (max beg end)))
2761 (end-of-line)
2762 (if (and (<= (point) (max beg end)) (not (eobp)))
2763 (progn
2764 (forward-line 1)
2765 (delete-region (point) (1- (point)))
2766 (if (not ex-variant) (fixup-whitespace))))))
2767 ((or (string= com "right") (string= com "left"))
2768 (indent-rigidly
2769 (min beg end) (max beg end)
2770 (if (string= com "right") vip-shift-width (- vip-shift-width)))
2771 (goto-char (max beg end))
2772 (end-of-line)
2773 (forward-char 1))))
2774
2775 (defun ex-mark ()
2776 "ex mark"
2777 (let (char)
2778 (if (null ex-addresses)
2779 (setq ex-addresses
2780 (cons (point) nil)))
2781 (save-window-excursion
2782 (set-buffer " *ex-working-space*")
2783 (skip-chars-forward " \t")
2784 (if (looking-at "[a-z]")
2785 (progn
2786 (setq char (following-char))
2787 (forward-char 1)
2788 (skip-chars-forward " \t")
2789 (if (not (looking-at "[\n|]"))
2790 (error "Extra characters at end of \"k\" command")))
2791 (if (looking-at "[\n|]")
2792 (error "\"k\" requires a following letter")
2793 (error "Mark must specify a letter"))))
2794 (save-excursion
2795 (goto-char (car ex-addresses))
2796 (point-to-register (- char (- ?a ?\C-a)) nil))))
2797
2798 (defun ex-map ()
2799 "ex map"
2800 (let (char string)
2801 (save-window-excursion
2802 (set-buffer " *ex-working-space*")
2803 (skip-chars-forward " \t")
2804 (setq char (char-to-string (following-char)))
2805 (forward-char 1)
2806 (skip-chars-forward " \t")
2807 (if (looking-at "[\n|]") (error "Missing rhs"))
2808 (set-mark (point))
2809 (end-of-buffer)
2810 (backward-char 1)
2811 (setq string (buffer-substring (mark) (point))))
2812 (if (not (lookup-key ex-map char))
2813 (define-key ex-map char
2814 (or (lookup-key vip-mode-map char) 'vip-nil)))
2815 (define-key vip-mode-map char
2816 (eval
2817 (list 'quote
2818 (cons 'lambda
2819 (list '(count)
2820 '(interactive "p")
2821 (list 'execute-kbd-macro string 'count))))))))
2822
2823 (defun ex-unmap ()
2824 "ex unmap"
2825 (let (char)
2826 (save-window-excursion
2827 (set-buffer " *ex-working-space*")
2828 (skip-chars-forward " \t")
2829 (setq char (char-to-string (following-char)))
2830 (forward-char 1)
2831 (skip-chars-forward " \t")
2832 (if (not (looking-at "[\n|]")) (error "Macro must be a character")))
2833 (if (not (lookup-key ex-map char))
2834 (error "That macro wasn't mapped"))
2835 (define-key vip-mode-map char (lookup-key ex-map char))
2836 (define-key ex-map char nil)))
2837
2838 (defun ex-put ()
2839 "ex put"
2840 (let ((point (if (null ex-addresses) (point) (car ex-addresses))))
2841 (vip-get-ex-buffer)
2842 (setq vip-use-register ex-buffer)
2843 (goto-char point)
2844 (if (= point 0) (vip-Put-back 1) (vip-put-back 1))))
2845
2846 (defun ex-quit ()
2847 "ex quit"
2848 (let (char)
2849 (save-window-excursion
2850 (set-buffer " *ex-working-space*")
2851 (skip-chars-forward " \t")
2852 (setq char (following-char)))
2853 (if (= char ?!) (kill-emacs t) (save-buffers-kill-emacs))))
2854
2855 (defun ex-read ()
2856 "ex read"
2857 (let ((point (if (null ex-addresses) (point) (car ex-addresses)))
2858 (variant nil) command file)
2859 (goto-char point)
2860 (if (not (= point 0)) (next-line 1))
2861 (beginning-of-line)
2862 (save-window-excursion
2863 (set-buffer " *ex-working-space*")
2864 (skip-chars-forward " \t")
2865 (if (looking-at "!")
2866 (progn
2867 (setq variant t)
2868 (forward-char 1)
2869 (skip-chars-forward " \t")
2870 (set-mark (point))
2871 (end-of-line)
2872 (setq command (buffer-substring (mark) (point))))
2873 (set-mark (point))
2874 (re-search-forward "[ \t\n]")
2875 (backward-char 1)
2876 (setq file (buffer-substring (point) (mark)))))
2877 (if variant
2878 (shell-command command t)
2879 (insert-file file))))
2880
2881 (defun ex-set ()
2882 (eval (list 'setq
2883 (read-variable "Variable: ")
2884 (eval (read-minibuffer "Value: ")))))
2885
2886 (defun ex-shell ()
2887 "ex shell"
2888 (vip-change-mode-to-emacs)
2889 (shell))
2890
2891 (defun ex-substitute (&optional repeat r-flag)
2892 "ex substitute.
2893 If REPEAT use previous reg-exp which is ex-reg-exp or
2894 vip-s-string"
2895 (let (pat repl (opt-g nil) (opt-c nil) (matched-pos nil))
2896 (if repeat (setq ex-token nil) (vip-get-ex-pat))
2897 (if (null ex-token)
2898 (setq pat (if r-flag vip-s-string ex-reg-exp)
2899 repl ex-repl)
2900 (setq pat (if (string= ex-token "") vip-s-string ex-token))
2901 (setq vip-s-string pat
2902 ex-reg-exp pat)
2903 (vip-get-ex-pat)
2904 (if (null ex-token)
2905 (setq ex-token ""
2906 ex-repl "")
2907 (setq repl ex-token
2908 ex-repl ex-token)))
2909 (while (vip-get-ex-opt-gc)
2910 (if (string= ex-token "g") (setq opt-g t) (setq opt-c t)))
2911 (vip-get-ex-count)
2912 (if ex-count
2913 (save-excursion
2914 (if ex-addresses (goto-char (car ex-addresses)))
2915 (set-mark (point))
2916 (forward-line (1- ex-count))
2917 (setq ex-addresses (cons (point) (cons (mark) nil))))
2918 (if (null ex-addresses)
2919 (setq ex-addresses (cons (point) (cons (point) nil)))
2920 (if (null (cdr ex-addresses))
2921 (setq ex-addresses (cons (car ex-addresses) ex-addresses)))))
2922 ;(setq G opt-g)
2923 (let ((beg (car ex-addresses)) (end (car (cdr ex-addresses)))
2924 (cont t) eol-mark)
2925 (save-excursion
2926 (vip-enlarge-region beg end)
2927 (let ((limit (save-excursion
2928 (goto-char (max (point) (mark)))
2929 (point-marker))))
2930 (goto-char (min (point) (mark)))
2931 (while (< (point) limit)
2932 (end-of-line)
2933 (setq eol-mark (point-marker))
2934 (beginning-of-line)
2935 (if opt-g
2936 (progn
2937 (while (and (not (eolp))
2938 (re-search-forward pat eol-mark t))
2939 (if (or (not opt-c) (y-or-n-p "Replace? "))
2940 (progn
2941 (setq matched-pos (point))
2942 (replace-match repl))))
2943 (end-of-line)
2944 (forward-char))
2945 (if (and (re-search-forward pat eol-mark t)
2946 (or (not opt-c) (y-or-n-p "Replace? ")))
2947 (progn
2948 (setq matched-pos (point))
2949 (replace-match repl)))
2950 (end-of-line)
2951 (forward-char))))))
2952 (if matched-pos (goto-char matched-pos))
2953 (beginning-of-line)
2954 (if opt-c (message "done"))))
2955
2956 (defun ex-tag ()
2957 "ex tag"
2958 (let (tag)
2959 (save-window-excursion
2960 (set-buffer " *ex-working-space*")
2961 (skip-chars-forward " \t")
2962 (set-mark (point))
2963 (skip-chars-forward "^ |\t\n")
2964 (setq tag (buffer-substring (mark) (point))))
2965 (if (not (string= tag "")) (setq ex-tag tag))
2966 (vip-change-mode-to-emacs)
2967 (condition-case conditions
2968 (progn
2969 (if (string= tag "")
2970 (find-tag ex-tag t)
2971 (find-tag-other-window ex-tag))
2972 (vip-change-mode-to-vi))
2973 (error
2974 (vip-change-mode-to-vi)
2975 (vip-message-conditions conditions)))))
2976
2977 (defun ex-write (q-flag)
2978 "ex write"
2979 (vip-default-ex-addresses t)
2980 (vip-get-ex-file)
2981 (if (string= ex-file "")
2982 (progn
2983 (if (null buffer-file-name)
2984 (error "No file associated with this buffer"))
2985 (setq ex-file buffer-file-name))
2986 (setq ex-file (expand-file-name ex-file)))
2987 (if (and (not (string= ex-file (buffer-file-name)))
2988 (file-exists-p ex-file)
2989 (not ex-variant))
2990 (error "\"%s\" File exists - use w! to override" ex-file))
2991 (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses))))
2992 (if (> beg end) (error "First address exceeds second"))
2993 (save-excursion
2994 (vip-enlarge-region beg end)
2995 (write-region (point) (mark) ex-file ex-append t)))
2996 (if (null buffer-file-name) (setq buffer-file-name ex-file))
2997 (if q-flag (save-buffers-kill-emacs)))
2998
2999 (defun ex-yank ()
3000 "ex yank"
3001 (vip-default-ex-addresses)
3002 (vip-get-ex-buffer)
3003 (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses))))
3004 (if (> beg end) (error "First address exceeds second"))
3005 (save-excursion
3006 (vip-enlarge-region beg end)
3007 (exchange-point-and-mark)
3008 (if (or ex-g-flag ex-g-variant) (error "Can't yank within global"))
3009 (if ex-count
3010 (progn
3011 (set-mark (point))
3012 (forward-line (1- ex-count)))
3013 (set-mark end))
3014 (vip-enlarge-region (point) (mark))
3015 (if ex-flag (error "Extra characters at end of command"))
3016 (if ex-buffer
3017 (copy-to-register ex-buffer (point) (mark) nil))
3018 (copy-region-as-kill (point) (mark)))))
3019
3020 (defun ex-command ()
3021 "execute shell command"
3022 (let (command)
3023 (save-window-excursion
3024 (set-buffer " *ex-working-space*")
3025 (skip-chars-forward " \t")
3026 (set-mark (point))
3027 (end-of-line)
3028 (setq command (buffer-substring (mark) (point))))
3029 (if (null ex-addresses)
3030 (shell-command command)
3031 (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses))))
3032 (if (null beg) (setq beg end))
3033 (save-excursion
3034 (goto-char beg)
3035 (set-mark end)
3036 (vip-enlarge-region (point) (mark))
3037 (shell-command-on-region (point) (mark) command t))
3038 (goto-char beg)))))
3039
3040 (defun ex-line-no ()
3041 "print line number"
3042 (message "%d"
3043 (1+ (count-lines
3044 (point-min)
3045 (if (null ex-addresses) (point-max) (car ex-addresses))))))
3046
3047 (if (file-exists-p vip-startup-file) (load vip-startup-file))
3048
3049 (provide 'vip)
3050
3051 ;;; vip.el ends here