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