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

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