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