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