lisp/emulation/vip.el

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