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