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