root/trunk/lisp/emulation/viper-ex.el

;;; viper-ex.el --- functions implementing the Ex commands for Viper

;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 2000, 2001, 2002, 2003,
;;   2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.

;; Author: Michael Kifer <kifer@cs.stonybrook.edu>

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;;; Commentary:

;;; Code:

(provide 'viper-ex)

;; Compiler pacifier
(defvar read-file-name-map)
(defvar viper-use-register)
(defvar viper-s-string)
(defvar viper-shift-width)
(defvar viper-ex-history)
(defvar viper-related-files-and-buffers-ring)
(defvar viper-local-search-start-marker)
(defvar viper-expert-level)
(defvar viper-custom-file-name)
(defvar viper-case-fold-search)
(defvar explicit-shell-file-name)
(defvar compile-command)

;; loading happens only in non-interactive compilation
;; in order to spare non-viperized emacs from being viperized
(if noninteractive
    (eval-when-compile
      (let ((load-path (cons (expand-file-name ".") load-path)))
        (or (featurep 'viper-util)
            (load "viper-util.el" nil nil 'nosuffix))
        (or (featurep 'viper-keym)
            (load "viper-keym.el" nil nil 'nosuffix))
        (or (featurep 'viper-cmd)
            (load "viper-cmd.el" nil nil 'nosuffix))
        )))
;; end pacifier

(require 'viper-util)

(defgroup viper-ex nil
  "Viper support for Ex commands."
  :prefix "ex-"
  :group 'viper)



;;; Variables

(defconst viper-ex-work-buf-name " *ex-working-space*")
(defvar viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name))
(defconst viper-ex-tmp-buf-name " *ex-tmp*")
(defconst viper-ex-print-buf-name " *ex-print*")
(defvar viper-ex-print-buf (get-buffer-create viper-ex-print-buf-name))


;;; ex-commands...

(defun ex-cmd-obsolete (name)
  (error "`%s': Obsolete command, not supported by Viper" name))

(defun ex-cmd-not-yet (name)
  (error "`%s': Command not implemented in Viper" name))

;; alist entries: name (in any order), command, cont(??)
;; If command is a string, then that is an alias to the real command
;; to execute (for instance, ":m" -> ":move").
;; command attributes:
;;   is-mashed: the command's args may be jammed right up against the command
;;   one-letter: this is a one-letter token.  Any text appearing after
;;                   the name gets appended as an argument for the command
;;               i.e. ":kabc" gets turned into (ex-mark "abc")
(defconst ex-token-alist '(
        ("!"                    (ex-command))
        ("&"                    (ex-substitute t))
        ("="                    (ex-line-no))
        (">"                    (ex-line "right"))
        ("<"                    (ex-line "left"))
        ("Buffer"               (if ex-cycle-other-window
                                    (viper-switch-to-buffer)
                                  (viper-switch-to-buffer-other-window)))
        ("Next"                 (ex-next (not ex-cycle-other-window)))
        ("PreviousRelatedFile"  (ex-next-related-buffer -1))
        ("RelatedFile"          (ex-next-related-buffer 1))
        ("W"                    "Write")
        ("WWrite"               (save-some-buffers t))
        ("Write"                (save-some-buffers))
        ("a"                    "append")
        ("args"                 (ex-args))
        ("buffer"               (if ex-cycle-other-window
                                    (viper-switch-to-buffer-other-window)
                                  (viper-switch-to-buffer)))
        ("c"                    "change")
        ;; ch should be "change" but maintain old viper compatibility
        ("ch"                   "chdir")
        ("cd"                   (ex-cd))
        ("chdir"                (ex-cd))
        ("copy"                 (ex-copy nil))
        ("customize"            (customize-group "viper"))
        ("delete"               (ex-delete))
        ("edit"                 (ex-edit))
        ("file"                 (ex-set-visited-file-name))
        ("g"                    "global")
        ("global"               (ex-global nil) is-mashed)
        ("goto"                 (ex-goto))
        ("help"                 (ex-help))
        ("join"                 (ex-line "join"))
        ("k"                    (ex-mark) one-letter)
        ("kmark"                (ex-mark))
        ("m"                    "move")
        ("make"                 (ex-compile))
        ; old viper doesn't specify a default for "ma" so leave it undefined
        ("map"                  (ex-map))
        ("mark"                 (ex-mark))
        ("move"                 (ex-copy t))
        ("next"                 (ex-next ex-cycle-other-window))
        ("p"                    "print")
        ("preserve"             (ex-preserve))
        ("print"                (ex-print))
        ("put"                  (ex-put))
        ("pwd"                  (ex-pwd))
        ("quit"                 (ex-quit))
        ("r"                    "read")
        ("re"                   "read")
        ("read"                 (ex-read))
        ("recover"              (ex-recover))
        ("rewind"               (ex-rewind))
        ("s"                    "substitute")
        ("su"                   "substitute")
        ("sub"                  "substitute")
        ("set"                  (ex-set))
        ("shell"                (ex-shell))
        ("source"               (ex-source))
        ("stop"                 (suspend-emacs))
        ("sr"                   (ex-substitute t t))
        ("submitReport"         (viper-submit-report))
        ("substitute"           (ex-substitute) is-mashed)
        ("suspend"              (suspend-emacs))
        ("t"                    "transfer")
        ("tag"                  (ex-tag))
        ("transfer"             (ex-copy nil))
        ("u"                    "undo")
        ("un"                   "undo")
        ("undo"                 (viper-undo))
        ("unmap"                (ex-unmap))
        ("v"                    "vglobal")
        ("version"              (viper-version))
        ("vglobal"              (ex-global t) is-mashed)
        ("visual"               (ex-edit))
        ("w"                    "write")
        ("wq"                   (ex-write t))
        ("write"                (ex-write nil))
        ("xit"                  (ex-write t))
        ("yank"                 (ex-yank))
        ("~"                    (ex-substitute t t))

        ("append"               (ex-cmd-obsolete "append"))
        ("change"               (ex-cmd-obsolete "change"))
        ("insert"               (ex-cmd-obsolete "insert"))
        ("open"                 (ex-cmd-obsolete "open"))

        ("list"                 (ex-cmd-not-yet "list"))
        ("z"                    (ex-cmd-not-yet "z"))
        ("#"                    (ex-cmd-not-yet "#"))

        ("abbreviate"           (error "`%s': Vi abbreviations are obsolete.  Use the more powerful Emacs abbrevs" ex-token))
        ("unabbreviate"         (error "`%s': Vi abbreviations are obsolete.  Use the more powerful Emacs abbrevs" ex-token))
        ))

;; No code should touch anything in the alist entry!  (other than the name,
;; "car entry", of course)   This way, changing this data structure
;; requires changing only the following ex-cmd functions...

;; Returns cmd if the command may be jammed right up against its
;; arguments, nil if there must be a space.
;; examples of mashable commands: g// g!// v// s// sno// sm//
(defun ex-cmd-is-mashed-with-args (cmd)
  (if (eq 'is-mashed (car (nthcdr 2 cmd))) cmd))

;; Returns true if this is a one-letter command that may be followed
;; by anything, no whitespace needed.  This is a special-case for ":k".
(defun ex-cmd-is-one-letter (cmd)
  (if (eq 'one-letter (car (nthcdr 2 cmd))) cmd))

;; Executes the function associated with the command
(defun ex-cmd-execute (cmd)
  (eval (cadr cmd)))

;; If this is a one-letter magic command, splice in args.
(defun ex-splice-args-in-1-letr-cmd (key list)
  (let ((oneletter (ex-cmd-is-one-letter (assoc (substring key 0 1) list))))
    (if oneletter
        (list key
              (append (cadr oneletter)
                      (if (< 1 (length key)) (list (substring key 1))))
              (car (cdr (cdr oneletter))) ))
        ))


;; Returns the alist entry for the appropriate key.
;; Tries to complete the key before using it in the alist.
;; If there is no appropriate key (no match or duplicate matches) return nil
(defun ex-cmd-assoc (key list)
  (let ((entry (try-completion key list))
        result)
    (setq result (cond
                  ((eq entry t)     (assoc key list))
                  ((stringp entry)  (or (ex-splice-args-in-1-letr-cmd key list)
                                        (assoc entry list)))
                  ((eq entry nil)   (ex-splice-args-in-1-letr-cmd key list))
                  (t nil)
                  ))
    ;; If we end up with an alias, look up the alias...
    (if (stringp (cadr result))
        (setq result (ex-cmd-assoc (cadr result) list)))
    ;; and return the corresponding alist entry
    result
    ))


;; A-list of Ex variables that can be set using the :set command.
(defconst ex-variable-alist
  '(("wrapscan") ("ws") ("wrapmargin") ("wm")
    ("tabstop-global") ("ts-g") ("tabstop") ("ts")
    ("showmatch") ("sm") ("shiftwidth") ("sw") ("shell") ("sh")
    ("readonly") ("ro")
    ("nowrapscan") ("nows") ("noshowmatch") ("nosm")
    ("noreadonly") ("noro") ("nomagic") ("noma")
    ("noignorecase") ("noic")
    ("noautoindent-global") ("noai-g") ("noautoindent") ("noai")
    ("magic") ("ma") ("ignorecase") ("ic")
    ("autoindent-global") ("ai-g") ("autoindent") ("ai")
    ("all")
    ))



;; Token recognized during parsing of Ex commands (e.g., "read", "comma")
(defvar ex-token nil)

;; Type of token.
;; If non-nil, gives type of address; if nil, it is a command.
(defvar ex-token-type nil)

;; List of addresses passed to Ex command
(defvar ex-addresses nil)

;; This flag is supposed to be set only by `#', `print', and `list',
;; none of which is implemented.  So, it and the pices of the code it
;; controls are dead weight.  We keep it just in case this might be
;; needed in the future.
(defvar ex-flag nil)

;; "buffer" where Ex commands keep deleted data.
;; In Emacs terms, this is a register.
(defvar ex-buffer nil)

;; Value of ex count.
(defvar ex-count nil)

;; Flag indicating that :global Ex command is being executed.
(defvar ex-g-flag nil)
;; Flag indicating that :vglobal Ex command is being executed.
(defvar ex-g-variant nil)
;; Marks to operate on during a :global Ex command.
(defvar ex-g-marks nil)

;; Save reg-exp used in substitute.
(defvar ex-reg-exp nil)


;; Replace pattern for substitute.
(defvar ex-repl nil)

;; Pattern for global command.
(defvar ex-g-pat nil)

(defcustom ex-unix-type-shell
  (let ((case-fold-search t))
    (and (stringp shell-file-name)
         (string-match
          (concat
           "\\("
           "csh$\\|csh.exe$"
           "\\|"
           "ksh$\\|ksh.exe$"
           "\\|"
           "^sh$\\|sh.exe$"
           "\\|"
           "[^a-z]sh$\\|[^a-z]sh.exe$"
           "\\|"
           "bash$\\|bash.exe$"
           "\\)")
          shell-file-name)))
  "Is the user using a unix-type shell under a non-OS?"
  :type 'boolean
  :group 'viper-ex)

(defcustom ex-unix-type-shell-options
  (let ((case-fold-search t))
    (if ex-unix-type-shell
        (cond ((string-match "\\(csh$\\|csh.exe$\\)" shell-file-name)
               "-f") ; csh: do it fast
              ((string-match "\\(bash$\\|bash.exe$\\)" shell-file-name)
               "-noprofile") ; bash: ignore .profile
              )))
  "Options to pass to the Unix-style shell.
Don't put `-c' here, as it is added automatically."
  :type '(choice (const nil) string)
  :group 'viper-ex)

(defcustom ex-compile-command "make"
  "The command to run when the user types :make."
  :type 'string
  :group 'viper-ex)

(defcustom viper-glob-function
  (cond (ex-unix-type-shell 'viper-glob-unix-files)
        ((eq system-type 'emx) 'viper-glob-mswindows-files) ; OS/2
        (viper-ms-style-os-p 'viper-glob-mswindows-files) ; Microsoft OS
        (viper-vms-os-p 'viper-glob-unix-files) ; VMS
        (t  'viper-glob-unix-files) ; presumably UNIX
        )
  "Expand the file spec containing wildcard symbols.
The default tries to set this variable to work with Unix, Windows,
OS/2, and VMS.

However, if it doesn't work right for some types of Unix shells or some OS,
the user should supply the appropriate function and set this variable to the
corresponding function symbol."
  :type 'symbol
  :group 'viper-ex)


;; Remembers the previous Ex tag.
(defvar ex-tag nil)

;; file used by Ex commands like :r, :w, :n
(defvar ex-file nil)

;; If t, tells Ex that this is a variant-command, i.e., w>>, r!, etc.
(defvar ex-variant nil)

;; Specified the offset of an Ex command, such as :read.
(defvar ex-offset nil)

;; Tells Ex that this is a w>> command.
(defvar ex-append nil)

;; File containing the shell command to be executed at Ex prompt,
;; e.g., :r !date
(defvar ex-cmdfile nil)
(defvar ex-cmdfile-args "")

;; flag used in viper-ex-read-file-name to indicate that we may be reading
;; multiple file names.  Used for :edit and :next
(defvar viper-keep-reading-filename nil)

(defcustom ex-cycle-other-window t
  "*If t, :n and :b cycles through files and buffers in other window.
Then :N and :B cycles in the current window.  If nil, this behavior is
reversed."
  :type 'boolean
  :group 'viper-ex)

(defcustom ex-cycle-through-non-files nil
  "*Cycle through *scratch* and other buffers that don't visit any file."
  :type 'boolean
  :group 'viper-ex)

;; Last shell command executed with :! command.
(defvar viper-ex-last-shell-com nil)

;; Indicates if Minibuffer was exited temporarily in Ex-command.
(defvar viper-incomplete-ex-cmd nil)

;; Remembers the last ex-command prompt.
(defvar viper-last-ex-prompt "")


;; Get a complete ex command
(defun viper-get-ex-com-subr ()
  (let (cmd case-fold-search)
    (set-mark (point))
    (re-search-forward "[a-zA-Z][a-zA-Z]*")
    (setq ex-token-type 'command)
    (setq ex-token (buffer-substring (point) (mark t)))
    (setq cmd (ex-cmd-assoc ex-token ex-token-alist))
    (if cmd
        (setq ex-token (car cmd))
      (setq ex-token-type 'non-command))
    ))

;; Get an ex-token which is either an address or a command.
;; A token has a type, \(command, address, end-mark\), and a value
(defun viper-get-ex-token ()
  (save-window-excursion
    (setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name))
    (set-buffer viper-ex-work-buf)
    (skip-chars-forward " \t|")
    (let ((case-fold-search t))
      (cond ((looking-at "#")
             (setq ex-token-type 'command)
             (setq ex-token (char-to-string (following-char)))
             (forward-char 1))
            ((looking-at "[a-z]") (viper-get-ex-com-subr))
            ((looking-at "\\.")
             (forward-char 1)
             (setq ex-token-type 'dot))
            ((looking-at "[0-9]")
             (set-mark (point))
             (re-search-forward "[0-9]*")
             (setq ex-token-type
                   (cond ((eq ex-token-type 'plus) 'add-number)
                         ((eq ex-token-type 'minus) 'sub-number)
                         (t 'abs-number)))
             (setq ex-token
                   (string-to-number (buffer-substring (point) (mark t)))))
            ((looking-at "\\$")
             (forward-char 1)
             (setq ex-token-type 'end))
            ((looking-at "%")
             (forward-char 1)
             (setq ex-token-type 'whole))
            ((looking-at "+")
             (cond ((or (looking-at "+[-+]") (looking-at "+[\n|]"))
                    (forward-char 1)
                    (insert "1")
                    (backward-char 1)
                  (setq ex-token-type 'plus))
                   ((looking-at "+[0-9]")
                    (forward-char 1)
                    (setq ex-token-type 'plus))
                   (t
                    (error viper-BadAddress))))
            ((looking-at "-")
             (cond ((or (looking-at "-[-+]") (looking-at "-[\n|]"))
                    (forward-char 1)
                    (insert "1")
                    (backward-char 1)
                    (setq ex-token-type 'minus))
                   ((looking-at "-[0-9]")
                    (forward-char 1)
                    (setq ex-token-type 'minus))
                   (t
                    (error viper-BadAddress))))
            ((looking-at "/")
             (forward-char 1)
             (set-mark (point))
             (let ((cont t))
               (while (and (not (eolp)) cont)
                 ;;(re-search-forward "[^/]*/")
                 (re-search-forward "[^/]*\\(/\\|\n\\)")
                 (if (not (viper-looking-back "[^\\\\]\\(\\\\\\\\\\)*\\\\/"))
                     (setq cont nil))))
             (backward-char 1)
             (setq ex-token (buffer-substring (point) (mark t)))
             (if (looking-at "/") (forward-char 1))
             (setq ex-token-type 'search-forward))
            ((looking-at "\\?")
             (forward-char 1)
             (set-mark (point))
             (let ((cont t))
               (while (and (not (eolp)) cont)
                 ;;(re-search-forward "[^\\?]*\\?")
                 (re-search-forward "[^\\?]*\\(\\?\\|\n\\)")
                 (if (not (viper-looking-back "[^\\\\]\\(\\\\\\\\\\)*\\\\\\?"))
                     (setq cont nil))
                 (backward-char 1)
                 (if (not (looking-at "\n")) (forward-char 1))))
             (setq ex-token-type 'search-backward)
             (setq ex-token (buffer-substring (1- (point)) (mark t))))
            ((looking-at ",")
             (forward-char 1)
             (setq ex-token-type 'comma))
            ((looking-at ";")
             (forward-char 1)
             (setq ex-token-type 'semi-colon))
            ((looking-at "[!=><&~]")
             (setq ex-token-type 'command)
             (setq ex-token (char-to-string (following-char)))
             (forward-char 1))
            ((looking-at "'")
             (setq ex-token-type 'goto-mark)
             (forward-char 1)
             (cond ((looking-at "'") (setq ex-token nil))
                   ((looking-at "[a-z]") (setq ex-token (following-char)))
                   (t (error "Marks are ' and a-z")))
             (forward-char 1))
            ((looking-at "\n")
             (setq ex-token-type 'end-mark)
             (setq ex-token "goto"))
            (t
             (error viper-BadExCommand))))))

;; Reads Ex command.  Tries to determine if it has to exit because command
;; is complete or invalid.  If not, keeps reading command.
(defun ex-cmd-read-exit ()
  (interactive)
  (setq viper-incomplete-ex-cmd t)
  (let ((quit-regex1 (concat
                      "\\(" "set[ \t]*"
                      "\\|" "edit[ \t]*"
                      "\\|" "[nN]ext[ \t]*"
                      "\\|" "unm[ \t]*"
                      "\\|" "^[ \t]*rep"
                      "\\)"))
        (quit-regex2 (concat
                      "[a-zA-Z][ \t]*"
                      "\\(" "!" "\\|" ">>"
                      "\\|" "\\+[0-9]+"
                      "\\)"
                      "*[ \t]*$"))
        (stay-regex (concat
                     "\\(" "^[ \t]*$"
                     "\\|" "[?/].*"
                     "\\|" "[ktgjmsz][ \t]*$"
                     "\\|" "^[ \t]*ab.*"
                     "\\|" "tr[ansfer \t]*"
                     "\\|" "sr[ \t]*"
                     "\\|" "mo.*"
                     "\\|" "^[ \t]*k?ma[^p]*"
                     "\\|" "^[ \t]*fi.*"
                     "\\|" "v?gl.*"
                     "\\|" "[vg][ \t]*$"
                     "\\|" "jo.*"
                     "\\|" "^[ \t]*ta.*"
                     "\\|" "^[ \t]*una.*"
                     ;; don't jump up in :s command
                     "\\|" "^[ \t]*\\([`'][a-z]\\|[.,%]\\)*[ \t]*su.*"
                     "\\|" "^[ \t]*\\([`'][a-z]\\|[.,%]\\)*[ \t]*s[^a-z].*"
                     "\\|" "['`][a-z][ \t]*"
                     ;; r! assumes that the next one is a shell command
                     "\\|" "\\(r\\|re\\|rea\\|read\\)[ \t]*!"
                     ;; w ! assumes that the next one is a shell command
                     "\\|" "\\(w\\|wr\\|wri\\|writ.?\\)[ \t]+!"
                     "\\|" "![ \t]*[a-zA-Z].*"
                     "\\)"
                     "!*")))

    (save-window-excursion ;; put cursor at the end of the Ex working buffer
      (setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name))
      (set-buffer viper-ex-work-buf)
      (goto-char (point-max)))
    (cond ((viper-looking-back quit-regex1) (exit-minibuffer))
          ((viper-looking-back stay-regex)  (insert " "))
          ((viper-looking-back quit-regex2) (exit-minibuffer))
          (t (insert " ")))))

;; complete Ex command
(defun ex-cmd-complete ()
  (interactive)
  (let (save-pos dist compl-list string-to-complete completion-result)

    (save-excursion
      (setq dist (skip-chars-backward "[a-zA-Z!=>&~]")
            save-pos (point)))

    (if (or (= dist 0)
            (viper-looking-back "\\([ \t]*['`][ \t]*[a-z]*\\)")
            (viper-looking-back
             "^[ \t]*[a-zA-Z!=>&~][ \t]*[/?]*[ \t]+[a-zA-Z!=>&~]+"))
        ;; Preceding characters are not the ones allowed in an Ex command
        ;; or we have typed past command name.
        ;; Note: we didn't do parsing, so there can be surprises.
        (if (or (viper-looking-back "[a-zA-Z!=>&~][ \t]*[/?]*[ \t]*")
                (viper-looking-back "\\([ \t]*['`][ \t]*[a-z]*\\)")
                (looking-at "[^ \t\n\C-m]"))
            nil
          (with-output-to-temp-buffer "*Completions*"
            (display-completion-list
             (viper-alist-to-list ex-token-alist))))
      ;; Preceding chars may be part of a command name
      (setq string-to-complete (buffer-substring save-pos (point)))
      (setq completion-result
            (try-completion string-to-complete ex-token-alist))

      (cond ((eq completion-result t)  ; exact match--do nothing
             (viper-tmp-insert-at-eob " (Sole completion)"))
            ((eq completion-result nil)
             (viper-tmp-insert-at-eob " (No match)"))
            (t  ;; partial completion
             (goto-char save-pos)
             (delete-region (point) (point-max))
             (insert completion-result)
             (let (case-fold-search)
               (setq compl-list
                     (viper-filter-alist (concat "^" completion-result)
                                       ex-token-alist)))
             (if (> (length compl-list) 1)
                 (with-output-to-temp-buffer "*Completions*"
                   (display-completion-list
                    (viper-alist-to-list (reverse compl-list)))))))
      )))


;; Read Ex commands
;; ARG is a prefix argument. If given, the ex command runs on the region
;;(without the user having to specify the address :a,b
;; STRING is the command to execute. If nil, then Viper asks you to enter the
;; command.
(defun viper-ex (arg &optional string)
  (interactive "P")
  (or string
      (setq ex-g-flag nil
            ex-g-variant nil))
  (let* ((map (copy-keymap minibuffer-local-map))
         (address nil)
         (cont t)
         (dot (point))
         reg-beg-line reg-end-line
         reg-beg reg-end
         initial-str
         prev-token-type com-str)
    (viper-add-keymap viper-ex-cmd-map map)

    (if arg
        (progn
          (viper-enlarge-region (mark t) (point))
          (if (> (point) (mark t))
              (setq reg-beg (mark t)
                    reg-end (point))
            (setq reg-end (mark t)
                  reg-beg (point)))
          (save-excursion
            (goto-char reg-beg)
            (setq reg-beg-line (1+ (count-lines (point-min) (point)))
                  reg-end-line
                  (+ reg-beg-line (count-lines reg-beg reg-end) -1)))))
    (if reg-beg-line
        (setq initial-str (format "%d,%d" reg-beg-line reg-end-line)))

    (setq com-str
          (or string (viper-read-string-with-history
                      ":"
                      initial-str
                      'viper-ex-history
                      ;; no default when working on region
                      (if initial-str
                          nil
                        (car viper-ex-history))
                      map
                      (if initial-str
                          " [Type command to execute on current region]"))))
    (save-window-excursion
      ;; just a precaution
      (setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name))
      (set-buffer viper-ex-work-buf)
      (delete-region (point-min) (point-max))
      (insert com-str "\n")
      (goto-char (point-min)))
    (setq ex-token-type nil
          ex-addresses nil)
    (while cont
      (viper-get-ex-token)
      (cond ((memq ex-token-type '(command end-mark))
             (if address (setq ex-addresses (cons address ex-addresses)))
             (viper-deactivate-mark)
             (let ((cmd (ex-cmd-assoc ex-token ex-token-alist)))
               (if (null cmd)
                   (error "`%s': %s" ex-token viper-BadExCommand))
               (ex-cmd-execute cmd)
               (if (or (ex-cmd-is-mashed-with-args cmd)
                       (ex-cmd-is-one-letter cmd))
                   (setq cont nil)
                 (save-excursion
                   (save-window-excursion
                     (setq viper-ex-work-buf
                           (get-buffer-create viper-ex-work-buf-name))
                     (set-buffer viper-ex-work-buf)
                     (skip-chars-forward " \t")
                     (cond ((looking-at "|")
                            (forward-char 1))
                           ((looking-at "\n")
                            (setq cont nil))
                           (t (error
                               "`%s': %s" ex-token viper-SpuriousText)))
                     )))
               ))
            ((eq ex-token-type 'non-command)
             (error "`%s': %s" ex-token viper-BadExCommand))
            ((eq ex-token-type 'whole)
             (setq address nil)
             (setq ex-addresses
                   (if ex-addresses
                       (cons (point-max) ex-addresses)
                     (cons (point-max) (cons (point-min) ex-addresses)))))
            ((eq ex-token-type 'comma)
             (if (eq prev-token-type 'whole)
                 (setq address (point-min)))
             (setq ex-addresses
                   (cons (if (null address) (point) address) ex-addresses)))
            ((eq ex-token-type 'semi-colon)
             (if (eq prev-token-type 'whole)
                 (setq address (point-min)))
             (if address (setq dot address))
             (setq ex-addresses
                   (cons (if (null address) (point) address) ex-addresses)))
            (t (let ((ans (viper-get-ex-address-subr address dot)))
                 (if ans (setq address ans)))))
      (setq prev-token-type ex-token-type))))


;; Get a regular expression and set `ex-variant', if found
;; Viper doesn't parse the substitution or search patterns.
;; In particular, it doesn't expand ~ into the last substitution.
(defun viper-get-ex-pat ()
  (save-window-excursion
    (setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name))
    (set-buffer viper-ex-work-buf)
    (skip-chars-forward " \t")
    (if (looking-at "!")
        ;; this is probably a variant command r!
        (progn
          (setq ex-g-variant (not ex-g-variant)
                ex-g-flag (not ex-g-flag))
          (forward-char 1)
          (skip-chars-forward " \t")))
    (let ((c (following-char)))
      (cond ((string-match "[0-9A-Za-z]" (format "%c" c))
             (error
              "Global regexp must be inside matching non-alphanumeric chars"))
            ((= c ??) (error "`?' is not an allowed pattern delimiter here")))
      (if (looking-at "[^\\\\\n]")
          (progn