lisp/emulation/viper-ex.el

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