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