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