summaryrefslogtreecommitdiff
path: root/lisp/emulation/vip.el
diff options
context:
space:
mode:
authorGlenn Morris <rgm@gnu.org>2014-06-01 18:02:21 -0700
committerGlenn Morris <rgm@gnu.org>2014-06-01 18:02:21 -0700
commit4982861a08d0ec3262a0b68ff699920bb2938c40 (patch)
treecf01c1b9ce846288a2dcbc9e5c660071cecedc14 /lisp/emulation/vip.el
parent953e106ac84587e765244995687b088969b5f6e1 (diff)
Make some old emulation modes obsolete
Ref: http://lists.gnu.org/archive/html/emacs-devel/2014-05/msg00502.html * lisp/emulation/crisp.el, lisp/emulation/tpu-edt.el: * lisp/emulation/tpu-extras.el, lisp/emulation/tpu-mapper.el: * lisp/emulation/vi.el, lisp/emulation/vip.el, lisp/emulation/ws-mode.el: Move to obsolete/. * doc/emacs/ack.texi (Acknowledgments): Remove some obsolete items. * doc/emacs/misc.texi (Emulation): Remove section. * doc/lispintro/emacs-lisp-intro.texi (Autoload): Update loaddefs.el details. * doc/misc/efaq.texi (Finding a package with particular functionality): Update example. * doc/misc/vip.texi: Mention this is obsolete. * etc/NEWS: Mention this.
Diffstat (limited to 'lisp/emulation/vip.el')
-rw-r--r--lisp/emulation/vip.el3059
1 files changed, 0 insertions, 3059 deletions
diff --git a/lisp/emulation/vip.el b/lisp/emulation/vip.el
deleted file mode 100644
index 09456e6320..0000000000
--- a/lisp/emulation/vip.el
+++ /dev/null
@@ -1,3059 +0,0 @@
-;;; vip.el --- a VI Package for GNU Emacs
-
-;; Copyright (C) 1986-1988, 1992-1993, 1998, 2001-2014 Free Software
-;; Foundation, Inc.
-
-;; Author: Masahiko Sato <ms@sail.stanford.edu>
-;; Keywords: emulations
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; A full-featured vi(1) emulator.
-;;
-;; In Japan, the author's address is: masahiko@sato.riec.tohoku.junet
-;;
-;; Send suggestions and bug reports to one of the above addresses.
-;; When you report a bug, be sure to include the version number of VIP and
-;; Emacs you are using.
-
-;; Execute info command by typing "M-x info" to get information on VIP.
-
-;;; Code:
-
-(defgroup vip nil
- "A VI Package for GNU Emacs."
- :prefix "vip-"
- :group 'emulations)
-
-;; external variables
-
-(defvar vip-emacs-local-map nil
- "Local map used in Emacs mode. (Buffer-specific.)")
-
-(defvar vip-insert-local-map nil
- "Local map used in insert command mode. (Buffer-specific.)")
-
-(make-variable-buffer-local 'vip-emacs-local-map)
-(make-variable-buffer-local 'vip-insert-local-map)
-
-(defvar vip-insert-point nil
- "Remember insert point as a marker. (Buffer-specific.)")
-
-(set-default 'vip-insert-point (make-marker))
-(make-variable-buffer-local 'vip-insert-point)
-
-(defvar vip-com-point nil
- "Remember com point as a marker. (Buffer-specific.)")
-
-(set-default 'vip-com-point (make-marker))
-(make-variable-buffer-local 'vip-com-point)
-
-(defvar vip-current-mode nil
- "Current mode. One of `emacs-mode', `vi-mode', `insert-mode'.")
-
-(make-variable-buffer-local 'vip-current-mode)
-(setq-default vip-current-mode 'emacs-mode)
-
-(defvar vip-emacs-mode-line-buffer-identification nil
- "Value of mode-line-buffer-identification in Emacs mode within vip.")
-(make-variable-buffer-local 'vip-emacs-mode-line-buffer-identification)
-(setq-default vip-emacs-mode-line-buffer-identification
- '("Emacs: %17b"))
-
-(defvar vip-current-major-mode nil
- "vip-current-major-mode is the major-mode vi considers it is now.
-\(buffer specific\)")
-
-(make-variable-buffer-local 'vip-current-major-mode)
-
-(defvar vip-last-shell-com nil
- "Last shell command executed by ! command.")
-
-(defvar vip-use-register nil
- "Name of register to store deleted or yanked strings.")
-
-(defvar vip-d-com nil
- "How to reexecute last destructive command. Value is list (M-COM VAL COM).")
-
-(defcustom vip-shift-width 8
- "The number of columns shifted by > and < command."
- :type 'integer
- :group 'vip)
-
-(defcustom vip-re-replace nil
- "If t then do regexp replace, if nil then do string replace."
- :type 'boolean
- :group 'vip)
-
-(defvar vip-d-char nil
- "The character remembered by the vi \"r\" command.")
-
-(defvar vip-f-char nil
- "For use by \";\" command.")
-
-(defvar vip-F-char nil
- "For use by \".\" command.")
-
-(defvar vip-f-forward nil
- "For use by \";\" command.")
-
-(defvar vip-f-offset nil
- "For use by \";\" command.")
-
-(defcustom vip-search-wrap-around t
- "If t, search wraps around."
- :type 'boolean
- :group 'vip)
-
-(defcustom vip-re-search nil
- "If t, search is reg-exp search, otherwise vanilla search."
- :type 'boolean
- :group 'vip)
-
-(defvar vip-s-string nil
- "Last vip search string.")
-
-(defvar vip-s-forward nil
- "If t, search is forward.")
-
-(defcustom vip-case-fold-search nil
- "If t, search ignores cases."
- :type 'boolean
- :group 'vip)
-
-(defcustom vip-re-query-replace nil
- "If t then do regexp replace, if nil then do string replace."
- :type 'boolean
- :group 'vip)
-
-(defcustom vip-open-with-indent nil
- "If t, indent when open a new line."
- :type 'boolean
- :group 'vip)
-
-(defcustom vip-help-in-insert-mode nil
- "If t then C-h is bound to help-command in insert mode.
-If nil then it is bound to `delete-backward-char'."
- :type 'boolean
- :group 'vip)
-
-(defvar vip-quote-string "> "
- "String inserted at the beginning of region.")
-
-(defvar vip-tags-file-name "TAGS")
-
-(defvar vip-inhibit-startup-message nil)
-
-(defvar vip-startup-file (locate-user-emacs-file "vip" ".vip")
- "Filename used as startup file for vip.")
-
-;; key bindings
-
-(defvar vip-mode-map
- (let ((map (make-keymap)))
- (define-key map "\C-a" 'beginning-of-line)
- (define-key map "\C-b" 'vip-scroll-back)
- (define-key map "\C-c" 'vip-ctl-c)
- (define-key map "\C-d" 'vip-scroll-up)
- (define-key map "\C-e" 'vip-scroll-up-one)
- (define-key map "\C-f" 'vip-scroll)
- (define-key map "\C-g" 'vip-keyboard-quit)
- (define-key map "\C-h" 'help-command)
- (define-key map "\C-m" 'vip-scroll-back)
- (define-key map "\C-n" 'vip-other-window)
- (define-key map "\C-o" 'vip-open-line-at-point)
- (define-key map "\C-u" 'vip-scroll-down)
- (define-key map "\C-x" 'vip-ctl-x)
- (define-key map "\C-y" 'vip-scroll-down-one)
- (define-key map "\C-z" 'vip-change-mode-to-emacs)
- (define-key map "\e" 'vip-ESC)
-
- (define-key map [?\S-\ ] 'vip-scroll-back)
- (define-key map " " 'vip-scroll)
- (define-key map "!" 'vip-command-argument)
- (define-key map "\"" 'vip-command-argument)
- (define-key map "#" 'vip-command-argument)
- (define-key map "$" 'vip-goto-eol)
- (define-key map "%" 'vip-paren-match)
- (define-key map "&" 'vip-nil)
- (define-key map "'" 'vip-goto-mark-and-skip-white)
- (define-key map "(" 'vip-backward-sentence)
- (define-key map ")" 'vip-forward-sentence)
- (define-key map "*" 'call-last-kbd-macro)
- (define-key map "+" 'vip-next-line-at-bol)
- (define-key map "," 'vip-repeat-find-opposite)
- (define-key map "-" 'vip-previous-line-at-bol)
- (define-key map "." 'vip-repeat)
- (define-key map "/" 'vip-search-forward)
-
- (define-key map "0" 'vip-beginning-of-line)
- (define-key map "1" 'vip-digit-argument)
- (define-key map "2" 'vip-digit-argument)
- (define-key map "3" 'vip-digit-argument)
- (define-key map "4" 'vip-digit-argument)
- (define-key map "5" 'vip-digit-argument)
- (define-key map "6" 'vip-digit-argument)
- (define-key map "7" 'vip-digit-argument)
- (define-key map "8" 'vip-digit-argument)
- (define-key map "9" 'vip-digit-argument)
-
- (define-key map ":" 'vip-ex)
- (define-key map ";" 'vip-repeat-find)
- (define-key map "<" 'vip-command-argument)
- (define-key map "=" 'vip-command-argument)
- (define-key map ">" 'vip-command-argument)
- (define-key map "?" 'vip-search-backward)
- (define-key map "@" 'vip-nil)
-
- (define-key map "A" 'vip-Append)
- (define-key map "B" 'vip-backward-Word)
- (define-key map "C" 'vip-ctl-c-equivalent)
- (define-key map "D" 'vip-kill-line)
- (define-key map "E" 'vip-end-of-Word)
- (define-key map "F" 'vip-find-char-backward)
- (define-key map "G" 'vip-goto-line)
- (define-key map "H" 'vip-window-top)
- (define-key map "I" 'vip-Insert)
- (define-key map "J" 'vip-join-lines)
- (define-key map "K" 'vip-kill-buffer)
- (define-key map "L" 'vip-window-bottom)
- (define-key map "M" 'vip-window-middle)
- (define-key map "N" 'vip-search-Next)
- (define-key map "O" 'vip-Open-line)
- (define-key map "P" 'vip-Put-back)
- (define-key map "Q" 'vip-query-replace)
- (define-key map "R" 'vip-replace-string)
- (define-key map "S" 'vip-switch-to-buffer-other-window)
- (define-key map "T" 'vip-goto-char-backward)
- (define-key map "U" 'vip-nil)
- (define-key map "V" 'vip-find-file-other-window)
- (define-key map "W" 'vip-forward-Word)
- (define-key map "X" 'vip-ctl-x-equivalent)
- (define-key map "Y" 'vip-yank-line)
- (define-key map "ZZ" 'save-buffers-kill-emacs)
-
- (define-key map "[" 'vip-nil)
- (define-key map "\\" 'vip-escape-to-emacs)
- (define-key map "]" 'vip-nil)
- (define-key map "^" 'vip-bol-and-skip-white)
- (define-key map "_" 'vip-nil)
- (define-key map "`" 'vip-goto-mark)
-
- (define-key map "a" 'vip-append)
- (define-key map "b" 'vip-backward-word)
- (define-key map "c" 'vip-command-argument)
- (define-key map "d" 'vip-command-argument)
- (define-key map "e" 'vip-end-of-word)
- (define-key map "f" 'vip-find-char-forward)
- (define-key map "g" 'vip-info-on-file)
- (define-key map "h" 'vip-backward-char)
- (define-key map "i" 'vip-insert)
- (define-key map "j" 'vip-next-line)
- (define-key map "k" 'vip-previous-line)
- (define-key map "l" 'vip-forward-char)
- (define-key map "m" 'vip-mark-point)
- (define-key map "n" 'vip-search-next)
- (define-key map "o" 'vip-open-line)
- (define-key map "p" 'vip-put-back)
- (define-key map "q" 'vip-nil)
- (define-key map "r" 'vip-replace-char)
- (define-key map "s" 'vip-switch-to-buffer)
- (define-key map "t" 'vip-goto-char-forward)
- (define-key map "u" 'vip-undo)
- (define-key map "v" 'vip-find-file)
- (define-key map "w" 'vip-forward-word)
- (define-key map "x" 'vip-delete-char)
- (define-key map "y" 'vip-command-argument)
- (define-key map "zH" 'vip-line-to-top)
- (define-key map "zM" 'vip-line-to-middle)
- (define-key map "zL" 'vip-line-to-bottom)
- (define-key map "z\C-m" 'vip-line-to-top)
- (define-key map "z." 'vip-line-to-middle)
- (define-key map "z-" 'vip-line-to-bottom)
-
- (define-key map "{" 'vip-backward-paragraph)
- (define-key map "|" 'vip-goto-col)
- (define-key map "}" 'vip-forward-paragraph)
- (define-key map "~" 'vip-nil)
- (define-key map "\177" 'vip-delete-backward-char)
- map))
-
-(defun vip-version ()
- (interactive)
- (message "VIP version 3.5 of September 15, 1987"))
-
-
-;; basic set up
-
-;;;###autoload
-(defun vip-setup ()
- "Set up bindings for C-x 7 and C-z that are useful for VIP users."
- (define-key ctl-x-map "7" 'vip-buffer-in-two-windows)
- (global-set-key "\C-z" 'vip-change-mode-to-vi))
-
-(defmacro vip-loop (count body)
- "(COUNT BODY) Execute BODY COUNT times."
- `(let ((count ,count))
- (while (> count 0)
- ,body
- (setq count (1- count)))))
-
-(defun vip-push-mark-silent (&optional location)
- "Set mark at LOCATION (point, by default) and push old mark on mark ring.
-No message."
- (if (null (mark t))
- nil
- (setq mark-ring (cons (copy-marker (mark-marker)) mark-ring))
- (if (> (length mark-ring) mark-ring-max)
- (progn
- (move-marker (car (nthcdr mark-ring-max mark-ring)) nil)
- (setcdr (nthcdr (1- mark-ring-max) mark-ring) nil))))
- (set-mark (or location (point))))
-
-(defun vip-goto-col (arg)
- "Go to ARG's column."
- (interactive "P")
- (let ((val (vip-p-val arg))
- (com (vip-getcom arg)))
- (save-excursion
- (end-of-line)
- (if (> val (1+ (current-column))) (error "")))
- (if com (move-marker vip-com-point (point)))
- (beginning-of-line)
- (forward-char (1- val))
- (if com (vip-execute-com 'vip-goto-col val com))))
-
-(defun vip-copy-keymap (map)
- (if (null map) (make-sparse-keymap) (copy-keymap map)))
-
-
-;; changing mode
-
-(defun vip-change-mode (new-mode)
- "Change mode to NEW-MODE---either emacs-mode, vi-mode, or insert-mode."
- (or (eq new-mode vip-current-mode)
- (progn
- (cond ((eq new-mode 'vi-mode)
- (if (eq vip-current-mode 'insert-mode)
- (progn
- (vip-copy-region-as-kill (point) vip-insert-point)
- (vip-repeat-insert-command))
- (setq vip-emacs-local-map (current-local-map)
- vip-emacs-mode-line-buffer-identification
- mode-line-buffer-identification
- vip-insert-local-map (vip-copy-keymap
- (current-local-map))))
- (vip-change-mode-line "Vi: ")
- (use-local-map vip-mode-map))
- ((eq new-mode 'insert-mode)
- (move-marker vip-insert-point (point))
- (if (eq vip-current-mode 'emacs-mode)
- (setq vip-emacs-local-map (current-local-map)
- vip-emacs-mode-line-buffer-identification
- mode-line-buffer-identification
- vip-insert-local-map (vip-copy-keymap
- (current-local-map)))
- (setq vip-insert-local-map (vip-copy-keymap
- vip-emacs-local-map)))
- (vip-change-mode-line "Insert")
- (use-local-map vip-insert-local-map)
- (define-key vip-insert-local-map "\e" 'vip-change-mode-to-vi)
- (define-key vip-insert-local-map "\C-z" 'vip-ESC)
- (define-key vip-insert-local-map "\C-h"
- (if vip-help-in-insert-mode 'help-command
- 'delete-backward-char))
- (define-key vip-insert-local-map "\C-w"
- 'vip-delete-backward-word))
- ((eq new-mode 'emacs-mode)
- (vip-change-mode-line "Emacs:")
- (use-local-map vip-emacs-local-map)))
- (setq vip-current-mode new-mode)
- (force-mode-line-update))))
-
-(defun vip-copy-region-as-kill (beg end)
- "If BEG and END do not belong to the same buffer, it copies empty region."
- (condition-case nil
- (copy-region-as-kill beg end)
- (error (copy-region-as-kill beg beg))))
-
-(defun vip-change-mode-line (string)
- "Assuming that the mode line format contains the string \"Emacs:\", this
-function replaces the string by \"Vi: \" etc."
- (setq mode-line-buffer-identification
- (if (string= string "Emacs:")
- vip-emacs-mode-line-buffer-identification
- (list (concat string " %17b")))))
-
-;;;###autoload
-(defun vip-mode ()
- "Turn on VIP emulation of VI."
- (interactive)
- (if (not vip-inhibit-startup-message)
- (progn
- (switch-to-buffer "VIP Startup Message")
- (erase-buffer)
- (insert
- "VIP is a Vi emulation package for GNU Emacs. VIP provides most Vi commands
-including Ex commands. VIP is however different from Vi in several points.
-You can get more information on VIP by:
- 1. Typing `M-x info' and selecting menu item \"vip\".
- 2. Typing `C-h k' followed by a key whose description you want.
- 3. Printing VIP manual which can be found as GNU/man/vip.texinfo
- 4. Printing VIP Reference Card which can be found as GNU/etc/vipcard.tex
-
-This startup message appears whenever you load VIP unless you type `y' now.
-Type `n' to quit this window for now.\n")
- (goto-char (point-min))
- (if (y-or-n-p "Inhibit VIP startup message? ")
- (progn
- (with-current-buffer
- (find-file-noselect
- (substitute-in-file-name vip-startup-file))
- (goto-char (point-max))
- (insert "\n(setq vip-inhibit-startup-message t)\n")
- (save-buffer)
- (kill-buffer (current-buffer)))
- (message "VIP startup message inhibited.")
- (sit-for 2)))
- (kill-buffer (current-buffer))
- (message "")
- (setq vip-inhibit-startup-message t)))
- (vip-change-mode-to-vi))
-
-(defun vip-change-mode-to-vi ()
- "Change mode to vi mode."
- (interactive)
- (vip-change-mode 'vi-mode))
-
-(defun vip-change-mode-to-insert ()
- "Change mode to insert mode."
- (interactive)
- (vip-change-mode 'insert-mode))
-
-(defun vip-change-mode-to-emacs ()
- "Change mode to Emacs mode."
- (interactive)
- (vip-change-mode 'emacs-mode))
-
-
-;; escape to emacs mode temporarily
-
-(defun vip-escape-to-emacs (arg &optional events)
- "Escape to Emacs mode for one Emacs command.
-ARG is used as the prefix value for the executed command. If
-EVENTS is a list of events, which become the beginning of the command."
- (interactive "P")
- (let (com key (old-map (current-local-map)))
- (if events (setq unread-command-events events))
- (setq prefix-arg arg)
- (use-local-map vip-emacs-local-map)
- (unwind-protect
- (setq com (key-binding (setq key (read-key-sequence nil))))
- (use-local-map old-map))
- (command-execute com prefix-arg)
- (setq prefix-arg nil) ;; reset prefix arg
- ))
-
-(defun vip-message-conditions (conditions)
- "Print CONDITIONS as a message."
- (let ((case (car conditions)) (msg (cdr conditions)))
- (if (null msg)
- (message "%s" case)
- (message "%s %s" case (prin1-to-string msg)))
- (ding)))
-
-(defun vip-ESC (arg)
- "Emulate ESC key in Emacs mode."
- (interactive "P")
- (vip-escape-to-emacs arg '(?\e)))
-
-(defun vip-ctl-c (arg)
- "Emulate C-c key in Emacs mode."
- (interactive "P")
- (vip-escape-to-emacs arg '(?\C-c)))
-
-(defun vip-ctl-x (arg)
- "Emulate C-x key in Emacs mode."
- (interactive "P")
- (vip-escape-to-emacs arg '(?\C-x)))
-
-(defun vip-ctl-h (arg)
- "Emulate C-h key in Emacs mode."
- (interactive "P")
- (vip-escape-to-emacs arg '(?\C-h)))
-
-
-;; prefix argument for vi mode
-
-;; In vi mode, prefix argument is a dotted pair (NUM . COM) where NUM
-;; represents the numeric value of the prefix argument and COM represents
-;; command prefix such as "c", "d", "m" and "y".
-
-(defun vip-prefix-arg-value (char value com)
- "Compute numeric prefix arg value. Invoked by CHAR. VALUE is the value
-obtained so far, and COM is the command part obtained so far."
- (while (and (>= char ?0) (<= char ?9))
- (setq value (+ (* (if (numberp value) value 0) 10) (- char ?0)))
- (setq char (read-char)))
- (setq prefix-arg value)
- (if com (setq prefix-arg (cons prefix-arg com)))
- (while (= char ?U)
- (vip-describe-arg prefix-arg)
- (setq char (read-char)))
- (setq unread-command-events (list char)))
-
-(defun vip-prefix-arg-com (char value com)
- "Vi operator as prefix argument."
- (let ((cont t))
- (while (and cont
- (or (= char ?c) (= char ?d) (= char ?y)
- (= char ?!) (= char ?<) (= char ?>) (= char ?=)
- (= char ?#) (= char ?r) (= char ?R) (= char ?\")))
- (if com
- ;; this means that we already have a command character, so we
- ;; construct a com list and exit while. however, if char is "
- ;; it is an error.
- (progn
- ;; new com is (CHAR . OLDCOM)
- (if (or (= char ?#) (= char ?\")) (error ""))
- (setq com (cons char com))
- (setq cont nil))
- ;; if com is nil we set com as char, and read more. again, if char
- ;; is ", we read the name of register and store it in vip-use-register.
- ;; if char is !, =, or #, a complete com is formed so we exit while.
- (cond ((or (= char ?!) (= char ?=))
- (setq com char)
- (setq char (read-char))
- (setq cont nil))
- ((= char ?#)
- ;; read a char and encode it as com
- (setq com (+ 128 (read-char)))
- (setq char (read-char))
- (setq cont nil))
- ((or (= char ?<) (= char ?>))
- (setq com char)
- (setq char (read-char))
- (if (= com char) (setq com (cons char com)))
- (setq cont nil))
- ((= char ?\")
- (let ((reg (read-char)))
- (if (or (and (<= ?A reg) (<= reg ?z))
- (and (<= ?1 reg) (<= reg ?9)))
- (setq vip-use-register reg)
- (error ""))
- (setq char (read-char))))
- (t
- (setq com char)
- (setq char (read-char)))))))
- (if (atom com)
- ;; com is a single char, so we construct prefix-arg
- ;; and if char is ?, describe prefix arg, otherwise exit by
- ;; pushing the char back
- (progn
- (setq prefix-arg (cons value com))
- (while (= char ?U)
- (vip-describe-arg prefix-arg)
- (setq char (read-char)))
- (setq unread-command-events (list char)))
- ;; as com is non-nil, this means that we have a command to execute
- (if (or (= (car com) ?r) (= (car com) ?R))
- ;; execute appropriate region command.
- (let ((char (car com)) (com (cdr com)))
- (setq prefix-arg (cons value com))
- (if (= char ?r) (vip-region prefix-arg)
- (vip-Region prefix-arg))
- ;; reset prefix-arg
- (setq prefix-arg nil))
- ;; otherwise, reset prefix arg and call appropriate command
- (setq value (if (null value) 1 value))
- (setq prefix-arg nil)
- (cond ((equal com '(?c . ?c)) (vip-line (cons value ?C)))
- ((equal com '(?d . ?d)) (vip-line (cons value ?D)))
- ((equal com '(?d . ?y)) (vip-yank-defun))
- ((equal com '(?y . ?y)) (vip-line (cons value ?Y)))
- ((equal com '(?< . ?<)) (vip-line (cons value ?<)))
- ((equal com '(?> . ?>)) (vip-line (cons value ?>)))
- ((equal com '(?! . ?!)) (vip-line (cons value ?!)))
- ((equal com '(?= . ?=)) (vip-line (cons value ?=)))
- (t (error ""))))))
-
-(defun vip-describe-arg (arg)
- (let (val com)
- (setq val (vip-P-val arg)
- com (vip-getcom arg))
- (if (null val)
- (if (null com)
- (message "Value is nil, and command is nil.")
- (message "Value is nil, and command is %c." com))
- (if (null com)
- (message "Value is %d, and command is nil." val)
- (message "Value is %d, and command is %c." val com)))))
-
-(defun vip-digit-argument (arg)
- "Begin numeric argument for the next command."
- (interactive "P")
- (vip-prefix-arg-value last-command-event nil
- (if (consp arg) (cdr arg) nil)))
-
-(defun vip-command-argument (arg)
- "Accept a motion command as an argument."
- (interactive "P")
- (condition-case conditions
- (vip-prefix-arg-com
- last-command-event
- (cond ((null arg) nil)
- ((consp arg) (car arg))
- ((numberp arg) arg)
- (t (error "strange arg")))
- (cond ((null arg) nil)
- ((consp arg) (cdr arg))
- ((numberp arg) nil)
- (t (error "strange arg"))))
- (quit
- (setq vip-use-register nil)
- (signal 'quit nil))))
-
-(defun vip-p-val (arg)
- "Get value part of prefix-argument ARG."
- (cond ((null arg) 1)
- ((consp arg) (if (null (car arg)) 1 (car arg)))
- (t arg)))
-
-(defun vip-P-val (arg)
- "Get value part of prefix-argument ARG."
- (cond ((consp arg) (car arg))
- (t arg)))
-
-(defun vip-getcom (arg)
- "Get com part of prefix-argument ARG."
- (cond ((null arg) nil)
- ((consp arg) (cdr arg))
- (t nil)))
-
-(defun vip-getCom (arg)
- "Get com part of prefix-argument ARG and modify it."
- (let ((com (vip-getcom arg)))
- (cond ((equal com ?c) ?C)
- ((equal com ?d) ?D)
- ((equal com ?y) ?Y)
- (t com))))
-
-
-;; repeat last destructive command
-
-(defun vip-append-to-register (reg start end)
- "Append region to text in register REG.
-START and END are buffer positions indicating what to append."
- (set-register reg (concat (or (get-register reg) "")
- (buffer-substring start end))))
-
-(defun vip-execute-com (m-com val com)
- "(M-COM VAL COM) Execute command COM. The list (M-COM VAL COM) is set
-to vip-d-com for later use by vip-repeat"
- (let ((reg vip-use-register))
- (if com
- (cond ((= com ?c) (vip-change vip-com-point (point)))
- ((= com (- ?c)) (vip-change-subr vip-com-point (point)))
- ((or (= com ?C) (= com (- ?C)))
- (save-excursion
- (set-mark vip-com-point)
- (vip-enlarge-region (mark) (point))
- (if vip-use-register
- (progn
- (cond ((and (<= ?a vip-use-register)
- (<= vip-use-register ?z))
- (copy-to-register
- vip-use-register (mark) (point) nil))
- ((and (<= ?A vip-use-register)
- (<= vip-use-register ?Z))
- (vip-append-to-register
- (+ vip-use-register 32) (mark) (point)))
- (t (setq vip-use-register nil)
- (error "")))
- (setq vip-use-register nil)))
- (delete-region (mark) (point)))
- (open-line 1)
- (if (= com ?C) (vip-change-mode-to-insert) (yank)))
- ((= com ?d)
- (if vip-use-register
- (progn
- (cond ((and (<= ?a vip-use-register)
- (<= vip-use-register ?z))
- (copy-to-register
- vip-use-register vip-com-point (point) nil))
- ((and (<= ?A vip-use-register)
- (<= vip-use-register ?Z))
- (vip-append-to-register
- (+ vip-use-register 32) vip-com-point (point)))
- (t (setq vip-use-register nil)
- (error "")))
- (setq vip-use-register nil)))
- (setq last-command
- (if (eq last-command 'd-command) 'kill-region nil))
- (kill-region vip-com-point (point))
- (setq this-command 'd-command))
- ((= com ?D)
- (save-excursion
- (set-mark vip-com-point)
- (vip-enlarge-region (mark) (point))
- (if vip-use-register
- (progn
- (cond ((and (<= ?a vip-use-register)
- (<= vip-use-register ?z))
- (copy-to-register
- vip-use-register (mark) (point) nil))
- ((and (<= ?A vip-use-register)
- (<= vip-use-register ?Z))
- (vip-append-to-register
- (+ vip-use-register 32) (mark) (point)))
- (t (setq vip-use-register nil)
- (error "")))
- (setq vip-use-register nil)))
- (setq last-command
- (if (eq last-command 'D-command) 'kill-region nil))
- (kill-region (mark) (point))
- (if (eq m-com 'vip-line) (setq this-command 'D-command)))
- (back-to-indentation))
- ((= com ?y)
- (if vip-use-register
- (progn
- (cond ((and (<= ?a vip-use-register)
- (<= vip-use-register ?z))
- (copy-to-register
- vip-use-register vip-com-point (point) nil))
- ((and (<= ?A vip-use-register)
- (<= vip-use-register ?Z))
- (vip-append-to-register
- (+ vip-use-register 32) vip-com-point (point)))
- (t (setq vip-use-register nil)
- (error "")))
- (setq vip-use-register nil)))
- (setq last-command nil)
- (copy-region-as-kill vip-com-point (point))
- (goto-char vip-com-point))
- ((= com ?Y)
- (save-excursion
- (set-mark vip-com-point)
- (vip-enlarge-region (mark) (point))
- (if vip-use-register
- (progn
- (cond ((and (<= ?a vip-use-register)
- (<= vip-use-register ?z))
- (copy-to-register
- vip-use-register (mark) (point) nil))
- ((and (<= ?A vip-use-register)
- (<= vip-use-register ?Z))
- (vip-append-to-register
- (+ vip-use-register 32) (mark) (point)))
- (t (setq vip-use-register nil)
- (error "")))
- (setq vip-use-register nil)))
- (setq last-command nil)
- (copy-region-as-kill (mark) (point)))
- (goto-char vip-com-point))
- ((or (= com ?!) (= com (- ?!)))
- (save-excursion
- (set-mark vip-com-point)
- (vip-enlarge-region (mark) (point))
- (shell-command-on-region
- (mark) (point)
- (if (= com ?!)
- (setq vip-last-shell-com (vip-read-string "!"))
- vip-last-shell-com)
- t t)))
- ((= com ?=)
- (save-excursion
- (set-mark vip-com-point)
- (vip-enlarge-region (mark) (point))
- (if (> (mark) (point)) (exchange-point-and-mark))
- (indent-region (mark) (point) nil)))
- ((= com ?<)
- (save-excursion
- (set-mark vip-com-point)
- (vip-enlarge-region (mark) (point))
- (indent-rigidly (mark) (point) (- vip-shift-width)))
- (goto-char vip-com-point))
- ((= com ?>)
- (save-excursion
- (set-mark vip-com-point)
- (vip-enlarge-region (mark) (point))
- (indent-rigidly (mark) (point) vip-shift-width))
- (goto-char vip-com-point))
- ((>= com 128)
- ;; this is special command #
- (vip-special-prefix-com (- com 128)))))
- (setq vip-d-com (list m-com val (if (or (= com ?c) (= com ?C) (= com ?!))
- (- com) com)
- reg))))
-
-(defun vip-repeat (arg)
- "(ARG) Re-execute last destructive command. vip-d-com has the form
-\(COM ARG CH REG), where COM is the command to be re-executed, ARG is the
-argument for COM, CH is a flag for repeat, and REG is optional and if exists
-is the name of the register for COM."
- (interactive "P")
- (if (eq last-command 'vip-undo)
- ;; if the last command was vip-undo, then undo-more
- (vip-undo-more)
- ;; otherwise execute the command stored in vip-d-com. if arg is non-nil
- ;; its prefix value is used as new prefix value for the command.
- (let ((m-com (car vip-d-com))
- (val (vip-P-val arg))
- (com (car (cdr (cdr vip-d-com))))
- (reg (nth 3 vip-d-com)))
- (if (null val) (setq val (car (cdr vip-d-com))))
- (if (null m-com) (error "No previous command to repeat"))
- (setq vip-use-register reg)
- (funcall m-com (cons val com)))))
-
-(defun vip-special-prefix-com (char)
- "This command is invoked interactively by the key sequence #<char>"
- (cond ((= char ?c)
- (downcase-region (min vip-com-point (point))
- (max vip-com-point (point))))
- ((= char ?C)
- (upcase-region (min vip-com-point (point))
- (max vip-com-point (point))))
- ((= char ?g)
- (set-mark vip-com-point)
- (vip-global-execute))
- ((= char ?q)
- (set-mark vip-com-point)
- (vip-quote-region))
- ((= char ?s) (ispell-region vip-com-point (point)))))
-
-
-;; undoing
-
-(defun vip-undo ()
- "Undo previous change."
- (interactive)
- (message "undo!")
- (undo-start)
- (undo-more 2)
- (setq this-command 'vip-undo))
-
-(defun vip-undo-more ()
- "Continue undoing previous changes."
- (message "undo more!")
- (undo-more 1)
- (setq this-command 'vip-undo))
-
-
-;; utilities
-
-(defun vip-string-tail (str)
- (if (or (null str) (string= str "")) nil
- (substring str 1)))
-
-(defun vip-yank-defun ()
- (mark-defun)
- (copy-region-as-kill (point) (mark)))
-
-(defun vip-enlarge-region (beg end)
- "Enlarge region between BEG and END."
- (if (< beg end)
- (progn (goto-char beg) (set-mark end))
- (goto-char end)
- (set-mark beg))
- (beginning-of-line)
- (exchange-point-and-mark)
- (if (or (not (eobp)) (not (bolp))) (with-no-warnings (next-line 1)))
- (beginning-of-line)
- (if (> beg end) (exchange-point-and-mark)))
-
-(defun vip-global-execute ()
- "Call last keyboard macro for each line in the region."
- (if (> (point) (mark)) (exchange-point-and-mark))
- (beginning-of-line)
- (call-last-kbd-macro)
- (while (< (point) (mark))
- (forward-line 1)
- (beginning-of-line)
- (call-last-kbd-macro)))
-
-(defun vip-quote-region ()
- "Quote region by inserting the user supplied string at the beginning of
-each line in the region."
- (setq vip-quote-string
- (let ((str
- (vip-read-string (format "quote string (default %s): "
- vip-quote-string))))
- (if (string= str "") vip-quote-string str)))
- (vip-enlarge-region (point) (mark))
- (if (> (point) (mark)) (exchange-point-and-mark))
- (insert vip-quote-string)
- (beginning-of-line)
- (forward-line 1)
- (while (and (< (point) (mark)) (bolp))
- (insert vip-quote-string)
- (beginning-of-line)
- (forward-line 1)))
-
-(defun vip-end-with-a-newline-p (string)
- "Check if the string ends with a newline."
- (or (string= string "")
- (= (aref string (1- (length string))) ?\n)))
-
-(defvar vip-save-minibuffer-local-map)
-
-(defun vip-read-string (prompt &optional init)
- (setq vip-save-minibuffer-local-map (copy-keymap minibuffer-local-map))
- (define-key minibuffer-local-map "\C-h" 'backward-char)
- (define-key minibuffer-local-map "\C-w" 'backward-word)
- (define-key minibuffer-local-map "\e" 'exit-minibuffer)
- (let (str)
- (condition-case conditions
- (setq str (read-string prompt init))
- (quit
- (setq minibuffer-local-map vip-save-minibuffer-local-map)
- (signal 'quit nil)))
- (setq minibuffer-local-map vip-save-minibuffer-local-map)
- str))
-
-
-;; insertion commands
-
-(defun vip-repeat-insert-command ()
- "This function is called when mode changes from insertion mode to
-vi command mode. It will repeat the insertion command if original insertion
-command was invoked with argument > 1."
- (let ((i-com (car vip-d-com)) (val (car (cdr vip-d-com))))
- (if (and val (> val 1)) ;; first check that val is non-nil
- (progn
- (setq vip-d-com (list i-com (1- val) ?r))
- (vip-repeat nil)
- (setq vip-d-com (list i-com val ?r))))))
-
-(defun vip-insert (arg) ""
- (interactive "P")
- (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
- (setq vip-d-com (list 'vip-insert val ?r))
- (if com (vip-loop val (yank))
- (vip-change-mode-to-insert))))
-
-(defun vip-append (arg)
- "Append after point."
- (interactive "P")
- (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
- (setq vip-d-com (list 'vip-append val ?r))
- (if (not (eolp)) (forward-char))
- (if (equal com ?r)
- (vip-loop val (yank))
- (vip-change-mode-to-insert))))
-
-(defun vip-Append (arg)
- "Append at end of line."
- (interactive "P")
- (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
- (setq vip-d-com (list 'vip-Append val ?r))
- (end-of-line)
- (if (equal com ?r)
- (vip-loop val (yank))
- (vip-change-mode-to-insert))))
-
-(defun vip-Insert (arg)
- "Insert before first non-white."
- (interactive "P")
- (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
- (setq vip-d-com (list 'vip-Insert val ?r))
- (back-to-indentation)
- (if (equal com ?r)
- (vip-loop val (yank))
- (vip-change-mode-to-insert))))
-
-(defun vip-open-line (arg)
- "Open line below."
- (interactive "P")
- (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
- (setq vip-d-com (list 'vip-open-line val ?r))
- (let ((col (current-indentation)))
- (if (equal com ?r)
- (vip-loop val
- (progn
- (end-of-line)
- (newline 1)
- (if vip-open-with-indent (indent-to col))
- (yank)))
- (end-of-line)
- (newline 1)
- (if vip-open-with-indent (indent-to col))
- (vip-change-mode-to-insert)))))
-
-(defun vip-Open-line (arg)
- "Open line above."
- (interactive "P")
- (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
- (setq vip-d-com (list 'vip-Open-line val ?r))
- (let ((col (current-indentation)))
- (if (equal com ?r)
- (vip-loop val
- (progn
- (beginning-of-line)
- (open-line 1)
- (if vip-open-with-indent (indent-to col))
- (yank)))
- (beginning-of-line)
- (open-line 1)
- (if vip-open-with-indent (indent-to col))
- (vip-change-mode-to-insert)))))
-
-(defun vip-open-line-at-point (arg)
- "Open line at point."
- (interactive "P")
- (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
- (setq vip-d-com (list 'vip-open-line-at-point val ?r))
- (if (equal com ?r)
- (vip-loop val
- (progn
- (open-line 1)
- (yank)))
- (open-line 1)
- (vip-change-mode-to-insert))))
-
-(defun vip-substitute (arg)
- "Substitute characters."
- (interactive "P")
- (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
- (save-excursion
- (set-mark (point))
- (forward-char val)
- (if (equal com ?r)
- (vip-change-subr (mark) (point))
- (vip-change (mark) (point))))
- (setq vip-d-com (list 'vip-substitute val ?r))))
-
-(defun vip-substitute-line (arg)
- "Substitute lines."
- (interactive "p")
- (vip-line (cons arg ?C)))
-
-
-;; line command
-
-(defun vip-line (arg)
- (let ((val (car arg)) (com (cdr arg)))
- (move-marker vip-com-point (point))
- (with-no-warnings (next-line (1- val)))
- (vip-execute-com 'vip-line val com)))
-
-(defun vip-yank-line (arg)
- "Yank ARG lines (in vi's sense)"
- (interactive "P")
- (let ((val (vip-p-val arg)))
- (vip-line (cons val ?Y))))
-
-
-;; region command
-
-(defun vip-region (arg)
- (interactive "P")
- (let ((val (vip-P-val arg))
- (com (vip-getcom arg)))
- (move-marker vip-com-point (point))
- (exchange-point-and-mark)
- (vip-execute-com 'vip-region val com)))
-
-(defun vip-Region (arg)
- (interactive "P")
- (let ((val (vip-P-val arg))
- (com (vip-getCom arg)))
- (move-marker vip-com-point (point))
- (exchange-point-and-mark)
- (vip-execute-com 'vip-Region val com)))
-
-(defun vip-replace-char (arg)
- "Replace the following ARG chars by the character read."
- (interactive "P")
- (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
- (setq vip-d-com (list 'vip-replace-char val ?r))
- (vip-replace-char-subr (if (equal com ?r) vip-d-char (read-char)) val)))
-
-(defun vip-replace-char-subr (char arg)
- (delete-char arg t)
- (setq vip-d-char char)
- (vip-loop (if (> arg 0) arg (- arg)) (insert char))
- (backward-char arg))
-
-(defun vip-replace-string ()
- "Replace string. If you supply null string as the string to be replaced,
-the query replace mode will toggle between string replace and regexp replace."
- (interactive)
- (let (str)
- (setq str (vip-read-string
- (if vip-re-replace "Replace regexp: " "Replace string: ")))
- (if (string= str "")
- (progn
- (setq vip-re-replace (not vip-re-replace))
- (message "Replace mode changed to %s."
- (if vip-re-replace "regexp replace"
- "string replace")))
- (if vip-re-replace
- ;; (replace-regexp
- ;; str
- ;; (vip-read-string (format "Replace regexp \"%s\" with: " str)))
- (while (re-search-forward str nil t)
- (replace-match (vip-read-string
- (format "Replace regexp \"%s\" with: " str))
- nil nil))
- (with-no-warnings
- (replace-string
- str
- (vip-read-string (format "Replace \"%s\" with: " str))))))))
-
-
-;; basic cursor movement. j, k, l, m commands.
-
-(defun vip-forward-char (arg)
- "Move point right ARG characters (left if ARG negative).On reaching end
-of buffer, stop and signal error."
- (interactive "P")
- (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
- (if com (move-marker vip-com-point (point)))
- (forward-char val)
- (if com (vip-execute-com 'vip-forward-char val com))))
-
-(defun vip-backward-char (arg)
- "Move point left ARG characters (right if ARG negative). On reaching
-beginning of buffer, stop and signal error."
- (interactive "P")
- (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
- (if com (move-marker vip-com-point (point)))
- (backward-char val)
- (if com (vip-execute-com 'vip-backward-char val com))))
-
-
-;; word command
-
-(defun vip-forward-word (arg)
- "Forward word."
- (interactive "P")
- (let ((val (vip-p-val arg))
- (com (vip-getcom arg)))
- (if com (move-marker vip-com-point (point)))
- (forward-word val)
- (skip-chars-forward " \t\n")
- (if com
- (progn
- (if (or (= com ?c) (= com (- ?c)))
- (progn (backward-word 1) (forward-word 1)))
- (if (or (= com ?d) (= com ?y))
- (progn
- (backward-word 1)
- (forward-word 1)
- (skip-chars-forward " \t")))
- (vip-execute-com 'vip-forward-word val com)))))
-
-(defun vip-end-of-word (arg)
- "Move point to end of current word."
- (interactive "P")
- (let ((val (vip-p-val arg))
- (com (vip-getcom arg)))
- (if com (move-marker vip-com-point (point)))
- (forward-char)
- (forward-word val)
- (backward-char)
- (if com
- (progn
- (forward-char)
- (vip-execute-com 'vip-end-of-word val com)))))
-
-(defun vip-backward-word (arg)
- "Backward word."
- (interactive "P")
- (let ((val (vip-p-val arg))
- (com (vip-getcom arg)))
- (if com (move-marker vip-com-point (point)))
- (backward-word val)
- (if com (vip-execute-com 'vip-backward-word val com))))
-
-(defun vip-forward-Word (arg)
- "Forward word delimited by white character."
- (interactive "P")
- (let ((val (vip-p-val arg))
- (com (vip-getcom arg)))
- (if com (move-marker vip-com-point (point)))
- (re-search-forward "[^ \t\n]*[ \t\n]+" nil t val)
- (if com
- (progn
- (if (or (= com ?c) (= com (- ?c)))
- (progn (backward-word 1) (forward-word 1)))
- (if (or (= com ?d) (= com ?y))
- (progn
- (backward-word 1)
- (forward-word 1)
- (skip-chars-forward " \t")))
- (vip-execute-com 'vip-forward-Word val com)))))
-
-(defun vip-end-of-Word (arg)
- "Move forward to end of word delimited by white character."
- (interactive "P")
- (let ((val (vip-p-val arg))
- (com (vip-getcom arg)))
- (if com (move-marker vip-com-point (point)))
- (forward-char)
- (if (re-search-forward "[^ \t\n]+" nil t val) (backward-char))
- (if com
- (progn
- (forward-char)
- (vip-execute-com 'vip-end-of-Word val com)))))
-
-(defun vip-backward-Word (arg)
- "Backward word delimited by white character."
- (interactive "P")
- (let ((val (vip-p-val arg))
- (com (vip-getcom arg)))
- (if com (move-marker vip-com-point (point)))
- (if (re-search-backward "[ \t\n]+[^ \t\n]+" nil t val)
- (forward-char)
- (goto-char (point-min)))
- (if com (vip-execute-com 'vip-backward-Word val com))))
-
-(defun vip-beginning-of-line (arg)
- "Go to beginning of line."
- (interactive "P")
- (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
- (if com (move-marker vip-com-point (point)))
- (beginning-of-line val)
- (if com (vip-execute-com 'vip-beginning-of-line val com))))
-
-(defun vip-bol-and-skip-white (arg)
- "Beginning of line at first non-white character."
- (interactive "P")
- (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
- (if com (move-marker vip-com-point (point)))
- (back-to-indentation)
- (if com (vip-execute-com 'vip-bol-and-skip-white val com))))
-
-(defun vip-goto-eol (arg)
- "Go to end of line."
- (interactive "P")
- (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
- (if com (move-marker vip-com-point (point)))
- (end-of-line val)
- (if com (vip-execute-com 'vip-goto-eol val com))))
-
-(defun vip-next-line (arg)
- "Go to next line."
- (interactive "P")
- (let ((val (vip-p-val arg)) (com (vip-getCom arg)))
- (if com (move-marker vip-com-point (point)))
- (line-move val)
- (setq this-command 'next-line)
- (if com (vip-execute-com 'vip-next-line val com))))
-
-(defun vip-next-line-at-bol (arg)
- "Next line at beginning of line."
- (interactive "P")
- (let ((val (vip-p-val arg)) (com (vip-getCom arg)))
- (if com (move-marker vip-com-point (point)))
- (with-no-warnings (next-line val))
- (back-to-indentation)
- (if com (vip-execute-com 'vip-next-line-at-bol val com))))
-
-(defun vip-previous-line (arg)
- "Go to previous line."
- (interactive "P")
- (let ((val (vip-p-val arg)) (com (vip-getCom arg)))
- (if com (move-marker vip-com-point (point)))
- (with-no-warnings (next-line (- val)))
- (setq this-command 'previous-line)
- (if com (vip-execute-com 'vip-previous-line val com))))
-
-(defun vip-previous-line-at-bol (arg)
- "Previous line at beginning of line."
- (interactive "P")
- (let ((val (vip-p-val arg)) (com (vip-getCom arg)))
- (if com (move-marker vip-com-point (point)))
- (with-no-warnings (next-line (- val)))
- (back-to-indentation)
- (if com (vip-execute-com 'vip-previous-line val com))))
-
-(defun vip-change-to-eol (arg)
- "Change to end of line."
- (interactive "P")
- (vip-goto-eol (cons arg ?c)))
-
-(defun vip-kill-line (arg)
- "Delete line."
- (interactive "P")
- (vip-goto-eol (cons arg ?d)))
-
-
-;; moving around
-
-(defun vip-goto-line (arg)
- "Go to ARG's line. Without ARG go to end of buffer."
- (interactive "P")
- (let ((val (vip-P-val arg)) (com (vip-getCom arg)))
- (move-marker vip-com-point (point))
- (set-mark (point))
- (if (null val)
- (goto-char (point-max))
- (goto-char (point-min))
- (forward-line (1- val)))
- (back-to-indentation)
- (if com (vip-execute-com 'vip-goto-line val com))))
-
-(defun vip-find-char (arg char forward offset)
- "Find ARG's occurrence of CHAR on the current line. If FORWARD then
-search is forward, otherwise backward. OFFSET is used to adjust point
-after search."
- (let ((arg (if forward arg (- arg))) point)
- (save-excursion
- (save-restriction
- (if (> arg 0)
- (narrow-to-region
- ;; forward search begins here
- (if (eolp) (error "") (point))
- ;; forward search ends here
- (progn (with-no-warnings (next-line 1)) (beginning-of-line) (point)))
- (narrow-to-region
- ;; backward search begins from here
- (if (bolp) (error "") (point))
- ;; backward search ends here
- (progn (beginning-of-line) (point))))
- ;; if arg > 0, point is forwarded before search.
- (if (> arg 0) (goto-char (1+ (point-min)))
- (goto-char (point-max)))
- (let ((case-fold-search nil))
- (search-forward (char-to-string char) nil 0 arg))
- (setq point (point))
- (if (or (and (> arg 0) (= point (point-max)))
- (and (< arg 0) (= point (point-min))))
- (error ""))))
- (goto-char (+ point (if (> arg 0) (if offset -2 -1) (if offset 1 0))))))
-
-(defun vip-find-char-forward (arg)
- "Find char on the line. If called interactively read the char to find
-from the terminal, and if called from vip-repeat, the char last used is
-used. This behavior is controlled by the sign of prefix numeric value."
- (interactive "P")
- (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
- (if (> val 0)
- ;; this means that the function was called interactively
- (setq vip-f-char (read-char)
- vip-f-forward t
- vip-f-offset nil)
- (setq val (- val)))
- (if com (move-marker vip-com-point (point)))
- (vip-find-char val (if (> (vip-p-val arg) 0) vip-f-char vip-F-char) t nil)
- (setq val (- val))
- (if com
- (progn
- (setq vip-F-char vip-f-char);; set new vip-F-char
- (forward-char)
- (vip-execute-com 'vip-find-char-forward val com)))))
-
-(defun vip-goto-char-forward (arg)
- "Go up to char ARG forward on line."
- (interactive "P")
- (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
- (if (> val 0)
- ;; this means that the function was called interactively
- (setq vip-f-char (read-char)
- vip-f-forward t
- vip-f-offset t)
- (setq val (- val)))
- (if com (move-marker vip-com-point (point)))
- (vip-find-char val (if (> (vip-p-val arg) 0) vip-f-char vip-F-char) t t)
- (setq val (- val))
- (if com
- (progn
- (setq vip-F-char vip-f-char);; set new vip-F-char
- (forward-char)
- (vip-execute-com 'vip-goto-char-forward val com)))))
-
-(defun vip-find-char-backward (arg)
- "Find char ARG on line backward."
- (interactive "P")
- (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
- (if (> val 0)
- ;; this means that the function was called interactively
- (setq vip-f-char (read-char)
- vip-f-forward nil
- vip-f-offset nil)
- (setq val (- val)))
- (if com (move-marker vip-com-point (point)))
- (vip-find-char
- val (if (> (vip-p-val arg) 0) vip-f-char vip-F-char) nil nil)
- (setq val (- val))
- (if com
- (progn
- (setq vip-F-char vip-f-char);; set new vip-F-char
- (vip-execute-com 'vip-find-char-backward val com)))))
-
-(defun vip-goto-char-backward (arg)
- "Go up to char ARG backward on line."
- (interactive "P")
- (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
- (if (> val 0)
- ;; this means that the function was called interactively
- (setq vip-f-char (read-char)
- vip-f-forward nil
- vip-f-offset t)
- (setq val (- val)))
- (if com (move-marker vip-com-point (point)))
- (vip-find-char val (if (> (vip-p-val arg) 0) vip-f-char vip-F-char) nil t)
- (setq val (- val))
- (if com
- (progn
- (setq vip-F-char vip-f-char);; set new vip-F-char
- (vip-execute-com 'vip-goto-char-backward val com)))))
-
-(defun vip-repeat-find (arg)
- "Repeat previous find command."
- (interactive "P")
- (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
- (if com (move-marker vip-com-point (point)))
- (vip-find-char val vip-f-char vip-f-forward vip-f-offset)
- (if com
- (progn
- (if vip-f-forward (forward-char))
- (vip-execute-com 'vip-repeat-find val com)))))
-
-(defun vip-repeat-find-opposite (arg)
- "Repeat previous find command in the opposite direction."
- (interactive "P")
- (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
- (if com (move-marker vip-com-point (point)))
- (vip-find-char val vip-f-char (not vip-f-forward) vip-f-offset)
- (if com
- (progn
- (if vip-f-forward (forward-char))
- (vip-execute-com 'vip-repeat-find-opposite val com)))))
-
-
-;; window scrolling etc.
-
-(defun vip-other-window (arg)
- "Switch to other window."
- (interactive "p")
- (other-window arg)
- (or (not (eq vip-current-mode 'emacs-mode))
- (string= (buffer-name (current-buffer)) " *Minibuf-1*")
- (vip-change-mode-to-vi)))
-
-(defun vip-window-top (arg)
- "Go to home window line."
- (interactive "P")
- (let ((val (vip-p-val arg))
- (com (vip-getCom arg)))
- (if com (move-marker vip-com-point (point)))
- (move-to-window-line (1- val))
- (if com (vip-execute-com 'vip-window-top val com))))
-
-(defun vip-window-middle (arg)
- "Go to middle window line."
- (interactive "P")
- (let ((val (vip-p-val arg))
- (com (vip-getCom arg)))
- (if com (move-marker vip-com-point (point)))
- (move-to-window-line (+ (/ (1- (window-height)) 2) (1- val)))
- (if com (vip-execute-com 'vip-window-middle val com))))
-
-(defun vip-window-bottom (arg)
- "Go to last window line."
- (interactive "P")
- (let ((val (vip-p-val arg))
- (com (vip-getCom arg)))
- (if com (move-marker vip-com-point (point)))
- (move-to-window-line (- val))
- (if com (vip-execute-com 'vip-window-bottom val com))))
-
-(defun vip-line-to-top (arg)
- "Put current line on the home line."
- (interactive "p")
- (recenter (1- arg)))
-
-(defun vip-line-to-middle (arg)
- "Put current line on the middle line."
- (interactive "p")
- (recenter (+ (1- arg) (/ (1- (window-height)) 2))))
-
-(defun vip-line-to-bottom (arg)
- "Put current line on the last line."
- (interactive "p")
- (recenter (- (window-height) (1+ arg))))
-
-
-;; paren match
-
-(defun vip-paren-match (arg)
- "Go to the matching parenthesis."
- (interactive "P")
- (let ((com (vip-getcom arg)))
- (if (numberp arg)
- (if (or (> arg 99) (< arg 1))
- (error "Prefix must be between 1 and 99")
- (goto-char
- (if (> (point-max) 80000)
- (* (/ (point-max) 100) arg)
- (/ (* (point-max) arg) 100)))
- (back-to-indentation))
- (cond ((looking-at "[\(\[{]")
- (if com (move-marker vip-com-point (point)))
- (forward-sexp 1)
- (if com
- (vip-execute-com 'vip-paren-match nil com)
- (backward-char)))
- ((looking-at "[])}]")
- (forward-char)
- (if com (move-marker vip-com-point (point)))
- (backward-sexp 1)
- (if com (vip-execute-com 'vip-paren-match nil com)))
- (t (error ""))))))
-
-
-;; sentence and paragraph
-
-(defun vip-forward-sentence (arg)
- "Forward sentence."
- (interactive "P")
- (let ((val (vip-p-val arg))
- (com (vip-getcom arg)))
- (if com (move-marker vip-com-point (point)))
- (forward-sentence val)
- (if com (vip-execute-com 'vip-forward-sentence nil com))))
-
-(defun vip-backward-sentence (arg)
- "Backward sentence."
- (interactive "P")
- (let ((val (vip-p-val arg))
- (com (vip-getcom arg)))
- (if com (move-marker vip-com-point (point)))
- (backward-sentence val)
- (if com (vip-execute-com 'vip-backward-sentence nil com))))
-
-(defun vip-forward-paragraph (arg)
- "Forward paragraph."
- (interactive "P")
- (let ((val (vip-p-val arg))
- (com (vip-getCom arg)))
- (if com (move-marker vip-com-point (point)))
- (forward-paragraph val)
- (if com (vip-execute-com 'vip-forward-paragraph nil com))))
-
-(defun vip-backward-paragraph (arg)
- "Backward paragraph."
- (interactive "P")
- (let ((val (vip-p-val arg))
- (com (vip-getCom arg)))
- (if com (move-marker vip-com-point (point)))
- (backward-paragraph val)
- (if com (vip-execute-com 'vip-backward-paragraph nil com))))
-
-
-;; scrolling
-
-(defun vip-scroll (arg)
- "Scroll to next screen."
- (interactive "p")
- (if (> arg 0)
- (while (> arg 0)
- (scroll-up)
- (setq arg (1- arg)))
- (while (> 0 arg)
- (scroll-down)
- (setq arg (1+ arg)))))
-
-(defun vip-scroll-back (arg)
- "Scroll to previous screen."
- (interactive "p")
- (vip-scroll (- arg)))
-
-(defun vip-scroll-down (arg)
- "Scroll up half screen."
- (interactive "P")
- (if (null arg) (scroll-down (/ (window-height) 2))
- (scroll-down arg)))
-
-(defun vip-scroll-down-one (arg)
- "Scroll up one line."
- (interactive "p")
- (scroll-down arg))
-
-(defun vip-scroll-up (arg)
- "Scroll down half screen."
- (interactive "P")
- (if (null arg) (scroll-up (/ (window-height) 2))
- (scroll-up arg)))
-
-(defun vip-scroll-up-one (arg)
- "Scroll down one line."
- (interactive "p")
- (scroll-up arg))
-
-
-;; splitting window
-
-(defun vip-buffer-in-two-windows ()
- "Show current buffer in two windows."
- (interactive)
- (delete-other-windows)
- (split-window-below))
-
-
-;; searching
-
-(defun vip-search-forward (arg)
- "Search a string forward. ARG is used to find the ARG's occurrence
-of the string. Default is vanilla search. Search mode can be toggled by
-giving null search string."
- (interactive "P")
- (let ((val (vip-P-val arg)) (com (vip-getcom arg)))
- (setq vip-s-forward t
- vip-s-string (vip-read-string (if vip-re-search "RE-/" "/")))
- (if (string= vip-s-string "")
- (progn
- (setq vip-re-search (not vip-re-search))
- (message "Search mode changed to %s search."
- (if vip-re-search "regular expression"
- "vanilla")))
- (vip-search vip-s-string t val)
- (if com
- (progn
- (move-marker vip-com-point (mark))
- (vip-execute-com 'vip-search-next val com))))))
-
-(defun vip-search-backward (arg)
- "Search a string backward. ARG is used to find the ARG's occurrence
-of the string. Default is vanilla search. Search mode can be toggled by
-giving null search string."
- (interactive "P")
- (let ((val (vip-P-val arg)) (com (vip-getcom arg)))
- (setq vip-s-forward nil
- vip-s-string (vip-read-string (if vip-re-search "RE-?" "?")))
- (if (string= vip-s-string "")
- (progn
- (setq vip-re-search (not vip-re-search))
- (message "Search mode changed to %s search."
- (if vip-re-search "regular expression"
- "vanilla")))
- (vip-search vip-s-string nil val)
- (if com
- (progn
- (move-marker vip-com-point (mark))
- (vip-execute-com 'vip-search-next val com))))))
-
-(defun vip-search (string forward arg &optional no-offset init-point)
- "(STRING FORWARD COUNT &optional NO-OFFSET) Search COUNT's occurrence of
-STRING. Search will be forward if FORWARD, otherwise backward."
- (let ((val (vip-p-val arg)) (com (vip-getcom arg))
- (null-arg (null (vip-P-val arg))) (offset (not no-offset))
- (case-fold-search vip-case-fold-search)
- (start-point (or init-point (point))))
- (if forward
- (condition-case conditions
- (progn
- (if (and offset (not (eobp))) (forward-char))
- (if vip-re-search
- (progn
- (re-search-forward string nil nil val)
- (re-search-backward string))
- (search-forward string nil nil val)
- (search-backward string))
- (push-mark start-point))
- (search-failed
- (if (and null-arg vip-search-wrap-around)
- (progn
- (goto-char (point-min))
- (vip-search string forward (cons 1 com) t start-point))
- (goto-char start-point)
- (signal 'search-failed (cdr conditions)))))
- (condition-case conditions
- (progn
- (if vip-re-search
- (re-search-backward string nil nil val)
- (search-backward string nil nil val))
- (push-mark start-point))
- (search-failed
- (if (and null-arg vip-search-wrap-around)
- (progn
- (goto-char (point-max))
- (vip-search string forward (cons 1 com) t start-point))
- (goto-char start-point)
- (signal 'search-failed (cdr conditions))))))))
-
-(defun vip-search-next (arg)
- "Repeat previous search."
- (interactive "P")
- (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
- (if (null vip-s-string) (error "No previous search string"))
- (vip-search vip-s-string vip-s-forward arg)
- (if com (vip-execute-com 'vip-search-next val com))))
-
-(defun vip-search-Next (arg)
- "Repeat previous search in the reverse direction."
- (interactive "P")
- (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
- (if (null vip-s-string) (error "No previous search string"))
- (vip-search vip-s-string (not vip-s-forward) arg)
- (if com (vip-execute-com 'vip-search-Next val com))))
-
-
-;; visiting and killing files, buffers
-
-(defun vip-switch-to-buffer ()
- "Switch to buffer in the current window."
- (interactive)
- (let (buffer)
- (setq buffer
- (read-buffer
- (format "switch to buffer \(%s\): "
- (buffer-name (other-buffer (current-buffer))))))
- (switch-to-buffer buffer)
- (vip-change-mode-to-vi)))
-
-(defun vip-switch-to-buffer-other-window ()
- "Switch to buffer in another window."
- (interactive)
- (let (buffer)
- (setq buffer
- (read-buffer
- (format "Switch to buffer \(%s\): "
- (buffer-name (other-buffer (current-buffer))))))
- (switch-to-buffer-other-window buffer)
- (vip-change-mode-to-vi)))
-
-(defun vip-kill-buffer ()
- "Kill a buffer."
- (interactive)
- (let (buffer buffer-name)
- (setq buffer-name
- (read-buffer
- (format "Kill buffer \(%s\): "
- (buffer-name (current-buffer)))))
- (setq buffer
- (if (null buffer-name)
- (current-buffer)
- (get-buffer buffer-name)))
- (if (null buffer) (error "Buffer %s nonexistent" buffer-name))
- (if (or (not (buffer-modified-p buffer))
- (y-or-n-p "Buffer is modified, are you sure? "))
- (kill-buffer buffer)
- (error "Buffer not killed"))))
-
-(defun vip-find-file ()
- "Visit file in the current window."
- (interactive)
- (let (file)
- (setq file (read-file-name "visit file: "))
- (switch-to-buffer (find-file-noselect file))
- (vip-change-mode-to-vi)))
-
-(defun vip-find-file-other-window ()
- "Visit file in another window."
- (interactive)
- (let (file)
- (setq file (read-file-name "Visit file: "))
- (switch-to-buffer-other-window (find-file-noselect file))
- (vip-change-mode-to-vi)))
-
-(defun vip-info-on-file ()
- "Give information of the file associated to the current buffer."
- (interactive)
- (message "\"%s\" line %d of %d"
- (if (buffer-file-name) (buffer-file-name) "")
- (1+ (count-lines (point-min) (point)))
- (1+ (count-lines (point-min) (point-max)))))
-
-
-;; yank and pop
-
-(defun vip-yank (text)
- "yank TEXT silently."
- (save-excursion
- (vip-push-mark-silent (point))
- (insert text)
- (exchange-point-and-mark))
- (skip-chars-forward " \t"))
-
-(defun vip-put-back (arg)
- "Put back after point/below line."
- (interactive "P")
- (let ((val (vip-p-val arg))
- (text (if vip-use-register
- (if (and (<= ?1 vip-use-register) (<= vip-use-register ?9))
- (current-kill (- vip-use-register ?1) 'do-not-rotate)
- (get-register vip-use-register))
- (current-kill 0))))
- (if (null text)
- (if vip-use-register
- (let ((reg vip-use-register))
- (setq vip-use-register nil)
- (error "Nothing in register %c" reg))
- (error "")))
- (setq vip-use-register nil)
- (if (vip-end-with-a-newline-p text)
- (progn
- (with-no-warnings (next-line 1))
- (beginning-of-line))
- (if (and (not (eolp)) (not (eobp))) (forward-char)))
- (setq vip-d-com (list 'vip-put-back val nil vip-use-register))
- (vip-loop val (vip-yank text))))
-
-(defun vip-Put-back (arg)
- "Put back at point/above line."
- (interactive "P")
- (let ((val (vip-p-val arg))
- (text (if vip-use-register
- (if (and (<= ?1 vip-use-register) (<= vip-use-register ?9))
- (current-kill (- vip-use-register ?1) 'do-not-rotate)
- (get-register vip-use-register))
- (current-kill 0))))
- (if (null text)
- (if vip-use-register
- (let ((reg vip-use-register))
- (setq vip-use-register nil)
- (error "Nothing in register %c" reg))
- (error "")))
- (setq vip-use-register nil)
- (if (vip-end-with-a-newline-p text) (beginning-of-line))
- (setq vip-d-com (list 'vip-Put-back val nil vip-use-register))
- (vip-loop val (vip-yank text))))
-
-(defun vip-delete-char (arg)
- "Delete character."
- (interactive "P")
- (let ((val (vip-p-val arg)))
- (setq vip-d-com (list 'vip-delete-char val nil))
- (if vip-use-register
- (progn
- (if (and (<= ?A vip-use-register) (<= vip-use-register ?Z))
- (vip-append-to-register
- (+ vip-use-register 32) (point) (- (point) val))
- (copy-to-register vip-use-register (point) (- (point) val) nil))
- (setq vip-use-register nil)))
- (delete-char val t)))
-
-(defun vip-delete-backward-char (arg)
- "Delete previous character."
- (interactive "P")
- (let ((val (vip-p-val arg)))
- (setq vip-d-com (list 'vip-delete-backward-char val nil))
- (if vip-use-register
- (progn
- (if (and (<= ?A vip-use-register) (<= vip-use-register ?Z))
- (vip-append-to-register
- (+ vip-use-register 32) (point) (+ (point) val))
- (copy-to-register vip-use-register (point) (+ (point) val) nil))
- (setq vip-use-register nil)))
- (delete-backward-char val t)))
-
-
-;; join lines.
-
-(defun vip-join-lines (arg)
- "Join this line to next, if ARG is nil. Otherwise, join ARG lines"
- (interactive "*P")
- (let ((val (vip-P-val arg)))
- (setq vip-d-com (list 'vip-join-lines val nil))
- (vip-loop (if (null val) 1 (1- val))
- (progn
- (end-of-line)
- (if (not (eobp))
- (progn
- (forward-line 1)
- (delete-region (point) (1- (point)))
- (fixup-whitespace)))))))
-
-
-;; making small changes
-
-(defvar vip-c-string)
-
-(defun vip-change (beg end)
- (setq vip-c-string
- (vip-read-string (format "%s => " (buffer-substring beg end))))
- (vip-change-subr beg end))
-
-(defun vip-change-subr (beg end)
- (if vip-use-register
- (progn
- (copy-to-register vip-use-register beg end nil)
- (setq vip-use-register nil)))
- (kill-region beg end)
- (setq this-command 'vip-change)
- (insert vip-c-string))
-
-
-;; query replace
-
-(defun vip-query-replace ()
- "Query replace. If you supply null string as the string to be replaced,
-the query replace mode will toggle between string replace and regexp replace."
- (interactive)
- (let (str)
- (setq str (vip-read-string
- (if vip-re-query-replace "Query replace regexp: "
- "Query replace: ")))
- (if (string= str "")
- (progn
- (setq vip-re-query-replace (not vip-re-query-replace))
- (message "Query replace mode changed to %s."
- (if vip-re-query-replace "regexp replace"
- "string replace")))
- (if vip-re-query-replace
- (query-replace-regexp
- str
- (vip-read-string (format "Query replace regexp \"%s\" with: " str)))
- (query-replace
- str
- (vip-read-string (format "Query replace \"%s\" with: " str)))))))
-
-
-;; marking
-
-(defun vip-mark-beginning-of-buffer ()
- (interactive)
- (set-mark (point))
- (goto-char (point-min))
- (exchange-point-and-mark)
- (message "mark set at the beginning of buffer"))
-
-(defun vip-mark-end-of-buffer ()
- (interactive)
- (set-mark (point))
- (goto-char (point-max))
- (exchange-point-and-mark)
- (message "mark set at the end of buffer"))
-
-(defun vip-mark-point (char)
- (interactive "c")
- (cond ((and (<= ?a char) (<= char ?z))
- (point-to-register (- char (- ?a ?\C-a)) nil))
- ((= char ?<) (vip-mark-beginning-of-buffer))
- ((= char ?>) (vip-mark-end-of-buffer))
- ((= char ?.) (push-mark))
- ((= char ?,) (set-mark-command 1))
- ((= char ?D) (mark-defun))
- (t (error ""))))
-
-(defun vip-goto-mark (arg)
- "Go to mark."
- (interactive "P")
- (let ((char (read-char)) (com (vip-getcom arg)))
- (vip-goto-mark-subr char com nil)))
-
-(defun vip-goto-mark-and-skip-white (arg)
- "Go to mark and skip to first non-white on line."
- (interactive "P")
- (let ((char (read-char)) (com (vip-getCom arg)))
- (vip-goto-mark-subr char com t)))
-
-(defun vip-goto-mark-subr (char com skip-white)
- (cond ((and (<= ?a char) (<= char ?z))
- (let ((buff (current-buffer)))
- (if com (move-marker vip-com-point (point)))
- (goto-char (register-to-point (- char (- ?a ?\C-a))))
- (if skip-white (back-to-indentation))
- (vip-change-mode-to-vi)
- (if com
- (if (equal buff (current-buffer))
- (vip-execute-com (if skip-white
- 'vip-goto-mark-and-skip-white
- 'vip-goto-mark)
- nil com)
- (switch-to-buffer buff)
- (goto-char vip-com-point)
- (vip-change-mode-to-vi)
- (error "")))))
- ((and (not skip-white) (= char ?`))
- (if com (move-marker vip-com-point (point)))
- (exchange-point-and-mark)
- (if com (vip-execute-com 'vip-goto-mark nil com)))
- ((and skip-white (= char ?'))
- (if com (move-marker vip-com-point (point)))
- (exchange-point-and-mark)
- (back-to-indentation)
- (if com (vip-execute-com 'vip-goto-mark-and-skip-white nil com)))
- (t (error ""))))
-
-(defun vip-exchange-point-and-mark ()
- (interactive)
- (exchange-point-and-mark)
- (back-to-indentation))
-
-(defun vip-keyboard-quit ()
- "Abort partially formed or running command."
- (interactive)
- (setq vip-use-register nil)
- (keyboard-quit))
-
-(defun vip-ctl-c-equivalent (arg)
- "Emulate C-c in Emacs mode."
- (interactive "P")
- (vip-ctl-key-equivalent "\C-c" arg))
-
-(defun vip-ctl-x-equivalent (arg)
- "Emulate C-x in Emacs mode."
- (interactive "P")
- (vip-ctl-key-equivalent "\C-x" arg))
-
-(defun vip-ctl-key-equivalent (key arg)
- (let ((char (read-char)))
- (if (and (<= ?A char) (<= char ?Z))
- (setq char (- char (- ?A ?\C-a))))
- (vip-escape-to-emacs arg (list (aref key 0) char))))
-
-;; commands in insertion mode
-
-(defun vip-delete-backward-word (arg)
- "Delete previous word."
- (interactive "p")
- (save-excursion
- (set-mark (point))
- (backward-word arg)
- (delete-region (point) (mark))))
-
-
-;; implement ex commands
-
-(defvar ex-token-type nil
- "type of token. if non-nil, gives type of address. if nil, it
-is a command.")
-
-(defvar ex-token nil
- "value of token.")
-
-(defvar ex-addresses nil
- "list of ex addresses")
-
-(defvar ex-flag nil
- "flag for ex flag")
-
-(defvar ex-buffer nil
- "name of ex buffer")
-
-(defvar ex-count nil
- "value of ex count")
-
-(defvar ex-g-flag nil
- "flag for global command")
-
-(defvar ex-g-variant nil
- "if t global command is executed on lines not matching ex-g-pat")
-
-(defvar ex-reg-exp nil
- "save reg-exp used in substitute")
-
-(defvar ex-repl nil
- "replace pattern for substitute")
-
-(defvar ex-g-pat nil
- "pattern for global command")
-
-(defvar ex-map (make-sparse-keymap)
- "save commands for mapped keys")
-
-(defvar ex-tag nil
- "save ex tag")
-
-(defvar ex-file nil)
-
-(defvar ex-variant nil)
-
-(defvar ex-offset nil)
-
-(defvar ex-append nil)
-
-(defun vip-nil ()
- (interactive)
- (error ""))
-
-(defun vip-looking-back (str)
- "returns t if looking back reg-exp STR before point."
- (and (save-excursion (re-search-backward str nil t))
- (= (point) (match-end 0))))
-
-(defun vip-check-sub (str)
- "check if ex-token is an initial segment of STR"
- (let ((length (length ex-token)))
- (if (and (<= length (length str))
- (string= ex-token (substring str 0 length)))
- (setq ex-token str)
- (setq ex-token-type "non-command"))))
-
-(defun vip-get-ex-com-subr ()
- "get a complete ex command"
- (set-mark (point))
- (re-search-forward "[a-z][a-z]*")
- (setq ex-token-type "command")
- (setq ex-token (buffer-substring (point) (mark)))
- (exchange-point-and-mark)
- (cond ((looking-at "a")
- (cond ((looking-at "ab") (vip-check-sub "abbreviate"))
- ((looking-at "ar") (vip-check-sub "args"))
- (t (vip-check-sub "append"))))
- ((looking-at "[bh]") (setq ex-token-type "non-command"))
- ((looking-at "c")
- (if (looking-at "co") (vip-check-sub "copy")
- (vip-check-sub "change")))
- ((looking-at "d") (vip-check-sub "delete"))
- ((looking-at "e")
- (if (looking-at "ex") (vip-check-sub "ex")
- (vip-check-sub "edit")))
- ((looking-at "f") (vip-check-sub "file"))
- ((looking-at "g") (vip-check-sub "global"))
- ((looking-at "i") (vip-check-sub "insert"))
- ((looking-at "j") (vip-check-sub "join"))
- ((looking-at "l") (vip-check-sub "list"))
- ((looking-at "m")
- (cond ((looking-at "map") (vip-check-sub "map"))
- ((looking-at "mar") (vip-check-sub "mark"))
- (t (vip-check-sub "move"))))
- ((looking-at "n")
- (if (looking-at "nu") (vip-check-sub "number")
- (vip-check-sub "next")))
- ((looking-at "o") (vip-check-sub "open"))
- ((looking-at "p")
- (cond ((looking-at "pre") (vip-check-sub "preserve"))
- ((looking-at "pu") (vip-check-sub "put"))
- (t (vip-check-sub "print"))))
- ((looking-at "q") (vip-check-sub "quit"))
- ((looking-at "r")
- (cond ((looking-at "rec") (vip-check-sub "recover"))
- ((looking-at "rew") (vip-check-sub "rewind"))
- (t (vip-check-sub "read"))))
- ((looking-at "s")
- (cond ((looking-at "se") (vip-check-sub "set"))
- ((looking-at "sh") (vip-check-sub "shell"))
- ((looking-at "so") (vip-check-sub "source"))
- ((looking-at "st") (vip-check-sub "stop"))
- (t (vip-check-sub "substitute"))))
- ((looking-at "t")
- (if (looking-at "ta") (vip-check-sub "tag")
- (vip-check-sub "t")))
- ((looking-at "u")
- (cond ((looking-at "una") (vip-check-sub "unabbreviate"))
- ((looking-at "unm") (vip-check-sub "unmap"))
- (t (vip-check-sub "undo"))))
- ((looking-at "v")
- (cond ((looking-at "ve") (vip-check-sub "version"))
- ((looking-at "vi") (vip-check-sub "visual"))
- (t (vip-check-sub "v"))))
- ((looking-at "w")
- (if (looking-at "wq") (vip-check-sub "wq")
- (vip-check-sub "write")))
- ((looking-at "x") (vip-check-sub "xit"))
- ((looking-at "y") (vip-check-sub "yank"))
- ((looking-at "z") (vip-check-sub "z")))
- (exchange-point-and-mark))
-
-(defun vip-get-ex-token ()
- "get an ex-token which is either an address or a command.
-a token has type \(command, address, end-mark\) and value."
- (with-current-buffer " *ex-working-space*"
- (skip-chars-forward " \t")
- (cond ((looking-at "[k#]")
- (setq ex-token-type "command")
- (setq ex-token (char-to-string (following-char)))
- (forward-char 1))
- ((looking-at "[a-z]") (vip-get-ex-com-subr))
- ((looking-at "\\.")
- (forward-char 1)
- (setq ex-token-type "dot"))
- ((looking-at "[0-9]")
- (set-mark (point))
- (re-search-forward "[0-9]*")
- (setq ex-token-type
- (cond ((string= ex-token-type "plus") "add-number")
- ((string= ex-token-type "minus") "sub-number")
- (t "abs-number")))
- (setq ex-token (string-to-number (buffer-substring (point) (mark)))))
- ((looking-at "\\$")
- (forward-char 1)
- (setq ex-token-type "end"))
- ((looking-at "%")
- (forward-char 1)
- (setq ex-token-type "whole"))
- ((looking-at "+")
- (cond ((or (looking-at "+[-+]") (looking-at "+[\n|]"))
- (forward-char 1)
- (insert "1")
- (backward-char 1)
- (setq ex-token-type "plus"))
- ((looking-at "+[0-9]")
- (forward-char 1)
- (setq ex-token-type "plus"))
- (t
- (error "Badly formed address"))))
- ((looking-at "-")
- (cond ((or (looking-at "-[-+]") (looking-at "-[\n|]"))
- (forward-char 1)
- (insert "1")
- (backward-char 1)
- (setq ex-token-type "minus"))
- ((looking-at "-[0-9]")
- (forward-char 1)
- (setq ex-token-type "minus"))
- (t
- (error "Badly formed address"))))
- ((looking-at "/")
- (forward-char 1)
- (set-mark (point))
- (let ((cont t))
- (while (and (not (eolp)) cont)
- ;;(re-search-forward "[^/]*/")
- (re-search-forward "[^/]*\\(/\\|\n\\)")
- (if (not (vip-looking-back "[^\\\\]\\(\\\\\\\\\\)*\\\\/"))
- (setq cont nil))))
- (backward-char 1)
- (setq ex-token (buffer-substring (point) (mark)))
- (if (looking-at "/") (forward-char 1))
- (setq ex-token-type "search-forward"))
- ((looking-at "\\?")
- (forward-char 1)
- (set-mark (point))
- (let ((cont t))
- (while (and (not (eolp)) cont)
- ;;(re-search-forward "[^\\?]*\\?")
- (re-search-forward "[^\\?]*\\(\\?\\|\n\\)")
- (if (not (vip-looking-back "[^\\\\]\\(\\\\\\\\\\)*\\\\\\?"))
- (setq cont nil))
- (backward-char 1)
- (if (not (looking-at "\n")) (forward-char 1))))
- (setq ex-token-type "search-backward")
- (setq ex-token (buffer-substring (1- (point)) (mark))))
- ((looking-at ",")
- (forward-char 1)
- (setq ex-token-type "comma"))
- ((looking-at ";")
- (forward-char 1)
- (setq ex-token-type "semi-colon"))
- ((looking-at "[!=><&~]")
- (setq ex-token-type "command")
- (setq ex-token (char-to-string (following-char)))
- (forward-char 1))
- ((looking-at "'")
- (setq ex-token-type "goto-mark")
- (forward-char 1)
- (cond ((looking-at "'") (setq ex-token nil))
- ((looking-at "[a-z]") (setq ex-token (following-char)))
- (t (error "Marks are ' and a-z")))
- (forward-char 1))
- ((looking-at "\n")
- (setq ex-token-type "end-mark")
- (setq ex-token "goto"))
- (t
- (error "invalid token")))))
-
-(defun vip-ex (&optional string)
- "ex commands within VIP."
- (interactive)
- (or string
- (setq ex-g-flag nil
- ex-g-variant nil))
- (let ((com-str (or string (vip-read-string ":")))
- (address nil) (cont t) (dot (point)))
- (with-current-buffer (get-buffer-create " *ex-working-space*")
- (delete-region (point-min) (point-max))
- (insert com-str "\n")
- (goto-char (point-min)))
- (setq ex-token-type "")
- (setq ex-addresses nil)
- (while cont
- (vip-get-ex-token)
- (cond ((or (string= ex-token-type "command")
- (string= ex-token-type "end-mark"))
- (if address (setq ex-addresses (cons address ex-addresses)))
- (cond ((string= ex-token "global")
- (ex-global nil)
- (setq cont nil))
- ((string= ex-token "v")
- (ex-global t)
- (setq cont nil))
- (t
- (vip-execute-ex-command)
- (with-current-buffer " *ex-working-space*"
- (skip-chars-forward " \t")
- (cond ((looking-at "|")
- (forward-char 1))
- ((looking-at "\n")
- (setq cont nil))
- (t (error "Extra character at end of a command")))))))
- ((string= ex-token-type "non-command")
- (error "%s: Not an editor command" ex-token))
- ((string= ex-token-type "whole")
- (setq ex-addresses
- (cons (point-max) (cons (point-min) ex-addresses))))
- ((string= ex-token-type "comma")
- (setq ex-addresses
- (cons (if (null address) (point) address) ex-addresses)))
- ((string= ex-token-type "semi-colon")
- (if address (setq dot address))
- (setq ex-addresses
- (cons (if (null address) (point) address) ex-addresses)))
- (t (let ((ans (vip-get-ex-address-subr address dot)))
- (if ans (setq address ans))))))))
-
-(defun vip-get-ex-pat ()
- "get a regular expression and set ex-variant if found"
- (with-current-buffer " *ex-working-space*"
- (skip-chars-forward " \t")
- (if (looking-at "!")
- (progn
- (setq ex-g-variant (not ex-g-variant)
- ex-g-flag (not ex-g-flag))
- (forward-char 1)
- (skip-chars-forward " \t")))
- (if (looking-at "/")
- (progn
- (forward-char 1)
- (set-mark (point))
- (let ((cont t))
- (while (and (not (eolp)) cont)
- (re-search-forward "[^/]*\\(/\\|\n\\)")
- ;;(re-search-forward "[^/]*/")
- (if (not (vip-looking-back "[^\\\\]\\(\\\\\\\\\\)*\\\\/"))
- (setq cont nil))))
- (setq ex-token
- (if (= (mark) (point)) ""
- (buffer-substring (1- (point)) (mark))))
- (backward-char 1))
- (setq ex-token nil))))
-
-(defun vip-get-ex-command ()
- "get an ex command"
- (with-current-buffer " *ex-working-space*"
- (if (looking-at "/") (forward-char 1))
- (skip-chars-forward " \t")
- (cond ((looking-at "[a-z]")
- (vip-get-ex-com-subr)
- (if (string= ex-token-type "non-command")
- (error "%s: not an editor command" ex-token)))
- ((looking-at "[!=><&~]")
- (setq ex-token (char-to-string (following-char)))
- (forward-char 1))
- (t (error "Could not find an ex command")))))
-
-(defun vip-get-ex-opt-gc ()
- "get an ex option g or c"
- (with-current-buffer " *ex-working-space*"
- (if (looking-at "/") (forward-char 1))
- (skip-chars-forward " \t")
- (cond ((looking-at "g")
- (setq ex-token "g")
- (forward-char 1)
- t)
- ((looking-at "c")
- (setq ex-token "c")
- (forward-char 1)
- t)
- (t nil))))
-
-(defun vip-default-ex-addresses (&optional whole-flag)
- "compute default addresses. whole-flag means whole buffer."
- (cond ((null ex-addresses)
- (setq ex-addresses
- (if whole-flag
- (cons (point-max) (cons (point-min) nil))
- (cons (point) (cons (point) nil)))))
- ((null (cdr ex-addresses))
- (setq ex-addresses
- (cons (car ex-addresses) ex-addresses)))))
-
-(defun vip-get-ex-address ()
- "get an ex-address as a marker and set ex-flag if a flag is found"
- (let ((address (point-marker)) (cont t))
- (setq ex-token "")
- (setq ex-flag nil)
- (while cont
- (vip-get-ex-token)
- (cond ((string= ex-token-type "command")
- (if (or (string= ex-token "print") (string= ex-token "list")
- (string= ex-token "#"))
- (progn
- (setq ex-flag t)
- (setq cont nil))
- (error "address expected")))
- ((string= ex-token-type "end-mark")
- (setq cont nil))
- ((string= ex-token-type "whole")
- (error "a trailing address is expected"))
- ((string= ex-token-type "comma")
- (error "Extra characters after an address"))
- (t (let ((ans (vip-get-ex-address-subr address (point-marker))))
- (if ans (setq address ans))))))
- address))
-
-(defun vip-get-ex-address-subr (old-address dot)
- "returns an address as a point"
- (let ((address nil))
- (if (null old-address) (setq old-address dot))
- (cond ((string= ex-token-type "dot")
- (setq address dot))
- ((string= ex-token-type "add-number")
- (save-excursion
- (goto-char old-address)
- (forward-line (if (= old-address 0) (1- ex-token) ex-token))
- (setq address (point-marker))))
- ((string= ex-token-type "sub-number")
- (save-excursion
- (goto-char old-address)
- (forward-line (- ex-token))
- (setq address (point-marker))))
- ((string= ex-token-type "abs-number")
- (save-excursion
- (goto-char (point-min))
- (if (= ex-token 0) (setq address 0)
- (forward-line (1- ex-token))
- (setq address (point-marker)))))
- ((string= ex-token-type "end")
- (setq address (point-max-marker)))
- ((string= ex-token-type "plus") t);; do nothing
- ((string= ex-token-type "minus") t);; do nothing
- ((string= ex-token-type "search-forward")
- (save-excursion
- (ex-search-address t)
- (setq address (point-marker))))
- ((string= ex-token-type "search-backward")
- (save-excursion
- (ex-search-address nil)
- (setq address (point-marker))))
- ((string= ex-token-type "goto-mark")
- (save-excursion
- (if (null ex-token)
- (exchange-point-and-mark)
- (goto-char (register-to-point (- ex-token (- ?a ?\C-a)))))
- (setq address (point-marker)))))
- address))
-
-(defun ex-search-address (forward)
- "search pattern and set address"
- (if (string= ex-token "")
- (if (null vip-s-string) (error "No previous search string")
- (setq ex-token vip-s-string))
- (setq vip-s-string ex-token))
- (if forward
- (progn
- (forward-line 1)
- (re-search-forward ex-token))
- (forward-line -1)
- (re-search-backward ex-token)))
-
-(defun vip-get-ex-buffer ()
- "get a buffer name and set ex-count and ex-flag if found"
- (setq ex-buffer nil)
- (setq ex-count nil)
- (setq ex-flag nil)
- (with-current-buffer " *ex-working-space*"
- (skip-chars-forward " \t")
- (if (looking-at "[a-zA-Z]")
- (progn
- (setq ex-buffer (following-char))
- (forward-char 1)
- (skip-chars-forward " \t")))
- (if (looking-at "[0-9]")
- (progn
- (set-mark (point))
- (re-search-forward "[0-9][0-9]*")
- (setq ex-count (string-to-number (buffer-substring (point) (mark))))
- (skip-chars-forward " \t")))
- (if (looking-at "[pl#]")
- (progn
- (setq ex-flag t)
- (forward-char 1)))
- (if (not (looking-at "[\n|]"))
- (error "Invalid extra characters"))))
-
-(defun vip-get-ex-count ()
- (setq ex-variant nil
- ex-count nil
- ex-flag nil)
- (with-current-buffer " *ex-working-space*"
- (skip-chars-forward " \t")
- (if (looking-at "!")
- (progn
- (setq ex-variant t)
- (forward-char 1)))
- (skip-chars-forward " \t")
- (if (looking-at "[0-9]")
- (progn
- (set-mark (point))
- (re-search-forward "[0-9][0-9]*")
- (setq ex-count (string-to-number (buffer-substring (point) (mark))))
- (skip-chars-forward " \t")))
- (if (looking-at "[pl#]")
- (progn
- (setq ex-flag t)
- (forward-char 1)))
- (if (not (looking-at "[\n|]"))
- (error "Invalid extra characters"))))
-
-(defun vip-get-ex-file ()
- "get a file name and set ex-variant, ex-append and ex-offset if found"
- (setq ex-file nil
- ex-variant nil
- ex-append nil
- ex-offset nil)
- (with-current-buffer " *ex-working-space*"
- (skip-chars-forward " \t")
- (if (looking-at "!")
- (progn
- (setq ex-variant t)
- (forward-char 1)
- (skip-chars-forward " \t")))
- (if (looking-at ">>")
- (progn
- (setq ex-append t
- ex-variant t)
- (forward-char 2)
- (skip-chars-forward " \t")))
- (if (looking-at "+")
- (progn
- (forward-char 1)
- (set-mark (point))
- (re-search-forward "[ \t\n]")
- (backward-char 1)
- (setq ex-offset (buffer-substring (point) (mark)))
- (forward-char 1)
- (skip-chars-forward " \t")))
- (set-mark (point))
- (re-search-forward "[ \t\n]")
- (backward-char 1)
- (setq ex-file (buffer-substring (point) (mark)))))
-
-(defun vip-execute-ex-command ()
- "execute ex command using the value of addresses."
- (cond ((string= ex-token "goto") (ex-goto))
- ((string= ex-token "copy") (ex-copy nil))
- ((string= ex-token "delete") (ex-delete))
- ((string= ex-token "edit") (ex-edit))
- ((string= ex-token "file") (vip-info-on-file))
- ;((string= ex-token "global") (ex-global nil))
- ((string= ex-token "join") (ex-line "join"))
- ((string= ex-token "k") (ex-mark))
- ((string= ex-token "mark") (ex-mark))
- ((string= ex-token "map") (ex-map))
- ((string= ex-token "move") (ex-copy t))
- ((string= ex-token "put") (ex-put))
- ((string= ex-token "quit") (ex-quit))
- ((string= ex-token "read") (ex-read))
- ((string= ex-token "set") (ex-set))
- ((string= ex-token "shell") (ex-shell))
- ((string= ex-token "substitute") (ex-substitute))
- ((string= ex-token "stop") (suspend-emacs))
- ((string= ex-token "t") (ex-copy nil))
- ((string= ex-token "tag") (ex-tag))
- ((string= ex-token "undo") (vip-undo))
- ((string= ex-token "unmap") (ex-unmap))
- ;((string= ex-token "v") (ex-global t))
- ((string= ex-token "version") (vip-version))
- ((string= ex-token "visual") (ex-edit))
- ((string= ex-token "write") (ex-write nil))
- ((string= ex-token "wq") (ex-write t))
- ((string= ex-token "yank") (ex-yank))
- ((string= ex-token "!") (ex-command))
- ((string= ex-token "=") (ex-line-no))
- ((string= ex-token ">") (ex-line "right"))
- ((string= ex-token "<") (ex-line "left"))
- ((string= ex-token "&") (ex-substitute t))
- ((string= ex-token "~") (ex-substitute t t))
- ((or (string= ex-token "append")
- (string= ex-token "args")
- (string= ex-token "change")
- (string= ex-token "insert")
- (string= ex-token "open")
- )
- (error "%s: no such command from VIP" ex-token))
- ((or (string= ex-token "abbreviate")
- (string= ex-token "list")
- (string= ex-token "next")
- (string= ex-token "print")
- (string= ex-token "preserve")
- (string= ex-token "recover")
- (string= ex-token "rewind")
- (string= ex-token "source")
- (string= ex-token "unabbreviate")
- (string= ex-token "xit")
- (string= ex-token "z")
- )
- (error "%s: not implemented in VIP" ex-token))
- (t (error "%s: Not an editor command" ex-token))))
-
-(defun ex-goto ()
- "ex goto command"
- (if (null ex-addresses)
- (setq ex-addresses (cons (point) nil)))
- (push-mark (point))
- (goto-char (car ex-addresses))
- (beginning-of-line))
-
-(defun ex-copy (del-flag)
- "ex copy and move command. DEL-FLAG means delete."
- (vip-default-ex-addresses)
- (let ((address (vip-get-ex-address))
- (end (car ex-addresses)) (beg (car (cdr ex-addresses))))
- (goto-char end)
- (save-excursion
- (set-mark beg)
- (vip-enlarge-region (mark) (point))
- (if del-flag (kill-region (point) (mark))
- (copy-region-as-kill (point) (mark)))
- (if ex-flag
- (progn
- (with-output-to-temp-buffer "*copy text*"
- (princ
- (if (or del-flag ex-g-flag ex-g-variant)
- (current-kill 0)
- (buffer-substring (point) (mark)))))
- (condition-case nil
- (progn
- (vip-read-string "[Hit return to continue] ")
- (save-excursion (kill-buffer "*copy text*")))
- (quit
- (save-excursion (kill-buffer "*copy text*"))
- (signal 'quit nil))))))
- (if (= address 0)
- (goto-char (point-min))
- (goto-char address)
- (forward-line 1))
- (insert (current-kill 0))))
-
-(defun ex-delete ()
- "ex delete"
- (vip-default-ex-addresses)
- (vip-get-ex-buffer)
- (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses))))
- (if (> beg end) (error "First address exceeds second"))
- (save-excursion
- (vip-enlarge-region beg end)
- (exchange-point-and-mark)
- (if ex-count
- (progn
- (set-mark (point))
- (forward-line (1- ex-count)))
- (set-mark end))
- (vip-enlarge-region (point) (mark))
- (if ex-flag
- ;; show text to be deleted and ask for confirmation
- (progn
- (with-output-to-temp-buffer " *delete text*"
- (princ (buffer-substring (point) (mark))))
- (condition-case conditions
- (vip-read-string "[Hit return to continue] ")
- (quit
- (save-excursion (kill-buffer " *delete text*"))
- (error "")))
- (save-excursion (kill-buffer " *delete text*")))
- (if ex-buffer
- (if (and (<= ?A ex-buffer) (<= ex-buffer ?Z))
- (vip-append-to-register
- (+ ex-buffer 32) (point) (mark))
- (copy-to-register ex-buffer (point) (mark) nil)))
- (delete-region (point) (mark))))))
-
-(defun ex-edit ()
- "ex-edit"
- (vip-get-ex-file)
- (if (and (not ex-variant) (buffer-modified-p) buffer-file-name)
- (error "No write since last change \(:e! overrides\)"))
- (vip-change-mode-to-emacs)
- (set-buffer
- (find-file-noselect (concat default-directory ex-file)))
- (vip-change-mode-to-vi)
- (goto-char (point-min))
- (if ex-offset
- (progn
- (with-current-buffer " *ex-working-space*"
- (delete-region (point-min) (point-max))
- (insert ex-offset "\n")
- (goto-char (point-min)))
- (goto-char (vip-get-ex-address))
- (beginning-of-line))))
-
-(defun ex-global (variant)
- "ex global command"
- (if (or ex-g-flag ex-g-variant)
- (error "Global within global not allowed")
- (if variant
- (setq ex-g-flag nil
- ex-g-variant t)
- (setq ex-g-flag t
- ex-g-variant nil)))
- (vip-get-ex-pat)
- (if (null ex-token)
- (error "Missing regular expression for global command"))
- (if (string= ex-token "")
- (if (null vip-s-string) (error "No previous search string")
- (setq ex-g-pat vip-s-string))
- (setq ex-g-pat ex-token
- vip-s-string ex-token))
- (if (null ex-addresses)
- (setq ex-addresses (list (point-max) (point-min))))
- (let ((marks nil) (mark-count 0)
- com-str (end (car ex-addresses)) (beg (car (cdr ex-addresses))))
- (if (> beg end) (error "First address exceeds second"))
- (save-excursion
- (vip-enlarge-region beg end)
- (exchange-point-and-mark)
- (let ((cont t) (limit (point-marker)))
- (exchange-point-and-mark)
- ;; skip the last line if empty
- (beginning-of-line)
- (if (and (eobp) (not (bobp))) (backward-char 1))
- (while (and cont (not (bobp)) (>= (point) limit))
- (beginning-of-line)
- (set-mark (point))
- (end-of-line)
- (let ((found (re-search-backward ex-g-pat (mark) t)))
- (if (or (and ex-g-flag found)
- (and ex-g-variant (not found)))
- (progn
- (end-of-line)
- (setq mark-count (1+ mark-count))
- (setq marks (cons (point-marker) marks)))))
- (beginning-of-line)
- (if (bobp) (setq cont nil)
- (forward-line -1)
- (end-of-line)))))
- (with-current-buffer " *ex-working-space*"
- (setq com-str (buffer-substring (1+ (point)) (1- (point-max)))))
- (while marks
- (goto-char (car marks))
- ;; report progress of execution on a slow machine.
- ;;(message "Executing global command...")
- ;;(if (zerop (% mark-count 10))
- ;; (message "Executing global command...%d" mark-count))
- (vip-ex com-str)
- (setq mark-count (1- mark-count))
- (setq marks (cdr marks)))))
-;;(message "Executing global command...done")))
-
-(defun ex-line (com)
- "ex line commands. COM is join, shift-right or shift-left."
- (vip-default-ex-addresses)
- (vip-get-ex-count)
- (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses))) point)
- (if (> beg end) (error "First address exceeds second"))
- (save-excursion
- (vip-enlarge-region beg end)
- (exchange-point-and-mark)
- (if ex-count
- (progn
- (set-mark (point))
- (forward-line ex-count)))
- (if ex-flag
- ;; show text to be joined and ask for confirmation
- (progn
- (with-output-to-temp-buffer " *text*"
- (princ (buffer-substring (point) (mark))))
- (condition-case conditions
- (progn
- (vip-read-string "[Hit return to continue] ")
- (ex-line-subr com (point) (mark)))
- (quit
- (ding)))
- (save-excursion (kill-buffer " *text*")))
- (ex-line-subr com (point) (mark)))
- (setq point (point)))
- (goto-char (1- point))
- (beginning-of-line)))
-
-(defun ex-line-subr (com beg end)
- (cond ((string= com "join")
- (goto-char (min beg end))
- (while (and (not (eobp)) (< (point) (max beg end)))
- (end-of-line)
- (if (and (<= (point) (max beg end)) (not (eobp)))
- (progn
- (forward-line 1)
- (delete-region (point) (1- (point)))
- (if (not ex-variant) (fixup-whitespace))))))
- ((or (string= com "right") (string= com "left"))
- (indent-rigidly
- (min beg end) (max beg end)
- (if (string= com "right") vip-shift-width (- vip-shift-width)))
- (goto-char (max beg end))
- (end-of-line)
- (forward-char 1))))
-
-(defun ex-mark ()
- "ex mark"
- (let (char)
- (if (null ex-addresses)
- (setq ex-addresses
- (cons (point) nil)))
- (with-current-buffer " *ex-working-space*"
- (skip-chars-forward " \t")
- (if (looking-at "[a-z]")
- (progn
- (setq char (following-char))
- (forward-char 1)
- (skip-chars-forward " \t")
- (if (not (looking-at "[\n|]"))
- (error "Extra characters at end of \"k\" command")))
- (if (looking-at "[\n|]")
- (error "\"k\" requires a following letter")
- (error "Mark must specify a letter"))))
- (save-excursion
- (goto-char (car ex-addresses))
- (point-to-register (- char (- ?a ?\C-a)) nil))))
-
-(defun ex-map ()
- "ex map"
- (let (char string)
- (with-current-buffer " *ex-working-space*"
- (skip-chars-forward " \t")
- (setq char (char-to-string (following-char)))
- (forward-char 1)
- (skip-chars-forward " \t")
- (if (looking-at "[\n|]") (error "Missing rhs"))
- (set-mark (point))
- (with-no-warnings
- (end-of-buffer))
- (backward-char 1)
- (setq string (buffer-substring (mark) (point))))
- (if (not (lookup-key ex-map char))
- (define-key ex-map char
- (or (lookup-key vip-mode-map char) 'vip-nil)))
- (define-key vip-mode-map char
- (eval
- (list 'quote
- (cons 'lambda
- (list '(count)
- '(interactive "p")
- (list 'execute-kbd-macro string 'count))))))))
-
-(defun ex-unmap ()
- "ex unmap"
- (let (char)
- (with-current-buffer " *ex-working-space*"
- (skip-chars-forward " \t")
- (setq char (char-to-string (following-char)))
- (forward-char 1)
- (skip-chars-forward " \t")
- (if (not (looking-at "[\n|]")) (error "Macro must be a character")))
- (if (not (lookup-key ex-map char))
- (error "That macro wasn't mapped"))
- (define-key vip-mode-map char (lookup-key ex-map char))
- (define-key ex-map char nil)))
-
-(defun ex-put ()
- "ex put"
- (let ((point (if (null ex-addresses) (point) (car ex-addresses))))
- (vip-get-ex-buffer)
- (setq vip-use-register ex-buffer)
- (goto-char point)
- (if (= point 0) (vip-Put-back 1) (vip-put-back 1))))
-
-(defun ex-quit ()
- "ex quit"
- (let (char)
- (with-current-buffer " *ex-working-space*"
- (skip-chars-forward " \t")
- (setq char (following-char)))
- (if (= char ?!) (kill-emacs t) (save-buffers-kill-emacs))))
-
-(defun ex-read ()
- "ex read"
- (let ((point (if (null ex-addresses) (point) (car ex-addresses)))
- (variant nil) command file)
- (goto-char point)
- (if (not (= point 0)) (with-no-warnings (next-line 1)))
- (beginning-of-line)
- (with-current-buffer " *ex-working-space*"
- (skip-chars-forward " \t")
- (if (looking-at "!")
- (progn
- (setq variant t)
- (forward-char 1)
- (skip-chars-forward " \t")
- (set-mark (point))
- (end-of-line)
- (setq command (buffer-substring (mark) (point))))
- (set-mark (point))
- (re-search-forward "[ \t\n]")
- (backward-char 1)
- (setq file (buffer-substring (point) (mark)))))
- (if variant
- (shell-command command t)
- (with-no-warnings
- (insert-file file)))))
-
-(defun ex-set ()
- (eval (list 'setq
- (read-variable "Variable: ")
- (eval (read-minibuffer "Value: ")))))
-
-(defun ex-shell ()
- "ex shell"
- (vip-change-mode-to-emacs)
- (shell))
-
-(defun ex-substitute (&optional repeat r-flag)
- "ex substitute.
-If REPEAT use previous reg-exp which is ex-reg-exp or
-vip-s-string"
- (let (pat repl (opt-g nil) (opt-c nil) (matched-pos nil))
- (if repeat (setq ex-token nil) (vip-get-ex-pat))
- (if (null ex-token)
- (setq pat (if r-flag vip-s-string ex-reg-exp)
- repl ex-repl)
- (setq pat (if (string= ex-token "") vip-s-string ex-token))
- (setq vip-s-string pat
- ex-reg-exp pat)
- (vip-get-ex-pat)
- (if (null ex-token)
- (setq ex-token ""
- ex-repl "")
- (setq repl ex-token
- ex-repl ex-token)))
- (while (vip-get-ex-opt-gc)
- (if (string= ex-token "g") (setq opt-g t) (setq opt-c t)))
- (vip-get-ex-count)
- (if ex-count
- (save-excursion
- (if ex-addresses (goto-char (car ex-addresses)))
- (set-mark (point))
- (forward-line (1- ex-count))
- (setq ex-addresses (cons (point) (cons (mark) nil))))
- (if (null ex-addresses)
- (setq ex-addresses (cons (point) (cons (point) nil)))
- (if (null (cdr ex-addresses))
- (setq ex-addresses (cons (car ex-addresses) ex-addresses)))))
- ;(setq G opt-g)
- (let ((beg (car ex-addresses)) (end (car (cdr ex-addresses)))
- (cont t) eol-mark)
- (save-excursion
- (vip-enlarge-region beg end)
- (let ((limit (save-excursion
- (goto-char (max (point) (mark)))
- (point-marker))))
- (goto-char (min (point) (mark)))
- (while (< (point) limit)
- (end-of-line)
- (setq eol-mark (point-marker))
- (beginning-of-line)
- (if opt-g
- (progn
- (while (and (not (eolp))
- (re-search-forward pat eol-mark t))
- (if (or (not opt-c) (y-or-n-p "Replace? "))
- (progn
- (setq matched-pos (point))
- (replace-match repl))))
- (end-of-line)
- (forward-char))
- (if (and (re-search-forward pat eol-mark t)
- (or (not opt-c) (y-or-n-p "Replace? ")))
- (progn
- (setq matched-pos (point))
- (replace-match repl)))
- (end-of-line)
- (forward-char))))))
- (if matched-pos (goto-char matched-pos))
- (beginning-of-line)
- (if opt-c (message "done"))))
-
-(defun ex-tag ()
- "ex tag"
- (let (tag)
- (with-current-buffer " *ex-working-space*"
- (skip-chars-forward " \t")
- (set-mark (point))
- (skip-chars-forward "^ |\t\n")
- (setq tag (buffer-substring (mark) (point))))
- (if (not (string= tag "")) (setq ex-tag tag))
- (vip-change-mode-to-emacs)
- (condition-case conditions
- (progn
- (if (string= tag "")
- (find-tag ex-tag t)
- (find-tag-other-window ex-tag))
- (vip-change-mode-to-vi))
- (error
- (vip-change-mode-to-vi)
- (vip-message-conditions conditions)))))
-
-(defun ex-write (q-flag)
- "ex write"
- (vip-default-ex-addresses t)
- (vip-get-ex-file)
- (if (string= ex-file "")
- (progn
- (if (null buffer-file-name)
- (error "No file associated with this buffer"))
- (setq ex-file buffer-file-name))
- (setq ex-file (expand-file-name ex-file)))
- (if (and (not (string= ex-file (buffer-file-name)))
- (file-exists-p ex-file)
- (not ex-variant))
- (error "\"%s\" File exists - use w! to override" ex-file))
- (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses))))
- (if (> beg end) (error "First address exceeds second"))
- (save-excursion
- (vip-enlarge-region beg end)
- (write-region (point) (mark) ex-file ex-append t)))
- (if (null buffer-file-name) (setq buffer-file-name ex-file))
- (if q-flag (save-buffers-kill-emacs)))
-
-(defun ex-yank ()
- "ex yank"
- (vip-default-ex-addresses)
- (vip-get-ex-buffer)
- (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses))))
- (if (> beg end) (error "First address exceeds second"))
- (save-excursion
- (vip-enlarge-region beg end)
- (exchange-point-and-mark)
- (if (or ex-g-flag ex-g-variant) (error "Can't yank within global"))
- (if ex-count
- (progn
- (set-mark (point))
- (forward-line (1- ex-count)))
- (set-mark end))
- (vip-enlarge-region (point) (mark))
- (if ex-flag (error "Extra characters at end of command"))
- (if ex-buffer
- (copy-to-register ex-buffer (point) (mark) nil))
- (copy-region-as-kill (point) (mark)))))
-
-(defun ex-command ()
- "execute shell command"
- (let (command)
- (with-current-buffer " *ex-working-space*"
- (skip-chars-forward " \t")
- (set-mark (point))
- (end-of-line)
- (setq command (buffer-substring (mark) (point))))
- (if (null ex-addresses)
- (shell-command command)
- (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses))))
- (if (null beg) (setq beg end))
- (save-excursion
- (goto-char beg)
- (set-mark end)
- (vip-enlarge-region (point) (mark))
- (shell-command-on-region (point) (mark) command t t))
- (goto-char beg)))))
-
-(defun ex-line-no ()
- "print line number"
- (message "%d"
- (1+ (count-lines
- (point-min)
- (if (null ex-addresses) (point-max) (car ex-addresses))))))
-
-(if (file-exists-p vip-startup-file) (load vip-startup-file))
-
-(provide 'vip)
-
-;;; vip.el ends here