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