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