1 ;;; viper-ex.el --- functions implementing the Ex commands for Viper
3 ;; Copyright (C) 1994, 1995, 1996, 1997 Free Software Foundation, Inc.
5 ;; This file is part of GNU Emacs.
7 ;; GNU Emacs is free software; you can redistribute it and/or modify
8 ;; it under the terms of the GNU General Public License as published by
9 ;; the Free Software Foundation; either version 2, or (at your option)
12 ;; GNU Emacs is distributed in the hope that it will be useful,
13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 ;; GNU General Public License for more details.
17 ;; You should have received a copy of the GNU General Public License
18 ;; along with GNU Emacs; see the file COPYING. If not, write to the
19 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 ;; Boston, MA 02111-1307, USA.
27 (defvar read-file-name-map
)
28 (defvar vip-use-register
)
30 (defvar vip-shift-width
)
31 (defvar vip-ex-history
)
32 (defvar vip-related-files-and-buffers-ring
)
33 (defvar vip-local-search-start-marker
)
34 (defvar vip-expert-level
)
35 (defvar vip-custom-file-name
)
36 (defvar vip-case-fold-search
)
37 (defvar explicit-shell-file-name
)
39 ;; loading happens only in non-interactive compilation
40 ;; in order to spare non-viperized emacs from being viperized
43 (let ((load-path (cons (expand-file-name ".") load-path
)))
44 (or (featurep 'viper-util
)
45 (load "viper-util.el" nil nil
'nosuffix
))
46 (or (featurep 'viper-keym
)
47 (load "viper-keym.el" nil nil
'nosuffix
))
48 (or (featurep 'viper-cmd
)
49 (load "viper-cmd.el" nil nil
'nosuffix
))
58 (defconst vip-ex-work-buf-name
" *ex-working-space*")
59 (defconst vip-ex-work-buf
(get-buffer-create vip-ex-work-buf-name
))
60 (defconst vip-ex-tmp-buf-name
" *ex-tmp*")
63 ;;; Variable completion in :set command
65 ;; The list of Ex commands. Used for completing command names.
66 (defconst ex-token-alist
67 '(("!") ("=") (">") ("&") ("~")
68 ("yank") ("xit") ("WWrite") ("Write") ("write") ("wq") ("visual")
69 ("version") ("vglobal") ("unmap") ("undo") ("tag") ("transfer") ("suspend")
70 ("substitute") ("submitReport") ("stop") ("sr") ("source") ("shell")
71 ("set") ("rewind") ("recover") ("read") ("quit") ("pwd")
72 ("put") ("preserve") ("PreviousRelatedFile") ("RelatedFile")
73 ("next") ("Next") ("move") ("mark") ("map") ("kmark") ("join")
74 ("help") ("goto") ("global") ("file") ("edit") ("delete") ("copy")
75 ("chdir") ("cd") ("Buffer") ("buffer") ("args")) )
77 ;; A-list of Ex variables that can be set using the :set command.
78 (defconst ex-variable-alist
79 '(("wrapscan") ("ws") ("wrapmargin") ("wm")
80 ("tabstop-global") ("ts-g") ("tabstop") ("ts")
81 ("showmatch") ("sm") ("shiftwidth") ("sw") ("shell") ("sh")
83 ("nowrapscan") ("nows") ("noshowmatch") ("nosm")
84 ("noreadonly") ("noro") ("nomagic") ("noma")
85 ("noignorecase") ("noic")
86 ("noautoindent-global") ("noai-g") ("noautoindent") ("noai")
87 ("magic") ("ma") ("ignorecase") ("ic")
88 ("autoindent-global") ("ai-g") ("autoindent") ("ai")
94 ;; Token recognized during parsing of Ex commands (e.g., "read", "comma")
98 ;; If non-nil, gives type of address; if nil, it is a command.
99 (defvar ex-token-type nil
)
101 ;; List of addresses passed to Ex command
102 (defvar ex-addresses nil
)
104 ;; It seems that this flag is used only for `#', `print', and `list', which
105 ;; aren't implemented. Check later.
108 ;; "buffer" where Ex commands keep deleted data.
109 ;; In Emacs terms, this is a register.
110 (defvar ex-buffer nil
)
112 ;; Value of ex count.
113 (defvar ex-count nil
)
115 ;; Flag for global command.
116 (defvar ex-g-flag nil
)
118 ;; If t, global command is executed on lines not matching ex-g-pat.
119 (defvar ex-g-variant nil
)
121 ;; Save reg-exp used in substitute.
122 (defvar ex-reg-exp nil
)
125 ;; Replace pattern for substitute.
128 ;; Pattern for global command.
129 (defvar ex-g-pat nil
)
132 (defvar ex-unix-type-shell
133 (let ((case-fold-search t
))
134 (and (stringp shell-file-name
)
144 "[^a-z]sh$\\|[^a-z]sh.exe$"
149 "Is the user using a unix-type shell?")
151 (defvar ex-unix-type-shell-options
152 (let ((case-fold-search t
))
153 (if ex-unix-type-shell
154 (cond ((string-match "\\(csh$\\|csh.exe$\\)" shell-file-name
)
155 "-f") ; csh: do it fast
156 ((string-match "\\(bash$\\|bash.exe$\\)" shell-file-name
)
157 "-noprofile") ; bash: ignore .profile
159 "Options to pass to the Unix-style shell.
160 Don't put `-c' here, as it is added automatically.")
162 (defvar ex-nontrivial-find-file-function
163 (cond (ex-unix-type-shell 'vip-ex-nontrivial-find-file-unix
)
164 ((eq system-type
'emx
) 'vip-ex-nontrivial-find-file-ms
) ; OS/2
165 (vip-ms-style-os-p 'vip-ex-nontrivial-find-file-ms
) ; a Microsoft OS
166 (vip-vms-os-p 'vip-ex-nontrivial-find-file-unix
) ; VMS
167 (t 'vip-ex-nontrivial-find-file-unix
) ; presumably UNIX
170 ;; Remembers the previous Ex tag.
173 ;; file used by Ex commands like :r, :w, :n
176 ;; If t, tells Ex that this is a variant-command, i.e., w>>, r!, etc.
177 (defvar ex-variant nil
)
179 ;; Specified the offset of an Ex command, such as :read.
180 (defvar ex-offset nil
)
182 ;; Tells Ex that this is a w>> command.
183 (defvar ex-append nil
)
185 ;; File containing the shell command to be executed at Ex prompt,
187 (defvar ex-cmdfile nil
)
189 ;; flag used in vip-ex-read-file-name to indicate that we may be reading
190 ;; multiple file names. Used for :edit and :next
191 (defvar vip-keep-reading-filename nil
)
193 (defconst ex-cycle-other-window t
194 "*If t, :n and :b cycles through files and buffers in other window.
195 Then :N and :B cycles in the current window. If nil, this behavior is
198 (defconst ex-cycle-through-non-files nil
199 "*Cycle through *scratch* and other buffers that don't visit any file.")
201 ;; Last shell command executed with :! command.
202 (defvar vip-ex-last-shell-com nil
)
204 ;; Indicates if Minibuffer was exited temporarily in Ex-command.
205 (defvar vip-incomplete-ex-cmd nil
)
207 ;; Remembers the last ex-command prompt.
208 (defvar vip-last-ex-prompt
"")
213 ;; Check if ex-token is an initial segment of STR
214 (defun vip-check-sub (str)
215 (let ((length (length ex-token
)))
216 (if (and (<= length
(length str
))
217 (string= ex-token
(substring str
0 length
)))
219 (setq ex-token-type
'non-command
))))
221 ;; Get a complete ex command
222 (defun vip-get-ex-com-subr ()
223 (let (case-fold-search)
225 (re-search-forward "[a-zA-Z][a-zA-Z]*")
226 (setq ex-token-type
'command
)
227 (setq ex-token
(buffer-substring (point) (mark t
)))
228 (exchange-point-and-mark)
229 (cond ((looking-at "a")
230 (cond ((looking-at "ab") (vip-check-sub "abbreviate"))
231 ((looking-at "ar") (vip-check-sub "args"))
232 (t (vip-check-sub "append"))))
233 ((looking-at "h") (vip-check-sub "help"))
235 (cond ((looking-at "cd") (vip-check-sub "cd"))
236 ((looking-at "ch") (vip-check-sub "chdir"))
237 ((looking-at "co") (vip-check-sub "copy"))
238 (t (vip-check-sub "change"))))
239 ((looking-at "d") (vip-check-sub "delete"))
240 ((looking-at "b") (vip-check-sub "buffer"))
241 ((looking-at "B") (vip-check-sub "Buffer"))
243 (if (looking-at "ex") (vip-check-sub "ex")
244 (vip-check-sub "edit")))
245 ((looking-at "f") (vip-check-sub "file"))
246 ((looking-at "g") (vip-check-sub "global"))
247 ((looking-at "i") (vip-check-sub "insert"))
248 ((looking-at "j") (vip-check-sub "join"))
249 ((looking-at "l") (vip-check-sub "list"))
251 (cond ((looking-at "map") (vip-check-sub "map"))
252 ((looking-at "mar") (vip-check-sub "mark"))
253 (t (vip-check-sub "move"))))
254 ((looking-at "k[a-z][^a-z]")
255 (setq ex-token
"kmark")
257 (exchange-point-and-mark)) ; this is canceled out by another
258 ; exchange-point-and-mark at the end
259 ((looking-at "k") (vip-check-sub "kmark"))
260 ((looking-at "n") (if (looking-at "nu")
261 (vip-check-sub "number")
262 (vip-check-sub "next")))
263 ((looking-at "N") (vip-check-sub "Next"))
264 ((looking-at "o") (vip-check-sub "open"))
266 (cond ((looking-at "pre") (vip-check-sub "preserve"))
267 ((looking-at "pu") (vip-check-sub "put"))
268 ((looking-at "pw") (vip-check-sub "pwd"))
269 (t (vip-check-sub "print"))))
270 ((looking-at "P") (vip-check-sub "PreviousRelatedFile"))
271 ((looking-at "R") (vip-check-sub "RelatedFile"))
272 ((looking-at "q") (vip-check-sub "quit"))
274 (cond ((looking-at "rec") (vip-check-sub "recover"))
275 ((looking-at "rew") (vip-check-sub "rewind"))
276 (t (vip-check-sub "read"))))
278 (cond ((looking-at "se") (vip-check-sub "set"))
279 ((looking-at "sh") (vip-check-sub "shell"))
280 ((looking-at "so") (vip-check-sub "source"))
281 ((looking-at "sr") (vip-check-sub "sr"))
282 ((looking-at "st") (vip-check-sub "stop"))
283 ((looking-at "sus") (vip-check-sub "suspend"))
284 ((looking-at "subm") (vip-check-sub "submitReport"))
285 (t (vip-check-sub "substitute"))))
287 (if (looking-at "ta") (vip-check-sub "tag")
288 (vip-check-sub "transfer")))
290 (cond ((looking-at "una") (vip-check-sub "unabbreviate"))
291 ((looking-at "unm") (vip-check-sub "unmap"))
292 (t (vip-check-sub "undo"))))
294 (cond ((looking-at "ve") (vip-check-sub "version"))
295 ((looking-at "vi") (vip-check-sub "visual"))
296 (t (vip-check-sub "vglobal"))))
298 (if (looking-at "wq") (vip-check-sub "wq")
299 (vip-check-sub "write")))
301 (if (looking-at "WW")
302 (vip-check-sub "WWrite")
303 (vip-check-sub "Write")))
304 ((looking-at "x") (vip-check-sub "xit"))
305 ((looking-at "y") (vip-check-sub "yank"))
306 ((looking-at "z") (vip-check-sub "z")))
307 (exchange-point-and-mark)
310 ;; Get an ex-token which is either an address or a command.
311 ;; A token has a type, \(command, address, end-mark\), and a value
312 (defun vip-get-ex-token ()
313 (save-window-excursion
314 (setq vip-ex-work-buf
(get-buffer-create vip-ex-work-buf-name
))
315 (set-buffer vip-ex-work-buf
)
316 (skip-chars-forward " \t|")
317 (cond ((looking-at "#")
318 (setq ex-token-type
'command
)
319 (setq ex-token
(char-to-string (following-char)))
321 ((looking-at "[a-z]") (vip-get-ex-com-subr))
324 (setq ex-token-type
'dot
))
325 ((looking-at "[0-9]")
327 (re-search-forward "[0-9]*")
329 (cond ((eq ex-token-type
'plus
) 'add-number
)
330 ((eq ex-token-type
'minus
) 'sub-number
)
332 (setq ex-token
(string-to-int (buffer-substring (point) (mark t
)))))
335 (setq ex-token-type
'end
))
338 (setq ex-token-type
'whole
))
340 (cond ((or (looking-at "+[-+]") (looking-at "+[\n|]"))
344 (setq ex-token-type
'plus
))
345 ((looking-at "+[0-9]")
347 (setq ex-token-type
'plus
))
349 (error vip-BadAddress
))))
351 (cond ((or (looking-at "-[-+]") (looking-at "-[\n|]"))
355 (setq ex-token-type
'minus
))
356 ((looking-at "-[0-9]")
358 (setq ex-token-type
'minus
))
360 (error vip-BadAddress
))))
365 (while (and (not (eolp)) cont
)
366 ;;(re-search-forward "[^/]*/")
367 (re-search-forward "[^/]*\\(/\\|\n\\)")
368 (if (not (vip-looking-back "[^\\\\]\\(\\\\\\\\\\)*\\\\/"))
371 (setq ex-token
(buffer-substring (point) (mark t
)))
372 (if (looking-at "/") (forward-char 1))
373 (setq ex-token-type
'search-forward
))
378 (while (and (not (eolp)) cont
)
379 ;;(re-search-forward "[^\\?]*\\?")
380 (re-search-forward "[^\\?]*\\(\\?\\|\n\\)")
381 (if (not (vip-looking-back "[^\\\\]\\(\\\\\\\\\\)*\\\\\\?"))
384 (if (not (looking-at "\n")) (forward-char 1))))
385 (setq ex-token-type
'search-backward
)
386 (setq ex-token
(buffer-substring (1- (point)) (mark t
))))
389 (setq ex-token-type
'comma
))
392 (setq ex-token-type
'semi-colon
))
393 ((looking-at "[!=><&~]")
394 (setq ex-token-type
'command
)
395 (setq ex-token
(char-to-string (following-char)))
398 (setq ex-token-type
'goto-mark
)
400 (cond ((looking-at "'") (setq ex-token nil
))
401 ((looking-at "[a-z]") (setq ex-token
(following-char)))
402 (t (error "Marks are ' and a-z")))
405 (setq ex-token-type
'end-mark
)
406 (setq ex-token
"goto"))
408 (error vip-BadExCommand
)))))
410 ;; Reads Ex command. Tries to determine if it has to exit because command
411 ;; is complete or invalid. If not, keeps reading command.
412 (defun ex-cmd-read-exit ()
414 (setq vip-incomplete-ex-cmd t
)
415 (let ((quit-regex1 (concat
418 "\\|" "[nN]ext[ \t]*"
431 "\\|" "[ktgjmsz][ \t]*$"
433 "\\|" "tr[ansfer \t]*"
436 "\\|" "^[ \t]*k?ma[^p]*"
445 "\\|" "![ \t]*[a-zA-Z].*"
449 (save-window-excursion ;; put cursor at the end of the Ex working buffer
450 (setq vip-ex-work-buf
(get-buffer-create vip-ex-work-buf-name
))
451 (set-buffer vip-ex-work-buf
)
452 (goto-char (point-max)))
453 (cond ((vip-looking-back quit-regex1
) (exit-minibuffer))
454 ((vip-looking-back stay-regex
) (insert " "))
455 ((vip-looking-back quit-regex2
) (exit-minibuffer))
458 ;; complete Ex command
459 (defun ex-cmd-complete ()
461 (let (save-pos dist compl-list string-to-complete completion-result
)
464 (setq dist
(skip-chars-backward "[a-zA-Z!=>&~]")
468 (vip-looking-back "\\([ \t]*['`][ \t]*[a-z]*\\)")
470 "^[ \t]*[a-zA-Z!=>&~][ \t]*[/?]*+[ \t]+[a-zA-Z!=>&~]+"))
471 ;; Preceding characters are not the ones allowed in an Ex command
472 ;; or we have typed past command name.
473 ;; Note: we didn't do parsing, so there may be surprises.
474 (if (or (vip-looking-back "[a-zA-Z!=>&~][ \t]*[/?]*[ \t]*")
475 (vip-looking-back "\\([ \t]*['`][ \t]*[a-z]*\\)")
476 (looking-at "[^ \t\n\C-m]"))
478 (with-output-to-temp-buffer "*Completions*"
479 (display-completion-list
480 (vip-alist-to-list ex-token-alist
))))
481 ;; Preceding chars may be part of a command name
482 (setq string-to-complete
(buffer-substring save-pos
(point)))
483 (setq completion-result
484 (try-completion string-to-complete ex-token-alist
))
486 (cond ((eq completion-result t
) ; exact match--do nothing
487 (vip-tmp-insert-at-eob " (Sole completion)"))
488 ((eq completion-result nil
)
489 (vip-tmp-insert-at-eob " (No match)"))
490 (t ;; partial completion
492 (delete-region (point) (point-max))
493 (insert completion-result
)
494 (let (case-fold-search)
496 (vip-filter-alist (concat "^" completion-result
)
498 (if (> (length compl-list
) 1)
499 (with-output-to-temp-buffer "*Completions*"
500 (display-completion-list
501 (vip-alist-to-list (reverse compl-list
)))))))
506 ;; Ex commands themselves are implemented in viper-ex.el
507 (defun vip-ex (&optional string
)
512 (let* ((map (copy-keymap minibuffer-local-map
))
516 prev-token-type com-str
)
518 (vip-add-keymap vip-ex-cmd-map map
)
520 (setq com-str
(or string
(vip-read-string-with-history
526 (save-window-excursion
528 (setq vip-ex-work-buf
(get-buffer-create vip-ex-work-buf-name
))
529 (set-buffer vip-ex-work-buf
)
530 (delete-region (point-min) (point-max))
531 (insert com-str
"\n")
532 (goto-char (point-min)))
533 (setq ex-token-type nil
537 (cond ((memq ex-token-type
'(command end-mark
))
538 (if address
(setq ex-addresses
(cons address ex-addresses
)))
539 (cond ((string= ex-token
"global")
542 ((string= ex-token
"vglobal")
546 (vip-execute-ex-command)
547 (save-window-excursion
548 (setq vip-ex-work-buf
549 (get-buffer-create vip-ex-work-buf-name
))
550 (set-buffer vip-ex-work-buf
)
551 (skip-chars-forward " \t")
552 (cond ((looking-at "|")
556 (t (error "`%s': %s" ex-token vip-SpuriousText
)))
559 ((eq ex-token-type
'non-command
)
560 (error "`%s': %s" ex-token vip-BadExCommand
))
561 ((eq ex-token-type
'whole
)
565 (cons (point-max) ex-addresses
)
566 (cons (point-max) (cons (point-min) ex-addresses
)))))
567 ((eq ex-token-type
'comma
)
568 (if (eq prev-token-type
'whole
)
569 (setq address
(point-min)))
571 (cons (if (null address
) (point) address
) ex-addresses
)))
572 ((eq ex-token-type
'semi-colon
)
573 (if (eq prev-token-type
'whole
)
574 (setq address
(point-min)))
575 (if address
(setq dot address
))
577 (cons (if (null address
) (point) address
) ex-addresses
)))
578 (t (let ((ans (vip-get-ex-address-subr address dot
)))
579 (if ans
(setq address ans
)))))
580 (setq prev-token-type ex-token-type
))))
583 ;; Get a regular expression and set `ex-variant', if found
584 (defun vip-get-ex-pat ()
585 (save-window-excursion
586 (setq vip-ex-work-buf
(get-buffer-create vip-ex-work-buf-name
))
587 (set-buffer vip-ex-work-buf
)
588 (skip-chars-forward " \t")
591 (setq ex-g-variant
(not ex-g-variant
)
592 ex-g-flag
(not ex-g-flag
))
594 (skip-chars-forward " \t")))
595 (let ((c (following-char)))
596 (if (string-match "[0-9A-Za-z]" (format "%c" c
))
598 "Global regexp must be inside matching non-alphanumeric chars"))
599 (if (looking-at "[^\\\\\n]")
604 (while (and (not (eolp)) cont
)
605 (if (not (re-search-forward (format "[^%c]*%c" c c
) nil t
))
606 (if (member ex-token
'("global" "vglobal"))
608 "Missing closing delimiter for global regexp")
609 (goto-char (point-max))))
610 (if (not (vip-looking-back
611 (format "[^\\\\]\\(\\\\\\\\\\)*\\\\%c" c
)))
614 (if (= (mark t
) (point)) ""
615 (buffer-substring (1- (point)) (mark t
))))
621 (defun vip-get-ex-command ()
622 (save-window-excursion
623 (setq vip-ex-work-buf
(get-buffer-create vip-ex-work-buf-name
))
624 (set-buffer vip-ex-work-buf
)
625 (if (looking-at "/") (forward-char 1))
626 (skip-chars-forward " \t")
627 (cond ((looking-at "[a-z]")
628 (vip-get-ex-com-subr)
629 (if (eq ex-token-type
'non-command
)
630 (error "`%s': %s" ex-token vip-BadExCommand
)))
631 ((looking-at "[!=><&~]")
632 (setq ex-token
(char-to-string (following-char)))
634 (t (error vip-BadExCommand
)))))
636 ;; Get an Ex option g or c
637 (defun vip-get-ex-opt-gc (c)
638 (save-window-excursion
639 (setq vip-ex-work-buf
(get-buffer-create vip-ex-work-buf-name
))
640 (set-buffer vip-ex-work-buf
)
641 (if (looking-at (format "%c" c
)) (forward-char 1))
642 (skip-chars-forward " \t")
643 (cond ((looking-at "g")
653 ;; Compute default addresses. WHOLE-FLAG means use the whole buffer
654 (defun vip-default-ex-addresses (&optional whole-flag
)
655 (cond ((null ex-addresses
)
658 (cons (point-max) (cons (point-min) nil
))
659 (cons (point) (cons (point) nil
)))))
660 ((null (cdr ex-addresses
))
662 (cons (car ex-addresses
) ex-addresses
)))))
664 ;; Get an ex-address as a marker and set ex-flag if a flag is found
665 (defun vip-get-ex-address ()
666 (let ((address (point-marker))
672 (cond ((eq ex-token-type
'command
)
673 (if (member ex-token
'("print" "list" "#"))
677 (error "Address expected in this Ex command")))
678 ((eq ex-token-type
'end-mark
)
680 ((eq ex-token-type
'whole
)
681 (error "Trailing address expected"))
682 ((eq ex-token-type
'comma
)
683 (error "`%s': %s" ex-token vip-SpuriousText
))
684 (t (let ((ans (vip-get-ex-address-subr address
(point-marker))))
685 (if ans
(setq address ans
))))))
688 ;; Returns an address as a point
689 (defun vip-get-ex-address-subr (old-address dot
)
691 (if (null old-address
) (setq old-address dot
))
692 (cond ((eq ex-token-type
'dot
)
694 ((eq ex-token-type
'add-number
)
696 (goto-char old-address
)
697 (forward-line (if (= old-address
0) (1- ex-token
) ex-token
))
698 (setq address
(point-marker))))
699 ((eq ex-token-type
'sub-number
)
701 (goto-char old-address
)
702 (forward-line (- ex-token
))
703 (setq address
(point-marker))))
704 ((eq ex-token-type
'abs-number
)
706 (goto-char (point-min))
707 (if (= ex-token
0) (setq address
0)
708 (forward-line (1- ex-token
))
709 (setq address
(point-marker)))))
710 ((eq ex-token-type
'end
)
711 (setq address
(point-max-marker)))
712 ((eq ex-token-type
'plus
) t
) ; do nothing
713 ((eq ex-token-type
'minus
) t
) ; do nothing
714 ((eq ex-token-type
'search-forward
)
716 (ex-search-address t
)
717 (setq address
(point-marker))))
718 ((eq ex-token-type
'search-backward
)
720 (ex-search-address nil
)
721 (setq address
(point-marker))))
722 ((eq ex-token-type
'goto-mark
)
725 (exchange-point-and-mark)
726 (goto-char (vip-register-to-point
727 (1+ (- ex-token ?a
)) 'enforce-buffer
)))
728 (setq address
(point-marker)))))
732 ;; Search pattern and set address
733 (defun ex-search-address (forward)
734 (if (string= ex-token
"")
735 (if (null vip-s-string
)
736 (error vip-NoPrevSearch
)
737 (setq ex-token vip-s-string
))
738 (setq vip-s-string ex-token
))
742 (re-search-forward ex-token
))
744 (re-search-backward ex-token
)))
746 ;; Get a buffer name and set `ex-count' and `ex-flag' if found
747 (defun vip-get-ex-buffer ()
751 (save-window-excursion
752 (setq vip-ex-work-buf
(get-buffer-create vip-ex-work-buf-name
))
753 (set-buffer vip-ex-work-buf
)
754 (skip-chars-forward " \t")
755 (if (looking-at "[a-zA-Z]")
757 (setq ex-buffer
(following-char))
759 (skip-chars-forward " \t")))
760 (if (looking-at "[0-9]")
763 (re-search-forward "[0-9][0-9]*")
764 (setq ex-count
(string-to-int (buffer-substring (point) (mark t
))))
765 (skip-chars-forward " \t")))
766 (if (looking-at "[pl#]")
770 (if (not (looking-at "[\n|]"))
771 (error "`%s': %s" ex-token vip-SpuriousText
))))
773 (defun vip-get-ex-count ()
777 (save-window-excursion
778 (setq vip-ex-work-buf
(get-buffer-create vip-ex-work-buf-name
))
779 (set-buffer vip-ex-work-buf
)
780 (skip-chars-forward " \t")
785 (skip-chars-forward " \t")
786 (if (looking-at "[0-9]")
789 (re-search-forward "[0-9][0-9]*")
790 (setq ex-count
(string-to-int (buffer-substring (point) (mark t
))))
791 (skip-chars-forward " \t")))
792 (if (looking-at "[pl#]")
796 (if (not (looking-at "[\n|]"))
798 (buffer-substring (point-min) (1- (point-max))) vip-BadExCommand
))))
800 ;; Expand \% and \# in ex command
801 (defun ex-expand-filsyms (cmd buf
)
805 (setq cf buffer-file-name
)
806 (setq pf
(ex-next nil t
))) ; this finds alternative file name
807 (if (and (null cf
) (string-match "[^\\]%\\|\\`%" cmd
))
808 (error "No current file to substitute for `%%'"))
809 (if (and (null pf
) (string-match "[^\\]#\\|\\`#" cmd
))
810 (error "No alternate file to substitute for `#'"))
812 (set-buffer (get-buffer-create vip-ex-tmp-buf-name
))
815 (goto-char (point-min))
816 (while (re-search-forward "%\\|#" nil t
)
817 (let ((data (match-data))
818 (char (buffer-substring (match-beginning 0) (match-end 0))))
819 (if (vip-looking-back (concat "\\\\" char
))
821 (store-match-data data
)
822 (if (string= char
"%")
824 (replace-match pf
)))))
826 (setq ret
(buffer-substring (point-min) (point)))
830 ;; Get a file name and set ex-variant, `ex-append' and `ex-offset' if found
831 (defun vip-get-ex-file ()
839 (save-window-excursion
840 (setq vip-ex-work-buf
(get-buffer-create vip-ex-work-buf-name
))
841 (set-buffer vip-ex-work-buf
)
842 (skip-chars-forward " \t")
844 (if (and (not (vip-looking-back "[ \t]"))
845 ;; read doesn't have a corresponding :r! form, so ! is
846 ;; immediately interpreted as a shell command.
847 (not (string= ex-token
"read")))
851 (skip-chars-forward " \t"))
854 (skip-chars-forward " \t")))
855 (if (looking-at ">>")
860 (skip-chars-forward " \t")))
865 (re-search-forward "[ \t\n]")
867 (setq ex-offset
(buffer-substring (point) (mark t
)))
869 (skip-chars-forward " \t")))
870 ;; this takes care of :r, :w, etc., when they get file names
871 ;; from the history list
872 (if (member ex-token
'("read" "write" "edit" "visual" "next"))
874 (setq ex-file
(buffer-substring (point) (1- (point-max))))
876 ;; For :e, match multiple non-white strings separated
877 ;; by white. For others, find the first non-white string
879 (if (string= ex-token
"edit")
880 "[^ \t\n]+\\([ \t]+[^ \t\n]+\\)*"
884 ;; if file name comes from history, don't leave
885 ;; minibuffer when the user types space
886 (setq vip-incomplete-ex-cmd nil
)
887 ;; this must be the last clause in this progn
888 (substring ex-file
(match-beginning 0) (match-end 0))
891 ;; this leaves only the command name in the work area
892 ;; file names are gone
893 (delete-region (point) (1- (point-max)))
895 (goto-char (point-max))
896 (skip-chars-backward " \t\n")
897 (setq prompt
(buffer-substring (point-min) (point)))
900 (setq vip-last-ex-prompt prompt
)
902 ;; If we just finished reading command, redisplay prompt
903 (if vip-incomplete-ex-cmd
904 (setq ex-file
(vip-ex-read-file-name (format ":%s " prompt
)))
905 ;; file was typed in-line
906 (setq ex-file
(or ex-file
"")))
910 ;; Completes file name or exits minibuffer. If Ex command accepts multiple
911 ;; file names, arranges to re-enter the minibuffer.
912 (defun vip-complete-filename-or-exit ()
914 (setq vip-keep-reading-filename t
)
915 ;; don't exit if directory---ex-commands don't
916 (cond ((ex-cmd-accepts-multiple-files-p ex-token
) (exit-minibuffer))
917 ;; apparently the argument to an Ex command is
918 ;; supposed to be a shell command
919 ((vip-looking-back "^[ \t]*!.*")
923 (setq ex-cmdfile nil
)
924 (minibuffer-complete-word))))
926 (defun vip-handle-! ()
929 (buffer-string) (vip-abbreviate-file-name default-directory
))
930 (member ex-token
'("read" "write")))
934 (defun ex-cmd-accepts-multiple-files-p (token)
935 (member token
'("edit" "next" "Next")))
937 ;; If user doesn't enter anything, then "" is returned, i.e., the
938 ;; prompt-directory is not returned.
939 (defun vip-ex-read-file-name (prompt)
941 (minibuffer-local-completion-map
942 (copy-keymap minibuffer-local-completion-map
))
945 (vip-add-keymap ex-read-filename-map
947 minibuffer-local-completion-map
950 (setq cont
(setq vip-keep-reading-filename t
))
952 (setq vip-keep-reading-filename nil
953 val
(read-file-name (concat prompt str
) nil default-directory
))
954 (if (string-match " " val
)
955 (setq val
(concat "\\\"" val
"\\\"")))
956 (setq str
(concat str
(if (equal val
"") "" " ")
957 val
(if (equal val
"") "" " ")))
959 ;; Only edit, next, and Next commands accept multiple files.
960 ;; vip-keep-reading-filename is set in the anonymous function that is
961 ;; bound to " " in ex-read-filename-map.
962 (setq cont
(and vip-keep-reading-filename
963 (ex-cmd-accepts-multiple-files-p ex-token
)))
966 (setq beg
(string-match "[^ \t]" str
) ; delete leading blanks
967 end
(string-match "[ \t]*$" str
)) ; delete trailing blanks
968 (if (member ex-token
'("read" "write"))
969 (if (string-match "[\t ]*!" str
)
970 ;; this is actually a shell command
974 (setq vip-last-ex-prompt
(concat vip-last-ex-prompt
" !")))))
975 (substring str
(or beg
0) end
)))
977 ;; Execute ex command using the value of addresses
978 (defun vip-execute-ex-command ()
979 (vip-deactivate-mark)
980 (cond ((string= ex-token
"args") (ex-args))
981 ((string= ex-token
"copy") (ex-copy nil
))
982 ((string= ex-token
"cd") (ex-cd))
983 ((string= ex-token
"chdir") (ex-cd))
984 ((string= ex-token
"delete") (ex-delete))
985 ((string= ex-token
"edit") (ex-edit))
986 ((string= ex-token
"file") (vip-info-on-file))
987 ((string= ex-token
"goto") (ex-goto))
988 ((string= ex-token
"help") (ex-help))
989 ((string= ex-token
"join") (ex-line "join"))
990 ((string= ex-token
"kmark") (ex-mark))
991 ((string= ex-token
"mark") (ex-mark))
992 ((string= ex-token
"map") (ex-map))
993 ((string= ex-token
"move") (ex-copy t
))
994 ((string= ex-token
"next") (ex-next ex-cycle-other-window
))
995 ((string= ex-token
"Next") (ex-next (not ex-cycle-other-window
)))
996 ((string= ex-token
"RelatedFile") (ex-next-related-buffer 1))
997 ((string= ex-token
"put") (ex-put))
998 ((string= ex-token
"pwd") (ex-pwd))
999 ((string= ex-token
"preserve") (ex-preserve))
1000 ((string= ex-token
"PreviousRelatedFile") (ex-next-related-buffer -
1))
1001 ((string= ex-token
"quit") (ex-quit))
1002 ((string= ex-token
"read") (ex-read))
1003 ((string= ex-token
"recover") (ex-recover))
1004 ((string= ex-token
"rewind") (ex-rewind))
1005 ((string= ex-token
"submitReport") (vip-submit-report))
1006 ((string= ex-token
"set") (ex-set))
1007 ((string= ex-token
"shell") (ex-shell))
1008 ((string= ex-token
"source") (ex-source))
1009 ((string= ex-token
"sr") (ex-substitute t t
))
1010 ((string= ex-token
"substitute") (ex-substitute))
1011 ((string= ex-token
"suspend") (suspend-emacs))
1012 ((string= ex-token
"stop") (suspend-emacs))
1013 ((string= ex-token
"transfer") (ex-copy nil
))
1014 ((string= ex-token
"buffer") (if ex-cycle-other-window
1015 (vip-switch-to-buffer-other-window)
1016 (vip-switch-to-buffer)))
1017 ((string= ex-token
"Buffer") (if ex-cycle-other-window
1018 (vip-switch-to-buffer)
1019 (vip-switch-to-buffer-other-window)))
1020 ((string= ex-token
"tag") (ex-tag))
1021 ((string= ex-token
"undo") (vip-undo))
1022 ((string= ex-token
"unmap") (ex-unmap))
1023 ((string= ex-token
"version") (vip-version))
1024 ((string= ex-token
"visual") (ex-edit))
1025 ((string= ex-token
"write") (ex-write nil
))
1026 ((string= ex-token
"Write") (save-some-buffers))
1027 ((string= ex-token
"wq") (ex-write t
))
1028 ((string= ex-token
"WWrite") (save-some-buffers t
)) ; don't ask
1029 ((string= ex-token
"xit") (ex-write t
))
1030 ((string= ex-token
"yank") (ex-yank))
1031 ((string= ex-token
"!") (ex-command))
1032 ((string= ex-token
"=") (ex-line-no))
1033 ((string= ex-token
">") (ex-line "right"))
1034 ((string= ex-token
"<") (ex-line "left"))
1035 ((string= ex-token
"&") (ex-substitute t
))
1036 ((string= ex-token
"~") (ex-substitute t t
))
1037 ((or (string= ex-token
"append")
1038 (string= ex-token
"change")
1039 (string= ex-token
"insert")
1040 (string= ex-token
"open"))
1041 (error "`%s': Obsolete command, not supported by Viper" ex-token
))
1042 ((or (string= ex-token
"abbreviate")
1043 (string= ex-token
"unabbreviate"))
1045 "`%s': Vi abbrevs are obsolete. Use the more powerful Emacs abbrevs"
1047 ((or (string= ex-token
"list")
1048 (string= ex-token
"print")
1049 (string= ex-token
"z")
1050 (string= ex-token
"#"))
1051 (error "`%s': Command not implemented in Viper" ex-token
))
1052 (t (error "`%s': %s" ex-token vip-BadExCommand
))))
1054 (defun vip-undisplayed-files ()
1058 (if (null (get-buffer-window b
))
1059 (let ((f (buffer-file-name b
)))
1061 (if ex-cycle-through-non-files
1062 (let ((s (buffer-name b
)))
1063 (if (string= " " (substring s
0 1))
1072 (let ((l (vip-undisplayed-files))
1075 (while (not (null l
))
1077 (setq args
(format "%s %d) %s\n" args file-count
(car l
))
1078 file-count
(1+ file-count
)))
1080 (if (string= args
"")
1081 (message "All files are already displayed")
1083 (save-window-excursion
1084 (with-output-to-temp-buffer " *vip-info*"
1085 (princ "\n\nThese files are not displayed in any window.\n")
1086 (princ "\n=============\n")
1088 (princ "\n=============\n")
1089 (princ "\nThe numbers can be given as counts to :next. ")
1090 (princ "\n\nPress any key to continue...\n\n"))
1091 (vip-read-event))))))
1093 ;; Ex cd command. Default directory of this buffer changes
1096 (if (string= ex-file
"")
1098 (setq default-directory
(file-name-as-directory (expand-file-name ex-file
))))
1100 ;; Ex copy and move command. DEL-FLAG means delete
1101 (defun ex-copy (del-flag)
1102 (vip-default-ex-addresses)
1103 (let ((address (vip-get-ex-address))
1104 (end (car ex-addresses
)) (beg (car (cdr ex-addresses
))))
1108 (vip-enlarge-region (mark t
) (point))
1110 (kill-region (point) (mark t
))
1111 (copy-region-as-kill (point) (mark t
)))
1114 (with-output-to-temp-buffer "*copy text*"
1116 (if (or del-flag ex-g-flag ex-g-variant
)
1118 (buffer-substring (point) (mark t
)))))
1121 (read-string "[Hit return to continue] ")
1122 (save-excursion (kill-buffer "*copy text*")))
1123 (quit (save-excursion (kill-buffer "*copy text*"))
1124 (signal 'quit nil
))))))
1126 (goto-char (point-min))
1129 (insert (current-kill 0))))
1131 ;; Ex delete command
1133 (vip-default-ex-addresses)
1135 (let ((end (car ex-addresses
)) (beg (car (cdr ex-addresses
))))
1136 (if (> beg end
) (error vip-FirstAddrExceedsSecond
))
1138 (vip-enlarge-region beg end
)
1139 (exchange-point-and-mark)
1143 (forward-line (1- ex-count
)))
1145 (vip-enlarge-region (point) (mark t
))
1147 ;; show text to be deleted and ask for confirmation
1149 (with-output-to-temp-buffer " *delete text*"
1150 (princ (buffer-substring (point) (mark t
))))
1152 (read-string "[Hit return to continue] ")
1154 (save-excursion (kill-buffer " *delete text*"))
1156 (save-excursion (kill-buffer " *delete text*")))
1158 (cond ((vip-valid-register ex-buffer
'(Letter))
1159 (vip-append-to-register
1160 (downcase ex-buffer
) (point) (mark t
)))
1161 ((vip-valid-register ex-buffer
)
1162 (copy-to-register ex-buffer
(point) (mark t
) nil
))
1163 (t (error vip-InvalidRegister ex-buffer
))))
1164 (kill-region (point) (mark t
))))))
1169 ;; In Viper, `e' and `e!' behave identically. In both cases, the user is
1170 ;; asked if current buffer should really be discarded.
1171 ;; This command can take multiple file names. It replaces the current buffer
1172 ;; with the first file in its argument list
1173 (defun ex-edit (&optional file
)
1176 (cond ((and (string= ex-file
"") buffer-file-name
)
1177 (setq ex-file
(vip-abbreviate-file-name (buffer-file-name))))
1178 ((string= ex-file
"")
1179 (error vip-NoFileSpecified
)))
1182 (if buffer-file-name
1183 (cond ((buffer-modified-p)
1185 (format "Buffer %s is modified. Discard changes? "
1188 ((not (verify-visited-file-modtime (current-buffer)))
1190 (format "File %s changed on disk. Reread from disk? "
1193 (t (setq do-edit nil
))))
1196 (if (yes-or-no-p msg
)
1198 (set-buffer-modified-p nil
)
1199 (kill-buffer (current-buffer)))
1200 (message "Buffer %s was left intact" (buffer-name))))
1203 (if (null (setq file
(get-file-buffer ex-file
)))
1205 (ex-find-file ex-file
)
1206 (or (eq major-mode
'dired-mode
)
1207 (vip-change-state-to-vi))
1208 (goto-char (point-min)))
1209 (switch-to-buffer file
))
1212 (save-window-excursion
1213 (setq vip-ex-work-buf
(get-buffer-create vip-ex-work-buf-name
))
1214 (set-buffer vip-ex-work-buf
)
1215 (delete-region (point-min) (point-max))
1216 (insert ex-offset
"\n")
1217 (goto-char (point-min)))
1218 (goto-char (vip-get-ex-address))
1219 (beginning-of-line)))
1220 (ex-fixup-history vip-last-ex-prompt ex-file
))
1222 ;; Find-file FILESPEC if it appears to specify a single file.
1223 ;; Otherwise, assume that FILES{EC is a wildcard.
1224 ;; In this case, split it into substrings separated by newlines.
1225 ;; Each line is assumed to be a file name. find-file's each file thus obtained.
1226 (defun ex-find-file (filespec)
1227 (let ((nonstandard-filename-chars "[^-a-zA-Z0-9_./,~$\\]"))
1228 (cond ((file-exists-p filespec
) (find-file filespec
))
1229 ((string-match nonstandard-filename-chars filespec
)
1230 (funcall ex-nontrivial-find-file-function filespec
))
1231 (t (find-file filespec
)))
1235 ;; Ex global command
1236 (defun ex-global (variant)
1237 (let ((gcommand ex-token
))
1238 (if (or ex-g-flag ex-g-variant
)
1239 (error "`%s' within `global' is not allowed" gcommand
)
1247 (error "`%s': Missing regular expression" gcommand
)))
1249 (if (string= ex-token
"")
1250 (if (null vip-s-string
)
1251 (error vip-NoPrevSearch
)
1252 (setq ex-g-pat vip-s-string
))
1253 (setq ex-g-pat ex-token
1254 vip-s-string ex-token
))
1255 (if (null ex-addresses
)
1256 (setq ex-addresses
(list (point-max) (point-min)))
1257 (vip-default-ex-addresses))
1258 (let ((marks nil
) (mark-count 0)
1259 com-str
(end (car ex-addresses
)) (beg (car (cdr ex-addresses
))))
1260 (if (> beg end
) (error vip-FirstAddrExceedsSecond
))
1262 (vip-enlarge-region beg end
)
1263 (exchange-point-and-mark)
1264 (let ((cont t
) (limit (point-marker)))
1265 (exchange-point-and-mark)
1266 ;; skip the last line if empty
1268 (if (eobp) (vip-backward-char-carefully))
1269 (while (and cont
(not (bobp)) (>= (point) limit
))
1273 (let ((found (re-search-backward ex-g-pat
(mark t
) t
)))
1274 (if (or (and ex-g-flag found
)
1275 (and ex-g-variant
(not found
)))
1278 (setq mark-count
(1+ mark-count
))
1279 (setq marks
(cons (point-marker) marks
)))))
1281 (if (bobp) (setq cont nil
)
1284 (save-window-excursion
1285 (setq vip-ex-work-buf
(get-buffer-create vip-ex-work-buf-name
))
1286 (set-buffer vip-ex-work-buf
)
1287 (setq com-str
(buffer-substring (1+ (point)) (1- (point-max)))))
1289 (goto-char (car marks
))
1291 (setq mark-count
(1- mark-count
))
1292 (setq marks
(cdr marks
)))))
1296 (if (null ex-addresses
)
1297 (setq ex-addresses
(cons (point) nil
)))
1298 (push-mark (point) t
)
1299 (goto-char (car ex-addresses
))
1300 (beginning-of-line))
1302 ;; Ex line commands. COM is join, shift-right or shift-left
1303 (defun ex-line (com)
1304 (vip-default-ex-addresses)
1306 (let ((end (car ex-addresses
)) (beg (car (cdr ex-addresses
))) point
)
1307 (if (> beg end
) (error vip-FirstAddrExceedsSecond
))
1309 (vip-enlarge-region beg end
)
1310 (exchange-point-and-mark)
1314 (forward-line ex-count
)))
1316 ;; show text to be joined and ask for confirmation
1318 (with-output-to-temp-buffer " *text*"
1319 (princ (buffer-substring (point) (mark t
))))
1322 (read-string "[Hit return to continue] ")
1323 (ex-line-subr com
(point) (mark t
)))
1325 (save-excursion (kill-buffer " *text*")))
1326 (ex-line-subr com
(point) (mark t
)))
1327 (setq point
(point)))
1328 (goto-char (1- point
))
1329 (beginning-of-line)))
1331 (defun ex-line-subr (com beg end
)
1332 (cond ((string= com
"join")
1333 (goto-char (min beg end
))
1334 (while (and (not (eobp)) (< (point) (max beg end
)))
1336 (if (and (<= (point) (max beg end
)) (not (eobp)))
1339 (delete-region (point) (1- (point)))
1340 (if (not ex-variant
) (fixup-whitespace))))))
1341 ((or (string= com
"right") (string= com
"left"))
1343 (min beg end
) (max beg end
)
1344 (if (string= com
"right") vip-shift-width
(- vip-shift-width
)))
1345 (goto-char (max beg end
))
1347 (vip-forward-char-carefully))))
1353 (if (null ex-addresses
)
1355 (cons (point) nil
)))
1356 (save-window-excursion
1357 (setq vip-ex-work-buf
(get-buffer-create vip-ex-work-buf-name
))
1358 (set-buffer vip-ex-work-buf
)
1359 (skip-chars-forward " \t")
1360 (if (looking-at "[a-z]")
1362 (setq char
(following-char))
1364 (skip-chars-forward " \t")
1365 (if (not (looking-at "[\n|]"))
1366 (error "`%s': %s" ex-token vip-SpuriousText
)))
1367 (error "`%s' requires a following letter" ex-token
)))
1369 (goto-char (car ex-addresses
))
1370 (point-to-register (1+ (- char ?a
))))))
1374 ;; Alternate file is the file next to the first one in the buffer ring
1375 (defun ex-next (cycle-other-window &optional find-alt-file
)
1378 (if (not find-alt-file
)
1381 (if (or (char-or-string-p ex-offset
)
1382 (and (not (string= "" ex-file
))
1383 (not (string-match "^[0-9]+$" ex-file
))))
1386 (throw 'ex-edit nil
))
1387 (setq count
(string-to-int ex-file
))
1388 (if (= count
0) (setq count
1))
1389 (if (< count
0) (error "Usage: `next <count>' (count >= 0)"))))
1391 (setq l
(vip-undisplayed-files))
1393 (while (and (not (null l
)) (null (car l
)))
1395 (setq count
(1- count
))
1398 (if find-alt-file
(car l
)
1400 (if (and (car l
) (get-file-buffer (car l
)))
1401 (let* ((w (if cycle-other-window
1402 (get-lru-window) (selected-window)))
1403 (b (window-buffer w
)))
1404 (set-window-buffer w
(get-file-buffer (car l
)))
1406 ;; this puts "next <count>" in the ex-command history
1407 (ex-fixup-history vip-last-ex-prompt ex-file
))
1408 (error "Not that many undisplayed files")))))))
1411 (defun ex-next-related-buffer (direction &optional no-recursion
)
1413 (vip-ring-rotate1 vip-related-files-and-buffers-ring direction
)
1415 (let ((file-or-buffer-name
1416 (vip-current-ring-item vip-related-files-and-buffers-ring
))
1417 (old-ring vip-related-files-and-buffers-ring
)
1418 (old-win (selected-window))
1421 (or (and (ring-p vip-related-files-and-buffers-ring
)
1422 (> (ring-length vip-related-files-and-buffers-ring
) 0))
1423 (error "This buffer has no related files or buffers"))
1425 (or (stringp file-or-buffer-name
)
1427 "File and buffer names must be strings, %S" file-or-buffer-name
))
1429 (setq buf
(cond ((get-buffer file-or-buffer-name
))
1430 ((file-exists-p file-or-buffer-name
)
1431 (find-file-noselect file-or-buffer-name
))
1434 (if (not (vip-buffer-live-p buf
))
1435 (error "Didn't find buffer %S or file %S"
1437 (vip-abbreviate-file-name
1438 (expand-file-name file-or-buffer-name
))))
1440 (if (equal buf
(current-buffer))
1445 (ex-next-related-buffer direction
'norecursion
))))
1450 (if (setq wind
(vip-get-visible-buffer-window buf
))
1452 (setq wind
(get-lru-window (if vip-xemacs-p nil
'visible
)))
1453 (set-window-buffer wind buf
))
1455 (if (vip-window-display-p)
1457 (raise-frame (window-frame wind
))
1458 (if (equal (window-frame wind
) (window-frame old-win
))
1459 (save-window-excursion (select-window wind
) (sit-for 1))
1460 (select-window wind
)))
1461 (save-window-excursion (select-window wind
) (sit-for 1)))
1465 (setq vip-related-files-and-buffers-ring old-ring
))
1467 (setq vip-local-search-start-marker
(point-marker))
1472 (defun ex-preserve ()
1473 (message "Autosaving all buffers that need to be saved...")
1478 (let ((point (if (null ex-addresses
) (point) (car ex-addresses
))))
1480 (setq vip-use-register ex-buffer
)
1482 (if (bobp) (vip-Put-back 1) (vip-put-back 1))))
1484 ;; Ex print working directory
1486 (message default-directory
))
1490 ;; skip "!", if it is q!. In Viper q!, w!, etc., behave as q, w, etc.
1492 (setq vip-ex-work-buf
(get-buffer-create vip-ex-work-buf-name
))
1493 (set-buffer vip-ex-work-buf
)
1494 (if (looking-at "!") (forward-char 1)))
1495 (if (< vip-expert-level
3)
1496 (save-buffers-kill-emacs)
1497 (kill-buffer (current-buffer))))
1503 (let ((point (if (null ex-addresses
) (point) (car ex-addresses
)))
1506 (vip-add-newline-at-eob-if-necessary)
1507 (if (not (or (bobp) (eobp))) (forward-line 1))
1508 (if (and (not ex-variant
) (string= ex-file
""))
1510 (if (null buffer-file-name
)
1511 (error vip-NoFileSpecified
))
1512 (setq ex-file buffer-file-name
)))
1515 (setq command
(ex-expand-filsyms ex-file
(current-buffer)))
1516 (shell-command command t
))
1517 (insert-file-contents ex-file
)))
1518 (ex-fixup-history vip-last-ex-prompt ex-file
))
1520 ;; this function fixes ex-history for some commands like ex-read, ex-edit
1521 (defun ex-fixup-history (&rest args
)
1522 (setq vip-ex-history
1523 (cons (mapconcat 'identity args
" ") (cdr vip-ex-history
))))
1526 ;; Ex recover from emacs \#file\#
1527 (defun ex-recover ()
1529 (if (or ex-append ex-offset
)
1530 (error "`recover': %s" vip-SpuriousText
))
1531 (if (string= ex-file
"")
1533 (if (null buffer-file-name
)
1534 (error "This buffer isn't visiting any file"))
1535 (setq ex-file buffer-file-name
))
1536 (setq ex-file
(expand-file-name ex-file
)))
1537 (if (and (not (string= ex-file
(buffer-file-name)))
1540 (error "No write since last change \(:rec! overrides\)"))
1541 (recover-file ex-file
))
1543 ;; Tell that `rewind' is obsolete and to use `:next count' instead
1546 "Use `:n <count>' instead. Counts are obtained from the `:args' command"))
1549 ;; read variable name for ex-set
1550 (defun ex-set-read-variable ()
1551 (let ((minibuffer-local-completion-map
1552 (copy-keymap minibuffer-local-completion-map
))
1553 (cursor-in-echo-area t
)
1556 minibuffer-local-completion-map
" " 'minibuffer-complete-and-exit
)
1557 (define-key minibuffer-local-completion-map
"=" 'exit-minibuffer
)
1558 (if (vip-set-unread-command-events
1559 (ex-get-inline-cmd-args "[ \t]*[a-zA-Z]*[ \t]*" nil
"\C-m"))
1562 (vip-set-unread-command-events ?\C-m
)))
1563 (message ":set <Variable> [= <Value>]")
1564 (or batch
(sit-for 2))
1566 (while (string-match "^[ \\t\\n]*$"
1568 (completing-read ":set " ex-variable-alist
)))
1569 (message ":set <Variable> [= <Value>]")
1570 ;; if there are unread events, don't wait
1571 (or (vip-set-unread-command-events "") (sit-for 2))
1577 (let ((var (ex-set-read-variable))
1581 (auto-cmd-label "; don't touch or else...")
1582 (delete-turn-on-auto-fill-pattern
1583 "([ \t]*add-hook[ \t]+'vip-insert-state-hooks[ \t]+'turn-on-auto-fill.*)")
1584 actual-lisp-cmd lisp-cmd-del-pattern
1587 (cond ((string= var
"all")
1588 (setq ask-if-save nil
1590 ((member var
'("ai" "autoindent"))
1591 (setq var
"vip-auto-indent"
1595 ((member var
'("ai-g" "autoindent-global"))
1596 (kill-local-variable 'vip-auto-indent
)
1597 (setq var
"vip-auto-indent"
1598 set-cmd
"setq-default"
1600 ((member var
'("noai" "noautoindent"))
1601 (setq var
"vip-auto-indent"
1604 ((member var
'("noai-g" "noautoindent-global"))
1605 (kill-local-variable 'vip-auto-indent
)
1606 (setq var
"vip-auto-indent"
1607 set-cmd
"setq-default"
1609 ((member var
'("ic" "ignorecase"))
1610 (setq var
"vip-case-fold-search"
1612 ((member var
'("noic" "noignorecase"))
1613 (setq var
"vip-case-fold-search"
1615 ((member var
'("ma" "magic"))
1616 (setq var
"vip-re-search"
1618 ((member var
'("noma" "nomagic"))
1619 (setq var
"vip-re-search"
1621 ((member var
'("ro" "readonly"))
1622 (setq var
"buffer-read-only"
1624 ((member var
'("noro" "noreadonly"))
1625 (setq var
"buffer-read-only"
1627 ((member var
'("sm" "showmatch"))
1628 (setq var
"blink-matching-paren"
1630 ((member var
'("nosm" "noshowmatch"))
1631 (setq var
"blink-matching-paren"
1633 ((member var
'("ws" "wrapscan"))
1634 (setq var
"vip-search-wrap-around-t"
1636 ((member var
'("nows" "nowrapscan"))
1637 (setq var
"vip-search-wrap-around-t"
1639 (if (and set-cmd
(eq val
0)) ; value must be set by the user
1640 (let ((cursor-in-echo-area t
))
1641 (message ":set %s = <Value>" var
)
1642 ;; if there are unread events, don't wait
1643 (or (vip-set-unread-command-events "") (sit-for 2))
1644 (setq val
(read-string (format ":set %s = " var
)))
1645 (ex-fixup-history "set" orig-var val
)
1647 ;; check numerical values
1651 "ts-g" "tabstop-global"
1654 (or (numberp (setq val2
(car (read-from-string val
))))
1655 (error "%s: Invalid value, numberp, %S" var val
))
1657 (error "%s: Invalid value, numberp, %S" var val
))))
1660 ((member var
'("sw" "shiftwidth"))
1661 (setq var
"vip-shift-width"))
1662 ((member var
'("ts" "tabstop"))
1663 ;; make it take effect in curr buff and new bufs
1664 (setq var
"tab-width"
1667 ((member var
'("ts-g" "tabstop-global"))
1668 (kill-local-variable 'tab-width
)
1669 (setq var
"tab-width"
1670 set-cmd
"setq-default"))
1671 ((member var
'("wm" "wrapmargin"))
1672 ;; make it take effect in curr buff and new bufs
1673 (kill-local-variable 'fill-column
)
1674 (setq var
"fill-column"
1675 val
(format "(- (window-width) %s)" val
)
1676 set-cmd
"setq-default"))
1677 ((member var
'("sh" "shell"))
1678 (setq var
"explicit-shell-file-name"
1679 val
(format "\"%s\"" val
)))))
1680 (ex-fixup-history "set" orig-var
))
1683 (setq actual-lisp-cmd
1684 (format "\n(%s %s %s) %s" set-cmd var val auto-cmd-label
)
1685 lisp-cmd-del-pattern
1686 (format "^\n?[ \t]*([ \t]*%s[ \t]+%s[ \t].*)[ \t]*%s"
1687 set-cmd var auto-cmd-label
)))
1689 (if (and ask-if-save
1690 (y-or-n-p (format "Do you want to save this setting in %s "
1691 vip-custom-file-name
)))
1693 (vip-save-string-in-file
1694 actual-lisp-cmd vip-custom-file-name
1696 lisp-cmd-del-pattern
)
1697 (if (string= var
"fill-column")
1699 (vip-save-string-in-file
1701 "(add-hook 'vip-insert-state-hooks 'turn-on-auto-fill) "
1703 vip-custom-file-name
1704 delete-turn-on-auto-fill-pattern
)
1705 (vip-save-string-in-file
1706 nil vip-custom-file-name delete-turn-on-auto-fill-pattern
)
1707 (vip-save-string-in-file
1708 nil vip-custom-file-name
1710 lisp-cmd-del-pattern
)
1717 (if (string-match "^[ \t]*$" val
)
1721 (eval (car (read-from-string actual-lisp-cmd
))))
1722 (if (string= var
"fill-column")
1725 (auto-fill-mode -
1)))
1726 (if (string= var
"all") (ex-show-vars))
1729 ;; In inline args, skip regex-forw and (optionally) chars-back.
1730 ;; Optional 3d arg is a string that should replace ' ' to prevent its
1732 (defun ex-get-inline-cmd-args (regex-forw &optional chars-back replace-str
)
1734 (setq vip-ex-work-buf
(get-buffer-create vip-ex-work-buf-name
))
1735 (set-buffer vip-ex-work-buf
)
1736 (goto-char (point-min))
1737 (re-search-forward regex-forw nil t
)
1740 (goto-char (point-max))
1742 (skip-chars-backward chars-back
)
1743 (skip-chars-backward " \t\n\C-m"))
1745 ;; replace SPC with `=' to suppress the special meaning SPC has
1749 (while (re-search-forward " +" nil t
)
1750 (replace-match replace-str nil t
)
1751 (vip-forward-char-carefully)))
1753 (buffer-substring beg end
))))
1760 ;; Viper help. Invokes Info
1764 (pop-to-buffer (get-buffer-create "*info*"))
1765 (info (if vip-xemacs-p
"viper.info" "viper"))
1766 (message "Type `i' to search for a specific topic"))
1768 (with-output-to-temp-buffer " *vip-info*"
1770 The Info file for Viper does not seem to be installed.
1772 This file is part of the standard distribution of %sEmacs.
1773 Please contact your system administrator. "
1774 (if vip-xemacs-p
"X" "")
1777 ;; Ex source command. Loads the file specified as argument or `~/.vip'
1780 (if (string= ex-file
"")
1781 (load vip-custom-file-name
)
1784 ;; Ex substitute command
1785 ;; If REPEAT use previous regexp which is ex-reg-exp or vip-s-string
1786 (defun ex-substitute (&optional repeat r-flag
)
1790 (case-fold-search vip-case-fold-search
)
1792 (if repeat
(setq ex-token nil
) (setq delim
(vip-get-ex-pat)))
1795 (setq pat
(if r-flag vip-s-string ex-reg-exp
))
1797 (error "No previous pattern to use in substitution"))
1799 delim
(string-to-char pat
)))
1800 (setq pat
(if (string= ex-token
"") vip-s-string ex-token
))
1801 (setq vip-s-string pat
1803 (setq delim
(vip-get-ex-pat))
1809 (while (vip-get-ex-opt-gc delim
)
1810 (if (string= ex-token
"g") (setq opt-g t
) (setq opt-c t
)))
1814 (if ex-addresses
(goto-char (car ex-addresses
)))
1816 (forward-line (1- ex-count
))
1817 (setq ex-addresses
(cons (point) (cons (mark t
) nil
))))
1818 (if (null ex-addresses
)
1819 (setq ex-addresses
(cons (point) (cons (point) nil
)))
1820 (if (null (cdr ex-addresses
))
1821 (setq ex-addresses
(cons (car ex-addresses
) ex-addresses
)))))
1823 (let ((beg (car ex-addresses
))
1824 (end (car (cdr ex-addresses
)))
1827 (vip-enlarge-region beg end
)
1828 (let ((limit (save-excursion
1829 (goto-char (max (point) (mark t
)))
1831 (goto-char (min (point) (mark t
)))
1832 (while (< (point) limit
)
1834 (setq eol-mark
(point-marker))
1838 (while (and (not (eolp))
1839 (re-search-forward pat eol-mark t
))
1840 (if (or (not opt-c
) (y-or-n-p "Replace? "))
1842 (setq matched-pos
(point))
1843 (if (not (stringp repl
))
1844 (error "Can't perform Ex substitution: No previous replacement pattern"))
1845 (replace-match repl t
))))
1847 (vip-forward-char-carefully))
1850 "Can't repeat Ex substitution: No previous regular expression"))
1851 (if (and (re-search-forward pat eol-mark t
)
1852 (or (not opt-c
) (y-or-n-p "Replace? ")))
1854 (setq matched-pos
(point))
1855 (if (not (stringp repl
))
1856 (error "Can't perform Ex substitution: No previous replacement pattern"))
1857 (replace-match repl t
)))
1859 (vip-forward-char-carefully))))))
1860 (if matched-pos
(goto-char matched-pos
))
1862 (if opt-c
(message "done"))))
1867 (save-window-excursion
1868 (setq vip-ex-work-buf
(get-buffer-create vip-ex-work-buf-name
))
1869 (set-buffer vip-ex-work-buf
)
1870 (skip-chars-forward " \t")
1872 (skip-chars-forward "^ |\t\n")
1873 (setq tag
(buffer-substring (mark t
) (point))))
1874 (if (not (string= tag
"")) (setq ex-tag tag
))
1875 (vip-change-state-to-emacs)
1876 (condition-case conds
1878 (if (string= tag
"")
1880 (find-tag-other-window ex-tag
))
1881 (vip-change-state-to-vi))
1883 (vip-change-state-to-vi)
1884 (vip-message-conditions conds
)))))
1887 (defun ex-write (q-flag)
1888 (vip-default-ex-addresses t
)
1890 (let ((end (car ex-addresses
))
1891 (beg (car (cdr ex-addresses
)))
1892 (orig-buf (current-buffer))
1893 (orig-buf-file-name (buffer-file-name))
1894 (orig-buf-name (buffer-name))
1895 (buff-changed-p (buffer-modified-p))
1896 temp-buf writing-same-file region
1897 file-exists writing-whole-file
)
1898 (if (> beg end
) (error vip-FirstAddrExceedsSecond
))
1901 (vip-enlarge-region beg end
)
1902 (shell-command-on-region (point) (mark t
) ex-file
))
1903 (if (and (string= ex-file
"") (not (buffer-file-name)))
1906 (format "Buffer %s isn't visiting any file. File to save in: "
1909 (setq writing-whole-file
(and (= (point-min) beg
) (= (point-max) end
))
1910 ex-file
(if (string= ex-file
"")
1912 (expand-file-name ex-file
)))
1913 ;; if ex-file is a directory use the file portion of the buffer file name
1914 (if (and (file-directory-p ex-file
)
1916 (not (file-directory-p buffer-file-name
)))
1918 (concat (file-name-as-directory ex-file
)
1919 (file-name-nondirectory buffer-file-name
))))
1921 (setq file-exists
(file-exists-p ex-file
)
1922 writing-same-file
(string= ex-file
(buffer-file-name)))
1924 (if (and writing-whole-file writing-same-file
)
1925 (if (not (buffer-modified-p))
1926 (message "(No changes need to be saved)")
1930 (ex-write-info file-exists ex-file
(point-min) (point-max))
1932 ;; writing some other file or portion of the current file
1933 (cond ((and file-exists
1934 (not writing-same-file
)
1936 (format "File %s exists. Overwrite? " ex-file
))))
1938 ((and writing-whole-file
(not ex-append
))
1941 (set-visited-file-name ex-file
)
1942 (set-buffer-modified-p t
)
1944 ;; restore the buffer file name
1945 (set-visited-file-name orig-buf-file-name
)
1946 (set-buffer-modified-p buff-changed-p
)
1947 ;; If the buffer wasn't visiting a file, restore buffer name.
1948 ;; Name could've been changed by packages such as uniquify.
1949 (or orig-buf-file-name
1952 (rename-buffer orig-buf-name
))))
1956 file-exists ex-file
(point-min) (point-max))))
1957 (t ; writing a region
1960 (vip-enlarge-region beg end
)
1961 (setq region
(buffer-substring (point) (mark t
)))
1962 ;; create temp buffer for the region
1963 (setq temp-buf
(get-buffer-create " *ex-write*"))
1964 (set-buffer temp-buf
)
1965 (set-visited-file-name ex-file
'noquerry
)
1967 (if (and file-exists ex-append
)
1968 (insert-file-contents ex-file
))
1969 (goto-char (point-max))
1973 file-exists ex-file
(point-min) (point-max))
1975 (set-buffer temp-buf
)
1976 (set-buffer-modified-p nil
)
1977 (kill-buffer temp-buf
))
1979 (set-buffer orig-buf
)
1980 ;; this prevents the loss of data if writing part of the buffer
1981 (if (and (buffer-file-name) writing-same-file
)
1982 (set-visited-file-modtime))
1983 (or writing-whole-file
1984 (not writing-same-file
)
1985 (set-buffer-modified-p t
))
1987 (if (< vip-expert-level
2)
1988 (save-buffers-kill-emacs)
1989 (kill-buffer (current-buffer))))
1993 (defun ex-write-info (exists file-name beg end
)
1994 (message "`%s'%s %d lines, %d characters"
1995 (vip-abbreviate-file-name file-name
)
1996 (if exists
"" " [New file]")
1997 (count-lines beg
(min (1+ end
) (point-max)))
2002 (vip-default-ex-addresses)
2004 (let ((end (car ex-addresses
)) (beg (car (cdr ex-addresses
))))
2005 (if (> beg end
) (error vip-FirstAddrExceedsSecond
))
2007 (vip-enlarge-region beg end
)
2008 (exchange-point-and-mark)
2009 (if (or ex-g-flag ex-g-variant
)
2010 (error "Can't execute `yank' within `global'"))
2014 (forward-line (1- ex-count
)))
2016 (vip-enlarge-region (point) (mark t
))
2017 (if ex-flag
(error "`yank': %s" vip-SpuriousText
))
2019 (cond ((vip-valid-register ex-buffer
'(Letter))
2020 (vip-append-to-register
2021 (downcase ex-buffer
) (point) (mark t
)))
2022 ((vip-valid-register ex-buffer
)
2023 (copy-to-register ex-buffer
(point) (mark t
) nil
))
2024 (t (error vip-InvalidRegister ex-buffer
))))
2025 (copy-region-as-kill (point) (mark t
)))))
2027 ;; Execute shell command
2028 (defun ex-command ()
2030 (save-window-excursion
2031 (setq vip-ex-work-buf
(get-buffer-create vip-ex-work-buf-name
))
2032 (set-buffer vip-ex-work-buf
)
2033 (skip-chars-forward " \t")
2034 (setq command
(buffer-substring (point) (point-max)))
2036 (setq command
(ex-expand-filsyms command
(current-buffer)))
2037 (if (and (> (length command
) 0) (string= "!" (substring command
0 1)))
2038 (if vip-ex-last-shell-com
2039 (setq command
(concat vip-ex-last-shell-com
(substring command
1)))
2040 (error "No previous shell command")))
2041 (setq vip-ex-last-shell-com command
)
2042 (if (null ex-addresses
)
2043 (shell-command command
)
2044 (let ((end (car ex-addresses
)) (beg (car (cdr ex-addresses
))))
2045 (if (null beg
) (setq beg end
))
2049 (vip-enlarge-region (point) (mark t
))
2050 (shell-command-on-region (point) (mark t
) command t
))
2053 ;; Print line number
2054 (defun ex-line-no ()
2058 (if (null ex-addresses
) (point-max) (car ex-addresses
))))))
2060 ;; Give information on the file visited by the current buffer
2061 (defun vip-info-on-file ()
2063 (let ((pos1 (vip-line-pos 'start
))
2064 (pos2 (vip-line-pos 'end
))
2066 (setq lines
(count-lines (point-min) (vip-line-pos 'end
))
2067 file
(if (buffer-file-name)
2068 (concat (vip-abbreviate-file-name (buffer-file-name)) ":")
2069 (concat (buffer-name) " [Not visiting any file]:"))
2070 info
(format "line=%d/%d pos=%d/%d col=%d %s"
2074 (count-lines (point-min) (point-max))
2075 (point) (1- (point-max))
2076 (1+ (current-column))
2077 (if (buffer-modified-p) "[Modified]" "[Unchanged]")))
2078 (if (< (+ 1 (length info
) (length file
))
2079 (window-width (minibuffer-window)))
2080 (message (concat file
" " info
))
2081 (save-window-excursion
2082 (with-output-to-temp-buffer " *vip-info*"
2085 "\n\n\nPress any key to continue...\n\n")))
2087 (kill-buffer " *vip-info*")))
2090 ;; display all variables set through :set
2091 (defun ex-show-vars ()
2092 (with-output-to-temp-buffer " *vip-info*"
2093 (princ (if vip-auto-indent
2094 "autoindent (local)\n" "noautoindent (local)\n"))
2095 (princ (if (default-value 'vip-auto-indent
)
2096 "autoindent (global) \n" "noautoindent (global) \n"))
2097 (princ (if vip-case-fold-search
"ignorecase\n" "noignorecase\n"))
2098 (princ (if vip-re-search
"magic\n" "nomagic\n"))
2099 (princ (if buffer-read-only
"readonly\n" "noreadonly\n"))
2100 (princ (if blink-matching-paren
"showmatch\n" "noshowmatch\n"))
2101 (princ (if vip-search-wrap-around-t
"wrapscan\n" "nowrapscan\n"))
2102 (princ (format "shiftwidth \t\t= %S\n" vip-shift-width
))
2103 (princ (format "tabstop (local) \t= %S\n" tab-width
))
2104 (princ (format "tabstop (global) \t= %S\n" (default-value 'tab-width
)))
2105 (princ (format "wrapmargin (local) \t= %S\n"
2106 (- (window-width) fill-column
)))
2107 (princ (format "wrapmargin (global) \t= %S\n"
2108 (- (window-width) (default-value 'fill-column
))))
2109 (princ (format "shell \t\t\t= %S\n" (if (boundp 'explicit-shell-file-name
)
2110 explicit-shell-file-name
2118 ;;; viper-ex.el ends here