lisp/emulation/vip.el

   1 ;;; vip.el --- a VI Package for GNU Emacs
   2
   3 ;; Copyright (C) 1986, 1987, 1988, 1992, 1993, 1998, 2001, 2002, 2003,
   4 ;;   2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
   5
   6 ;; Author: Masahiko Sato <ms@sail.stanford.edu>
   7 ;; Keywords: emulations
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software: you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation, either version 3 of the License, or
  14 ;; (at your option) any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  23
  24 ;;; Commentary:
  25
  26 ;; A full-featured vi(1) emulator.
  27 ;;
  28 ;; In Japan, the author's address is: masahiko@sato.riec.tohoku.junet
  29 ;;
  30 ;; Send suggestions and bug reports to one of the above addresses.
  31 ;; When you report a bug, be sure to include the version number of VIP and
  32 ;; Emacs you are using.
  33
  34 ;; Execute info command by typing "M-x info" to get information on VIP.
  35
  36 ;;; Code:
  37
  38 (defgroup vip nil
  39   "A VI Package for GNU Emacs."
  40   :prefix "vip-"
  41   :group 'emulations)
  42
  43 ;; external variables
  44
  45 (defvar vip-emacs-local-map nil
  46   "Local map used in Emacs mode.  (Buffer-specific.)")
  47
  48 (defvar vip-insert-local-map nil
  49   "Local map used in insert command mode.  (Buffer-specific.)")
  50
  51 (make-variable-buffer-local 'vip-emacs-local-map)
  52 (make-variable-buffer-local 'vip-insert-local-map)
  53
  54 (defvar vip-insert-point nil
  55   "Remember insert point as a marker.  (Buffer-specific.)")
  56
  57 (set-default 'vip-insert-point (make-marker))
  58 (make-variable-buffer-local 'vip-insert-point)
  59
  60 (defvar vip-com-point nil
  61   "Remember com point as a marker.  (Buffer-specific.)")
  62
  63 (set-default 'vip-com-point (make-marker))
  64 (make-variable-buffer-local 'vip-com-point)
  65
  66 (defvar vip-current-mode nil
  67   "Current mode.  One of `emacs-mode', `vi-mode', `insert-mode'.")
  68
  69 (make-variable-buffer-local 'vip-current-mode)
  70 (setq-default vip-current-mode 'emacs-mode)
  71
  72 (defvar vip-emacs-mode-line-buffer-identification nil
  73   "Value of mode-line-buffer-identification in Emacs mode within vip.")
  74 (make-variable-buffer-local 'vip-emacs-mode-line-buffer-identification)
  75 (setq-default vip-emacs-mode-line-buffer-identification
  76               '("Emacs: %17b"))
  77
  78 (defvar vip-current-major-mode nil
  79   "vip-current-major-mode is the major-mode vi considers it is now.
  80 \(buffer specific\)")
  81
  82 (make-variable-buffer-local 'vip-current-major-mode)
  83
  84 (defvar vip-last-shell-com nil
  85   "Last shell command executed by ! command.")
  86
  87 (defvar vip-use-register nil
  88   "Name of register to store deleted or yanked strings.")
  89
  90 (defvar vip-d-com nil
  91   "How to reexecute last destructive command.  Value is list (M-COM VAL COM).")
  92
  93 (defcustom vip-shift-width 8
  94   "The number of columns shifted by > and < command."
  95   :type 'integer
  96   :group 'vip)
  97
  98 (defcustom vip-re-replace nil
  99   "If t then do regexp replace, if nil then do string replace."
 100   :type 'boolean
 101   :group 'vip)
 102
 103 (defvar vip-d-char nil
 104   "The character remembered by the vi \"r\" command.")
 105
 106 (defvar vip-f-char nil
 107   "For use by \";\" command.")
 108
 109 (defvar vip-F-char nil
 110   "For use by \".\" command.")
 111
 112 (defvar vip-f-forward nil
 113   "For use by \";\" command.")
 114
 115 (defvar vip-f-offset nil
 116   "For use by \";\" command.")
 117
 118 (defcustom vip-search-wrap-around t
 119   "If t, search wraps around."
 120   :type 'boolean
 121   :group 'vip)
 122
 123 (defcustom vip-re-search nil
 124   "If t, search is reg-exp search, otherwise vanilla search."
 125   :type 'boolean
 126   :group 'vip)
 127
 128 (defvar vip-s-string nil
 129   "Last vip search string.")
 130
 131 (defvar vip-s-forward nil
 132   "If t, search is forward.")
 133
 134 (defcustom vip-case-fold-search nil
 135   "If t, search ignores cases."
 136   :type 'boolean
 137   :group 'vip)
 138
 139 (defcustom vip-re-query-replace nil
 140   "If t then do regexp replace, if nil then do string replace."
 141   :type 'boolean
 142   :group 'vip)
 143
 144 (defcustom vip-open-with-indent nil
 145   "If t, indent when open a new line."
 146   :type 'boolean
 147   :group 'vip)
 148
 149 (defcustom vip-help-in-insert-mode nil
 150   "If t then C-h is bound to help-command in insert mode.
 151 If nil then it is bound to `delete-backward-char'."
 152   :type 'boolean
 153   :group 'vip)
 154
 155 (defvar vip-quote-string "> "
 156   "String inserted at the beginning of region.")
 157
 158 (defvar vip-tags-file-name "TAGS")
 159
 160 (defvar vip-inhibit-startup-message nil)
 161
 162 (defvar vip-startup-file (convert-standard-filename "~/.vip")
 163   "Filename used as startup file for vip.")
 164 \f
 165 ;; key bindings
 166
 167 (defvar vip-mode-map (make-keymap))
 168
 169 (define-key vip-mode-map "\C-a" 'beginning-of-line)
 170 (define-key vip-mode-map "\C-b" 'vip-scroll-back)
 171 (define-key vip-mode-map "\C-c" 'vip-ctl-c)
 172 (define-key vip-mode-map "\C-d" 'vip-scroll-up)
 173 (define-key vip-mode-map "\C-e" 'vip-scroll-up-one)
 174 (define-key vip-mode-map "\C-f" 'vip-scroll)
 175 (define-key vip-mode-map "\C-g" 'vip-keyboard-quit)
 176 (define-key vip-mode-map "\C-h" 'help-command)
 177 (define-key vip-mode-map "\C-m" 'vip-scroll-back)
 178 (define-key vip-mode-map "\C-n" 'vip-other-window)
 179 (define-key vip-mode-map "\C-o" 'vip-open-line-at-point)
 180 (define-key vip-mode-map "\C-u" 'vip-scroll-down)
 181 (define-key vip-mode-map "\C-x" 'vip-ctl-x)
 182 (define-key vip-mode-map "\C-y" 'vip-scroll-down-one)
 183 (define-key vip-mode-map "\C-z" 'vip-change-mode-to-emacs)
 184 (define-key vip-mode-map "\e" 'vip-ESC)
 185
 186 (define-key vip-mode-map " " 'vip-scroll)
 187 (define-key vip-mode-map "!" 'vip-command-argument)
 188 (define-key vip-mode-map "\"" 'vip-command-argument)
 189 (define-key vip-mode-map "#" 'vip-command-argument)
 190 (define-key vip-mode-map "$" 'vip-goto-eol)
 191 (define-key vip-mode-map "%" 'vip-paren-match)
 192 (define-key vip-mode-map "&" 'vip-nil)
 193 (define-key vip-mode-map "'" 'vip-goto-mark-and-skip-white)
 194 (define-key vip-mode-map "(" 'vip-backward-sentence)
 195 (define-key vip-mode-map ")" 'vip-forward-sentence)
 196 (define-key vip-mode-map "*" 'call-last-kbd-macro)
 197 (define-key vip-mode-map "+" 'vip-next-line-at-bol)
 198 (define-key vip-mode-map "," 'vip-repeat-find-opposite)
 199 (define-key vip-mode-map "-" 'vip-previous-line-at-bol)
 200 (define-key vip-mode-map "." 'vip-repeat)
 201 (define-key vip-mode-map "/" 'vip-search-forward)
 202
 203 (define-key vip-mode-map "0" 'vip-beginning-of-line)
 204 (define-key vip-mode-map "1" 'vip-digit-argument)
 205 (define-key vip-mode-map "2" 'vip-digit-argument)
 206 (define-key vip-mode-map "3" 'vip-digit-argument)
 207 (define-key vip-mode-map "4" 'vip-digit-argument)
 208 (define-key vip-mode-map "5" 'vip-digit-argument)
 209 (define-key vip-mode-map "6" 'vip-digit-argument)
 210 (define-key vip-mode-map "7" 'vip-digit-argument)
 211 (define-key vip-mode-map "8" 'vip-digit-argument)
 212 (define-key vip-mode-map "9" 'vip-digit-argument)
 213
 214 (define-key vip-mode-map ":" 'vip-ex)
 215 (define-key vip-mode-map ";" 'vip-repeat-find)
 216 (define-key vip-mode-map "<" 'vip-command-argument)
 217 (define-key vip-mode-map "=" 'vip-command-argument)
 218 (define-key vip-mode-map ">" 'vip-command-argument)
 219 (define-key vip-mode-map "?" 'vip-search-backward)
 220 (define-key vip-mode-map "@" 'vip-nil)
 221
 222 (define-key vip-mode-map "A" 'vip-Append)
 223 (define-key vip-mode-map "B" 'vip-backward-Word)
 224 (define-key vip-mode-map "C" 'vip-ctl-c-equivalent)
 225 (define-key vip-mode-map "D" 'vip-kill-line)
 226 (define-key vip-mode-map "E" 'vip-end-of-Word)
 227 (define-key vip-mode-map "F" 'vip-find-char-backward)
 228 (define-key vip-mode-map "G" 'vip-goto-line)
 229 (define-key vip-mode-map "H" 'vip-window-top)
 230 (define-key vip-mode-map "I" 'vip-Insert)
 231 (define-key vip-mode-map "J" 'vip-join-lines)
 232 (define-key vip-mode-map "K" 'vip-kill-buffer)
 233 (define-key vip-mode-map "L" 'vip-window-bottom)
 234 (define-key vip-mode-map "M" 'vip-window-middle)
 235 (define-key vip-mode-map "N" 'vip-search-Next)
 236 (define-key vip-mode-map "O" 'vip-Open-line)
 237 (define-key vip-mode-map "P" 'vip-Put-back)
 238 (define-key vip-mode-map "Q" 'vip-query-replace)
 239 (define-key vip-mode-map "R" 'vip-replace-string)
 240 (define-key vip-mode-map "S" 'vip-switch-to-buffer-other-window)
 241 (define-key vip-mode-map "T" 'vip-goto-char-backward)
 242 (define-key vip-mode-map "U" 'vip-nil)
 243 (define-key vip-mode-map "V" 'vip-find-file-other-window)
 244 (define-key vip-mode-map "W" 'vip-forward-Word)
 245 (define-key vip-mode-map "X" 'vip-ctl-x-equivalent)
 246 (define-key vip-mode-map "Y" 'vip-yank-line)
 247 (define-key vip-mode-map "ZZ" 'save-buffers-kill-emacs)
 248
 249 (define-key vip-mode-map "[" 'vip-nil)
 250 (define-key vip-mode-map "\\" 'vip-escape-to-emacs)
 251 (define-key vip-mode-map "]" 'vip-nil)
 252 (define-key vip-mode-map "^" 'vip-bol-and-skip-white)
 253 (define-key vip-mode-map "_" 'vip-nil)
 254 (define-key vip-mode-map "`" 'vip-goto-mark)
 255
 256 (define-key vip-mode-map "a" 'vip-append)
 257 (define-key vip-mode-map "b" 'vip-backward-word)
 258 (define-key vip-mode-map "c" 'vip-command-argument)
 259 (define-key vip-mode-map "d" 'vip-command-argument)
 260 (define-key vip-mode-map "e" 'vip-end-of-word)
 261 (define-key vip-mode-map "f" 'vip-find-char-forward)
 262 (define-key vip-mode-map "g" 'vip-info-on-file)
 263 (define-key vip-mode-map "h" 'vip-backward-char)
 264 (define-key vip-mode-map "i" 'vip-insert)
 265 (define-key vip-mode-map "j" 'vip-next-line)
 266 (define-key vip-mode-map "k" 'vip-previous-line)
 267 (define-key vip-mode-map "l" 'vip-forward-char)
 268 (define-key vip-mode-map "m" 'vip-mark-point)
 269 (define-key vip-mode-map "n" 'vip-search-next)
 270 (define-key vip-mode-map "o" 'vip-open-line)
 271 (define-key vip-mode-map "p" 'vip-put-back)
 272 (define-key vip-mode-map "q" 'vip-nil)
 273 (define-key vip-mode-map "r" 'vip-replace-char)
 274 (define-key vip-mode-map "s" 'vip-switch-to-buffer)
 275 (define-key vip-mode-map "t" 'vip-goto-char-forward)
 276 (define-key vip-mode-map "u" 'vip-undo)
 277 (define-key vip-mode-map "v" 'vip-find-file)
 278 (define-key vip-mode-map "w" 'vip-forward-word)
 279 (define-key vip-mode-map "x" 'vip-delete-char)
 280 (define-key vip-mode-map "y" 'vip-command-argument)
 281 (define-key vip-mode-map "zH" 'vip-line-to-top)
 282 (define-key vip-mode-map "zM" 'vip-line-to-middle)
 283 (define-key vip-mode-map "zL" 'vip-line-to-bottom)
 284 (define-key vip-mode-map "z\C-m" 'vip-line-to-top)
 285 (define-key vip-mode-map "z." 'vip-line-to-middle)
 286 (define-key vip-mode-map "z-" 'vip-line-to-bottom)
 287
 288 (define-key vip-mode-map "{" 'vip-backward-paragraph)
 289 (define-key vip-mode-map "|" 'vip-goto-col)
 290 (define-key vip-mode-map "}" 'vip-forward-paragraph)
 291 (define-key vip-mode-map "~" 'vip-nil)
 292 (define-key vip-mode-map "\177" 'vip-delete-backward-char)
 293
 294 (defun vip-version ()
 295   (interactive)
 296   (message "VIP version 3.5 of September 15, 1987"))
 297
 298 \f
 299 ;; basic set up
 300
 301 ;;;###autoload
 302 (defun vip-setup ()
 303   "Set up bindings for C-x 7 and C-z that are useful for VIP users."
 304   (define-key ctl-x-map "7" 'vip-buffer-in-two-windows)
 305   (global-set-key "\C-z" 'vip-change-mode-to-vi))
 306
 307 (defmacro vip-loop (count body)
 308   "(COUNT BODY) Execute BODY COUNT times."
 309   (list 'let (list (list 'count count))
 310         (list 'while (list '> 'count 0)
 311               body
 312               (list 'setq 'count (list '1- 'count)))))
 313
 314 (defun vip-push-mark-silent (&optional location)
 315   "Set mark at LOCATION (point, by default) and push old mark on mark ring.
 316 No message."
 317   (if (null (mark t))
 318       nil
 319     (setq mark-ring (cons (copy-marker (mark-marker)) mark-ring))
 320     (if (> (length mark-ring) mark-ring-max)
 321         (progn
 322           (move-marker (car (nthcdr mark-ring-max mark-ring)) nil)
 323           (setcdr (nthcdr (1- mark-ring-max) mark-ring) nil))))
 324   (set-mark (or location (point))))
 325
 326 (defun vip-goto-col (arg)
 327   "Go to ARG's column."
 328   (interactive "P")
 329   (let ((val (vip-p-val arg))
 330         (com (vip-getcom arg)))
 331     (save-excursion
 332       (end-of-line)
 333       (if (> val (1+ (current-column))) (error "")))
 334     (if com (move-marker vip-com-point (point)))
 335     (beginning-of-line)
 336     (forward-char (1- val))
 337     (if com (vip-execute-com 'vip-goto-col val com))))
 338
 339 (defun vip-copy-keymap (map)
 340   (if (null map) (make-sparse-keymap) (copy-keymap map)))
 341
 342 \f
 343 ;; changing mode
 344
 345 (defun vip-change-mode (new-mode)
 346   "Change mode to NEW-MODE---either emacs-mode, vi-mode, or insert-mode."
 347   (or (eq new-mode vip-current-mode)
 348       (progn
 349         (cond ((eq new-mode 'vi-mode)
 350                (if (eq vip-current-mode 'insert-mode)
 351                    (progn
 352                      (vip-copy-region-as-kill (point) vip-insert-point)
 353                      (vip-repeat-insert-command))
 354                  (setq vip-emacs-local-map (current-local-map)
 355                        vip-emacs-mode-line-buffer-identification
 356                        mode-line-buffer-identification
 357                        vip-insert-local-map (vip-copy-keymap
 358                                              (current-local-map))))
 359                (vip-change-mode-line "Vi:   ")
 360                (use-local-map vip-mode-map))
 361               ((eq new-mode 'insert-mode)
 362                (move-marker vip-insert-point (point))
 363                (if (eq vip-current-mode 'emacs-mode)
 364                    (setq vip-emacs-local-map (current-local-map)
 365                          vip-emacs-mode-line-buffer-identification
 366                          mode-line-buffer-identification
 367                          vip-insert-local-map (vip-copy-keymap
 368                                                (current-local-map)))
 369                  (setq vip-insert-local-map (vip-copy-keymap
 370                                              vip-emacs-local-map)))
 371                (vip-change-mode-line "Insert")
 372                (use-local-map vip-insert-local-map)
 373                (define-key vip-insert-local-map "\e" 'vip-change-mode-to-vi)
 374                (define-key vip-insert-local-map "\C-z" 'vip-ESC)
 375                (define-key vip-insert-local-map "\C-h"
 376                  (if vip-help-in-insert-mode 'help-command
 377                    'delete-backward-char))
 378                (define-key vip-insert-local-map "\C-w"
 379                  'vip-delete-backward-word))
 380               ((eq new-mode 'emacs-mode)
 381                (vip-change-mode-line "Emacs:")
 382                (use-local-map vip-emacs-local-map)))
 383         (setq vip-current-mode new-mode)
 384         (force-mode-line-update))))
 385
 386 (defun vip-copy-region-as-kill (beg end)
 387   "If BEG and END do not belong to the same buffer, it copies empty region."
 388   (condition-case nil
 389       (copy-region-as-kill beg end)
 390     (error (copy-region-as-kill beg beg))))
 391
 392 (defun vip-change-mode-line (string)
 393   "Assuming that the mode line format contains the string \"Emacs:\", this
 394 function replaces the string by \"Vi:   \" etc."
 395   (setq mode-line-buffer-identification
 396         (if (string= string "Emacs:")
 397             vip-emacs-mode-line-buffer-identification
 398           (list (concat string " %17b")))))
 399
 400 ;;;###autoload
 401 (defun vip-mode ()
 402   "Turn on VIP emulation of VI."
 403   (interactive)
 404   (if (not vip-inhibit-startup-message)
 405       (progn
 406         (switch-to-buffer "VIP Startup Message")
 407         (erase-buffer)
 408         (insert
 409          "VIP is a Vi emulation package for GNU Emacs.  VIP provides most Vi commands
 410 including Ex commands.  VIP is however different from Vi in several points.
 411 You can get more information on VIP by:
 412     1.  Typing `M-x info' and selecting menu item \"vip\".
 413     2.  Typing `C-h k' followed by a key whose description you want.
 414     3.  Printing VIP manual which can be found as GNU/man/vip.texinfo
 415     4.  Printing VIP Reference Card which can be found as GNU/etc/vipcard.tex
 416
 417 This startup message appears whenever you load VIP unless you type `y' now.
 418 Type `n' to quit this window for now.\n")
 419         (goto-char (point-min))
 420         (if (y-or-n-p "Inhibit VIP startup message? ")
 421             (progn
 422               (with-current-buffer
 423                   (find-file-noselect
 424                    (substitute-in-file-name vip-startup-file))
 425                 (goto-char (point-max))
 426                 (insert "\n(setq vip-inhibit-startup-message t)\n")
 427                 (save-buffer)
 428                 (kill-buffer (current-buffer)))
 429               (message "VIP startup message inhibited.")
 430               (sit-for 2)))
 431         (kill-buffer (current-buffer))
 432         (message "")
 433         (setq vip-inhibit-startup-message t)))
 434   (vip-change-mode-to-vi))
 435
 436 (defun vip-change-mode-to-vi ()
 437   "Change mode to vi mode."
 438   (interactive)
 439   (vip-change-mode 'vi-mode))
 440
 441 (defun vip-change-mode-to-insert ()
 442   "Change mode to insert mode."
 443   (interactive)
 444   (vip-change-mode 'insert-mode))
 445
 446 (defun vip-change-mode-to-emacs ()
 447   "Change mode to Emacs mode."
 448   (interactive)
 449   (vip-change-mode 'emacs-mode))
 450
 451 \f
 452 ;; escape to emacs mode temporarily
 453
 454 (defun vip-escape-to-emacs (arg &optional events)
 455   "Escape to Emacs mode for one Emacs command.
 456 ARG is used as the prefix value for the executed command.  If
 457 EVENTS is a list of events, which become the beginning of the command."
 458   (interactive "P")
 459   (let (com key (old-map (current-local-map)))
 460     (if events (setq unread-command-events events))
 461     (setq prefix-arg arg)
 462     (use-local-map vip-emacs-local-map)
 463     (unwind-protect
 464         (setq com (key-binding (setq key (read-key-sequence nil))))
 465       (use-local-map old-map))
 466     (command-execute com prefix-arg)
 467     (setq prefix-arg nil)  ;; reset prefix arg
 468     ))
 469
 470 (defun vip-message-conditions (conditions)
 471   "Print CONDITIONS as a message."
 472   (let ((case (car conditions)) (msg (cdr conditions)))
 473     (if (null msg)
 474         (message "%s" case)
 475       (message "%s %s" case (prin1-to-string msg)))
 476     (ding)))
 477
 478 (defun vip-ESC (arg)
 479   "Emulate ESC key in Emacs mode."
 480   (interactive "P")
 481   (vip-escape-to-emacs arg '(?\e)))
 482
 483 (defun vip-ctl-c (arg)
 484   "Emulate C-c key in Emacs mode."
 485   (interactive "P")
 486   (vip-escape-to-emacs arg '(?\C-c)))
 487
 488 (defun vip-ctl-x (arg)
 489   "Emulate C-x key in Emacs mode."
 490   (interactive "P")
 491   (vip-escape-to-emacs arg '(?\C-x)))
 492
 493 (defun vip-ctl-h (arg)
 494   "Emulate C-h key in Emacs mode."
 495   (interactive "P")
 496   (vip-escape-to-emacs arg '(?\C-h)))
 497
 498 \f
 499 ;; prefix argument for vi mode
 500
 501 ;; In vi mode, prefix argument is a dotted pair (NUM . COM) where NUM
 502 ;; represents the numeric value of the prefix argument and COM represents
 503 ;; command prefix such as "c", "d", "m" and "y".
 504
 505 (defun vip-prefix-arg-value (char value com)
 506   "Compute numeric prefix arg value.  Invoked by CHAR.  VALUE is the value
 507 obtained so far, and COM is the command part obtained so far."
 508   (while (and (>= char ?0) (<= char ?9))
 509     (setq value (+ (* (if (numberp value) value 0) 10) (- char ?0)))
 510     (setq char (read-char)))
 511   (setq prefix-arg value)
 512   (if com (setq prefix-arg (cons prefix-arg com)))
 513   (while (= char ?U)
 514     (vip-describe-arg prefix-arg)
 515     (setq char (read-char)))
 516   (setq unread-command-events (list char)))
 517
 518 (defun vip-prefix-arg-com (char value com)
 519   "Vi operator as prefix argument."
 520   (let ((cont t))
 521     (while (and cont
 522                 (or (= char ?c) (= char ?d) (= char ?y)
 523                     (= char ?!) (= char ?<) (= char ?>) (= char ?=)
 524                     (= char ?#) (= char ?r) (= char ?R) (= char ?\")))
 525       (if com
 526           ;; this means that we already have a command character, so we
 527           ;; construct a com list and exit while.  however, if char is "
 528           ;; it is an error.
 529           (progn
 530             ;; new com is (CHAR . OLDCOM)
 531             (if (or (= char ?#) (= char ?\")) (error ""))
 532             (setq com (cons char com))
 533             (setq cont nil))
 534         ;; if com is nil we set com as char, and read more.  again, if char
 535         ;; is ", we read the name of register and store it in vip-use-register.
 536         ;; if char is !, =, or #, a complete com is formed so we exit while.
 537         (cond ((or (= char ?!) (= char ?=))
 538                (setq com char)
 539                (setq char (read-char))
 540                (setq cont nil))
 541               ((= char ?#)
 542                ;; read a char and encode it as com
 543                (setq com (+ 128 (read-char)))
 544                (setq char (read-char))
 545                (setq cont nil))
 546               ((or (= char ?<) (= char ?>))
 547                (setq com char)
 548                (setq char (read-char))
 549                (if (= com char) (setq com (cons char com)))
 550                (setq cont nil))
 551               ((= char ?\")
 552                (let ((reg (read-char)))
 553                  (if (or (and (<= ?A reg) (<= reg ?z))
 554                          (and (<= ?1 reg) (<= reg ?9)))
 555                      (setq vip-use-register reg)
 556                    (error ""))
 557                  (setq char (read-char))))
 558               (t
 559                (setq com char)
 560                (setq char (read-char)))))))
 561   (if (atom com)
 562       ;; com is a single char, so we construct prefix-arg
 563       ;; and if char is ?, describe prefix arg, otherwise exit by
 564       ;; pushing the char back
 565       (progn
 566         (setq prefix-arg (cons value com))
 567         (while (= char ?U)
 568           (vip-describe-arg prefix-arg)
 569           (setq char (read-char)))
 570         (setq unread-command-events (list char)))
 571     ;; as com is non-nil, this means that we have a command to execute
 572     (if (or (= (car com) ?r) (= (car com) ?R))
 573         ;; execute appropriate region command.
 574         (let ((char (car com)) (com (cdr com)))
 575           (setq prefix-arg (cons value com))
 576           (if (= char ?r) (vip-region prefix-arg)
 577             (vip-Region prefix-arg))
 578           ;; reset prefix-arg
 579           (setq prefix-arg nil))
 580       ;; otherwise, reset prefix arg and call appropriate command
 581       (setq value (if (null value) 1 value))
 582       (setq prefix-arg nil)
 583       (cond ((equal com '(?c . ?c)) (vip-line (cons value ?C)))
 584             ((equal com '(?d . ?d)) (vip-line (cons value ?D)))
 585             ((equal com '(?d . ?y)) (vip-yank-defun))
 586             ((equal com '(?y . ?y)) (vip-line (cons value ?Y)))
 587             ((equal com '(?< . ?<)) (vip-line (cons value ?<)))
 588             ((equal com '(?> . ?>)) (vip-line (cons value ?>)))
 589             ((equal com '(?! . ?!)) (vip-line (cons value ?!)))
 590             ((equal com '(?= . ?=)) (vip-line (cons value ?=)))
 591             (t (error ""))))))
 592
 593 (defun vip-describe-arg (arg)
 594   (let (val com)
 595     (setq val (vip-P-val arg)
 596           com (vip-getcom arg))
 597     (if (null val)
 598         (if (null com)
 599             (message "Value is nil, and command is nil.")
 600           (message "Value is nil, and command is %c." com))
 601       (if (null com)
 602           (message "Value is %d, and command is nil." val)
 603         (message "Value is %d, and command is %c." val com)))))
 604
 605 (defun vip-digit-argument (arg)
 606   "Begin numeric argument for the next command."
 607   (interactive "P")
 608   (vip-prefix-arg-value last-command-event nil
 609                         (if (consp arg) (cdr arg) nil)))
 610
 611 (defun vip-command-argument (arg)
 612   "Accept a motion command as an argument."
 613   (interactive "P")
 614   (condition-case conditions
 615       (vip-prefix-arg-com
 616        last-command-event
 617        (cond ((null arg) nil)
 618              ((consp arg) (car arg))
 619              ((numberp arg) arg)
 620              (t (error "strange arg")))
 621        (cond ((null arg) nil)
 622              ((consp arg) (cdr arg))
 623              ((numberp arg) nil)
 624              (t (error "strange arg"))))
 625     (quit
 626      (setq vip-use-register nil)
 627      (signal 'quit nil))))
 628
 629 (defun vip-p-val (arg)
 630   "Get value part of prefix-argument ARG."
 631   (cond ((null arg) 1)
 632         ((consp arg) (if (null (car arg)) 1 (car arg)))
 633         (t arg)))
 634
 635 (defun vip-P-val (arg)
 636   "Get value part of prefix-argument ARG."
 637   (cond ((consp arg) (car arg))
 638         (t arg)))
 639
 640 (defun vip-getcom (arg)
 641   "Get com part of prefix-argument ARG."
 642   (cond ((null arg) nil)
 643         ((consp arg) (cdr arg))
 644         (t nil)))
 645
 646 (defun vip-getCom (arg)
 647   "Get com part of prefix-argument ARG and modify it."
 648   (let ((com (vip-getcom arg)))
 649     (cond ((equal com ?c) ?C)
 650           ((equal com ?d) ?D)
 651           ((equal com ?y) ?Y)
 652           (t com))))
 653
 654 \f
 655 ;; repeat last destructive command
 656
 657 (defun vip-append-to-register (reg start end)
 658   "Append region to text in register REG.
 659 START and END are buffer positions indicating what to append."
 660   (set-register reg (concat (or (get-register reg) "")
 661                             (buffer-substring start end))))
 662
 663 (defun vip-execute-com (m-com val com)
 664   "(M-COM VAL COM)  Execute command COM. The list (M-COM VAL COM) is set
 665 to vip-d-com for later use by vip-repeat"
 666   (let ((reg vip-use-register))
 667     (if com
 668         (cond ((= com ?c) (vip-change vip-com-point (point)))
 669               ((= com (- ?c)) (vip-change-subr vip-com-point (point)))
 670               ((or (= com ?C) (= com (- ?C)))
 671                (save-excursion
 672                  (set-mark vip-com-point)
 673                  (vip-enlarge-region (mark) (point))
 674                  (if vip-use-register
 675                      (progn
 676                        (cond ((and (<= ?a vip-use-register)
 677                                    (<= vip-use-register ?z))
 678                               (copy-to-register
 679                                vip-use-register (mark) (point) nil))
 680                              ((and (<= ?A vip-use-register)
 681                                    (<= vip-use-register ?Z))
 682                               (vip-append-to-register
 683                                (+ vip-use-register 32) (mark) (point)))
 684                              (t (setq vip-use-register nil)
 685                                 (error "")))
 686                        (setq vip-use-register nil)))
 687                  (delete-region (mark) (point)))
 688                (open-line 1)
 689                (if (= com ?C) (vip-change-mode-to-insert) (yank)))
 690               ((= com ?d)
 691                (if vip-use-register
 692                    (progn
 693                      (cond ((and (<= ?a vip-use-register)
 694                                  (<= vip-use-register ?z))
 695                             (copy-to-register
 696                              vip-use-register vip-com-point (point) nil))
 697                            ((and (<= ?A vip-use-register)
 698                                  (<= vip-use-register ?Z))
 699                             (vip-append-to-register
 700                              (+ vip-use-register 32) vip-com-point (point)))
 701                            (t (setq vip-use-register nil)
 702                               (error "")))
 703                      (setq vip-use-register nil)))
 704                (setq last-command
 705                      (if (eq last-command 'd-command) 'kill-region nil))
 706                (kill-region vip-com-point (point))
 707                (setq this-command 'd-command))
 708               ((= com ?D)
 709                (save-excursion
 710                  (set-mark vip-com-point)
 711                  (vip-enlarge-region (mark) (point))
 712                  (if vip-use-register
 713                      (progn
 714                        (cond ((and (<= ?a vip-use-register)
 715                                    (<= vip-use-register ?z))
 716                               (copy-to-register
 717                                vip-use-register (mark) (point) nil))
 718                              ((and (<= ?A vip-use-register)
 719                                    (<= vip-use-register ?Z))
 720                               (vip-append-to-register
 721                                (+ vip-use-register 32) (mark) (point)))
 722                              (t (setq vip-use-register nil)
 723                                 (error "")))
 724                        (setq vip-use-register nil)))
 725                  (setq last-command
 726                        (if (eq last-command 'D-command) 'kill-region nil))
 727                  (kill-region (mark) (point))
 728                  (if (eq m-com 'vip-line) (setq this-command 'D-command)))
 729                (back-to-indentation))
 730               ((= com ?y)
 731                (if vip-use-register
 732                    (progn
 733                      (cond ((and (<= ?a vip-use-register)
 734                                  (<= vip-use-register ?z))
 735                             (copy-to-register
 736                              vip-use-register vip-com-point (point) nil))
 737                            ((and (<= ?A vip-use-register)
 738                                  (<= vip-use-register ?Z))
 739                             (vip-append-to-register
 740                              (+ vip-use-register 32) vip-com-point (point)))
 741                            (t (setq vip-use-register nil)
 742                               (error "")))
 743                      (setq vip-use-register nil)))
 744                (setq last-command nil)
 745                (copy-region-as-kill vip-com-point (point))
 746                (goto-char vip-com-point))
 747               ((= com ?Y)
 748                (save-excursion
 749                  (set-mark vip-com-point)
 750                  (vip-enlarge-region (mark) (point))
 751                  (if vip-use-register
 752                      (progn
 753                        (cond ((and (<= ?a vip-use-register)
 754                                    (<= vip-use-register ?z))
 755                               (copy-to-register
 756                                vip-use-register (mark) (point) nil))
 757                              ((and (<= ?A vip-use-register)
 758                                    (<= vip-use-register ?Z))
 759                               (vip-append-to-register
 760                                (+ vip-use-register 32) (mark) (point)))
 761                              (t (setq vip-use-register nil)
 762                                 (error "")))
 763                        (setq vip-use-register nil)))
 764                  (setq last-command nil)
 765                  (copy-region-as-kill (mark) (point)))
 766                (goto-char vip-com-point))
 767               ((or (= com ?!) (= com (- ?!)))
 768                (save-excursion
 769                  (set-mark vip-com-point)
 770                  (vip-enlarge-region (mark) (point))
 771                  (shell-command-on-region
 772                   (mark) (point)
 773                   (if (= com ?!)
 774                       (setq vip-last-shell-com (vip-read-string "!"))
 775                     vip-last-shell-com)
 776                   t)))
 777               ((= com ?=)
 778                (save-excursion
 779                  (set-mark vip-com-point)
 780                  (vip-enlarge-region (mark) (point))
 781                  (if (> (mark) (point)) (exchange-point-and-mark))
 782                  (indent-region (mark) (point) nil)))
 783               ((= com ?<)
 784                (save-excursion
 785                  (set-mark vip-com-point)
 786                  (vip-enlarge-region (mark) (point))
 787                  (indent-rigidly (mark) (point) (- vip-shift-width)))
 788                (goto-char vip-com-point))
 789               ((= com ?>)
 790                (save-excursion
 791                  (set-mark vip-com-point)
 792                  (vip-enlarge-region (mark) (point))
 793                  (indent-rigidly (mark) (point) vip-shift-width))
 794                (goto-char vip-com-point))
 795               ((>= com 128)
 796                ;; this is special command #
 797                (vip-special-prefix-com (- com 128)))))
 798     (setq vip-d-com (list m-com val (if (or (= com ?c) (= com ?C) (= com ?!))
 799                                         (- com) com)
 800                           reg))))
 801
 802 (defun vip-repeat (arg)
 803   "(ARG)  Re-execute last destructive command.  vip-d-com has the form
 804 \(COM ARG CH REG), where COM is the command to be re-executed, ARG is the
 805 argument for COM, CH is a flag for repeat, and REG is optional and if exists
 806 is the name of the register for COM."
 807   (interactive "P")
 808   (if (eq last-command 'vip-undo)
 809       ;; if the last command was vip-undo, then undo-more
 810       (vip-undo-more)
 811     ;; otherwise execute the command stored in vip-d-com.  if arg is non-nil
 812     ;; its prefix value is used as new prefix value for the command.
 813     (let ((m-com (car vip-d-com))
 814           (val (vip-P-val arg))
 815           (com (car (cdr (cdr vip-d-com))))
 816           (reg (nth 3 vip-d-com)))
 817       (if (null val) (setq val (car (cdr vip-d-com))))
 818       (if (null m-com) (error "No previous command to repeat"))
 819       (setq vip-use-register reg)
 820       (funcall m-com (cons val com)))))
 821
 822 (defun vip-special-prefix-com (char)
 823   "This command is invoked interactively by the key sequence #<char>"
 824   (cond ((= char ?c)
 825          (downcase-region (min vip-com-point (point))
 826                           (max vip-com-point (point))))
 827         ((= char ?C)
 828          (upcase-region (min vip-com-point (point))
 829                         (max vip-com-point (point))))
 830         ((= char ?g)
 831          (set-mark vip-com-point)
 832          (vip-global-execute))
 833         ((= char ?q)
 834          (set-mark vip-com-point)
 835          (vip-quote-region))
 836         ((= char ?s) (ispell-region vip-com-point (point)))))
 837
 838 \f
 839 ;; undoing
 840
 841 (defun vip-undo ()
 842   "Undo previous change."
 843   (interactive)
 844   (message "undo!")
 845   (undo-start)
 846   (undo-more 2)
 847   (setq this-command 'vip-undo))
 848
 849 (defun vip-undo-more ()
 850   "Continue undoing previous changes."
 851   (message "undo more!")
 852   (undo-more 1)
 853   (setq this-command 'vip-undo))
 854
 855 \f
 856 ;; utilities
 857
 858 (defun vip-string-tail (str)
 859   (if (or (null str) (string= str "")) nil
 860     (substring str 1)))
 861
 862 (defun vip-yank-defun ()
 863   (mark-defun)
 864   (copy-region-as-kill (point) (mark)))
 865
 866 (defun vip-enlarge-region (beg end)
 867   "Enlarge region between BEG and END."
 868   (if (< beg end)
 869       (progn (goto-char beg) (set-mark end))
 870     (goto-char end)
 871     (set-mark beg))
 872   (beginning-of-line)
 873   (exchange-point-and-mark)
 874   (if (or (not (eobp)) (not (bolp))) (with-no-warnings (next-line 1)))
 875   (beginning-of-line)
 876   (if (> beg end) (exchange-point-and-mark)))
 877
 878 (defun vip-global-execute ()
 879   "Call last keyboad macro for each line in the region."
 880   (if (> (point) (mark)) (exchange-point-and-mark))
 881   (beginning-of-line)
 882   (call-last-kbd-macro)
 883   (while (< (point) (mark))
 884     (forward-line 1)
 885     (beginning-of-line)
 886     (call-last-kbd-macro)))
 887
 888 (defun vip-quote-region ()
 889   "Quote region by inserting the user supplied string at the beginning of
 890 each line in the region."
 891   (setq vip-quote-string
 892         (let ((str
 893                (vip-read-string (format "quote string (default %s): "
 894                                         vip-quote-string))))
 895           (if (string= str "") vip-quote-string str)))
 896   (vip-enlarge-region (point) (mark))
 897   (if (> (point) (mark)) (exchange-point-and-mark))
 898   (insert vip-quote-string)
 899   (beginning-of-line)
 900   (forward-line 1)
 901   (while (and (< (point) (mark)) (bolp))
 902     (insert vip-quote-string)
 903     (beginning-of-line)
 904     (forward-line 1)))
 905
 906 (defun vip-end-with-a-newline-p (string)
 907   "Check if the string ends with a newline."
 908   (or (string= string "")
 909       (= (aref string (1- (length string))) ?\n)))
 910
 911 (defvar vip-save-minibuffer-local-map)
 912
 913 (defun vip-read-string (prompt &optional init)
 914   (setq vip-save-minibuffer-local-map (copy-keymap minibuffer-local-map))
 915   (define-key minibuffer-local-map "\C-h" 'backward-char)
 916   (define-key minibuffer-local-map "\C-w" 'backward-word)
 917   (define-key minibuffer-local-map "\e" 'exit-minibuffer)
 918   (let (str)
 919     (condition-case conditions
 920         (setq str (read-string prompt init))
 921       (quit
 922        (setq minibuffer-local-map vip-save-minibuffer-local-map)
 923        (signal 'quit nil)))
 924     (setq minibuffer-local-map vip-save-minibuffer-local-map)
 925     str))
 926
 927 \f
 928 ;; insertion commands
 929
 930 (defun vip-repeat-insert-command ()
 931   "This function is called when mode changes from insertion mode to
 932 vi command mode.  It will repeat the insertion command if original insertion
 933 command was invoked with argument > 1."
 934   (let ((i-com (car vip-d-com)) (val (car (cdr vip-d-com))))
 935     (if (and val (> val 1)) ;; first check that val is non-nil
 936         (progn
 937           (setq vip-d-com (list i-com (1- val) ?r))
 938           (vip-repeat nil)
 939           (setq vip-d-com (list i-com val ?r))))))
 940
 941 (defun vip-insert (arg) ""
 942   (interactive "P")
 943   (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
 944     (setq vip-d-com (list 'vip-insert val ?r))
 945     (if com (vip-loop val (yank))
 946       (vip-change-mode-to-insert))))
 947
 948 (defun vip-append (arg)
 949   "Append after point."
 950   (interactive "P")
 951   (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
 952     (setq vip-d-com (list 'vip-append val ?r))
 953     (if (not (eolp)) (forward-char))
 954     (if (equal com ?r)
 955         (vip-loop val (yank))
 956       (vip-change-mode-to-insert))))
 957
 958 (defun vip-Append (arg)
 959   "Append at end of line."
 960   (interactive "P")
 961   (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
 962     (setq vip-d-com (list 'vip-Append val ?r))
 963     (end-of-line)
 964     (if (equal com ?r)
 965         (vip-loop val (yank))
 966       (vip-change-mode-to-insert))))
 967
 968 (defun vip-Insert (arg)
 969   "Insert before first non-white."
 970   (interactive "P")
 971   (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
 972     (setq vip-d-com (list 'vip-Insert val ?r))
 973     (back-to-indentation)
 974     (if (equal com ?r)
 975         (vip-loop val (yank))
 976       (vip-change-mode-to-insert))))
 977
 978 (defun vip-open-line (arg)
 979   "Open line below."
 980   (interactive "P")
 981   (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
 982     (setq vip-d-com (list 'vip-open-line val ?r))
 983     (let ((col (current-indentation)))
 984       (if (equal com ?r)
 985           (vip-loop val
 986                 (progn
 987                   (end-of-line)
 988                   (newline 1)
 989                   (if vip-open-with-indent (indent-to col))
 990                   (yank)))
 991         (end-of-line)
 992         (newline 1)
 993         (if vip-open-with-indent (indent-to col))
 994         (vip-change-mode-to-insert)))))
 995
 996 (defun vip-Open-line (arg)
 997   "Open line above."
 998   (interactive "P")
 999   (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
1000   (setq vip-d-com (list 'vip-Open-line val ?r))
1001   (let ((col (current-indentation)))
1002     (if (equal com ?r)
1003         (vip-loop val
1004               (progn
1005                 (beginning-of-line)
1006                 (open-line 1)
1007                 (if vip-open-with-indent (indent-to col))
1008                 (yank)))
1009       (beginning-of-line)
1010       (open-line 1)
1011       (if vip-open-with-indent (indent-to col))
1012       (vip-change-mode-to-insert)))))
1013
1014 (defun vip-open-line-at-point (arg)
1015   "Open line at point."
1016   (interactive "P")
1017   (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
1018     (setq vip-d-com (list 'vip-open-line-at-point val ?r))
1019     (if (equal com ?r)
1020         (vip-loop val
1021               (progn
1022                 (open-line 1)
1023                 (yank)))
1024       (open-line 1)
1025       (vip-change-mode-to-insert))))
1026
1027 (defun vip-substitute (arg)
1028   "Substitute characters."
1029   (interactive "P")
1030   (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
1031     (save-excursion
1032       (set-mark (point))
1033       (forward-char val)
1034       (if (equal com ?r)
1035           (vip-change-subr (mark) (point))
1036         (vip-change (mark) (point))))
1037     (setq vip-d-com (list 'vip-substitute val ?r))))
1038
1039 (defun vip-substitute-line (arg)
1040   "Substitute lines."
1041   (interactive "p")
1042   (vip-line (cons arg ?C)))
1043
1044 \f
1045 ;; line command
1046
1047 (defun vip-line (arg)
1048   (let ((val (car arg)) (com (cdr arg)))
1049     (move-marker vip-com-point (point))
1050     (with-no-warnings (next-line (1- val)))
1051     (vip-execute-com 'vip-line val com)))
1052
1053 (defun vip-yank-line (arg)
1054   "Yank ARG lines (in vi's sense)"
1055   (interactive "P")
1056   (let ((val (vip-p-val arg)))
1057     (vip-line (cons val ?Y))))
1058
1059 \f
1060 ;; region command
1061
1062 (defun vip-region (arg)
1063   (interactive "P")
1064   (let ((val (vip-P-val arg))
1065         (com (vip-getcom arg)))
1066     (move-marker vip-com-point (point))
1067     (exchange-point-and-mark)
1068     (vip-execute-com 'vip-region val com)))
1069
1070 (defun vip-Region (arg)
1071   (interactive "P")
1072   (let ((val (vip-P-val arg))
1073         (com (vip-getCom arg)))
1074     (move-marker vip-com-point (point))
1075     (exchange-point-and-mark)
1076     (vip-execute-com 'vip-Region val com)))
1077
1078 (defun vip-replace-char (arg)
1079   "Replace the following ARG chars by the character read."
1080   (interactive "P")
1081   (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
1082     (setq vip-d-com (list 'vip-replace-char val ?r))
1083     (vip-replace-char-subr (if (equal com ?r) vip-d-char (read-char)) val)))
1084
1085 (defun vip-replace-char-subr (char arg)
1086   (delete-char arg t)
1087   (setq vip-d-char char)
1088   (vip-loop (if (> arg 0) arg (- arg)) (insert char))
1089   (backward-char arg))
1090
1091 (defun vip-replace-string ()
1092   "Replace string.  If you supply null string as the string to be replaced,
1093 the query replace mode will toggle between string replace and regexp replace."
1094   (interactive)
1095   (let (str)
1096     (setq str (vip-read-string
1097                (if vip-re-replace "Replace regexp: " "Replace string: ")))
1098     (if (string= str "")
1099         (progn
1100           (setq vip-re-replace (not vip-re-replace))
1101           (message "Replace mode changed to %s."
1102                    (if vip-re-replace "regexp replace"
1103                      "string replace")))
1104       (if vip-re-replace
1105           ;; (replace-regexp
1106           ;;  str
1107           ;;  (vip-read-string (format "Replace regexp \"%s\" with: " str)))
1108           (while (re-search-forward str nil t)
1109             (replace-match (vip-read-string
1110                             (format "Replace regexp \"%s\" with: " str))
1111                            nil nil))
1112         (with-no-warnings
1113           (replace-string
1114            str
1115            (vip-read-string (format "Replace \"%s\" with: " str))))))))
1116
1117 \f
1118 ;; basic cursor movement.  j, k, l, m commands.
1119
1120 (defun vip-forward-char (arg)
1121   "Move point right ARG characters (left if ARG negative).On reaching end
1122 of buffer, stop and signal error."
1123   (interactive "P")
1124   (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
1125     (if com (move-marker vip-com-point (point)))
1126     (forward-char val)
1127     (if com (vip-execute-com 'vip-forward-char val com))))
1128
1129 (defun vip-backward-char (arg)
1130   "Move point left ARG characters (right if ARG negative).  On reaching
1131 beginning of buffer, stop and signal error."
1132   (interactive "P")
1133   (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
1134     (if com (move-marker vip-com-point (point)))
1135     (backward-char val)
1136     (if com (vip-execute-com 'vip-backward-char val com))))
1137
1138 \f
1139 ;; word command
1140
1141 (defun vip-forward-word (arg)
1142   "Forward word."
1143   (interactive "P")
1144   (let ((val (vip-p-val arg))
1145         (com (vip-getcom arg)))
1146     (if com (move-marker vip-com-point (point)))
1147     (forward-word val)
1148     (skip-chars-forward " \t\n")
1149     (if com
1150         (progn
1151           (if (or (= com ?c) (= com (- ?c)))
1152               (progn (backward-word 1) (forward-word 1)))
1153           (if (or (= com ?d) (= com ?y))
1154               (progn
1155                 (backward-word 1)
1156                 (forward-word 1)
1157                 (skip-chars-forward " \t")))
1158           (vip-execute-com 'vip-forward-word val com)))))
1159
1160 (defun vip-end-of-word (arg)
1161   "Move point to end of current word."
1162   (interactive "P")
1163   (let ((val (vip-p-val arg))
1164         (com (vip-getcom arg)))
1165     (if com (move-marker vip-com-point (point)))
1166     (forward-char)
1167     (forward-word val)
1168     (backward-char)
1169     (if com
1170         (progn
1171           (forward-char)
1172           (vip-execute-com 'vip-end-of-word val com)))))
1173
1174 (defun vip-backward-word (arg)
1175   "Backward word."
1176   (interactive "P")
1177   (let ((val (vip-p-val arg))
1178         (com (vip-getcom arg)))
1179     (if com (move-marker vip-com-point (point)))
1180     (backward-word val)
1181     (if com (vip-execute-com 'vip-backward-word val com))))
1182
1183 (defun vip-forward-Word (arg)
1184   "Forward word delimited by white character."
1185   (interactive "P")
1186   (let ((val (vip-p-val arg))
1187         (com (vip-getcom arg)))
1188     (if com (move-marker vip-com-point (point)))
1189     (re-search-forward "[^ \t\n]*[ \t\n]+" nil t val)
1190     (if com
1191         (progn
1192           (if (or (= com ?c) (= com (- ?c)))
1193               (progn (backward-word 1) (forward-word 1)))
1194           (if (or (= com ?d) (= com ?y))
1195               (progn
1196                 (backward-word 1)
1197                 (forward-word 1)
1198                 (skip-chars-forward " \t")))
1199           (vip-execute-com 'vip-forward-Word val com)))))
1200
1201 (defun vip-end-of-Word (arg)
1202   "Move forward to end of word delimited by white character."
1203   (interactive "P")
1204   (let ((val (vip-p-val arg))
1205         (com (vip-getcom arg)))
1206     (if com (move-marker vip-com-point (point)))
1207     (forward-char)
1208     (if (re-search-forward "[^ \t\n]+" nil t val) (backward-char))
1209     (if com
1210         (progn
1211           (forward-char)
1212           (vip-execute-com 'vip-end-of-Word val com)))))
1213
1214 (defun vip-backward-Word (arg)
1215   "Backward word delimited by white character."
1216   (interactive "P")
1217   (let ((val (vip-p-val arg))
1218         (com (vip-getcom arg)))
1219     (if com (move-marker vip-com-point (point)))
1220     (if (re-search-backward "[ \t\n]+[^ \t\n]+" nil t val)
1221         (forward-char)
1222       (goto-char (point-min)))
1223     (if com (vip-execute-com 'vip-backward-Word val com))))
1224
1225 (defun vip-beginning-of-line (arg)
1226   "Go to beginning of line."
1227   (interactive "P")
1228   (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
1229     (if com (move-marker vip-com-point (point)))
1230     (beginning-of-line val)
1231     (if com (vip-execute-com 'vip-beginning-of-line val com))))
1232
1233 (defun vip-bol-and-skip-white (arg)
1234   "Beginning of line at first non-white character."
1235   (interactive "P")
1236   (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
1237     (if com (move-marker vip-com-point (point)))
1238     (back-to-indentation)
1239     (if com (vip-execute-com 'vip-bol-and-skip-white val com))))
1240
1241 (defun vip-goto-eol (arg)
1242   "Go to end of line."
1243   (interactive "P")
1244   (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
1245     (if com (move-marker vip-com-point (point)))
1246     (end-of-line val)
1247     (if com (vip-execute-com 'vip-goto-eol val com))))
1248
1249 (defun vip-next-line (arg)
1250   "Go to next line."
1251   (interactive "P")
1252   (let ((val (vip-p-val arg)) (com (vip-getCom arg)))
1253     (if com (move-marker vip-com-point (point)))
1254     (line-move val)
1255     (setq this-command 'next-line)
1256     (if com (vip-execute-com 'vip-next-line val com))))
1257
1258 (defun vip-next-line-at-bol (arg)
1259   "Next line at beginning of line."
1260   (interactive "P")
1261   (let ((val (vip-p-val arg)) (com (vip-getCom arg)))
1262     (if com (move-marker vip-com-point (point)))
1263     (with-no-warnings (next-line val))
1264     (back-to-indentation)
1265     (if com (vip-execute-com 'vip-next-line-at-bol val com))))
1266
1267 (defun vip-previous-line (arg)
1268   "Go to previous line."
1269   (interactive "P")
1270   (let ((val (vip-p-val arg)) (com (vip-getCom arg)))
1271     (if com (move-marker vip-com-point (point)))
1272     (with-no-warnings (next-line (- val)))
1273     (setq this-command 'previous-line)
1274     (if com (vip-execute-com 'vip-previous-line val com))))
1275
1276 (defun vip-previous-line-at-bol (arg)
1277   "Previous line at beginning of line."
1278   (interactive "P")
1279   (let ((val (vip-p-val arg)) (com (vip-getCom arg)))
1280     (if com (move-marker vip-com-point (point)))
1281     (with-no-warnings (next-line (- val)))
1282     (back-to-indentation)
1283     (if com (vip-execute-com 'vip-previous-line val com))))
1284
1285 (defun vip-change-to-eol (arg)
1286   "Change to end of line."
1287   (interactive "P")
1288   (vip-goto-eol (cons arg ?c)))
1289
1290 (defun vip-kill-line (arg)
1291   "Delete line."
1292   (interactive "P")
1293   (vip-goto-eol (cons arg ?d)))
1294
1295 \f
1296 ;; moving around
1297
1298 (defun vip-goto-line (arg)
1299   "Go to ARG's line.  Without ARG go to end of buffer."
1300   (interactive "P")
1301   (let ((val (vip-P-val arg)) (com (vip-getCom arg)))
1302     (move-marker vip-com-point (point))
1303     (set-mark (point))
1304     (if (null val)
1305         (goto-char (point-max))
1306       (goto-char (point-min))
1307       (forward-line (1- val)))
1308     (back-to-indentation)
1309     (if com (vip-execute-com 'vip-goto-line val com))))
1310
1311 (defun vip-find-char (arg char forward offset)
1312   "Find ARG's occurrence of CHAR on the current line.  If FORWARD then
1313 search is forward, otherwise backward.  OFFSET is used to adjust point
1314 after search."
1315   (let ((arg (if forward arg (- arg))) point)
1316     (save-excursion
1317       (save-restriction
1318         (if (> arg 0)
1319             (narrow-to-region
1320              ;; forward search begins here
1321              (if (eolp) (error "") (point))
1322              ;; forward search ends here
1323              (progn (with-no-warnings (next-line 1)) (beginning-of-line) (point)))
1324           (narrow-to-region
1325            ;; backward search begins from here
1326            (if (bolp) (error "") (point))
1327            ;; backward search ends here
1328            (progn (beginning-of-line) (point))))
1329         ;; if arg > 0, point is forwarded before search.
1330         (if (> arg 0) (goto-char (1+ (point-min)))
1331           (goto-char (point-max)))
1332         (let ((case-fold-search nil))
1333           (search-forward (char-to-string char) nil 0 arg))
1334         (setq point (point))
1335         (if (or (and (> arg 0) (= point (point-max)))
1336                 (and (< arg 0) (= point (point-min))))
1337             (error ""))))
1338     (goto-char (+ point (if (> arg 0) (if offset -2 -1) (if offset 1 0))))))
1339
1340 (defun vip-find-char-forward (arg)
1341   "Find char on the line.  If called interactively read the char to find
1342 from the terminal, and if called from vip-repeat, the char last used is
1343 used.  This behavior is controlled by the sign of prefix numeric value."
1344   (interactive "P")
1345   (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
1346     (if (> val 0)
1347         ;; this means that the function was called interactively
1348         (setq vip-f-char (read-char)
1349               vip-f-forward t
1350               vip-f-offset nil)
1351       (setq val (- val)))
1352     (if com (move-marker vip-com-point (point)))
1353     (vip-find-char val (if (> (vip-p-val arg) 0) vip-f-char vip-F-char) t nil)
1354     (setq val (- val))
1355     (if com
1356         (progn
1357           (setq vip-F-char vip-f-char);; set new vip-F-char
1358           (forward-char)
1359           (vip-execute-com 'vip-find-char-forward val com)))))
1360
1361 (defun vip-goto-char-forward (arg)
1362   "Go up to char ARG forward on line."
1363   (interactive "P")
1364   (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
1365     (if (> val 0)
1366         ;; this means that the function was called interactively
1367         (setq vip-f-char (read-char)
1368               vip-f-forward t
1369               vip-f-offset t)
1370       (setq val (- val)))
1371     (if com (move-marker vip-com-point (point)))
1372     (vip-find-char val (if (> (vip-p-val arg) 0) vip-f-char vip-F-char) t t)
1373     (setq val (- val))
1374     (if com
1375         (progn
1376           (setq vip-F-char vip-f-char);; set new vip-F-char
1377           (forward-char)
1378           (vip-execute-com 'vip-goto-char-forward val com)))))
1379
1380 (defun vip-find-char-backward (arg)
1381   "Find char ARG on line backward."
1382   (interactive "P")
1383   (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
1384     (if (> val 0)
1385         ;; this means that the function was called interactively
1386         (setq vip-f-char (read-char)
1387               vip-f-forward nil
1388               vip-f-offset nil)
1389       (setq val (- val)))
1390     (if com (move-marker vip-com-point (point)))
1391     (vip-find-char
1392      val (if (> (vip-p-val arg) 0) vip-f-char vip-F-char) nil nil)
1393     (setq val (- val))
1394     (if com
1395         (progn
1396           (setq vip-F-char vip-f-char);; set new vip-F-char
1397           (vip-execute-com 'vip-find-char-backward val com)))))
1398
1399 (defun vip-goto-char-backward (arg)
1400   "Go up to char ARG backward on line."
1401   (interactive "P")
1402   (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
1403     (if (> val 0)
1404         ;; this means that the function was called interactively
1405         (setq vip-f-char (read-char)
1406               vip-f-forward nil
1407               vip-f-offset t)
1408       (setq val (- val)))
1409     (if com (move-marker vip-com-point (point)))
1410     (vip-find-char val (if (> (vip-p-val arg) 0) vip-f-char vip-F-char) nil t)
1411     (setq val (- val))
1412     (if com
1413         (progn
1414           (setq vip-F-char vip-f-char);; set new vip-F-char
1415           (vip-execute-com 'vip-goto-char-backward val com)))))
1416
1417 (defun vip-repeat-find (arg)
1418   "Repeat previous find command."
1419   (interactive "P")
1420   (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
1421     (if com (move-marker vip-com-point (point)))
1422     (vip-find-char val vip-f-char vip-f-forward vip-f-offset)
1423     (if com
1424         (progn
1425           (if vip-f-forward (forward-char))
1426           (vip-execute-com 'vip-repeat-find val com)))))
1427
1428 (defun vip-repeat-find-opposite (arg)
1429   "Repeat previous find command in the opposite direction."
1430   (interactive "P")
1431   (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
1432     (if com (move-marker vip-com-point (point)))
1433     (vip-find-char val vip-f-char (not vip-f-forward) vip-f-offset)
1434     (if com
1435         (progn
1436           (if vip-f-forward (forward-char))
1437           (vip-execute-com 'vip-repeat-find-opposite val com)))))
1438
1439 \f
1440 ;; window scrolling etc.
1441
1442 (defun vip-other-window (arg)
1443   "Switch to other window."
1444   (interactive "p")
1445   (other-window arg)
1446   (or (not (eq vip-current-mode 'emacs-mode))
1447       (string= (buffer-name (current-buffer)) " *Minibuf-1*")
1448       (vip-change-mode-to-vi)))
1449
1450 (defun vip-window-top (arg)
1451   "Go to home window line."
1452   (interactive "P")
1453   (let ((val (vip-p-val arg))
1454         (com (vip-getCom arg)))
1455     (if com (move-marker vip-com-point (point)))
1456     (move-to-window-line (1- val))
1457     (if com (vip-execute-com 'vip-window-top val com))))
1458
1459 (defun vip-window-middle (arg)
1460   "Go to middle window line."
1461   (interactive "P")
1462   (let ((val (vip-p-val arg))
1463         (com (vip-getCom arg)))
1464     (if com (move-marker vip-com-point (point)))
1465     (move-to-window-line (+ (/ (1- (window-height)) 2) (1- val)))
1466     (if com (vip-execute-com 'vip-window-middle val com))))
1467
1468 (defun vip-window-bottom (arg)
1469   "Go to last window line."
1470   (interactive "P")
1471   (let ((val (vip-p-val arg))
1472         (com (vip-getCom arg)))
1473     (if com (move-marker vip-com-point (point)))
1474     (move-to-window-line (- val))
1475     (if com (vip-execute-com 'vip-window-bottom val com))))
1476
1477 (defun vip-line-to-top (arg)
1478   "Put current line on the home line."
1479   (interactive "p")
1480   (recenter (1- arg)))
1481
1482 (defun vip-line-to-middle (arg)
1483   "Put current line on the middle line."
1484   (interactive "p")
1485   (recenter (+ (1- arg) (/ (1- (window-height)) 2))))
1486
1487 (defun vip-line-to-bottom (arg)
1488   "Put current line on the last line."
1489   (interactive "p")
1490   (recenter (- (window-height) (1+ arg))))
1491
1492 \f
1493 ;; paren match
1494
1495 (defun vip-paren-match (arg)
1496   "Go to the matching parenthesis."
1497   (interactive "P")
1498   (let ((com (vip-getcom arg)))
1499     (if (numberp arg)
1500         (if (or (> arg 99) (< arg 1))
1501             (error "Prefix must be between 1 and 99")
1502           (goto-char
1503            (if (> (point-max) 80000)
1504                (* (/ (point-max) 100) arg)
1505              (/ (* (point-max) arg) 100)))
1506           (back-to-indentation))
1507     (cond ((looking-at "[\(\[{]")
1508            (if com (move-marker vip-com-point (point)))
1509            (forward-sexp 1)
1510            (if com
1511                (vip-execute-com 'vip-paren-match nil com)
1512              (backward-char)))
1513           ((looking-at "[])}]")
1514            (forward-char)
1515            (if com (move-marker vip-com-point (point)))
1516            (backward-sexp 1)
1517            (if com (vip-execute-com 'vip-paren-match nil com)))
1518           (t (error ""))))))
1519
1520 \f
1521 ;; sentence and paragraph
1522
1523 (defun vip-forward-sentence (arg)
1524   "Forward sentence."
1525   (interactive "P")
1526   (let ((val (vip-p-val arg))
1527         (com (vip-getcom arg)))
1528     (if com (move-marker vip-com-point (point)))
1529     (forward-sentence val)
1530     (if com (vip-execute-com 'vip-forward-sentence nil com))))
1531
1532 (defun vip-backward-sentence (arg)
1533   "Backward sentence."
1534   (interactive "P")
1535   (let ((val (vip-p-val arg))
1536         (com (vip-getcom arg)))
1537     (if com (move-marker vip-com-point (point)))
1538     (backward-sentence val)
1539     (if com (vip-execute-com 'vip-backward-sentence nil com))))
1540
1541 (defun vip-forward-paragraph (arg)
1542   "Forward paragraph."
1543   (interactive "P")
1544   (let ((val (vip-p-val arg))
1545         (com (vip-getCom arg)))
1546     (if com (move-marker vip-com-point (point)))
1547     (forward-paragraph val)
1548     (if com (vip-execute-com 'vip-forward-paragraph nil com))))
1549
1550 (defun vip-backward-paragraph (arg)
1551   "Backward paragraph."
1552   (interactive "P")
1553   (let ((val (vip-p-val arg))
1554         (com (vip-getCom arg)))
1555     (if com (move-marker vip-com-point (point)))
1556     (backward-paragraph val)
1557     (if com (vip-execute-com 'vip-backward-paragraph nil com))))
1558
1559 \f
1560 ;; scrolling
1561
1562 (defun vip-scroll (arg)
1563   "Scroll to next screen."
1564   (interactive "p")
1565   (if (> arg 0)
1566       (while (> arg 0)
1567         (scroll-up)
1568         (setq arg (1- arg)))
1569     (while (> 0 arg)
1570       (scroll-down)
1571       (setq arg (1+ arg)))))
1572
1573 (defun vip-scroll-back (arg)
1574   "Scroll to previous screen."
1575   (interactive "p")
1576   (vip-scroll (- arg)))
1577
1578 (defun vip-scroll-down (arg)
1579   "Scroll up half screen."
1580   (interactive "P")
1581   (if (null arg) (scroll-down (/ (window-height) 2))
1582     (scroll-down arg)))
1583
1584 (defun vip-scroll-down-one (arg)
1585   "Scroll up one line."
1586   (interactive "p")
1587   (scroll-down arg))
1588
1589 (defun vip-scroll-up (arg)
1590   "Scroll down half screen."
1591   (interactive "P")
1592   (if (null arg) (scroll-up (/ (window-height) 2))
1593     (scroll-up arg)))
1594
1595 (defun vip-scroll-up-one (arg)
1596   "Scroll down one line."
1597   (interactive "p")
1598   (scroll-up arg))
1599
1600 \f
1601 ;; splitting window
1602
1603 (defun vip-buffer-in-two-windows ()
1604   "Show current buffer in two windows."
1605   (interactive)
1606   (delete-other-windows)
1607   (split-window-vertically nil))
1608
1609 \f
1610 ;; searching
1611
1612 (defun vip-search-forward (arg)
1613   "Search a string forward.  ARG is used to find the ARG's occurrence
1614 of the string.  Default is vanilla search.  Search mode can be toggled by
1615 giving null search string."
1616   (interactive "P")
1617   (let ((val (vip-P-val arg)) (com (vip-getcom arg)))
1618     (setq vip-s-forward t
1619           vip-s-string (vip-read-string (if vip-re-search "RE-/" "/")))
1620     (if (string= vip-s-string "")
1621         (progn
1622           (setq vip-re-search (not vip-re-search))
1623           (message "Search mode changed to %s search."
1624                    (if vip-re-search "regular expression"
1625                      "vanilla")))
1626       (vip-search vip-s-string t val)
1627       (if com
1628           (progn
1629             (move-marker vip-com-point (mark))
1630             (vip-execute-com 'vip-search-next val com))))))
1631
1632 (defun vip-search-backward (arg)
1633   "Search a string backward.  ARG is used to find the ARG's occurrence
1634 of the string.  Default is vanilla search.  Search mode can be toggled by
1635 giving null search string."
1636   (interactive "P")
1637   (let ((val (vip-P-val arg)) (com (vip-getcom arg)))
1638     (setq vip-s-forward nil
1639           vip-s-string (vip-read-string (if vip-re-search "RE-?" "?")))
1640     (if (string= vip-s-string "")
1641         (progn
1642           (setq vip-re-search (not vip-re-search))
1643           (message "Search mode changed to %s search."
1644                    (if vip-re-search "regular expression"
1645                      "vanilla")))
1646       (vip-search vip-s-string nil val)
1647       (if com
1648           (progn
1649             (move-marker vip-com-point (mark))
1650             (vip-execute-com 'vip-search-next val com))))))
1651
1652 (defun vip-search (string forward arg &optional no-offset init-point)
1653   "(STRING FORWARD COUNT &optional NO-OFFSET) Search COUNT's occurrence of
1654 STRING.  Search will be forward if FORWARD, otherwise backward."
1655   (let ((val (vip-p-val arg)) (com (vip-getcom arg))
1656         (null-arg (null (vip-P-val arg))) (offset (not no-offset))
1657         (case-fold-search vip-case-fold-search)
1658         (start-point (or init-point (point))))
1659     (if forward
1660         (condition-case conditions
1661             (progn
1662               (if (and offset (not (eobp))) (forward-char))
1663               (if vip-re-search
1664                   (progn
1665                     (re-search-forward string nil nil val)
1666                     (re-search-backward string))
1667                 (search-forward string nil nil val)
1668                 (search-backward string))
1669               (push-mark start-point))
1670           (search-failed
1671            (if (and null-arg vip-search-wrap-around)
1672                (progn
1673                  (goto-char (point-min))
1674                  (vip-search string forward (cons 1 com) t start-point))
1675              (goto-char start-point)
1676              (signal 'search-failed (cdr conditions)))))
1677       (condition-case conditions
1678             (progn
1679               (if vip-re-search
1680                     (re-search-backward string nil nil val)
1681                 (search-backward string nil nil val))
1682               (push-mark start-point))
1683           (search-failed
1684            (if (and null-arg vip-search-wrap-around)
1685                (progn
1686                  (goto-char (point-max))
1687                  (vip-search string forward (cons 1 com) t start-point))
1688              (goto-char start-point)
1689              (signal 'search-failed (cdr conditions))))))))
1690
1691 (defun vip-search-next (arg)
1692   "Repeat previous search."
1693   (interactive "P")
1694   (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
1695     (if (null vip-s-string) (error "No previous search string"))
1696     (vip-search vip-s-string vip-s-forward arg)
1697     (if com (vip-execute-com 'vip-search-next val com))))
1698
1699 (defun vip-search-Next (arg)
1700   "Repeat previous search in the reverse direction."
1701   (interactive "P")
1702   (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
1703     (if (null vip-s-string) (error "No previous search string"))
1704     (vip-search vip-s-string (not vip-s-forward) arg)
1705     (if com (vip-execute-com 'vip-search-Next val com))))
1706
1707 \f
1708 ;; visiting and killing files, buffers
1709
1710 (defun vip-switch-to-buffer ()
1711   "Switch to buffer in the current window."
1712   (interactive)
1713   (let (buffer)
1714     (setq buffer
1715           (read-buffer
1716            (format "switch to buffer \(%s\): "
1717                    (buffer-name (other-buffer (current-buffer))))))
1718     (switch-to-buffer buffer)
1719     (vip-change-mode-to-vi)))
1720
1721 (defun vip-switch-to-buffer-other-window ()
1722   "Switch to buffer in another window."
1723   (interactive)
1724   (let (buffer)
1725     (setq buffer
1726           (read-buffer
1727            (format "Switch to buffer \(%s\): "
1728                    (buffer-name (other-buffer (current-buffer))))))
1729     (switch-to-buffer-other-window buffer)
1730     (vip-change-mode-to-vi)))
1731
1732 (defun vip-kill-buffer ()
1733   "Kill a buffer."
1734   (interactive)
1735   (let (buffer buffer-name)
1736     (setq buffer-name
1737           (read-buffer
1738            (format "Kill buffer \(%s\): "
1739                    (buffer-name (current-buffer)))))
1740     (setq buffer
1741           (if (null buffer-name)
1742               (current-buffer)
1743             (get-buffer buffer-name)))
1744     (if (null buffer) (error "Buffer %s nonexistent" buffer-name))
1745     (if (or (not (buffer-modified-p buffer))
1746             (y-or-n-p "Buffer is modified, are you sure? "))
1747         (kill-buffer buffer)
1748       (error "Buffer not killed"))))
1749
1750 (defun vip-find-file ()
1751   "Visit file in the current window."
1752   (interactive)
1753   (let (file)
1754     (setq file (read-file-name "visit file: "))
1755     (switch-to-buffer (find-file-noselect file))
1756     (vip-change-mode-to-vi)))
1757
1758 (defun vip-find-file-other-window ()
1759   "Visit file in another window."
1760   (interactive)
1761   (let (file)
1762     (setq file (read-file-name "Visit file: "))
1763     (switch-to-buffer-other-window (find-file-noselect file))
1764     (vip-change-mode-to-vi)))
1765
1766 (defun vip-info-on-file ()
1767   "Give information of the file associated to the current buffer."
1768   (interactive)
1769   (message "\"%s\" line %d of %d"
1770            (if (buffer-file-name) (buffer-file-name) "")
1771            (1+ (count-lines (point-min) (point)))
1772            (1+ (count-lines (point-min) (point-max)))))
1773
1774 \f
1775 ;; yank and pop
1776
1777 (defun vip-yank (text)
1778   "yank TEXT silently."
1779   (save-excursion
1780     (vip-push-mark-silent (point))
1781     (insert text)
1782     (exchange-point-and-mark))
1783   (skip-chars-forward " \t"))
1784
1785 (defun vip-put-back (arg)
1786   "Put back after point/below line."
1787   (interactive "P")
1788   (let ((val (vip-p-val arg))
1789         (text (if vip-use-register
1790                   (if (and (<= ?1 vip-use-register) (<= vip-use-register ?9))
1791                       (current-kill (- vip-use-register ?1) 'do-not-rotate)
1792                     (get-register vip-use-register))
1793                 (current-kill 0))))
1794     (if (null text)
1795         (if vip-use-register
1796             (let ((reg vip-use-register))
1797               (setq vip-use-register nil)
1798               (error "Nothing in register %c" reg))
1799           (error "")))
1800     (setq vip-use-register nil)
1801     (if (vip-end-with-a-newline-p text)
1802         (progn
1803           (with-no-warnings (next-line 1))
1804           (beginning-of-line))
1805       (if (and (not (eolp)) (not (eobp))) (forward-char)))
1806     (setq vip-d-com (list 'vip-put-back val nil vip-use-register))
1807     (vip-loop val (vip-yank text))))
1808
1809 (defun vip-Put-back (arg)
1810   "Put back at point/above line."
1811   (interactive "P")
1812   (let ((val (vip-p-val arg))
1813         (text (if vip-use-register
1814                   (if (and (<= ?1 vip-use-register) (<= vip-use-register ?9))
1815                       (current-kill (- vip-use-register ?1) 'do-not-rotate)
1816                     (get-register vip-use-register))
1817                 (current-kill 0))))
1818     (if (null text)
1819         (if vip-use-register
1820             (let ((reg vip-use-register))
1821               (setq vip-use-register nil)
1822               (error "Nothing in register %c" reg))
1823           (error "")))
1824     (setq vip-use-register nil)
1825     (if (vip-end-with-a-newline-p text) (beginning-of-line))
1826     (setq vip-d-com (list 'vip-Put-back val nil vip-use-register))
1827     (vip-loop val (vip-yank text))))
1828
1829 (defun vip-delete-char (arg)
1830   "Delete character."
1831   (interactive "P")
1832   (let ((val (vip-p-val arg)))
1833     (setq vip-d-com (list 'vip-delete-char val nil))
1834     (if vip-use-register
1835         (progn
1836           (if (and (<= ?A vip-use-register) (<= vip-use-register ?Z))
1837               (vip-append-to-register
1838                (+ vip-use-register 32) (point) (- (point) val))
1839             (copy-to-register vip-use-register (point) (- (point) val) nil))
1840           (setq vip-use-register nil)))
1841     (delete-char val t)))
1842
1843 (defun vip-delete-backward-char (arg)
1844   "Delete previous character."
1845   (interactive "P")
1846   (let ((val (vip-p-val arg)))
1847     (setq vip-d-com (list 'vip-delete-backward-char val nil))
1848     (if vip-use-register
1849         (progn
1850           (if (and (<= ?A vip-use-register) (<= vip-use-register ?Z))
1851               (vip-append-to-register
1852                (+ vip-use-register 32) (point) (+ (point) val))
1853             (copy-to-register vip-use-register (point) (+ (point) val) nil))
1854           (setq vip-use-register nil)))
1855     (delete-backward-char val t)))
1856
1857 \f
1858 ;; join lines.
1859
1860 (defun vip-join-lines (arg)
1861   "Join this line to next, if ARG is nil.  Otherwise, join ARG lines"
1862   (interactive "*P")
1863   (let ((val (vip-P-val arg)))
1864     (setq vip-d-com (list 'vip-join-lines val nil))
1865     (vip-loop (if (null val) 1 (1- val))
1866           (progn
1867             (end-of-line)
1868             (if (not (eobp))
1869                 (progn
1870                   (forward-line 1)
1871                   (delete-region (point) (1- (point)))
1872                   (fixup-whitespace)))))))
1873
1874 \f
1875 ;; making small changes
1876
1877 (defvar vip-c-string)
1878
1879 (defun vip-change (beg end)
1880   (setq vip-c-string
1881         (vip-read-string (format "%s => " (buffer-substring beg end))))
1882   (vip-change-subr beg end))
1883
1884 (defun vip-change-subr (beg end)
1885   (if vip-use-register
1886       (progn
1887         (copy-to-register vip-use-register beg end nil)
1888         (setq vip-use-register nil)))
1889   (kill-region beg end)
1890   (setq this-command 'vip-change)
1891   (insert vip-c-string))
1892
1893 \f
1894 ;; query replace
1895
1896 (defun vip-query-replace ()
1897   "Query replace.  If you supply null string as the string to be replaced,
1898 the query replace mode will toggle between string replace and regexp replace."
1899   (interactive)
1900   (let (str)
1901     (setq str (vip-read-string
1902                (if vip-re-query-replace "Query replace regexp: "
1903                  "Query replace: ")))
1904     (if (string= str "")
1905         (progn
1906           (setq vip-re-query-replace (not vip-re-query-replace))
1907           (message "Query replace mode changed to %s."
1908                    (if vip-re-query-replace "regexp replace"
1909                      "string replace")))
1910       (if vip-re-query-replace
1911           (query-replace-regexp
1912            str
1913            (vip-read-string (format "Query replace regexp \"%s\" with: " str)))
1914         (query-replace
1915          str
1916          (vip-read-string (format "Query replace \"%s\" with: " str)))))))
1917
1918 \f
1919 ;; marking
1920
1921 (defun vip-mark-beginning-of-buffer ()
1922   (interactive)
1923   (set-mark (point))
1924   (goto-char (point-min))
1925   (exchange-point-and-mark)
1926   (message "mark set at the beginning of buffer"))
1927
1928 (defun vip-mark-end-of-buffer ()
1929   (interactive)
1930   (set-mark (point))
1931   (goto-char (point-max))
1932   (exchange-point-and-mark)
1933   (message "mark set at the end of buffer"))
1934
1935 (defun vip-mark-point (char)
1936   (interactive "c")
1937   (cond ((and (<= ?a char) (<= char ?z))
1938          (point-to-register (- char (- ?a ?\C-a)) nil))
1939         ((= char ?<) (vip-mark-beginning-of-buffer))
1940         ((= char ?>) (vip-mark-end-of-buffer))
1941         ((= char ?.) (push-mark))
1942         ((= char ?,) (set-mark-command 1))
1943         ((= char ?D) (mark-defun))
1944         (t (error ""))))
1945
1946 (defun vip-goto-mark (arg)
1947   "Go to mark."
1948   (interactive "P")
1949   (let ((char (read-char)) (com (vip-getcom arg)))
1950     (vip-goto-mark-subr char com nil)))
1951
1952 (defun vip-goto-mark-and-skip-white (arg)
1953   "Go to mark and skip to first non-white on line."
1954   (interactive "P")
1955   (let ((char (read-char)) (com (vip-getCom arg)))
1956     (vip-goto-mark-subr char com t)))
1957
1958 (defun vip-goto-mark-subr (char com skip-white)
1959   (cond ((and (<= ?a char) (<= char ?z))
1960          (let ((buff (current-buffer)))
1961            (if com (move-marker vip-com-point (point)))
1962            (goto-char (register-to-point (- char (- ?a ?\C-a))))
1963            (if skip-white (back-to-indentation))
1964            (vip-change-mode-to-vi)
1965            (if com
1966                (if (equal buff (current-buffer))
1967                    (vip-execute-com (if skip-white
1968                                         'vip-goto-mark-and-skip-white
1969                                       'vip-goto-mark)
1970                                     nil com)
1971                  (switch-to-buffer buff)
1972                  (goto-char vip-com-point)
1973                  (vip-change-mode-to-vi)
1974                  (error "")))))
1975         ((and (not skip-white) (= char ?`))
1976          (if com (move-marker vip-com-point (point)))
1977          (exchange-point-and-mark)
1978          (if com (vip-execute-com 'vip-goto-mark nil com)))
1979         ((and skip-white (= char ?'))
1980          (if com (move-marker vip-com-point (point)))
1981          (exchange-point-and-mark)
1982          (back-to-indentation)
1983          (if com (vip-execute-com 'vip-goto-mark-and-skip-white nil com)))
1984         (t (error ""))))
1985
1986 (defun vip-exchange-point-and-mark ()
1987   (interactive)
1988   (exchange-point-and-mark)
1989   (back-to-indentation))
1990
1991 (defun vip-keyboard-quit ()
1992   "Abort partially formed or running command."
1993   (interactive)
1994   (setq vip-use-register nil)
1995   (keyboard-quit))
1996
1997 (defun vip-ctl-c-equivalent (arg)
1998   "Emulate C-c in Emacs mode."
1999   (interactive "P")
2000   (vip-ctl-key-equivalent "\C-c" arg))
2001
2002 (defun vip-ctl-x-equivalent (arg)
2003   "Emulate C-x in Emacs mode."
2004   (interactive "P")
2005   (vip-ctl-key-equivalent "\C-x" arg))
2006
2007 (defun vip-ctl-key-equivalent (key arg)
2008   (let ((char (read-char)))
2009     (if (and (<= ?A char) (<= char ?Z))
2010         (setq char (- char (- ?A ?\C-a))))
2011     (vip-escape-to-emacs arg (list (aref key 0) char))))
2012 \f
2013 ;; commands in insertion mode
2014
2015 (defun vip-delete-backward-word (arg)
2016   "Delete previous word."
2017   (interactive "p")
2018   (save-excursion
2019     (set-mark (point))
2020     (backward-word arg)
2021     (delete-region (point) (mark))))
2022
2023 \f
2024 ;; implement ex commands
2025
2026 (defvar ex-token-type nil
2027   "type of token.  if non-nil, gives type of address.  if nil, it
2028 is a command.")
2029
2030 (defvar ex-token nil
2031   "value of token.")
2032
2033 (defvar ex-addresses nil
2034   "list of ex addresses")
2035
2036 (defvar ex-flag nil
2037   "flag for ex flag")
2038
2039 (defvar ex-buffer nil
2040   "name of ex buffer")
2041
2042 (defvar ex-count nil
2043   "value of ex count")
2044
2045 (defvar ex-g-flag nil
2046   "flag for global command")
2047
2048 (defvar ex-g-variant nil
2049   "if t global command is executed on lines not matching ex-g-pat")
2050
2051 (defvar ex-reg-exp nil
2052   "save reg-exp used in substitute")
2053
2054 (defvar ex-repl nil
2055   "replace pattern for substitute")
2056
2057 (defvar ex-g-pat nil
2058   "pattern for global command")
2059
2060 (defvar ex-map (make-sparse-keymap)
2061   "save commands for mapped keys")
2062
2063 (defvar ex-tag nil
2064   "save ex tag")
2065
2066 (defvar ex-file nil)
2067
2068 (defvar ex-variant nil)
2069
2070 (defvar ex-offset nil)
2071
2072 (defvar ex-append nil)
2073
2074 (defun vip-nil ()
2075   (interactive)
2076   (error ""))
2077
2078 (defun vip-looking-back (str)
2079   "returns t if looking back reg-exp STR before point."
2080   (and (save-excursion (re-search-backward str nil t))
2081        (= (point) (match-end 0))))
2082
2083 (defun vip-check-sub (str)
2084   "check if ex-token is an initial segment of STR"
2085   (let ((length (length ex-token)))
2086     (if (and (<= length (length str))
2087              (string= ex-token (substring str 0 length)))
2088         (setq ex-token str)
2089       (setq ex-token-type "non-command"))))
2090
2091 (defun vip-get-ex-com-subr ()
2092   "get a complete ex command"
2093   (set-mark (point))
2094   (re-search-forward "[a-z][a-z]*")
2095   (setq ex-token-type "command")
2096   (setq ex-token (buffer-substring (point) (mark)))
2097   (exchange-point-and-mark)
2098   (cond ((looking-at "a")
2099          (cond ((looking-at "ab") (vip-check-sub "abbreviate"))
2100                ((looking-at "ar") (vip-check-sub "args"))
2101                (t (vip-check-sub "append"))))
2102         ((looking-at "[bh]") (setq ex-token-type "non-command"))
2103         ((looking-at "c")
2104          (if (looking-at "co") (vip-check-sub "copy")
2105            (vip-check-sub "change")))
2106         ((looking-at "d") (vip-check-sub "delete"))
2107         ((looking-at "e")
2108          (if (looking-at "ex") (vip-check-sub "ex")
2109            (vip-check-sub "edit")))
2110         ((looking-at "f") (vip-check-sub "file"))
2111         ((looking-at "g") (vip-check-sub "global"))
2112         ((looking-at "i") (vip-check-sub "insert"))
2113         ((looking-at "j") (vip-check-sub "join"))
2114         ((looking-at "l") (vip-check-sub "list"))
2115         ((looking-at "m")
2116          (cond ((looking-at "map") (vip-check-sub "map"))
2117                ((looking-at "mar") (vip-check-sub "mark"))
2118                (t (vip-check-sub "move"))))
2119         ((looking-at "n")
2120          (if (looking-at "nu") (vip-check-sub "number")
2121            (vip-check-sub "next")))
2122         ((looking-at "o") (vip-check-sub "open"))
2123         ((looking-at "p")
2124          (cond ((looking-at "pre") (vip-check-sub "preserve"))
2125                ((looking-at "pu") (vip-check-sub "put"))
2126                (t (vip-check-sub "print"))))
2127         ((looking-at "q") (vip-check-sub "quit"))
2128         ((looking-at "r")
2129          (cond ((looking-at "rec") (vip-check-sub "recover"))
2130                ((looking-at "rew") (vip-check-sub "rewind"))
2131                (t (vip-check-sub "read"))))
2132         ((looking-at "s")
2133          (cond ((looking-at "se") (vip-check-sub "set"))
2134                ((looking-at "sh") (vip-check-sub "shell"))
2135                ((looking-at "so") (vip-check-sub "source"))
2136                ((looking-at "st") (vip-check-sub "stop"))
2137                (t (vip-check-sub "substitute"))))
2138         ((looking-at "t")
2139          (if (looking-at "ta") (vip-check-sub "tag")
2140            (vip-check-sub "t")))
2141         ((looking-at "u")
2142          (cond ((looking-at "una") (vip-check-sub "unabbreviate"))
2143                ((looking-at "unm") (vip-check-sub "unmap"))
2144                (t (vip-check-sub "undo"))))
2145         ((looking-at "v")
2146          (cond ((looking-at "ve") (vip-check-sub "version"))
2147                ((looking-at "vi") (vip-check-sub "visual"))
2148                (t (vip-check-sub "v"))))
2149         ((looking-at "w")
2150          (if (looking-at "wq") (vip-check-sub "wq")
2151            (vip-check-sub "write")))
2152         ((looking-at "x") (vip-check-sub "xit"))
2153         ((looking-at "y") (vip-check-sub "yank"))
2154         ((looking-at "z") (vip-check-sub "z")))
2155   (exchange-point-and-mark))
2156
2157 (defun vip-get-ex-token ()
2158   "get an ex-token which is either an address or a command.
2159 a token has type \(command, address, end-mark\) and value."
2160   (with-current-buffer " *ex-working-space*"
2161     (skip-chars-forward " \t")
2162     (cond ((looking-at "[k#]")
2163            (setq ex-token-type "command")
2164            (setq ex-token (char-to-string (following-char)))
2165            (forward-char 1))
2166           ((looking-at "[a-z]") (vip-get-ex-com-subr))
2167           ((looking-at "\\.")
2168            (forward-char 1)
2169            (setq ex-token-type "dot"))
2170           ((looking-at "[0-9]")
2171            (set-mark (point))
2172            (re-search-forward "[0-9]*")
2173            (setq ex-token-type
2174                  (cond ((string= ex-token-type "plus") "add-number")
2175                        ((string= ex-token-type "minus") "sub-number")
2176                        (t "abs-number")))
2177            (setq ex-token (string-to-number (buffer-substring (point) (mark)))))
2178           ((looking-at "\\$")
2179            (forward-char 1)
2180            (setq ex-token-type "end"))
2181           ((looking-at "%")
2182            (forward-char 1)
2183            (setq ex-token-type "whole"))
2184           ((looking-at "+")
2185            (cond ((or (looking-at "+[-+]") (looking-at "+[\n|]"))
2186                   (forward-char 1)
2187                   (insert "1")
2188                   (backward-char 1)
2189                   (setq ex-token-type "plus"))
2190                  ((looking-at "+[0-9]")
2191                   (forward-char 1)
2192                   (setq ex-token-type "plus"))
2193                  (t
2194                   (error "Badly formed address"))))
2195           ((looking-at "-")
2196            (cond ((or (looking-at "-[-+]") (looking-at "-[\n|]"))
2197                   (forward-char 1)
2198                   (insert "1")
2199                   (backward-char 1)
2200                   (setq ex-token-type "minus"))
2201                  ((looking-at "-[0-9]")
2202                   (forward-char 1)
2203                   (setq ex-token-type "minus"))
2204                  (t
2205                   (error "Badly formed address"))))
2206           ((looking-at "/")
2207            (forward-char 1)
2208            (set-mark (point))
2209            (let ((cont t))
2210              (while (and (not (eolp)) cont)
2211                ;;(re-search-forward "[^/]*/")
2212                (re-search-forward "[^/]*\\(/\\|\n\\)")
2213                (if (not (vip-looking-back "[^\\\\]\\(\\\\\\\\\\)*\\\\/"))
2214                    (setq cont nil))))
2215            (backward-char 1)
2216            (setq ex-token (buffer-substring (point) (mark)))
2217            (if (looking-at "/") (forward-char 1))
2218            (setq ex-token-type "search-forward"))
2219           ((looking-at "\\?")
2220            (forward-char 1)
2221            (set-mark (point))
2222            (let ((cont t))
2223              (while (and (not (eolp)) cont)
2224                ;;(re-search-forward "[^\\?]*\\?")
2225                (re-search-forward "[^\\?]*\\(\\?\\|\n\\)")
2226                (if (not (vip-looking-back "[^\\\\]\\(\\\\\\\\\\)*\\\\\\?"))
2227                    (setq cont nil))
2228                (backward-char 1)
2229                (if (not (looking-at "\n")) (forward-char 1))))
2230            (setq ex-token-type "search-backward")
2231            (setq ex-token (buffer-substring (1- (point)) (mark))))
2232           ((looking-at ",")
2233            (forward-char 1)
2234            (setq ex-token-type "comma"))
2235           ((looking-at ";")
2236            (forward-char 1)
2237            (setq ex-token-type "semi-colon"))
2238           ((looking-at "[!=><&~]")
2239            (setq ex-token-type "command")
2240            (setq ex-token (char-to-string (following-char)))
2241            (forward-char 1))
2242           ((looking-at "'")
2243            (setq ex-token-type "goto-mark")
2244            (forward-char 1)
2245            (cond ((looking-at "'") (setq ex-token nil))
2246                  ((looking-at "[a-z]") (setq ex-token (following-char)))
2247                  (t (error "Marks are ' and a-z")))
2248            (forward-char 1))
2249           ((looking-at "\n")
2250            (setq ex-token-type "end-mark")
2251            (setq ex-token "goto"))
2252           (t
2253            (error "invalid token")))))
2254
2255 (defun vip-ex (&optional string)
2256   "ex commands within VIP."
2257   (interactive)
2258   (or string
2259       (setq ex-g-flag nil
2260             ex-g-variant nil))
2261   (let ((com-str (or string (vip-read-string ":")))
2262         (address nil) (cont t) (dot (point)))
2263     (with-current-buffer (get-buffer-create " *ex-working-space*")
2264       (delete-region (point-min) (point-max))
2265       (insert com-str "\n")
2266       (goto-char (point-min)))
2267     (setq ex-token-type "")
2268     (setq ex-addresses nil)
2269     (while cont
2270       (vip-get-ex-token)
2271       (cond ((or (string= ex-token-type "command")
2272                  (string= ex-token-type "end-mark"))
2273              (if address (setq ex-addresses (cons address ex-addresses)))
2274              (cond ((string= ex-token "global")
2275                     (ex-global nil)
2276                     (setq cont nil))
2277                    ((string= ex-token "v")
2278                     (ex-global t)
2279                     (setq cont nil))
2280                    (t
2281                     (vip-execute-ex-command)
2282                     (with-current-buffer " *ex-working-space*"
2283                       (skip-chars-forward " \t")
2284                       (cond ((looking-at "|")
2285                              (forward-char 1))
2286                             ((looking-at "\n")
2287                              (setq cont nil))
2288                             (t (error "Extra character at end of a command")))))))
2289             ((string= ex-token-type "non-command")
2290              (error "%s: Not an editor command" ex-token))
2291             ((string= ex-token-type "whole")
2292              (setq ex-addresses
2293                    (cons (point-max) (cons (point-min) ex-addresses))))
2294             ((string= ex-token-type "comma")
2295              (setq ex-addresses
2296                    (cons (if (null address) (point) address) ex-addresses)))
2297             ((string= ex-token-type "semi-colon")
2298              (if address (setq dot address))
2299              (setq ex-addresses
2300                    (cons (if (null address) (point) address) ex-addresses)))
2301             (t (let ((ans (vip-get-ex-address-subr address dot)))
2302                  (if ans (setq address ans))))))))
2303
2304 (defun vip-get-ex-pat ()
2305   "get a regular expression and set ex-variant if found"
2306   (with-current-buffer " *ex-working-space*"
2307     (skip-chars-forward " \t")
2308     (if (looking-at "!")
2309         (progn
2310           (setq ex-g-variant (not ex-g-variant)
2311                 ex-g-flag (not ex-g-flag))
2312           (forward-char 1)
2313           (skip-chars-forward " \t")))
2314     (if (looking-at "/")
2315         (progn
2316           (forward-char 1)
2317           (set-mark (point))
2318           (let ((cont t))
2319             (while (and (not (eolp)) cont)
2320               (re-search-forward "[^/]*\\(/\\|\n\\)")
2321               ;;(re-search-forward "[^/]*/")
2322               (if (not (vip-looking-back "[^\\\\]\\(\\\\\\\\\\)*\\\\/"))
2323                   (setq cont nil))))
2324           (setq ex-token
2325                 (if (= (mark) (point)) ""
2326                   (buffer-substring (1- (point)) (mark))))
2327           (backward-char 1))
2328       (setq ex-token nil))))
2329
2330 (defun vip-get-ex-command ()
2331   "get an ex command"
2332   (with-current-buffer " *ex-working-space*"
2333     (if (looking-at "/") (forward-char 1))
2334     (skip-chars-forward " \t")
2335     (cond ((looking-at "[a-z]")
2336            (vip-get-ex-com-subr)
2337            (if (string= ex-token-type "non-command")
2338                (error "%s: not an editor command" ex-token)))
2339           ((looking-at "[!=><&~]")
2340            (setq ex-token (char-to-string (following-char)))
2341            (forward-char 1))
2342           (t (error "Could not find an ex command")))))
2343
2344 (defun vip-get-ex-opt-gc ()
2345   "get an ex option g or c"
2346   (with-current-buffer " *ex-working-space*"
2347     (if (looking-at "/") (forward-char 1))
2348     (skip-chars-forward " \t")
2349     (cond ((looking-at "g")
2350            (setq ex-token "g")
2351            (forward-char 1)
2352            t)
2353           ((looking-at "c")
2354            (setq ex-token "c")
2355            (forward-char 1)
2356            t)
2357           (t nil))))
2358
2359 (defun vip-default-ex-addresses (&optional whole-flag)
2360   "compute default addresses.  whole-flag means whole buffer."
2361   (cond ((null ex-addresses)
2362          (setq ex-addresses
2363                (if whole-flag
2364                    (cons (point-max) (cons (point-min) nil))
2365                  (cons (point) (cons (point) nil)))))
2366         ((null (cdr ex-addresses))
2367          (setq ex-addresses
2368                (cons (car ex-addresses) ex-addresses)))))
2369
2370 (defun vip-get-ex-address ()
2371   "get an ex-address as a marker and set ex-flag if a flag is found"
2372   (let ((address (point-marker)) (cont t))
2373     (setq ex-token "")
2374     (setq ex-flag nil)
2375     (while cont
2376       (vip-get-ex-token)
2377       (cond ((string= ex-token-type "command")
2378              (if (or (string= ex-token "print") (string= ex-token "list")
2379                      (string= ex-token "#"))
2380                  (progn
2381                    (setq ex-flag t)
2382                    (setq cont nil))
2383              (error "address expected")))
2384             ((string= ex-token-type "end-mark")
2385              (setq cont nil))
2386             ((string= ex-token-type "whole")
2387              (error "a trailing address is expected"))
2388             ((string= ex-token-type "comma")
2389              (error "Extra characters after an address"))
2390             (t (let ((ans (vip-get-ex-address-subr address (point-marker))))
2391                  (if ans (setq address ans))))))
2392     address))
2393
2394 (defun vip-get-ex-address-subr (old-address dot)
2395   "returns an address as a point"
2396   (let ((address nil))
2397     (if (null old-address) (setq old-address dot))
2398     (cond ((string= ex-token-type "dot")
2399            (setq address dot))
2400           ((string= ex-token-type "add-number")
2401            (save-excursion
2402              (goto-char old-address)
2403              (forward-line (if (= old-address 0) (1- ex-token) ex-token))
2404              (setq address (point-marker))))
2405           ((string= ex-token-type "sub-number")
2406            (save-excursion
2407              (goto-char old-address)
2408              (forward-line (- ex-token))
2409              (setq address (point-marker))))
2410           ((string= ex-token-type "abs-number")
2411            (save-excursion
2412              (goto-char (point-min))
2413              (if (= ex-token 0) (setq address 0)
2414                (forward-line (1- ex-token))
2415                (setq address (point-marker)))))
2416           ((string= ex-token-type "end")
2417            (setq address (point-max-marker)))
2418           ((string= ex-token-type "plus") t);; do nothing
2419           ((string= ex-token-type "minus") t);; do nothing
2420           ((string= ex-token-type "search-forward")
2421            (save-excursion
2422              (ex-search-address t)
2423              (setq address (point-marker))))
2424           ((string= ex-token-type "search-backward")
2425            (save-excursion
2426              (ex-search-address nil)
2427              (setq address (point-marker))))
2428           ((string= ex-token-type "goto-mark")
2429            (save-excursion
2430              (if (null ex-token)
2431                  (exchange-point-and-mark)
2432                (goto-char (register-to-point (- ex-token (- ?a ?\C-a)))))
2433              (setq address (point-marker)))))
2434     address))
2435
2436 (defun ex-search-address (forward)
2437   "search pattern and set address"
2438   (if (string= ex-token "")
2439       (if (null vip-s-string) (error "No previous search string")
2440         (setq ex-token vip-s-string))
2441     (setq vip-s-string ex-token))
2442   (if forward
2443       (progn
2444         (forward-line 1)
2445         (re-search-forward ex-token))
2446     (forward-line -1)
2447     (re-search-backward ex-token)))
2448
2449 (defun vip-get-ex-buffer ()
2450   "get a buffer name and set ex-count and ex-flag if found"
2451   (setq ex-buffer nil)
2452   (setq ex-count nil)
2453   (setq ex-flag nil)
2454   (with-current-buffer " *ex-working-space*"
2455     (skip-chars-forward " \t")
2456     (if (looking-at "[a-zA-Z]")
2457         (progn
2458           (setq ex-buffer (following-char))
2459           (forward-char 1)
2460           (skip-chars-forward " \t")))
2461     (if (looking-at "[0-9]")
2462         (progn
2463           (set-mark (point))
2464           (re-search-forward "[0-9][0-9]*")
2465           (setq ex-count (string-to-number (buffer-substring (point) (mark))))
2466           (skip-chars-forward " \t")))
2467     (if (looking-at "[pl#]")
2468         (progn
2469           (setq ex-flag t)
2470           (forward-char 1)))
2471     (if (not (looking-at "[\n|]"))
2472         (error "Invalid extra characters"))))
2473
2474 (defun vip-get-ex-count ()
2475   (setq ex-variant nil
2476         ex-count nil
2477         ex-flag nil)
2478   (with-current-buffer " *ex-working-space*"
2479     (skip-chars-forward " \t")
2480     (if (looking-at "!")
2481         (progn
2482           (setq ex-variant t)
2483           (forward-char 1)))
2484     (skip-chars-forward " \t")
2485     (if (looking-at "[0-9]")
2486         (progn
2487           (set-mark (point))
2488           (re-search-forward "[0-9][0-9]*")
2489           (setq ex-count (string-to-number (buffer-substring (point) (mark))))
2490           (skip-chars-forward " \t")))
2491     (if (looking-at "[pl#]")
2492         (progn
2493           (setq ex-flag t)
2494           (forward-char 1)))
2495     (if (not (looking-at "[\n|]"))
2496         (error "Invalid extra characters"))))
2497
2498 (defun vip-get-ex-file ()
2499   "get a file name and set ex-variant, ex-append and ex-offset if found"
2500   (setq ex-file nil
2501         ex-variant nil
2502         ex-append nil
2503         ex-offset nil)
2504   (with-current-buffer " *ex-working-space*"
2505     (skip-chars-forward " \t")
2506     (if (looking-at "!")
2507         (progn
2508           (setq ex-variant t)
2509           (forward-char 1)
2510           (skip-chars-forward " \t")))
2511     (if (looking-at ">>")
2512         (progn
2513           (setq ex-append t
2514                 ex-variant t)
2515           (forward-char 2)
2516           (skip-chars-forward " \t")))
2517     (if (looking-at "+")
2518         (progn
2519           (forward-char 1)
2520           (set-mark (point))
2521           (re-search-forward "[ \t\n]")
2522           (backward-char 1)
2523           (setq ex-offset (buffer-substring (point) (mark)))
2524           (forward-char 1)
2525           (skip-chars-forward " \t")))
2526     (set-mark (point))
2527     (re-search-forward "[ \t\n]")
2528     (backward-char 1)
2529     (setq ex-file (buffer-substring (point) (mark)))))
2530
2531 (defun vip-execute-ex-command ()
2532   "execute ex command using the value of addresses."
2533   (cond ((string= ex-token "goto") (ex-goto))
2534         ((string= ex-token "copy") (ex-copy nil))
2535         ((string= ex-token "delete") (ex-delete))
2536         ((string= ex-token "edit") (ex-edit))
2537         ((string= ex-token "file") (vip-info-on-file))
2538         ;((string= ex-token "global") (ex-global nil))
2539         ((string= ex-token "join") (ex-line "join"))
2540         ((string= ex-token "k") (ex-mark))
2541         ((string= ex-token "mark") (ex-mark))
2542         ((string= ex-token "map") (ex-map))
2543         ((string= ex-token "move") (ex-copy t))
2544         ((string= ex-token "put") (ex-put))
2545         ((string= ex-token "quit") (ex-quit))
2546         ((string= ex-token "read") (ex-read))
2547         ((string= ex-token "set") (ex-set))
2548         ((string= ex-token "shell") (ex-shell))
2549         ((string= ex-token "substitute") (ex-substitute))
2550         ((string= ex-token "stop") (suspend-emacs))
2551         ((string= ex-token "t") (ex-copy nil))
2552         ((string= ex-token "tag") (ex-tag))
2553         ((string= ex-token "undo") (vip-undo))
2554         ((string= ex-token "unmap") (ex-unmap))
2555         ;((string= ex-token "v") (ex-global t))
2556         ((string= ex-token "version") (vip-version))
2557         ((string= ex-token "visual") (ex-edit))
2558         ((string= ex-token "write") (ex-write nil))
2559         ((string= ex-token "wq") (ex-write t))
2560         ((string= ex-token "yank") (ex-yank))
2561         ((string= ex-token "!") (ex-command))
2562         ((string= ex-token "=") (ex-line-no))
2563         ((string= ex-token ">") (ex-line "right"))
2564         ((string= ex-token "<") (ex-line "left"))
2565         ((string= ex-token "&") (ex-substitute t))
2566         ((string= ex-token "~") (ex-substitute t t))
2567         ((or (string= ex-token "append")
2568              (string= ex-token "args")
2569              (string= ex-token "change")
2570              (string= ex-token "insert")
2571              (string= ex-token "open")
2572              )
2573          (error "%s: no such command from VIP" ex-token))
2574         ((or (string= ex-token "abbreviate")
2575              (string= ex-token "list")
2576              (string= ex-token "next")
2577              (string= ex-token "print")
2578              (string= ex-token "preserve")
2579              (string= ex-token "recover")
2580              (string= ex-token "rewind")
2581              (string= ex-token "source")
2582              (string= ex-token "unabbreviate")
2583              (string= ex-token "xit")
2584              (string= ex-token "z")
2585              )
2586          (error "%s: not implemented in VIP" ex-token))
2587         (t (error "%s: Not an editor command" ex-token))))
2588
2589 (defun ex-goto ()
2590   "ex goto command"
2591   (if (null ex-addresses)
2592       (setq ex-addresses (cons (point) nil)))
2593   (push-mark (point))
2594   (goto-char (car ex-addresses))
2595   (beginning-of-line))
2596
2597 (defun ex-copy (del-flag)
2598   "ex copy and move command.  DEL-FLAG means delete."
2599   (vip-default-ex-addresses)
2600   (let ((address (vip-get-ex-address))
2601         (end (car ex-addresses)) (beg (car (cdr ex-addresses))))
2602     (goto-char end)
2603     (save-excursion
2604       (set-mark beg)
2605       (vip-enlarge-region (mark) (point))
2606       (if del-flag (kill-region (point) (mark))
2607         (copy-region-as-kill (point) (mark)))
2608       (if ex-flag
2609           (progn
2610             (with-output-to-temp-buffer "*copy text*"
2611               (princ
2612                (if (or del-flag ex-g-flag ex-g-variant)
2613                    (current-kill 0)
2614                  (buffer-substring (point) (mark)))))
2615             (condition-case nil
2616                 (progn
2617                   (vip-read-string "[Hit return to continue] ")
2618                   (save-excursion (kill-buffer "*copy text*")))
2619               (quit
2620                (save-excursion (kill-buffer "*copy text*"))
2621                (signal 'quit nil))))))
2622       (if (= address 0)
2623           (goto-char (point-min))
2624         (goto-char address)
2625         (forward-line 1))
2626       (insert (current-kill 0))))
2627
2628 (defun ex-delete ()
2629   "ex delete"
2630   (vip-default-ex-addresses)
2631   (vip-get-ex-buffer)
2632   (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses))))
2633     (if (> beg end) (error "First address exceeds second"))
2634     (save-excursion
2635       (vip-enlarge-region beg end)
2636       (exchange-point-and-mark)
2637       (if ex-count
2638           (progn
2639             (set-mark (point))
2640             (forward-line (1- ex-count)))
2641         (set-mark end))
2642       (vip-enlarge-region (point) (mark))
2643       (if ex-flag
2644           ;; show text to be deleted and ask for confirmation
2645           (progn
2646             (with-output-to-temp-buffer " *delete text*"
2647               (princ (buffer-substring (point) (mark))))
2648             (condition-case conditions
2649                 (vip-read-string "[Hit return to continue] ")
2650               (quit
2651                (save-excursion (kill-buffer " *delete text*"))
2652                (error "")))
2653             (save-excursion (kill-buffer " *delete text*")))
2654         (if ex-buffer
2655             (if (and (<= ?A ex-buffer) (<= ex-buffer ?Z))
2656                 (vip-append-to-register
2657                  (+ ex-buffer 32) (point) (mark))
2658               (copy-to-register ex-buffer (point) (mark) nil)))
2659         (delete-region (point) (mark))))))
2660
2661 (defun ex-edit ()
2662   "ex-edit"
2663   (vip-get-ex-file)
2664   (if (and (not ex-variant) (buffer-modified-p) buffer-file-name)
2665       (error "No write since last change \(:e! overrides\)"))
2666   (vip-change-mode-to-emacs)
2667   (set-buffer
2668    (find-file-noselect (concat default-directory ex-file)))
2669   (vip-change-mode-to-vi)
2670   (goto-char (point-min))
2671   (if ex-offset
2672       (progn
2673         (with-current-buffer " *ex-working-space*"
2674           (delete-region (point-min) (point-max))
2675           (insert ex-offset "\n")
2676           (goto-char (point-min)))
2677         (goto-char (vip-get-ex-address))
2678         (beginning-of-line))))
2679
2680 (defun ex-global (variant)
2681   "ex global command"
2682   (if (or ex-g-flag ex-g-variant)
2683       (error "Global within global not allowed")
2684     (if variant
2685         (setq ex-g-flag nil
2686               ex-g-variant t)
2687       (setq ex-g-flag t
2688             ex-g-variant nil)))
2689   (vip-get-ex-pat)
2690   (if (null ex-token)
2691       (error "Missing regular expression for global command"))
2692   (if (string= ex-token "")
2693       (if (null vip-s-string) (error "No previous search string")
2694         (setq ex-g-pat vip-s-string))
2695     (setq ex-g-pat ex-token
2696           vip-s-string ex-token))
2697   (if (null ex-addresses)
2698       (setq ex-addresses (list (point-max) (point-min))))
2699   (let ((marks nil) (mark-count 0)
2700         com-str (end (car ex-addresses)) (beg (car (cdr ex-addresses))))
2701     (if (> beg end) (error "First address exceeds second"))
2702     (save-excursion
2703       (vip-enlarge-region beg end)
2704       (exchange-point-and-mark)
2705       (let ((cont t) (limit (point-marker)))
2706         (exchange-point-and-mark)
2707         ;; skip the last line if empty
2708         (beginning-of-line)
2709         (if (and (eobp) (not (bobp))) (backward-char 1))
2710         (while (and cont (not (bobp)) (>= (point) limit))
2711           (beginning-of-line)
2712           (set-mark (point))
2713           (end-of-line)
2714           (let ((found (re-search-backward ex-g-pat (mark) t)))
2715             (if (or (and ex-g-flag found)
2716                     (and ex-g-variant (not found)))
2717                 (progn
2718                   (end-of-line)
2719                   (setq mark-count (1+ mark-count))
2720                   (setq marks (cons (point-marker) marks)))))
2721           (beginning-of-line)
2722           (if (bobp) (setq cont nil)
2723             (forward-line -1)
2724             (end-of-line)))))
2725     (with-current-buffer " *ex-working-space*"
2726       (setq com-str (buffer-substring (1+ (point)) (1- (point-max)))))
2727     (while marks
2728       (goto-char (car marks))
2729       ;; report progress of execution on a slow machine.
2730       ;;(message "Executing global command...")
2731       ;;(if (zerop (% mark-count 10))
2732       ;;    (message "Executing global command...%d" mark-count))
2733       (vip-ex com-str)
2734       (setq mark-count (1- mark-count))
2735       (setq marks (cdr marks)))))
2736 ;;(message "Executing global command...done")))
2737
2738 (defun ex-line (com)
2739   "ex line commands.  COM is join, shift-right or shift-left."
2740   (vip-default-ex-addresses)
2741   (vip-get-ex-count)
2742   (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses))) point)
2743     (if (> beg end) (error "First address exceeds second"))
2744     (save-excursion
2745       (vip-enlarge-region beg end)
2746       (exchange-point-and-mark)
2747       (if ex-count
2748           (progn
2749             (set-mark (point))
2750             (forward-line ex-count)))
2751       (if ex-flag
2752           ;; show text to be joined and ask for confirmation
2753           (progn
2754             (with-output-to-temp-buffer " *text*"
2755               (princ (buffer-substring (point) (mark))))
2756             (condition-case conditions
2757                 (progn
2758                   (vip-read-string "[Hit return to continue] ")
2759                   (ex-line-subr com (point) (mark)))
2760               (quit
2761                (ding)))
2762             (save-excursion (kill-buffer " *text*")))
2763         (ex-line-subr com (point) (mark)))
2764       (setq point (point)))
2765     (goto-char (1- point))
2766     (beginning-of-line)))
2767
2768 (defun ex-line-subr (com beg end)
2769   (cond ((string= com "join")
2770          (goto-char (min beg end))
2771          (while (and (not (eobp)) (< (point) (max beg end)))
2772            (end-of-line)
2773            (if (and (<= (point) (max beg end)) (not (eobp)))
2774                (progn
2775                  (forward-line 1)
2776                  (delete-region (point) (1- (point)))
2777                  (if (not ex-variant) (fixup-whitespace))))))
2778         ((or (string= com "right") (string= com "left"))
2779          (indent-rigidly
2780           (min beg end) (max beg end)
2781           (if (string= com "right") vip-shift-width (- vip-shift-width)))
2782          (goto-char (max beg end))
2783          (end-of-line)
2784          (forward-char 1))))
2785
2786 (defun ex-mark ()
2787   "ex mark"
2788   (let (char)
2789     (if (null ex-addresses)
2790         (setq ex-addresses
2791               (cons (point) nil)))
2792     (with-current-buffer " *ex-working-space*"
2793       (skip-chars-forward " \t")
2794       (if (looking-at "[a-z]")
2795           (progn
2796             (setq char (following-char))
2797             (forward-char 1)
2798             (skip-chars-forward " \t")
2799             (if (not (looking-at "[\n|]"))
2800                 (error "Extra characters at end of \"k\" command")))
2801         (if (looking-at "[\n|]")
2802             (error "\"k\" requires a following letter")
2803           (error "Mark must specify a letter"))))
2804     (save-excursion
2805       (goto-char (car ex-addresses))
2806       (point-to-register (- char (- ?a ?\C-a)) nil))))
2807
2808 (defun ex-map ()
2809   "ex map"
2810   (let (char string)
2811     (with-current-buffer " *ex-working-space*"
2812       (skip-chars-forward " \t")
2813       (setq char (char-to-string (following-char)))
2814       (forward-char 1)
2815       (skip-chars-forward " \t")
2816       (if (looking-at "[\n|]") (error "Missing rhs"))
2817       (set-mark (point))
2818       (with-no-warnings
2819         (end-of-buffer))
2820       (backward-char 1)
2821       (setq string (buffer-substring (mark) (point))))
2822     (if (not (lookup-key ex-map char))
2823         (define-key ex-map char
2824           (or (lookup-key vip-mode-map char) 'vip-nil)))
2825     (define-key vip-mode-map char
2826       (eval
2827        (list 'quote
2828              (cons 'lambda
2829                    (list '(count)
2830                          '(interactive "p")
2831                          (list 'execute-kbd-macro string 'count))))))))
2832
2833 (defun ex-unmap ()
2834   "ex unmap"
2835   (let (char)
2836     (with-current-buffer " *ex-working-space*"
2837       (skip-chars-forward " \t")
2838       (setq char (char-to-string (following-char)))
2839       (forward-char 1)
2840       (skip-chars-forward " \t")
2841       (if (not (looking-at "[\n|]")) (error "Macro must be a character")))
2842     (if (not (lookup-key ex-map char))
2843         (error "That macro wasn't mapped"))
2844     (define-key vip-mode-map char (lookup-key ex-map char))
2845     (define-key ex-map char nil)))
2846
2847 (defun ex-put ()
2848   "ex put"
2849   (let ((point (if (null ex-addresses) (point) (car ex-addresses))))
2850     (vip-get-ex-buffer)
2851     (setq vip-use-register ex-buffer)
2852     (goto-char point)
2853     (if (= point 0) (vip-Put-back 1) (vip-put-back 1))))
2854
2855 (defun ex-quit ()
2856   "ex quit"
2857   (let (char)
2858     (with-current-buffer " *ex-working-space*"
2859       (skip-chars-forward " \t")
2860       (setq char (following-char)))
2861     (if (= char ?!) (kill-emacs t) (save-buffers-kill-emacs))))
2862
2863 (defun ex-read ()
2864   "ex read"
2865   (let ((point (if (null ex-addresses) (point) (car ex-addresses)))
2866         (variant nil) command file)
2867     (goto-char point)
2868     (if (not (= point 0)) (with-no-warnings (next-line 1)))
2869     (beginning-of-line)
2870     (with-current-buffer " *ex-working-space*"
2871       (skip-chars-forward " \t")
2872       (if (looking-at "!")
2873           (progn
2874             (setq variant t)
2875             (forward-char 1)
2876             (skip-chars-forward " \t")
2877             (set-mark (point))
2878             (end-of-line)
2879             (setq command (buffer-substring (mark) (point))))
2880         (set-mark (point))
2881         (re-search-forward "[ \t\n]")
2882         (backward-char 1)
2883         (setq file (buffer-substring (point) (mark)))))
2884       (if variant
2885           (shell-command command t)
2886         (with-no-warnings
2887           (insert-file file)))))
2888
2889 (defun ex-set ()
2890   (eval (list 'setq
2891               (read-variable "Variable: ")
2892               (eval (read-minibuffer "Value: ")))))
2893
2894 (defun ex-shell ()
2895   "ex shell"
2896   (vip-change-mode-to-emacs)
2897   (shell))
2898
2899 (defun ex-substitute (&optional repeat r-flag)
2900   "ex substitute.
2901 If REPEAT use previous reg-exp which is ex-reg-exp or
2902 vip-s-string"
2903   (let (pat repl (opt-g nil) (opt-c nil) (matched-pos nil))
2904     (if repeat (setq ex-token nil) (vip-get-ex-pat))
2905     (if (null ex-token)
2906         (setq pat (if r-flag vip-s-string ex-reg-exp)
2907               repl ex-repl)
2908       (setq pat (if (string= ex-token "") vip-s-string ex-token))
2909       (setq vip-s-string pat
2910             ex-reg-exp pat)
2911       (vip-get-ex-pat)
2912       (if (null ex-token)
2913           (setq ex-token ""
2914                 ex-repl "")
2915         (setq repl ex-token
2916               ex-repl ex-token)))
2917     (while (vip-get-ex-opt-gc)
2918       (if (string= ex-token "g") (setq opt-g t) (setq opt-c t)))
2919     (vip-get-ex-count)
2920     (if ex-count
2921         (save-excursion
2922           (if ex-addresses (goto-char (car ex-addresses)))
2923           (set-mark (point))
2924           (forward-line (1- ex-count))
2925           (setq ex-addresses (cons (point) (cons (mark) nil))))
2926       (if (null ex-addresses)
2927           (setq ex-addresses (cons (point) (cons (point) nil)))
2928         (if (null (cdr ex-addresses))
2929             (setq ex-addresses (cons (car ex-addresses) ex-addresses)))))
2930     ;(setq G opt-g)
2931     (let ((beg (car ex-addresses)) (end (car (cdr ex-addresses)))
2932           (cont t) eol-mark)
2933       (save-excursion
2934         (vip-enlarge-region beg end)
2935         (let ((limit (save-excursion
2936                        (goto-char (max (point) (mark)))
2937                        (point-marker))))
2938           (goto-char (min (point) (mark)))
2939           (while (< (point) limit)
2940             (end-of-line)
2941             (setq eol-mark (point-marker))
2942             (beginning-of-line)
2943             (if opt-g
2944                 (progn
2945                   (while (and (not (eolp))
2946                               (re-search-forward pat eol-mark t))
2947                     (if (or (not opt-c) (y-or-n-p "Replace? "))
2948                         (progn
2949                           (setq matched-pos (point))
2950                           (replace-match repl))))
2951                   (end-of-line)
2952                   (forward-char))
2953               (if (and (re-search-forward pat eol-mark t)
2954                        (or (not opt-c) (y-or-n-p "Replace? ")))
2955                   (progn
2956                     (setq matched-pos (point))
2957                     (replace-match repl)))
2958               (end-of-line)
2959               (forward-char))))))
2960     (if matched-pos (goto-char matched-pos))
2961     (beginning-of-line)
2962     (if opt-c (message "done"))))
2963
2964 (defun ex-tag ()
2965   "ex tag"
2966   (let (tag)
2967     (with-current-buffer " *ex-working-space*"
2968       (skip-chars-forward " \t")
2969       (set-mark (point))
2970       (skip-chars-forward "^ |\t\n")
2971       (setq tag (buffer-substring (mark) (point))))
2972     (if (not (string= tag "")) (setq ex-tag tag))
2973     (vip-change-mode-to-emacs)
2974     (condition-case conditions
2975         (progn
2976           (if (string= tag "")
2977               (find-tag ex-tag t)
2978             (find-tag-other-window ex-tag))
2979           (vip-change-mode-to-vi))
2980       (error
2981        (vip-change-mode-to-vi)
2982        (vip-message-conditions conditions)))))
2983
2984 (defun ex-write (q-flag)
2985   "ex write"
2986   (vip-default-ex-addresses t)
2987   (vip-get-ex-file)
2988   (if (string= ex-file "")
2989       (progn
2990         (if (null buffer-file-name)
2991             (error "No file associated with this buffer"))
2992         (setq ex-file buffer-file-name))
2993     (setq ex-file (expand-file-name ex-file)))
2994   (if (and (not (string= ex-file (buffer-file-name)))
2995            (file-exists-p ex-file)
2996            (not ex-variant))
2997       (error "\"%s\" File exists - use w! to override" ex-file))
2998   (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses))))
2999     (if (> beg end) (error "First address exceeds second"))
3000     (save-excursion
3001       (vip-enlarge-region beg end)
3002       (write-region (point) (mark) ex-file ex-append t)))
3003   (if (null buffer-file-name) (setq buffer-file-name ex-file))
3004   (if q-flag (save-buffers-kill-emacs)))
3005
3006 (defun ex-yank ()
3007   "ex yank"
3008   (vip-default-ex-addresses)
3009   (vip-get-ex-buffer)
3010   (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses))))
3011     (if (> beg end) (error "First address exceeds second"))
3012     (save-excursion
3013       (vip-enlarge-region beg end)
3014       (exchange-point-and-mark)
3015       (if (or ex-g-flag ex-g-variant) (error "Can't yank within global"))
3016       (if ex-count
3017           (progn
3018             (set-mark (point))
3019             (forward-line (1- ex-count)))
3020         (set-mark end))
3021       (vip-enlarge-region (point) (mark))
3022       (if ex-flag (error "Extra characters at end of command"))
3023       (if ex-buffer
3024           (copy-to-register ex-buffer (point) (mark) nil))
3025       (copy-region-as-kill (point) (mark)))))
3026
3027 (defun ex-command ()
3028   "execute shell command"
3029   (let (command)
3030     (with-current-buffer " *ex-working-space*"
3031       (skip-chars-forward " \t")
3032       (set-mark (point))
3033       (end-of-line)
3034       (setq command (buffer-substring (mark) (point))))
3035     (if (null ex-addresses)
3036         (shell-command command)
3037       (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses))))
3038         (if (null beg) (setq beg end))
3039         (save-excursion
3040           (goto-char beg)
3041           (set-mark end)
3042           (vip-enlarge-region (point) (mark))
3043           (shell-command-on-region (point) (mark) command t))
3044         (goto-char beg)))))
3045
3046 (defun ex-line-no ()
3047   "print line number"
3048   (message "%d"
3049            (1+ (count-lines
3050                 (point-min)
3051                 (if (null ex-addresses) (point-max) (car ex-addresses))))))
3052
3053 (if (file-exists-p vip-startup-file) (load vip-startup-file))
3054
3055 (provide 'vip)
3056
3057 ;; arch-tag: bff623ef-48f7-41d4-9aa3-2e840c9ab415
3058 ;;; vip.el ends here