lisp/emulation/viper-ex.el

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