CEDET (development tools) package merged.
[bpt/emacs.git] / lisp / emulation / viper-ex.el
1 ;;; viper-ex.el --- functions implementing the Ex commands for Viper
2
3 ;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 2000, 2001, 2002, 2003,
4 ;; 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
5
6 ;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
7
8 ;; This file is part of GNU Emacs.
9
10 ;; GNU Emacs is free software: you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation, either version 3 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
43 ;; loading happens only in non-interactive compilation
44 ;; in order to spare non-viperized emacs from being viperized
45 (if noninteractive
46 (eval-when-compile
47 (if (not (featurep 'viper-cmd))
48 (require 'viper-cmd))
49 ))
50 ;; end pacifier
51
52 (require 'viper-util)
53
54 (defgroup viper-ex nil
55 "Viper support for Ex commands."
56 :prefix "ex-"
57 :group 'viper)
58
59
60
61 ;;; Variables
62
63 (defconst viper-ex-work-buf-name " *ex-working-space*")
64 (defvar viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name))
65 (defconst viper-ex-tmp-buf-name " *ex-tmp*")
66 (defconst viper-ex-print-buf-name " *ex-print*")
67 (defvar viper-ex-print-buf (get-buffer-create viper-ex-print-buf-name))
68
69
70 ;;; ex-commands...
71
72 (defun ex-cmd-obsolete (name)
73 (error "`%s': Obsolete command, not supported by Viper" name))
74
75 (defun ex-cmd-not-yet (name)
76 (error "`%s': Command not implemented in Viper" name))
77
78 ;; alist entries: name (in any order), command, cont(??)
79 ;; If command is a string, then that is an alias to the real command
80 ;; to execute (for instance, ":m" -> ":move").
81 ;; command attributes:
82 ;; is-mashed: the command's args may be jammed right up against the command
83 ;; one-letter: this is a one-letter token. Any text appearing after
84 ;; the name gets appended as an argument for the command
85 ;; i.e. ":kabc" gets turned into (ex-mark "abc")
86 (defconst ex-token-alist '(
87 ("!" (ex-command))
88 ("&" (ex-substitute t))
89 ("=" (ex-line-no))
90 (">" (ex-line "right"))
91 ("<" (ex-line "left"))
92 ("Buffer" (if ex-cycle-other-window
93 (viper-switch-to-buffer)
94 (viper-switch-to-buffer-other-window)))
95 ("Next" (ex-next (not ex-cycle-other-window)))
96 ("PreviousRelatedFile" (ex-next-related-buffer -1))
97 ("RelatedFile" (ex-next-related-buffer 1))
98 ("W" "Write")
99 ("WWrite" (save-some-buffers t))
100 ("Write" (save-some-buffers))
101 ("a" "append")
102 ("args" (ex-args))
103 ("buffer" (if ex-cycle-other-window
104 (viper-switch-to-buffer-other-window)
105 (viper-switch-to-buffer)))
106 ("c" "change")
107 ;; ch should be "change" but maintain old viper compatibility
108 ("ch" "chdir")
109 ("cd" (ex-cd))
110 ("chdir" (ex-cd))
111 ("copy" (ex-copy nil))
112 ("customize" (customize-group "viper"))
113 ("delete" (ex-delete))
114 ("edit" (ex-edit))
115 ("file" (ex-set-visited-file-name))
116 ("g" "global")
117 ("global" (ex-global nil) is-mashed)
118 ("goto" (ex-goto))
119 ("help" (ex-help))
120 ("join" (ex-line "join"))
121 ("k" (ex-mark) one-letter)
122 ("kmark" (ex-mark))
123 ("m" "move")
124 ("make" (ex-compile))
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 ("print" (ex-print))
133 ("put" (ex-put))
134 ("pwd" (ex-pwd))
135 ("quit" (ex-quit))
136 ("r" "read")
137 ("re" "read")
138 ("read" (ex-read))
139 ("recover" (ex-recover))
140 ("rewind" (ex-rewind))
141 ("s" "substitute")
142 ("su" "substitute")
143 ("sub" "substitute")
144 ("set" (ex-set))
145 ("shell" (ex-shell))
146 ("source" (ex-source))
147 ("stop" (suspend-emacs))
148 ("sr" (ex-substitute t t))
149 ("submitReport" (viper-submit-report))
150 ("substitute" (ex-substitute) is-mashed)
151 ("suspend" (suspend-emacs))
152 ("t" "transfer")
153 ("tag" (ex-tag))
154 ("transfer" (ex-copy nil))
155 ("u" "undo")
156 ("un" "undo")
157 ("undo" (viper-undo))
158 ("unmap" (ex-unmap))
159 ("v" "vglobal")
160 ("version" (viper-version))
161 ("vglobal" (ex-global t) is-mashed)
162 ("visual" (ex-edit))
163 ("w" "write")
164 ("wq" (ex-write t))
165 ("write" (ex-write nil))
166 ("xit" (ex-write t))
167 ("yank" (ex-yank))
168 ("~" (ex-substitute t t))
169
170 ("append" (ex-cmd-obsolete "append"))
171 ("change" (ex-cmd-obsolete "change"))
172 ("insert" (ex-cmd-obsolete "insert"))
173 ("open" (ex-cmd-obsolete "open"))
174
175 ("list" (ex-cmd-not-yet "list"))
176 ("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 ((oneletter (ex-cmd-is-one-letter (assoc (substring key 0 1) list))))
205 (if oneletter
206 (list key
207 (append (cadr oneletter)
208 (if (< 1 (length key)) (list (substring key 1))))
209 (car (cdr (cdr oneletter))) ))
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)
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 ;; Marks to operate on during a :global Ex command.
279 (defvar ex-g-marks nil)
280
281 ;; Save reg-exp used in substitute.
282 (defvar ex-reg-exp nil)
283
284
285 ;; Replace pattern for substitute.
286 (defvar ex-repl nil)
287
288 ;; Pattern for global command.
289 (defvar ex-g-pat nil)
290
291 (defcustom ex-unix-type-shell
292 (let ((case-fold-search t))
293 (and (stringp shell-file-name)
294 (string-match
295 (concat
296 "\\("
297 "csh$\\|csh.exe$"
298 "\\|"
299 "ksh$\\|ksh.exe$"
300 "\\|"
301 "^sh$\\|sh.exe$"
302 "\\|"
303 "[^a-z]sh$\\|[^a-z]sh.exe$"
304 "\\|"
305 "bash$\\|bash.exe$"
306 "\\)")
307 shell-file-name)))
308 "Is the user using a unix-type shell under a non-OS?"
309 :type 'boolean
310 :group 'viper-ex)
311
312 (defcustom ex-unix-type-shell-options
313 (let ((case-fold-search t))
314 (if ex-unix-type-shell
315 (cond ((string-match "\\(csh$\\|csh.exe$\\)" shell-file-name)
316 "-f") ; csh: do it fast
317 ((string-match "\\(bash$\\|bash.exe$\\)" shell-file-name)
318 "-noprofile") ; bash: ignore .profile
319 )))
320 "Options to pass to the Unix-style shell.
321 Don't put `-c' here, as it is added automatically."
322 :type '(choice (const nil) string)
323 :group 'viper-ex)
324
325 (defcustom ex-compile-command "make"
326 "The command to run when the user types :make."
327 :type 'string
328 :group 'viper-ex)
329
330 (defcustom viper-glob-function
331 (cond (ex-unix-type-shell 'viper-glob-unix-files)
332 (viper-ms-style-os-p 'viper-glob-mswindows-files) ; Microsoft OS
333 (t 'viper-glob-unix-files) ; presumably UNIX
334 )
335 "Expand the file spec containing wildcard symbols.
336 The default tries to set this variable to work with Unix, Windows,
337 and OS/2.
338
339 However, if it doesn't work right for some types of Unix shells or some OS,
340 the user should supply the appropriate function and set this variable to the
341 corresponding function symbol."
342 :type 'symbol
343 :group 'viper-ex)
344
345
346 ;; Remembers the previous Ex tag.
347 (defvar ex-tag nil)
348
349 ;; file used by Ex commands like :r, :w, :n
350 (defvar ex-file nil)
351
352 ;; If t, tells Ex that this is a variant-command, i.e., w>>, r!, etc.
353 (defvar ex-variant nil)
354
355 ;; Specified the offset of an Ex command, such as :read.
356 (defvar ex-offset nil)
357
358 ;; Tells Ex that this is a w>> command.
359 (defvar ex-append nil)
360
361 ;; File containing the shell command to be executed at Ex prompt,
362 ;; e.g., :r !date
363 (defvar ex-cmdfile nil)
364 (defvar ex-cmdfile-args "")
365
366 ;; flag used in viper-ex-read-file-name to indicate that we may be reading
367 ;; multiple file names. Used for :edit and :next
368 (defvar viper-keep-reading-filename nil)
369
370 (defcustom ex-cycle-other-window t
371 "*If t, :n and :b cycles through files and buffers in other window.
372 Then :N and :B cycles in the current window. If nil, this behavior is
373 reversed."
374 :type 'boolean
375 :group 'viper-ex)
376
377 (defcustom ex-cycle-through-non-files nil
378 "*Cycle through *scratch* and other buffers that don't visit any file."
379 :type 'boolean
380 :group 'viper-ex)
381
382 ;; Last shell command executed with :! command.
383 (defvar viper-ex-last-shell-com nil)
384
385 ;; Indicates if Minibuffer was exited temporarily in Ex-command.
386 (defvar viper-incomplete-ex-cmd nil)
387
388 ;; Remembers the last ex-command prompt.
389 (defvar viper-last-ex-prompt "")
390
391
392 ;; Get a complete ex command
393 (defun viper-get-ex-com-subr ()
394 (let (cmd case-fold-search)
395 (set-mark (point))
396 (re-search-forward "[a-zA-Z][a-zA-Z]*")
397 (setq ex-token-type 'command)
398 (setq ex-token (buffer-substring (point) (mark t)))
399 (setq cmd (ex-cmd-assoc ex-token ex-token-alist))
400 (if cmd
401 (setq ex-token (car cmd))
402 (setq ex-token-type 'non-command))
403 ))
404
405 ;; Get an ex-token which is either an address or a command.
406 ;; A token has a type, \(command, address, end-mark\), and a value
407 (defun viper-get-ex-token ()
408 (save-window-excursion
409 (setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name))
410 (set-buffer viper-ex-work-buf)
411 (skip-chars-forward " \t|")
412 (let ((case-fold-search t))
413 (cond ((looking-at "#")
414 (setq ex-token-type 'command)
415 (setq ex-token (char-to-string (following-char)))
416 (forward-char 1))
417 ((looking-at "[a-z]") (viper-get-ex-com-subr))
418 ((looking-at "\\.")
419 (forward-char 1)
420 (setq ex-token-type 'dot))
421 ((looking-at "[0-9]")
422 (set-mark (point))
423 (re-search-forward "[0-9]*")
424 (setq ex-token-type
425 (cond ((eq ex-token-type 'plus) 'add-number)
426 ((eq ex-token-type 'minus) 'sub-number)
427 (t 'abs-number)))
428 (setq ex-token
429 (string-to-number (buffer-substring (point) (mark t)))))
430 ((looking-at "\\$")
431 (forward-char 1)
432 (setq ex-token-type 'end))
433 ((looking-at "%")
434 (forward-char 1)
435 (setq ex-token-type 'whole))
436 ((looking-at "+")
437 (cond ((or (looking-at "+[-+]") (looking-at "+[\n|]"))
438 (forward-char 1)
439 (insert "1")
440 (backward-char 1)
441 (setq ex-token-type 'plus))
442 ((looking-at "+[0-9]")
443 (forward-char 1)
444 (setq ex-token-type 'plus))
445 (t
446 (error viper-BadAddress))))
447 ((looking-at "-")
448 (cond ((or (looking-at "-[-+]") (looking-at "-[\n|]"))
449 (forward-char 1)
450 (insert "1")
451 (backward-char 1)
452 (setq ex-token-type 'minus))
453 ((looking-at "-[0-9]")
454 (forward-char 1)
455 (setq ex-token-type 'minus))
456 (t
457 (error viper-BadAddress))))
458 ((looking-at "/")
459 (forward-char 1)
460 (set-mark (point))
461 (let ((cont t))
462 (while (and (not (eolp)) cont)
463 ;;(re-search-forward "[^/]*/")
464 (re-search-forward "[^/]*\\(/\\|\n\\)")
465 (if (not (viper-looking-back "[^\\\\]\\(\\\\\\\\\\)*\\\\/"))
466 (setq cont nil))))
467 (backward-char 1)
468 (setq ex-token (buffer-substring (point) (mark t)))
469 (if (looking-at "/") (forward-char 1))
470 (setq ex-token-type 'search-forward))
471 ((looking-at "\\?")
472 (forward-char 1)
473 (set-mark (point))
474 (let ((cont t))
475 (while (and (not (eolp)) cont)
476 ;;(re-search-forward "[^\\?]*\\?")
477 (re-search-forward "[^\\?]*\\(\\?\\|\n\\)")
478 (if (not (viper-looking-back "[^\\\\]\\(\\\\\\\\\\)*\\\\\\?"))
479 (setq cont nil))
480 (backward-char 1)
481 (if (not (looking-at "\n")) (forward-char 1))))
482 (setq ex-token-type 'search-backward)
483 (setq ex-token (buffer-substring (1- (point)) (mark t))))
484 ((looking-at ",")
485 (forward-char 1)
486 (setq ex-token-type 'comma))
487 ((looking-at ";")
488 (forward-char 1)
489 (setq ex-token-type 'semi-colon))
490 ((looking-at "[!=><&~]")
491 (setq ex-token-type 'command)
492 (setq ex-token (char-to-string (following-char)))
493 (forward-char 1))
494 ((looking-at "'")
495 (setq ex-token-type 'goto-mark)
496 (forward-char 1)
497 (cond ((looking-at "'") (setq ex-token nil))
498 ((looking-at "[a-z]") (setq ex-token (following-char)))
499 (t (error "Marks are ' and a-z")))
500 (forward-char 1))
501 ((looking-at "\n")
502 (setq ex-token-type 'end-mark)
503 (setq ex-token "goto"))
504 (t
505 (error viper-BadExCommand))))))
506
507 ;; Reads Ex command. Tries to determine if it has to exit because command
508 ;; is complete or invalid. If not, keeps reading command.
509 (defun ex-cmd-read-exit ()
510 (interactive)
511 (setq viper-incomplete-ex-cmd t)
512 (let ((quit-regex1 (concat
513 "\\(" "set[ \t]*"
514 "\\|" "edit[ \t]*"
515 "\\|" "[nN]ext[ \t]*"
516 "\\|" "unm[ \t]*"
517 "\\|" "^[ \t]*rep"
518 "\\)"))
519 (quit-regex2 (concat
520 "[a-zA-Z][ \t]*"
521 "\\(" "!" "\\|" ">>"
522 "\\|" "\\+[0-9]+"
523 "\\)"
524 "*[ \t]*$"))
525 (stay-regex (concat
526 "\\(" "^[ \t]*$"
527 "\\|" "[?/].*"
528 "\\|" "[ktgjmsz][ \t]*$"
529 "\\|" "^[ \t]*ab.*"
530 "\\|" "tr[ansfer \t]*"
531 "\\|" "sr[ \t]*"
532 "\\|" "mo.*"
533 "\\|" "^[ \t]*k?ma[^p]*"
534 "\\|" "^[ \t]*fi.*"
535 "\\|" "v?gl.*"
536 "\\|" "[vg][ \t]*$"
537 "\\|" "jo.*"
538 "\\|" "^[ \t]*ta.*"
539 "\\|" "^[ \t]*una.*"
540 ;; don't jump up in :s command
541 "\\|" "^[ \t]*\\([`'][a-z]\\|[.,%]\\)*[ \t]*su.*"
542 "\\|" "^[ \t]*\\([`'][a-z]\\|[.,%]\\)*[ \t]*s[^a-z].*"
543 "\\|" "['`][a-z][ \t]*"
544 ;; r! assumes that the next one is a shell command
545 "\\|" "\\(r\\|re\\|rea\\|read\\)[ \t]*!"
546 ;; w ! assumes that the next one is a shell command
547 "\\|" "\\(w\\|wr\\|wri\\|writ.?\\)[ \t]+!"
548 "\\|" "![ \t]*[a-zA-Z].*"
549 "\\)"
550 "!*")))
551
552 (save-window-excursion ;; put cursor at the end of the Ex working buffer
553 (setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name))
554 (set-buffer viper-ex-work-buf)
555 (goto-char (point-max)))
556 (cond ((viper-looking-back quit-regex1) (exit-minibuffer))
557 ((viper-looking-back stay-regex) (insert " "))
558 ((viper-looking-back quit-regex2) (exit-minibuffer))
559 (t (insert " ")))))
560
561 ;; complete Ex command
562 (defun ex-cmd-complete ()
563 (interactive)
564 (let (save-pos dist compl-list string-to-complete completion-result)
565
566 (save-excursion
567 (setq dist (skip-chars-backward "[a-zA-Z!=>&~]")
568 save-pos (point)))
569
570 (if (or (= dist 0)
571 (viper-looking-back "\\([ \t]*['`][ \t]*[a-z]*\\)")
572 (viper-looking-back
573 "^[ \t]*[a-zA-Z!=>&~][ \t]*[/?]*[ \t]+[a-zA-Z!=>&~]+"))
574 ;; Preceding characters are not the ones allowed in an Ex command
575 ;; or we have typed past command name.
576 ;; Note: we didn't do parsing, so there can be surprises.
577 (if (or (viper-looking-back "[a-zA-Z!=>&~][ \t]*[/?]*[ \t]*")
578 (viper-looking-back "\\([ \t]*['`][ \t]*[a-z]*\\)")
579 (looking-at "[^ \t\n\C-m]"))
580 nil
581 (with-output-to-temp-buffer "*Completions*"
582 (display-completion-list
583 (viper-alist-to-list ex-token-alist))))
584 ;; Preceding chars may be part of a command name
585 (setq string-to-complete (buffer-substring save-pos (point)))
586 (setq completion-result
587 (try-completion string-to-complete ex-token-alist))
588
589 (cond ((eq completion-result t) ; exact match--do nothing
590 (viper-tmp-insert-at-eob " (Sole completion)"))
591 ((eq completion-result nil)
592 (viper-tmp-insert-at-eob " (No match)"))
593 (t ;; partial completion
594 (goto-char save-pos)
595 (delete-region (point) (point-max))
596 (insert completion-result)
597 (let (case-fold-search)
598 (setq compl-list
599 (viper-filter-alist (concat "^" completion-result)
600 ex-token-alist)))
601 (if (> (length compl-list) 1)
602 (with-output-to-temp-buffer "*Completions*"
603 (display-completion-list
604 (viper-alist-to-list (reverse compl-list)))))))
605 )))
606
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 (viper-looking-back
750 (format "[^\\\\]\\(\\\\\\\\\\)*\\\\%c" c)))
751 (setq cont nil)
752 ;; we are at an escaped delimiter: unescape it and continue
753 (delete-backward-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 ;; Returns an address as a point
830 (defun viper-get-ex-address-subr (old-address dot)
831 (let ((address nil))
832 (if (null old-address) (setq old-address dot))
833 (cond ((eq ex-token-type 'dot)
834 (setq address dot))
835 ((eq ex-token-type 'add-number)
836 (save-excursion
837 (goto-char old-address)
838 (forward-line (if (= old-address 0) (1- ex-token) ex-token))
839 (setq address (point-marker))))
840 ((eq ex-token-type 'sub-number)
841 (save-excursion
842 (goto-char old-address)
843 (forward-line (- ex-token))
844 (setq address (point-marker))))
845 ((eq ex-token-type 'abs-number)
846 (save-excursion
847 (goto-char (point-min))
848 (if (= ex-token 0) (setq address 0)
849 (forward-line (1- ex-token))
850 (setq address (point-marker)))))
851 ((eq ex-token-type 'end)
852 (save-excursion
853 (goto-char (1- (point-max)))
854 (setq address (point-marker))))
855 ((eq ex-token-type 'plus) t) ; do nothing
856 ((eq ex-token-type 'minus) t) ; do nothing
857 ((eq ex-token-type 'search-forward)
858 (save-excursion
859 (ex-search-address t)
860 (setq address (point-marker))))
861 ((eq ex-token-type 'search-backward)
862 (save-excursion
863 (ex-search-address nil)
864 (setq address (point-marker))))
865 ((eq ex-token-type 'goto-mark)
866 (save-excursion
867 (if (null ex-token)
868 (exchange-point-and-mark)
869 (goto-char
870 (viper-register-to-point
871 (viper-int-to-char (1+ (- ex-token ?a))) 'enforce-buffer)))
872 (setq address (point-marker)))))
873 address))
874
875
876 ;; Search pattern and set address
877 ;; Doesn't wrap around. Should it?
878 (defun ex-search-address (forward)
879 (if (string= ex-token "")
880 (if (null viper-s-string)
881 (error viper-NoPrevSearch)
882 (setq ex-token viper-s-string))
883 (setq viper-s-string ex-token))
884 (if forward
885 (progn
886 (forward-line 1)
887 (re-search-forward ex-token))
888 (forward-line -1)
889 (re-search-backward ex-token)))
890
891 ;; Get a buffer name and set `ex-count' and `ex-flag' if found
892 (defun viper-get-ex-buffer ()
893 (setq ex-buffer nil)
894 (setq ex-count nil)
895 (setq ex-flag nil)
896 (save-window-excursion
897 (setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name))
898 (set-buffer viper-ex-work-buf)
899 (skip-chars-forward " \t")
900 (if (looking-at "[a-zA-Z]")
901 (progn
902 (setq ex-buffer (following-char))
903 (forward-char 1)
904 (skip-chars-forward " \t")))
905 (if (looking-at "[0-9]")
906 (progn
907 (set-mark (point))
908 (re-search-forward "[0-9][0-9]*")
909 (setq ex-count (string-to-number (buffer-substring (point) (mark t))))
910 (skip-chars-forward " \t")))
911 (if (looking-at "[pl#]")
912 (progn
913 (setq ex-flag t)
914 (forward-char 1)))
915 (if (not (looking-at "[\n|]"))
916 (error "`%s': %s" ex-token viper-SpuriousText))))
917
918 (defun viper-get-ex-count ()
919 (setq ex-variant nil
920 ex-count nil
921 ex-flag nil)
922 (save-window-excursion
923 (setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name))
924 (set-buffer viper-ex-work-buf)
925 (skip-chars-forward " \t")
926 (if (looking-at "!")
927 (progn
928 (setq ex-variant t)
929 (forward-char 1)))
930 (skip-chars-forward " \t")
931 (if (looking-at "[0-9]")
932 (progn
933 (set-mark (point))
934 (re-search-forward "[0-9][0-9]*")
935 (setq ex-count (string-to-number (buffer-substring (point) (mark t))))
936 (skip-chars-forward " \t")))
937 (if (looking-at "[pl#]")
938 (progn
939 (setq ex-flag t)
940 (forward-char 1)))
941 (if (not (looking-at "[\n|]"))
942 (error "`%s': %s"
943 (buffer-substring
944 (point-min) (1- (point-max))) viper-BadExCommand))))
945
946 ;; Expand \% and \# in ex command
947 (defun ex-expand-filsyms (cmd buf)
948 (let (cf pf ret)
949 (save-excursion
950 (set-buffer buf)
951 (setq cf buffer-file-name)
952 (setq pf (ex-next nil t))) ; this finds alternative file name
953 (if (and (null cf) (string-match "[^\\]%\\|\\`%" cmd))
954 (error "No current file to substitute for `%%'"))
955 (if (and (null pf) (string-match "[^\\]#\\|\\`#" cmd))
956 (error "No alternate file to substitute for `#'"))
957 (save-excursion
958 (set-buffer (get-buffer-create viper-ex-tmp-buf-name))
959 (erase-buffer)
960 (insert cmd)
961 (goto-char (point-min))
962 (while (re-search-forward "%\\|#" nil t)
963 (let ((data (match-data))
964 (char (buffer-substring (match-beginning 0) (match-end 0))))
965 (if (viper-looking-back (concat "\\\\" char))
966 (replace-match char)
967 (store-match-data data)
968 (if (string= char "%")
969 (replace-match cf)
970 (replace-match pf)))))
971 (end-of-line)
972 (setq ret (buffer-substring (point-min) (point)))
973 (message "%s" ret))
974 ret))
975
976 ;; Get a file name and set `ex-variant', `ex-append' and `ex-offset' if found
977 ;; If it is r!, then get the command name and whatever args
978 (defun viper-get-ex-file ()
979 (let (prompt)
980 (setq ex-file nil
981 ex-variant nil
982 ex-append nil
983 ex-offset nil
984 ex-cmdfile nil
985 ex-cmdfile-args "")
986 (save-excursion
987 (save-window-excursion
988 (setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name))
989 (set-buffer viper-ex-work-buf)
990 (skip-chars-forward " \t")
991 (if (looking-at "!")
992 (if (and (not (viper-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 ((viper-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 ;; Ex delete command
1209 (defun ex-delete ()
1210 (viper-default-ex-addresses)
1211 (viper-get-ex-buffer)
1212 (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses))))
1213 (if (> beg end) (error viper-FirstAddrExceedsSecond))
1214 (save-excursion
1215 (viper-enlarge-region beg end)
1216 (exchange-point-and-mark)
1217 (if ex-count
1218 (progn
1219 (set-mark (point))
1220 (forward-line (1- ex-count)))
1221 (set-mark end))
1222 (viper-enlarge-region (point) (mark t))
1223 (if ex-flag
1224 ;; show text to be deleted and ask for confirmation
1225 (progn
1226 (with-output-to-temp-buffer " *delete text*"
1227 (princ (buffer-substring (point) (mark t))))
1228 (condition-case nil
1229 (read-string "[Hit return to confirm] ")
1230 (quit
1231 (save-excursion (kill-buffer " *delete text*"))
1232 (error "Viper bell")))
1233 (save-excursion (kill-buffer " *delete text*")))
1234 (if ex-buffer
1235 (cond ((viper-valid-register ex-buffer '(Letter))
1236 (viper-append-to-register
1237 (downcase ex-buffer) (point) (mark t)))
1238 ((viper-valid-register ex-buffer)
1239 (copy-to-register ex-buffer (point) (mark t) nil))
1240 (t (error viper-InvalidRegister ex-buffer))))
1241 (kill-region (point) (mark t))))))
1242
1243
1244
1245 ;; Ex edit command
1246 ;; In Viper, `e' and `e!' behave identically. In both cases, the user is
1247 ;; asked if current buffer should really be discarded.
1248 ;; This command can take multiple file names. It replaces the current buffer
1249 ;; with the first file in its argument list
1250 (defun ex-edit (&optional file)
1251 (if (not file)
1252 (viper-get-ex-file))
1253 (cond ((and (string= ex-file "") buffer-file-name)
1254 (setq ex-file (viper-abbreviate-file-name (buffer-file-name))))
1255 ((string= ex-file "")
1256 (error viper-NoFileSpecified)))
1257
1258 (let (msg do-edit)
1259 (if buffer-file-name
1260 (cond ((buffer-modified-p)
1261 (setq msg
1262 (format "Buffer %s is modified. Discard changes? "
1263 (buffer-name))
1264 do-edit t))
1265 ((not (verify-visited-file-modtime (current-buffer)))
1266 (setq msg
1267 (format "File %s changed on disk. Reread from disk? "
1268 buffer-file-name)
1269 do-edit t))
1270 (t (setq do-edit nil))))
1271
1272 (if do-edit
1273 (if (yes-or-no-p msg)
1274 (progn
1275 (set-buffer-modified-p nil)
1276 (kill-buffer (current-buffer)))
1277 (message "Buffer %s was left intact" (buffer-name))))
1278 ) ; let
1279
1280 (if (null (setq file (get-file-buffer ex-file)))
1281 (progn
1282 ;; this also does shell-style globbing
1283 (ex-find-file
1284 ;; replace # and % with the previous/current file
1285 (ex-expand-filsyms ex-file (current-buffer)))
1286 (or (eq major-mode 'dired-mode)
1287 (viper-change-state-to-vi))
1288 (goto-char (point-min)))
1289 (switch-to-buffer file))
1290 (if ex-offset
1291 (progn
1292 (save-window-excursion
1293 (setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name))
1294 (set-buffer viper-ex-work-buf)
1295 (delete-region (point-min) (point-max))
1296 (insert ex-offset "\n")
1297 (goto-char (point-min)))
1298 (goto-char (viper-get-ex-address))
1299 (beginning-of-line)))
1300 (ex-fixup-history viper-last-ex-prompt ex-file))
1301
1302 ;; Find-file FILESPEC if it appears to specify a single file.
1303 ;; Otherwise, assume that FILESPEC is a wildcard.
1304 ;; In this case, split it into substrings separated by newlines.
1305 ;; Each line is assumed to be a file name.
1306 (defun ex-find-file (filespec)
1307 (let ((nonstandard-filename-chars "[^-a-zA-Z0-9_./,~$\\]"))
1308 (cond ((file-exists-p filespec) (find-file filespec))
1309 ((string-match nonstandard-filename-chars filespec)
1310 (mapcar 'find-file (funcall viper-glob-function filespec)))
1311 (t (find-file filespec)))
1312 ))
1313
1314
1315 ;; Ex global command
1316 ;; This is executed in response to:
1317 ;; :global "pattern" ex-command
1318 ;; :vglobal "pattern" ex-command
1319 ;; :global executes ex-command on all lines matching <pattern>
1320 ;; :vglobal executes ex-command on all lines that don't match <pattern>
1321 ;;
1322 ;; With VARIANT nil, this functions executes :global
1323 ;; With VARIANT t, executes :vglobal
1324 (defun ex-global (variant)
1325 (let ((gcommand ex-token))
1326 (if (or ex-g-flag ex-g-variant)
1327 (error "`%s' within `global' is not allowed" gcommand)
1328 (if variant
1329 (setq ex-g-flag nil
1330 ex-g-variant t)
1331 (setq ex-g-flag t
1332 ex-g-variant nil)))
1333 (viper-get-ex-pat)
1334 (if (null ex-token)
1335 (error "`%s': Missing regular expression" gcommand)))
1336
1337 (if (string= ex-token "")
1338 (if (null viper-s-string)
1339 (error viper-NoPrevSearch)
1340 (setq ex-g-pat viper-s-string))
1341 (setq ex-g-pat ex-token
1342 viper-s-string ex-token))
1343 (if (null ex-addresses)
1344 (setq ex-addresses (list (point-max) (point-min)))
1345 (viper-default-ex-addresses))
1346 (setq ex-g-marks nil)
1347 (let ((mark-count 0)
1348 (end (car ex-addresses))
1349 (beg (car (cdr ex-addresses)))
1350 com-str)
1351 (if (> beg end) (error viper-FirstAddrExceedsSecond))
1352 (save-excursion
1353 (viper-enlarge-region beg end)
1354 (exchange-point-and-mark)
1355 (let ((cont t) (limit (point-marker)))
1356 (exchange-point-and-mark)
1357 ;; skip the last line if empty
1358 (beginning-of-line)
1359 (if (eobp) (viper-backward-char-carefully))
1360 (while (and cont (not (bobp)) (>= (point) limit))
1361 (beginning-of-line)
1362 (set-mark (point))
1363 (end-of-line)
1364 (let ((found (re-search-backward ex-g-pat (mark t) t)))
1365 (if (or (and ex-g-flag found)
1366 (and ex-g-variant (not found)))
1367 (progn
1368 (end-of-line)
1369 (setq mark-count (1+ mark-count))
1370 (setq ex-g-marks (cons (point-marker) ex-g-marks)))))
1371 (beginning-of-line)
1372 (if (bobp) (setq cont nil)
1373 (forward-line -1)
1374 (end-of-line)))))
1375 (save-window-excursion
1376 (setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name))
1377 (set-buffer viper-ex-work-buf)
1378 ;; com-str is the command string, i.e., g/pattern/ or v/pattern'
1379 (setq com-str (buffer-substring (1+ (point)) (1- (point-max)))))
1380 (while ex-g-marks
1381 (goto-char (car ex-g-marks))
1382 (viper-ex nil com-str)
1383 (setq mark-count (1- mark-count))
1384 (setq ex-g-marks (cdr ex-g-marks)))))
1385
1386 ;; Ex goto command
1387 (defun ex-goto ()
1388 (if (null ex-addresses)
1389 (setq ex-addresses (cons (point) nil)))
1390 (push-mark (point) t)
1391 (goto-char (car ex-addresses))
1392 (beginning-of-line)
1393 )
1394
1395 ;; Ex line commands. COM is join, shift-right or shift-left
1396 (defun ex-line (com)
1397 (viper-default-ex-addresses)
1398 (viper-get-ex-count)
1399 (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses))) point)
1400 (if (> beg end) (error viper-FirstAddrExceedsSecond))
1401 (save-excursion
1402 (viper-enlarge-region beg end)
1403 (exchange-point-and-mark)
1404 (if ex-count
1405 (progn
1406 (set-mark (point))
1407 (forward-line ex-count)))
1408 (if ex-flag
1409 ;; show text to be joined and ask for confirmation
1410 (progn
1411 (with-output-to-temp-buffer " *join text*"
1412 (princ (buffer-substring (point) (mark t))))
1413 (condition-case nil
1414 (progn
1415 (read-string "[Hit return to confirm] ")
1416 (ex-line-subr com (point) (mark t)))
1417 (quit (ding)))
1418 (save-excursion (kill-buffer " *join text*")))
1419 (ex-line-subr com (point) (mark t)))
1420 (setq point (point)))
1421 (goto-char (1- point))
1422 (beginning-of-line)))
1423
1424 (defun ex-line-subr (com beg end)
1425 (cond ((string= com "join")
1426 (goto-char (min beg end))
1427 (while (and (not (eobp)) (< (point) (max beg end)))
1428 (end-of-line)
1429 (if (and (<= (point) (max beg end)) (not (eobp)))
1430 (progn
1431 (forward-line 1)
1432 (delete-region (point) (1- (point)))
1433 (if (not ex-variant) (fixup-whitespace))))))
1434 ((or (string= com "right") (string= com "left"))
1435 (indent-rigidly
1436 (min beg end) (max beg end)
1437 (if (string= com "right") viper-shift-width (- viper-shift-width)))
1438 (goto-char (max beg end))
1439 (end-of-line)
1440 (viper-forward-char-carefully))))
1441
1442
1443 ;; Ex mark command
1444 ;; Sets the mark to the current point.
1445 ;; If name is omitted, get the name straight from the work buffer."
1446 (defun ex-mark (&optional name)
1447 (let (char)
1448 (if (null ex-addresses)
1449 (setq ex-addresses
1450 (cons (point) nil)))
1451 (if name
1452 (if (eq 1 (length name))
1453 (setq char (string-to-char name))
1454 (error "`%s': Spurious text \"%s\" after mark name"
1455 name (substring name 1)))
1456 (save-window-excursion
1457 (setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name))
1458 (set-buffer viper-ex-work-buf)
1459 (skip-chars-forward " \t")
1460 (if (looking-at "[a-z]")
1461 (progn
1462 (setq char (following-char))
1463 (forward-char 1)
1464 (skip-chars-forward " \t")
1465 (if (not (looking-at "[\n|]"))
1466 (error "`%s': %s" ex-token viper-SpuriousText)))
1467 (error "`%s' requires a following letter" ex-token))))
1468 (save-excursion
1469 (goto-char (car ex-addresses))
1470 (point-to-register (viper-int-to-char (1+ (- char ?a)))))))
1471
1472
1473
1474 ;; Alternate file is the file next to the first one in the buffer ring
1475 (defun ex-next (cycle-other-window &optional find-alt-file)
1476 (catch 'ex-edit
1477 (let (count l)
1478 (if (not find-alt-file)
1479 (progn
1480 (viper-get-ex-file)
1481 (if (or (char-or-string-p ex-offset)
1482 (and (not (string= "" ex-file))
1483 (not (string-match "^[0-9]+$" ex-file))))
1484 (progn
1485 (ex-edit t)
1486 (throw 'ex-edit nil))
1487 (setq count (string-to-number ex-file))
1488 (if (= count 0) (setq count 1))
1489 (if (< count 0) (error "Usage: `next <count>' (count >= 0)"))))
1490 (setq count 1))
1491 (setq l (viper-undisplayed-files))
1492 (while (> count 0)
1493 (while (and (not (null l)) (null (car l)))
1494 (setq l (cdr l)))
1495 (setq count (1- count))
1496 (if (> count 0)
1497 (setq l (cdr l))))
1498 (if find-alt-file (car l)
1499 (progn
1500 (if (and (car l) (get-file-buffer (car l)))
1501 (let* ((w (if cycle-other-window
1502 (get-lru-window) (selected-window)))
1503 (b (window-buffer w)))
1504 (set-window-buffer w (get-file-buffer (car l)))
1505 (bury-buffer b)
1506 ;; this puts "next <count>" in the ex-command history
1507 (ex-fixup-history viper-last-ex-prompt ex-file))
1508 (error "Not that many undisplayed files")))))))
1509
1510
1511 (defun ex-next-related-buffer (direction &optional no-recursion)
1512
1513 (viper-ring-rotate1 viper-related-files-and-buffers-ring direction)
1514
1515 (let ((file-or-buffer-name
1516 (viper-current-ring-item viper-related-files-and-buffers-ring))
1517 (old-ring viper-related-files-and-buffers-ring)
1518 (old-win (selected-window))
1519 skip-rest buf wind)
1520
1521 (or (and (ring-p viper-related-files-and-buffers-ring)
1522 (> (ring-length viper-related-files-and-buffers-ring) 0))
1523 (error "This buffer has no related files or buffers"))
1524
1525 (or (stringp file-or-buffer-name)
1526 (error
1527 "File and buffer names must be strings, %S" file-or-buffer-name))
1528
1529 (setq buf (cond ((get-buffer file-or-buffer-name))
1530 ((file-exists-p file-or-buffer-name)
1531 (find-file-noselect file-or-buffer-name))
1532 ))
1533
1534 (if (not (viper-buffer-live-p buf))
1535 (error "Didn't find buffer %S or file %S"
1536 file-or-buffer-name
1537 (viper-abbreviate-file-name
1538 (expand-file-name file-or-buffer-name))))
1539
1540 (if (equal buf (current-buffer))
1541 (or no-recursion
1542 ;; try again
1543 (progn
1544 (setq skip-rest t)
1545 (ex-next-related-buffer direction 'norecursion))))
1546
1547 (if skip-rest
1548 ()
1549 ;; setup buffer
1550 (if (setq wind (viper-get-visible-buffer-window buf))
1551 ()
1552 (setq wind (get-lru-window (if (featurep 'xemacs) nil 'visible)))
1553 (set-window-buffer wind buf))
1554
1555 (if (viper-window-display-p)
1556 (progn
1557 (raise-frame (window-frame wind))
1558 (if (equal (window-frame wind) (window-frame old-win))
1559 (save-window-excursion (select-window wind) (sit-for 1))
1560 (select-window wind)))
1561 (save-window-excursion (select-window wind) (sit-for 1)))
1562
1563 (save-excursion
1564 (set-buffer buf)
1565 (setq viper-related-files-and-buffers-ring old-ring))
1566
1567 (setq viper-local-search-start-marker (point-marker))
1568 )))
1569
1570
1571 ;; Force auto save
1572 (defun ex-preserve ()
1573 (message "Autosaving all buffers that need to be saved...")
1574 (do-auto-save t))
1575
1576 ;; Ex put
1577 (defun ex-put ()
1578 (let ((point (if (null ex-addresses) (point) (car ex-addresses))))
1579 (viper-get-ex-buffer)
1580 (setq viper-use-register ex-buffer)
1581 (goto-char point)
1582 (if (bobp) (viper-Put-back 1) (viper-put-back 1))))
1583
1584 ;; Ex print working directory
1585 (defun ex-pwd ()
1586 (message "%s" default-directory))
1587
1588 ;; Ex quit command
1589 (defun ex-quit ()
1590 ;; skip "!", if it is q!. In Viper q!, w!, etc., behave as q, w, etc.
1591 (save-excursion
1592 (setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name))
1593 (set-buffer viper-ex-work-buf)
1594 (if (looking-at "!") (forward-char 1)))
1595 (if (< viper-expert-level 3)
1596 (save-buffers-kill-emacs)
1597 (kill-buffer (current-buffer))))
1598
1599
1600 ;; Ex read command
1601 ;; ex-read doesn't support wildcards, because file completion is a better
1602 ;; mechanism. We also don't support # and % (except in :r <shell-command>
1603 ;; because file history is a better mechanism.
1604 (defun ex-read ()
1605 (viper-get-ex-file)
1606 (let ((point (if (null ex-addresses) (point) (car ex-addresses)))
1607 command)
1608 (goto-char point)
1609 (viper-add-newline-at-eob-if-necessary)
1610 (if (not (or (bobp) (eobp))) (forward-line 1))
1611 (if (and (not ex-variant) (string= ex-file ""))
1612 (progn
1613 (if (null buffer-file-name)
1614 (error viper-NoFileSpecified))
1615 (setq ex-file buffer-file-name)))
1616 (if ex-cmdfile
1617 (progn
1618 (setq command
1619 ;; replace # and % with the previous/current file
1620 (ex-expand-filsyms
1621 (concat (shell-quote-argument ex-file) ex-cmdfile-args)
1622 (current-buffer)))
1623 (shell-command command t))
1624 (insert-file-contents ex-file)))
1625 (ex-fixup-history viper-last-ex-prompt ex-file ex-cmdfile-args))
1626
1627 ;; this function fixes ex-history for some commands like ex-read, ex-edit
1628 (defun ex-fixup-history (&rest args)
1629 (setq viper-ex-history
1630 (cons (mapconcat 'identity args " ") (cdr viper-ex-history))))
1631
1632
1633 ;; Ex recover from emacs \#file\#
1634 (defun ex-recover ()
1635 (viper-get-ex-file)
1636 (if (or ex-append ex-offset)
1637 (error "`recover': %s" viper-SpuriousText))
1638 (if (string= ex-file "")
1639 (progn
1640 (if (null buffer-file-name)
1641 (error "This buffer isn't visiting any file"))
1642 (setq ex-file buffer-file-name))
1643 (setq ex-file (expand-file-name ex-file)))
1644 (if (and (not (string= ex-file (buffer-file-name)))
1645 (buffer-modified-p)
1646 (not ex-variant))
1647 (error "No write since last change \(:rec! overrides\)"))
1648 (recover-file ex-file))
1649
1650 ;; Tell that `rewind' is obsolete and to use `:next count' instead
1651 (defun ex-rewind ()
1652 (message
1653 "Use `:n <count>' instead. Counts are obtained from the `:args' command"))
1654
1655
1656 ;; read variable name for ex-set
1657 (defun ex-set-read-variable ()
1658 (let ((minibuffer-local-completion-map
1659 (copy-keymap minibuffer-local-completion-map))
1660 (cursor-in-echo-area t)
1661 str batch)
1662 (define-key
1663 minibuffer-local-completion-map " " 'minibuffer-complete-and-exit)
1664 (define-key minibuffer-local-completion-map "=" 'exit-minibuffer)
1665 (if (viper-set-unread-command-events
1666 (ex-get-inline-cmd-args "[ \t]*[a-zA-Z]*[ \t]*" nil "\C-m"))
1667 (progn
1668 (setq batch t)
1669 (viper-set-unread-command-events ?\C-m)))
1670 (message ":set <Variable> [= <Value>]")
1671 (or batch (sit-for 2))
1672
1673 (while (string-match "^[ \\t\\n]*$"
1674 (setq str
1675 (completing-read ":set " ex-variable-alist)))
1676 (message ":set <Variable> [= <Value>]")
1677 ;; if there are unread events, don't wait
1678 (or (viper-set-unread-command-events "") (sit-for 2))
1679 ) ; while
1680 str))
1681
1682
1683 (defun ex-set ()
1684 (let ((var (ex-set-read-variable))
1685 (val 0)
1686 (set-cmd "setq")
1687 (ask-if-save t)
1688 (auto-cmd-label "; don't touch or else...")
1689 (delete-turn-on-auto-fill-pattern
1690 "([ \t]*add-hook[ \t]+'viper-insert-state-hook[ \t]+'turn-on-auto-fill.*)")
1691 actual-lisp-cmd lisp-cmd-del-pattern
1692 val2 orig-var)
1693 (setq orig-var var)
1694 (cond ((string= var "all")
1695 (setq ask-if-save nil
1696 set-cmd nil))
1697 ((member var '("ai" "autoindent"))
1698 (setq var "viper-auto-indent"
1699 set-cmd "setq"
1700 ask-if-save nil
1701 val "t"))
1702 ((member var '("ai-g" "autoindent-global"))
1703 (kill-local-variable 'viper-auto-indent)
1704 (setq var "viper-auto-indent"
1705 set-cmd "setq-default"
1706 val "t"))
1707 ((member var '("noai" "noautoindent"))
1708 (setq var "viper-auto-indent"
1709 ask-if-save nil
1710 val "nil"))
1711 ((member var '("noai-g" "noautoindent-global"))
1712 (kill-local-variable 'viper-auto-indent)
1713 (setq var "viper-auto-indent"
1714 set-cmd "setq-default"
1715 val "nil"))
1716 ((member var '("ic" "ignorecase"))
1717 (setq var "viper-case-fold-search"
1718 val "t"))
1719 ((member var '("noic" "noignorecase"))
1720 (setq var "viper-case-fold-search"
1721 val "nil"))
1722 ((member var '("ma" "magic"))
1723 (setq var "viper-re-search"
1724 val "t"))
1725 ((member var '("noma" "nomagic"))
1726 (setq var "viper-re-search"
1727 val "nil"))
1728 ((member var '("ro" "readonly"))
1729 (setq var "buffer-read-only"
1730 val "t"))
1731 ((member var '("noro" "noreadonly"))
1732 (setq var "buffer-read-only"
1733 val "nil"))
1734 ((member var '("sm" "showmatch"))
1735 (setq var "blink-matching-paren"
1736 val "t"))
1737 ((member var '("nosm" "noshowmatch"))
1738 (setq var "blink-matching-paren"
1739 val "nil"))
1740 ((member var '("ws" "wrapscan"))
1741 (setq var "viper-search-wrap-around"
1742 val "t"))
1743 ((member var '("nows" "nowrapscan"))
1744 (setq var "viper-search-wrap-around"
1745 val "nil")))
1746 (if (and set-cmd (eq val 0)) ; value must be set by the user
1747 (let ((cursor-in-echo-area t))
1748 (message ":set %s = <Value>" var)
1749 ;; if there are unread events, don't wait
1750 (or (viper-set-unread-command-events "") (sit-for 2))
1751 (setq val (read-string (format ":set %s = " var)))
1752 (ex-fixup-history "set" orig-var val)
1753
1754 ;; check numerical values
1755 (if (member var
1756 '("sw" "shiftwidth"
1757 "ts" "tabstop"
1758 "ts-g" "tabstop-global"
1759 "wm" "wrapmargin"))
1760 (condition-case nil
1761 (or (numberp (setq val2 (car (read-from-string val))))
1762 (error "%s: Invalid value, numberp, %S" var val))
1763 (error
1764 (error "%s: Invalid value, numberp, %S" var val))))
1765
1766 (cond
1767 ((member var '("sw" "shiftwidth"))
1768 (setq var "viper-shift-width"))
1769 ((member var '("ts" "tabstop"))
1770 ;; make it take effect in curr buff and new bufs
1771 (setq var "tab-width"
1772 set-cmd "setq"
1773 ask-if-save nil))
1774 ((member var '("ts-g" "tabstop-global"))
1775 (kill-local-variable 'tab-width)
1776 (setq var "tab-width"
1777 set-cmd "setq-default"))
1778 ((member var '("wm" "wrapmargin"))
1779 ;; make it take effect in curr buff and new bufs
1780 (kill-local-variable 'fill-column)
1781 (setq var "fill-column"
1782 val (format "(- (window-width) %s)" val)
1783 set-cmd "setq-default"))
1784 ((member var '("sh" "shell"))
1785 (setq var "explicit-shell-file-name"
1786 val (format "\"%s\"" val)))))
1787 (ex-fixup-history "set" orig-var))
1788
1789 (if set-cmd
1790 (setq actual-lisp-cmd
1791 (format "\n(%s %s %s) %s" set-cmd var val auto-cmd-label)
1792 lisp-cmd-del-pattern
1793 (format "^\n?[ \t]*([ \t]*%s[ \t]+%s[ \t].*)[ \t]*%s"
1794 set-cmd var auto-cmd-label)))
1795
1796 (if (and ask-if-save
1797 (y-or-n-p (format "Do you want to save this setting in %s "
1798 viper-custom-file-name)))
1799 (progn
1800 (viper-save-string-in-file
1801 actual-lisp-cmd viper-custom-file-name
1802 ;; del pattern
1803 lisp-cmd-del-pattern)
1804 (if (string= var "fill-column")
1805 (if (> val2 0)
1806 (viper-save-string-in-file
1807 (concat
1808 "(add-hook 'viper-insert-state-hook 'turn-on-auto-fill) "
1809 auto-cmd-label)
1810 viper-custom-file-name
1811 delete-turn-on-auto-fill-pattern)
1812 (viper-save-string-in-file
1813 nil viper-custom-file-name delete-turn-on-auto-fill-pattern)
1814 (viper-save-string-in-file
1815 nil viper-custom-file-name
1816 ;; del pattern
1817 lisp-cmd-del-pattern)
1818 ))
1819 ))
1820
1821 (if set-cmd
1822 (message "%s %s %s"
1823 set-cmd var
1824 (if (string-match "^[ \t]*$" val)
1825 (format "%S" val)
1826 val)))
1827 (if actual-lisp-cmd
1828 (eval (car (read-from-string actual-lisp-cmd))))
1829 (if (string= var "fill-column")
1830 (if (> val2 0)
1831 (auto-fill-mode 1)
1832 (auto-fill-mode -1)))
1833 (if (string= var "all") (ex-show-vars))
1834 ))
1835
1836 ;; In inline args, skip regex-forw and (optionally) chars-back.
1837 ;; Optional 3d arg is a string that should replace ' ' to prevent its
1838 ;; special meaning
1839 (defun ex-get-inline-cmd-args (regex-forw &optional chars-back replace-str)
1840 (save-excursion
1841 (setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name))
1842 (set-buffer viper-ex-work-buf)
1843 (goto-char (point-min))
1844 (re-search-forward regex-forw nil t)
1845 (let ((beg (point))
1846 end)
1847 (goto-char (point-max))
1848 (if chars-back
1849 (skip-chars-backward chars-back)
1850 (skip-chars-backward " \t\n\C-m"))
1851 (setq end (point))
1852 ;; replace SPC with `=' to suppress the special meaning SPC has
1853 ;; in Ex commands
1854 (goto-char beg)
1855 (if replace-str
1856 (while (re-search-forward " +" nil t)
1857 (replace-match replace-str nil t)
1858 (viper-forward-char-carefully)))
1859 (goto-char end)
1860 (buffer-substring beg end))))
1861
1862
1863 ;; Ex shell command
1864 (defun ex-shell ()
1865 (shell))
1866
1867 ;; Viper help. Invokes Info
1868 (defun ex-help ()
1869 (condition-case nil
1870 (progn
1871 (pop-to-buffer (get-buffer-create "*info*"))
1872 (info (if (featurep 'xemacs) "viper.info" "viper"))
1873 (message "Type `i' to search for a specific topic"))
1874 (error (beep 1)
1875 (with-output-to-temp-buffer " *viper-info*"
1876 (princ (format "
1877 The Info file for Viper does not seem to be installed.
1878
1879 This file is part of the standard distribution of %sEmacs.
1880 Please contact your system administrator. "
1881 (if (featurep 'xemacs) "X" "")
1882 ))))))
1883
1884 ;; Ex source command. Loads the file specified as argument or `~/.viper'
1885 (defun ex-source ()
1886 (viper-get-ex-file)
1887 (if (string= ex-file "")
1888 (load viper-custom-file-name)
1889 (load ex-file)))
1890
1891 ;; Ex substitute command
1892 ;; If REPEAT use previous regexp which is ex-reg-exp or viper-s-string
1893 (defun ex-substitute (&optional repeat r-flag)
1894 (let ((opt-g nil)
1895 (opt-c nil)
1896 (matched-pos nil)
1897 (case-fold-search viper-case-fold-search)
1898 delim pat repl)
1899 (if repeat (setq ex-token nil) (setq delim (viper-get-ex-pat)))
1900 (if (null ex-token)
1901 (progn
1902 (setq pat (if r-flag viper-s-string ex-reg-exp))
1903 (or (stringp pat)
1904 (error "No previous pattern to use in substitution"))
1905 (setq repl ex-repl
1906 delim (string-to-char pat)))
1907 (setq pat (if (string= ex-token "") viper-s-string ex-token))
1908 (setq viper-s-string pat
1909 ex-reg-exp pat)
1910 (setq delim (viper-get-ex-pat))
1911 (if (null ex-token)
1912 (setq ex-token ""
1913 ex-repl "")
1914 (setq repl ex-token
1915 ex-repl ex-token)))
1916 (while (viper-get-ex-opt-gc delim)
1917 (if (string= ex-token "g") (setq opt-g t) (setq opt-c t)))
1918 (viper-get-ex-count)
1919 (if ex-count
1920 (save-excursion
1921 (if ex-addresses (goto-char (car ex-addresses)))
1922 (set-mark (point))
1923 (forward-line (1- ex-count))
1924 (setq ex-addresses (cons (point) (cons (mark t) nil))))
1925 (if (null ex-addresses)
1926 (setq ex-addresses (cons (point) (cons (point) nil)))
1927 (if (null (cdr ex-addresses))
1928 (setq ex-addresses (cons (car ex-addresses) ex-addresses)))))
1929 ;(setq G opt-g)
1930 (let ((beg (car ex-addresses))
1931 (end (car (cdr ex-addresses)))
1932 eol-mark)
1933 (save-excursion
1934 (viper-enlarge-region beg end)
1935 (let ((limit (save-excursion
1936 (goto-char (max (point) (mark t)))
1937 (point-marker))))
1938 (goto-char (min (point) (mark t)))
1939 (while (< (point) limit)
1940 (save-excursion
1941 (end-of-line)
1942 ;; This move allows the use of newline as the last character in
1943 ;; the substitution pattern
1944 (viper-forward-char-carefully)
1945 (setq eol-mark (point-marker)))
1946 (beginning-of-line)
1947 (if opt-g
1948 (progn
1949 (while (and (not (eolp))
1950 (re-search-forward pat eol-mark t))
1951 (if (or (not opt-c)
1952 (progn
1953 (viper-put-on-search-overlay (match-beginning 0)
1954 (match-end 0))
1955 (y-or-n-p "Replace? ")))
1956 (progn
1957 (viper-hide-search-overlay)
1958 (setq matched-pos (point))
1959 (if (not (stringp repl))
1960 (error "Can't perform Ex substitution: No previous replacement pattern"))
1961 (replace-match repl t))))
1962 (end-of-line)
1963 (viper-forward-char-carefully))
1964 (if (null pat)
1965 (error
1966 "Can't repeat Ex substitution: No previous regular expression"))
1967 (if (and (re-search-forward pat eol-mark t)
1968 (or (not opt-c)
1969 (progn
1970 (viper-put-on-search-overlay (match-beginning 0)
1971 (match-end 0))
1972 (y-or-n-p "Replace? "))))
1973 (progn
1974 (viper-hide-search-overlay)
1975 (setq matched-pos (point))
1976 (if (not (stringp repl))
1977 (error "Can't perform Ex substitution: No previous replacement pattern"))
1978 (replace-match repl t)))
1979 ;;(end-of-line)
1980 ;;(viper-forward-char-carefully)
1981 (goto-char eol-mark)
1982 )))))
1983 (if matched-pos (goto-char matched-pos))
1984 (beginning-of-line)
1985 (if opt-c (message "done"))))
1986
1987 ;; Ex tag command
1988 (defun ex-tag ()
1989 (let (tag)
1990 (save-window-excursion
1991 (setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name))
1992 (set-buffer viper-ex-work-buf)
1993 (skip-chars-forward " \t")
1994 (set-mark (point))
1995 (skip-chars-forward "^ |\t\n")
1996 (setq tag (buffer-substring (mark t) (point))))
1997 (if (not (string= tag "")) (setq ex-tag tag))
1998 (viper-change-state-to-emacs)
1999 (condition-case conds
2000 (progn
2001 (if (string= tag "")
2002 (find-tag ex-tag t)
2003 (find-tag-other-window ex-tag))
2004 (viper-change-state-to-vi))
2005 (error
2006 (viper-change-state-to-vi)
2007 (viper-message-conditions conds)))))
2008
2009 ;; Ex write command
2010 ;; ex-write doesn't support wildcards, because file completion is a better
2011 ;; mechanism. We also don't support # and %
2012 ;; because file history is a better mechanism.
2013 (defun ex-write (q-flag)
2014 (viper-default-ex-addresses t)
2015 (viper-get-ex-file)
2016 (let ((end (car ex-addresses))
2017 (beg (car (cdr ex-addresses)))
2018 (orig-buf (current-buffer))
2019 ;;(orig-buf-file-name (buffer-file-name))
2020 ;;(orig-buf-name (buffer-name))
2021 ;;(buff-changed-p (buffer-modified-p))
2022 temp-buf writing-same-file region
2023 file-exists writing-whole-file)
2024 (if (> beg end) (error viper-FirstAddrExceedsSecond))
2025 (if ex-cmdfile
2026 (progn
2027 (viper-enlarge-region beg end)
2028 (shell-command-on-region (point) (mark t)
2029 (concat ex-file ex-cmdfile-args)))
2030 (if (and (string= ex-file "") (not (buffer-file-name)))
2031 (setq ex-file
2032 (read-file-name
2033 (format "Buffer %s isn't visiting any file. File to save in: "
2034 (buffer-name)))))
2035
2036 (setq writing-whole-file (and (= (point-min) beg) (= (point-max) end))
2037 ex-file (if (string= ex-file "")
2038 (buffer-file-name)
2039 (expand-file-name ex-file)))
2040 ;; if ex-file is a directory use the file portion of the buffer file name
2041 (if (and (file-directory-p ex-file)
2042 buffer-file-name
2043 (not (file-directory-p buffer-file-name)))
2044 (setq ex-file
2045 (concat (file-name-as-directory ex-file)
2046 (file-name-nondirectory buffer-file-name))))
2047
2048 (setq file-exists (file-exists-p ex-file)
2049 writing-same-file (string= ex-file (buffer-file-name)))
2050
2051 ;; do actual writing
2052 (if (and writing-whole-file writing-same-file)
2053 ;; saving whole buffer in visited file
2054 (if (not (buffer-modified-p))
2055 (message "(No changes need to be saved)")
2056 (viper-maybe-checkout (current-buffer))
2057 (save-buffer)
2058 (save-restriction
2059 (widen)
2060 (ex-write-info file-exists ex-file (point-min) (point-max))
2061 ))
2062 ;; writing to non-visited file and it already exists
2063 (if (and file-exists (not writing-same-file)
2064 (not (yes-or-no-p
2065 (format "File %s exists. Overwrite? " ex-file))))
2066 (error "Quit"))
2067 ;; writing a region or whole buffer to non-visited file
2068 (unwind-protect
2069 (save-excursion
2070 (viper-enlarge-region beg end)
2071 (setq region (buffer-substring (point) (mark t)))
2072 ;; create temp buffer for the region
2073 (setq temp-buf (get-buffer-create " *ex-write*"))
2074 (set-buffer temp-buf)
2075 (if (featurep 'xemacs)
2076 (set-visited-file-name ex-file)
2077 (set-visited-file-name ex-file 'noquery))
2078 (erase-buffer)
2079 (if (and file-exists ex-append)
2080 (insert-file-contents ex-file))
2081 (goto-char (point-max))
2082 (insert region)
2083 ;; ask user
2084 (viper-maybe-checkout (current-buffer))
2085 (setq selective-display nil)
2086 (save-buffer)
2087 (ex-write-info
2088 file-exists ex-file (point-min) (point-max))
2089 )
2090 ;; this must be under unwind-protect so that
2091 ;; temp-buf will be deleted in case of an error
2092 (set-buffer temp-buf)
2093 (set-buffer-modified-p nil)
2094 (kill-buffer temp-buf)
2095 ;; buffer/region has been written, now take care of details
2096 (set-buffer orig-buf)))
2097 ;; set the right file modification time
2098 (if (and (buffer-file-name) writing-same-file)
2099 (set-visited-file-modtime))
2100 ;; prevent loss of data if saving part of the buffer in visited file
2101 (or writing-whole-file
2102 (not writing-same-file)
2103 (progn
2104 (sit-for 2)
2105 (message "Warning: you have saved only part of the buffer!")
2106 (set-buffer-modified-p t)))
2107 (if q-flag
2108 (if (< viper-expert-level 2)
2109 (save-buffers-kill-emacs)
2110 (kill-buffer (current-buffer))))
2111 )))
2112
2113
2114 (defun ex-write-info (exists file-name beg end)
2115 (message "`%s'%s %d lines, %d characters"
2116 (viper-abbreviate-file-name file-name)
2117 (if exists "" " [New file]")
2118 (count-lines beg (min (1+ end) (point-max)))
2119 (- end beg)))
2120
2121 ;; Ex yank command
2122 (defun ex-yank ()
2123 (viper-default-ex-addresses)
2124 (viper-get-ex-buffer)
2125 (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses))))
2126 (if (> beg end) (error viper-FirstAddrExceedsSecond))
2127 (save-excursion
2128 (viper-enlarge-region beg end)
2129 (exchange-point-and-mark)
2130 (if (or ex-g-flag ex-g-variant)
2131 (error "Can't execute `yank' within `global'"))
2132 (if ex-count
2133 (progn
2134 (set-mark (point))
2135 (forward-line (1- ex-count)))
2136 (set-mark end))
2137 (viper-enlarge-region (point) (mark t))
2138 (if ex-flag (error "`yank': %s" viper-SpuriousText))
2139 (if ex-buffer
2140 (cond ((viper-valid-register ex-buffer '(Letter))
2141 (viper-append-to-register
2142 (downcase ex-buffer) (point) (mark t)))
2143 ((viper-valid-register ex-buffer)
2144 (copy-to-register ex-buffer (point) (mark t) nil))
2145 (t (error viper-InvalidRegister ex-buffer))))
2146 (copy-region-as-kill (point) (mark t)))))
2147
2148 ;; Execute shell command
2149 (defun ex-command ()
2150 (let (command)
2151 (save-window-excursion
2152 (setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name))
2153 (set-buffer viper-ex-work-buf)
2154 (skip-chars-forward " \t")
2155 (setq command (buffer-substring (point) (point-max)))
2156 (end-of-line))
2157 ;; replace # and % with the previous/current file
2158 (setq command (ex-expand-filsyms command (current-buffer)))
2159 (if (and (> (length command) 0) (string= "!" (substring command 0 1)))
2160 (if viper-ex-last-shell-com
2161 (setq command
2162 (concat viper-ex-last-shell-com (substring command 1)))
2163 (error "No previous shell command")))
2164 (setq viper-ex-last-shell-com command)
2165 (if (null ex-addresses)
2166 (shell-command command)
2167 (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses))))
2168 (if (null beg) (setq beg end))
2169 (save-excursion
2170 (goto-char beg)
2171 (set-mark end)
2172 (viper-enlarge-region (point) (mark t))
2173 (shell-command-on-region (point) (mark t) command t))
2174 (goto-char beg)))))
2175
2176 (defun ex-compile ()
2177 "Reads args from the command line, then runs make with the args.
2178 If no args are given, then it runs the last compile command.
2179 Type 'mak ' (including the space) to run make with no args."
2180 (let (args)
2181 (save-window-excursion
2182 (setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name))
2183 (set-buffer viper-ex-work-buf)
2184 (setq args (buffer-substring (point) (point-max)))
2185 (end-of-line))
2186 ;; Remove the newline that may (will?) be at the end of the args
2187 (if (string= "\n" (substring args (1- (length args))))
2188 (setq args (substring args 0 (1- (length args)))))
2189 ;; Run last command if no args given, else construct a new command.
2190 (setq args
2191 (if (string= "" args)
2192 (if (boundp 'compile-command)
2193 compile-command
2194 ex-compile-command)
2195 (concat ex-compile-command " " args)))
2196 (compile args)
2197 ))
2198
2199 ;; Print line number
2200 (defun ex-line-no ()
2201 (message "%d"
2202 (1+ (count-lines
2203 (point-min)
2204 (if (null ex-addresses) (point-max) (car ex-addresses))))))
2205
2206 ;; Give information on the file visited by the current buffer
2207 (defun viper-info-on-file ()
2208 (interactive)
2209 (let ((pos1 (viper-line-pos 'start))
2210 (pos2 (viper-line-pos 'end))
2211 lines file info)
2212 (setq lines (count-lines (point-min) (viper-line-pos 'end))
2213 file (cond ((buffer-file-name)
2214 (concat (viper-abbreviate-file-name (buffer-file-name)) ":"))
2215 ((buffer-file-name (buffer-base-buffer))
2216 (concat (viper-abbreviate-file-name (buffer-file-name (buffer-base-buffer))) " (indirect buffer):"))
2217 (t (concat (buffer-name) " [Not visiting any file]:")))
2218 info (format "line=%d/%d pos=%d/%d col=%d %s"
2219 (if (= pos1 pos2)
2220 (1+ lines)
2221 lines)
2222 (count-lines (point-min) (point-max))
2223 (point) (1- (point-max))
2224 (1+ (current-column))
2225 (if (buffer-modified-p) "[Modified]" "[Unchanged]")))
2226 (if (< (+ 1 (length info) (length file))
2227 (window-width (minibuffer-window)))
2228 (message "%s" (concat file " " info))
2229 (save-window-excursion
2230 (with-output-to-temp-buffer " *viper-info*"
2231 (princ (concat "\n" file "\n\n\t" info "\n\n")))
2232 (let ((inhibit-quit t))
2233 (viper-set-unread-command-events (viper-read-event)))
2234 (kill-buffer " *viper-info*")))
2235 ))
2236
2237
2238 ;; Without arguments displays info on file. With an arg, sets the visited file
2239 ;; name to that arg
2240 (defun ex-set-visited-file-name ()
2241 (viper-get-ex-file)
2242 (if (string= ex-file "")
2243 (viper-info-on-file)
2244 ;; If ex-file is a directory, use the file portion of the buffer
2245 ;; file name (like ex-write). Do this even if ex-file is a
2246 ;; non-existent directory, since set-visited-file-name signals an
2247 ;; error on this condition, too.
2248 (if (and (string= (file-name-nondirectory ex-file) "")
2249 buffer-file-name
2250 (not (file-directory-p buffer-file-name)))
2251 (setq ex-file (concat (file-name-as-directory ex-file)
2252 (file-name-nondirectory buffer-file-name))))
2253 (set-visited-file-name ex-file)))
2254
2255
2256 ;; display all variables set through :set
2257 (defun ex-show-vars ()
2258 (with-output-to-temp-buffer " *viper-info*"
2259 (princ (if viper-auto-indent
2260 "autoindent (local)\n" "noautoindent (local)\n"))
2261 (princ (if (default-value 'viper-auto-indent)
2262 "autoindent (global) \n" "noautoindent (global) \n"))
2263 (princ (if viper-case-fold-search "ignorecase\n" "noignorecase\n"))
2264 (princ (if viper-re-search "magic\n" "nomagic\n"))
2265 (princ (if buffer-read-only "readonly\n" "noreadonly\n"))
2266 (princ (if blink-matching-paren "showmatch\n" "noshowmatch\n"))
2267 (princ (if viper-search-wrap-around "wrapscan\n" "nowrapscan\n"))
2268 (princ (format "shiftwidth \t\t= %S\n" viper-shift-width))
2269 (princ (format "tabstop (local) \t= %S\n" tab-width))
2270 (princ (format "tabstop (global) \t= %S\n" (default-value 'tab-width)))
2271 (princ (format "wrapmargin (local) \t= %S\n"
2272 (- (window-width) fill-column)))
2273 (princ (format "wrapmargin (global) \t= %S\n"
2274 (- (window-width) (default-value 'fill-column))))
2275 (princ (format "shell \t\t\t= %S\n" (if (boundp 'explicit-shell-file-name)
2276 explicit-shell-file-name
2277 'none)))
2278 ))
2279
2280 (defun ex-print ()
2281 (viper-default-ex-addresses)
2282 (let ((end (car ex-addresses))
2283 (beg (car (cdr ex-addresses))))
2284 (if (> beg end) (error viper-FirstAddrExceedsSecond))
2285 (save-excursion
2286 (viper-enlarge-region beg end)
2287 (if (or ex-g-flag ex-g-variant)
2288 ;; When executing a global command, collect output of each
2289 ;; print in viper-ex-print-buf.
2290 (progn
2291 (append-to-buffer viper-ex-print-buf (point) (mark t))
2292 ;; Is this the last mark for the global command?
2293 (unless (cdr ex-g-marks)
2294 (with-current-buffer viper-ex-print-buf
2295 (ex-print-display-lines (buffer-string))
2296 (erase-buffer))))
2297 (ex-print-display-lines (buffer-substring (point) (mark t)))))))
2298
2299 (defun ex-print-display-lines (lines)
2300 (cond
2301 ;; String doesn't contain a newline.
2302 ((not (string-match "\n" lines))
2303 (message "%s" lines))
2304 ;; String contains only one newline at the end. Strip it off.
2305 ((= (string-match "\n" lines) (1- (length lines)))
2306 (message "%s" (substring lines 0 -1)))
2307 ;; String spans more than one line. Use a temporary buffer.
2308 (t
2309 (save-current-buffer
2310 (with-output-to-temp-buffer " *viper-info*"
2311 (princ lines))))))
2312
2313
2314
2315
2316
2317 ;; arch-tag: 56b80d36-f880-4d10-bd66-85ad91a295db
2318 ;;; viper-ex.el ends here