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