cgit.sxemacs.org Git - packages/blob - mule-packages/skk/vip.el

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