home *** CD-ROM | disk | FTP | other *** search
/ Education Sampler 1992 [NeXTSTEP] / Education_1992_Sampler.iso / NeXT / GnuSource / emacs-15.0.3 / lisp / vip.el < prev    next >
Lisp/Scheme  |  1990-08-16  |  97KB  |  3,075 lines

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