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