code.delx.au - gnu-emacs/blob - lisp/emulation/viper-ex.el

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