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