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