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