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