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