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