Update comment about _XOPEN_SOURCE.
[bpt/emacs.git] / lisp / emulation / viper-ex.el
1 ;;; viper-ex.el --- functions implementing the Ex commands for Viper
2
3 ;; Copyright (C) 1994, 1995, 1996, 1997, 1998 Free Software Foundation, Inc.
4
5 ;; This file is part of GNU Emacs.
6
7 ;; GNU Emacs is free software; you can redistribute it and/or modify
8 ;; it under the terms of the GNU General Public License as published by
9 ;; the Free Software Foundation; either version 2, or (at your option)
10 ;; any later version.
11
12 ;; GNU Emacs is distributed in the hope that it will be useful,
13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 ;; GNU General Public License for more details.
16
17 ;; You should have received a copy of the GNU General Public License
18 ;; along with GNU Emacs; see the file COPYING. If not, write to the
19 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 ;; Boston, MA 02111-1307, USA.
21
22 ;; Code
23
24 (provide 'viper-ex)
25
26 ;; Compiler pacifier
27 (defvar read-file-name-map)
28 (defvar viper-use-register)
29 (defvar viper-s-string)
30 (defvar viper-shift-width)
31 (defvar viper-ex-history)
32 (defvar viper-related-files-and-buffers-ring)
33 (defvar viper-local-search-start-marker)
34 (defvar viper-expert-level)
35 (defvar viper-custom-file-name)
36 (defvar viper-case-fold-search)
37 (defvar explicit-shell-file-name)
38
39 ;; loading happens only in non-interactive compilation
40 ;; in order to spare non-viperized emacs from being viperized
41 (if noninteractive
42 (eval-when-compile
43 (let ((load-path (cons (expand-file-name ".") load-path)))
44 (or (featurep 'viper-util)
45 (load "viper-util.el" nil nil 'nosuffix))
46 (or (featurep 'viper-keym)
47 (load "viper-keym.el" nil nil 'nosuffix))
48 (or (featurep 'viper-cmd)
49 (load "viper-cmd.el" nil nil 'nosuffix))
50 )))
51 ;; end pacifier
52
53 (require 'viper-util)
54
55 (defgroup viper-ex nil
56 "Viper support for Ex commands"
57 :prefix "ex-"
58 :group 'viper)
59
60
61
62 ;;; Variables
63
64 (defconst viper-ex-work-buf-name " *ex-working-space*")
65 (defconst viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name))
66 (defconst viper-ex-tmp-buf-name " *ex-tmp*")
67
68
69 ;;; Variable completion in :set command
70
71 ;; The list of Ex commands. Used for completing command names.
72 (defconst ex-token-alist
73 '(("!") ("=") (">") ("&") ("~")
74 ("yank") ("xit") ("WWrite") ("Write") ("write") ("wq") ("visual")
75 ("version") ("vglobal") ("unmap") ("undo") ("tag") ("transfer") ("suspend")
76 ("substitute") ("submitReport") ("stop") ("sr") ("source") ("shell")
77 ("set") ("rewind") ("recover") ("read") ("quit") ("pwd")
78 ("put") ("preserve") ("PreviousRelatedFile") ("RelatedFile")
79 ("next") ("Next") ("move") ("mark") ("map") ("kmark") ("join")
80 ("help") ("goto") ("global") ("file") ("edit") ("delete") ("customize")
81 ("copy") ("chdir") ("cd") ("Buffer") ("buffer") ("args")) )
82
83 ;; A-list of Ex variables that can be set using the :set command.
84 (defconst ex-variable-alist
85 '(("wrapscan") ("ws") ("wrapmargin") ("wm")
86 ("tabstop-global") ("ts-g") ("tabstop") ("ts")
87 ("showmatch") ("sm") ("shiftwidth") ("sw") ("shell") ("sh")
88 ("readonly") ("ro")
89 ("nowrapscan") ("nows") ("noshowmatch") ("nosm")
90 ("noreadonly") ("noro") ("nomagic") ("noma")
91 ("noignorecase") ("noic")
92 ("noautoindent-global") ("noai-g") ("noautoindent") ("noai")
93 ("magic") ("ma") ("ignorecase") ("ic")
94 ("autoindent-global") ("ai-g") ("autoindent") ("ai")
95 ("all")
96 ))
97
98
99
100 ;; Token recognized during parsing of Ex commands (e.g., "read", "comma")
101 (defvar ex-token nil)
102
103 ;; Type of token.
104 ;; If non-nil, gives type of address; if nil, it is a command.
105 (defvar ex-token-type nil)
106
107 ;; List of addresses passed to Ex command
108 (defvar ex-addresses nil)
109
110 ;; This flag is supposed to be set only by `#', `print', and `list',
111 ;; none of which is implemented. So, it and the pices of the code it
112 ;; controls are dead weight. We keep it just in case this might be
113 ;; needed in the future.
114 (defvar ex-flag nil)
115
116 ;; "buffer" where Ex commands keep deleted data.
117 ;; In Emacs terms, this is a register.
118 (defvar ex-buffer nil)
119
120 ;; Value of ex count.
121 (defvar ex-count nil)
122
123 ;; Flag indicating that :global Ex command is being executed.
124 (defvar ex-g-flag nil)
125 ;; Flag indicating that :vglobal Ex command is being executed.
126 (defvar ex-g-variant nil)
127
128 ;; Save reg-exp used in substitute.
129 (defvar ex-reg-exp nil)
130
131
132 ;; Replace pattern for substitute.
133 (defvar ex-repl nil)
134
135 ;; Pattern for global command.
136 (defvar ex-g-pat nil)
137
138 (defcustom ex-unix-type-shell
139 (let ((case-fold-search t))
140 (and (stringp shell-file-name)
141 (string-match
142 (concat
143 "\\("
144 "csh$\\|csh.exe$"
145 "\\|"
146 "ksh$\\|ksh.exe$"
147 "\\|"
148 "^sh$\\|sh.exe$"
149 "\\|"
150 "[^a-z]sh$\\|[^a-z]sh.exe$"
151 "\\|"
152 "bash$\\|bash.exe$"
153 "\\)")
154 shell-file-name)))
155 "Is the user using a unix-type shell under a non-OS?"
156 :type 'boolean
157 :group 'viper-ex)
158
159 (defcustom ex-unix-type-shell-options
160 (let ((case-fold-search t))
161 (if ex-unix-type-shell
162 (cond ((string-match "\\(csh$\\|csh.exe$\\)" shell-file-name)
163 "-f") ; csh: do it fast
164 ((string-match "\\(bash$\\|bash.exe$\\)" shell-file-name)
165 "-noprofile") ; bash: ignore .profile
166 )))
167 "Options to pass to the Unix-style shell.
168 Don't put `-c' here, as it is added automatically."
169 :type 'string
170 :group 'viper-ex)
171
172 (defcustom viper-glob-function
173 (cond (ex-unix-type-shell 'viper-glob-unix-files)
174 ((eq system-type 'emx) 'viper-glob-mswindows-files) ; OS/2
175 (viper-ms-style-os-p 'viper-glob-mswindows-files) ; Microsoft OS
176 (viper-vms-os-p 'viper-glob-unix-files) ; VMS
177 (t 'viper-glob-unix-files) ; presumably UNIX
178 )
179 "Expand the file spec containing wildcard symbols.
180 The default tries to set this variable to work with Unix, Windows,
181 OS/2, and VMS.
182
183 However, if it doesn't work right for some types of Unix shells or some OS,
184 the user should supply the appropriate function and set this variable to the
185 corresponding function symbol."
186 :type 'symbol
187 :group 'viper-ex)
188
189
190 ;; Remembers the previous Ex tag.
191 (defvar ex-tag nil)
192
193 ;; file used by Ex commands like :r, :w, :n
194 (defvar ex-file nil)
195
196 ;; If t, tells Ex that this is a variant-command, i.e., w>>, r!, etc.
197 (defvar ex-variant nil)
198
199 ;; Specified the offset of an Ex command, such as :read.
200 (defvar ex-offset nil)
201
202 ;; Tells Ex that this is a w>> command.
203 (defvar ex-append nil)
204
205 ;; File containing the shell command to be executed at Ex prompt,
206 ;; e.g., :r !date
207 (defvar ex-cmdfile nil)
208 (defvar ex-cmdfile-args "")
209
210 ;; flag used in viper-ex-read-file-name to indicate that we may be reading
211 ;; multiple file names. Used for :edit and :next
212 (defvar viper-keep-reading-filename nil)
213
214 (defcustom ex-cycle-other-window t
215 "*If t, :n and :b cycles through files and buffers in other window.
216 Then :N and :B cycles in the current window. If nil, this behavior is
217 reversed."
218 :type 'boolean
219 :group 'viper-ex)
220
221 (defcustom ex-cycle-through-non-files nil
222 "*Cycle through *scratch* and other buffers that don't visit any file."
223 :type 'boolean
224 :group 'viper-ex)
225
226 ;; Last shell command executed with :! command.
227 (defvar viper-ex-last-shell-com nil)
228
229 ;; Indicates if Minibuffer was exited temporarily in Ex-command.
230 (defvar viper-incomplete-ex-cmd nil)
231
232 ;; Remembers the last ex-command prompt.
233 (defvar viper-last-ex-prompt "")
234
235
236 ;;; Code
237
238 ;; Check if ex-token is an initial segment of STR
239 (defun viper-check-sub (str)
240 (let ((length (length ex-token)))
241 (if (and (<= length (length str))
242 (string= ex-token (substring str 0 length)))
243 (setq ex-token str)
244 (setq ex-token-type 'non-command))))
245
246 ;; Get a complete ex command
247 (defun viper-get-ex-com-subr ()
248 (let (case-fold-search)
249 (set-mark (point))
250 (re-search-forward "[a-zA-Z][a-zA-Z]*")
251 (setq ex-token-type 'command)
252 (setq ex-token (buffer-substring (point) (mark t)))
253 (exchange-point-and-mark)
254 (cond ((looking-at "a")
255 (cond ((looking-at "ab") (viper-check-sub "abbreviate"))
256 ((looking-at "ar") (viper-check-sub "args"))
257 (t (viper-check-sub "append"))))
258 ((looking-at "h") (viper-check-sub "help"))
259 ((looking-at "c")
260 (cond ((looking-at "cd") (viper-check-sub "cd"))
261 ((looking-at "ch") (viper-check-sub "chdir"))
262 ((looking-at "co") (viper-check-sub "copy"))
263 ((looking-at "cu") (viper-check-sub "customize"))
264 (t (viper-check-sub "change"))))
265 ((looking-at "d") (viper-check-sub "delete"))
266 ((looking-at "b") (viper-check-sub "buffer"))
267 ((looking-at "B") (viper-check-sub "Buffer"))
268 ((looking-at "e")
269 (if (looking-at "ex") (viper-check-sub "ex")
270 (viper-check-sub "edit")))
271 ((looking-at "f") (viper-check-sub "file"))
272 ((looking-at "g") (viper-check-sub "global"))
273 ((looking-at "i") (viper-check-sub "insert"))
274 ((looking-at "j") (viper-check-sub "join"))
275 ((looking-at "l") (viper-check-sub "list"))
276 ((looking-at "m")
277 (cond ((looking-at "map") (viper-check-sub "map"))
278 ((looking-at "mar") (viper-check-sub "mark"))
279 (t (viper-check-sub "move"))))
280 ((looking-at "k[a-z][^a-z]")
281 (setq ex-token "kmark")
282 (forward-char 1)
283 (exchange-point-and-mark)) ; this is canceled out by another
284 ; exchange-point-and-mark at the end
285 ((looking-at "k") (viper-check-sub "kmark"))
286 ((looking-at "n") (if (looking-at "nu")
287 (viper-check-sub "number")
288 (viper-check-sub "next")))
289 ((looking-at "N") (viper-check-sub "Next"))
290 ((looking-at "o") (viper-check-sub "open"))
291 ((looking-at "p")
292 (cond ((looking-at "pre") (viper-check-sub "preserve"))
293 ((looking-at "pu") (viper-check-sub "put"))
294 ((looking-at "pw") (viper-check-sub "pwd"))
295 (t (viper-check-sub "print"))))
296 ((looking-at "P") (viper-check-sub "PreviousRelatedFile"))
297 ((looking-at "R") (viper-check-sub "RelatedFile"))
298 ((looking-at "q") (viper-check-sub "quit"))
299 ((looking-at "r")
300 (cond ((looking-at "rec") (viper-check-sub "recover"))
301 ((looking-at "rew") (viper-check-sub "rewind"))
302 (t (viper-check-sub "read"))))
303 ((looking-at "s")
304 (cond ((looking-at "se") (viper-check-sub "set"))
305 ((looking-at "sh") (viper-check-sub "shell"))
306 ((looking-at "so") (viper-check-sub "source"))
307 ((looking-at "sr") (viper-check-sub "sr"))
308 ((looking-at "st") (viper-check-sub "stop"))
309 ((looking-at "sus") (viper-check-sub "suspend"))
310 ((looking-at "subm") (viper-check-sub "submitReport"))
311 (t (viper-check-sub "substitute"))))
312 ((looking-at "t")
313 (if (looking-at "ta") (viper-check-sub "tag")
314 (viper-check-sub "transfer")))
315 ((looking-at "u")
316 (cond ((looking-at "una") (viper-check-sub "unabbreviate"))
317 ((looking-at "unm") (viper-check-sub "unmap"))
318 (t (viper-check-sub "undo"))))
319 ((looking-at "v")
320 (cond ((looking-at "ve") (viper-check-sub "version"))
321 ((looking-at "vi") (viper-check-sub "visual"))
322 (t (viper-check-sub "vglobal"))))
323 ((looking-at "w")
324 (if (looking-at "wq") (viper-check-sub "wq")
325 (viper-check-sub "write")))
326 ((looking-at "W")
327 (if (looking-at "WW")
328 (viper-check-sub "WWrite")
329 (viper-check-sub "Write")))
330 ((looking-at "x") (viper-check-sub "xit"))
331 ((looking-at "y") (viper-check-sub "yank"))
332 ((looking-at "z") (viper-check-sub "z")))
333 (exchange-point-and-mark)
334 ))
335
336 ;; Get an ex-token which is either an address or a command.
337 ;; A token has a type, \(command, address, end-mark\), and a value
338 (defun viper-get-ex-token ()
339 (save-window-excursion
340 (setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name))
341 (set-buffer viper-ex-work-buf)
342 (skip-chars-forward " \t|")
343 (let ((case-fold-search t))
344 (cond ((looking-at "#")
345 (setq ex-token-type 'command)
346 (setq ex-token (char-to-string (following-char)))
347 (forward-char 1))
348 ((looking-at "[a-z]") (viper-get-ex-com-subr))
349 ((looking-at "\\.")
350 (forward-char 1)
351 (setq ex-token-type 'dot))
352 ((looking-at "[0-9]")
353 (set-mark (point))
354 (re-search-forward "[0-9]*")
355 (setq ex-token-type
356 (cond ((eq ex-token-type 'plus) 'add-number)
357 ((eq ex-token-type 'minus) 'sub-number)
358 (t 'abs-number)))
359 (setq ex-token
360 (string-to-int (buffer-substring (point) (mark t)))))
361 ((looking-at "\\$")
362 (forward-char 1)
363 (setq ex-token-type 'end))
364 ((looking-at "%")
365 (forward-char 1)
366 (setq ex-token-type 'whole))
367 ((looking-at "+")
368 (cond ((or (looking-at "+[-+]") (looking-at "+[\n|]"))
369 (forward-char 1)
370 (insert "1")
371 (backward-char 1)
372 (setq ex-token-type 'plus))
373 ((looking-at "+[0-9]")
374 (forward-char 1)
375 (setq ex-token-type 'plus))
376 (t
377 (error viper-BadAddress))))
378 ((looking-at "-")
379 (cond ((or (looking-at "-[-+]") (looking-at "-[\n|]"))
380 (forward-char 1)
381 (insert "1")
382 (backward-char 1)
383 (setq ex-token-type 'minus))
384 ((looking-at "-[0-9]")
385 (forward-char 1)
386 (setq ex-token-type 'minus))
387 (t
388 (error viper-BadAddress))))
389 ((looking-at "/")
390 (forward-char 1)
391 (set-mark (point))
392 (let ((cont t))
393 (while (and (not (eolp)) cont)
394 ;;(re-search-forward "[^/]*/")
395 (re-search-forward "[^/]*\\(/\\|\n\\)")
396 (if (not (viper-looking-back "[^\\\\]\\(\\\\\\\\\\)*\\\\/"))
397 (setq cont nil))))
398 (backward-char 1)
399 (setq ex-token (buffer-substring (point) (mark t)))
400 (if (looking-at "/") (forward-char 1))
401 (setq ex-token-type 'search-forward))
402 ((looking-at "\\?")
403 (forward-char 1)
404 (set-mark (point))
405 (let ((cont t))
406 (while (and (not (eolp)) cont)
407 ;;(re-search-forward "[^\\?]*\\?")
408 (re-search-forward "[^\\?]*\\(\\?\\|\n\\)")
409 (if (not (viper-looking-back "[^\\\\]\\(\\\\\\\\\\)*\\\\\\?"))
410 (setq cont nil))
411 (backward-char 1)
412 (if (not (looking-at "\n")) (forward-char 1))))
413 (setq ex-token-type 'search-backward)
414 (setq ex-token (buffer-substring (1- (point)) (mark t))))
415 ((looking-at ",")
416 (forward-char 1)
417 (setq ex-token-type 'comma))
418 ((looking-at ";")
419 (forward-char 1)
420 (setq ex-token-type 'semi-colon))
421 ((looking-at "[!=><&~]")
422 (setq ex-token-type 'command)
423 (setq ex-token (char-to-string (following-char)))
424 (forward-char 1))
425 ((looking-at "'")
426 (setq ex-token-type 'goto-mark)
427 (forward-char 1)
428 (cond ((looking-at "'") (setq ex-token nil))
429 ((looking-at "[a-z]") (setq ex-token (following-char)))
430 (t (error "Marks are ' and a-z")))
431 (forward-char 1))
432 ((looking-at "\n")
433 (setq ex-token-type 'end-mark)
434 (setq ex-token "goto"))
435 (t
436 (error viper-BadExCommand))))))
437
438 ;; Reads Ex command. Tries to determine if it has to exit because command
439 ;; is complete or invalid. If not, keeps reading command.
440 (defun ex-cmd-read-exit ()
441 (interactive)
442 (setq viper-incomplete-ex-cmd t)
443 (let ((quit-regex1 (concat
444 "\\(" "set[ \t]*"
445 "\\|" "edit[ \t]*"
446 "\\|" "[nN]ext[ \t]*"
447 "\\|" "unm[ \t]*"
448 "\\|" "^[ \t]*rep"
449 "\\)"))
450 (quit-regex2 (concat
451 "[a-zA-Z][ \t]*"
452 "\\(" "!" "\\|" ">>"
453 "\\|" "\\+[0-9]+"
454 "\\)"
455 "*[ \t]*$"))
456 (stay-regex (concat
457 "\\(" "^[ \t]*$"
458 "\\|" "[?/].*"
459 "\\|" "[ktgjmsz][ \t]*$"
460 "\\|" "^[ \t]*ab.*"
461 "\\|" "tr[ansfer \t]*"
462 "\\|" "sr[ \t]*"
463 "\\|" "mo.*"
464 "\\|" "^[ \t]*k?ma[^p]*"
465 "\\|" "^[ \t]*fi.*"
466 "\\|" "v?gl.*"
467 "\\|" "[vg][ \t]*$"
468 "\\|" "jo.*"
469 "\\|" "^[ \t]*ta.*"
470 "\\|" "^[ \t]*una.*"
471 ;; don't jump up in :s command
472 "\\|" "^[ \t]*\\([`'][a-z]\\|[.,%]\\)*[ \t]*su.*"
473 "\\|" "^[ \t]*\\([`'][a-z]\\|[.,%]\\)*[ \t]*s[^a-z].*"
474 "\\|" "['`][a-z][ \t]*"
475 ;; r! assumes that the next one is a shell command
476 "\\|" "\\(r\\|re\\|rea\\|read\\)[ \t]*!"
477 ;; w ! assumes that the next one is a shell command
478 "\\|" "\\(w\\|wr\\|wri\\|writ.?\\)[ \t]+!"
479 "\\|" "![ \t]*[a-zA-Z].*"
480 "\\)"
481 "!*")))
482
483 (save-window-excursion ;; put cursor at the end of the Ex working buffer
484 (setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name))
485 (set-buffer viper-ex-work-buf)
486 (goto-char (point-max)))
487 (cond ((viper-looking-back quit-regex1) (exit-minibuffer))
488 ((viper-looking-back stay-regex) (insert " "))
489 ((viper-looking-back quit-regex2) (exit-minibuffer))
490 (t (insert " ")))))
491
492 ;; complete Ex command
493 (defun ex-cmd-complete ()
494 (interactive)
495 (let (save-pos dist compl-list string-to-complete completion-result)
496
497 (save-excursion
498 (setq dist (skip-chars-backward "[a-zA-Z!=>&~]")
499 save-pos (point)))
500
501 (if (or (= dist 0)
502 (viper-looking-back "\\([ \t]*['`][ \t]*[a-z]*\\)")
503 (viper-looking-back
504 "^[ \t]*[a-zA-Z!=>&~][ \t]*[/?]*[ \t]+[a-zA-Z!=>&~]+"))
505 ;; Preceding characters are not the ones allowed in an Ex command
506 ;; or we have typed past command name.
507 ;; Note: we didn't do parsing, so there can be surprises.
508 (if (or (viper-looking-back "[a-zA-Z!=>&~][ \t]*[/?]*[ \t]*")
509 (viper-looking-back "\\([ \t]*['`][ \t]*[a-z]*\\)")
510 (looking-at "[^ \t\n\C-m]"))
511 nil
512 (with-output-to-temp-buffer "*Completions*"
513 (display-completion-list
514 (viper-alist-to-list ex-token-alist))))
515 ;; Preceding chars may be part of a command name
516 (setq string-to-complete (buffer-substring save-pos (point)))
517 (setq completion-result
518 (try-completion string-to-complete ex-token-alist))
519
520 (cond ((eq completion-result t) ; exact match--do nothing
521 (viper-tmp-insert-at-eob " (Sole completion)"))
522 ((eq completion-result nil)
523 (viper-tmp-insert-at-eob " (No match)"))
524 (t ;; partial completion
525 (goto-char save-pos)
526 (delete-region (point) (point-max))
527 (insert completion-result)
528 (let (case-fold-search)
529 (setq compl-list
530 (viper-filter-alist (concat "^" completion-result)
531 ex-token-alist)))
532 (if (> (length compl-list) 1)
533 (with-output-to-temp-buffer "*Completions*"
534 (display-completion-list
535 (viper-alist-to-list (reverse compl-list)))))))
536 )))
537
538
539 ;; Read Ex commands
540 ;; ARG is a prefix argument. If given, the ex command runs on the region
541 ;;(without the user having to specify the address :a,b
542 ;; STRING is the command to execute. If nil, then Viper asks you to enter the
543 ;; command.
544 (defun viper-ex (arg &optional string)
545 (interactive "P")
546 (or string
547 (setq ex-g-flag nil
548 ex-g-variant nil))
549 (let* ((map (copy-keymap minibuffer-local-map))
550 (address nil)
551 (cont t)
552 (dot (point))
553 reg-beg-line reg-end-line
554 reg-beg reg-end
555 initial-str
556 prev-token-type com-str)
557 (viper-add-keymap viper-ex-cmd-map map)
558
559 (if arg
560 (progn
561 (viper-enlarge-region (mark t) (point))
562 (if (> (point) (mark t))
563 (setq reg-beg (mark t)
564 reg-end (point))
565 (setq reg-end (mark t)
566 reg-beg (point)))
567 (save-excursion
568 (goto-char reg-beg)
569 (setq reg-beg-line (1+ (count-lines (point-min) (point)))
570 reg-end-line
571 (+ reg-beg-line (count-lines reg-beg reg-end) -1)))))
572 (if reg-beg-line
573 (setq initial-str (format "%d,%d" reg-beg-line reg-end-line)))
574
575 (setq com-str
576 (or string (viper-read-string-with-history
577 ":"
578 initial-str
579 'viper-ex-history
580 ;; no default when working on region
581 (if initial-str
582 "none"
583 (car viper-ex-history))
584 map
585 (if initial-str
586 " [Type command to execute on current region]"))))
587 (save-window-excursion
588 ;; just a precaution
589 (setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name))
590 (set-buffer viper-ex-work-buf)
591 (delete-region (point-min) (point-max))
592 (insert com-str "\n")
593 (goto-char (point-min)))
594 (setq ex-token-type nil
595 ex-addresses nil)
596 (while cont
597 (viper-get-ex-token)
598 (cond ((memq ex-token-type '(command end-mark))
599 (if address (setq ex-addresses (cons address ex-addresses)))
600 (cond ((string= ex-token "global")
601 (ex-global nil)
602 (setq cont nil))
603 ((string= ex-token "vglobal")
604 (ex-global t)
605 (setq cont nil))
606 (t
607 (viper-execute-ex-command)
608 (save-excursion
609 (save-window-excursion
610 (setq viper-ex-work-buf
611 (get-buffer-create viper-ex-work-buf-name))
612 (set-buffer viper-ex-work-buf)
613 (skip-chars-forward " \t")
614 (cond ((looking-at "|")
615 (forward-char 1))
616 ((looking-at "\n")
617 (setq cont nil))
618 (t (error
619 "`%s': %s" ex-token viper-SpuriousText)))
620 )))
621 ))
622 ((eq ex-token-type 'non-command)
623 (error "`%s': %s" ex-token viper-BadExCommand))
624 ((eq ex-token-type 'whole)
625 (setq address nil)
626 (setq ex-addresses
627 (if ex-addresses
628 (cons (point-max) ex-addresses)
629 (cons (point-max) (cons (point-min) ex-addresses)))))
630 ((eq ex-token-type 'comma)
631 (if (eq prev-token-type 'whole)
632 (setq address (point-min)))
633 (setq ex-addresses
634 (cons (if (null address) (point) address) ex-addresses)))
635 ((eq ex-token-type 'semi-colon)
636 (if (eq prev-token-type 'whole)
637 (setq address (point-min)))
638 (if address (setq dot address))
639 (setq ex-addresses
640 (cons (if (null address) (point) address) ex-addresses)))
641 (t (let ((ans (viper-get-ex-address-subr address dot)))
642 (if ans (setq address ans)))))
643 (setq prev-token-type ex-token-type))))
644
645
646 ;; Get a regular expression and set `ex-variant', if found
647 (defun viper-get-ex-pat ()
648 (save-window-excursion
649 (setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name))
650 (set-buffer viper-ex-work-buf)
651 (skip-chars-forward " \t")
652 (if (looking-at "!")
653 ;; this is probably a variant command r!
654 (progn
655 (setq ex-g-variant (not ex-g-variant)
656 ex-g-flag (not ex-g-flag))
657 (forward-char 1)
658 (skip-chars-forward " \t")))
659 (let ((c (following-char)))
660 (cond ((string-match "[0-9A-Za-z]" (format "%c" c))
661 (error
662 "Global regexp must be inside matching non-alphanumeric chars"))
663 ((= c ??) (error "`?' is not an allowed pattern delimiter here")))
664 (if (looking-at "[^\\\\\n]")
665 (progn
666 (forward-char 1)
667 (set-mark (point))
668 (let ((cont t))
669 ;; the use of eobp instead of eolp permits the use of newlines in
670 ;; pat2 in s/pat1/pat2/
671 (while (and (not (eobp)) cont)
672 (if (not (re-search-forward (format "[^%c]*%c" c c) nil t))
673 (if (member ex-token '("global" "vglobal"))
674 (error "Missing closing delimiter for global regexp")
675 (goto-char (point-max))))
676 (if (not (viper-looking-back
677 (format "[^\\\\]\\(\\\\\\\\\\)*\\\\%c" c)))
678 (setq cont nil)
679 ;; we are at an escaped delimiter: unescape it and continue
680 (delete-backward-char 2)
681 (insert c)
682 (if (eolp)
683 ;; if at eol, exit loop and go to next line
684 ;; later, delim will be inserted at the end
685 (progn
686 (setq cont nil)
687 (forward-char))))
688 ))
689 (setq ex-token
690 (if (= (mark t) (point)) ""
691 (buffer-substring (1- (point)) (mark t))))
692 (backward-char 1)
693 ;; if the user didn't insert the final pattern delimiter, we're
694 ;; at newline now. In this case, insert the initial delimiter
695 ;; specified in variable c
696 (if (eolp)
697 (progn
698 (insert c)
699 (backward-char 1)))
700 )
701 (setq ex-token nil))
702 c)))
703
704 ;; get an ex command
705 (defun viper-get-ex-command ()
706 (save-window-excursion
707 (setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name))
708 (set-buffer viper-ex-work-buf)
709 (if (looking-at "/") (forward-char 1))
710 (skip-chars-forward " \t")
711 (cond ((looking-at "[a-z]")
712 (viper-get-ex-com-subr)
713 (if (eq ex-token-type 'non-command)
714 (error "`%s': %s" ex-token viper-BadExCommand)))
715 ((looking-at "[!=><&~]")
716 (setq ex-token (char-to-string (following-char)))
717 (forward-char 1))
718 (t (error viper-BadExCommand)))))
719
720 ;; Get an Ex option g or c
721 (defun viper-get-ex-opt-gc (c)
722 (save-window-excursion
723 (setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name))
724 (set-buffer viper-ex-work-buf)
725 (if (looking-at (format "%c" c)) (forward-char 1))
726 (skip-chars-forward " \t")
727 (cond ((looking-at "g")
728 (setq ex-token "g")
729 (forward-char 1)
730 t)
731 ((looking-at "c")
732 (setq ex-token "c")
733 (forward-char 1)
734 t)
735 (t nil))))
736
737 ;; Compute default addresses. WHOLE-FLAG means use the whole buffer
738 (defun viper-default-ex-addresses (&optional whole-flag)
739 (cond ((null ex-addresses)
740 (setq ex-addresses
741 (if whole-flag
742 (list (point-max) (point-min))
743 (list (point) (point)))))
744 ((null (cdr ex-addresses))
745 (setq ex-addresses
746 (cons (car ex-addresses) ex-addresses)))))
747
748 ;; Get an ex-address as a marker and set ex-flag if a flag is found
749 (defun viper-get-ex-address ()
750 (let ((address (point-marker))
751 (cont t))
752 (setq ex-token "")
753 (setq ex-flag nil)
754 (while cont
755 (viper-get-ex-token)
756 (cond ((eq ex-token-type 'command)
757 (if (member ex-token '("print" "list" "#"))
758 (progn
759 (setq ex-flag t
760 cont nil))
761 (error "Address expected in this Ex command")))
762 ((eq ex-token-type 'end-mark)
763 (setq cont nil))
764 ((eq ex-token-type 'whole)
765 (error "Trailing address expected"))
766 ((eq ex-token-type 'comma)
767 (error "`%s': %s" ex-token viper-SpuriousText))
768 (t (let ((ans (viper-get-ex-address-subr address (point-marker))))
769 (if ans (setq address ans))))))
770 address))
771
772 ;; Returns an address as a point
773 (defun viper-get-ex-address-subr (old-address dot)
774 (let ((address nil))
775 (if (null old-address) (setq old-address dot))
776 (cond ((eq ex-token-type 'dot)
777 (setq address dot))
778 ((eq ex-token-type 'add-number)
779 (save-excursion
780 (goto-char old-address)
781 (forward-line (if (= old-address 0) (1- ex-token) ex-token))
782 (setq address (point-marker))))
783 ((eq ex-token-type 'sub-number)
784 (save-excursion
785 (goto-char old-address)
786 (forward-line (- ex-token))
787 (setq address (point-marker))))
788 ((eq ex-token-type 'abs-number)
789 (save-excursion
790 (goto-char (point-min))
791 (if (= ex-token 0) (setq address 0)
792 (forward-line (1- ex-token))
793 (setq address (point-marker)))))
794 ((eq ex-token-type 'end)
795 (setq address (point-max-marker)))
796 ((eq ex-token-type 'plus) t) ; do nothing
797 ((eq ex-token-type 'minus) t) ; do nothing
798 ((eq ex-token-type 'search-forward)
799 (save-excursion
800 (ex-search-address t)
801 (setq address (point-marker))))
802 ((eq ex-token-type 'search-backward)
803 (save-excursion
804 (ex-search-address nil)
805 (setq address (point-marker))))
806 ((eq ex-token-type 'goto-mark)
807 (save-excursion
808 (if (null ex-token)
809 (exchange-point-and-mark)
810 (goto-char (viper-register-to-point
811 (1+ (- ex-token ?a)) 'enforce-buffer)))
812 (setq address (point-marker)))))
813 address))
814
815
816 ;; Search pattern and set address
817 (defun ex-search-address (forward)
818 (if (string= ex-token "")
819 (if (null viper-s-string)
820 (error viper-NoPrevSearch)
821 (setq ex-token viper-s-string))
822 (setq viper-s-string ex-token))
823 (if forward
824 (progn
825 (forward-line 1)
826 (re-search-forward ex-token))
827 (forward-line -1)
828 (re-search-backward ex-token)))
829
830 ;; Get a buffer name and set `ex-count' and `ex-flag' if found
831 (defun viper-get-ex-buffer ()
832 (setq ex-buffer nil)
833 (setq ex-count nil)
834 (setq ex-flag nil)
835 (save-window-excursion
836 (setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name))
837 (set-buffer viper-ex-work-buf)
838 (skip-chars-forward " \t")
839 (if (looking-at "[a-zA-Z]")
840 (progn
841 (setq ex-buffer (following-char))
842 (forward-char 1)
843 (skip-chars-forward " \t")))
844 (if (looking-at "[0-9]")
845 (progn
846 (set-mark (point))
847 (re-search-forward "[0-9][0-9]*")
848 (setq ex-count (string-to-int (buffer-substring (point) (mark t))))
849 (skip-chars-forward " \t")))
850 (if (looking-at "[pl#]")
851 (progn
852 (setq ex-flag t)
853 (forward-char 1)))
854 (if (not (looking-at "[\n|]"))
855 (error "`%s': %s" ex-token viper-SpuriousText))))
856
857 (defun viper-get-ex-count ()
858 (setq ex-variant nil
859 ex-count nil
860 ex-flag nil)
861 (save-window-excursion
862 (setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name))
863 (set-buffer viper-ex-work-buf)
864 (skip-chars-forward " \t")
865 (if (looking-at "!")
866 (progn
867 (setq ex-variant t)
868 (forward-char 1)))
869 (skip-chars-forward " \t")
870 (if (looking-at "[0-9]")
871 (progn
872 (set-mark (point))
873 (re-search-forward "[0-9][0-9]*")
874 (setq ex-count (string-to-int (buffer-substring (point) (mark t))))
875 (skip-chars-forward " \t")))
876 (if (looking-at "[pl#]")
877 (progn
878 (setq ex-flag t)
879 (forward-char 1)))
880 (if (not (looking-at "[\n|]"))
881 (error "`%s': %s"
882 (buffer-substring
883 (point-min) (1- (point-max))) viper-BadExCommand))))
884
885 ;; Expand \% and \# in ex command
886 (defun ex-expand-filsyms (cmd buf)
887 (let (cf pf ret)
888 (save-excursion
889 (set-buffer buf)
890 (setq cf buffer-file-name)
891 (setq pf (ex-next nil t))) ; this finds alternative file name
892 (if (and (null cf) (string-match "[^\\]%\\|\\`%" cmd))
893 (error "No current file to substitute for `%%'"))
894 (if (and (null pf) (string-match "[^\\]#\\|\\`#" cmd))
895 (error "No alternate file to substitute for `#'"))
896 (save-excursion
897 (set-buffer (get-buffer-create viper-ex-tmp-buf-name))
898 (erase-buffer)
899 (insert cmd)
900 (goto-char (point-min))
901 (while (re-search-forward "%\\|#" nil t)
902 (let ((data (match-data))
903 (char (buffer-substring (match-beginning 0) (match-end 0))))
904 (if (viper-looking-back (concat "\\\\" char))
905 (replace-match char)
906 (store-match-data data)
907 (if (string= char "%")
908 (replace-match cf)
909 (replace-match pf)))))
910 (end-of-line)
911 (setq ret (buffer-substring (point-min) (point)))
912 (message "%s" ret))
913 ret))
914
915 ;; Get a file name and set `ex-variant', `ex-append' and `ex-offset' if found
916 ;; If it is r!, then get the command name and whatever args
917 (defun viper-get-ex-file ()
918 (let (prompt)
919 (setq ex-file nil
920 ex-variant nil
921 ex-append nil
922 ex-offset nil
923 ex-cmdfile nil
924 ex-cmdfile-args "")
925 (save-excursion
926 (save-window-excursion
927 (setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name))
928 (set-buffer viper-ex-work-buf)
929 (skip-chars-forward " \t")
930 (if (looking-at "!")
931 (if (and (not (viper-looking-back "[ \t]"))
932 ;; read doesn't have a corresponding :r! form, so ! is
933 ;; immediately interpreted as a shell command.
934 (not (string= ex-token "read")))
935 (progn
936 (setq ex-variant t)
937 (forward-char 1)
938 (skip-chars-forward " \t"))
939 (setq ex-cmdfile t)
940 (forward-char 1)
941 (skip-chars-forward " \t")))
942 (if (looking-at ">>")
943 (progn
944 (setq ex-append t
945 ex-variant t)
946 (forward-char 2)
947 (skip-chars-forward " \t")))
948 (if (looking-at "+")
949 (progn
950 (forward-char 1)
951 (set-mark (point))
952 (re-search-forward "[ \t\n]")
953 (backward-char 1)
954 (setq ex-offset (buffer-substring (point) (mark t)))
955 (forward-char 1)
956 (skip-chars-forward " \t")))
957 ;; this takes care of :r, :w, etc., when they get file names
958 ;; from the history list
959 (if (member ex-token '("read" "write" "edit" "visual" "next"))
960 (progn
961 (setq ex-file (buffer-substring (point) (1- (point-max))))
962 (setq ex-file
963 ;; For :e, match multiple non-white strings separated
964 ;; by white. For others, find the first non-white string
965 (if (string-match
966 (if (string= ex-token "edit")
967 "[^ \t\n]+\\([ \t]+[^ \t\n]+\\)*"
968 "[^ \t\n]+")
969 ex-file)
970 (progn
971 ;; if file name comes from history, don't leave
972 ;; minibuffer when the user types space
973 (setq viper-incomplete-ex-cmd nil)
974 (setq ex-cmdfile-args
975 (substring ex-file (match-end 0) nil))
976 ;; this must be the last clause in this progn
977 (substring ex-file (match-beginning 0) (match-end 0))
978 )
979 ""))
980 ;; this leaves only the command name in the work area
981 ;; file names are gone
982 (delete-region (point) (1- (point-max)))
983 ))
984 (goto-char (point-max))
985 (skip-chars-backward " \t\n")
986 (setq prompt (buffer-substring (point-min) (point)))
987 ))
988
989 (setq viper-last-ex-prompt prompt)
990
991 ;; If we just finished reading command, redisplay prompt
992 (if viper-incomplete-ex-cmd
993 (setq ex-file (viper-ex-read-file-name (format ":%s " prompt)))
994 ;; file was typed in-line
995 (setq ex-file (or ex-file "")))
996 ))
997
998
999 ;; Completes file name or exits minibuffer. If Ex command accepts multiple
1000 ;; file names, arranges to re-enter the minibuffer.
1001 (defun viper-complete-filename-or-exit ()
1002 (interactive)
1003 (setq viper-keep-reading-filename t)
1004 ;; don't exit if directory---ex-commands don't
1005 (cond ((ex-cmd-accepts-multiple-files-p ex-token) (exit-minibuffer))
1006 ;; apparently the argument to an Ex command is
1007 ;; supposed to be a shell command
1008 ((viper-looking-back "^[ \t]*!.*")
1009 (setq ex-cmdfile t)
1010 (insert " "))
1011 (t
1012 (setq ex-cmdfile nil)
1013 (minibuffer-complete-word))))
1014
1015 (defun viper-handle-! ()
1016 (interactive)
1017 (if (and (string=
1018 (buffer-string) (viper-abbreviate-file-name default-directory))
1019 (member ex-token '("read" "write")))
1020 (erase-buffer))
1021 (insert "!"))
1022
1023 (defun ex-cmd-accepts-multiple-files-p (token)
1024 (member token '("edit" "next" "Next")))
1025
1026 ;; Read file name from the minibuffer in an ex command.
1027 ;; If user doesn't enter anything, then "" is returned, i.e., the
1028 ;; prompt-directory is not returned.
1029 (defun viper-ex-read-file-name (prompt)
1030 (let* ((str "")
1031 (minibuffer-local-completion-map
1032 (copy-keymap minibuffer-local-completion-map))
1033 beg end cont val)
1034
1035 (viper-add-keymap ex-read-filename-map
1036 (if viper-emacs-p
1037 minibuffer-local-completion-map
1038 read-file-name-map))
1039
1040 (setq cont (setq viper-keep-reading-filename t))
1041 (while cont
1042 (setq viper-keep-reading-filename nil
1043 val (read-file-name (concat prompt str) nil default-directory))
1044 (setq val (expand-file-name val))
1045 (if (and (string-match " " val)
1046 (ex-cmd-accepts-multiple-files-p ex-token))
1047 (setq val (concat "\"" val "\"")))
1048 (setq str (concat str (if (equal val "") "" " ")
1049 val (if (equal val "") "" " ")))
1050
1051 ;; Only edit, next, and Next commands accept multiple files.
1052 ;; viper-keep-reading-filename is set in the anonymous function that is
1053 ;; bound to " " in ex-read-filename-map.
1054 (setq cont (and viper-keep-reading-filename
1055 (ex-cmd-accepts-multiple-files-p ex-token)))
1056 )
1057
1058 (setq beg (string-match "[^ \t]" str) ; delete leading blanks
1059 end (string-match "[ \t]*$" str)) ; delete trailing blanks
1060 (if (member ex-token '("read" "write"))
1061 (if (string-match "[\t ]*!" str)
1062 ;; this is actually a shell command
1063 (progn
1064 (setq ex-cmdfile t)
1065 (setq beg (1+ beg))
1066 (setq viper-last-ex-prompt
1067 (concat viper-last-ex-prompt " !")))))
1068 (substring str (or beg 0) end)))
1069
1070 ;; Execute ex command using the value of addresses
1071 (defun viper-execute-ex-command ()
1072 (viper-deactivate-mark)
1073 (cond ((string= ex-token "args") (ex-args))
1074 ((string= ex-token "copy") (ex-copy nil))
1075 ((string= ex-token "cd") (ex-cd))
1076 ((string= ex-token "customize") (customize-group "viper"))
1077 ((string= ex-token "chdir") (ex-cd))
1078 ((string= ex-token "delete") (ex-delete))
1079 ((string= ex-token "edit") (ex-edit))
1080 ((string= ex-token "file") (viper-info-on-file))
1081 ((string= ex-token "goto") (ex-goto))
1082 ((string= ex-token "help") (ex-help))
1083 ((string= ex-token "join") (ex-line "join"))
1084 ((string= ex-token "kmark") (ex-mark))
1085 ((string= ex-token "mark") (ex-mark))
1086 ((string= ex-token "map") (ex-map))
1087 ((string= ex-token "move") (ex-copy t))
1088 ((string= ex-token "next") (ex-next ex-cycle-other-window))
1089 ((string= ex-token "Next") (ex-next (not ex-cycle-other-window)))
1090 ((string= ex-token "RelatedFile") (ex-next-related-buffer 1))
1091 ((string= ex-token "put") (ex-put))
1092 ((string= ex-token "pwd") (ex-pwd))
1093 ((string= ex-token "preserve") (ex-preserve))
1094 ((string= ex-token "PreviousRelatedFile") (ex-next-related-buffer -1))
1095 ((string= ex-token "quit") (ex-quit))
1096 ((string= ex-token "read") (ex-read))
1097 ((string= ex-token "recover") (ex-recover))
1098 ((string= ex-token "rewind") (ex-rewind))
1099 ((string= ex-token "submitReport") (viper-submit-report))
1100 ((string= ex-token "set") (ex-set))
1101 ((string= ex-token "shell") (ex-shell))
1102 ((string= ex-token "source") (ex-source))
1103 ((string= ex-token "sr") (ex-substitute t t))
1104 ((string= ex-token "substitute") (ex-substitute))
1105 ((string= ex-token "suspend") (suspend-emacs))
1106 ((string= ex-token "stop") (suspend-emacs))
1107 ((string= ex-token "transfer") (ex-copy nil))
1108 ((string= ex-token "buffer") (if ex-cycle-other-window
1109 (viper-switch-to-buffer-other-window)
1110 (viper-switch-to-buffer)))
1111 ((string= ex-token "Buffer") (if ex-cycle-other-window
1112 (viper-switch-to-buffer)
1113 (viper-switch-to-buffer-other-window)))
1114 ((string= ex-token "tag") (ex-tag))
1115 ((string= ex-token "undo") (viper-undo))
1116 ((string= ex-token "unmap") (ex-unmap))
1117 ((string= ex-token "version") (viper-version))
1118 ((string= ex-token "visual") (ex-edit))
1119 ((string= ex-token "write") (ex-write nil))
1120 ((string= ex-token "Write") (save-some-buffers))
1121 ((string= ex-token "wq") (ex-write t))
1122 ((string= ex-token "WWrite") (save-some-buffers t)) ; don't ask
1123 ((string= ex-token "xit") (ex-write t))
1124 ((string= ex-token "yank") (ex-yank))
1125 ((string= ex-token "!") (ex-command))
1126 ((string= ex-token "=") (ex-line-no))
1127 ((string= ex-token ">") (ex-line "right"))
1128 ((string= ex-token "<") (ex-line "left"))
1129 ((string= ex-token "&") (ex-substitute t))
1130 ((string= ex-token "~") (ex-substitute t t))
1131 ((or (string= ex-token "append")
1132 (string= ex-token "change")
1133 (string= ex-token "insert")
1134 (string= ex-token "open"))
1135 (error "`%s': Obsolete command, not supported by Viper" ex-token))
1136 ((or (string= ex-token "abbreviate")
1137 (string= ex-token "unabbreviate"))
1138 (error
1139 "`%s': Vi abbrevs are obsolete. Use the more powerful Emacs abbrevs"
1140 ex-token))
1141 ((or (string= ex-token "list")
1142 (string= ex-token "print")
1143 (string= ex-token "z")
1144 (string= ex-token "#"))
1145 (error "`%s': Command not implemented in Viper" ex-token))
1146 (t (error "`%s': %s" ex-token viper-BadExCommand))))
1147
1148 (defun viper-undisplayed-files ()
1149 (mapcar
1150 (lambda (b)
1151 (if (null (get-buffer-window b))
1152 (let ((f (buffer-file-name b)))
1153 (if f f
1154 (if ex-cycle-through-non-files
1155 (let ((s (buffer-name b)))
1156 (if (string= " " (substring s 0 1))
1157 nil
1158 s))
1159 nil)))
1160 nil))
1161 (buffer-list)))
1162
1163
1164 (defun ex-args ()
1165 (let ((l (viper-undisplayed-files))
1166 (args "")
1167 (file-count 1))
1168 (while (not (null l))
1169 (if (car l)
1170 (setq args (format "%s %d) %s\n" args file-count (car l))
1171 file-count (1+ file-count)))
1172 (setq l (cdr l)))
1173 (if (string= args "")
1174 (message "All files are already displayed")
1175 (save-excursion
1176 (save-window-excursion
1177 (with-output-to-temp-buffer " *viper-info*"
1178 (princ "\n\nThese files are not displayed in any window.\n")
1179 (princ "\n=============\n")
1180 (princ args)
1181 (princ "\n=============\n")
1182 (princ "\nThe numbers can be given as counts to :next. ")
1183 (princ "\n\nPress any key to continue...\n\n"))
1184 (viper-read-event))))))
1185
1186 ;; Ex cd command. Default directory of this buffer changes
1187 (defun ex-cd ()
1188 (viper-get-ex-file)
1189 (if (string= ex-file "")
1190 (setq ex-file "~"))
1191 (setq default-directory (file-name-as-directory (expand-file-name ex-file))))
1192
1193 ;; Ex copy and move command. DEL-FLAG means delete
1194 (defun ex-copy (del-flag)
1195 (viper-default-ex-addresses)
1196 (let ((address (viper-get-ex-address))
1197 (end (car ex-addresses)) (beg (car (cdr ex-addresses))))
1198 (goto-char end)
1199 (save-excursion
1200 (push-mark beg t)
1201 (viper-enlarge-region (mark t) (point))
1202 (if del-flag
1203 (kill-region (point) (mark t))
1204 (copy-region-as-kill (point) (mark t)))
1205 (if ex-flag
1206 (progn
1207 (with-output-to-temp-buffer " *copy text*"
1208 (princ
1209 (if (or del-flag ex-g-flag ex-g-variant)
1210 (current-kill 0)
1211 (buffer-substring (point) (mark t)))))
1212 (condition-case nil
1213 (progn
1214 (read-string "[Hit return to confirm] ")
1215 (save-excursion (kill-buffer " *copy text*")))
1216 (quit (save-excursion (kill-buffer " *copy text*"))
1217 (signal 'quit nil))))))
1218 (if (= address 0)
1219 (goto-char (point-min))
1220 (goto-char address)
1221 (forward-line 1))
1222 (insert (current-kill 0))))
1223
1224 ;; Ex delete command
1225 (defun ex-delete ()
1226 (viper-default-ex-addresses)
1227 (viper-get-ex-buffer)
1228 (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses))))
1229 (if (> beg end) (error viper-FirstAddrExceedsSecond))
1230 (save-excursion
1231 (viper-enlarge-region beg end)
1232 (exchange-point-and-mark)
1233 (if ex-count
1234 (progn
1235 (set-mark (point))
1236 (forward-line (1- ex-count)))
1237 (set-mark end))
1238 (viper-enlarge-region (point) (mark t))
1239 (if ex-flag
1240 ;; show text to be deleted and ask for confirmation
1241 (progn
1242 (with-output-to-temp-buffer " *delete text*"
1243 (princ (buffer-substring (point) (mark t))))
1244 (condition-case nil
1245 (read-string "[Hit return to confirm] ")
1246 (quit
1247 (save-excursion (kill-buffer " *delete text*"))
1248 (error "")))
1249 (save-excursion (kill-buffer " *delete text*")))
1250 (if ex-buffer
1251 (cond ((viper-valid-register ex-buffer '(Letter))
1252 (viper-append-to-register
1253 (downcase ex-buffer) (point) (mark t)))
1254 ((viper-valid-register ex-buffer)
1255 (copy-to-register ex-buffer (point) (mark t) nil))
1256 (t (error viper-InvalidRegister ex-buffer))))
1257 (kill-region (point) (mark t))))))
1258
1259
1260
1261 ;; Ex edit command
1262 ;; In Viper, `e' and `e!' behave identically. In both cases, the user is
1263 ;; asked if current buffer should really be discarded.
1264 ;; This command can take multiple file names. It replaces the current buffer
1265 ;; with the first file in its argument list
1266 (defun ex-edit (&optional file)
1267 (if (not file)
1268 (viper-get-ex-file))
1269 (cond ((and (string= ex-file "") buffer-file-name)
1270 (setq ex-file (viper-abbreviate-file-name (buffer-file-name))))
1271 ((string= ex-file "")
1272 (error viper-NoFileSpecified)))
1273
1274 ;;; (let (msg do-edit)
1275 ;;; (if buffer-file-name
1276 ;;; (cond ((buffer-modified-p)
1277 ;;; (setq msg
1278 ;;; (format "Buffer %s is modified. Discard changes? "
1279 ;;; (buffer-name))
1280 ;;; do-edit t))
1281 ;;; ((not (verify-visited-file-modtime (current-buffer)))
1282 ;;; (setq msg
1283 ;;; (format "File %s changed on disk. Reread from disk? "
1284 ;;; buffer-file-name)
1285 ;;; do-edit t))
1286 ;;; (t (setq do-edit nil))))
1287 ;;;
1288 ;;; (if do-edit
1289 ;;; (if (yes-or-no-p msg)
1290 ;;; (progn
1291 ;;; (set-buffer-modified-p nil)
1292 ;;; (kill-buffer (current-buffer)))
1293 ;;; (message "Buffer %s was left intact" (buffer-name))))
1294 ;;; ) ; let
1295
1296 (if (null (setq file (get-file-buffer ex-file)))
1297 (progn
1298 ;; this also does shell-style globbing
1299 (ex-find-file
1300 ;; replace # and % with the previous/current file
1301 (ex-expand-filsyms ex-file (current-buffer)))
1302 (or (eq major-mode 'dired-mode)
1303 (viper-change-state-to-vi))
1304 (goto-char (point-min)))
1305 (switch-to-buffer file))
1306 (if ex-offset
1307 (progn
1308 (save-window-excursion
1309 (setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name))
1310 (set-buffer viper-ex-work-buf)
1311 (delete-region (point-min) (point-max))
1312 (insert ex-offset "\n")
1313 (goto-char (point-min)))
1314 (goto-char (viper-get-ex-address))
1315 (beginning-of-line)))
1316 (ex-fixup-history viper-last-ex-prompt ex-file))
1317
1318 ;; Find-file FILESPEC if it appears to specify a single file.
1319 ;; Otherwise, assume that FILESPEC is a wildcard.
1320 ;; In this case, split it into substrings separated by newlines.
1321 ;; Each line is assumed to be a file name.
1322 (defun ex-find-file (filespec)
1323 (let ((nonstandard-filename-chars "[^-a-zA-Z0-9_./,~$\\]"))
1324 (cond ((file-exists-p filespec) (find-file filespec))
1325 ((string-match nonstandard-filename-chars filespec)
1326 (mapcar 'find-file (funcall viper-glob-function filespec)))
1327 (t (find-file filespec)))
1328 ))
1329
1330
1331 ;; Ex global command
1332 ;; This is executed in response to:
1333 ;; :global "pattern" ex-command
1334 ;; :vglobal "pattern" ex-command
1335 ;; :global executes ex-command on all lines matching <pattern>
1336 ;; :vglobal executes ex-command on all lines that don't match <pattern>
1337 ;;
1338 ;; With VARIANT nil, this functions executes :global
1339 ;; With VARIANT t, executes :vglobal
1340 (defun ex-global (variant)
1341 (let ((gcommand ex-token))
1342 (if (or ex-g-flag ex-g-variant)
1343 (error "`%s' within `global' is not allowed" gcommand)
1344 (if variant
1345 (setq ex-g-flag nil
1346 ex-g-variant t)
1347 (setq ex-g-flag t
1348 ex-g-variant nil)))
1349 (viper-get-ex-pat)
1350 (if (null ex-token)
1351 (error "`%s': Missing regular expression" gcommand)))
1352
1353 (if (string= ex-token "")
1354 (if (null viper-s-string)
1355 (error viper-NoPrevSearch)
1356 (setq ex-g-pat viper-s-string))
1357 (setq ex-g-pat ex-token
1358 viper-s-string ex-token))
1359 (if (null ex-addresses)
1360 (setq ex-addresses (list (point-max) (point-min)))
1361 (viper-default-ex-addresses))
1362 (let ((marks nil)
1363 (mark-count 0)
1364 (end (car ex-addresses))
1365 (beg (car (cdr ex-addresses)))
1366 com-str)
1367 (if (> beg end) (error viper-FirstAddrExceedsSecond))
1368 (save-excursion
1369 (viper-enlarge-region beg end)
1370 (exchange-point-and-mark)
1371 (let ((cont t) (limit (point-marker)))
1372 (exchange-point-and-mark)
1373 ;; skip the last line if empty
1374 (beginning-of-line)
1375 (if (eobp) (viper-backward-char-carefully))
1376 (while (and cont (not (bobp)) (>= (point) limit))
1377 (beginning-of-line)
1378 (set-mark (point))
1379 (end-of-line)
1380 (let ((found (re-search-backward ex-g-pat (mark t) t)))
1381 (if (or (and ex-g-flag found)
1382 (and ex-g-variant (not found)))
1383 (progn
1384 (end-of-line)
1385 (setq mark-count (1+ mark-count))
1386 (setq marks (cons (point-marker) marks)))))
1387 (beginning-of-line)
1388 (if (bobp) (setq cont nil)
1389 (forward-line -1)
1390 (end-of-line)))))
1391 (save-window-excursion
1392 (setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name))
1393 (set-buffer viper-ex-work-buf)
1394 ;; com-str is the command string, i.e., g/pattern/ or v/pattern'
1395 (setq com-str (buffer-substring (1+ (point)) (1- (point-max)))))
1396 (while marks
1397 (goto-char (car marks))
1398 (viper-ex nil com-str)
1399 (setq mark-count (1- mark-count))
1400 (setq marks (cdr marks)))))
1401
1402 ;; Ex goto command
1403 (defun ex-goto ()
1404 (if (null ex-addresses)
1405 (setq ex-addresses (cons (point) nil)))
1406 (push-mark (point) t)
1407 (goto-char (car ex-addresses))
1408 (beginning-of-line)
1409 )
1410
1411 ;; Ex line commands. COM is join, shift-right or shift-left
1412 (defun ex-line (com)
1413 (viper-default-ex-addresses)
1414 (viper-get-ex-count)
1415 (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses))) point)
1416 (if (> beg end) (error viper-FirstAddrExceedsSecond))
1417 (save-excursion
1418 (viper-enlarge-region beg end)
1419 (exchange-point-and-mark)
1420 (if ex-count
1421 (progn
1422 (set-mark (point))
1423 (forward-line ex-count)))
1424 (if ex-flag
1425 ;; show text to be joined and ask for confirmation
1426 (progn
1427 (with-output-to-temp-buffer " *join text*"
1428 (princ (buffer-substring (point) (mark t))))
1429 (condition-case nil
1430 (progn
1431 (read-string "[Hit return to confirm] ")
1432 (ex-line-subr com (point) (mark t)))
1433 (quit (ding)))
1434 (save-excursion (kill-buffer " *join text*")))
1435 (ex-line-subr com (point) (mark t)))
1436 (setq point (point)))
1437 (goto-char (1- point))
1438 (beginning-of-line)))
1439
1440 (defun ex-line-subr (com beg end)
1441 (cond ((string= com "join")
1442 (goto-char (min beg end))
1443 (while (and (not (eobp)) (< (point) (max beg end)))
1444 (end-of-line)
1445 (if (and (<= (point) (max beg end)) (not (eobp)))
1446 (progn
1447 (forward-line 1)
1448 (delete-region (point) (1- (point)))
1449 (if (not ex-variant) (fixup-whitespace))))))
1450 ((or (string= com "right") (string= com "left"))
1451 (indent-rigidly
1452 (min beg end) (max beg end)
1453 (if (string= com "right") viper-shift-width (- viper-shift-width)))
1454 (goto-char (max beg end))
1455 (end-of-line)
1456 (viper-forward-char-carefully))))
1457
1458
1459 ;; Ex mark command
1460 (defun ex-mark ()
1461 (let (char)
1462 (if (null ex-addresses)
1463 (setq ex-addresses
1464 (cons (point) nil)))
1465 (save-window-excursion
1466 (setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name))
1467 (set-buffer viper-ex-work-buf)
1468 (skip-chars-forward " \t")
1469 (if (looking-at "[a-z]")
1470 (progn
1471 (setq char (following-char))
1472 (forward-char 1)
1473 (skip-chars-forward " \t")
1474 (if (not (looking-at "[\n|]"))
1475 (error "`%s': %s" ex-token viper-SpuriousText)))
1476 (error "`%s' requires a following letter" ex-token)))
1477 (save-excursion
1478 (goto-char (car ex-addresses))
1479 (point-to-register (1+ (- char ?a))))))
1480
1481
1482
1483 ;; Alternate file is the file next to the first one in the buffer ring
1484 (defun ex-next (cycle-other-window &optional find-alt-file)
1485 (catch 'ex-edit
1486 (let (count l)
1487 (if (not find-alt-file)
1488 (progn
1489 (viper-get-ex-file)
1490 (if (or (char-or-string-p ex-offset)
1491 (and (not (string= "" ex-file))
1492 (not (string-match "^[0-9]+$" ex-file))))
1493 (progn
1494 (ex-edit t)
1495 (throw 'ex-edit nil))
1496 (setq count (string-to-int ex-file))
1497 (if (= count 0) (setq count 1))
1498 (if (< count 0) (error "Usage: `next <count>' (count >= 0)"))))
1499 (setq count 1))
1500 (setq l (viper-undisplayed-files))
1501 (while (> count 0)
1502 (while (and (not (null l)) (null (car l)))
1503 (setq l (cdr l)))
1504 (setq count (1- count))
1505 (if (> count 0)
1506 (setq l (cdr l))))
1507 (if find-alt-file (car l)
1508 (progn
1509 (if (and (car l) (get-file-buffer (car l)))
1510 (let* ((w (if cycle-other-window
1511 (get-lru-window) (selected-window)))
1512 (b (window-buffer w)))
1513 (set-window-buffer w (get-file-buffer (car l)))
1514 (bury-buffer b)
1515 ;; this puts "next <count>" in the ex-command history
1516 (ex-fixup-history viper-last-ex-prompt ex-file))
1517 (error "Not that many undisplayed files")))))))
1518
1519
1520 (defun ex-next-related-buffer (direction &optional no-recursion)
1521
1522 (viper-ring-rotate1 viper-related-files-and-buffers-ring direction)
1523
1524 (let ((file-or-buffer-name
1525 (viper-current-ring-item viper-related-files-and-buffers-ring))
1526 (old-ring viper-related-files-and-buffers-ring)
1527 (old-win (selected-window))
1528 skip-rest buf wind)
1529
1530 (or (and (ring-p viper-related-files-and-buffers-ring)
1531 (> (ring-length viper-related-files-and-buffers-ring) 0))
1532 (error "This buffer has no related files or buffers"))
1533
1534 (or (stringp file-or-buffer-name)
1535 (error
1536 "File and buffer names must be strings, %S" file-or-buffer-name))
1537
1538 (setq buf (cond ((get-buffer file-or-buffer-name))
1539 ((file-exists-p file-or-buffer-name)
1540 (find-file-noselect file-or-buffer-name))
1541 ))
1542
1543 (if (not (viper-buffer-live-p buf))
1544 (error "Didn't find buffer %S or file %S"
1545 file-or-buffer-name
1546 (viper-abbreviate-file-name
1547 (expand-file-name file-or-buffer-name))))
1548
1549 (if (equal buf (current-buffer))
1550 (or no-recursion
1551 ;; try again
1552 (progn
1553 (setq skip-rest t)
1554 (ex-next-related-buffer direction 'norecursion))))
1555
1556 (if skip-rest
1557 ()
1558 ;; setup buffer
1559 (if (setq wind (viper-get-visible-buffer-window buf))
1560 ()
1561 (setq wind (get-lru-window (if viper-xemacs-p nil 'visible)))
1562 (set-window-buffer wind buf))
1563
1564 (if (viper-window-display-p)
1565 (progn
1566 (raise-frame (window-frame wind))
1567 (if (equal (window-frame wind) (window-frame old-win))
1568 (save-window-excursion (select-window wind) (sit-for 1))
1569 (select-window wind)))
1570 (save-window-excursion (select-window wind) (sit-for 1)))
1571
1572 (save-excursion
1573 (set-buffer buf)
1574 (setq viper-related-files-and-buffers-ring old-ring))
1575
1576 (setq viper-local-search-start-marker (point-marker))
1577 )))
1578
1579
1580 ;; Force auto save
1581 (defun ex-preserve ()
1582 (message "Autosaving all buffers that need to be saved...")
1583 (do-auto-save t))
1584
1585 ;; Ex put
1586 (defun ex-put ()
1587 (let ((point (if (null ex-addresses) (point) (car ex-addresses))))
1588 (viper-get-ex-buffer)
1589 (setq viper-use-register ex-buffer)
1590 (goto-char point)
1591 (if (bobp) (viper-Put-back 1) (viper-put-back 1))))
1592
1593 ;; Ex print working directory
1594 (defun ex-pwd ()
1595 (message default-directory))
1596
1597 ;; Ex quit command
1598 (defun ex-quit ()
1599 ;; skip "!", if it is q!. In Viper q!, w!, etc., behave as q, w, etc.
1600 (save-excursion
1601 (setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name))
1602 (set-buffer viper-ex-work-buf)
1603 (if (looking-at "!") (forward-char 1)))
1604 (if (< viper-expert-level 3)
1605 (save-buffers-kill-emacs)
1606 (kill-buffer (current-buffer))))
1607
1608
1609 ;; Ex read command
1610 ;; ex-read doesn't support wildcards, because file completion is a better
1611 ;; mechanism. We also don't support # and % (except in :r <shell-command>
1612 ;; because file history is a better mechanism.
1613 (defun ex-read ()
1614 (viper-get-ex-file)
1615 (let ((point (if (null ex-addresses) (point) (car ex-addresses)))
1616 command)
1617 (goto-char point)
1618 (viper-add-newline-at-eob-if-necessary)
1619 (if (not (or (bobp) (eobp))) (forward-line 1))
1620 (if (and (not ex-variant) (string= ex-file ""))
1621 (progn
1622 (if (null buffer-file-name)
1623 (error viper-NoFileSpecified))
1624 (setq ex-file buffer-file-name)))
1625 (if ex-cmdfile
1626 (progn
1627 (setq command
1628 ;; replace # and % with the previous/current file
1629 (ex-expand-filsyms (concat ex-file ex-cmdfile-args)
1630 (current-buffer)))
1631 (shell-command command t))
1632 (insert-file-contents ex-file)))
1633 (ex-fixup-history viper-last-ex-prompt ex-file ex-cmdfile-args))
1634
1635 ;; this function fixes ex-history for some commands like ex-read, ex-edit
1636 (defun ex-fixup-history (&rest args)
1637 (setq viper-ex-history
1638 (cons (mapconcat 'identity args " ") (cdr viper-ex-history))))
1639
1640
1641 ;; Ex recover from emacs \#file\#
1642 (defun ex-recover ()
1643 (viper-get-ex-file)
1644 (if (or ex-append ex-offset)
1645 (error "`recover': %s" viper-SpuriousText))
1646 (if (string= ex-file "")
1647 (progn
1648 (if (null buffer-file-name)
1649 (error "This buffer isn't visiting any file"))
1650 (setq ex-file buffer-file-name))
1651 (setq ex-file (expand-file-name ex-file)))
1652 (if (and (not (string= ex-file (buffer-file-name)))
1653 (buffer-modified-p)
1654 (not ex-variant))
1655 (error "No write since last change \(:rec! overrides\)"))
1656 (recover-file ex-file))
1657
1658 ;; Tell that `rewind' is obsolete and to use `:next count' instead
1659 (defun ex-rewind ()
1660 (message
1661 "Use `:n <count>' instead. Counts are obtained from the `:args' command"))
1662
1663
1664 ;; read variable name for ex-set
1665 (defun ex-set-read-variable ()
1666 (let ((minibuffer-local-completion-map
1667 (copy-keymap minibuffer-local-completion-map))
1668 (cursor-in-echo-area t)
1669 str batch)
1670 (define-key
1671 minibuffer-local-completion-map " " 'minibuffer-complete-and-exit)
1672 (define-key minibuffer-local-completion-map "=" 'exit-minibuffer)
1673 (if (viper-set-unread-command-events
1674 (ex-get-inline-cmd-args "[ \t]*[a-zA-Z]*[ \t]*" nil "\C-m"))
1675 (progn
1676 (setq batch t)
1677 (viper-set-unread-command-events ?\C-m)))
1678 (message ":set <Variable> [= <Value>]")
1679 (or batch (sit-for 2))
1680
1681 (while (string-match "^[ \\t\\n]*$"
1682 (setq str
1683 (completing-read ":set " ex-variable-alist)))
1684 (message ":set <Variable> [= <Value>]")
1685 ;; if there are unread events, don't wait
1686 (or (viper-set-unread-command-events "") (sit-for 2))
1687 ) ; while
1688 str))
1689
1690
1691 (defun ex-set ()
1692 (let ((var (ex-set-read-variable))
1693 (val 0)
1694 (set-cmd "setq")
1695 (ask-if-save t)
1696 (auto-cmd-label "; don't touch or else...")
1697 (delete-turn-on-auto-fill-pattern
1698 "([ \t]*add-hook[ \t]+'viper-insert-state-hook[ \t]+'turn-on-auto-fill.*)")
1699 actual-lisp-cmd lisp-cmd-del-pattern
1700 val2 orig-var)
1701 (setq orig-var var)
1702 (cond ((string= var "all")
1703 (setq ask-if-save nil
1704 set-cmd nil))
1705 ((member var '("ai" "autoindent"))
1706 (setq var "viper-auto-indent"
1707 set-cmd "setq"
1708 ask-if-save nil
1709 val "t"))
1710 ((member var '("ai-g" "autoindent-global"))
1711 (kill-local-variable 'viper-auto-indent)
1712 (setq var "viper-auto-indent"
1713 set-cmd "setq-default"
1714 val "t"))
1715 ((member var '("noai" "noautoindent"))
1716 (setq var "viper-auto-indent"
1717 ask-if-save nil
1718 val "nil"))
1719 ((member var '("noai-g" "noautoindent-global"))
1720 (kill-local-variable 'viper-auto-indent)
1721 (setq var "viper-auto-indent"
1722 set-cmd "setq-default"
1723 val "nil"))
1724 ((member var '("ic" "ignorecase"))
1725 (setq var "viper-case-fold-search"
1726 val "t"))
1727 ((member var '("noic" "noignorecase"))
1728 (setq var "viper-case-fold-search"
1729 val "nil"))
1730 ((member var '("ma" "magic"))
1731 (setq var "viper-re-search"
1732 val "t"))
1733 ((member var '("noma" "nomagic"))
1734 (setq var "viper-re-search"
1735 val "nil"))
1736 ((member var '("ro" "readonly"))
1737 (setq var "buffer-read-only"
1738 val "t"))
1739 ((member var '("noro" "noreadonly"))
1740 (setq var "buffer-read-only"
1741 val "nil"))
1742 ((member var '("sm" "showmatch"))
1743 (setq var "blink-matching-paren"
1744 val "t"))
1745 ((member var '("nosm" "noshowmatch"))
1746 (setq var "blink-matching-paren"
1747 val "nil"))
1748 ((member var '("ws" "wrapscan"))
1749 (setq var "viper-search-wrap-around-t"
1750 val "t"))
1751 ((member var '("nows" "nowrapscan"))
1752 (setq var "viper-search-wrap-around-t"
1753 val "nil")))
1754 (if (and set-cmd (eq val 0)) ; value must be set by the user
1755 (let ((cursor-in-echo-area t))
1756 (message ":set %s = <Value>" var)
1757 ;; if there are unread events, don't wait
1758 (or (viper-set-unread-command-events "") (sit-for 2))
1759 (setq val (read-string (format ":set %s = " var)))
1760 (ex-fixup-history "set" orig-var val)
1761
1762 ;; check numerical values
1763 (if (member var
1764 '("sw" "shiftwidth"
1765 "ts" "tabstop"
1766 "ts-g" "tabstop-global"
1767 "wm" "wrapmargin"))
1768 (condition-case nil
1769 (or (numberp (setq val2 (car (read-from-string val))))
1770 (error "%s: Invalid value, numberp, %S" var val))
1771 (error
1772 (error "%s: Invalid value, numberp, %S" var val))))
1773
1774 (cond
1775 ((member var '("sw" "shiftwidth"))
1776 (setq var "viper-shift-width"))
1777 ((member var '("ts" "tabstop"))
1778 ;; make it take effect in curr buff and new bufs
1779 (setq var "tab-width"
1780 set-cmd "setq"
1781 ask-if-save nil))
1782 ((member var '("ts-g" "tabstop-global"))
1783 (kill-local-variable 'tab-width)
1784 (setq var "tab-width"
1785 set-cmd "setq-default"))
1786 ((member var '("wm" "wrapmargin"))
1787 ;; make it take effect in curr buff and new bufs
1788 (kill-local-variable 'fill-column)
1789 (setq var "fill-column"
1790 val (format "(- (window-width) %s)" val)
1791 set-cmd "setq-default"))
1792 ((member var '("sh" "shell"))
1793 (setq var "explicit-shell-file-name"
1794 val (format "\"%s\"" val)))))
1795 (ex-fixup-history "set" orig-var))
1796
1797 (if set-cmd
1798 (setq actual-lisp-cmd
1799 (format "\n(%s %s %s) %s" set-cmd var val auto-cmd-label)
1800 lisp-cmd-del-pattern
1801 (format "^\n?[ \t]*([ \t]*%s[ \t]+%s[ \t].*)[ \t]*%s"
1802 set-cmd var auto-cmd-label)))
1803
1804 (if (and ask-if-save
1805 (y-or-n-p (format "Do you want to save this setting in %s "
1806 viper-custom-file-name)))
1807 (progn
1808 (viper-save-string-in-file
1809 actual-lisp-cmd viper-custom-file-name
1810 ;; del pattern
1811 lisp-cmd-del-pattern)
1812 (if (string= var "fill-column")
1813 (if (> val2 0)
1814 (viper-save-string-in-file
1815 (concat
1816 "(add-hook 'viper-insert-state-hook 'turn-on-auto-fill) "
1817 auto-cmd-label)
1818 viper-custom-file-name
1819 delete-turn-on-auto-fill-pattern)
1820 (viper-save-string-in-file
1821 nil viper-custom-file-name delete-turn-on-auto-fill-pattern)
1822 (viper-save-string-in-file
1823 nil viper-custom-file-name
1824 ;; del pattern
1825 lisp-cmd-del-pattern)
1826 ))
1827 ))
1828
1829 (if set-cmd
1830 (message "%s %s %s"
1831 set-cmd var
1832 (if (string-match "^[ \t]*$" val)
1833 (format "%S" val)
1834 val)))
1835 (if actual-lisp-cmd
1836 (eval (car (read-from-string actual-lisp-cmd))))
1837 (if (string= var "fill-column")
1838 (if (> val2 0)
1839 (auto-fill-mode 1)
1840 (auto-fill-mode -1)))
1841 (if (string= var "all") (ex-show-vars))
1842 ))
1843
1844 ;; In inline args, skip regex-forw and (optionally) chars-back.
1845 ;; Optional 3d arg is a string that should replace ' ' to prevent its
1846 ;; special meaning
1847 (defun ex-get-inline-cmd-args (regex-forw &optional chars-back replace-str)
1848 (save-excursion
1849 (setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name))
1850 (set-buffer viper-ex-work-buf)
1851 (goto-char (point-min))
1852 (re-search-forward regex-forw nil t)
1853 (let ((beg (point))
1854 end)
1855 (goto-char (point-max))
1856 (if chars-back
1857 (skip-chars-backward chars-back)
1858 (skip-chars-backward " \t\n\C-m"))
1859 (setq end (point))
1860 ;; replace SPC with `=' to suppress the special meaning SPC has
1861 ;; in Ex commands
1862 (goto-char beg)
1863 (if replace-str
1864 (while (re-search-forward " +" nil t)
1865 (replace-match replace-str nil t)
1866 (viper-forward-char-carefully)))
1867 (goto-char end)
1868 (buffer-substring beg end))))
1869
1870
1871 ;; Ex shell command
1872 (defun ex-shell ()
1873 (shell))
1874
1875 ;; Viper help. Invokes Info
1876 (defun ex-help ()
1877 (condition-case nil
1878 (progn
1879 (pop-to-buffer (get-buffer-create "*info*"))
1880 (info (if viper-xemacs-p "viper.info" "viper"))
1881 (message "Type `i' to search for a specific topic"))
1882 (error (beep 1)
1883 (with-output-to-temp-buffer " *viper-info*"
1884 (princ (format "
1885 The Info file for Viper does not seem to be installed.
1886
1887 This file is part of the standard distribution of %sEmacs.
1888 Please contact your system administrator. "
1889 (if viper-xemacs-p "X" "")
1890 ))))))
1891
1892 ;; Ex source command. Loads the file specified as argument or `~/.viper'
1893 (defun ex-source ()
1894 (viper-get-ex-file)
1895 (if (string= ex-file "")
1896 (load viper-custom-file-name)
1897 (load ex-file)))
1898
1899 ;; Ex substitute command
1900 ;; If REPEAT use previous regexp which is ex-reg-exp or viper-s-string
1901 (defun ex-substitute (&optional repeat r-flag)
1902 (let ((opt-g nil)
1903 (opt-c nil)
1904 (matched-pos nil)
1905 (case-fold-search viper-case-fold-search)
1906 delim pat repl)
1907 (if repeat (setq ex-token nil) (setq delim (viper-get-ex-pat)))
1908 (if (null ex-token)
1909 (progn
1910 (setq pat (if r-flag viper-s-string ex-reg-exp))
1911 (or (stringp pat)
1912 (error "No previous pattern to use in substitution"))
1913 (setq repl ex-repl
1914 delim (string-to-char pat)))
1915 (setq pat (if (string= ex-token "") viper-s-string ex-token))
1916 (setq viper-s-string pat
1917 ex-reg-exp pat)
1918 (setq delim (viper-get-ex-pat))
1919 (if (null ex-token)
1920 (setq ex-token ""
1921 ex-repl "")
1922 (setq repl ex-token
1923 ex-repl ex-token)))
1924 (while (viper-get-ex-opt-gc delim)
1925 (if (string= ex-token "g") (setq opt-g t) (setq opt-c t)))
1926 (viper-get-ex-count)
1927 (if ex-count
1928 (save-excursion
1929 (if ex-addresses (goto-char (car ex-addresses)))
1930 (set-mark (point))
1931 (forward-line (1- ex-count))
1932 (setq ex-addresses (cons (point) (cons (mark t) nil))))
1933 (if (null ex-addresses)
1934 (setq ex-addresses (cons (point) (cons (point) nil)))
1935 (if (null (cdr ex-addresses))
1936 (setq ex-addresses (cons (car ex-addresses) ex-addresses)))))
1937 ;(setq G opt-g)
1938 (let ((beg (car ex-addresses))
1939 (end (car (cdr ex-addresses)))
1940 eol-mark)
1941 (save-excursion
1942 (viper-enlarge-region beg end)
1943 (let ((limit (save-excursion
1944 (goto-char (max (point) (mark t)))
1945 (point-marker))))
1946 (goto-char (min (point) (mark t)))
1947 (while (< (point) limit)
1948 (save-excursion
1949 (end-of-line)
1950 ;; This move allows the use of newline as the last character in
1951 ;; the substitution pattern
1952 (viper-forward-char-carefully)
1953 (setq eol-mark (point-marker)))
1954 (beginning-of-line)
1955 (if opt-g
1956 (progn
1957 (while (and (not (eolp))
1958 (re-search-forward pat eol-mark t))
1959 (if (or (not opt-c)
1960 (progn
1961 (viper-put-on-search-overlay (match-beginning 0)
1962 (match-end 0))
1963 (y-or-n-p "Replace? ")))
1964 (progn
1965 (viper-hide-search-overlay)
1966 (setq matched-pos (point))
1967 (if (not (stringp repl))
1968 (error "Can't perform Ex substitution: No previous replacement pattern"))
1969 (replace-match repl t))))
1970 (end-of-line)
1971 (viper-forward-char-carefully))
1972 (if (null pat)
1973 (error
1974 "Can't repeat Ex substitution: No previous regular expression"))
1975 (if (and (re-search-forward pat eol-mark t)
1976 (or (not opt-c)
1977 (progn
1978 (viper-put-on-search-overlay (match-beginning 0)
1979 (match-end 0))
1980 (y-or-n-p "Replace? "))))
1981 (progn
1982 (viper-hide-search-overlay)
1983 (setq matched-pos (point))
1984 (if (not (stringp repl))
1985 (error "Can't perform Ex substitution: No previous replacement pattern"))
1986 (replace-match repl t)))
1987 ;;(end-of-line)
1988 ;;(viper-forward-char-carefully)
1989 (goto-char eol-mark)
1990 )))))
1991 (if matched-pos (goto-char matched-pos))
1992 (beginning-of-line)
1993 (if opt-c (message "done"))))
1994
1995 ;; Ex tag command
1996 (defun ex-tag ()
1997 (let (tag)
1998 (save-window-excursion
1999 (setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name))
2000 (set-buffer viper-ex-work-buf)
2001 (skip-chars-forward " \t")
2002 (set-mark (point))
2003 (skip-chars-forward "^ |\t\n")
2004 (setq tag (buffer-substring (mark t) (point))))
2005 (if (not (string= tag "")) (setq ex-tag tag))
2006 (viper-change-state-to-emacs)
2007 (condition-case conds
2008 (progn
2009 (if (string= tag "")
2010 (find-tag ex-tag t)
2011 (find-tag-other-window ex-tag))
2012 (viper-change-state-to-vi))
2013 (error
2014 (viper-change-state-to-vi)
2015 (viper-message-conditions conds)))))
2016
2017 ;; Ex write command
2018 ;; ex-write doesn't support wildcards, because file completion is a better
2019 ;; mechanism. We also don't support # and %
2020 ;; because file history is a better mechanism.
2021 (defun ex-write (q-flag)
2022 (viper-default-ex-addresses t)
2023 (viper-get-ex-file)
2024 (let ((end (car ex-addresses))
2025 (beg (car (cdr ex-addresses)))
2026 (orig-buf (current-buffer))
2027 (orig-buf-file-name (buffer-file-name))
2028 (orig-buf-name (buffer-name))
2029 (buff-changed-p (buffer-modified-p))
2030 temp-buf writing-same-file region
2031 file-exists writing-whole-file)
2032 (if (> beg end) (error viper-FirstAddrExceedsSecond))
2033 (if ex-cmdfile
2034 (progn
2035 (viper-enlarge-region beg end)
2036 (shell-command-on-region (point) (mark t)
2037 (concat ex-file ex-cmdfile-args)))
2038 (if (and (string= ex-file "") (not (buffer-file-name)))
2039 (setq ex-file
2040 (read-file-name
2041 (format "Buffer %s isn't visiting any file. File to save in: "
2042 (buffer-name)))))
2043
2044 (setq writing-whole-file (and (= (point-min) beg) (= (point-max) end))
2045 ex-file (if (string= ex-file "")
2046 (buffer-file-name)
2047 (expand-file-name ex-file)))
2048 ;; if ex-file is a directory use the file portion of the buffer file name
2049 (if (and (file-directory-p ex-file)
2050 buffer-file-name
2051 (not (file-directory-p buffer-file-name)))
2052 (setq ex-file
2053 (concat (file-name-as-directory ex-file)
2054 (file-name-nondirectory buffer-file-name))))
2055
2056 (setq file-exists (file-exists-p ex-file)
2057 writing-same-file (string= ex-file (buffer-file-name)))
2058
2059 ;; do actual writing
2060 (if (and writing-whole-file writing-same-file)
2061 ;; saving whole buffer in visited file
2062 (if (not (buffer-modified-p))
2063 (message "(No changes need to be saved)")
2064 (viper-maybe-checkout (current-buffer))
2065 (save-buffer)
2066 (save-restriction
2067 (widen)
2068 (ex-write-info file-exists ex-file (point-min) (point-max))
2069 ))
2070 ;; writing to non-visited file and it already exists
2071 (if (and file-exists (not writing-same-file)
2072 (not (yes-or-no-p
2073 (format "File %s exists. Overwrite? " ex-file))))
2074 (error "Quit"))
2075 ;; writing a region or whole buffer to non-visited file
2076 (unwind-protect
2077 (save-excursion
2078 (viper-enlarge-region beg end)
2079 (setq region (buffer-substring (point) (mark t)))
2080 ;; create temp buffer for the region
2081 (setq temp-buf (get-buffer-create " *ex-write*"))
2082 (set-buffer temp-buf)
2083 (if viper-xemacs-p
2084 (set-visited-file-name ex-file)
2085 (set-visited-file-name ex-file 'noquerry))
2086 (erase-buffer)
2087 (if (and file-exists ex-append)
2088 (insert-file-contents ex-file))
2089 (goto-char (point-max))
2090 (insert region)
2091 ;; ask user
2092 (viper-maybe-checkout (current-buffer))
2093 (setq selective-display nil)
2094 (save-buffer)
2095 (ex-write-info
2096 file-exists ex-file (point-min) (point-max))
2097 )
2098 ;; this must be under unwind-protect so that
2099 ;; temp-buf will be deleted in case of an error
2100 (set-buffer temp-buf)
2101 (set-buffer-modified-p nil)
2102 (kill-buffer temp-buf)
2103 ;; buffer/region has been written, now take care of details
2104 (set-buffer orig-buf)))
2105 ;; set the right file modification time
2106 (if (and (buffer-file-name) writing-same-file)
2107 (set-visited-file-modtime))
2108 ;; prevent loss of data if saving part of the buffer in visited file
2109 (or writing-whole-file
2110 (not writing-same-file)
2111 (progn
2112 (sit-for 2)
2113 (message "Warning: you have saved only part of the buffer!")
2114 (set-buffer-modified-p t)))
2115 (if q-flag
2116 (if (< viper-expert-level 2)
2117 (save-buffers-kill-emacs)
2118 (kill-buffer (current-buffer))))
2119 )))
2120
2121
2122 (defun ex-write-info (exists file-name beg end)
2123 (message "`%s'%s %d lines, %d characters"
2124 (viper-abbreviate-file-name file-name)
2125 (if exists "" " [New file]")
2126 (count-lines beg (min (1+ end) (point-max)))
2127 (- end beg)))
2128
2129 ;; Ex yank command
2130 (defun ex-yank ()
2131 (viper-default-ex-addresses)
2132 (viper-get-ex-buffer)
2133 (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses))))
2134 (if (> beg end) (error viper-FirstAddrExceedsSecond))
2135 (save-excursion
2136 (viper-enlarge-region beg end)
2137 (exchange-point-and-mark)
2138 (if (or ex-g-flag ex-g-variant)
2139 (error "Can't execute `yank' within `global'"))
2140 (if ex-count
2141 (progn
2142 (set-mark (point))
2143 (forward-line (1- ex-count)))
2144 (set-mark end))
2145 (viper-enlarge-region (point) (mark t))
2146 (if ex-flag (error "`yank': %s" viper-SpuriousText))
2147 (if ex-buffer
2148 (cond ((viper-valid-register ex-buffer '(Letter))
2149 (viper-append-to-register
2150 (downcase ex-buffer) (point) (mark t)))
2151 ((viper-valid-register ex-buffer)
2152 (copy-to-register ex-buffer (point) (mark t) nil))
2153 (t (error viper-InvalidRegister ex-buffer))))
2154 (copy-region-as-kill (point) (mark t)))))
2155
2156 ;; Execute shell command
2157 (defun ex-command ()
2158 (let (command)
2159 (save-window-excursion
2160 (setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name))
2161 (set-buffer viper-ex-work-buf)
2162 (skip-chars-forward " \t")
2163 (setq command (buffer-substring (point) (point-max)))
2164 (end-of-line))
2165 ;; replace # and % with the previous/current file
2166 (setq command (ex-expand-filsyms command (current-buffer)))
2167 (if (and (> (length command) 0) (string= "!" (substring command 0 1)))
2168 (if viper-ex-last-shell-com
2169 (setq command
2170 (concat viper-ex-last-shell-com (substring command 1)))
2171 (error "No previous shell command")))
2172 (setq viper-ex-last-shell-com command)
2173 (if (null ex-addresses)
2174 (shell-command command)
2175 (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses))))
2176 (if (null beg) (setq beg end))
2177 (save-excursion
2178 (goto-char beg)
2179 (set-mark end)
2180 (viper-enlarge-region (point) (mark t))
2181 (shell-command-on-region (point) (mark t) command t))
2182 (goto-char beg)))))
2183
2184 ;; Print line number
2185 (defun ex-line-no ()
2186 (message "%d"
2187 (1+ (count-lines
2188 (point-min)
2189 (if (null ex-addresses) (point-max) (car ex-addresses))))))
2190
2191 ;; Give information on the file visited by the current buffer
2192 (defun viper-info-on-file ()
2193 (interactive)
2194 (let ((pos1 (viper-line-pos 'start))
2195 (pos2 (viper-line-pos 'end))
2196 lines file info)
2197 (setq lines (count-lines (point-min) (viper-line-pos 'end))
2198 file (if (buffer-file-name)
2199 (concat (viper-abbreviate-file-name (buffer-file-name)) ":")
2200 (concat (buffer-name) " [Not visiting any file]:"))
2201 info (format "line=%d/%d pos=%d/%d col=%d %s"
2202 (if (= pos1 pos2)
2203 (1+ lines)
2204 lines)
2205 (count-lines (point-min) (point-max))
2206 (point) (1- (point-max))
2207 (1+ (current-column))
2208 (if (buffer-modified-p) "[Modified]" "[Unchanged]")))
2209 (if (< (+ 1 (length info) (length file))
2210 (window-width (minibuffer-window)))
2211 (message (concat file " " info))
2212 (save-window-excursion
2213 (with-output-to-temp-buffer " *viper-info*"
2214 (princ (concat "\n" file "\n\n\t" info "\n\n")))
2215 (let ((inhibit-quit t))
2216 (viper-set-unread-command-events (viper-read-event)))
2217 (kill-buffer " *viper-info*")))
2218 ))
2219
2220 ;; display all variables set through :set
2221 (defun ex-show-vars ()
2222 (with-output-to-temp-buffer " *viper-info*"
2223 (princ (if viper-auto-indent
2224 "autoindent (local)\n" "noautoindent (local)\n"))
2225 (princ (if (default-value 'viper-auto-indent)
2226 "autoindent (global) \n" "noautoindent (global) \n"))
2227 (princ (if viper-case-fold-search "ignorecase\n" "noignorecase\n"))
2228 (princ (if viper-re-search "magic\n" "nomagic\n"))
2229 (princ (if buffer-read-only "readonly\n" "noreadonly\n"))
2230 (princ (if blink-matching-paren "showmatch\n" "noshowmatch\n"))
2231 (princ (if viper-search-wrap-around-t "wrapscan\n" "nowrapscan\n"))
2232 (princ (format "shiftwidth \t\t= %S\n" viper-shift-width))
2233 (princ (format "tabstop (local) \t= %S\n" tab-width))
2234 (princ (format "tabstop (global) \t= %S\n" (default-value 'tab-width)))
2235 (princ (format "wrapmargin (local) \t= %S\n"
2236 (- (window-width) fill-column)))
2237 (princ (format "wrapmargin (global) \t= %S\n"
2238 (- (window-width) (default-value 'fill-column))))
2239 (princ (format "shell \t\t\t= %S\n" (if (boundp 'explicit-shell-file-name)
2240 explicit-shell-file-name
2241 'none)))
2242 ))
2243
2244
2245
2246
2247
2248 ;;; viper-ex.el ends here