lisp/emulation/viper-ex.el

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