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