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.

7 files changed, 8858 insertions, 0 deletions

diff --git a/lisp/obsolete/crisp.el b/lisp/obsolete/crisp.el
new file mode 100644
index 00000000000..47cf898190b
--- /dev/null
+++ b/lisp/obsolete/crisp.el
@@ -0,0 +1,387 @@
+;;; crisp.el --- CRiSP/Brief Emacs emulator
+
+;; Copyright (C) 1997-1999, 2001-2014 Free Software Foundation, Inc.
+
+;; Author: Gary D. Foster <Gary.Foster@Corp.Sun.COM>
+;; Keywords: emulations brief crisp
+;; Obsolete-since: 24.5
+
+;; 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:
+
+;; Keybindings and minor functions to duplicate the functionality and
+;; finger-feel of the CRiSP/Brief editor.  This package is designed to
+;; facilitate transitioning from Brief to (XE|E)macs with a minimum
+;; amount of hassles.
+
+;; Enable this package by putting (require 'crisp) in your .emacs and
+;; use M-x crisp-mode to toggle it on or off.
+
+;; This package will automatically load the scroll-all.el package if
+;; you put (setq crisp-load-scroll-all t) in your .emacs before
+;; loading this package.  If this feature is enabled, it will bind
+;; meta-f1 to the scroll-all mode toggle.  The scroll-all package
+;; duplicates the scroll-all feature in CRiSP.
+
+;; Also, the default keybindings for brief/CRiSP override the M-x
+;; key to exit the editor.  If you don't like this functionality, you
+;; can prevent this behavior (or redefine it dynamically) by setting
+;; the value of `crisp-override-meta-x' either in your .emacs or
+;; interactively.  The default setting is t, which means that M-x will
+;; by default run `save-buffers-kill-emacs' instead of the command
+;; `execute-extended-command'.
+
+;; Finally, if you want to change the string displayed in the mode
+;; line when this mode is in effect, override the definition of
+;; `crisp-mode-mode-line-string' in your .emacs.  The default value is
+;; " *Crisp*" which may be a bit lengthy if you have a lot of things
+;; being displayed there.
+
+;; All these overrides should go *before* the (require 'crisp) statement.
+
+;;; Code:
+
+;; local variables
+
+(defgroup crisp nil
+  "Emulator for CRiSP and Brief key bindings."
+  :prefix "crisp-"
+  :group 'emulations)
+
+(defvar crisp-mode-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map [(f1)]           'other-window)
+
+    (define-key map [(f2) (down)]    'enlarge-window)
+    (define-key map [(f2) (left)]    'shrink-window-horizontally)
+    (define-key map [(f2) (right)]   'enlarge-window-horizontally)
+    (define-key map [(f2) (up)]      'shrink-window)
+    (define-key map [(f3) (down)]    'split-window-below)
+    (define-key map [(f3) (right)]   'split-window-right)
+
+    (define-key map [(f4)]           'delete-window)
+    (define-key map [(control f4)]   'delete-other-windows)
+
+    (define-key map [(f5)]           'search-forward-regexp)
+    (define-key map [(f19)]          'search-forward-regexp)
+    (define-key map [(meta f5)]      'search-backward-regexp)
+
+    (define-key map [(f6)]           'query-replace)
+
+    (define-key map [(f7)]           'start-kbd-macro)
+    (define-key map [(meta f7)]      'end-kbd-macro)
+
+    (define-key map [(f8)]           'call-last-kbd-macro)
+    (define-key map [(meta f8)]      'save-kbd-macro)
+
+    (define-key map [(f9)]           'find-file)
+    (define-key map [(meta f9)]      'load-library)
+
+    (define-key map [(f10)]          'execute-extended-command)
+    (define-key map [(meta f10)]     'compile)
+
+    (define-key map [(SunF37)]       'kill-buffer)
+    (define-key map [(kp-add)]       'crisp-copy-line)
+    (define-key map [(kp-subtract)]  'crisp-kill-line)
+    ;; just to cover all the bases (GNU Emacs, for instance)
+    (define-key map [(f24)]          'crisp-kill-line)
+    (define-key map [(insert)]       'crisp-yank-clipboard)
+    (define-key map [(f16)]          'crisp-set-clipboard) ; copy on Sun5 kbd
+    (define-key map [(f20)]          'crisp-kill-region) ; cut on Sun5 kbd
+    (define-key map [(f18)]          'crisp-yank-clipboard) ; paste on Sun5 kbd
+
+    (define-key map [(control f)]    'fill-paragraph-or-region)
+    (define-key map [(meta d)]       (lambda ()
+                                       (interactive)
+                                       (beginning-of-line) (kill-line)))
+    (define-key map [(meta e)]       'find-file)
+    (define-key map [(meta g)]       'goto-line)
+    (define-key map [(meta h)]       'help)
+    (define-key map [(meta i)]       'overwrite-mode)
+    (define-key map [(meta j)]       'bookmark-jump)
+    (define-key map [(meta l)]       'crisp-mark-line)
+    (define-key map [(meta m)]       'set-mark-command)
+    (define-key map [(meta n)]       'bury-buffer)
+    (define-key map [(meta p)]       'crisp-unbury-buffer)
+    (define-key map [(meta u)]       'undo)
+    (define-key map [(f14)]          'undo)
+    (define-key map [(meta w)]       'save-buffer)
+    (define-key map [(meta x)]       'crisp-meta-x-wrapper)
+    (define-key map [(meta ?0)]      (lambda ()
+                                       (interactive)
+                                       (bookmark-set "0")))
+    (define-key map [(meta ?1)]      (lambda ()
+                                       (interactive)
+                                       (bookmark-set "1")))
+    (define-key map [(meta ?2)]      (lambda ()
+                                       (interactive)
+                                       (bookmark-set "2")))
+    (define-key map [(meta ?3)]      (lambda ()
+                                       (interactive)
+                                       (bookmark-set "3")))
+    (define-key map [(meta ?4)]      (lambda ()
+                                       (interactive)
+                                       (bookmark-set "4")))
+    (define-key map [(meta ?5)]      (lambda ()
+                                       (interactive)
+                                       (bookmark-set "5")))
+    (define-key map [(meta ?6)]      (lambda ()
+                                       (interactive)
+                                       (bookmark-set "6")))
+    (define-key map [(meta ?7)]      (lambda ()
+                                       (interactive)
+                                       (bookmark-set "7")))
+    (define-key map [(meta ?8)]      (lambda ()
+                                       (interactive)
+                                       (bookmark-set "8")))
+    (define-key map [(meta ?9)]      (lambda ()
+                                       (interactive)
+                                       (bookmark-set "9")))
+
+    (define-key map [(shift delete)]    'kill-word)
+    (define-key map [(shift backspace)] 'backward-kill-word)
+    (define-key map [(control left)]    'backward-word)
+    (define-key map [(control right)]   'forward-word)
+
+    (define-key map [(home)]            'crisp-home)
+    (define-key map [(control home)]    (lambda ()
+                                          (interactive)
+                                          (move-to-window-line 0)))
+    (define-key map [(meta home)]       'beginning-of-line)
+    (define-key map [(end)]             'crisp-end)
+    (define-key map [(control end)]     (lambda ()
+                                          (interactive)
+                                          (move-to-window-line -1)))
+    (define-key map [(meta end)]        'end-of-line)
+    map)
+  "Local keymap for CRiSP emulation mode.
+All the bindings are done here instead of globally to try and be
+nice to the world.")
+
+(define-obsolete-variable-alias 'crisp-mode-modeline-string
+  'crisp-mode-mode-line-string "24.3")
+
+(defcustom crisp-mode-mode-line-string " *CRiSP*"
+  "String to display in the mode line when CRiSP emulation mode is enabled."
+  :type 'string
+  :group 'crisp)
+
+;;;###autoload
+(defcustom crisp-mode nil
+  "Track status of CRiSP emulation mode.
+A value of nil means CRiSP mode is not enabled.  A value of t
+indicates CRiSP mode is enabled.
+
+Setting this variable directly does not take effect;
+use either M-x customize or the function `crisp-mode'."
+  :set (lambda (symbol value) (crisp-mode (if value 1 0)))
+  :initialize 'custom-initialize-default
+  :require 'crisp
+  :version "20.4"
+  :type 'boolean
+  :group 'crisp)
+
+(defcustom crisp-override-meta-x t
+  "Controls overriding the normal Emacs M-x key binding in the CRiSP emulator.
+Normally the CRiSP emulator rebinds M-x to `save-buffers-exit-emacs', and
+provides the usual M-x functionality on the F10 key.  If this variable
+is non-nil, M-x will exit Emacs."
+  :type 'boolean
+  :group 'crisp)
+
+(defcustom crisp-load-scroll-all nil
+  "Controls loading of the Scroll Lock in the CRiSP emulator.
+Its default behavior is to load and enable the Scroll Lock minor mode
+package when enabling the CRiSP emulator.
+
+If this variable is nil when you start the CRiSP emulator, it
+does not load the scroll-all package."
+  :type 'boolean
+  :group 'crisp)
+
+(defcustom crisp-load-hook nil
+  "Hooks to run after loading the CRiSP emulator package."
+  :type 'hook
+  :group 'crisp)
+
+(defcustom crisp-mode-hook nil
+  "Hook run by the function `crisp-mode'."
+  :type 'hook
+  :group 'crisp)
+
+(defconst crisp-version "1.34"
+  "The version of the CRiSP emulator.")
+
+(defconst crisp-mode-help-address "gfoster@suzieq.ml.org"
+  "The email address of the CRiSP mode author/maintainer.")
+
+;; Silence the byte-compiler.
+(defvar crisp-last-last-command nil
+  "The previous value of `last-command'.")
+
+;; The cut and paste routines are different between XEmacs and Emacs
+;; so we need to set up aliases for the functions.
+
+(defalias 'crisp-set-clipboard
+  (if (fboundp 'clipboard-kill-ring-save)
+      'clipboard-kill-ring-save
+    'copy-primary-selection))
+
+(defalias 'crisp-kill-region
+  (if (fboundp 'clipboard-kill-region)
+      'clipboard-kill-region
+    'kill-primary-selection))
+
+(defalias 'crisp-yank-clipboard
+  (if (fboundp 'clipboard-yank)
+      'clipboard-yank
+    'yank-clipboard-selection))
+
+(defun crisp-region-active ()
+  "Compatibility function to test for an active region."
+  (if (featurep 'xemacs)
+      zmacs-region-active-p
+    mark-active))
+
+(defun crisp-version (&optional arg)
+  "Version number of the CRiSP emulator package.
+If ARG, insert results at point."
+  (interactive "P")
+  (let ((foo (concat "CRiSP version " crisp-version)))
+    (if arg
+	(insert (message foo))
+      (message foo))))
+
+(defun crisp-mark-line (arg)
+  "Set mark at the end of the line.
+Arg works as in `end-of-line'."
+  (interactive "p")
+  (let (newmark)
+    (save-excursion
+      (end-of-line arg)
+      (setq newmark (point)))
+    (push-mark newmark nil t)))
+
+(defun crisp-kill-line (arg)
+  "Mark and kill line(s).
+Marks from point to end of the current line (honoring prefix arguments),
+copies the region to the kill ring and clipboard, and then deletes it."
+  (interactive "*p")
+  (if (crisp-region-active)
+      (call-interactively 'crisp-kill-region)
+    (crisp-mark-line arg)
+    (call-interactively 'crisp-kill-region)))
+
+(defun crisp-copy-line (arg)
+  "Mark and copy line(s).
+Marks from point to end of the current line (honoring prefix arguments),
+copies the region to the kill ring and clipboard, and then deactivates
+the region."
+  (interactive "*p")
+    (if (crisp-region-active)
+	(call-interactively 'crisp-set-clipboard)
+      (crisp-mark-line arg)
+      (call-interactively 'crisp-set-clipboard))
+    ;; clear the region after the operation is complete
+    ;; XEmacs does this automagically, Emacs doesn't.
+    (if (boundp 'mark-active)
+	(setq mark-active nil)))
+
+(defun crisp-home ()
+  "\"Home\" the point, the way CRiSP would do it.
+The first use moves point to beginning of the line.  Second
+consecutive use moves point to beginning of the screen.  Third
+consecutive use moves point to the beginning of the buffer."
+  (interactive nil)
+  (cond
+    ((and (eq last-command 'crisp-home)
+	  (eq crisp-last-last-command 'crisp-home))
+     (goto-char (point-min)))
+    ((eq last-command 'crisp-home)
+     (move-to-window-line 0))
+    (t
+     (beginning-of-line)))
+  (setq crisp-last-last-command last-command))
+
+(defun crisp-end ()
+  "\"End\" the point, the way CRiSP would do it.
+The first use moves point to end of the line.  Second
+consecutive use moves point to the end of the screen.  Third
+consecutive use moves point to the end of the buffer."
+  (interactive nil)
+  (cond
+    ((and (eq last-command 'crisp-end)
+	  (eq crisp-last-last-command 'crisp-end))
+     (goto-char (point-max)))
+    ((eq last-command 'crisp-end)
+     (move-to-window-line -1)
+     (end-of-line))
+    (t
+     (end-of-line)))
+  (setq crisp-last-last-command last-command))
+
+(defun crisp-unbury-buffer ()
+  "Go back one buffer."
+  (interactive)
+  (switch-to-buffer (car (last (buffer-list)))))
+
+(defun crisp-meta-x-wrapper ()
+  "Wrapper function to conditionally override the normal M-x bindings.
+When `crisp-override-meta-x' is non-nil, M-x will exit Emacs (the
+normal CRiSP binding) and when it is nil M-x will run
+`execute-extended-command' (the normal Emacs binding)."
+  (interactive)
+  (if crisp-override-meta-x
+      (save-buffers-kill-emacs)
+    (call-interactively 'execute-extended-command)))
+
+;;;###autoload
+(define-minor-mode crisp-mode
+  "Toggle CRiSP/Brief emulation (CRiSP mode).
+With a prefix argument ARG, enable CRiSP mode if ARG is positive,
+and disable it otherwise.  If called from Lisp, enable the mode
+if ARG is omitted or nil."
+  :keymap crisp-mode-map
+  :lighter crisp-mode-mode-line-string
+  (when crisp-mode
+    ;; Make menu entries show M-u or f14 in preference to C-x u.
+    (put 'undo :advertised-binding
+         `([?\M-u] [f14] ,@(get 'undo :advertised-binding)))
+    ;; Force transient-mark-mode, so that the marking routines work as
+    ;; expected.  If the user turns off transient mark mode, most
+    ;; things will still work fine except the crisp-(copy|kill)
+    ;; functions won't work quite as nicely when regions are marked
+    ;; differently and could really confuse people.  Caveat emptor.
+    (if (fboundp 'transient-mark-mode)
+	(transient-mark-mode t))
+    (if crisp-load-scroll-all
+	(require 'scroll-all))
+    (if (featurep 'scroll-all)
+	(define-key crisp-mode-map [(meta f1)] 'scroll-all-mode))))
+
+;; People might use Apropos on `brief'.
+;;;###autoload
+(defalias 'brief-mode 'crisp-mode)
+
+;; Interaction with other packages.
+(put 'crisp-home 'CUA 'move)
+(put 'crisp-end  'CUA 'move)
+
+(run-hooks 'crisp-load-hook)
+(provide 'crisp)
+
+;;; crisp.el ends here
diff --git a/lisp/obsolete/tpu-edt.el b/lisp/obsolete/tpu-edt.el
new file mode 100644
index 00000000000..43189319a6a
--- /dev/null
+++ b/lisp/obsolete/tpu-edt.el
@@ -0,0 +1,2472 @@
+;;; tpu-edt.el --- Emacs emulating TPU emulating EDT
+
+;; Copyright (C) 1993-1995, 2000-2014 Free Software Foundation, Inc.
+
+;; Author: Rob Riepel <riepel@networking.stanford.edu>
+;; Maintainer: Rob Riepel <riepel@networking.stanford.edu>
+;; Version: 4.5
+;; Keywords: emulations
+;; Obsolete-since: 24.5
+
+;; 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/>.
+
+;; TPU-edt is based on tpu.el by Jeff Kowalski and Bob Covey.
+
+;;; Commentary:
+
+;; %% TPU-edt -- Emacs emulating TPU emulating EDT
+
+;; %% Contents
+
+;;  % Introduction
+;;  % Differences Between TPU-edt and DEC TPU/edt
+;;  % Starting TPU-edt
+;;  % Customizing TPU-edt using the Emacs Initialization File
+;;  % Regular Expressions in TPU-edt
+
+
+;; %% Introduction
+
+;;    TPU-edt emulates the popular DEC VMS editor EDT (actually, it emulates
+;;    DEC TPU's EDT emulation, hence the name TPU-edt).  TPU-edt features the
+;;    following TPU/edt functionality:
+
+;;     .  EDT keypad
+;;     .  On-line help
+;;     .  Repeat counts
+;;     .  Scroll margins
+;;     .  Learn sequences
+;;     .  Free cursor mode
+;;     .  Rectangular cut and paste
+;;     .  Multiple windows and buffers
+;;     .  TPU line-mode REPLACE command
+;;     .  Wild card search and substitution
+;;     .  Configurable through an initialization file
+;;     .  History recall of search strings, file names, and commands
+
+;;    Please note that TPU-edt does NOT emulate TPU.  It emulates TPU's EDT
+;;    emulation.  Very few TPU line-mode commands are supported.
+
+;;    TPU-edt, like its VMS cousin, works on VT-series terminals with DEC
+;;    style keyboards.  VT terminal emulators, including xterm with the
+;;    appropriate key translations, work just fine too.
+
+;;    TPU-edt works with X-windows.  This is accomplished through a TPU-edt
+;;    X key map.  The tpu-mapper command creates this map and stores it in a
+;;    file.  See the tpu-mapper command help for more information, or just
+;;    run it and follow the directions.
+
+
+;; %% Differences Between TPU-edt and DEC TPU/edt
+
+;;    In some cases, Emacs doesn't support text highlighting, so selected
+;;    regions are not shown in inverse video.  Emacs uses the concept of "the
+;;    mark".  The mark is set at one end of a selected region; the cursor is
+;;    at the other.  In cases where the selected region cannot be shown in
+;;    inverse video an at sign (@) appears in the mode line when mark is set.
+;;    The native Emacs command ^X^X (Control-X twice) exchanges the cursor
+;;    with the mark; this provides a handy way to find the location of the
+;;    mark.
+
+;;    In TPU the cursor can be either bound or free.  Bound means the cursor
+;;    cannot wander outside the text of the file being edited.  Free means
+;;    the arrow keys can move the cursor past the ends of lines.  Free is the
+;;    default mode in TPU; bound is the only mode in EDT.  Bound is the only
+;;    mode in the base version of TPU-edt; optional extensions add an
+;;    approximation of free mode, see the commentary in tpu-extras.el for
+;;    details.
+
+;;    Like TPU, Emacs uses multiple buffers.  Some buffers are used to hold
+;;    files you are editing; other "internal" buffers are used for Emacs's own
+;;    purposes (like showing you help).  Here are some commands for dealing
+;;    with buffers.
+
+;;       Gold-B   moves to next buffer, including internal buffers
+;;       Gold-N   moves to next buffer containing a file
+;;       Gold-M   brings up a buffer menu (like TPU "show buffers")
+
+;;    Emacs is very fond of throwing up new windows.  Dealing with all these
+;;    windows can be a little confusing at first, so here are a few commands
+;;    to that may help:
+
+;;       Gold-Next_Scr  moves to the next window on the screen
+;;       Gold-Prev_Scr  moves to the previous window on the screen
+;;       Gold-TAB       also moves to the next window on the screen
+
+;;       Control-x 1    deletes all but the current window
+;;       Control-x 0    deletes the current window
+
+;;    Note that the buffers associated with deleted windows still exist!
+
+;;    Like TPU, TPU-edt has a "command" function, invoked with Gold-KP7 or
+;;    Do.  Most of the commands available are Emacs commands.  Some TPU
+;;    commands are available, they are: replace, exit, quit, include, and
+;;    Get (unfortunately, "get" is an internal Emacs function, so we are
+;;    stuck with "Get" - to make life easier, Get is available as Gold-g).
+
+;;    TPU-edt supports the recall of commands, file names, and search
+;;    strings.  The history of strings recalled differs slightly from
+;;    TPU/edt, but it is still very convenient.
+
+;;    Help is available!  The traditional help keys (Help and PF2) display
+;;    a small help file showing the default keypad layout, control key
+;;    functions, and Gold key functions.  Pressing any key inside of help
+;;    splits the screen and prints a description of the function of the
+;;    pressed key.  Gold-PF2 invokes the native Emacs help, with its
+;;    zillions of options.
+
+;;    Thanks to Emacs, TPU-edt has some extensions that may make your life
+;;    easier, or at least more interesting.  For example, Gold-r toggles
+;;    TPU-edt rectangular mode.  In rectangular mode, Remove and Insert work
+;;    on rectangles.  Likewise, Gold-* toggles TPU-edt regular expression
+;;    mode.  In regular expression mode Find, Find Next, and the line-mode
+;;    replace command work with regular expressions.  [A regular expression
+;;    is a pattern that denotes a set of strings; like VMS wildcards.]
+
+;;    Emacs also gives TPU-edt the undo and occur functions.  Undo does
+;;    what it says; it undoes the last change.  Multiple undos in a row
+;;    undo multiple changes.  For your convenience, undo is available on
+;;    Gold-u.  Occur shows all the lines containing a specific string in
+;;    another window.  Moving to that window, and typing ^C^C (Control-C
+;;    twice) on a particular line moves you back to the original window
+;;    at that line.  Occur is on Gold-o.
+
+;;    Finally, as you edit, remember that all the power of Emacs is at
+;;    your disposal.  It really is a fantastic tool.  You may even want to
+;;    take some time and read the Emacs tutorial; perhaps not to learn the
+;;    native Emacs key bindings, but to get a feel for all the things
+;;    Emacs can do for you.  The Emacs tutorial is available from the
+;;    Emacs help function: "Gold-PF2 t"
+
+
+;; %% Starting TPU-edt
+
+;;    All you have to do to start TPU-edt, is turn it on.  This can be
+;;    done from the command line when running Emacs.
+
+;;        prompt> emacs -f tpu-edt
+
+;;    If you've already started Emacs, turn on TPU-edt using the tpu-edt
+;;    command.  First press `M-x' (that's usually `ESC' followed by `x')
+;;    and type `tpu-edt' followed by a carriage return.
+
+;;    If you like TPU-edt and want to use it all the time, you can start
+;;    TPU-edt using the Emacs initialization file, .emacs.  Simply add
+;;    the following line to your init file:
+
+;;        (tpu-edt)
+
+;;    That's all you need to do to start TPU-edt.
+
+
+;; %% Customizing TPU-edt using the Emacs Initialization File
+
+;;    The following is a sample Emacs initialization file.  It shows how to
+;;    invoke TPU-edt, and how to customize it.
+
+;;    ; .emacs - a sample Emacs initialization file
+
+;;    ; Turn on TPU-edt
+;;    (tpu-edt)
+
+;;    ; Set scroll margins 10% (top) and 15% (bottom).
+;;    (tpu-set-scroll-margins "10%" "15%")
+
+;;    ; Load the vtxxx terminal control functions.
+;;    (load "vt-control" t)
+
+;;    ; TPU-edt treats words like EDT; here's how to add word separators.
+;;    ; Note that backslash (\) and double quote (") are quoted with '\'.
+;;    (tpu-add-word-separators "]\\[-_,.\"=+()'/*#:!&;$")
+
+;;    ; Emacs is happy to save files without a final newline; other Unix
+;;    ; programs hate that!  Here we make sure that files end with newlines.
+;;    (setq require-final-newline t)
+
+;;    ; Emacs uses Control-s and Control-q.  Problems can occur when using
+;;    ; Emacs on terminals that use these codes for flow control (Xon/Xoff
+;;    ; flow control).  These lines disable Emacs's use of these characters.
+;;    (global-unset-key "\C-s")
+;;    (global-unset-key "\C-q")
+
+;;    ; The Emacs universal-argument function is very useful.
+;;    ; This line maps universal-argument to Gold-PF1.
+;;    (define-key tpu-gold-map [kp_f1] 'universal-argument)      ; Gold-PF1
+
+;;    ; Make KP7 move by paragraphs, instead of pages.
+;;    (define-key tpu-global-map [kf_7] 'tpu-paragraph)          ; KP7
+
+;;    ; Repeat the preceding mappings for X-windows.
+;;    (cond
+;;     (window-system
+;;      (define-key tpu-global-map [kp_7] 'tpu-paragraph)        ; KP7
+;;      (define-key tpu-gold-map [kp_f1] 'universal-argument)))  ; GOLD-PF1
+
+;;    ; Display the TPU-edt version.
+;;    (tpu-version)
+
+
+;; %% Regular Expressions in TPU-edt
+
+;;    Gold-* toggles TPU-edt regular expression mode.  In regular expression
+;;    mode, find, find next, replace, and substitute accept Emacs regular
+;;    expressions.  A complete list of Emacs regular expressions can be found
+;;    using the Emacs "info" command (it's somewhat like the VMS help
+;;    command).  Try the following sequence of commands:
+
+;;        DO info             <enter info mode>
+;;        m emacs             <select the "emacs" topic>
+;;        m regexs            <select the "regular expression" topic>
+
+;;    Type "q" to quit out of info mode.
+
+;;    There is a problem in regular expression mode when searching for empty
+;;    strings, like beginning-of-line (^) and end-of-line ($).  When searching
+;;    for these strings, find-next may find the current string, instead of the
+;;    next one.  This can cause global replace and substitute commands to loop
+;;    forever in the same location.  For this reason, commands like
+
+;;        replace "^" "> "       <add "> " to beginning of line>
+;;        replace "$" "00711"    <add "00711" to end of line>
+
+;;    may not work properly.
+
+;;    Commands like those above are very useful for adding text to the
+;;    beginning or end of lines.  They might work on a line-by-line basis, but
+;;    go into an infinite loop if the "all" response is specified.  If the
+;;    goal is to add a string to the beginning or end of a particular set of
+;;    lines TPU-edt provides functions to do this.
+
+;;        Gold-^  Add a string at BOL in region or buffer
+;;        Gold-$  Add a string at EOL in region or buffer
+
+;;    There is also a TPU-edt interface to the native Emacs string replacement
+;;    commands.  Gold-/ invokes this command.  It accepts regular expressions
+;;    if TPU-edt is in regular expression mode.  Given a repeat count, it will
+;;    perform the replacement without prompting for confirmation.
+
+;;    This command replaces empty strings correctly, however, it has its
+;;    drawbacks.  As a native Emacs command, it has a different interface
+;;    than the emulated TPU commands.  Also, it works only in the forward
+;;    direction, regardless of the current TPU-edt direction.
+
+;;; Todo/Bugs:
+
+;; We shouldn't use vt100 ESC sequences since it is uselessly fighting
+;; against function-key-map.  Better use real key names.
+
+;;; Code:
+
+;; we use picture-mode functions
+(require 'picture)
+
+(defgroup tpu nil
+  "Emacs emulating TPU emulating EDT."
+  :prefix "tpu-"
+  :group 'emulations)
+
+
+;;;
+;;;  Version Information
+;;;
+(defconst tpu-version "4.5" "TPU-edt version number.")
+
+
+;;;
+;;;  User Configurable Variables
+;;;
+(defcustom tpu-have-ispell t
+  "Non-nil means `tpu-spell-check' uses `ispell-region' for spell checking.
+Otherwise, use `spell-region'."
+  :type 'boolean
+  :group 'tpu)
+(make-obsolete-variable 'tpu-have-ispell "the `spell' package is obsolete."
+                        "23.1")
+
+(defcustom tpu-kill-buffers-silently nil
+  "If non-nil, TPU-edt kills modified buffers without asking."
+  :type 'boolean
+  :group 'tpu)
+
+(defcustom tpu-percent-scroll 75
+  "Percentage of the screen to scroll for next/previous screen commands."
+  :type 'integer
+  :group 'tpu)
+
+(defcustom tpu-pan-columns 16
+  "Number of columns the tpu-pan functions scroll left or right."
+  :type 'integer
+  :group 'tpu)
+
+
+;;;
+;;;  Global Keymaps
+;;;
+
+(define-obsolete-variable-alias 'GOLD-map 'tpu-gold-map "23.1")
+(defvar tpu-gold-map
+  (let ((map (make-keymap)))
+    ;; Previously we used escape sequences here.  We now instead presume
+    ;; that term/*.el does its job to map the escape sequence to the right
+    ;; key-symbol.
+
+    (define-key map [up]    'tpu-move-to-beginning)	; up-arrow
+    (define-key map [down]  'tpu-move-to-end)		; down-arrow
+    (define-key map [right] 'end-of-line)		; right-arrow
+    (define-key map [left]  'beginning-of-line)		; left-arrow
+
+    ;; (define-key map [find]   nil)			; Find
+    ;; (define-key map [insert] nil)			; Insert Here
+    (define-key map [delete] 'tpu-store-text)		; Remove
+    (define-key map [select] 'tpu-unselect)		; Select
+    (define-key map [prior]  'tpu-previous-window)	; Prev Screen
+    (define-key map [next]   'tpu-next-window)		; Next Screen
+
+    ;; (define-key map [f1] nil)			; F1
+    ;; (define-key map [f2] nil)			; F2
+    ;; (define-key map [f3] nil)			; F3
+    ;; (define-key map [f4] nil)			; F4
+    ;; (define-key map [f5] nil)			; F5
+    ;; (define-key map [f6] nil)			; F6
+    ;; (define-key map [f7] nil)			; F7
+    ;; (define-key map [f8] nil)			; F8
+    ;; (define-key map [f9] nil)			; F9
+    ;; (define-key map [f10] nil)			; F10
+    ;; (define-key map [f11] nil)			; F11
+    ;; (define-key map [f12] nil)			; F12
+    ;; (define-key map [f13] nil)			; F13
+    ;; (define-key map [f14] nil)			; F14
+    (define-key map [help] 'describe-bindings)		; HELP
+    ;; (define-key map [menu] nil)			; DO
+    (define-key map [f17] 'tpu-drop-breadcrumb)		; F17
+    ;; (define-key map [f18] nil)			; F18
+    ;; (define-key map [f19] nil)			; F19
+    ;; (define-key map [f20] nil)			; F20
+
+    (define-key map [kp-f1] 'keyboard-quit)		; PF1
+    (define-key map [kp-f2] 'help-for-help)		; PF2
+    (define-key map [kp-f3] 'tpu-search)		; PF3
+    (define-key map [kp-f4] 'tpu-undelete-lines)	; PF4
+    (define-key map [kp-0] 'open-line)			; KP0
+    (define-key map [kp-1] 'tpu-change-case)		; KP1
+    (define-key map [kp-2] 'tpu-delete-to-eol)		; KP2
+    (define-key map [kp-3] 'tpu-special-insert)		; KP3
+    (define-key map [kp-4] 'tpu-move-to-end)		; KP4
+    (define-key map [kp-5] 'tpu-move-to-beginning)	; KP5
+    (define-key map [kp-6] 'tpu-paste)			; KP6
+    (define-key map [kp-7] 'execute-extended-command)	; KP7
+    (define-key map [kp-8] 'tpu-fill)			; KP8
+    (define-key map [kp-9] 'tpu-replace)		; KP9
+    (define-key map [kp-subtract] 'tpu-undelete-words)	; KP-
+    (define-key map [kp-separator] 'tpu-undelete-char)	; KP,
+    (define-key map [kp-decimal] 'tpu-unselect)		; KP.
+    (define-key map [kp-enter] 'tpu-substitute)		; KPenter
+
+    ;;
+    (define-key map "\C-A" 'tpu-toggle-overwrite-mode)	; ^A
+    ;; (define-key map "\C-B" nil)			; ^B
+    ;; (define-key map "\C-C" nil)			; ^C
+    ;; (define-key map "\C-D" nil)			; ^D
+    ;; (define-key map "\C-E" nil)			; ^E
+    (define-key map "\C-F" 'set-visited-file-name)	; ^F
+    (define-key map "\C-g" 'keyboard-quit)		; safety first
+    (define-key map "\C-h" 'delete-other-windows)	; BS
+    (define-key map "\C-i" 'other-window)		; TAB
+    ;; (define-key map "\C-J" nil)			; ^J
+    (define-key map "\C-K" 'tpu-define-macro-key)	; ^K
+    (define-key map "\C-l" 'downcase-region)		; ^L
+    ;; (define-key map "\C-M" nil)			; ^M
+    ;; (define-key map "\C-N" nil)			; ^N
+    ;; (define-key map "\C-O" nil)			; ^O
+    ;; (define-key map "\C-P" nil)			; ^P
+    ;; (define-key map "\C-Q" nil)			; ^Q
+    ;; (define-key map "\C-R" nil)			; ^R
+    ;; (define-key map "\C-S" nil)			; ^S
+    (define-key map "\C-T" 'tpu-toggle-control-keys)	; ^T
+    (define-key map "\C-u" 'upcase-region)		; ^U
+    ;; (define-key map "\C-V" nil)			; ^V
+    (define-key map "\C-w" 'tpu-write-current-buffers)	; ^W
+    ;; (define-key map "\C-X" nil)			; ^X
+    ;; (define-key map "\C-Y" nil)			; ^Y
+    ;; (define-key map "\C-Z" nil)			; ^Z
+    (define-key map " " 'undo)				; SPC
+    ;; (define-key map "!" nil)				; !
+    ;; (define-key map "#" nil)				; #
+    (define-key map "$" 'tpu-add-at-eol)		; $
+    (define-key map "%" 'tpu-goto-percent)		; %
+    ;; (define-key map "&" nil)				; &
+    ;; (define-key map "(" nil)				; (
+    ;; (define-key map ")" nil)				; )
+    (define-key map "*" 'tpu-toggle-regexp)		; *
+    ;; (define-key map "+" nil)				; +
+    (define-key map "," 'tpu-goto-breadcrumb)		; ,
+    (define-key map "-" 'negative-argument)		; -
+    (define-key map "." 'tpu-drop-breadcrumb)		; .
+    (define-key map "/" 'tpu-emacs-replace)		; /
+    (define-key map "0" 'digit-argument)		; 0
+    (define-key map "1" 'digit-argument)		; 1
+    (define-key map "2" 'digit-argument)		; 2
+    (define-key map "3" 'digit-argument)		; 3
+    (define-key map "4" 'digit-argument)		; 4
+    (define-key map "5" 'digit-argument)		; 5
+    (define-key map "6" 'digit-argument)		; 6
+    (define-key map "7" 'digit-argument)		; 7
+    (define-key map "8" 'digit-argument)		; 8
+    (define-key map "9" 'digit-argument)		; 9
+    ;; (define-key map ":" nil)				; :
+    (define-key map ";" 'tpu-trim-line-ends)		; ;
+    ;; (define-key map "<" nil)				; <
+    ;; (define-key map "=" nil)				; =
+    ;; (define-key map ">" nil)				; >
+    (define-key map "?" 'tpu-spell-check)		; ?
+    ;; (define-key map "A" 'tpu-toggle-newline-and-indent) ; A
+    ;; (define-key map "B" 'tpu-next-buffer)		; B
+    ;; (define-key map "C" 'repeat-complex-command)	; C
+    ;; (define-key map "D" 'shell-command)		; D
+    ;; (define-key map "E" 'tpu-exit)			; E
+    ;; (define-key map "F" 'tpu-cursor-free-mode)	; F
+    ;; (define-key map "G" 'tpu-get)			; G
+    ;; (define-key map "H" nil)				; H
+    ;; (define-key map "I" 'tpu-include)		; I
+    ;; (define-key map "K" 'tpu-kill-buffer)		; K
+    (define-key map "L" 'tpu-what-line)			; L
+    ;; (define-key map "M" 'buffer-menu)		; M
+    ;; (define-key map "N" 'tpu-next-file-buffer)	; N
+    ;; (define-key map "O" 'occur)			; O
+    (define-key map "P" 'lpr-buffer)			; P
+    ;; (define-key map "Q" 'tpu-quit)			; Q
+    ;; (define-key map "R" 'tpu-toggle-rectangle)	; R
+    ;; (define-key map "S" 'replace)			; S
+    ;; (define-key map "T" 'tpu-line-to-top-of-window)	; T
+    ;; (define-key map "U" 'undo)			; U
+    ;; (define-key map "V" 'tpu-version)		; V
+    ;; (define-key map "W" 'save-buffer)		; W
+    ;; (define-key map "X" 'tpu-save-all-buffers-kill-emacs) ; X
+    ;; (define-key map "Y" 'copy-region-as-kill)	; Y
+    ;; (define-key map "Z" 'suspend-emacs)		; Z
+    (define-key map "[" 'blink-matching-open)		; [
+    ;; (define-key map "\\" nil)			; \
+    (define-key map "]" 'blink-matching-open)		; ]
+    (define-key map "^" 'tpu-add-at-bol)		; ^
+    (define-key map "_" 'split-window-below)	        ; -
+    (define-key map "`" 'what-line)			; `
+    (define-key map "a" 'tpu-toggle-newline-and-indent)	; a
+    (define-key map "b" 'tpu-next-buffer)		; b
+    (define-key map "c" 'repeat-complex-command)	; c
+    (define-key map "d" 'shell-command)			; d
+    (define-key map "e" 'tpu-exit)			; e
+    (define-key map "f" 'tpu-cursor-free-mode)		; f
+    (define-key map "g" 'tpu-get)			; g
+    ;; (define-key map "h" nil)				; h
+    (define-key map "i" 'tpu-include)			; i
+    (define-key map "k" 'tpu-kill-buffer)		; k
+    (define-key map "l" 'goto-line)			; l
+    (define-key map "m" 'buffer-menu)			; m
+    (define-key map "n" 'tpu-next-file-buffer)		; n
+    (define-key map "o" 'occur)				; o
+    (define-key map "p" 'lpr-region)			; p
+    (define-key map "q" 'tpu-quit)			; q
+    (define-key map "r" 'tpu-toggle-rectangle)		; r
+    (define-key map "s" 'replace)			; s
+    (define-key map "t" 'tpu-line-to-top-of-window)	; t
+    (define-key map "u" 'undo)				; u
+    (define-key map "v" 'tpu-version)			; v
+    (define-key map "w" 'save-buffer)			; w
+    (define-key map "x" 'tpu-save-all-buffers-kill-emacs) ; x
+    (define-key map "y" 'copy-region-as-kill)		; y
+    (define-key map "z" 'suspend-emacs)			; z
+    ;; (define-key map "{" nil)				; {
+    (define-key map "|" 'split-window-right)	        ; |
+    ;; (define-key map "}" nil)				; }
+    (define-key map "~" 'exchange-point-and-mark)	; ~
+    (define-key map "\177" 'delete-window)		; <X]
+    map)
+  "Maps the function keys on the VT100 keyboard preceded by PF1.
+GOLD is the ASCII 7-bit escape sequence <ESC>OP.")
+
+(defvar tpu-global-map
+  (let ((map (make-sparse-keymap)))
+
+    ;; Previously defined in CSI-map.  We now presume that term/*.el does
+    ;; its job to map the escape sequence to the right key-symbol.
+    (define-key map [find]   'tpu-search)		; Find
+    (define-key map [insert] 'tpu-paste)		; Insert Here
+    (define-key map [delete] 'tpu-cut)			; Remove
+    (define-key map [select] 'tpu-select)		; Select
+    (define-key map [prior]  'tpu-scroll-window-down)	; Prev Screen
+    (define-key map [next]   'tpu-scroll-window-up)	; Next Screen
+
+    ;; (define-key map [f1] nil)			; F1
+    ;; (define-key map [f2] nil)			; F2
+    ;; (define-key map [f3] nil)			; F3
+    ;; (define-key map [f4] nil)			; F4
+    ;; (define-key map [f5] nil)			; F5
+    ;; (define-key map [f6] nil)			; F6
+    ;; (define-key map [f7] nil)			; F7
+    ;; (define-key map [f8] nil)			; F8
+    ;; (define-key map [f9] nil)			; F9
+    (define-key map [f10] 'tpu-exit)			; F10
+    (define-key map [f11] 'tpu-insert-escape)		; F11 (ESC)
+    (define-key map [f12] 'tpu-next-beginning-of-line)	; F12 (BS)
+    (define-key map [f13] 'tpu-delete-previous-word)	; F13 (LF)
+    (define-key map [f14] 'tpu-toggle-overwrite-mode)	; F14
+    (define-key map [help] 'tpu-help)			; HELP
+    (define-key map [menu] 'execute-extended-command)	; DO
+    (define-key map [f17] 'tpu-goto-breadcrumb)		; F17
+    ;; (define-key map [f18] nil)			; F18
+    ;; (define-key map [f19] nil)			; F19
+    ;; (define-key map [f20] nil)			; F20
+
+
+    ;; Previously defined in SS3-map.  We now presume that term/*.el does
+    ;; its job to map the escape sequence to the right key-symbol.
+    (define-key map [kp-f1] tpu-gold-map)		; GOLD map
+    ;;
+    (define-key map [up]    'tpu-previous-line)		; up
+    (define-key map [down]  'tpu-next-line)		; down
+    (define-key map [right] 'tpu-forward-char)		; right
+    (define-key map [left]  'tpu-backward-char)		; left
+
+    (define-key map [kp-f2] 'tpu-help)			; PF2
+    (define-key map [kp-f3] 'tpu-search-again)		; PF3
+    (define-key map [kp-f4] 'tpu-delete-current-line)	; PF4
+    (define-key map [kp-0] 'tpu-line)			; KP0
+    (define-key map [kp-1] 'tpu-word)			; KP1
+    (define-key map [kp-2] 'tpu-end-of-line)		; KP2
+    (define-key map [kp-3] 'tpu-char)			; KP3
+    (define-key map [kp-4] 'tpu-advance-direction)	; KP4
+    (define-key map [kp-5] 'tpu-backup-direction)	; KP5
+    (define-key map [kp-6] 'tpu-cut)			; KP6
+    (define-key map [kp-7] 'tpu-page)			; KP7
+    (define-key map [kp-8] 'tpu-scroll-window)		; KP8
+    (define-key map [kp-9] 'tpu-append-region)		; KP9
+    (define-key map [kp-subtract] 'tpu-delete-current-word) ; KP-
+    (define-key map [kp-separator] 'tpu-delete-current-char) ; KP,
+    (define-key map [kp-decimal] 'tpu-select)		; KP.
+    (define-key map [kp-enter] 'newline)		; KPenter
+
+    map)
+  "TPU-edt global keymap.")
+
+
+;;;
+;;;  Global Variables
+;;;
+(defvar tpu-last-replaced-text ""
+  "Last text deleted by a TPU-edt replace command.")
+(defvar tpu-last-deleted-region ""
+  "Last text deleted by a TPU-edt remove command.")
+(defvar tpu-last-deleted-lines ""
+  "Last text deleted by a TPU-edt line-delete command.")
+(defvar tpu-last-deleted-words ""
+  "Last text deleted by a TPU-edt word-delete command.")
+(defvar tpu-last-deleted-char ""
+  "Last character deleted by a TPU-edt character-delete command.")
+
+(defvar tpu-searching-forward t
+  "If non-nil, TPU-edt is searching in the forward direction.")
+(defvar tpu-search-last-string ""
+  "Last text searched for by the TPU-edt search commands.")
+(defvar tpu-search-overlay (make-overlay 1 1)
+  "Search highlight overlay.")
+(overlay-put tpu-search-overlay 'face 'bold)
+
+(defvar tpu-replace-overlay (make-overlay 1 1)
+  "Replace highlight overlay.")
+(overlay-put tpu-replace-overlay 'face 'highlight)
+
+(defvar tpu-regexp-p nil
+  "If non-nil, TPU-edt uses regexp search and replace routines.")
+(defvar tpu-rectangular-p nil
+  "If non-nil, TPU-edt removes and inserts rectangles.")
+(defvar tpu-advance t
+  "True when TPU-edt is operating in the forward direction.")
+(defvar tpu-reverse nil
+  "True when TPU-edt is operating in the backward direction.")
+(defvar tpu-control-keys nil
+  "If non-nil, control keys are set to perform TPU functions.")
+(defvar tpu-xkeys-file nil
+  "File containing TPU-edt X key map.")
+
+(defvar tpu-rectangle-string nil
+  "Mode line string to identify rectangular mode.")
+(defvar tpu-direction-string nil
+  "Mode line string to identify current direction.")
+
+(defvar tpu-add-at-bol-hist nil
+  "History variable for tpu-edt-add-at-bol function.")
+(defvar tpu-add-at-eol-hist nil
+  "History variable for tpu-edt-add-at-eol function.")
+(defvar tpu-regexp-prompt-hist  nil
+  "History variable for search and replace functions.")
+
+
+;;;
+;;;  Buffer Local Variables
+;;;
+(defvar tpu-newline-and-indent-p nil
+  "If non-nil, Return produces a newline and indents.")
+(make-variable-buffer-local 'tpu-newline-and-indent-p)
+
+(defvar tpu-newline-and-indent-string nil
+  "Mode line string to identify AutoIndent mode.")
+(make-variable-buffer-local 'tpu-newline-and-indent-string)
+
+(defvar tpu-saved-delete-func nil
+  "Saved value of the delete key.")
+(make-variable-buffer-local 'tpu-saved-delete-func)
+
+(defvar tpu-buffer-local-map nil
+  "TPU-edt buffer local key map.")
+(make-variable-buffer-local 'tpu-buffer-local-map)
+
+
+;;;
+;;;  Mode Line - Modify the mode line to show the following
+;;;
+;;;     o  Mark state.
+;;;     o  Direction of motion.
+;;;     o  Active rectangle mode.
+;;;     o  Active auto indent mode.
+;;;
+(defvar tpu-original-mm-alist minor-mode-alist)
+
+(defvar tpu-mark-flag "")
+(make-variable-buffer-local 'tpu-mark-flag)
+
+(defun tpu-set-mode-line (for-tpu)
+  "Set ``minor-mode-alist'' for TPU-edt, or reset it to default Emacs."
+  (let ((entries '((tpu-newline-and-indent-p tpu-newline-and-indent-string)
+                   (tpu-rectangular-p tpu-rectangle-string)
+                   (tpu-direction-string tpu-direction-string)
+                   (tpu-mark-flag tpu-mark-flag))))
+    (dolist (entry entries)
+      (if for-tpu
+          (add-to-list 'minor-mode-alist entry)
+        (setq minor-mode-alist (remove entry minor-mode-alist))))))
+
+(defun tpu-update-mode-line nil
+  "Make sure mode-line in the current buffer reflects all changes."
+  (setq tpu-mark-flag (if transient-mark-mode "" (if (tpu-mark) " @" "  ")))
+  (force-mode-line-update))
+
+(cond ((featurep 'xemacs)
+       (add-hook 'zmacs-deactivate-region-hook 'tpu-update-mode-line)
+       (add-hook 'zmacs-activate-region-hook 'tpu-update-mode-line))
+      (t
+       (add-hook 'activate-mark-hook 'tpu-update-mode-line)
+       (add-hook 'deactivate-mark-hook 'tpu-update-mode-line)))
+
+
+;;;
+;;;  Match Markers -
+;;;
+;;;     Set in:  Search
+;;;
+;;;     Used in: Replace, Substitute, Store-Text, Cut/Remove,
+;;;              Append, and Change-Case
+;;;
+(defvar tpu-match-beginning-mark (make-marker))
+(defvar tpu-match-end-mark (make-marker))
+
+(defun tpu-set-match nil
+  "Set markers at match beginning and end."
+  ;; Add one to beginning mark so it stays with the first character of
+  ;;   the string even if characters are added just before the string.
+  (setq tpu-match-beginning-mark (copy-marker (match-beginning 0) t))
+  (setq tpu-match-end-mark (copy-marker (match-end 0))))
+
+(defun tpu-unset-match nil
+  "Unset match beginning and end markers."
+  (set-marker tpu-match-beginning-mark nil)
+  (set-marker tpu-match-end-mark nil))
+
+(defun tpu-match-beginning nil
+  "Return the location of the last match beginning."
+  (marker-position tpu-match-beginning-mark))
+
+(defun tpu-match-end nil
+  "Return the location of the last match end."
+  (marker-position tpu-match-end-mark))
+
+(defun tpu-check-match nil
+  "Return t if point is between tpu-match markers.
+Otherwise sets the tpu-match markers to nil and returns nil."
+  ;; make sure 1- marker is in this buffer
+  ;;           2- point is at or after beginning marker
+  ;;           3- point is before ending marker, or in the case of
+  ;;              zero length regions (like bol, or eol) that the
+  ;;              beginning, end, and point are equal.
+  (cond ((and
+	  (equal (marker-buffer tpu-match-beginning-mark) (current-buffer))
+	  (>= (point) (marker-position tpu-match-beginning-mark))
+	  (or
+	   (< (point) (marker-position tpu-match-end-mark))
+	   (and (= (marker-position tpu-match-beginning-mark)
+		   (marker-position tpu-match-end-mark))
+		(= (marker-position tpu-match-end-mark) (point))))) t)
+	(t
+	 (tpu-unset-match) nil)))
+
+(defun tpu-show-match-markers nil
+  "Show the values of the match markers."
+  (interactive)
+  (if (markerp tpu-match-beginning-mark)
+      (message "(%s, %s) in %s -- current %s in %s"
+               (marker-position tpu-match-beginning-mark)
+               (marker-position tpu-match-end-mark)
+               (marker-buffer tpu-match-end-mark)
+               (point) (current-buffer))))
+
+
+;;;
+;;;  Utilities
+;;;
+
+(defun tpu-mark nil
+  "TPU-edt version of the mark function.
+Return the appropriate value of the mark for the current
+version of Emacs."
+  (cond ((featurep 'xemacs) (mark (not zmacs-regions)))
+	(t (and mark-active (mark (not transient-mark-mode))))))
+
+(defun tpu-set-mark (pos)
+  "TPU-edt version of the `set-mark' function.
+Sets the mark at POS and activates the region according to the
+current version of Emacs."
+  (set-mark pos)
+  (when (featurep 'xemacs) (when pos (zmacs-activate-region))))
+
+(defun tpu-string-prompt (prompt history-symbol)
+  "Read a string with PROMPT."
+  (read-from-minibuffer prompt nil nil nil history-symbol))
+
+(defvar tpu-last-answer nil "Most recent response to tpu-y-or-n-p.")
+
+(defun tpu-y-or-n-p (prompt &optional not-yes)
+  "Prompt for a y or n answer with positive default.
+Optional second argument NOT-YES changes default to negative.
+Like Emacs `y-or-n-p', but also accepts space as y and DEL as n."
+  (message "%s[%s]" prompt (if not-yes "n" "y"))
+  (let ((doit t))
+    (while doit
+      (setq doit nil)
+      (let ((ans (read-char)))
+	(cond ((or (= ans ?y) (= ans ?Y) (= ans ?\ ))
+	       (setq tpu-last-answer t))
+	      ((or (= ans ?n) (= ans ?N) (= ans ?\C-?))
+	       (setq tpu-last-answer nil))
+	      ((= ans ?\r) (setq tpu-last-answer (not not-yes)))
+	      (t
+	       (setq doit t) (beep)
+	       (message "Please answer y or n.  %s[%s]"
+			prompt (if not-yes "n" "y")))))))
+  tpu-last-answer)
+
+(defun tpu-local-set-key (key func)
+  "Replace a key in the TPU-edt local key map.
+Create the key map if necessary."
+  (cond ((not (keymapp tpu-buffer-local-map))
+	 (setq tpu-buffer-local-map (if (current-local-map)
+					(copy-keymap (current-local-map))
+				      (make-sparse-keymap)))
+	 (use-local-map tpu-buffer-local-map)))
+  (local-set-key key func))
+
+(defun tpu-current-line ()
+  "Return the vertical position of point in the selected window.
+Top line is 0.  Counts each text line only once, even if it wraps."
+  (or
+   (cdr (nth 6 (posn-at-point)))
+   (if (eq (window-start) (point)) 0
+     (1- (count-screen-lines (window-start) (point) 'count-final-newline)))))
+
+
+;;;
+;;;  Breadcrumbs
+;;;
+(defvar tpu-breadcrumb-plist nil
+  "The set of user-defined markers (breadcrumbs), as a plist.")
+
+(defun tpu-drop-breadcrumb (num)
+  "Drops a breadcrumb that can be returned to later with goto-breadcrumb."
+  (interactive "p")
+  (put tpu-breadcrumb-plist num (list (current-buffer) (point)))
+  (message "Mark %d set." num))
+
+(defun tpu-goto-breadcrumb (num)
+  "Return to a breadcrumb set with drop-breadcrumb."
+  (interactive "p")
+  (cond ((get tpu-breadcrumb-plist num)
+	 (switch-to-buffer (car (get tpu-breadcrumb-plist num)))
+	 (goto-char (cadr (get tpu-breadcrumb-plist num)))
+	 (message "mark %d found." num))
+	(t
+	 (message "mark %d not found." num))))
+
+
+;;;
+;;;  Miscellaneous
+;;;
+(defun tpu-change-case (num)
+  "Change the case of the character under the cursor or region.
+Accepts a prefix argument of the number of characters to invert."
+  (interactive "p")
+  (cond ((tpu-mark)
+	 (let ((beg (region-beginning)) (end (region-end)))
+	   (while (> end beg)
+	     (funcall (if (= (downcase (char-after beg)) (char-after beg))
+			  'upcase-region 'downcase-region)
+		      beg (1+ beg))
+	     (setq beg (1+ beg)))
+	   (tpu-unselect t)))
+	((tpu-check-match)
+	 (let ((beg (tpu-match-beginning)) (end (tpu-match-end)))
+	   (while (> end beg)
+	     (funcall (if (= (downcase (char-after beg)) (char-after beg))
+			  'upcase-region 'downcase-region)
+		      beg (1+ beg))
+	     (setq beg (1+ beg)))
+	   (tpu-unset-match)))
+	(t
+	 (while (> num 0)
+	   (funcall (if (= (downcase (following-char)) (following-char))
+			'upcase-region 'downcase-region)
+		    (point) (1+ (point)))
+	   (forward-char (if tpu-reverse -1 1))
+	   (setq num (1- num))))))
+
+(defun tpu-fill (num)
+  "Fill paragraph or marked region.
+With argument, fill and justify."
+  (interactive "P")
+  (cond ((tpu-mark)
+	 (fill-region (point) (tpu-mark) num)
+	 (tpu-unselect t))
+	(t
+	 (fill-paragraph num))))
+
+(defun tpu-version nil
+  "Print the TPU-edt version number."
+  (interactive)
+  (message
+   "TPU-edt version %s by Rob Riepel (riepel@networking.stanford.edu)"
+   tpu-version))
+
+(defun tpu-reset-screen-size (height width)
+  "Set the screen size."
+  (interactive "nnew screen height: \nnnew screen width: ")
+  (set-frame-height (selected-frame) height)
+  (set-frame-width (selected-frame) width))
+
+(defun tpu-toggle-newline-and-indent nil
+  "Toggle between 'newline and indent' and 'simple newline'."
+  (interactive)
+  (cond (tpu-newline-and-indent-p
+         (setq tpu-newline-and-indent-string "")
+         (setq tpu-newline-and-indent-p nil)
+         (tpu-local-set-key "\C-m" 'newline))
+        (t
+         (setq tpu-newline-and-indent-string " AutoIndent")
+         (setq tpu-newline-and-indent-p t)
+         (tpu-local-set-key "\C-m" 'newline-and-indent)))
+  (tpu-update-mode-line)
+  (and (called-interactively-p 'interactive)
+       (message "Carriage return inserts a newline%s"
+		(if tpu-newline-and-indent-p " and indents." "."))))
+
+(defun tpu-spell-check nil
+  "Check the spelling of the region, or of the entire buffer,
+if no region is selected."
+  (interactive)
+  (let ((m (tpu-mark)))
+    (apply (if tpu-have-ispell 'ispell-region
+             'spell-region)
+           (if m
+               (if (> m (point)) (list (point) m)
+                 (list m (point)))
+             (list (point-min) (point-max))))
+    (if m (tpu-unselect t))))
+
+(defun tpu-toggle-overwrite-mode nil
+  "Switch in and out of overwrite mode."
+  (interactive)
+  (cond (overwrite-mode
+	 (tpu-local-set-key "\177" tpu-saved-delete-func)
+	 (overwrite-mode 0))
+	(t
+	 (setq tpu-saved-delete-func (local-key-binding "\177"))
+	 (tpu-local-set-key "\177" 'picture-backward-clear-column)
+	 (overwrite-mode 1))))
+
+(defun tpu-special-insert (num)
+  "Insert a character or control code according to its ASCII decimal value."
+  (interactive "P")
+  (if overwrite-mode (delete-char 1))
+  (insert (or num 0)))
+
+(defun tpu-quoted-insert (num)
+  "Read next input character and insert it.
+This is useful for inserting control characters."
+  (interactive "*p")
+  (let ((char (read-char)) )
+    (if overwrite-mode (delete-char num))
+    (insert-char char num)))
+
+
+;;;
+;;;  TPU line-mode commands
+;;;
+(defun tpu-include (file)
+  "TPU-like include file."
+  (interactive "fInclude file: ")
+  (insert-file-contents file)
+  (message ""))
+
+(defun tpu-get (file)
+  "TPU-like get file."
+  (interactive "FFile to get: ")
+  (find-file file find-file-wildcards))
+
+(defun tpu-what-line nil
+  "Tell what line the point is on,
+and the total number of lines in the buffer."
+  (interactive)
+  (if (eobp)
+      (message "You are at the End of Buffer.  The last line is %d."
+	       (count-lines 1 (point-max)))
+    (let* ((cur (count-lines 1 (1+ (point))))
+	   (max (count-lines 1 (point-max)))
+	   (pct (/ (* 100 (+ cur (/ max 200))) max)))
+      (message "You are on line %d out of %d (%d%%)." cur max pct))))
+
+(defun tpu-exit nil
+  "Exit the way TPU does, save current buffer and ask about others."
+  (interactive)
+  (if (not (eq (recursion-depth) 0))
+      (exit-recursive-edit)
+    (progn (save-buffer) (save-buffers-kill-emacs))))
+
+(defun tpu-quit nil
+  "Quit the way TPU does, ask to make sure changes should be abandoned."
+  (interactive)
+  (let ((list (buffer-list))
+	(working t))
+    (while (and list working)
+      (let ((buffer (car list)))
+	(if (and (buffer-file-name buffer) (buffer-modified-p buffer))
+            (if (tpu-y-or-n-p
+		 "Modifications will not be saved, continue quitting? ")
+		(kill-emacs t) (setq working nil)))
+	(setq list (cdr list))))
+    (if working (kill-emacs t))))
+
+
+;;;
+;;;  Command and Function Aliases
+;;;
+;;;###autoload
+(define-minor-mode tpu-edt-mode
+  "Toggle TPU/edt emulation on or off.
+With a prefix argument ARG, enable the mode if ARG is positive,
+and disable it otherwise.  If called from Lisp, enable the mode
+if ARG is omitted or nil."
+  :global t :group 'tpu
+  (if tpu-edt-mode (tpu-edt-on) (tpu-edt-off)))
+
+(defalias 'TPU-EDT-MODE 'tpu-edt-mode)
+
+;;;###autoload
+(defalias 'tpu-edt 'tpu-edt-on)
+(defalias 'TPU-EDT 'tpu-edt-on)
+
+;; Note:  The following functions have no `tpu-' prefix.  This is unavoidable.
+;;        The real TPU/edt editor has interactive commands with these names,
+;;        so tpu-edt.el users expect things like M-x exit RET and M-x help RET
+;;        to work.  Therefore it really is necessary to define these functions,
+;;        even in cases where they redefine existing Emacs functions.
+
+(defalias 'exit 'tpu-exit)
+(defalias 'EXIT 'tpu-exit)
+
+(defalias 'Get 'tpu-get)
+(defalias 'GET 'tpu-get)
+
+(defalias 'include 'tpu-include)
+(defalias 'INCLUDE 'tpu-include)
+
+(defalias 'quit 'tpu-quit)
+(defalias 'QUIT 'tpu-quit)
+
+(defalias 'spell 'tpu-spell-check)
+(defalias 'SPELL 'tpu-spell-check)
+
+(defalias 'what\ line 'tpu-what-line)
+(defalias 'WHAT\ LINE 'tpu-what-line)
+
+(defalias 'replace 'tpu-lm-replace)
+(defalias 'REPLACE 'tpu-lm-replace)
+
+(defalias 'help 'tpu-help)
+(defalias 'HELP 'tpu-help)
+
+(defalias 'set\ cursor\ free 'tpu-set-cursor-free)
+(defalias 'SET\ CURSOR\ FREE 'tpu-set-cursor-free)
+
+(defalias 'set\ cursor\ bound 'tpu-set-cursor-bound)
+(defalias 'SET\ CURSOR\ BOUND 'tpu-set-cursor-bound)
+
+(defalias 'set\ scroll\ margins 'tpu-set-scroll-margins)
+(defalias 'SET\ SCROLL\ MARGINS 'tpu-set-scroll-margins)
+
+;; Real TPU error messages end in periods.
+;; Define this to avoid openly flouting Emacs coding standards.
+(defalias 'tpu-error 'error)
+
+
+;;;
+;;;  Help
+;;;
+(defvar tpu-help-keypad-map "\f
+          _______________________    _______________________________
+         | HELP  |      Do       |  |       |       |       |       |
+         |KeyDefs|               |  |       |       |       |       |
+         |_______|_______________|  |_______|_______|_______|_______|
+          _______________________    _______________________________
+         | Find  |Insert |Remove |  | Gold  | HELP  |FndNxt | Del L |
+         |       |       |Sto Tex|  |  key  |E-Help | Find  |Undel L|
+         |_______|_______|_______|  |_______|_______|_______|_______|
+         |Select |Pre Scr|Nex Scr|  | Page  | Sect  |Append | Del W |
+         | Reset |Pre Win|Nex Win|  |  Do   | Fill  |Replace|Undel W|
+         |_______|_______|_______|  |_______|_______|_______|_______|
+                 |Move up|          |Forward|Reverse|Remove | Del C |
+                 |  Top  |          |Bottom |  Top  |Insert |Undel C|
+          _______|_______|_______   |_______|_______|_______|_______|
+         |Mov Lef|Mov Dow|Mov Rig|  | Word  |  EOL  | Char  |       |
+         |StaOfLi|Bottom |EndOfLi|  |ChngCas|Del EOL|SpecIns| Enter |
+         |_______|_______|_______|  |_______|_______|_______|       |
+                                    |     Line      |Select | Subs  |
+                                    |   Open Line   | Reset |       |
+                                    |_______________|_______|_______|
+")
+
+(defvar tpu-help-text "
+\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\f
+
+      Control Characters
+
+      ^A  toggle insert and overwrite
+      ^B  recall
+      ^E  end of line
+
+      ^G  Cancel current operation
+      ^H  beginning of line
+      ^J  delete previous word
+
+      ^K  learn
+      ^L  insert page break
+      ^R  remember (during learn), re-center
+
+      ^U  delete to beginning of line
+      ^V  quote
+      ^W  refresh
+
+      ^Z  exit
+    ^X^X  exchange point and mark - useful for checking region boundaries
+
+\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\f
+       Gold-<key> Functions
+
+       B     Next Buffer - display the next buffer (all buffers)
+       C     Recall - edit and possibly repeat previous commands
+       E     Exit - save current buffer and ask about others
+       G     Get - load a file into a new edit buffer
+
+       I     Include - include a file in this buffer
+       K     Kill Buffer - abandon edits and delete buffer
+       M     Buffer Menu - display a list of all buffers
+       N     Next File Buffer - display next buffer containing a file
+
+       O     Occur - show following lines containing REGEXP
+       Q     Quit - exit without saving anything
+       R     Toggle rectangular mode for remove and insert
+       S     Search and substitute - line mode REPLACE command
+
+      ^T     Toggle control key bindings between TPU and Emacs
+       U     Undo - undo the last edit
+       W     Write - save current buffer
+       X     Exit - save all modified buffers and exit
+
+\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\f
+
+  More extensive documentation on TPU-edt can be found in the `Commentary'
+  section of tpu-edt.el.  This section can be accessed through the standard
+  Emacs help facility using the `p' option.  Once you exit TPU-edt Help, one
+  of the following key sequences is sure to get you there.
+
+    ^h p        if you're not yet using TPU-edt
+    Gold-PF2 p  if you're using TPU-edt
+
+  Alternatively, fire up Emacs help from the command prompt, with
+
+    M-x help-for-help <CR> p <CR>
+
+  Where `M-x' might be any of `Gold-KP7', 'Do', or 'ESC-x'.
+
+  When you successfully invoke this part of the Emacs help facility, you
+  will see a buffer named `*Finder*' listing a number of topics.  Look for
+  tpu-edt under `emulations'.
+
+\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\f
+
+   *** No more help, use P to view previous screen")
+
+(defvar tpu-help-enter (format "%s" "\eOM"))    ; tpu-help enter key symbol
+(defvar tpu-help-return (format "%s" "\r"))     ; tpu-help enter key symbol
+(defvar tpu-help-N "N")                         ; tpu-help "N" symbol
+(defvar tpu-help-n "n")                         ; tpu-help "n" symbol
+(defvar tpu-help-P "P")                         ; tpu-help "P" symbol
+(defvar tpu-help-p "p")                         ; tpu-help "p" symbol
+
+(defun tpu-help nil
+  "Display TPU-edt help."
+  (interactive)
+  ;; Save current window configuration
+  (save-window-excursion
+    ;; Create and fill help buffer if necessary
+    (if (not (get-buffer "*TPU-edt Help*"))
+	(progn (generate-new-buffer "*TPU-edt Help*")
+	       (switch-to-buffer "*TPU-edt Help*")
+	       (insert tpu-help-keypad-map)
+	       (insert tpu-help-text)
+	       (setq buffer-read-only t)))
+
+    ;; Display the help buffer
+    (switch-to-buffer "*TPU-edt Help*")
+    (delete-other-windows)
+    (tpu-move-to-beginning)
+    (forward-line 1)
+    (tpu-line-to-top-of-window)
+
+    ;; Prompt for keys to describe, based on screen state (split/not split)
+    (let ((key nil) (fkey nil) (split nil))
+      (while (not (equal tpu-help-return fkey))
+	(if split
+	    (setq key
+		  (read-key-sequence
+		   "Press the key you want help on (RET=exit, ENTER=redisplay, N=next, P=prev): "))
+	  (setq key
+		(read-key-sequence
+		 "Press the key you want help on (RET to exit, N next screen, P prev screen): ")))
+
+	;; Process the read key
+	;;
+	;;    ENTER   -  Display just the help window
+	;;    N or n  -  Next help or describe-key screen
+	;;    P or p  -  Previous help or describe-key screen
+	;;    RETURN  -  Exit from TPU-help
+	;;    default -  describe the key
+	;;
+	(setq fkey (format "%s" key))
+	(cond ((equal tpu-help-enter fkey)
+	       (setq split nil)
+	       (delete-other-windows))
+	      ((or (equal tpu-help-N fkey) (equal tpu-help-n fkey))
+	       (cond (split
+	              (condition-case nil
+	        	  (scroll-other-window 8)
+	        	(error nil)))
+	             (t
+	              (forward-page)
+	              (forward-line 1)
+	              (tpu-line-to-top-of-window))))
+	      ((or (equal tpu-help-P fkey) (equal tpu-help-p fkey))
+	       (cond (split
+	              (condition-case nil
+	        	  (scroll-other-window -8)
+	        	(error nil)))
+	             (t
+	              (forward-line -1)
+	              (backward-page)
+	              (forward-line 1)
+	              (tpu-line-to-top-of-window))))
+	      ((not (equal tpu-help-return fkey))
+	       (setq split t)
+	       (describe-key key)
+	       ;; If the key is undefined, leave the
+	       ;;   message in the mini-buffer for 3 seconds
+	       (if (not (key-binding key)) (sit-for 3))))))))
+
+
+;;;
+;;;  Auto-insert
+;;;
+(defun tpu-insert-escape nil
+  "Insert an escape character, and so becomes the escape-key alias."
+  (interactive)
+  (insert "\e"))
+
+(defun tpu-insert-formfeed nil
+  "Insert a formfeed character."
+  (interactive)
+  (insert "\C-L"))
+
+
+;;;
+;;;  Define key
+;;;
+(defvar tpu-saved-control-r nil "Saved value of Control-r.")
+
+(defun tpu-end-define-macro-key (key)
+  "End the current macro definition."
+  (interactive "kPress the key you want to use to do what was just learned: ")
+  (end-kbd-macro nil)
+  (global-set-key key last-kbd-macro)
+  (global-set-key "\C-r" tpu-saved-control-r))
+
+(defun tpu-define-macro-key nil
+  "Bind a set of keystrokes to a single key, or key combination."
+  (interactive)
+  (setq tpu-saved-control-r (global-key-binding "\C-r"))
+  (global-set-key "\C-r" 'tpu-end-define-macro-key)
+  (start-kbd-macro nil))
+
+
+;;;
+;;;  Buffers and Windows
+;;;
+(defun tpu-kill-buffer nil
+  "Kill the current buffer.
+If `tpu-kill-buffers-silently' is non-nil,
+kill modified buffers without asking."
+  (interactive)
+  (if tpu-kill-buffers-silently (set-buffer-modified-p nil))
+  (kill-buffer (current-buffer)))
+
+(defun tpu-save-all-buffers-kill-emacs nil
+  "Save all buffers and exit Emacs."
+  (interactive)
+  (let ((delete-old-versions t))
+    (save-buffers-kill-emacs t)))
+
+(defun tpu-write-current-buffers nil
+  "Save all modified buffers without exiting."
+  (interactive)
+  (save-some-buffers t))
+
+(defun tpu-next-buffer nil
+  "Go to next buffer in ring."
+  (interactive)
+  (switch-to-buffer (car (reverse (buffer-list)))))
+
+(defun tpu-next-file-buffer nil
+  "Go to next buffer in ring that is visiting a file or directory."
+  (interactive)
+  (let ((list (tpu-make-file-buffer-list (buffer-list))))
+    (setq list (delq (current-buffer) list))
+    (if (not list) (tpu-error "No other buffers."))
+    (switch-to-buffer (car (reverse list)))))
+
+(defun tpu-make-file-buffer-list (buffer-list)
+  "Return names from BUFFER-LIST excluding those beginning with a space or star."
+  (delq nil (mapcar (lambda (b)
+                      (if (or (= (aref (buffer-name b) 0) ?\s)
+                              (= (aref (buffer-name b) 0) ?*)) nil b))
+                    buffer-list)))
+
+(defun tpu-next-window nil
+  "Move to the next window."
+  (interactive)
+  (if (one-window-p) (message "There is only one window on screen.")
+    (other-window 1)))
+
+(defun tpu-previous-window nil
+  "Move to the previous window."
+  (interactive)
+  (if (one-window-p) (message "There is only one window on screen.")
+    (select-window (previous-window))))
+
+
+;;;
+;;;  Search
+;;;
+(defun tpu-toggle-regexp nil
+  "Switch in and out of regular expression search and replace mode."
+  (interactive)
+  (setq tpu-regexp-p (not tpu-regexp-p))
+  (tpu-set-search)
+  (and (called-interactively-p 'interactive)
+       (message "Regular expression search and substitute %sabled."
+		(if tpu-regexp-p "en" "dis"))))
+
+(defun tpu-regexp-prompt (prompt)
+  "Read a string, adding 'RE' to the prompt if tpu-regexp-p is set."
+  (let ((re-prompt (concat (if tpu-regexp-p "RE ") prompt)))
+    (read-from-minibuffer re-prompt nil nil nil 'tpu-regexp-prompt-hist)))
+
+(defun tpu-search-highlight nil
+  (if (tpu-check-match)
+      (move-overlay tpu-search-overlay
+                    (tpu-match-beginning) (tpu-match-end) (current-buffer))
+    (unless (equal (overlay-start tpu-search-overlay)
+		   (overlay-end tpu-search-overlay))
+      (move-overlay tpu-search-overlay 1 1 (current-buffer)))))
+
+(defun tpu-search nil
+  "Search for a string or regular expression.
+The search is performed in the current direction."
+  (interactive)
+  (tpu-set-search)
+  (tpu-search-internal ""))
+
+(defun tpu-search-forward nil
+  "Search for a string or regular expression.
+The search is begins in the forward direction."
+  (interactive)
+  (setq tpu-searching-forward t)
+  (tpu-set-search t)
+  (tpu-search-internal ""))
+
+(defun tpu-search-reverse nil
+  "Search for a string or regular expression.
+The search is begins in the reverse direction."
+  (interactive)
+  (setq tpu-searching-forward nil)
+  (tpu-set-search t)
+  (tpu-search-internal ""))
+
+(defun tpu-search-again nil
+  "Search for the same string or regular expression as last time.
+The search is performed in the current direction."
+  (interactive)
+  (tpu-search-internal tpu-search-last-string))
+
+;;  tpu-set-search defines the search functions used by the TPU-edt internal
+;;  search function.  It should be called whenever the direction changes, or
+;;  the regular expression mode is turned on or off.  It can also be called
+;;  to ensure that the next search will be in the current direction.  It is
+;;  called from:
+
+;;       tpu-advance                   tpu-backup
+;;       tpu-toggle-regexp             tpu-toggle-search-direction (t)
+;;       tpu-search                    tpu-lm-replace
+;;       tpu-search-forward (t)        tpu-search-reverse (t)
+;;       tpu-search-forward-exit (t)   tpu-search-backward-exit (t)
+
+(declare-function tpu-emacs-search "tpu-edt")
+(declare-function tpu-emacs-rev-search "tpu-edt")
+
+(defun tpu-set-search (&optional arg)
+  "Set the search functions and set the search direction to the current direction.
+If an argument is specified, don't set the search direction."
+  (if (not arg) (setq tpu-searching-forward tpu-advance))
+  (cond (tpu-searching-forward
+	 (cond (tpu-regexp-p
+		(fset 'tpu-emacs-search 're-search-forward)
+		(fset 'tpu-emacs-rev-search 're-search-backward))
+	       (t
+		(fset 'tpu-emacs-search 'search-forward)
+		(fset 'tpu-emacs-rev-search 'search-backward))))
+	(t
+	 (cond (tpu-regexp-p
+		(fset 'tpu-emacs-search 're-search-backward)
+		(fset 'tpu-emacs-rev-search 're-search-forward))
+	       (t
+		(fset 'tpu-emacs-search 'search-backward)
+		(fset 'tpu-emacs-rev-search 'search-forward))))))
+
+(defun tpu-search-internal (pat &optional quiet)
+  "Search for a string or regular expression."
+  (setq tpu-search-last-string
+	(if (not (string= "" pat)) pat (tpu-regexp-prompt "Search: ")))
+
+  (tpu-unset-match)
+  (tpu-adjust-search)
+
+  (let ((case-fold-search
+	 (and case-fold-search (tpu-check-search-case tpu-search-last-string))))
+
+    (cond ((tpu-emacs-search tpu-search-last-string nil t)
+	   (tpu-set-match) (goto-char (tpu-match-beginning)))
+
+	  (t
+	   (tpu-adjust-search t)
+	   (let ((found nil) (pos nil))
+	     (save-excursion
+	       (let ((tpu-searching-forward (not tpu-searching-forward)))
+		 (tpu-adjust-search)
+		 (setq found (tpu-emacs-rev-search tpu-search-last-string nil t))
+		 (setq pos (match-beginning 0))))
+
+	     (cond
+	      (found
+	       (cond ((tpu-y-or-n-p
+		       (format "Found in %s direction.  Go there? "
+			       (if tpu-searching-forward "reverse" "forward")))
+		      (goto-char pos) (tpu-set-match)
+		      (tpu-toggle-search-direction))))
+
+	      (t
+	       (if (not quiet)
+		   (message
+		    "%sSearch failed: \"%s\""
+		    (if tpu-regexp-p "RE " "") tpu-search-last-string)))))))))
+
+(defalias 'tpu-search-internal-core (symbol-function 'tpu-search-internal))
+
+(defun tpu-check-search-case (string)
+  "Return t if string contains upper case."
+  ;; if using regexp, eliminate upper case forms (\B \W \S.)
+  (if tpu-regexp-p
+      (let ((pat (copy-sequence string)) (case-fold-search nil) (pos 0))
+	(while (setq pos (string-match "\\\\\\\\" pat)) (aset pat (+ 1 pos) ?.))
+	(while (setq pos (string-match "\\\\B" pat)) (aset pat (+ 1 pos) ?.))
+	(while (setq pos (string-match "\\\\W" pat)) (aset pat (+ 1 pos) ?.))
+	(while (setq pos (string-match "\\\\S." pat))
+	  (aset pat (+ 1 pos) ?.) (aset pat (+ 2 pos) ?.))
+	(string-equal pat (downcase pat)))
+    (string-equal string (downcase string))))
+
+(defun tpu-adjust-search (&optional arg)
+  "For forward searches, move forward a character before searching,
+and backward a character after a failed search.  Arg means end of search."
+  (if tpu-searching-forward
+      (cond (arg (if (not (bobp)) (forward-char -1)))
+	    (t (if (not (eobp)) (forward-char 1))))))
+
+(defun tpu-toggle-search-direction nil
+  "Toggle the TPU-edt search direction.
+Used for reversing a search in progress."
+  (interactive)
+  (setq tpu-searching-forward (not tpu-searching-forward))
+  (tpu-set-search t)
+  (and (called-interactively-p 'interactive)
+       (message "Searching %sward."
+		(if tpu-searching-forward "for" "back"))))
+
+(defun tpu-search-forward-exit nil
+  "Set search direction forward and exit minibuffer."
+  (interactive)
+  (setq tpu-searching-forward t)
+  (tpu-set-search t)
+  (exit-minibuffer))
+
+(defun tpu-search-backward-exit nil
+  "Set search direction backward and exit minibuffer."
+  (interactive)
+  (setq tpu-searching-forward nil)
+  (tpu-set-search t)
+  (exit-minibuffer))
+
+
+;;;
+;;;  Select / Unselect
+;;;
+(defun tpu-select (&optional quiet)
+  "Set the mark to define one end of a region."
+  (interactive "P")
+  (cond ((tpu-mark)
+	 (tpu-unselect quiet))
+	(t
+	 (tpu-set-mark (point))
+	 (tpu-update-mode-line)
+	 (if (not quiet) (message "Move the text cursor to select text.")))))
+
+(defun tpu-unselect (&optional quiet)
+  "Remove the mark to unselect the current region."
+  (interactive "P")
+  (deactivate-mark)
+  (setq mark-ring nil)
+  (tpu-set-mark nil)
+  (tpu-update-mode-line)
+  (if (not quiet) (message "Selection canceled.")))
+
+
+;;;
+;;;  Delete / Cut
+;;;
+(defun tpu-toggle-rectangle nil
+  "Toggle rectangular mode for remove and insert."
+  (interactive)
+  (setq tpu-rectangular-p (not tpu-rectangular-p))
+  (setq tpu-rectangle-string (if tpu-rectangular-p " Rect" ""))
+  (tpu-update-mode-line)
+  (and (called-interactively-p 'interactive)
+       (message "Rectangular cut and paste %sabled."
+		(if tpu-rectangular-p "en" "dis"))))
+
+(defun tpu-arrange-rectangle nil
+  "Adjust point and mark to upper left and lower right corners of a rectangle."
+  (let ((mc (current-column))
+	(pc (progn (exchange-point-and-mark) (current-column))))
+
+    (cond ((> (point) (tpu-mark))                  ; point on lower line
+	   (cond ((> pc mc)                        ; point @  lower-right
+		  (exchange-point-and-mark))       ; point -> upper-left
+
+		 (t	                           ; point @  lower-left
+		  (move-to-column mc t)            ; point -> lower-right
+		  (exchange-point-and-mark)        ; point -> upper-right
+		  (move-to-column pc t))))         ; point -> upper-left
+
+	  (t                                       ; point on upper line
+	   (cond ((> pc mc)                        ; point @  upper-right
+		  (move-to-column mc t)            ; point -> upper-left
+		  (exchange-point-and-mark)        ; point -> lower-left
+		  (move-to-column pc t)            ; point -> lower-right
+		  (exchange-point-and-mark)))))))  ; point -> upper-left
+
+(defun tpu-cut-text nil
+  "Delete the selected region.
+The text is saved for the tpu-paste command."
+  (interactive)
+  (cond ((tpu-mark)
+	 (cond (tpu-rectangular-p
+		(tpu-arrange-rectangle)
+		(picture-clear-rectangle (point) (tpu-mark) (not overwrite-mode))
+		(tpu-unselect t))
+	       (t
+		(setq tpu-last-deleted-region
+		      (buffer-substring (tpu-mark) (point)))
+		(delete-region (tpu-mark) (point))
+		(tpu-unselect t))))
+	((tpu-check-match)
+	 (let ((beg (tpu-match-beginning)) (end (tpu-match-end)))
+	   (setq tpu-last-deleted-region (buffer-substring beg end))
+	   (delete-region beg end)
+	   (tpu-unset-match)))
+	(t
+	 (tpu-error "No selection active."))))
+
+(defun tpu-store-text nil
+  "Copy the selected region to the cut buffer without deleting it.
+The text is saved for the tpu-paste command."
+  (interactive)
+  (cond ((tpu-mark)
+	 (cond (tpu-rectangular-p
+		(save-excursion
+		  (tpu-arrange-rectangle)
+		  (setq picture-killed-rectangle
+			(extract-rectangle (point) (tpu-mark))))
+		(tpu-unselect t))
+	       (t
+		(setq tpu-last-deleted-region
+		      (buffer-substring (tpu-mark) (point)))
+		(tpu-unselect t))))
+	((tpu-check-match)
+	 (setq tpu-last-deleted-region
+	       (buffer-substring (tpu-match-beginning) (tpu-match-end)))
+	 (tpu-unset-match))
+	(t
+	 (tpu-error "No selection active."))))
+
+(defun tpu-cut (arg)
+  "Copy selected region to the cut buffer.
+In the absence of an argument, delete the selected region too."
+  (interactive "P")
+  (if arg (tpu-store-text) (tpu-cut-text)))
+
+(defun tpu-append-region (arg)
+  "Append selected region to the tpu-cut buffer.
+In the absence of an argument, delete the selected region too."
+  (interactive "P")
+  (cond ((tpu-mark)
+	 (let ((beg (region-beginning)) (end (region-end)))
+	   (setq tpu-last-deleted-region
+		 (concat tpu-last-deleted-region
+			 (buffer-substring beg end)))
+	   (if (not arg) (delete-region beg end))
+	   (tpu-unselect t)))
+	((tpu-check-match)
+	 (let ((beg (tpu-match-beginning)) (end (tpu-match-end)))
+	   (setq tpu-last-deleted-region
+		 (concat tpu-last-deleted-region
+			 (buffer-substring beg end)))
+	   (if (not arg) (delete-region beg end))
+	   (tpu-unset-match)))
+	(t
+	 (tpu-error "No selection active."))))
+
+(defun tpu-delete-current-line (num)
+  "Delete one or specified number of lines after point.
+This includes the newline character at the end of each line.
+They are saved for the TPU-edt undelete-lines command."
+  (interactive "p")
+  (let ((beg (point)))
+    (forward-line num)
+    (if (not (eq (preceding-char) ?\n))
+        (insert "\n"))
+    (setq tpu-last-deleted-lines
+          (buffer-substring beg (point)))
+    (delete-region beg (point))))
+
+(defun tpu-delete-to-eol (num)
+  "Delete text up to end of line.
+With argument, delete up to the Nth line-end past point.
+They are saved for the TPU-edt undelete-lines command."
+  (interactive "p")
+  (let ((beg (point)))
+    (forward-char 1)
+    (end-of-line num)
+    (setq tpu-last-deleted-lines
+          (buffer-substring beg (point)))
+    (delete-region beg (point))))
+
+(defun tpu-delete-to-bol (num)
+  "Delete text back to beginning of line.
+With argument, delete up to the Nth line-end past point.
+They are saved for the TPU-edt undelete-lines command."
+  (interactive "p")
+  (let ((beg (point)))
+    (tpu-next-beginning-of-line num)
+    (setq tpu-last-deleted-lines
+          (buffer-substring (point) beg))
+    (delete-region (point) beg)))
+
+(defun tpu-delete-current-word (num)
+  "Delete one or specified number of words after point.
+They are saved for the TPU-edt undelete-words command."
+  (interactive "p")
+  (let ((beg (point)))
+    (tpu-forward-to-word num)
+    (setq tpu-last-deleted-words
+          (buffer-substring beg (point)))
+    (delete-region beg (point))))
+
+(defun tpu-delete-previous-word (num)
+  "Delete one or specified number of words before point.
+They are saved for the TPU-edt undelete-words command."
+  (interactive "p")
+  (let ((beg (point)))
+    (tpu-backward-to-word num)
+    (setq tpu-last-deleted-words
+          (buffer-substring (point) beg))
+    (delete-region beg (point))))
+
+(defun tpu-delete-current-char (num)
+  "Delete one or specified number of characters after point.
+The last character deleted is saved for the TPU-edt undelete-char command."
+  (interactive "p")
+  (while (and (> num 0) (not (eobp)))
+    (setq tpu-last-deleted-char (char-after (point)))
+    (cond (overwrite-mode
+	   (picture-clear-column 1)
+	   (forward-char 1))
+	  (t
+	   (delete-char 1)))
+    (setq num (1- num))))
+
+
+;;;
+;;;  Undelete / Paste
+;;;
+(defun tpu-paste (num)
+  "Insert the last region or rectangle of killed text.
+With argument reinserts the text that many times."
+  (interactive "p")
+  (while (> num 0)
+    (cond (tpu-rectangular-p
+	   (let ((beg (point)))
+	     (save-excursion
+	       (picture-yank-rectangle (not overwrite-mode))
+	       (message ""))
+	     (goto-char beg)))
+	  (t
+	   (insert tpu-last-deleted-region)))
+    (setq num (1- num))))
+
+(defun tpu-undelete-lines (num)
+  "Insert lines deleted by last TPU-edt line-deletion command.
+With argument reinserts lines that many times."
+  (interactive "p")
+  (let ((beg (point)))
+    (while (> num 0)
+      (insert tpu-last-deleted-lines)
+      (setq num (1- num)))
+    (goto-char beg)))
+
+(defun tpu-undelete-words (num)
+  "Insert words deleted by last TPU-edt word-deletion command.
+With argument reinserts words that many times."
+  (interactive "p")
+  (let ((beg (point)))
+    (while (> num 0)
+      (insert tpu-last-deleted-words)
+      (setq num (1- num)))
+    (goto-char beg)))
+
+(defun tpu-undelete-char (num)
+  "Insert character deleted by last TPU-edt character-deletion command.
+With argument reinserts the character that many times."
+  (interactive "p")
+  (while (> num 0)
+    (if overwrite-mode (prog1 (forward-char -1) (delete-char 1)))
+    (insert tpu-last-deleted-char)
+    (forward-char -1)
+    (setq num (1- num))))
+
+
+;;;
+;;;  Replace and Substitute
+;;;
+(defun tpu-replace nil
+  "Replace the selected region with the contents of the cut buffer."
+  (interactive)
+  (cond ((tpu-mark)
+	 (let ((beg (region-beginning)) (end (region-end)))
+	   (setq tpu-last-replaced-text (buffer-substring beg end))
+	   (delete-region beg end)
+	   (insert tpu-last-deleted-region)
+	   (tpu-unselect t)))
+	((tpu-check-match)
+	 (let ((beg (tpu-match-beginning)) (end (tpu-match-end)))
+	   (setq tpu-last-replaced-text (buffer-substring beg end))
+	   (replace-match tpu-last-deleted-region
+			  (not case-replace) (not tpu-regexp-p))
+	   (tpu-unset-match)))
+	(t
+	 (tpu-error "No selection active."))))
+
+(defun tpu-substitute (num)
+  "Replace the selected region with the contents of the cut buffer,
+and repeat most recent search.  A numeric argument serves as a repeat count.
+A negative argument means replace all occurrences of the search string."
+  (interactive "p")
+  (cond ((or (tpu-mark) (tpu-check-match))
+	 (while (and (not (= num 0)) (or (tpu-mark) (tpu-check-match)))
+	   (let ((beg (point)))
+	     (tpu-replace)
+	     (if tpu-searching-forward (forward-char -1) (goto-char beg))
+	     (if (= num 1) (tpu-search-internal tpu-search-last-string)
+	       (tpu-search-internal-core tpu-search-last-string)))
+	   (setq num (1- num))))
+	(t
+	 (tpu-error "No selection active."))))
+
+(defun tpu-lm-replace (from to)
+  "Interactively search for OLD-string and substitute NEW-string."
+  (interactive (list (tpu-regexp-prompt "Old String: ")
+		     (tpu-regexp-prompt "New String: ")))
+
+  (let ((doit t) (strings 0))
+
+    ;; Can't replace null strings
+    (if (string= "" from) (tpu-error "No string to replace."))
+
+    ;; Find the first occurrence
+    (tpu-set-search)
+    (tpu-search-internal from t)
+
+    ;; Loop on replace question - yes, no, all, last, or quit.
+    (while doit
+      (if (not (tpu-check-match)) (setq doit nil)
+	(progn
+	  (move-overlay tpu-replace-overlay
+			(tpu-match-beginning) (tpu-match-end) (current-buffer))
+	  (message "Replace? Type Yes, No, All, Last, or Quit: ")
+	  (let ((ans (read-char)))
+
+	    (cond ((or (= ans ?y) (= ans ?Y) (= ans ?\r) (= ans ?\ ))
+		   (let ((beg (point)))
+		     (replace-match to (not case-replace) (not tpu-regexp-p))
+		     (setq strings (1+ strings))
+		     (if tpu-searching-forward (forward-char -1) (goto-char beg)))
+		   (tpu-search-internal from t))
+
+		  ((or (= ans ?n) (= ans ?N) (= ans ?\C-?))
+		   (tpu-search-internal from t))
+
+		  ((or (= ans ?a) (= ans ?A))
+		   (save-excursion
+		     (let ((beg (point)))
+		       (replace-match to (not case-replace) (not tpu-regexp-p))
+		       (setq strings (1+ strings))
+		       (if tpu-searching-forward (forward-char -1) (goto-char beg)))
+		     (tpu-search-internal-core from t)
+		     (while (tpu-check-match)
+		       (let ((beg (point)))
+			 (replace-match to (not case-replace) (not tpu-regexp-p))
+			 (setq strings (1+ strings))
+			 (if tpu-searching-forward (forward-char -1) (goto-char beg)))
+		       (tpu-search-internal-core from t)))
+		   (setq doit nil))
+
+		  ((or (= ans ?l) (= ans ?L))
+		   (let ((beg (point)))
+		     (replace-match to (not case-replace) (not tpu-regexp-p))
+		     (setq strings (1+ strings))
+		     (if tpu-searching-forward (forward-char -1) (goto-char beg)))
+		   (setq doit nil))
+
+		  ((or (= ans ?q) (= ans ?Q))
+		   (tpu-unset-match)
+		   (setq doit nil)))))))
+
+    (move-overlay tpu-replace-overlay 1 1 (current-buffer))
+    (message "Replaced %s occurrence%s." strings (if (not (= 1 strings)) "s" ""))))
+
+(defun tpu-emacs-replace (&optional dont-ask)
+  "A TPU-edt interface to the Emacs replace functions.
+If TPU-edt is currently in regular expression mode, the Emacs regular
+expression replace functions are used.  If an argument is supplied,
+replacements are performed without asking.  Only works in forward direction."
+  (interactive "P")
+  (cond (dont-ask
+	 (setq current-prefix-arg nil)
+	 (call-interactively
+	  (if tpu-regexp-p 'replace-regexp 'replace-string)))
+	(t
+	 (call-interactively
+	  (if tpu-regexp-p 'query-replace-regexp 'query-replace)))))
+
+(defun tpu-add-at-bol (text)
+  "Add text to the beginning of each line in a region,
+or each line in the entire buffer if no region is selected."
+  (interactive
+   (list (tpu-string-prompt "String to add: " 'tpu-add-at-bol-hist)))
+  (if (string= "" text) (tpu-error "No string specified."))
+  (cond ((tpu-mark)
+	 (save-excursion
+	   (if (> (point) (tpu-mark)) (exchange-point-and-mark))
+	   (while (and (< (point) (tpu-mark)) (re-search-forward "^" (tpu-mark) t))
+	     (if (< (point) (tpu-mark)) (replace-match text))))
+	 (tpu-unselect t))
+	(t
+	 (save-excursion
+	   (goto-char (point-min))
+	   (while (and (re-search-forward "^" nil t) (not (eobp)))
+	     (replace-match text))))))
+
+(defun tpu-add-at-eol (text)
+  "Add text to the end of each line in a region,
+or each line of the entire buffer if no region is selected."
+  (interactive
+   (list (tpu-string-prompt "String to add: " 'tpu-add-at-eol-hist)))
+  (if (string= "" text) (tpu-error "No string specified."))
+  (cond ((tpu-mark)
+	 (save-excursion
+	   (if (> (point) (tpu-mark)) (exchange-point-and-mark))
+	   (while (< (point) (tpu-mark))
+	     (end-of-line)
+	     (if (<= (point) (tpu-mark)) (insert text))
+	     (forward-line)))
+	 (tpu-unselect t))
+	(t
+	 (save-excursion
+	   (goto-char (point-min))
+	   (while (not (eobp))
+	     (end-of-line) (insert text) (forward-line))))))
+
+(defun tpu-trim-line-ends nil
+  "Remove trailing whitespace from every line in the buffer."
+  (interactive)
+  (save-match-data
+    (save-excursion
+      (goto-char (point-min))
+      (while (re-search-forward "[ \t][ \t]*$" nil t)
+	(delete-region (match-beginning 0) (match-end 0))))))
+
+
+;;;
+;;;  Movement by character
+;;;
+(defun tpu-char (num)
+  "Move to the next character in the current direction.
+A repeat count means move that many characters."
+  (interactive "p")
+  (if tpu-advance (tpu-forward-char num) (tpu-backward-char num)))
+
+(defun tpu-forward-char (num)
+  "Move right ARG characters (left if ARG is negative)."
+  (interactive "p")
+  (forward-char num))
+
+(defun tpu-backward-char (num)
+  "Move left ARG characters (right if ARG is negative)."
+  (interactive "p")
+  (backward-char num))
+
+
+;;;
+;;;  Movement by word
+;;;
+(defvar tpu-word-separator-list '()
+  "List of additional word separators.")
+(defvar tpu-skip-chars "^ \t"
+  "Characters to skip when moving by word.
+Additional word separators are added to this string.")
+
+(defun tpu-word (num)
+  "Move to the beginning of the next word in the current direction.
+A repeat count means move that many words."
+  (interactive "p")
+  (if tpu-advance (tpu-forward-to-word num) (tpu-backward-to-word num)))
+
+(defun tpu-forward-to-word (num)
+  "Move forward until encountering the beginning of a word.
+With argument, do this that many times."
+  (interactive "p")
+  (while (and (> num 0) (not (eobp)))
+    (let* ((beg (point))
+	   (end (prog2 (end-of-line) (point) (goto-char beg))))
+      (cond ((eolp)
+	     (forward-char 1))
+	    ((memq (char-after (point)) tpu-word-separator-list)
+	     (forward-char 1)
+	     (skip-chars-forward " \t" end))
+	    (t
+	     (skip-chars-forward tpu-skip-chars end)
+	     (skip-chars-forward " \t" end))))
+    (setq num (1- num))))
+
+(defun tpu-backward-to-word (num)
+  "Move backward until encountering the beginning of a word.
+With argument, do this that many times."
+  (interactive "p")
+  (while (and (> num 0) (not (bobp)))
+    (let* ((beg (point))
+	   (end (prog2 (beginning-of-line) (point) (goto-char beg))))
+      (cond ((bolp)
+	     ( forward-char -1))
+	    ((memq (char-after (1- (point)))  tpu-word-separator-list)
+	     (forward-char -1))
+	    (t
+	     (skip-chars-backward " \t" end)
+	     (skip-chars-backward tpu-skip-chars end)
+	     (if (and (not (bolp)) (= ?  (char-syntax (char-after (point)))))
+		 (forward-char -1)))))
+    (setq num (1- num))))
+
+(defun tpu-add-word-separators (separators)
+  "Add new word separators for TPU-edt word commands."
+  (interactive "sSeparators: ")
+  (let* ((n 0) (length (length separators)))
+    (while (< n length)
+      (let ((char (aref separators n))
+	    (ss (substring separators n (1+ n))))
+	(cond ((not (memq char tpu-word-separator-list))
+	       (setq tpu-word-separator-list
+		     (append ss tpu-word-separator-list))
+	       (cond ((= char ?-)
+		      (setq tpu-skip-chars (concat tpu-skip-chars "\\-")))
+		     ((= char ?\\)
+		      (setq tpu-skip-chars (concat tpu-skip-chars "\\\\")))
+		     ((= char ?^)
+		      (setq tpu-skip-chars (concat tpu-skip-chars "\\^")))
+		     (t
+		      (setq tpu-skip-chars (concat tpu-skip-chars ss))))))
+	(setq n (1+ n))))))
+
+(defun tpu-reset-word-separators nil
+  "Reset word separators to default value."
+  (interactive)
+  (setq tpu-word-separator-list nil)
+  (setq tpu-skip-chars "^ \t"))
+
+(defun tpu-set-word-separators (separators)
+  "Set new word separators for TPU-edt word commands."
+  (interactive "sSeparators: ")
+  (tpu-reset-word-separators)
+  (tpu-add-word-separators separators))
+
+
+;;;
+;;;  Movement by line
+;;;
+(defun tpu-next-line (num)
+  "Move to next line.
+Prefix argument serves as a repeat count."
+  (interactive "p")
+  (line-move num)
+  (setq this-command 'next-line))
+
+(defun tpu-previous-line (num)
+  "Move to previous line.
+Prefix argument serves as a repeat count."
+  (interactive "p")
+  (line-move (- num))
+  (setq this-command 'previous-line))
+
+(defun tpu-next-beginning-of-line (num)
+  "Move to beginning of line; if at beginning, move to beginning of next line.
+Accepts a prefix argument for the number of lines to move."
+  (interactive "p")
+  (backward-char 1)
+  (forward-visible-line (- 1 num)))
+
+(defun tpu-end-of-line (num)
+  "Move to the next end of line in the current direction.
+A repeat count means move that many lines."
+  (interactive "p")
+  (if tpu-advance (tpu-next-end-of-line num) (tpu-previous-end-of-line num)))
+
+(defun tpu-next-end-of-line (num)
+  "Move to end of line; if at end, move to end of next line.
+Accepts a prefix argument for the number of lines to move."
+  (interactive "p")
+  (forward-char 1)
+  (end-of-line num))
+
+(defun tpu-previous-end-of-line (num)
+  "Move EOL upward.
+Accepts a prefix argument for the number of lines to move."
+  (interactive "p")
+  (end-of-line (- 1 num)))
+
+(defun tpu-current-end-of-line nil
+  "Move point to end of current line."
+  (interactive)
+  (let ((beg (point)))
+    (end-of-line)
+    (if (= beg (point)) (message "You are already at the end of a line."))))
+
+(defun tpu-line (num)
+  "Move to the beginning of the next line in the current direction.
+A repeat count means move that many lines."
+  (interactive "p")
+  (if tpu-advance (tpu-forward-line num) (tpu-backward-line num)))
+
+(defun tpu-forward-line (num)
+  "Move to beginning of next line.
+Prefix argument serves as a repeat count."
+  (interactive "p")
+  (forward-line num))
+
+(defun tpu-backward-line (num)
+  "Move to beginning of previous line.
+Prefix argument serves as repeat count."
+  (interactive "p")
+  (or (bolp) (>= 0 num) (setq num (- num 1)))
+  (forward-line (- num)))
+
+
+;;;
+;;;  Movement by paragraph
+;;;
+(defun tpu-paragraph (num)
+  "Move to the next paragraph in the current direction.
+A repeat count means move that many paragraphs."
+  (interactive "p")
+  (if tpu-advance
+      (tpu-next-paragraph num) (tpu-previous-paragraph num)))
+
+(defun tpu-next-paragraph (num)
+  "Move to beginning of the next paragraph.
+Accepts a prefix argument for the number of paragraphs."
+  (interactive "p")
+  (beginning-of-line)
+  (while (and (not (eobp)) (> num 0))
+    (if (re-search-forward "^[ \t]*$" nil t)
+	(if (re-search-forward "[^ \t\n]" nil t)
+	    (goto-char (match-beginning 0))
+	  (goto-char (point-max))))
+    (setq num (1- num)))
+  (beginning-of-line))
+
+
+(defun tpu-previous-paragraph (num)
+  "Move to beginning of previous paragraph.
+Accepts a prefix argument for the number of paragraphs."
+  (interactive "p")
+  (end-of-line)
+  (while (and (not (bobp)) (> num 0))
+    (if (not (and (re-search-backward "^[ \t]*$" nil t)
+		  (re-search-backward "[^ \t\n]" nil t)
+		  (re-search-backward "^[ \t]*$" nil t)
+		  (progn (re-search-forward "[^ \t\n]" nil t)
+			 (goto-char (match-beginning 0)))))
+	(goto-char (point-min)))
+    (setq num (1- num)))
+  (beginning-of-line))
+
+
+;;;
+;;;  Movement by page
+;;;
+(defun tpu-page (num)
+  "Move to the next page in the current direction.
+A repeat count means move that many pages."
+  (interactive "p")
+  (if tpu-advance (forward-page num) (backward-page num))
+  (if (eobp) (recenter -1)))
+
+
+;;;
+;;;  Scrolling and movement within the buffer
+;;;
+(defun tpu-scroll-window (num)
+  "Scroll the display to the next section in the current direction.
+A repeat count means scroll that many sections."
+  (interactive "p")
+  (if tpu-advance (tpu-scroll-window-up num) (tpu-scroll-window-down num)))
+
+(defun tpu-scroll-window-down (num)
+  "Scroll the display down to the next section.
+A repeat count means scroll that many sections."
+  (interactive "p")
+  (let* ((beg (tpu-current-line))
+	 (height (1- (window-height)))
+	 (lines (* num (/ (* height tpu-percent-scroll) 100))))
+    (line-move (- lines))
+    (if (> lines beg) (recenter 0))))
+
+(defun tpu-scroll-window-up (num)
+  "Scroll the display up to the next section.
+A repeat count means scroll that many sections."
+  (interactive "p")
+  (let* ((beg (tpu-current-line))
+	 (height (1- (window-height)))
+	 (lines (* num (/ (* height tpu-percent-scroll) 100))))
+    (line-move lines)
+    (if (>= (+ lines beg) height) (recenter -1))))
+
+(defun tpu-pan-right (num)
+  "Pan right tpu-pan-columns (16 by default).
+Accepts a prefix argument for the number of tpu-pan-columns to scroll."
+  (interactive "p")
+  (scroll-left (* tpu-pan-columns num)))
+
+(defun tpu-pan-left (num)
+  "Pan left tpu-pan-columns (16 by default).
+Accepts a prefix argument for the number of tpu-pan-columns to scroll."
+  (interactive "p")
+  (scroll-right (* tpu-pan-columns num)))
+
+(defun tpu-move-to-beginning nil
+  "Move cursor to the beginning of buffer, but don't set the mark."
+  (interactive)
+  (goto-char (point-min)))
+
+(defun tpu-move-to-end nil
+  "Move cursor to the end of buffer, but don't set the mark."
+  (interactive)
+  (goto-char (point-max))
+  (recenter -1))
+
+(defun tpu-goto-percent (perc)
+  "Move point to ARG percentage of the buffer."
+  (interactive "NGoto-percentage: ")
+  (if (or (> perc 100) (< perc 0))
+      (tpu-error "Percentage %d out of range 0 < percent < 100." perc)
+    (goto-char (/ (* (point-max) perc) 100))))
+
+(defun tpu-beginning-of-window nil
+  "Move cursor to top of window."
+  (interactive)
+  (move-to-window-line 0))
+
+(defun tpu-end-of-window nil
+  "Move cursor to bottom of window."
+  (interactive)
+  (move-to-window-line -1))
+
+(defun tpu-line-to-bottom-of-window nil
+  "Move the current line to the bottom of the window."
+  (interactive)
+  (recenter -1))
+
+(defun tpu-line-to-top-of-window nil
+  "Move the current line to the top of the window."
+  (interactive)
+  (recenter 0))
+
+
+;;;
+;;;  Direction
+;;;
+(defun tpu-advance-direction nil
+  "Set TPU Advance mode so keypad commands move forward."
+  (interactive)
+  (setq tpu-direction-string " Advance")
+  (setq tpu-advance t)
+  (setq tpu-reverse nil)
+  (tpu-set-search)
+  (tpu-update-mode-line))
+
+(defun tpu-backup-direction nil
+  "Set TPU Backup mode so keypad commands move backward."
+  (interactive)
+  (setq tpu-direction-string " Reverse")
+  (setq tpu-advance nil)
+  (setq tpu-reverse t)
+  (tpu-set-search)
+  (tpu-update-mode-line))
+
+(defun tpu-toggle-direction nil
+  "Change the current TPU direction."
+  (interactive)
+  (if tpu-advance (tpu-backup-direction) (tpu-advance-direction)))
+
+
+;;;
+;;;  Minibuffer map additions to make KP_enter = RET
+;;;
+;; Standard Emacs settings under xterm in function-key-map map
+;; "\eOM" to [kp-enter] and [kp-enter] to RET, but since the output of the map
+;; is not fed back into the map, the key stays as kp-enter :-(.
+(define-key minibuffer-local-map [kp-enter] 'exit-minibuffer)
+;; These are not necessary because they are inherited.
+;; (define-key minibuffer-local-ns-map [kp-enter] 'exit-minibuffer)
+;; (define-key minibuffer-local-completion-map [kp-enter] 'exit-minibuffer)
+(define-key minibuffer-local-must-match-map [kp-enter] 'minibuffer-complete-and-exit)
+
+
+;;;
+;;;  Minibuffer map additions to set search direction
+;;;
+(define-key minibuffer-local-map [kp-4] 'tpu-search-forward-exit)  ;KP4
+(define-key minibuffer-local-map [kp-5] 'tpu-search-backward-exit) ;KP5
+
+
+;;;
+;;;  Functions to set, reset, and toggle the control key bindings
+;;;
+
+(defvar tpu-control-keys-map
+  (let ((map (make-sparse-keymap)))
+  (define-key map "\C-\\" 'quoted-insert)                ; ^\
+  (define-key map "\C-a" 'tpu-toggle-overwrite-mode)     ; ^A
+  (define-key map "\C-b" 'repeat-complex-command)        ; ^B
+  (define-key map "\C-e" 'tpu-current-end-of-line)       ; ^E
+  (define-key map "\C-h" 'tpu-next-beginning-of-line)    ; ^H (BS)
+  (define-key map "\C-j" 'tpu-delete-previous-word)      ; ^J (LF)
+  (define-key map "\C-k" 'tpu-define-macro-key)          ; ^K
+  (define-key map "\C-l" 'tpu-insert-formfeed)           ; ^L (FF)
+  (define-key map "\C-r" 'recenter)                      ; ^R
+  (define-key map "\C-u" 'tpu-delete-to-bol)             ; ^U
+  (define-key map "\C-v" 'tpu-quoted-insert)             ; ^V
+  (define-key map "\C-w" 'redraw-display)                ; ^W
+  (define-key map "\C-z" 'tpu-exit)                      ; ^Z
+  map))
+
+(defun tpu-set-control-keys ()
+  "Set control keys to TPU style functions."
+  (tpu-reset-control-keys 'tpu))
+
+(defun tpu-reset-control-keys (tpu-style)
+  "Set control keys to TPU or Emacs style functions."
+  (let ((parent (keymap-parent tpu-global-map)))
+    (if tpu-style
+        (if (eq parent tpu-control-keys-map)
+            nil                         ;All done already.
+          ;; Insert tpu-control-keys-map in the global map.
+          (set-keymap-parent tpu-control-keys-map parent)
+          (set-keymap-parent tpu-global-map tpu-control-keys-map))
+      (if (not (eq parent tpu-control-keys-map))
+          nil                         ;All done already.
+        ;; Remove tpu-control-keys-map from the global map.
+        (set-keymap-parent tpu-global-map (keymap-parent parent))
+        (set-keymap-parent tpu-control-keys-map nil)))
+    (setq tpu-control-keys tpu-style)))
+
+(defun tpu-toggle-control-keys nil
+  "Toggle control key bindings between TPU-edt and Emacs."
+  (interactive)
+  (tpu-reset-control-keys (not tpu-control-keys))
+  (and (called-interactively-p 'interactive)
+       (message "Control keys function with %s bindings."
+		(if tpu-control-keys "TPU-edt" "Emacs"))))
+
+
+;;;
+;;;  Emacs version 19 minibuffer history support
+;;;
+(defun tpu-next-history-element (n)
+  "Insert the next element of the minibuffer history into the minibuffer."
+  (interactive "p")
+  (next-history-element n)
+  (goto-char (point-max)))
+
+(defun tpu-previous-history-element (n)
+  "Insert the previous element of the minibuffer history into the minibuffer."
+  (interactive "p")
+  (previous-history-element n)
+  (goto-char (point-max)))
+
+(defun tpu-arrow-history nil
+  "Modify minibuffer maps to use arrows for history recall."
+  (interactive)
+  (dolist (cur (where-is-internal 'tpu-previous-line))
+    (define-key read-expression-map cur 'tpu-previous-history-element)
+    (define-key minibuffer-local-map cur 'tpu-previous-history-element)
+    ;; These are inherited anyway.  --Stef
+    ;; (define-key minibuffer-local-ns-map cur 'tpu-previous-history-element)
+    ;; (define-key minibuffer-local-completion-map cur 'tpu-previous-history-element)
+    ;; (define-key minibuffer-local-must-match-map cur 'tpu-previous-history-element)
+    )
+
+  (dolist (cur (where-is-internal 'tpu-next-line))
+    (define-key read-expression-map cur 'tpu-next-history-element)
+    (define-key minibuffer-local-map cur 'tpu-next-history-element)
+    ;; These are inherited anyway.  --Stef
+    ;; (define-key minibuffer-local-ns-map cur 'tpu-next-history-element)
+    ;; (define-key minibuffer-local-completion-map cur 'tpu-next-history-element)
+    ;; (define-key minibuffer-local-must-match-map cur 'tpu-next-history-element)
+    ))
+
+
+;;;
+;;;  Emacs version 19 X-windows key definition support
+;;;
+(defun tpu-load-xkeys (file)
+  "Load the TPU-edt X-windows key definitions FILE.
+If FILE is nil, try to load a default file.  The default file names are
+`~/.tpu-lucid-keys' for XEmacs, and `~/.tpu-keys' for Emacs."
+  (interactive "fX key definition file: ")
+  (cond (file
+	 (setq file (expand-file-name file)))
+	(tpu-xkeys-file
+	 (setq file (expand-file-name tpu-xkeys-file)))
+	((featurep 'xemacs)
+	 (setq file (convert-standard-filename
+		     (expand-file-name "~/.tpu-lucid-keys"))))
+	(t
+	 (setq file (convert-standard-filename
+		     (expand-file-name "~/.tpu-keys")))
+	 (and (not (file-exists-p file))
+	      (file-exists-p
+	       (convert-standard-filename
+		(expand-file-name "~/.tpu-gnu-keys")))
+	      (tpu-copy-keyfile
+	       (convert-standard-filename
+		(expand-file-name "~/.tpu-gnu-keys")) file))))
+  (cond ((file-readable-p file)
+	 (load-file file))
+	(t
+         ;; This used to force the user to build `file'.  With the
+         ;; new code, such a file may not be necessary.  In case it
+         ;; is, issue a message giving a hint as to how to build it.
+         (message "%s not found: use M-x tpu-mapper to create it"
+                  (abbreviate-file-name file)))))
+
+(defun tpu-copy-keyfile (oldname newname)
+  "Copy the TPU-edt X key definitions file to the new default name."
+  (interactive "fOld name: \nFNew name: ")
+  (if (not (get-buffer "*TPU-Notice*")) (generate-new-buffer "*TPU-Notice*"))
+  (set-buffer "*TPU-Notice*")
+  (erase-buffer)
+  (insert "
+  NOTICE --
+
+  The default name of the TPU-edt key definition file has changed
+  from `~/.tpu-gnu-keys' to `~/.tpu-keys'.  With your permission,
+  your key definitions will be copied to the new file.  If you'll
+  never use older versions of Emacs, you can remove the old file.
+  If the copy fails, you'll be asked if you want to create a new
+  key definitions file.  Do you want to copy your key definition
+  file now?
+  ")
+  (save-window-excursion
+    (switch-to-buffer-other-window "*TPU-Notice*")
+    (shrink-window-if-larger-than-buffer)
+    (goto-char (point-min))
+    (beep)
+    (and (tpu-y-or-n-p "Copy key definitions to the new file now? ")
+	 (with-demoted-errors "Sorry, couldn't copy - %s."
+           (copy-file oldname newname)))
+    (kill-buffer "*TPU-Notice*")))
+
+(defvar tpu-edt-old-global-values nil)
+
+;;;
+;;;  Start and Stop TPU-edt
+;;;
+;;;###autoload
+(defun tpu-edt-on ()
+  "Turn on TPU/edt emulation."
+  (interactive)
+  ;; To clean things up (and avoid cycles in the global map).
+  (tpu-edt-off)
+  ;; First, activate tpu-global-map, while protecting the original keymap.
+  (set-keymap-parent tpu-global-map global-map)
+  (setq global-map tpu-global-map)
+  (use-global-map global-map)
+  ;; Then do the normal TPU setup.
+  (transient-mark-mode t)
+  (add-hook 'post-command-hook 'tpu-search-highlight)
+  (tpu-set-mode-line t)
+  (tpu-advance-direction)
+  ;; set page delimiter, display line truncation, and scrolling like TPU
+  (dolist (varval '((page-delimiter . "\f")
+                    (truncate-lines . t)
+                    (scroll-step . 1)))
+    (push (cons (car varval) (default-value (car varval)))
+          tpu-edt-old-global-values)
+    (set-default (car varval) (cdr varval)))
+  (tpu-set-control-keys)
+  (and window-system (tpu-load-xkeys nil))
+  (tpu-arrow-history)
+  ;; Then protect tpu-global-map from user modifications.
+  (let ((map (make-sparse-keymap)))
+    (set-keymap-parent map global-map)
+    (setq global-map map)
+    (use-global-map map))
+  (setq tpu-edt-mode t))
+
+(defun tpu-edt-off ()
+  "Turn off TPU/edt emulation.  Note that the keypad is left on."
+  (interactive)
+  (tpu-reset-control-keys nil)
+  (remove-hook 'post-command-hook 'tpu-search-highlight)
+  (tpu-set-mode-line nil)
+  (while tpu-edt-old-global-values
+    (let ((varval (pop tpu-edt-old-global-values)))
+      (set-default (car varval) (cdr varval))))
+  ;; Remove tpu-global-map from the global map.
+  (let ((map global-map))
+    (while map
+      (let ((parent (keymap-parent map)))
+        (if (eq tpu-global-map parent)
+            (set-keymap-parent map (keymap-parent parent))
+          (setq map parent)))))
+  ;; Only has an effect if the advice in tpu-extras has been activated.
+  (condition-case nil
+      (with-no-warnings (ad-disable-regexp "\\`tpu-"))
+    (error nil))
+  (setq tpu-edt-mode nil))
+
+
+;;;### (autoloads nil "tpu-extras" "tpu-extras.el" "cbbb448cff48fab904ac19805aa6f36a")
+;;; Generated autoloads from tpu-extras.el
+
+(autoload 'tpu-cursor-free-mode "tpu-extras" "\
+Minor mode to allow the cursor to move freely about the screen.
+With a prefix argument ARG, enable the mode if ARG is positive,
+and disable it otherwise.  If called from Lisp, enable the mode
+if ARG is omitted or nil.
+
+\(fn &optional ARG)" t nil)
+
+(autoload 'tpu-set-scroll-margins "tpu-extras" "\
+Set scroll margins.
+
+\(fn TOP BOTTOM)" t nil)
+
+(autoload 'tpu-set-cursor-free "tpu-extras" "\
+Allow the cursor to move freely about the screen.
+
+\(fn)" t nil)
+
+(autoload 'tpu-set-cursor-bound "tpu-extras" "\
+Constrain the cursor to the flow of the text.
+
+\(fn)" t nil)
+
+;;;***
+
+(provide 'tpu-edt)
+
+;;; tpu-edt.el ends here
diff --git a/lisp/obsolete/tpu-extras.el b/lisp/obsolete/tpu-extras.el
new file mode 100644
index 00000000000..32257e840ac
--- /dev/null
+++ b/lisp/obsolete/tpu-extras.el
@@ -0,0 +1,446 @@
+;;; tpu-extras.el --- scroll margins and free cursor mode for TPU-edt
+
+;; Copyright (C) 1993-1995, 2000-2014 Free Software Foundation, Inc.
+
+;; Author: Rob Riepel <riepel@networking.stanford.edu>
+;; Maintainer: Rob Riepel <riepel@networking.stanford.edu>
+;; Keywords: emulations
+;; Package: tpu-edt
+;; Obsolete-since: 24.5
+
+;; 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:
+
+;;  Use the functions defined here to customize TPU-edt to your tastes by
+;;  setting scroll margins and/or turning on free cursor mode.  Here's an
+;;  example for your init file.
+
+;;     (tpu-set-cursor-free)                   ; Set cursor free.
+;;     (tpu-set-scroll-margins "10%" "15%")    ; Set scroll margins.
+
+;;  Scroll margins and cursor binding can be changed from within emacs using
+;;  the following commands:
+
+;;     tpu-set-scroll-margins  or   set scroll margins
+;;     tpu-set-cursor-bound    or   set cursor bound
+;;     tpu-set-cursor-free     or   set cursor free
+
+;;  Additionally, Gold-F toggles between bound and free cursor modes.
+
+;;  Note that switching out of free cursor mode or exiting TPU-edt while in
+;;  free cursor mode strips trailing whitespace from every line in the file.
+
+
+;;; Details:
+
+;;  The functions contained in this file implement scroll margins and free
+;;  cursor mode.  The following keys and commands are affected.
+
+;;       key/command   function                        scroll   cursor
+
+;;       Up-Arrow      previous line                     x        x
+;;       Down-Arrow    next line                         x        x
+;;       Right-Arrow   next character                             x
+;;       Left-Arrow    previous character                         x
+;;       KP0           next or previous line             x
+;;       KP7           next or previous page             x
+;;       KP8           next or previous screen           x
+;;       KP2           next or previous end-of-line      x        x
+;;       Control-e     current end-of-line                        x
+;;       Control-h     previous beginning-of-line        x
+;;       Next Scr      next screen                       x
+;;       Prev Scr      previous screen                   x
+;;       Search        find a string                     x
+;;       Replace       find and replace a string         x
+;;       Newline       insert a newline                  x
+;;       Paragraph     next or previous paragraph        x
+;;       Auto-Fill     break lines on spaces             x
+
+;;  These functions are not part of the base TPU-edt for the following
+;;  reasons:
+
+;;  Free cursor mode is implemented with the emacs picture-mode functions.
+;;  These functions support moving the cursor all over the screen, however,
+;;  when the cursor is moved past the end of a line, spaces or tabs are
+;;  appended to the line - even if no text is entered in that area.  In
+;;  order for a free cursor mode to work exactly like TPU/edt, this trailing
+;;  whitespace needs to be dealt with in every function that might encounter
+;;  it.  Such global changes are impractical, however, free cursor mode is
+;;  too valuable to abandon completely, so it has been implemented in those
+;;  functions where it serves best.
+
+;;  The implementation of scroll margins adds overhead to previously
+;;  simple and often used commands.  These commands are now responsible
+;;  for their normal operation and part of the display function.  There
+;;  is a possibility that this display overhead could adversely affect the
+;;  performance of TPU-edt on slower computers.  In order to support the
+;;  widest range of computers, scroll margin support is optional.
+
+;;  It's actually not known whether the overhead associated with scroll
+;;  margin support is significant.  If you find that it is, please send
+;;  a note describing the extent of the performance degradation.  Be sure
+;;  to include a description of the platform where you're running TPU-edt.
+;;  Send your note to the address provided by Gold-V.
+
+;;  Even with these differences and limitations, these functions implement
+;;  important aspects of the real TPU/edt.  Those who miss free cursor mode
+;;  and/or scroll margins will appreciate these implementations.
+
+;;; Code:
+
+
+;;;  Gotta have tpu-edt
+
+(require 'tpu-edt)
+
+
+;;;  Customization variables
+
+(defcustom tpu-top-scroll-margin 0
+  "Scroll margin at the top of the screen.
+Interpreted as a percent of the current window size."
+  :type 'integer
+  :group 'tpu)
+(defcustom tpu-bottom-scroll-margin 0
+  "Scroll margin at the bottom of the screen.
+Interpreted as a percent of the current window size."
+  :type 'integer
+  :group 'tpu)
+
+(defcustom tpu-backward-char-like-tpu t
+  "If non-nil, in free cursor mode backward-char (left-arrow) works
+just like TPU/edt.  Otherwise, backward-char will move to the end of
+the previous line when starting from a line beginning."
+  :type 'boolean
+  :group 'tpu)
+
+
+;;;  Global variables
+
+;;;###autoload
+(define-minor-mode tpu-cursor-free-mode
+  "Minor mode to allow the cursor to move freely about the screen.
+With a prefix argument ARG, enable the mode if ARG is positive,
+and disable it otherwise.  If called from Lisp, enable the mode
+if ARG is omitted or nil."
+  :init-value nil
+  (if (not tpu-cursor-free-mode)
+      (tpu-trim-line-ends))
+  (if (not tpu-cursor-free-mode)
+      (message "The cursor is now bound to the flow of your text.")
+    (message "The cursor will now move freely about the screen.")))
+
+
+;;;  Hooks  --  Set cursor free in picture mode.
+;;;             Clean up when writing a file from cursor free mode.
+
+(add-hook 'picture-mode-hook 'tpu-set-cursor-free)
+
+(defun tpu-trim-line-ends-if-needed ()
+  "Eliminate whitespace at ends of lines, if the cursor is free."
+  (if (and (buffer-modified-p) tpu-cursor-free-mode) (tpu-trim-line-ends)))
+(add-hook 'before-save-hook 'tpu-trim-line-ends-if-needed)
+
+
+;;;  Utility routines for implementing scroll margins
+
+(defun tpu-top-check (beg lines)
+  "Enforce scroll margin at the top of screen."
+  (let ((margin	 (/ (* (window-height) tpu-top-scroll-margin) 100)))
+    (cond ((< beg margin) (recenter beg))
+	  ((< (- beg lines) margin) (recenter margin)))))
+
+(defun tpu-bottom-check (beg lines)
+  "Enforce scroll margin at the bottom of screen."
+  (let* ((height (window-height))
+	 (margin (+ 1 (/ (* height tpu-bottom-scroll-margin) 100)))
+	 ;; subtract 1 from height because it includes mode line
+	 (difference (- height margin 1)))
+    (cond ((> beg difference) (recenter beg))
+	  ((> (+ beg lines) difference) (recenter (- margin))))))
+
+
+;;;  Movement by character
+
+(defun tpu-forward-char (num)
+  "Move right ARG characters (left if ARG is negative)."
+  (interactive "p")
+  (if tpu-cursor-free-mode (picture-forward-column num) (forward-char num)))
+
+(defun tpu-backward-char (num)
+  "Move left ARG characters (right if ARG is negative)."
+  (interactive "p")
+  (cond ((not tpu-cursor-free-mode)
+	 (backward-char num))
+	(tpu-backward-char-like-tpu
+	 (picture-backward-column num))
+	((bolp)
+	 (backward-char 1)
+	 (picture-end-of-line)
+	 (picture-backward-column (1- num)))
+	(t
+	 (picture-backward-column num))))
+
+
+;;;  Movement by line
+
+(defun tpu-next-line (num)
+  "Move to next line.
+Prefix argument serves as a repeat count."
+  (interactive "p")
+  (let ((beg (tpu-current-line)))
+    (if tpu-cursor-free-mode (or (eobp) (picture-move-down num))
+      (line-move num))
+    (tpu-bottom-check beg num)
+    (setq this-command 'next-line)))
+
+(defun tpu-previous-line (num)
+  "Move to previous line.
+Prefix argument serves as a repeat count."
+  (interactive "p")
+  (let ((beg (tpu-current-line)))
+    (if tpu-cursor-free-mode (picture-move-up num) (line-move (- num)))
+    (tpu-top-check beg num)
+    (setq this-command 'previous-line)))
+
+(defun tpu-next-beginning-of-line (num)
+  "Move to beginning of line; if at beginning, move to beginning of next line.
+Accepts a prefix argument for the number of lines to move."
+  (interactive "p")
+  (let ((beg (tpu-current-line)))
+    (backward-char 1)
+    (forward-visible-line (- 1 num))
+    (tpu-top-check beg num)))
+
+(defun tpu-next-end-of-line (num)
+  "Move to end of line; if at end, move to end of next line.
+Accepts a prefix argument for the number of lines to move."
+  (interactive "p")
+  (let ((beg (tpu-current-line)))
+    (cond (tpu-cursor-free-mode
+	   (let ((beg (point)))
+	     (if (< 1 num) (forward-line num))
+	     (picture-end-of-line)
+	     (if (<= (point) beg) (progn (forward-line) (picture-end-of-line)))))
+	  (t
+	   (forward-char)
+	   (end-of-line num)))
+    (tpu-bottom-check beg num)))
+
+(defun tpu-previous-end-of-line (num)
+  "Move EOL upward.
+Accepts a prefix argument for the number of lines to move."
+  (interactive "p")
+  (let ((beg (tpu-current-line)))
+    (cond (tpu-cursor-free-mode
+	   (picture-end-of-line (- 1 num)))
+	  (t
+	   (end-of-line (- 1 num))))
+    (tpu-top-check beg num)))
+
+(defun tpu-current-end-of-line ()
+  "Move point to end of current line."
+  (interactive)
+  (let ((beg (point)))
+    (if tpu-cursor-free-mode (picture-end-of-line) (end-of-line))
+    (if (= beg (point)) (message "You are already at the end of a line."))))
+
+(defun tpu-forward-line (num)
+  "Move to beginning of next line.
+Prefix argument serves as a repeat count."
+  (interactive "p")
+  (let ((beg (tpu-current-line)))
+    (forward-line num)
+    (tpu-bottom-check beg num)))
+
+(defun tpu-backward-line (num)
+  "Move to beginning of previous line.
+Prefix argument serves as repeat count."
+  (interactive "p")
+  (let ((beg (tpu-current-line)))
+    (or (bolp) (>= 0 num) (setq num (- num 1)))
+    (forward-line (- num))
+    (tpu-top-check beg num)))
+
+
+;;;  Movement by paragraph
+
+;; Cf edt-with-position.
+(defmacro tpu-with-position (&rest body)
+  "Execute BODY with some position-related variables bound."
+  `(let* ((left nil)
+          (beg (tpu-current-line))
+          (height (window-height))
+          (top-percent
+           (if (zerop tpu-top-scroll-margin) 10 tpu-top-scroll-margin))
+          (bottom-percent
+           (if (zerop tpu-bottom-scroll-margin) 15 tpu-bottom-scroll-margin))
+          (top-margin (/ (* height top-percent) 100))
+          (bottom-up-margin (1+ (/ (* height bottom-percent) 100)))
+          (bottom-margin (max beg (- height bottom-up-margin 1)))
+          (top (save-excursion (move-to-window-line top-margin) (point)))
+          (bottom (save-excursion (move-to-window-line bottom-margin) (point)))
+          (far (save-excursion
+                 (goto-char bottom)
+                 (point-at-bol (1- height)))))
+     ,@body))
+
+(defun tpu-paragraph (num)
+  "Move to the next paragraph in the current direction.
+A repeat count means move that many paragraphs."
+  (interactive "p")
+  (tpu-with-position
+   (if tpu-advance
+       (progn
+         (tpu-next-paragraph num)
+         (if (> (point) far)
+             (if (zerop (setq left (save-excursion (forward-line height))))
+                 (recenter top-margin)
+               (recenter (- left bottom-up-margin)))
+           (and (> (point) bottom) (recenter bottom-margin))))
+     (tpu-previous-paragraph num)
+     (and (< (point) top) (recenter (min beg top-margin))))))
+
+;;;  Movement by page
+
+(defun tpu-page (num)
+  "Move to the next page in the current direction.
+A repeat count means move that many pages."
+  (interactive "p")
+  (tpu-with-position
+   (if tpu-advance
+       (progn
+         (forward-page num)
+         (if (> (point) far)
+               (if (zerop (setq left (save-excursion (forward-line height))))
+                   (recenter top-margin)
+                 (recenter (- left bottom-up-margin)))
+           (and (> (point) bottom) (recenter bottom-margin))))
+     (backward-page num)
+     (and (< (point) top) (recenter (min beg top-margin))))))
+
+;;;  Scrolling
+
+(defun tpu-scroll-window-down (num)
+  "Scroll the display down to the next section.
+A repeat count means scroll that many sections."
+  (interactive "p")
+  (let* ((beg (tpu-current-line))
+	 (height (1- (window-height)))
+	 (lines (* num (/ (* height tpu-percent-scroll) 100))))
+    (line-move (- lines))
+    (tpu-top-check beg lines)))
+
+(defun tpu-scroll-window-up (num)
+  "Scroll the display up to the next section.
+A repeat count means scroll that many sections."
+  (interactive "p")
+  (let* ((beg (tpu-current-line))
+	 (height (1- (window-height)))
+	 (lines (* num (/ (* height tpu-percent-scroll) 100))))
+    (line-move lines)
+    (tpu-bottom-check beg lines)))
+
+
+;;;  Replace the TPU-edt internal search function
+
+(defun tpu-search-internal (pat &optional quiet)
+  "Search for a string or regular expression."
+  (tpu-with-position
+   (tpu-search-internal-core pat quiet)
+   (if tpu-searching-forward
+       (progn
+         (if (> (point) far)
+             (if (zerop (setq left (save-excursion (forward-line height))))
+                 (recenter top-margin)
+               (recenter (- left bottom-up-margin)))
+           (and (> (point) bottom) (recenter bottom-margin))))
+     (and (< (point) top) (recenter (min beg top-margin))))))
+
+;; Advise the newline, newline-and-indent, and do-auto-fill functions.
+(defadvice newline (around tpu-respect-bottom-scroll-margin activate disable)
+  "Respect `tpu-bottom-scroll-margin'."
+  (let ((beg (tpu-current-line))
+        (num (prefix-numeric-value (ad-get-arg 0))))
+    ad-do-it
+    (tpu-bottom-check beg num)))
+
+(defadvice newline-and-indent (around tpu-respect-bottom-scroll-margin)
+  "Respect `tpu-bottom-scroll-margin'."
+  (let ((beg (tpu-current-line)))
+    ad-do-it
+    (tpu-bottom-check beg 1)))
+
+(defadvice do-auto-fill (around tpu-respect-bottom-scroll-margin)
+  "Respect `tpu-bottom-scroll-margin'."
+  (let ((beg (tpu-current-line)))
+    ad-do-it
+    (tpu-bottom-check beg 1)))
+
+
+;;;  Function to set scroll margins
+
+;;;###autoload
+(defun tpu-set-scroll-margins (top bottom)
+  "Set scroll margins."
+  (interactive
+   "sEnter top scroll margin (N lines or N%% or RETURN for current value): \
+\nsEnter bottom scroll margin (N lines or N%% or RETURN for current value): ")
+  ;; set top scroll margin
+  (or (string= top "")
+      (setq tpu-top-scroll-margin
+            (if (string= "%" (substring top -1))
+                (string-to-number top)
+	      (/ (1- (+ (* (string-to-number top) 100) (window-height)))
+		 (window-height)))))
+  ;; set bottom scroll margin
+  (or (string= bottom "")
+      (setq tpu-bottom-scroll-margin
+            (if (string= "%" (substring bottom -1))
+                (string-to-number bottom)
+	      (/ (1- (+ (* (string-to-number bottom) 100) (window-height)))
+		 (window-height)))))
+  (dolist (f '(newline newline-and-indent do-auto-fill))
+    (ad-enable-advice f 'around 'tpu-respect-bottom-scroll-margin)
+    (ad-activate f))
+  ;; report scroll margin settings if running interactively
+  (and (called-interactively-p 'interactive)
+       (message "Scroll margins set.  Top = %s%%, Bottom = %s%%"
+		tpu-top-scroll-margin tpu-bottom-scroll-margin)))
+
+
+;;;  Functions to set cursor bound or free
+
+;;;###autoload
+(defun tpu-set-cursor-free ()
+  "Allow the cursor to move freely about the screen."
+  (interactive)
+  (tpu-cursor-free-mode 1))
+
+;;;###autoload
+(defun tpu-set-cursor-bound ()
+  "Constrain the cursor to the flow of the text."
+  (interactive)
+  (tpu-cursor-free-mode -1))
+
+(provide 'tpu-extras)
+
+;; Local Variables:
+;; generated-autoload-file: "tpu-edt.el"
+;; End:
+
+;;; tpu-extras.el ends here
diff --git a/lisp/obsolete/tpu-mapper.el b/lisp/obsolete/tpu-mapper.el
new file mode 100644
index 00000000000..d653685218b
--- /dev/null
+++ b/lisp/obsolete/tpu-mapper.el
@@ -0,0 +1,353 @@
+;;; tpu-mapper.el --- create a TPU-edt X-windows keymap file
+
+;; Copyright (C) 1993-1995, 2001-2014 Free Software Foundation, Inc.
+
+;; Author: Rob Riepel <riepel@networking.stanford.edu>
+;; Maintainer: Rob Riepel <riepel@networking.stanford.edu>
+;; Keywords: emulations
+;; Package: tpu-edt
+;; Obsolete-since: 24.5
+
+;; 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:
+
+;;  This Emacs Lisp program can be used to create an Emacs Lisp file that
+;;  defines the TPU-edt keypad for Emacs running on X-Windows.
+
+;;; Code:
+
+;;;
+;;;  Key variables
+;;;
+(defvar tpu-kp4 nil)
+(defvar tpu-kp5 nil)
+(defvar tpu-key nil)
+(defvar tpu-enter nil)
+(defvar tpu-return nil)
+(defvar tpu-key-seq nil)
+(defvar tpu-enter-seq nil)
+(defvar tpu-return-seq nil)
+
+;;;
+;;;  Key mapping function
+;;;
+(defun tpu-map-key (ident descrip func gold-func)
+  (interactive)
+  (if (featurep 'xemacs)
+      (progn
+	(setq tpu-key-seq (read-key-sequence
+                           (format "Press %s%s: " ident descrip))
+              tpu-key (format "[%s]" (event-key (aref tpu-key-seq 0))))
+	(unless (equal tpu-key tpu-return)
+          (set-buffer "Keys")
+          (insert (format"(global-set-key %s %s)\n" tpu-key func))
+          (set-buffer "Gold-Keys")
+          (insert (format "(define-key GOLD-map %s %s)\n" tpu-key gold-func))))
+    (message "Press %s%s: " ident descrip)
+    (setq tpu-key-seq (read-event)
+          tpu-key (format "[%s]" tpu-key-seq))
+    (unless (equal tpu-key tpu-return)
+      (set-buffer "Keys")
+      (insert (format"(define-key tpu-global-map %s %s)\n" tpu-key func))
+      (set-buffer "Gold-Keys")
+      (insert (format "(define-key tpu-gold-map %s %s)\n" tpu-key gold-func))))
+  (set-buffer "Directions")
+  tpu-key)
+
+;;;###autoload
+(defun tpu-mapper ()
+  "Create an Emacs lisp file defining the TPU-edt keypad for X-windows.
+
+This command displays an instruction screen showing the TPU-edt keypad
+and asks you to press the TPU-edt editing keys.  It uses the keys you
+press to create an Emacs Lisp file that will define a TPU-edt keypad
+for your X server.  You can even re-arrange the standard EDT keypad to
+suit your tastes (or to cope with those silly Sun and PC keypads).
+
+Finally, you will be prompted for the name of the file to store the key
+definitions.  If you chose the default, TPU-edt will find it and load it
+automatically.  If you specify a different file name, you will need to
+set the variable ``tpu-xkeys-file'' before starting TPU-edt.  Here's how
+you might go about doing that in your init file.
+
+  (setq tpu-xkeys-file (expand-file-name \"~/.my-emacs-x-keys\"))
+  (tpu-edt)
+
+Known Problems:
+
+Sometimes, tpu-mapper will ignore a key you press, and just continue to
+prompt for the same key.  This can happen when your window manager sucks
+up the key and doesn't pass it on to Emacs, or it could be an Emacs bug.
+Either way, there's nothing that tpu-mapper can do about it.  You must
+press RETURN, to skip the current key and continue.  Later, you and/or
+your local X guru can try to figure out why the key is being ignored."
+  (interactive)
+
+  ;; Make sure we're running X-windows
+
+  (if (not window-system)
+      (error "tpu-mapper requires running Emacs with an X display"))
+
+  ;; Make sure the window is big enough to display the instructions
+
+  (if (featurep 'xemacs) (set-screen-size (selected-screen) 80 36)
+    (set-frame-size (selected-frame) 80 36))
+
+  ;; Create buffers - Directions, Keys, Gold-Keys
+
+  (if (not (get-buffer "Directions")) (generate-new-buffer "Directions"))
+  (if (not (get-buffer "Keys")) (generate-new-buffer "Keys"))
+  (if (not (get-buffer "Gold-Keys")) (generate-new-buffer "Gold-Keys"))
+
+  ;; Put headers in the Keys buffer
+
+  (set-buffer "Keys")
+  (insert "\
+;;  Key definitions for TPU-edt
+;;
+")
+
+  ;; Display directions
+
+  (switch-to-buffer "Directions")
+  (insert "
+    This program prompts you to press keys to create a custom keymap file
+    for use with the x-windows version of Emacs and TPU-edt.
+
+    Start by pressing the RETURN key, and continue by pressing the keys
+    specified in the mini-buffer.  You can re-arrange the TPU-edt keypad
+    by pressing any key you want at any prompt.  If you want to entirely
+    omit a key, just press RETURN at the prompt.
+
+    Here's a picture of the standard TPU/edt keypad for reference:
+
+          _______________________    _______________________________
+         | HELP  |      Do       |  |       |       |       |       |
+         |KeyDefs|               |  |       |       |       |       |
+         |_______|_______________|  |_______|_______|_______|_______|
+          _______________________    _______________________________
+         | Find  |Insert |Remove |  | Gold  | HELP  |FndNxt | Del L |
+         |       |       |Sto Tex|  |  key  |E-Help | Find  |Undel L|
+         |_______|_______|_______|  |_______|_______|_______|_______|
+         |Select |Pre Scr|Nex Scr|  | Page  | Sect  |Append | Del W |
+         | Reset |Pre Win|Nex Win|  |  Do   | Fill  |Replace|Undel W|
+         |_______|_______|_______|  |_______|_______|_______|_______|
+                 |Move up|          |Forward|Reverse|Remove | Del C |
+                 |  Top  |          |Bottom |  Top  |Insert |Undel C|
+          _______|_______|_______   |_______|_______|_______|_______|
+         |Mov Lef|Mov Dow|Mov Rig|  | Word  |  EOL  | Char  |       |
+         |StaOfLi|Bottom |EndOfLi|  |ChngCas|Del EOL|SpecIns| Enter |
+         |_______|_______|_______|  |_______|_______|_______|       |
+                                    |     Line      |Select | Subs  |
+                                    |   Open Line   | Reset |       |
+                                    |_______________|_______|_______|
+
+
+")
+  (delete-other-windows)
+  (goto-char (point-min))
+
+  ;; Save <CR> for future reference
+
+  (cond
+   ((featurep 'xemacs)
+    (setq tpu-return-seq (read-key-sequence "Hit carriage-return <CR> to continue "))
+    (setq tpu-return (concat "[" (format "%s" (event-key (aref tpu-return-seq 0))) "]")))
+   (t
+    (message "Hit carriage-return <CR> to continue ")
+    (setq tpu-return-seq (read-event))
+    (setq tpu-return (concat "[" (format "%s" tpu-return-seq) "]"))))
+
+  ;; Build the keymap file
+
+  (set-buffer "Keys")
+  (insert "
+;;  Arrows
+;;
+")
+  (set-buffer "Gold-Keys")
+  (insert "
+;;  GOLD Arrows
+;;
+")
+  (set-buffer "Directions")
+
+  (tpu-map-key "Up-Arrow"     ""  "'tpu-previous-line"  "'tpu-move-to-beginning")
+  (tpu-map-key "Down-arrow"   ""  "'tpu-next-line"      "'tpu-move-to-end")
+  (tpu-map-key "Right-arrow"  ""  "'tpu-forward-char"   "'end-of-line")
+  (tpu-map-key "Left-arrow"   ""  "'tpu-backward-char"  "'beginning-of-line")
+
+  (set-buffer "Keys")
+  (insert "
+;;  PF keys
+;;
+")
+  (set-buffer "Gold-Keys")
+  (insert "
+;;  GOLD PF keys
+;;
+")
+  (set-buffer "Directions")
+
+  (tpu-map-key "PF1"  " - The GOLD key"               "GOLD-map"                 "'keyboard-quit")
+  (tpu-map-key "PF2"  " - The Keypad Help key"        "'tpu-help"                 "'help-for-help")
+  (tpu-map-key "PF3"  " - The Find/Find-Next key"     "'tpu-search-again"         "'tpu-search")
+  (tpu-map-key "PF4"  " - The Del/Undelete Line key"  "'tpu-delete-current-line"  "'tpu-undelete-lines")
+
+  (set-buffer "Keys")
+  (insert "
+;;  KP0-9 KP- KP, KP. and KPenter
+;;
+")
+  (set-buffer "Gold-Keys")
+  (insert "
+;;  GOLD KP0-9 KP- KP, and KPenter
+;;
+")
+  (set-buffer "Directions")
+
+  (tpu-map-key "KP-0"      " - The Line/Open-Line key"               "'tpu-line"                 "'open-line")
+  (tpu-map-key "KP-1"      " - The Word/Change-Case key"             "'tpu-word"                 "'tpu-change-case")
+  (tpu-map-key "KP-2"      " - The EOL/Delete-EOL key"               "'tpu-end-of-line"          "'tpu-delete-to-eol")
+  (tpu-map-key "KP-3"      " - The Character/Special-Insert key"     "'tpu-char"                 "'tpu-special-insert")
+  (setq tpu-kp4 (tpu-map-key "KP-4"      " - The Forward/Bottom key"               "'tpu-advance-direction"    "'tpu-move-to-end"))
+  (setq tpu-kp5 (tpu-map-key "KP-5"      " - The Reverse/Top key"                  "'tpu-backup-direction"     "'tpu-move-to-beginning"))
+  (tpu-map-key "KP-6"      " - The Remove/Insert key"                "'tpu-cut"                  "'tpu-paste")
+  (tpu-map-key "KP-7"      " - The Page/Do key"                      "'tpu-page"                 "'execute-extended-command")
+  (tpu-map-key "KP-8"      " - The Section/Fill key"                 "'tpu-scroll-window"        "'tpu-fill")
+  (tpu-map-key "KP-9"      " - The Append/Replace key"               "'tpu-append-region"        "'tpu-replace")
+  (tpu-map-key "KP--"      " - The Delete/Undelete Word key"         "'tpu-delete-current-word"  "'tpu-undelete-words")
+  (tpu-map-key "KP-,"      " - The Delete/Undelete Character key"    "'tpu-delete-current-char"  "'tpu-undelete-char")
+  (tpu-map-key "KP-."      " - The Select/Reset key"                 "'tpu-select"               "'tpu-unselect")
+  (tpu-map-key "KP-Enter"  " - The Enter key on the numeric keypad"  "'newline"                  "'tpu-substitute")
+  ;; Save the enter key
+  (setq tpu-enter tpu-key)
+  (setq tpu-enter-seq tpu-key-seq)
+
+  (set-buffer "Keys")
+  (insert "
+;;  Editing keypad (find, insert, remove)
+;;                 (select, prev, next)
+;;
+")
+  (set-buffer "Gold-Keys")
+  (insert "
+;;  GOLD Editing keypad (find, insert, remove)
+;;                      (select, prev, next)
+;;
+")
+  (set-buffer "Directions")
+
+  (tpu-map-key "Find"      " - The Find key on the editing keypad"       "'tpu-search"              "'nil")
+  (tpu-map-key "Insert"    " - The Insert key on the editing keypad"     "'tpu-paste"               "'nil")
+  (tpu-map-key "Remove"    " - The Remove key on the editing keypad"     "'tpu-cut"                 "'tpu-store-text")
+  (tpu-map-key "Select"    " - The Select key on the editing keypad"     "'tpu-select"              "'tpu-unselect")
+  (tpu-map-key "Prev Scr"  " - The Prev Scr key on the editing keypad"   "'tpu-scroll-window-down"  "'tpu-previous-window")
+  (tpu-map-key "Next Scr"  " - The Next Scr key on the editing keypad"   "'tpu-scroll-window-up"    "'tpu-next-window")
+
+  (set-buffer "Keys")
+  (insert "
+;;  F10-14 Help Do F17
+;;
+")
+  (set-buffer "Gold-Keys")
+  (insert "
+;;  GOLD F10-14 Help Do F17
+;;
+")
+  (set-buffer "Directions")
+
+  (tpu-map-key "F10"       " - Invokes the Exit function on VT200+ terminals"  "'tpu-exit"                    "'nil")
+  (tpu-map-key "F11"       " - Inserts an Escape character into the text"      "'tpu-insert-escape"           "'nil")
+  (tpu-map-key "Backspace" " - Not Delete nor ^H!  Sometimes on the F12 key"   "'tpu-next-beginning-of-line" "'nil")
+  (tpu-map-key "F13"       " - Invokes the delete previous word function"      "'tpu-delete-previous-word"   "'nil")
+  (tpu-map-key "F14"       " - Toggles insert/overstrike modes"                "'tpu-toggle-overwrite-mode"  "'nil")
+  (tpu-map-key "Help"      " - Brings up the help screen, same as PF2"         "'tpu-help"                   "'describe-bindings")
+  (tpu-map-key "Do"        " - Invokes the COMMAND function"                   "'execute-extended-command"   "'nil")
+  (tpu-map-key "F17"       ""                                                  "'tpu-goto-breadcrumb"        "'tpu-drop-breadcrumb")
+
+  (set-buffer "Gold-Keys")
+  (cond
+   ((not (equal tpu-enter tpu-return))
+    (insert "
+;;  Minibuffer map additions to make KP_enter = RET
+;;
+")
+
+    (insert (format "(define-key minibuffer-local-map %s 'exit-minibuffer)\n" tpu-enter))
+    ;; These are not necessary because they are inherited.
+    ;; (insert (format "(define-key minibuffer-local-ns-map %s 'exit-minibuffer)\n" tpu-enter))
+    ;; (insert (format "(define-key minibuffer-local-completion-map %s 'exit-minibuffer)\n" tpu-enter))
+    (insert (format "(define-key minibuffer-local-must-match-map %s 'minibuffer-complete-and-exit)\n" tpu-enter))))
+
+  (cond
+   ((not (or (equal tpu-kp4 tpu-return) (equal tpu-kp5 tpu-return)))
+    (insert "
+;;  Minibuffer map additions to allow KP-4/5 termination of search strings.
+;;
+")
+
+    (insert (format "(define-key minibuffer-local-map %s 'tpu-search-forward-exit)\n" tpu-kp4))
+    (insert (format "(define-key minibuffer-local-map %s 'tpu-search-backward-exit)\n" tpu-kp5))))
+
+  (insert "
+;;  Define the tpu-help-enter/return symbols
+;;
+")
+
+  (cond ((featurep 'xemacs)
+	 (insert (format "(setq tpu-help-enter \"%s\")\n" tpu-enter-seq))
+	 (insert (format "(setq tpu-help-return \"%s\")\n" tpu-return-seq))
+	 (insert "(setq tpu-help-N \"[#<keypress-event N>]\")\n")
+	 (insert "(setq tpu-help-n \"[#<keypress-event n>]\")\n")
+	 (insert "(setq tpu-help-P \"[#<keypress-event P>]\")\n")
+	 (insert "(setq tpu-help-p \"[#<keypress-event p>]\")\n"))
+	(t
+	 (insert (format "(setq tpu-help-enter \"%s\")\n" tpu-enter))))
+
+  (append-to-buffer "Keys" 1 (point))
+  (set-buffer "Keys")
+
+  ;; Save the key mapping program
+
+  (let ((file
+	 (convert-standard-filename
+	  (if (featurep 'xemacs) "~/.tpu-lucid-keys" "~/.tpu-keys"))))
+    (set-visited-file-name
+     (read-file-name (format "Save key mapping to file (default %s): " file) "" file)))
+  (save-buffer)
+
+  ;; Load the newly defined keys and clean up
+
+  (require 'tpu-edt)
+  (eval-buffer)
+  (kill-buffer (current-buffer))
+  (kill-buffer "*scratch*")
+  (kill-buffer "Gold-Keys")
+
+  ;; Let them know it worked.
+
+  (switch-to-buffer "Directions")
+  (erase-buffer)
+  (insert "
+    A custom TPU-edt keymap file has been created.
+
+    Press GOLD-k to remove this buffer and continue editing.
+")
+  (goto-char (point-min)))
+
+;;; tpu-mapper.el ends here
diff --git a/lisp/obsolete/vi.el b/lisp/obsolete/vi.el
new file mode 100644
index 00000000000..bb57735b0a9
--- /dev/null
+++ b/lisp/obsolete/vi.el
@@ -0,0 +1,1495 @@
+;;; vi.el --- major mode for emulating "vi" editor under GNU Emacs
+
+;; This file is in the public domain because the authors distributed it
+;; without a copyright notice before the US signed the Bern Convention.
+
+;; This file is part of GNU Emacs.
+
+;; Author: Neal Ziring <nz@rsch.wisc.edu>
+;;	Felix S. T. Wu <wu@crys.wisc.edu>
+;; Keywords: emulations
+;; Obsolete-since: 24.5
+
+;;; Commentary:
+
+;; This file is obsolete.  Consider using viper instead.
+
+;; Originally written by : seismo!wucs!nz@rsch.wisc.edu (Neal Ziring)
+;; Extensively redesigned and rewritten by wu@crys.wisc.edu (Felix S.T. Wu)
+;; Last revision: 01/07/87 Wed (for GNU Emacs 18.33)
+
+;; INSTALLATION PROCEDURE:
+;; 1) Add a global key binding for command "vi-mode" (I use ESC ESC instead of
+;;    the single ESC used in real "vi", so I can access other ESC prefixed emacs
+;;    commands while I'm in "vi"), say, by putting the following line in your
+;;    ".emacs" file:
+;;    (define-key global-map "\e\e" 'vi-mode) ;quick switch into vi-mode
+;; 2) If you wish you can define "find-file-hook" to enter "vi" automatically
+;;    after a file is loaded into the buffer. For example, I defined it as:
+;;    (setq find-file-hook (list
+;;                           (function (lambda ()
+;;                               (if (not (or (eq major-mode 'Info-mode)
+;; 	                                     (eq major-mode 'vi-mode)))
+;;                                   (vi-mode))))))
+;; 3) In your init file you can define the command "vi-mode" to be "autoload"
+;;    or you can execute the "load" command to load "vi" directly.
+;; 4) Read the comments for command "vi-mode" before you start using it.
+
+;; COULD DO
+;; 1). A general 'define-operator' function to replace current hack
+;; 2). In operator handling, should allow other point moving Emacs commands
+;;     (such as ESC <, ESC >) to be used as arguments.
+
+;;; Code:
+
+(defvar vi-mode-old-major-mode)
+(defvar vi-mode-old-mode-name)
+(defvar vi-mode-old-local-map)
+(defvar vi-mode-old-case-fold)
+
+(if (null (where-is-internal 'vi-switch-mode (current-local-map)))
+    (define-key ctl-x-map "~" 'vi-switch-mode))
+
+(defvar vi-tilde-map nil
+  "Keymap used for \\[vi-switch-mode] prefix key.  Link to various major modes.")
+
+(if vi-tilde-map
+    nil
+  (setq vi-tilde-map (make-keymap))
+  (define-key vi-tilde-map "a" 'abbrev-mode)
+  (define-key vi-tilde-map "c" 'c-mode)
+  (define-key vi-tilde-map "d" 'vi-debugging)
+  (define-key vi-tilde-map "e" 'emacs-lisp-mode)
+  (define-key vi-tilde-map "f" 'auto-fill-mode)
+  (define-key vi-tilde-map "g" 'prolog-mode)
+  (define-key vi-tilde-map "h" 'hanoi)
+  (define-key vi-tilde-map "i" 'info-mode)
+  (define-key vi-tilde-map "l" 'lisp-mode)
+  (define-key vi-tilde-map "n" 'nroff-mode)
+  (define-key vi-tilde-map "o" 'overwrite-mode)
+  (define-key vi-tilde-map "O" 'outline-mode)
+  (define-key vi-tilde-map "P" 'picture-mode)
+  (define-key vi-tilde-map "r" 'vi-readonly-mode)
+  (define-key vi-tilde-map "t" 'text-mode)
+  (define-key vi-tilde-map "v" 'vi-mode)
+  (define-key vi-tilde-map "x" 'tex-mode)
+  (define-key vi-tilde-map "~" 'vi-back-to-old-mode))
+
+(defun vi-switch-mode (arg mode-char)
+  "Switch the major mode of current buffer as specified by the following char \\{vi-tilde-map}"
+  (interactive "P\nc")
+  (let ((mode-cmd (lookup-key vi-tilde-map (char-to-string mode-char))))
+    (if (null mode-cmd)
+	(with-output-to-temp-buffer "*Help*"
+	  (princ (substitute-command-keys "Possible major modes to switch to: \\{vi-tilde-map}"))
+	  (with-current-buffer standard-output
+	    (help-mode)))
+      (setq prefix-arg arg)		; prefix arg will be passed down
+      (command-execute mode-cmd nil)	; may need to save mode-line-format etc
+      (force-mode-line-update))))	; just in case
+
+
+(defun vi-debugging (arg)
+  "Toggle debug-on-error flag.  If prefix arg is given, set t."
+  (interactive "P")
+  (if arg
+      (setq debug-on-error t)
+    (setq debug-on-error (not debug-on-error)))
+  (if debug-on-error
+      (message "Debug-on-error ...")
+    (message "NO more debug-on-error")))
+
+(defun vi-back-to-old-mode ()
+  "Go back to the previous mode without setting up for insertion."
+  (interactive)
+  (if vi-mode-old-major-mode
+      (progn
+	(setq mode-name vi-mode-old-mode-name)
+	(use-local-map vi-mode-old-local-map)
+	(setq major-mode vi-mode-old-major-mode)
+	(setq case-fold-search vi-mode-old-case-fold)
+	(force-mode-line-update))))
+
+(defun vi-readonly-mode ()
+  "Toggle current buffer's readonly flag."
+  (interactive)
+  (setq buffer-read-only (not buffer-read-only)))
+
+(defvar vi-com-map nil
+   "Keymap used in Evi's command state
+Command state includes most of the vi editing commands, with some Emacs
+command extensions.")
+
+(put 'vi-undefined 'suppress-keymap t)
+(if vi-com-map nil
+  (setq vi-com-map (make-keymap))
+;;(fillarray vi-com-map 'vi-undefined)
+  (define-key vi-com-map "\C-@" 'vi-mark-region) ; extension
+  (define-key vi-com-map "\C-a" 'vi-ask-for-info)  ; extension
+  (define-key vi-com-map "\C-b" 'vi-backward-windowful)
+  (define-key vi-com-map "\C-c" 'vi-do-old-mode-C-c-command) ; extension
+  (define-key vi-com-map "\C-d" 'vi-scroll-down-window)
+  (define-key vi-com-map "\C-e" 'vi-expose-line-below)
+  (define-key vi-com-map "\C-f" 'vi-forward-windowful)
+  (define-key vi-com-map "\C-g" 'keyboard-quit)
+  (define-key vi-com-map "\C-i" 'indent-relative-maybe) ; TAB
+  (define-key vi-com-map "\C-j" 'vi-next-line) ; LFD
+  (define-key vi-com-map "\C-k" 'vi-kill-line) ; extension
+  (define-key vi-com-map "\C-l" 'recenter)
+  (define-key vi-com-map "\C-m" 'vi-next-line-first-nonwhite) ; RET
+  (define-key vi-com-map "\C-n" 'vi-next-line)
+  (define-key vi-com-map "\C-o" 'vi-split-open-line)
+  (define-key vi-com-map "\C-p" 'previous-line)
+  (define-key vi-com-map "\C-q" 'vi-query-replace) ; extension
+  (define-key vi-com-map "\C-r" 'vi-isearch-backward) ; modification
+  (define-key vi-com-map "\C-s" 'vi-isearch-forward)  ; extension
+  (define-key vi-com-map "\C-t" 'vi-transpose-objects) ; extension
+  (define-key vi-com-map "\C-u" 'vi-scroll-up-window)
+  (define-key vi-com-map "\C-v" 'scroll-up-command) ; extension
+  (define-key vi-com-map "\C-w" 'vi-kill-region)   ; extension
+  (define-key vi-com-map "\C-x" 'Control-X-prefix) ; extension
+  (define-key vi-com-map "\C-y" 'vi-expose-line-above)
+  (define-key vi-com-map "\C-z" 'suspend-emacs)
+
+  (define-key vi-com-map "\e"   'ESC-prefix); C-[ (ESC)
+  (define-key vi-com-map "\C-\\" 'vi-unimplemented)
+  (define-key vi-com-map "\C-]" 'find-tag)
+  (define-key vi-com-map "\C-^" 'vi-locate-def)  ; extension
+  (define-key vi-com-map "\C-_" 'vi-undefined)
+
+  (define-key vi-com-map " " 'forward-char)
+  (define-key vi-com-map "!"  'vi-operator)
+  (define-key vi-com-map "\"" 'vi-char-argument)
+  (define-key vi-com-map "#"  'universal-argument) ; extension
+  (define-key vi-com-map "$"  'end-of-line)
+  (define-key vi-com-map "%"  'vi-find-matching-paren)
+  (define-key vi-com-map "&"  'vi-unimplemented)
+  (define-key vi-com-map "'"  'vi-goto-line-mark)
+  (define-key vi-com-map "("  'backward-sexp)
+  (define-key vi-com-map ")"  'forward-sexp)
+  (define-key vi-com-map "*"  'vi-name-last-change-or-macro) ; extension
+  (define-key vi-com-map "+"  'vi-next-line-first-nonwhite)
+  (define-key vi-com-map ","  'vi-reverse-last-find-char)
+  (define-key vi-com-map "-"  'vi-previous-line-first-nonwhite)
+  (define-key vi-com-map "."  'vi-redo-last-change-command)
+  (define-key vi-com-map "/"  'vi-search-forward)
+  (define-key vi-com-map "0"  'beginning-of-line)
+
+  (define-key vi-com-map "1"  'vi-digit-argument)
+  (define-key vi-com-map "2"  'vi-digit-argument)
+  (define-key vi-com-map "3"  'vi-digit-argument)
+  (define-key vi-com-map "4"  'vi-digit-argument)
+  (define-key vi-com-map "5"  'vi-digit-argument)
+  (define-key vi-com-map "6"  'vi-digit-argument)
+  (define-key vi-com-map "7"  'vi-digit-argument)
+  (define-key vi-com-map "8"  'vi-digit-argument)
+  (define-key vi-com-map "9"  'vi-digit-argument)
+
+  (define-key vi-com-map ":"  'vi-ex-cmd)
+  (define-key vi-com-map ";"  'vi-repeat-last-find-char)
+  (define-key vi-com-map "<"  'vi-operator)
+  (define-key vi-com-map "="  'vi-operator)
+  (define-key vi-com-map ">"  'vi-operator)
+  (define-key vi-com-map "?"  'vi-search-backward)
+  (define-key vi-com-map "@"  'vi-call-named-change-or-macro) ; extension
+
+  (define-key vi-com-map "A"  'vi-append-at-end-of-line)
+  (define-key vi-com-map "B"  'vi-backward-blank-delimited-word)
+  (define-key vi-com-map "C"  'vi-change-rest-of-line)
+  (define-key vi-com-map "D"  'vi-kill-line)
+  (define-key vi-com-map "E"  'vi-end-of-blank-delimited-word)
+  (define-key vi-com-map "F"  'vi-backward-find-char)
+  (define-key vi-com-map "G"  'vi-goto-line)
+  (define-key vi-com-map "H"  'vi-home-window-line)
+  (define-key vi-com-map "I"  'vi-insert-before-first-nonwhite)
+  (define-key vi-com-map "J"  'vi-join-lines)
+  (define-key vi-com-map "K"  'vi-undefined)
+  (define-key vi-com-map "L"  'vi-last-window-line)
+  (define-key vi-com-map "M"  'vi-middle-window-line)
+  (define-key vi-com-map "N"  'vi-reverse-last-search)
+  (define-key vi-com-map "O"  'vi-open-above)
+  (define-key vi-com-map "P"  'vi-put-before)
+  (define-key vi-com-map "Q"  'vi-quote-words) ; extension
+  (define-key vi-com-map "R"  'vi-replace-chars)
+  (define-key vi-com-map "S"  'vi-substitute-lines)
+  (define-key vi-com-map "T"  'vi-backward-upto-char)
+  (define-key vi-com-map "U"  'vi-unimplemented)
+  (define-key vi-com-map "V"  'vi-undefined)
+  (define-key vi-com-map "W"  'vi-forward-blank-delimited-word)
+  (define-key vi-com-map "X"  'call-last-kbd-macro) ; modification/extension
+  (define-key vi-com-map "Y"  'vi-yank-line)
+  (define-key vi-com-map "Z" (make-sparse-keymap)) ;allow below prefix command
+  (define-key vi-com-map "ZZ" 'vi-save-all-and-exit)
+
+  (define-key vi-com-map "["  'vi-unimplemented)
+  (define-key vi-com-map "\\" 'vi-operator) ; extension for vi-narrow-op
+  (define-key vi-com-map "]"  'vi-unimplemented)
+  (define-key vi-com-map "^"  'back-to-indentation)
+  (define-key vi-com-map "_"  'vi-undefined)
+  (define-key vi-com-map "`"  'vi-goto-char-mark)
+
+  (define-key vi-com-map "a"  'vi-insert-after)
+  (define-key vi-com-map "b"  'backward-word)
+  (define-key vi-com-map "c"  'vi-operator)
+  (define-key vi-com-map "d"  'vi-operator)
+  (define-key vi-com-map "e"  'vi-end-of-word)
+  (define-key vi-com-map "f"  'vi-forward-find-char)
+  (define-key vi-com-map "g"  'vi-beginning-of-buffer) ; extension
+  (define-key vi-com-map "h"  'backward-char)
+  (define-key vi-com-map "i"  'vi-insert-before)
+  (define-key vi-com-map "j"  'vi-next-line)
+  (define-key vi-com-map "k"  'previous-line)
+  (define-key vi-com-map "l"  'forward-char)
+  (define-key vi-com-map "m"  'vi-set-mark)
+  (define-key vi-com-map "n"  'vi-repeat-last-search)
+  (define-key vi-com-map "o"  'vi-open-below)
+  (define-key vi-com-map "p"  'vi-put-after)
+  (define-key vi-com-map "q"  'vi-replace)
+  (define-key vi-com-map "r"  'vi-replace-1-char)
+  (define-key vi-com-map "s"  'vi-substitute-chars)
+  (define-key vi-com-map "t"  'vi-forward-upto-char)
+  (define-key vi-com-map "u"  'undo)
+  (define-key vi-com-map "v"  'vi-verify-spelling)
+  (define-key vi-com-map "w"  'vi-forward-word)
+  (define-key vi-com-map "x"  'vi-kill-char)
+  (define-key vi-com-map "y"  'vi-operator)
+  (define-key vi-com-map "z"  'vi-adjust-window)
+
+  (define-key vi-com-map "{"  'backward-paragraph)
+  (define-key vi-com-map "|"  'vi-goto-column)
+  (define-key vi-com-map "}"  'forward-paragraph)
+  (define-key vi-com-map "~"  'vi-change-case)
+  (define-key vi-com-map "\177" 'delete-backward-char))
+
+(put 'backward-char 'point-moving-unit 'char)
+(put 'vi-next-line 'point-moving-unit 'line)
+(put 'next-line 'point-moving-unit 'line)
+(put 'forward-line 'point-moving-unit 'line)
+(put 'previous-line 'point-moving-unit 'line)
+(put 'vi-isearch-backward 'point-moving-unit 'search)
+(put 'vi-search-backward 'point-moving-unit 'search)
+(put 'vi-isearch-forward 'point-moving-unit 'search)
+(put 'vi-search-forward 'point-moving-unit 'search)
+(put 'forward-char 'point-moving-unit 'char)
+(put 'end-of-line 'point-moving-unit 'char)
+(put 'vi-find-matching-paren 'point-moving-unit 'match)
+(put 'vi-goto-line-mark 'point-moving-unit 'line)
+(put 'backward-sexp 'point-moving-unit 'sexp)
+(put 'forward-sexp 'point-moving-unit 'sexp)
+(put 'vi-next-line-first-nonwhite 'point-moving-unit 'line)
+(put 'vi-previous-line-first-nonwhite 'point-moving-unit 'line)
+(put 'vi-reverse-last-find-char 'point-moving-unit 'rev-find)
+(put 'vi-re-search-forward 'point-moving-unit 'search)
+(put 'beginning-of-line 'point-moving-unit 'char)
+(put 'vi-beginning-of-buffer 'point-moving-unit 'char)
+(put 'vi-repeat-last-find-char 'point-moving-unit 'find)
+(put 'vi-re-search-backward 'point-moving-unit 'search)
+(put 'vi-backward-blank-delimited-word 'point-moving-unit 'WORD)
+(put 'vi-end-of-blank-delimited-word 'point-moving-unit 'match)
+(put 'vi-backward-find-char 'point-moving-unit 'find)
+(put 'vi-goto-line 'point-moving-unit 'line)
+(put 'vi-home-window-line 'point-moving-unit 'line)
+(put 'vi-last-window-line 'point-moving-unit 'line)
+(put 'vi-middle-window-line 'point-moving-unit 'line)
+(put 'vi-reverse-last-search 'point-moving-unit 'rev-search)
+(put 'vi-backward-upto-char 'point-moving-unit 'find)
+(put 'vi-forward-blank-delimited-word 'point-moving-unit 'WORD)
+(put 'back-to-indentation 'point-moving-unit 'char)
+(put 'vi-goto-char-mark 'point-moving-unit 'char)
+(put 'backward-word 'point-moving-unit 'word)
+(put 'vi-end-of-word 'point-moving-unit 'match)
+(put 'vi-forward-find-char 'point-moving-unit 'find)
+(put 'backward-char 'point-moving-unit 'char)
+(put 'vi-forward-char 'point-moving-unit 'char)
+(put 'vi-repeat-last-search 'point-moving-unit 'search)
+(put 'vi-forward-upto-char 'point-moving-unit 'find)
+(put 'vi-forward-word 'point-moving-unit 'word)
+(put 'vi-goto-column 'point-moving-unit 'match)
+(put 'forward-paragraph 'point-moving-unit 'paragraph)
+(put 'backward-paragraph 'point-moving-unit 'paragraph)
+
+;;; region mark commands
+(put 'mark-page 'point-moving-unit 'region)
+(put 'mark-paragraph 'point-moving-unit 'region)
+(put 'mark-word 'point-moving-unit 'region)
+(put 'mark-sexp 'point-moving-unit 'region)
+(put 'mark-defun 'point-moving-unit 'region)
+(put 'mark-whole-buffer 'point-moving-unit 'region)
+(put 'mark-end-of-sentence 'point-moving-unit 'region)
+(put 'c-mark-function 'point-moving-unit 'region)
+;;;
+
+(defvar vi-mark-alist nil
+  "Alist of (NAME . MARK), marks are local to each buffer.")
+
+(defvar vi-scroll-amount (/ (window-height) 2)
+  "Default amount of lines for scrolling (used by \"^D\"/\"^U\").")
+
+(defvar vi-shift-width 4
+  "Shift amount for \"<\"/\">\" operators.")
+
+(defvar vi-ins-point nil		; integer
+  "Last insertion point.  Should use `mark' instead.")
+
+(defvar vi-ins-length nil		; integer
+  "Length of last insertion.")
+
+(defvar vi-ins-repetition nil		; integer
+  "The repetition required for last insertion.")
+
+(defvar vi-ins-overwrt-p nil		; boolean
+  "T if last insertion was a replace actually.")
+
+(defvar vi-ins-prefix-code nil		; ready-to-eval sexp
+  "Code to be eval'ed before (redo-)insertion begins.")
+
+(defvar vi-last-find-char nil		; cons cell
+  "Save last direction, char and upto-flag used for char finding.")
+
+(defvar vi-last-change-command nil	; cons cell
+  "Save commands for redoing last changes.  Each command is in (FUNC . ARGS)
+form that is ready to be `apply'ed.")
+
+(defvar vi-last-shell-command nil	; last shell op command line
+  "Save last shell command given for \"!\" operator.")
+
+(defvar vi-insert-state nil             ; boolean
+  "Non-nil if it is in insert state.")
+
+; in "loaddefs.el"
+;(defvar search-last-string ""
+;  "Last string search for by a search command.")
+
+(defvar vi-search-last-command nil	; (re-)search-forward(backward)
+  "Save last search command for possible redo.")
+
+(defvar vi-mode-old-local-map nil
+  "Save the local-map used before entering vi-mode.")
+
+(defvar vi-mode-old-mode-name nil
+  "Save the mode-name before entering vi-mode.")
+
+(defvar vi-mode-old-major-mode nil
+  "Save the major-mode before entering vi-mode.")
+
+(defvar vi-mode-old-case-fold nil)
+
+;(defconst vi-add-to-mode-line-1
+;  '(overwrite-mode nil " Insert"))
+
+;; Value is same as vi-add-to-mode-line-1 when in vi mode,
+;; but nil in other buffers.
+;(defvar vi-add-to-mode-line nil)
+
+(defun vi-mode-setup ()
+  "Setup a buffer for vi-mode by creating necessary buffer-local variables."
+;  (make-local-variable 'vi-add-to-mode-line)
+;  (setq vi-add-to-mode-line vi-add-to-mode-line-1)
+;  (or (memq vi-add-to-mode-line minor-mode-alist)
+;      (setq minor-mode-alist (cons vi-add-to-mode-line minor-mode-alist)))
+  (make-local-variable 'vi-scroll-amount)
+  (setq vi-scroll-amount (/ (window-height) 2))
+  (make-local-variable 'vi-shift-width)
+  (setq vi-shift-width 4)
+  (make-local-variable 'vi-ins-point)
+  (make-local-variable 'vi-ins-length)
+  (make-local-variable 'vi-ins-repetition)
+  (make-local-variable 'vi-ins-overwrt-p)
+  (make-local-variable 'vi-ins-prefix-code)
+  (make-local-variable 'vi-last-change-command)
+  (make-local-variable 'vi-last-shell-command)
+  (make-local-variable 'vi-last-find-char)
+  (make-local-variable 'vi-mark-alist)
+  (make-local-variable 'vi-insert-state)
+  (make-local-variable 'vi-mode-old-local-map)
+  (make-local-variable 'vi-mode-old-mode-name)
+  (make-local-variable 'vi-mode-old-major-mode)
+  (make-local-variable 'vi-mode-old-case-fold)
+  (run-mode-hooks 'vi-mode-hook))
+
+;;;###autoload
+(defun vi-mode ()
+  "Major mode that acts like the `vi' editor.
+The purpose of this mode is to provide you the combined power of vi (namely,
+the \"cross product\" effect of commands and repeat last changes) and Emacs.
+
+This command redefines nearly all keys to look like vi commands.
+It records the previous major mode, and any vi command for input
+\(`i', `a', `s', etc.) switches back to that mode.
+Thus, ordinary Emacs (in whatever major mode you had been using)
+is \"input\" mode as far as vi is concerned.
+
+To get back into vi from \"input\" mode, you must issue this command again.
+Therefore, it is recommended that you assign it to a key.
+
+Major differences between this mode and real vi :
+
+* Limitations and unsupported features
+  - Search patterns with line offset (e.g. /pat/+3 or /pat/z.) are
+    not supported.
+  - Ex commands are not implemented; try ':' to get some hints.
+  - No line undo (i.e. the 'U' command), but multi-undo is a standard feature.
+
+* Modifications
+  - The stopping positions for some point motion commands (word boundary,
+    pattern search) are slightly different from standard 'vi'.
+    Also, no automatic wrap around at end of buffer for pattern searching.
+  - Since changes are done in two steps (deletion then insertion), you need
+    to undo twice to completely undo a change command.  But this is not needed
+    for undoing a repeated change command.
+  - No need to set/unset 'magic', to search for a string with regular expr
+    in it just put a prefix arg for the search commands.  Replace cmds too.
+  - ^R is bound to incremental backward search, so use ^L to redraw screen.
+
+* Extensions
+  - Some standard (or modified) Emacs commands were integrated, such as
+    incremental search, query replace, transpose objects, and keyboard macros.
+  - In command state, ^X links to the 'ctl-x-map', and ESC can be linked to
+    esc-map or set undefined.  These can give you the full power of Emacs.
+  - See vi-com-map for those keys that are extensions to standard vi, e.g.
+    `vi-name-last-change-or-macro', `vi-verify-spelling', `vi-locate-def',
+    `vi-mark-region', and 'vi-quote-words'.  Some of them are quite handy.
+  - Use \\[vi-switch-mode] to switch among different modes quickly.
+
+Syntax table and abbrevs while in vi mode remain as they were in Emacs."
+   (interactive)
+   (if (null vi-mode-old-major-mode)	; very first call for current buffer
+       (vi-mode-setup))
+
+   (if (eq major-mode 'vi-mode)
+       (progn (ding) (message "Already in vi-mode."))
+     (setq vi-mode-old-local-map (current-local-map))
+     (setq vi-mode-old-mode-name mode-name)
+     (setq vi-mode-old-major-mode major-mode)
+     (setq vi-mode-old-case-fold case-fold-search) ; this is needed !!
+     (setq case-fold-search nil)	; exact case match in searching
+     (use-local-map vi-com-map)
+     (setq major-mode 'vi-mode)
+     (setq mode-name "VI")
+     (force-mode-line-update)		; force mode line update
+     (if vi-insert-state	        ; this is a return from insertion
+         (vi-end-of-insert-state))))
+
+(defun vi-ding()
+  "Ding !"
+  (interactive)
+  (ding))
+
+(defun vi-save-all-and-exit ()
+  "Save all modified buffers without asking, then exits emacs."
+  (interactive)
+  (save-some-buffers t)
+  (kill-emacs))
+
+;; to be used by "ex" commands
+(defvar vi-replaced-string nil)
+(defvar vi-replacing-string nil)
+
+(defun vi-ex-cmd ()
+  "Ex commands are not implemented in Evi mode.  For some commonly used ex
+commands, you can use the following alternatives for similar effect :
+w            C-x C-s (save-buffer)
+wq           C-x C-c (save-buffers-kill-emacs)
+w fname      C-x C-w (write-file)
+e fname      C-x C-f (find-file)
+r fname      C-x i   (insert-file)
+s/old/new    use q (vi-replace) to do unconditional replace
+             use C-q (vi-query-replace) to do query replace
+set sw=n     M-x set-variable vi-shift-width n "
+  (interactive)
+;; (let ((cmd (read-string ":")) (lines 1))
+;;  (cond ((string-match "s"))))
+  (with-output-to-temp-buffer "*Help*"
+    (princ (documentation 'vi-ex-cmd))
+    (with-current-buffer standard-output
+      (help-mode))))
+
+(defun vi-undefined ()
+  (interactive)
+  (message "Command key \"%s\" is undefined in Evi."
+	   (single-key-description last-command-event))
+  (ding))
+
+(defun vi-unimplemented ()
+  (interactive)
+  (message "Command key \"%s\" is not implemented in Evi."
+	   (single-key-description last-command-event))
+  (ding))
+
+;;;;;
+(defun vi-goto-insert-state (repetition &optional prefix-code do-it-now-p)
+  "Go into insert state, the text entered will be repeated if REPETITION > 1.
+If PREFIX-CODE is given, do it before insertion begins if DO-IT-NOW-P is T.
+In any case, the prefix-code will be done before each 'redo-insert'.
+This function expects `overwrite-mode' being set properly beforehand."
+  (if do-it-now-p (apply (car prefix-code) (cdr prefix-code)))
+  (setq vi-ins-point (point))
+  (setq vi-ins-repetition repetition)
+  (setq vi-ins-prefix-code prefix-code)
+  (setq mode-name vi-mode-old-mode-name)
+  (setq case-fold-search vi-mode-old-case-fold)
+  (use-local-map vi-mode-old-local-map)
+  (setq major-mode vi-mode-old-major-mode)
+  (force-mode-line-update)
+  (setq vi-insert-state t))
+
+(defun vi-end-of-insert-state ()
+  "Terminate insertion and set up last change command."
+  (if (or (< (point) vi-ins-point)    ;Check if there is any effective change
+	  (and (= (point) vi-ins-point) (null vi-ins-prefix-code))
+	  (<= vi-ins-repetition 0))
+      (vi-goto-command-state t)
+    (if (> vi-ins-repetition 1)
+	(progn
+	  (let ((str (buffer-substring vi-ins-point (point))))
+	    (while (> vi-ins-repetition 1)
+	      (insert str)
+	      (setq vi-ins-repetition (1- vi-ins-repetition))))))
+    (vi-set-last-change-command 'vi-first-redo-insertion vi-ins-point (point)
+			     overwrite-mode vi-ins-prefix-code)
+    (vi-goto-command-state t)))
+
+(defun vi-first-redo-insertion (begin end &optional overwrite-p prefix-code)
+  "Redo last insertion the first time.  Extract the string and save it for
+future redoes.  Do prefix-code if it's given, use overwrite mode if asked."
+  (let ((str (buffer-substring begin end)))
+    (if prefix-code (apply (car prefix-code) (cdr prefix-code)))
+    (if overwrite-p (delete-region (point) (+ (point) (length str))))
+    (insert str)
+    (vi-set-last-change-command 'vi-more-redo-insertion str overwrite-p prefix-code)))
+
+(defun vi-more-redo-insertion (str &optional overwrite-p prefix-code)
+  "Redo more insertion : copy string from STR to point, use overwrite mode
+if overwrite-p is T; apply prefix-code first if it's non-nil."
+  (if prefix-code (apply (car prefix-code) (cdr prefix-code)))
+  (if overwrite-p (delete-region (point) (+ (point) (length str))))
+  (insert str))
+
+(defun vi-goto-command-state (&optional from-insert-state-p)
+  "Go to vi-mode command state.  If optional arg exists, means return from
+insert state."
+  (use-local-map vi-com-map)
+  (setq vi-insert-state nil)
+  (if from-insert-state-p
+      (if overwrite-mode
+	  (overwrite-mode 0)
+;	(set-minor-mode 'ins "Insert" nil)
+	)))
+
+(defun vi-kill-line (arg)
+   "kill specified number of lines (=d$), text saved in the kill ring."
+   (interactive "*P")
+   (kill-line arg)
+   (vi-set-last-change-command 'kill-line arg))
+
+(defun vi-kill-region (start end)
+  (interactive "*r")
+  (kill-region start end)
+  (vi-set-last-change-command 'kill-region))
+
+(defun vi-append-at-end-of-line (arg)
+   "go to end of line and then go into vi insert state."
+   (interactive "*p")
+   (vi-goto-insert-state arg '(end-of-line) t))
+
+(defun vi-change-rest-of-line (arg)
+  "Change the rest of (ARG) lines (= c$ in vi)."
+  (interactive "*P")
+  (vi-goto-insert-state 1 (list 'kill-line arg) t))
+
+(defun vi-insert-before-first-nonwhite (arg)
+  "(= ^i in vi)"
+  (interactive "*p")
+  (vi-goto-insert-state arg '(back-to-indentation) t))
+
+(defun vi-open-above (arg)
+  "open new line(s) above current line and enter insert state."
+  (interactive "*p")
+  (vi-goto-insert-state 1
+			(list (function (lambda (x)
+					  (or (beginning-of-line)
+					      (open-line x)))) arg)
+			t))
+
+(defun vi-open-below (arg)
+  "open new line(s) and go into insert mode on the last line."
+  (interactive "*p")
+  (vi-goto-insert-state 1
+			(list (function (lambda (x)
+					  (or (end-of-line)
+					    (open-line x)
+					    (forward-line x)))) arg)
+			t))
+
+(defun vi-insert-after (arg)
+   "start vi insert state after cursor."
+   (interactive "*p")
+   (vi-goto-insert-state arg
+			 (list (function (lambda ()
+					   (if (not (eolp)) (forward-char)))))
+			 t))
+
+(defun vi-insert-before (arg)
+  "enter insert state before the cursor."
+  (interactive "*p")
+  (vi-goto-insert-state arg))
+
+(defun vi-goto-line (arg)
+   "Go to ARGth line."
+   (interactive "P")
+   (if (null (vi-raw-numeric-prefix arg))
+       (with-no-warnings
+	 (end-of-buffer))
+     (with-no-warnings (goto-line (vi-prefix-numeric-value arg)))))
+
+(defun vi-beginning-of-buffer ()
+  "Move point to the beginning of current buffer."
+  (interactive)
+  (goto-char (point-min)))
+
+;;;;; not used now
+;;(defvar regexp-search t		; string
+;;  "*T if search string can contain regular expressions. (= set magic in vi)")
+;;;;;
+
+(defun vi-isearch-forward (arg)
+  "Incremental search forward.  Use regexp version if ARG is non-nil."
+  (interactive "P")
+  (let ((scmd (if arg 'isearch-forward-regexp 'isearch-forward))
+	(opoint (point)))
+    (call-interactively scmd)
+    (if (= opoint (point))
+	nil
+      (setq vi-search-last-command (if arg 're-search-forward 'search-forward)))))
+
+(defun vi-isearch-backward (arg)
+  "Incremental search backward.  Use regexp version if ARG is non-nil."
+  (interactive "P")
+  (let ((scmd (if arg 'isearch-backward-regexp 'isearch-backward))
+	(opoint (point)))
+    (call-interactively scmd)
+    (if (= opoint (point))
+	nil
+      (setq vi-search-last-command (if arg 're-search-backward 'search-backward)))))
+
+(defun vi-search-forward (arg string)
+   "Nonincremental search forward. Use regexp version if ARG is non-nil."
+   (interactive (if current-prefix-arg
+		    (list t (read-string "regexp/" nil))
+		  (list nil (read-string "/" nil))))
+   (setq vi-search-last-command (if arg 're-search-forward 'search-forward))
+   (if (> (length string) 0)
+       (isearch-update-ring string arg))
+   (funcall vi-search-last-command string nil nil 1))
+
+(defun vi-search-backward (arg string)
+   "Nonincremental search backward.  Use regexp version if ARG is non-nil."
+   (interactive (if current-prefix-arg
+		    (list t (read-string "regexp?" nil))
+		  (list nil (read-string "?" nil))))
+   (setq vi-search-last-command (if arg 're-search-backward 'search-backward))
+   (if (> (length string) 0)
+       (isearch-update-ring string arg))
+   (funcall vi-search-last-command string nil nil 1))
+
+(defun vi-repeat-last-search (arg &optional search-command search-string)
+  "Repeat last search command.
+If optional search-command/string are given,
+use those instead of the ones saved."
+  (interactive "p")
+  (if (null search-command) (setq search-command vi-search-last-command))
+  (if (null search-string)
+      (setq search-string
+	    (car (if (memq search-command
+			   '(re-search-forward re-search-backward))
+		     regexp-search-ring
+		   search-ring))))
+  (if (null search-command)
+      (progn (ding) (message "No last search command to repeat."))
+    (funcall search-command search-string nil nil arg)))
+
+(defun vi-reverse-last-search (arg &optional search-command search-string)
+  "Redo last search command in reverse direction.
+If the optional search args are given, use those instead of the ones saved."
+  (interactive "p")
+  (if (null search-command) (setq search-command vi-search-last-command))
+  (if (null search-string)
+      (setq search-string
+	    (car (if (memq search-command
+			   '(re-search-forward re-search-backward))
+		     regexp-search-ring
+		   search-ring))))
+  (if (null search-command)
+      (progn (ding) (message "No last search command to repeat."))
+    (funcall (cond ((eq search-command 're-search-forward) 're-search-backward)
+		   ((eq search-command 're-search-backward) 're-search-forward)
+		   ((eq search-command 'search-forward) 'search-backward)
+		   ((eq search-command 'search-backward) 'search-forward))
+	     search-string nil nil arg)))
+
+(defun vi-join-lines (arg)
+   "join ARG lines from current line (default 2), cleaning up white space."
+   (interactive "P")
+   (if (null (vi-raw-numeric-prefix arg))
+       (delete-indentation t)
+     (let ((count (vi-prefix-numeric-value arg)))
+       (while (>= count 2)
+	 (delete-indentation t)
+	 (setq count (1- count)))))
+   (vi-set-last-change-command 'vi-join-lines arg))
+
+(defun vi-backward-kill-line ()
+   "kill the current line.  Only works in insert state."
+   (interactive)
+   (if (not vi-insert-state)
+       nil
+     (beginning-of-line 1)
+     (kill-line nil)))
+
+(defun vi-abort-ins ()
+  "abort insert state, kill inserted text and go back to command state."
+  (interactive)
+  (if (not vi-insert-state)
+      nil
+    (if (> (point) vi-ins-point)
+	   (kill-region vi-ins-point (point)))
+    (vi-goto-command-state t)))
+
+(defun vi-backward-windowful (count)
+  "Backward COUNT windowfuls. Default is one."
+  (interactive "p")
+; (set-mark-command nil)
+  (while (> count 0)
+    (scroll-down nil)
+    (setq count (1- count))))
+
+(defun vi-scroll-down-window (count)
+  "Scrolls down window COUNT lines.
+If COUNT is nil (actually, non-integer), scrolls default amount.
+The given COUNT is remembered for future scrollings."
+  (interactive "P")
+  (if (integerp count)
+      (setq vi-scroll-amount count))
+  (scroll-up vi-scroll-amount))
+
+(defun vi-expose-line-below (count)
+  "Expose COUNT more lines below the current window.  Default COUNT is 1."
+  (interactive "p")
+  (scroll-up count))
+
+(defun vi-forward-windowful (count)
+  "Forward COUNT windowfuls. Default is one."
+  (interactive "p")
+; (set-mark-command nil)
+  (while (> count 0)
+    (scroll-up nil)
+    (setq count (1- count))))
+
+(defun vi-next-line (count)
+  "Go down count lines, try to keep at the same column."
+  (interactive "p")
+  (setq this-command 'next-line)	; this is a needed trick
+  (if (= (point) (progn (line-move count) (point)))
+      (ding)				; no moving, already at end of buffer
+    (setq last-command 'next-line)))
+
+(defun vi-next-line-first-nonwhite (count)
+  "Go down COUNT lines.  Stop at first non-white."
+  (interactive "p")
+  (if (= (point) (progn (forward-line count) (back-to-indentation) (point)))
+      (ding)))				; no moving, already at end of buffer
+
+(defun vi-previous-line-first-nonwhite (count)
+  "Go up COUNT lines.  Stop at first non-white."
+  (interactive "p")
+  (forward-line (- count))
+  (back-to-indentation))
+
+(defun vi-scroll-up-window (count)
+  "Scrolls up window COUNT lines.
+If COUNT is nil (actually, non-integer), scrolls default amount.
+The given COUNT is remembered for future scrollings."
+  (interactive "P")
+  (if (integerp count)
+      (setq vi-scroll-amount count))
+  (scroll-down vi-scroll-amount))
+
+(defun vi-expose-line-above (count)
+  "Expose COUNT more lines above the current window.  Default COUNT is 1."
+  (interactive "p")
+  (scroll-down count))
+
+(defun vi-char-argument (arg)
+  "Get following character (could be any CHAR) as part of the prefix argument.
+Possible prefix-arg cases are nil, INTEGER, (nil . CHAR) or (INTEGER . CHAR)."
+  (interactive "P")
+  (let ((char (read-char)))
+    (cond ((null arg) (setq prefix-arg (cons nil char)))
+	  ((integerp arg) (setq prefix-arg (cons arg char)))
+	  ; This can happen only if the user changed his/her mind for CHAR,
+	  ; Or there are some leading "universal-argument"s
+	  (t (setq prefix-arg (cons (car arg) char))))))
+
+(defun vi-goto-mark (mark-char &optional line-flag)
+  "Go to marked position or line (if line-flag is given).
+Goto mark '@' means jump into and pop the top mark on the mark ring."
+  (cond ((char-equal mark-char last-command-event)	; `` or ''
+	 (exchange-point-and-mark) (if line-flag (back-to-indentation)))
+	((char-equal mark-char ?@)	; jump and pop mark
+	 (set-mark-command t) (if line-flag (back-to-indentation)))
+	(t
+	 (let ((mark (vi-get-mark mark-char)))
+	   (if (null mark)
+	       (progn (vi-ding) (message "Mark register undefined."))
+	     (set-mark-command nil)
+	     (goto-char mark)
+	     (if line-flag (back-to-indentation)))))))
+
+(defun vi-goto-line-mark (char)
+  "Go to the line (at first non-white) marked by next char."
+  (interactive "c")
+  (vi-goto-mark char t))
+
+(defun vi-goto-char-mark (char)
+  "Go to the char position marked by next mark-char."
+  (interactive "c")
+  (vi-goto-mark char))
+
+(defun vi-digit-argument (arg)
+  "Set numeric prefix argument."
+  (interactive "P")
+  (cond ((null arg) (digit-argument arg))
+	((integerp arg) (digit-argument nil)
+	                 (setq prefix-arg (* prefix-arg arg)))
+	(t (digit-argument nil)		; in (NIL . CHAR) or (NUM . CHAR) form
+	   (setq prefix-arg (cons (* prefix-arg
+				     (if (null (car arg)) 1 (car arg)))
+				  (cdr arg))))))
+
+(defun vi-raw-numeric-prefix (arg)
+  "Return the raw value of numeric part prefix argument."
+  (if (consp arg) (car arg) arg))
+
+(defun vi-prefix-numeric-value (arg)
+  "Return numeric meaning of the raw prefix argument.  This is a modification
+to the standard one provided in `callint.c' to handle (_ . CHAR) cases."
+  (cond ((null arg) 1)
+	((integerp arg) arg)
+	((consp arg) (if (car arg) (car arg) 1))))
+
+(defun vi-reverse-last-find-char (count &optional find-arg)
+  "Reverse last f F t T operation COUNT times.  If the optional FIND-ARG
+is given, it is used instead of the saved one."
+  (interactive "p")
+  (if (null find-arg) (setq find-arg vi-last-find-char))
+  (if (null find-arg)
+      (progn (ding) (message "No last find char to repeat."))
+    (vi-find-char (cons (* (car find-arg) -1) (cdr find-arg)) count))) ;6/13/86
+
+(defun vi-find-char (arg count)
+  "Find in DIRECTION (1/-1) for CHAR of COUNT'th times on current line.
+If UPTO-FLAG is T, stop before the char. ARG = (DIRECTION.CHAR.UPTO-FLAG."
+  (let* ((direction (car arg)) (char (car (cdr arg)))
+	 (upto-flag (cdr (cdr arg))) (pos (+ (point) direction)))
+    (if (catch 'exit-find-char
+	  (while t
+	    (cond ((null (char-after pos)) (throw 'exit-find-char nil))
+		  ((char-equal (char-after pos) ?\n) (throw 'exit-find-char nil))
+		  ((char-equal char (char-after pos)) (setq count (1- count))
+		   (if (= count 0)
+		       (throw 'exit-find-char
+			      (if upto-flag
+				  (setq pos (- pos direction))
+				pos)))))
+	    (setq pos (+ pos direction))))
+      (goto-char pos)
+    (ding))))
+
+(defun vi-repeat-last-find-char (count &optional find-arg)
+  "Repeat last f F t T operation COUNT times.  If optional FIND-ARG is given,
+it is used instead of the saved one."
+  (interactive "p")
+  (if (null find-arg) (setq find-arg vi-last-find-char))
+  (if (null find-arg)
+      (progn (ding) (message "No last find char to repeat."))
+    (vi-find-char find-arg count)))
+
+(defun vi-backward-find-char (count char)
+  "Find the COUNT'th CHAR backward on current line."
+  (interactive "p\nc")
+  (setq vi-last-find-char (cons -1 (cons char nil)))
+  (vi-repeat-last-find-char count))
+
+(defun vi-forward-find-char (count char)
+  "Find the COUNT'th CHAR forward on current line."
+  (interactive "p\nc")
+  (setq vi-last-find-char (cons 1 (cons char nil)))
+  (vi-repeat-last-find-char count))
+
+(defun vi-backward-upto-char (count char)
+  "Find upto the COUNT'th CHAR backward on current line."
+  (interactive "p\nc")
+  (setq vi-last-find-char (cons -1 (cons char t)))
+  (vi-repeat-last-find-char count))
+
+(defun vi-forward-upto-char (count char)
+  "Find upto the COUNT'th CHAR forward on current line."
+  (interactive "p\nc")
+  (setq vi-last-find-char (cons 1 (cons char t)))
+  (vi-repeat-last-find-char count))
+
+(defun vi-end-of-word (count)
+  "Move forward until encountering the end of a word.
+With argument, do this that many times."
+  (interactive "p")
+  (if (not (eobp)) (forward-char))
+  (if (re-search-forward "\\W*\\w+\\>" nil t count)
+      (backward-char)))
+
+(defun vi-replace-1-char (count char)
+  "Replace char after point by CHAR.  Repeat COUNT times."
+  (interactive "p\nc")
+  (delete-char count nil)       ; don't save in kill ring
+  (setq last-command-event char)
+  (self-insert-command count)
+  (vi-set-last-change-command 'vi-replace-1-char count char))
+
+(defun vi-replace-chars (arg)
+  "Replace chars over old ones."
+  (interactive "*p")
+  (overwrite-mode 1)
+  (vi-goto-insert-state arg))
+
+(defun vi-substitute-chars (count)
+  "Substitute COUNT chars by the input chars, enter insert state."
+  (interactive "*p")
+  (vi-goto-insert-state 1 (list (function (lambda (c) ; this is a bit tricky
+					    (delete-region (point)
+							   (+ (point) c))))
+				count) t))
+
+(defun vi-substitute-lines (count)
+  "Substitute COUNT lines by the input chars. (=cc in vi)"
+  (interactive "*p")
+  (vi-goto-insert-state 1 (list 'vi-delete-op 'next-line (1- count)) t))
+
+(defun vi-prefix-char-value (arg)
+  "Get the char part of the current prefix argument."
+  (cond ((null arg) nil)
+	((integerp arg) nil)
+	((consp arg) (cdr arg))
+	(t nil)))
+
+(defun vi-operator (arg)
+  "Handling vi operators (d/c/</>/!/=/y).  Current implementation requires
+the key bindings of the operators being fixed."
+  (interactive "P")
+  (catch 'vi-exit-op
+    (let ((this-op-char last-command-event))
+      (setq last-command-event (read-char))
+      (setq this-command (lookup-key vi-com-map (char-to-string last-command-event)))
+      (if (not (eq this-command 'vi-digit-argument))
+	  (setq prefix-arg arg)
+	(vi-digit-argument arg)
+	(setq last-command-event (read-char))
+	(setq this-command (lookup-key vi-com-map (char-to-string last-command-event))))
+      (cond ((char-equal this-op-char last-command-event) ; line op
+	     (vi-execute-op this-op-char 'next-line
+			    (cons (1- (vi-prefix-numeric-value prefix-arg))
+				  (vi-prefix-char-value prefix-arg))))
+	    ;; We assume any command that has no property 'point-moving-unit'
+	    ;; as having that property with the value 'CHAR'.  3/12/86
+	    (t   ;;  (get this-command 'point-moving-unit)
+	     (vi-execute-op this-op-char this-command prefix-arg))))))
+	    ;;   (t (throw 'vi-exit-op (ding)))))))
+
+(defun vi-execute-op (op-char motion-command arg)
+  "Execute vi edit operator as specified by OP-CHAR, the operand is the region
+determined by the MOTION-COMMAND with ARG."
+  (cond ((= op-char ?d)
+	 (if (vi-delete-op motion-command arg)
+	     (vi-set-last-change-command 'vi-delete-op (vi-repeat-command-of motion-command) arg)))
+	 ((= op-char ?c)
+	  (if (vi-delete-op motion-command arg)
+	      (vi-goto-insert-state 1 (list 'vi-delete-op
+			      (vi-repeat-command-of motion-command) arg) nil)))
+	 ((= op-char ?y)
+	  (if (vi-yank-op motion-command arg)
+	      (vi-set-last-change-command 'vi-yank-op (vi-repeat-command-of motion-command) arg)))
+	 ((= op-char ?!)
+	  (if (vi-shell-op motion-command arg)
+	      (vi-set-last-change-command 'vi-shell-op (vi-repeat-command-of motion-command) arg vi-last-shell-command)))
+	 ((= op-char ?<)
+	  (if (vi-shift-op motion-command arg (- vi-shift-width))
+	      (vi-set-last-change-command 'vi-shift-op (vi-repeat-command-of motion-command) arg (- vi-shift-width))))
+	 ((= op-char ?>)
+	  (if (vi-shift-op motion-command arg vi-shift-width)
+	      (vi-set-last-change-command 'vi-shift-op (vi-repeat-command-of motion-command) arg vi-shift-width)))
+	 ((= op-char ?=)
+	  (if (vi-indent-op motion-command arg)
+	      (vi-set-last-change-command 'vi-indent-op (vi-repeat-command-of motion-command) arg)))
+	 ((= op-char ?\\)
+	  (vi-narrow-op motion-command arg))))
+
+(defun vi-repeat-command-of (command)
+  "Return the command for redo the given command."
+  (let ((cmd-type (get command 'point-moving-unit)))
+    (cond ((eq cmd-type 'search) 'vi-repeat-last-search)
+	  ((eq cmd-type 'find) 'vi-repeat-last-find-char)
+	  (t command))))
+
+(defun vi-effective-range (motion-command arg)
+  "Return (begin . end) of the range spanned by executing the given
+MOTION-COMMAND with ARG.
+   MOTION-COMMAND in ready-to-eval list form is not yet supported."
+  (save-excursion
+    (let ((begin (point)) end opoint
+	  (moving-unit (get motion-command 'point-moving-unit)))
+      (setq prefix-arg arg)
+      (setq opoint (point))
+      (command-execute motion-command nil)
+;; Check if there is any effective motion. Note that for single line operation
+;; the motion-command causes no effective point movement (since it moves up or
+;; down zero lines), but it should be counted as effectively moved.
+      (if (and (= (point) opoint) (not (eq moving-unit 'line)))
+	  (cons opoint opoint)		; no effective motion
+	(if (eq moving-unit 'region)
+	    (setq begin (or (mark) (point))))
+	(if (<= begin (point))
+	    (setq end (point))
+	  (setq end begin)
+	  (setq begin (point)))
+	(cond ((or (eq moving-unit 'match) (eq moving-unit 'find))
+	       (setq end (1+ end)))
+	      ((eq moving-unit 'line)
+	       (goto-char begin) (beginning-of-line) (setq begin (point))
+	       (goto-char end) (forward-line 1) (beginning-of-line) (setq end (point))))
+	(if (> end (point-max)) (setq end (point-max))) ; force in buffer region
+	(cons begin end)))))
+
+(defun vi-delete-op (motion-command arg)
+  "Delete range specified by MOTION-COMMAND with ARG."
+  (let* ((range (vi-effective-range motion-command arg))
+	 (begin (car range)) (end (cdr range)) reg)
+    (if (= begin end)
+	nil				; point not moved, abort op
+      (setq reg (vi-prefix-char-value arg))
+      (if (null reg)
+	  (kill-region begin end)	; kill ring as unnamed registers
+	(if (and (>= reg ?A) (<= reg ?Z))
+	    (append-to-register (downcase reg) begin end t)
+	  (copy-to-register reg begin end t)))
+      t)))
+
+(defun vi-yank-op (motion-command arg)
+  "Yank (in vi sense) range specified by MOTION-COMMAND with ARG."
+  (let* ((range (vi-effective-range motion-command arg))
+	 (begin (car range)) (end (cdr range)) reg)
+    (if (= begin end)
+	nil				; point not moved, abort op
+      (setq reg (vi-prefix-char-value arg))
+      (if (null reg)
+	  (copy-region-as-kill begin end); kill ring as unnamed registers
+	(if (and (>= reg ?A) (<= reg ?Z))
+	    (append-to-register (downcase reg) begin end nil)
+	  (copy-to-register reg begin end nil)))
+      t)))
+
+(defun vi-yank-line (arg)
+  "Yank (in vi sense) lines (= `yy' command)."
+  (interactive "*P")
+  (setq arg (cons (1- (vi-prefix-numeric-value arg)) (vi-prefix-char-value arg)))
+  (if (vi-yank-op 'next-line arg)
+      (vi-set-last-change-command 'vi-yank-op 'next-line arg)))
+
+(defun vi-string-end-with-nl-p (string)
+  "See if STRING ends with a newline char.
+Used in checking whether the yanked text should be put back as lines or not."
+  (= (aref string (1- (length string))) ?\n))
+
+(defun vi-put-before (arg &optional after-p)
+  "Put yanked (in vi sense) text back before/above cursor.
+If a numeric prefix value (currently it should be >1) is given, put back
+text as lines.  If the optional after-p is given, put after/below the cursor."
+  (interactive "P")
+  (let ((reg (vi-prefix-char-value arg)) put-text)
+    (if (and reg (or (< reg ?1) (> reg ?9)) (null (get-register reg)))
+	(error "Nothing in register %c" reg)
+      (if (null reg) (setq reg ?1))	; the default is the last text killed
+      (setq put-text
+	    (cond
+	     ((and (>= reg ?1) (<= reg ?9))
+	      (setq this-command 'yank) ; So we may yank-pop !!
+	      (current-kill (- reg ?0 1) 'do-not-rotate))
+	     ((stringp (get-register reg)) (get-register reg))
+	     (t (error "Register %c is not containing text string" reg))))
+      (if (vi-string-end-with-nl-p put-text) ; put back text as lines
+	  (if after-p
+	      (progn (forward-line 1) (beginning-of-line))
+	    (beginning-of-line))
+	(if after-p (forward-char 1)))
+      (push-mark (point))
+      (insert put-text)
+      (exchange-point-and-mark)
+;;    (back-to-indentation)      ; this is not allowed if we allow yank-pop
+      (vi-set-last-change-command 'vi-put-before arg after-p))))
+
+(defun vi-put-after (arg)
+  "Put yanked (in vi sense) text back after/below cursor."
+  (interactive "P")
+  (vi-put-before arg t))
+
+(defun vi-shell-op (motion-command arg &optional shell-command)
+  "Perform shell command (as filter).
+Performs command on range specified by MOTION-COMMAND
+with ARG. If SHELL-COMMAND is not given, ask for one from minibuffer.
+If char argument is given, it directs the output to a *temp* buffer."
+  (let* ((range (vi-effective-range motion-command arg))
+	 (begin (car range)) (end (cdr range)))
+    (if (= begin end)
+	nil				; point not moved, abort op
+      (cond ((null shell-command)
+	     (setq shell-command (read-string "!" nil))
+	     (setq vi-last-shell-command shell-command)))
+      (shell-command-on-region begin end shell-command (not (vi-prefix-char-value arg))
+			                               (not (vi-prefix-char-value arg)))
+      t)))
+
+(defun vi-shift-op (motion-command arg amount)
+  "Perform shift command on range specified by MOTION-COMMAND with ARG for
+AMOUNT on each line.  Negative amount means shift left.
+SPECIAL FEATURE: char argument can be used to specify shift amount(1-9)."
+  (let* ((range (vi-effective-range motion-command arg))
+	 (begin (car range)) (end (cdr range)))
+    (if (= begin end)
+	nil				; point not moved, abort op
+      (if (vi-prefix-char-value arg)
+	  (setq amount (if (> amount 0)
+			   (- (vi-prefix-char-value arg) ?0)
+			 (- ?0 (vi-prefix-char-value arg)))))
+      (indent-rigidly begin end amount)
+      t)))
+
+(defun vi-indent-op (motion-command arg)
+  "Perform indent command on range specified by MOTION-COMMAND with ARG."
+  (let* ((range (vi-effective-range motion-command arg))
+	 (begin (car range)) (end (cdr range)))
+    (if (= begin end)
+	nil				; point not moved, abort op
+      (indent-region begin end nil)	; insert TAB as indent command
+      t)))
+
+(defun vi-narrow-op (motion-command arg)
+  "Narrow to region specified by MOTION-COMMAND with ARG."
+  (let* ((range (vi-effective-range motion-command arg))
+	 (begin (car range)) (end (cdr range)) reg)
+    (if (= begin end)
+	nil				; point not moved, abort op
+      (narrow-to-region begin end))))
+
+(defun vi-get-mark (char)
+  "Return contents of vi mark register named CHAR, or nil if undefined."
+  (cdr (assq char vi-mark-alist)))
+
+(defun vi-set-mark (char)
+  "Set contents of vi mark register named CHAR to current point.
+'@' is the special anonymous mark register."
+  (interactive "c")
+  (if (char-equal char ?@)
+      (set-mark-command nil)
+    (let ((aelt (assq char vi-mark-alist)))
+      (if aelt
+	  (move-marker (cdr aelt) (point)) ; fixed 6/12/86
+	(setq aelt (cons char (copy-marker (point))))
+	(setq vi-mark-alist (cons aelt vi-mark-alist))))))
+
+(defun vi-find-matching-paren ()
+  "Locate the matching paren.  It's a hack right now."
+  (interactive)
+  (cond ((looking-at "[[({]") (forward-sexp 1) (backward-char 1))
+	((looking-at "[])}]") (forward-char 1) (backward-sexp 1))
+        (t (ding))))
+
+(defun vi-backward-blank-delimited-word (count)
+  "Backward COUNT blank-delimited words."
+  (interactive "p")
+  (if (re-search-backward "[ \t\n\`][^ \t\n\`]+" nil t count)
+      (if (not (bobp)) (forward-char 1))))
+
+(defun vi-forward-blank-delimited-word (count)
+  "Forward COUNT blank-delimited words."
+  (interactive "p")
+  (if (re-search-forward "[^ \t\n]*[ \t\n]+[^ \t\n]" nil t count)
+      (if (not (eobp)) (backward-char 1))))
+
+(defun vi-end-of-blank-delimited-word (count)
+  "Forward to the end of the COUNT'th blank-delimited word."
+  (interactive "p")
+  (if (re-search-forward "[^ \t\n\']+[ \t\n\']" nil t count)
+      (if (not (eobp)) (backward-char 2))))
+
+(defun vi-home-window-line (arg)
+  "To window home or arg'th line from the top of the window."
+  (interactive "p")
+  (move-to-window-line (1- arg))
+  (back-to-indentation))
+
+(defun vi-last-window-line (arg)
+  "To window last line or arg'th line from the bottom of the window."
+  (interactive "p")
+  (move-to-window-line (- arg))
+  (back-to-indentation))
+
+(defun vi-middle-window-line ()
+  "To the middle line of the window."
+  (interactive)
+  (move-to-window-line nil)
+  (back-to-indentation))
+
+(defun vi-forward-word (count)
+  "Stop at the beginning of the COUNT'th words from point."
+  (interactive "p")
+  (if (re-search-forward "\\w*\\W+\\<" nil t count)
+      t
+    (vi-ding)))
+
+(defun vi-set-last-change-command (fun &rest args)
+  "Set (FUN . ARGS) as the `last-change-command'."
+  (setq vi-last-change-command (cons fun args)))
+
+(defun vi-redo-last-change-command (count &optional command)
+  "Redo last change command COUNT times.  If the optional COMMAND is given,
+it is used instead of the current `last-change-command'."
+  (interactive "p")
+  (if (null command)
+      (setq command vi-last-change-command))
+  (if (null command)
+      (message "No last change command available.")
+    (while (> count 0)
+      (apply (car command) (cdr command))
+      (setq count (1- count)))))
+
+(defun vi-kill-char (count)
+  "Kill COUNT chars from current point."
+  (interactive "*p")
+  (delete-char count t)			; save in kill ring
+  (vi-set-last-change-command 'delete-char count t))
+
+(defun vi-transpose-objects (arg unit)
+  "Transpose objects.
+The following char specifies unit of objects to be
+transposed -- \"c\" for chars, \"l\" for lines, \"w\" for words, \"s\" for
+ sexp, \"p\" for paragraph.
+For the use of the prefix-arg, refer to individual functions called."
+  (interactive "*P\nc")
+  (if (char-equal unit ??)
+      (progn
+	(message "Transpose: c(har), l(ine), p(aragraph), s(-exp), w(ord),")
+	(setq unit (read-char))))
+  (vi-set-last-change-command 'vi-transpose-objects arg unit)
+  (cond ((char-equal unit ?c) (transpose-chars arg))
+	((char-equal unit ?l) (transpose-lines (vi-prefix-numeric-value arg)))
+	((char-equal unit ?p) (transpose-paragraphs (vi-prefix-numeric-value arg)))
+	((char-equal unit ?s) (transpose-sexps (vi-prefix-numeric-value arg)))
+	((char-equal unit ?w) (transpose-words (vi-prefix-numeric-value arg)))
+	(t (vi-transpose-objects arg ??))))
+
+(defun vi-query-replace (arg)
+  "Query replace, use regexp version if ARG is non-nil."
+  (interactive "*P")
+  (let ((rcmd (if arg 'query-replace-regexp 'query-replace)))
+    (call-interactively rcmd nil)))
+
+(defun vi-replace (arg)
+  "Replace strings, use regexp version if ARG is non-nil."
+  (interactive "*P")
+  (let ((rcmd (if arg 'replace-regexp 'replace-string)))
+    (call-interactively rcmd nil)))
+
+(defun vi-adjust-window (arg position)
+  "Move current line to the top/center/bottom of the window."
+  (interactive "p\nc")
+  (cond ((char-equal position ?\r) (recenter 0))
+	((char-equal position ?-) (recenter -1))
+	((char-equal position ?.) (recenter (/ (window-height) 2)))
+	(t (message "Move current line to: \\r(top) -(bottom) .(middle)")
+	   (setq position (read-char))
+	   (vi-adjust-window arg position))))
+
+(defun vi-goto-column (col)
+  "Go to given column of the current line."
+  (interactive "p")
+  (let ((opoint (point)))
+    (beginning-of-line)
+    (while (> col 1)
+      (if (eolp)
+	  (setq col 0)
+	(forward-char 1)
+	(setq col (1- col))))
+    (if (= col 1)
+	t
+      (goto-char opoint)
+      (ding))))
+
+(defun vi-name-last-change-or-macro (arg char)
+  "Give name to the last change command or just defined kbd macro.
+If prefix ARG is given, name last macro, otherwise name last change command.
+The following CHAR will be the name for the command or macro."
+  (interactive "P\nc")
+  (if arg
+      (name-last-kbd-macro (intern (char-to-string char)))
+    (if (eq (car vi-last-change-command) 'vi-first-redo-insertion)
+	(let* ((args (cdr vi-last-change-command)) ; save the insertion text
+	       (str (buffer-substring (nth 0 args) (nth 1 args)))
+	       (overwrite-p (nth 2 args))
+	       (prefix-code (nth 3 args)))
+	  (vi-set-last-change-command 'vi-more-redo-insertion str
+				   overwrite-p prefix-code)))
+    (fset (intern (char-to-string char)) vi-last-change-command)))
+
+(defun vi-call-named-change-or-macro (count char)
+  "Execute COUNT times the keyboard macro definition named by the following CHAR."
+  (interactive "p\nc")
+  (if (stringp (symbol-function (intern (char-to-string char))))
+      (execute-kbd-macro (intern (char-to-string char)) count)
+    (vi-redo-last-change-command count (symbol-function (intern (char-to-string char))))))
+
+(defun vi-change-case (arg)		; could be made as an operator ?
+  "Change the case of the char after point."
+  (interactive "*p")
+  (catch 'exit
+    (if (looking-at "[a-z]")
+	(upcase-region (point) (+ (point) arg))
+      (if (looking-at "[A-Z]")
+	  (downcase-region (point) (+ (point) arg))
+	(ding)
+	(throw 'exit nil)))
+    (vi-set-last-change-command 'vi-change-case arg) ;should avoid redundant save
+    (forward-char arg)))
+
+(defun vi-ask-for-info (char)
+  "Inquire status info. The next CHAR will specify the particular info requested."
+  (interactive "c")
+  (cond ((char-equal char ?l) (what-line))
+	((char-equal char ?c) (what-cursor-position))
+	((char-equal char ?p) (what-page))
+	(t (message "Ask for: l(ine number), c(ursor position), p(age number)")
+	   (setq char (read-char))
+	   (vi-ask-for-info char))))
+
+(declare-function c-mark-function "cc-cmds" ())
+
+(defun vi-mark-region (arg region)
+  "Mark region appropriately.  The next char REGION is d(efun),s(-exp),b(uffer),
+p(aragraph), P(age), f(unction in C/Pascal etc.), w(ord), e(nd of sentence),
+l(ines)."
+  (interactive "p\nc")
+  (cond ((char-equal region ?d) (mark-defun))
+	((char-equal region ?s) (mark-sexp arg))
+	((char-equal region ?b) (mark-whole-buffer))
+	((char-equal region ?p) (mark-paragraph))
+	((char-equal region ?P) (mark-page arg))
+	((char-equal region ?f) (c-mark-function))
+	((char-equal region ?w) (mark-word arg))
+	((char-equal region ?e) (mark-end-of-sentence arg))
+	((char-equal region ?l) (vi-mark-lines arg))
+	(t (message "Mark: d(efun),s(-exp),b(uf),p(arag),P(age),f(unct),w(ord),e(os),l(ines)")
+	   (setq region (read-char))
+	   (vi-mark-region arg region))))
+
+(defun vi-mark-lines (num)
+  "Mark NUM of lines from current line as current region."
+  (beginning-of-line 1)
+  (push-mark)
+  (end-of-line num))
+
+(defun vi-verify-spelling (arg unit)
+  "Verify spelling for the objects specified by char UNIT : [b(uffer),
+r(egion), s(tring), w(ord) ]."
+  (interactive "P\nc")
+  (setq prefix-arg arg)			; seems not needed
+  (cond ((char-equal unit ?b) (call-interactively 'spell-buffer))
+	((char-equal unit ?r) (call-interactively 'spell-region))
+	((char-equal unit ?s) (call-interactively 'spell-string))
+	((char-equal unit ?w) (call-interactively 'spell-word))
+	(t (message "Spell check: b(uffer), r(egion), s(tring), w(ord)")
+	   (setq unit (read-char))
+	   (vi-verify-spelling arg unit))))
+
+(defun vi-do-old-mode-C-c-command (arg)
+  "This is a hack for accessing mode specific C-c commands in vi-mode."
+  (interactive "P")
+  (let ((cmd (lookup-key vi-mode-old-local-map
+			 (concat "\C-c" (char-to-string (read-char))))))
+    (if (catch 'exit-vi-mode	; kludge hack due to dynamic binding
+				; of case-fold-search
+	  (if (null cmd)
+	      (progn (ding) nil)
+	    (let ((case-fold-search vi-mode-old-case-fold)) ; a hack
+	      (setq prefix-arg arg)
+	      (command-execute cmd nil)
+	      nil)))
+	(progn
+	  (vi-back-to-old-mode)
+	  (setq prefix-arg arg)
+	  (command-execute cmd nil)))))
+
+(defun vi-quote-words (arg char)
+  "Quote ARG words from the word point is on with pattern specified by CHAR.
+Currently, CHAR could be [,{,(,\",',`,<,*, etc."
+  (interactive "*p\nc")
+  (while (not (string-match "[[({<\"'`*]" (char-to-string char)))
+    (message "Enter any of [,{,(,<,\",',`,* as quoting character.")
+    (setq char (read-char)))
+  (vi-set-last-change-command 'vi-quote-words arg char)
+  (if (not (looking-at "\\<")) (forward-word -1))
+  (insert char)
+  (cond ((char-equal char ?[) (setq char ?]))
+	((char-equal char ?{) (setq char ?}))
+	((char-equal char ?<) (setq char ?>))
+	((char-equal char ?() (setq char ?)))
+	((char-equal char ?`) (setq char ?')))
+  (vi-end-of-word arg)
+  (forward-char 1)
+  (insert char))
+
+(defun vi-locate-def ()
+  "Locate definition in current file for the name before the point.
+It assumes a `(def..' always starts at the beginning of a line."
+  (interactive)
+  (let (name)
+    (save-excursion
+      (setq name (buffer-substring (progn (vi-backward-blank-delimited-word 1)
+					  (skip-chars-forward "^a-zA-Z")
+					  (point))
+				   (progn (vi-end-of-blank-delimited-word 1)
+					  (forward-char)
+					  (skip-chars-backward "^a-zA-Z")
+					  (point)))))
+    (set-mark-command nil)
+    (goto-char (point-min))
+    (if (re-search-forward (concat "^(def[unvarconst ]*" name) nil t)
+	nil
+      (ding)
+      (message "No definition for \"%s\" in current file." name)
+      (set-mark-command t))))
+
+(defun vi-split-open-line (arg)
+  "Insert a newline and leave point before it.
+With ARG, inserts that many newlines."
+  (interactive "*p")
+  (vi-goto-insert-state 1
+    (list (function (lambda (arg)
+		      (let ((flag (and (bolp) (not (bobp)))))
+			(if flag (forward-char -1))
+			(while (> arg 0)
+			  (save-excursion
+			    (insert ?\n)
+			    (if fill-prefix (insert fill-prefix)))
+			  (setq arg (1- arg)))
+			(if flag (forward-char 1))))) arg)
+    t))
+
+(provide 'vi)
+
+;;; vi.el ends here
diff --git a/lisp/obsolete/vip.el b/lisp/obsolete/vip.el
new file mode 100644
index 00000000000..ea102cb0ac5
--- /dev/null
+++ b/lisp/obsolete/vip.el
@@ -0,0 +1,3062 @@
+;;; 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
+;; Obsolete-since: 24.5
+
+;; 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:
+
+;; This file is obsolete.  Consider using viper instead.
+
+;; 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
diff --git a/lisp/obsolete/ws-mode.el b/lisp/obsolete/ws-mode.el
new file mode 100644
index 00000000000..d87cc73252b
--- /dev/null
+++ b/lisp/obsolete/ws-mode.el
@@ -0,0 +1,643 @@
+;;; ws-mode.el --- WordStar emulation mode for GNU Emacs
+
+;; Copyright (C) 1991, 2001-2014 Free Software Foundation, Inc.
+
+;; Author: Juergen Nickelsen <nickel@cs.tu-berlin.de>
+;; Version: 0.7
+;; Keywords: emulations
+;; Obsolete-since: 24.5
+
+;; 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:
+
+;; This emulates WordStar, with a major mode.
+
+;;; Code:
+(defvar wordstar-C-k-map
+  (let ((map (make-keymap)))
+    (define-key map " " ())
+    (define-key map "0" 'ws-set-marker-0)
+    (define-key map "1" 'ws-set-marker-1)
+    (define-key map "2" 'ws-set-marker-2)
+    (define-key map "3" 'ws-set-marker-3)
+    (define-key map "4" 'ws-set-marker-4)
+    (define-key map "5" 'ws-set-marker-5)
+    (define-key map "6" 'ws-set-marker-6)
+    (define-key map "7" 'ws-set-marker-7)
+    (define-key map "8" 'ws-set-marker-8)
+    (define-key map "9" 'ws-set-marker-9)
+    (define-key map "b" 'ws-begin-block)
+    (define-key map "\C-b" 'ws-begin-block)
+    (define-key map "c" 'ws-copy-block)
+    (define-key map "\C-c" 'ws-copy-block)
+    (define-key map "d" 'save-buffers-kill-emacs)
+    (define-key map "\C-d" 'save-buffers-kill-emacs)
+    (define-key map "f" 'find-file)
+    (define-key map "\C-f" 'find-file)
+    (define-key map "h" 'ws-show-markers)
+    (define-key map "\C-h" 'ws-show-markers)
+    (define-key map "i" 'ws-indent-block)
+    (define-key map "\C-i" 'ws-indent-block)
+    (define-key map "k" 'ws-end-block)
+    (define-key map "\C-k" 'ws-end-block)
+    (define-key map "p" 'ws-print-block)
+    (define-key map "\C-p" 'ws-print-block)
+    (define-key map "q" 'kill-emacs)
+    (define-key map "\C-q" 'kill-emacs)
+    (define-key map "r" 'insert-file)
+    (define-key map "\C-r" 'insert-file)
+    (define-key map "s" 'save-some-buffers)
+    (define-key map "\C-s" 'save-some-buffers)
+    (define-key map "t" 'ws-mark-word)
+    (define-key map "\C-t" 'ws-mark-word)
+    (define-key map "u" 'ws-exdent-block)
+    (define-key map "\C-u" 'keyboard-quit)
+    (define-key map "v" 'ws-move-block)
+    (define-key map "\C-v" 'ws-move-block)
+    (define-key map "w" 'ws-write-block)
+    (define-key map "\C-w" 'ws-write-block)
+    (define-key map "x" 'save-buffers-kill-emacs)
+    (define-key map "\C-x" 'save-buffers-kill-emacs)
+    (define-key map "y" 'ws-delete-block)
+    (define-key map "\C-y" 'ws-delete-block)
+    map))
+
+(defvar wordstar-C-o-map
+  (let ((map (make-keymap)))
+    (define-key map " " ())
+    (define-key map "c" 'wordstar-center-line)
+    (define-key map "\C-c" 'wordstar-center-line)
+    (define-key map "b" 'switch-to-buffer)
+    (define-key map "\C-b" 'switch-to-buffer)
+    (define-key map "j" 'justify-current-line)
+    (define-key map "\C-j" 'justify-current-line)
+    (define-key map "k" 'kill-buffer)
+    (define-key map "\C-k" 'kill-buffer)
+    (define-key map "l" 'list-buffers)
+    (define-key map "\C-l" 'list-buffers)
+    (define-key map "m" 'auto-fill-mode)
+    (define-key map "\C-m" 'auto-fill-mode)
+    (define-key map "r" 'set-fill-column)
+    (define-key map "\C-r" 'set-fill-column)
+    (define-key map "\C-u" 'keyboard-quit)
+    (define-key map "wd" 'delete-other-windows)
+    (define-key map "wh" 'split-window-right)
+    (define-key map "wo" 'other-window)
+    (define-key map "wv" 'split-window-below)
+    map)
+  "")
+
+(defvar wordstar-C-q-map
+  (let ((map (make-keymap)))
+    (define-key map " " ())
+    (define-key map "0" 'ws-find-marker-0)
+    (define-key map "1" 'ws-find-marker-1)
+    (define-key map "2" 'ws-find-marker-2)
+    (define-key map "3" 'ws-find-marker-3)
+    (define-key map "4" 'ws-find-marker-4)
+    (define-key map "5" 'ws-find-marker-5)
+    (define-key map "6" 'ws-find-marker-6)
+    (define-key map "7" 'ws-find-marker-7)
+    (define-key map "8" 'ws-find-marker-8)
+    (define-key map "9" 'ws-find-marker-9)
+    (define-key map "a" 'ws-query-replace)
+    (define-key map "\C-a" 'ws-query-replace)
+    (define-key map "b" 'ws-goto-block-begin)
+    (define-key map "\C-b" 'ws-goto-block-begin)
+    (define-key map "c" 'end-of-buffer)
+    (define-key map "\C-c" 'end-of-buffer)
+    (define-key map "d" 'end-of-line)
+    (define-key map "\C-d" 'end-of-line)
+    (define-key map "f" 'ws-search)
+    (define-key map "\C-f" 'ws-search)
+    (define-key map "k" 'ws-goto-block-end)
+    (define-key map "\C-k" 'ws-goto-block-end)
+    (define-key map "l" 'ws-undo)
+    (define-key map "\C-l" 'ws-undo)
+    (define-key map "p" 'ws-last-cursorp)
+    (define-key map "\C-p" 'ws-last-cursorp)
+    (define-key map "r" 'beginning-of-buffer)
+    (define-key map "\C-r" 'beginning-of-buffer)
+    (define-key map "s" 'beginning-of-line)
+    (define-key map "\C-s" 'beginning-of-line)
+    (define-key map "\C-u" 'keyboard-quit)
+    (define-key map "w" 'ws-last-error)
+    (define-key map "\C-w" 'ws-last-error)
+    (define-key map "y" 'ws-kill-eol)
+    (define-key map "\C-y" 'ws-kill-eol)
+    (define-key map "\177" 'ws-kill-bol)
+    map))
+
+(defvar wordstar-mode-map
+  (let ((map (make-keymap)))
+    (define-key map "\C-a" 'backward-word)
+    (define-key map "\C-b" 'fill-paragraph)
+    (define-key map "\C-c" 'scroll-up-command)
+    (define-key map "\C-d" 'forward-char)
+    (define-key map "\C-e" 'previous-line)
+    (define-key map "\C-f" 'forward-word)
+    (define-key map "\C-g" 'delete-char)
+    (define-key map "\C-h" 'backward-char)
+    (define-key map "\C-i" 'indent-for-tab-command)
+    (define-key map "\C-j" 'help-for-help)
+    (define-key map "\C-k" wordstar-C-k-map)
+    (define-key map "\C-l" 'ws-repeat-search)
+    (define-key map "\C-n" 'open-line)
+    (define-key map "\C-o" wordstar-C-o-map)
+    (define-key map "\C-p" 'quoted-insert)
+    (define-key map "\C-q" wordstar-C-q-map)
+    (define-key map "\C-r" 'scroll-down-command)
+    (define-key map "\C-s" 'backward-char)
+    (define-key map "\C-t" 'kill-word)
+    (define-key map "\C-u" 'keyboard-quit)
+    (define-key map "\C-v" 'overwrite-mode)
+    (define-key map "\C-w" 'scroll-down-line)
+    (define-key map "\C-x" 'next-line)
+    (define-key map "\C-y" 'kill-complete-line)
+    (define-key map "\C-z" 'scroll-up-line)
+    map))
+
+;; wordstar-C-j-map not yet implemented
+(defvar wordstar-C-j-map nil)
+
+
+(put 'wordstar-mode 'mode-class 'special)
+
+;;;###autoload
+(define-derived-mode wordstar-mode fundamental-mode "WordStar"
+  "Major mode with WordStar-like key bindings.
+
+BUGS:
+ - Help menus with WordStar commands (C-j just calls help-for-help)
+   are not implemented
+ - Options for search and replace
+ - Show markers (C-k h) is somewhat strange
+ - Search and replace (C-q a) is only available in forward direction
+
+No key bindings beginning with ESC are installed, they will work
+Emacs-like.")
+
+
+(defun wordstar-center-paragraph ()
+  "Center each line in the paragraph at or after point.
+See `wordstar-center-line' for more info."
+  (interactive)
+  (save-excursion
+    (forward-paragraph)
+    (or (bolp) (newline 1))
+    (let ((end (point)))
+      (backward-paragraph)
+      (wordstar-center-region (point) end))))
+
+(defun wordstar-center-region (from to)
+  "Center each line starting in the region.
+See `wordstar-center-line' for more info."
+  (interactive "r")
+  (if (> from to)
+      (let ((tem to))
+	(setq to from from tem)))
+  (save-excursion
+    (save-restriction
+      (narrow-to-region from to)
+      (goto-char from)
+      (while (not (eobp))
+	(wordstar-center-line)
+	(forward-line 1)))))
+
+(defun wordstar-center-line ()
+  "Center the line point is on, within the width specified by `fill-column'.
+This means adjusting the indentation to match
+the distance between the end of the text and `fill-column'."
+  (interactive)
+  (save-excursion
+    (let (line-length)
+      (beginning-of-line)
+      (delete-horizontal-space)
+      (end-of-line)
+      (delete-horizontal-space)
+      (setq line-length (current-column))
+      (beginning-of-line)
+      (indent-to
+       (+ left-margin
+	  (/ (- fill-column left-margin line-length) 2))))))
+
+;;;;;;;;;;;
+;; wordstar special variables:
+
+(defvar ws-marker-0 nil "Position marker 0 in WordStar mode.")
+(defvar ws-marker-1 nil "Position marker 1 in WordStar mode.")
+(defvar ws-marker-2 nil "Position marker 2 in WordStar mode.")
+(defvar ws-marker-3 nil "Position marker 3 in WordStar mode.")
+(defvar ws-marker-4 nil "Position marker 4 in WordStar mode.")
+(defvar ws-marker-5 nil "Position marker 5 in WordStar mode.")
+(defvar ws-marker-6 nil "Position marker 6 in WordStar mode.")
+(defvar ws-marker-7 nil "Position marker 7 in WordStar mode.")
+(defvar ws-marker-8 nil "Position marker 8 in WordStar mode.")
+(defvar ws-marker-9 nil "Position marker 9 in WordStar mode.")
+
+(defvar ws-block-begin-marker nil "Beginning of \"Block\" in WordStar mode.")
+(defvar ws-block-end-marker nil "End of \"Block\" in WordStar mode.")
+
+(defvar ws-search-string nil "String of last search in WordStar mode.")
+(defvar ws-search-direction t
+  "Direction of last search in WordStar mode. t if forward, nil if backward.")
+
+(defvar ws-last-cursorposition nil
+  "Position before last search etc. in WordStar mode.")
+
+(defvar ws-last-errormessage nil
+  "Last error message issued by a WordStar mode function.")
+
+;;;;;;;;;;;
+;; wordstar special functions:
+
+(defun ws-error (string)
+  "Report error of a WordStar special function. Error message is saved
+in ws-last-errormessage for recovery with C-q w."
+  (setq ws-last-errormessage string)
+  (error string))
+
+(defun ws-set-marker-0 ()
+  "In WordStar mode: Set marker 0 to current cursor position."
+  (interactive)
+  (setq ws-marker-0 (point-marker))
+  (message "Marker 0 set"))
+
+(defun ws-set-marker-1 ()
+  "In WordStar mode: Set marker 1 to current cursor position."
+  (interactive)
+  (setq ws-marker-1 (point-marker))
+  (message "Marker 1 set"))
+
+(defun ws-set-marker-2 ()
+  "In WordStar mode: Set marker 2 to current cursor position."
+  (interactive)
+  (setq ws-marker-2 (point-marker))
+  (message "Marker 2 set"))
+
+(defun ws-set-marker-3 ()
+  "In WordStar mode: Set marker 3 to current cursor position."
+  (interactive)
+  (setq ws-marker-3 (point-marker))
+  (message "Marker 3 set"))
+
+(defun ws-set-marker-4 ()
+  "In WordStar mode: Set marker 4 to current cursor position."
+  (interactive)
+  (setq ws-marker-4 (point-marker))
+  (message "Marker 4 set"))
+
+(defun ws-set-marker-5 ()
+  "In WordStar mode: Set marker 5 to current cursor position."
+  (interactive)
+  (setq ws-marker-5 (point-marker))
+  (message "Marker 5 set"))
+
+(defun ws-set-marker-6 ()
+  "In WordStar mode: Set marker 6 to current cursor position."
+  (interactive)
+  (setq ws-marker-6 (point-marker))
+  (message "Marker 6 set"))
+
+(defun ws-set-marker-7 ()
+  "In WordStar mode: Set marker 7 to current cursor position."
+  (interactive)
+  (setq ws-marker-7 (point-marker))
+  (message "Marker 7 set"))
+
+(defun ws-set-marker-8 ()
+  "In WordStar mode: Set marker 8 to current cursor position."
+  (interactive)
+  (setq ws-marker-8 (point-marker))
+  (message "Marker 8 set"))
+
+(defun ws-set-marker-9 ()
+  "In WordStar mode: Set marker 9 to current cursor position."
+  (interactive)
+  (setq ws-marker-9 (point-marker))
+  (message "Marker 9 set"))
+
+(defun ws-begin-block ()
+  "In WordStar mode: Set block begin marker to current cursor position."
+  (interactive)
+  (setq ws-block-begin-marker (point-marker))
+  (message "Block begin marker set"))
+
+(defun ws-show-markers ()
+  "In WordStar mode: Show block markers."
+  (interactive)
+  (if (or ws-block-begin-marker ws-block-end-marker)
+      (save-excursion
+	(if ws-block-begin-marker
+	    (progn
+	      (goto-char ws-block-begin-marker)
+	      (message "Block begin marker")
+	      (sit-for 2))
+	  (message "Block begin marker not set")
+	  (sit-for 2))
+	(if ws-block-end-marker
+	    (progn
+	      (goto-char ws-block-end-marker)
+	      (message "Block end marker")
+	      (sit-for 2))
+	  (message "Block end marker not set"))
+	(message ""))
+    (message "Block markers not set")))
+
+
+(defun ws-indent-block ()
+  "In WordStar mode: Indent block (not yet implemented)."
+  (interactive)
+  (ws-error "Indent block not yet implemented"))
+
+(defun ws-end-block ()
+  "In WordStar mode: Set block end marker to current cursor position."
+  (interactive)
+  (setq ws-block-end-marker (point-marker))
+  (message "Block end marker set"))
+
+(defun ws-print-block ()
+  "In WordStar mode: Print block."
+  (interactive)
+  (message "Don't do this. Write block to a file (C-k w) and print this file."))
+
+(defun ws-mark-word ()
+  "In WordStar mode: Mark current word as block."
+  (interactive)
+  (save-excursion
+    (forward-word 1)
+    (sit-for 1)
+    (ws-end-block)
+    (forward-word -1)
+    (sit-for 1)
+    (ws-begin-block)))
+
+(defun ws-exdent-block ()
+  "I don't know what this (C-k u) should do."
+  (interactive)
+  (ws-error "This won't be done -- not yet implemented."))
+
+(defun ws-move-block ()
+  "In WordStar mode: Move block to current cursor position."
+  (interactive)
+  (if (and ws-block-begin-marker ws-block-end-marker)
+      (progn
+	(kill-region ws-block-begin-marker ws-block-end-marker)
+	(yank)
+	(save-excursion
+	  (goto-char (region-beginning))
+	  (setq ws-block-begin-marker (point-marker))
+	  (goto-char (region-end))
+	  (setq ws-block-end-marker (point-marker))))
+    (ws-error (cond (ws-block-begin-marker "Block end marker not set")
+		    (ws-block-end-marker "Block begin marker not set")
+		    (t "Block markers not set")))))
+
+(defun ws-write-block ()
+  "In WordStar mode: Write block to file."
+  (interactive)
+  (if (and ws-block-begin-marker ws-block-end-marker)
+      (let ((filename (read-file-name "Write block to file: ")))
+	(write-region ws-block-begin-marker ws-block-end-marker filename))
+    (ws-error (cond (ws-block-begin-marker "Block end marker not set")
+		    (ws-block-end-marker "Block begin marker not set")
+		    (t "Block markers not set")))))
+
+
+(defun ws-delete-block ()
+  "In WordStar mode: Delete block."
+  (interactive)
+  (if (and ws-block-begin-marker ws-block-end-marker)
+      (progn
+	(kill-region ws-block-begin-marker ws-block-end-marker)
+	(setq ws-block-end-marker nil)
+	(setq ws-block-begin-marker nil))
+    (ws-error (cond (ws-block-begin-marker "Block end marker not set")
+		    (ws-block-end-marker "Block begin marker not set")
+		    (t "Block markers not set")))))
+
+(defun ws-find-marker-0 ()
+  "In WordStar mode: Go to marker 0."
+  (interactive)
+  (if ws-marker-0
+      (progn
+	(setq ws-last-cursorposition (point-marker))
+	(goto-char ws-marker-0))
+    (ws-error "Marker 0 not set")))
+
+(defun ws-find-marker-1 ()
+  "In WordStar mode: Go to marker 1."
+  (interactive)
+  (if ws-marker-1
+      (progn
+	(setq ws-last-cursorposition (point-marker))
+	(goto-char ws-marker-1))
+    (ws-error "Marker 1 not set")))
+
+(defun ws-find-marker-2 ()
+  "In WordStar mode: Go to marker 2."
+  (interactive)
+  (if ws-marker-2
+      (progn
+	(setq ws-last-cursorposition (point-marker))
+	(goto-char ws-marker-2))
+    (ws-error "Marker 2 not set")))
+
+(defun ws-find-marker-3 ()
+  "In WordStar mode: Go to marker 3."
+  (interactive)
+  (if ws-marker-3
+      (progn
+	(setq ws-last-cursorposition (point-marker))
+	(goto-char ws-marker-3))
+    (ws-error "Marker 3 not set")))
+
+(defun ws-find-marker-4 ()
+  "In WordStar mode: Go to marker 4."
+  (interactive)
+  (if ws-marker-4
+      (progn
+	(setq ws-last-cursorposition (point-marker))
+	(goto-char ws-marker-4))
+    (ws-error "Marker 4 not set")))
+
+(defun ws-find-marker-5 ()
+  "In WordStar mode: Go to marker 5."
+  (interactive)
+  (if ws-marker-5
+      (progn
+	(setq ws-last-cursorposition (point-marker))
+	(goto-char ws-marker-5))
+    (ws-error "Marker 5 not set")))
+
+(defun ws-find-marker-6 ()
+  "In WordStar mode: Go to marker 6."
+  (interactive)
+  (if ws-marker-6
+      (progn
+	(setq ws-last-cursorposition (point-marker))
+	(goto-char ws-marker-6))
+    (ws-error "Marker 6 not set")))
+
+(defun ws-find-marker-7 ()
+  "In WordStar mode: Go to marker 7."
+  (interactive)
+  (if ws-marker-7
+      (progn
+	(setq ws-last-cursorposition (point-marker))
+	(goto-char ws-marker-7))
+    (ws-error "Marker 7 not set")))
+
+(defun ws-find-marker-8 ()
+  "In WordStar mode: Go to marker 8."
+  (interactive)
+  (if ws-marker-8
+      (progn
+	(setq ws-last-cursorposition (point-marker))
+	(goto-char ws-marker-8))
+    (ws-error "Marker 8 not set")))
+
+(defun ws-find-marker-9 ()
+  "In WordStar mode: Go to marker 9."
+  (interactive)
+  (if ws-marker-9
+      (progn
+	(setq ws-last-cursorposition (point-marker))
+	(goto-char ws-marker-9))
+    (ws-error "Marker 9 not set")))
+
+(defun ws-goto-block-begin ()
+  "In WordStar mode: Go to block begin marker."
+  (interactive)
+  (if ws-block-begin-marker
+      (progn
+	(setq ws-last-cursorposition (point-marker))
+	(goto-char ws-block-begin-marker))
+    (ws-error "Block begin marker not set")))
+
+(defun ws-search (string)
+  "In WordStar mode: Search string, remember string for repetition."
+  (interactive "sSearch for: ")
+  (message "Forward (f) or backward (b)")
+  (let ((direction
+	 (read-char)))
+    (cond ((equal (upcase direction) ?F)
+	   (setq ws-search-string string)
+	   (setq ws-search-direction t)
+	   (setq ws-last-cursorposition (point-marker))
+	   (search-forward string))
+	  ((equal (upcase direction) ?B)
+	   (setq ws-search-string string)
+	   (setq ws-search-direction nil)
+	   (setq ws-last-cursorposition (point-marker))
+	   (search-backward string))
+	  (t (keyboard-quit)))))
+
+(defun ws-goto-block-end ()
+  "In WordStar mode: Go to block end marker."
+  (interactive)
+  (if ws-block-end-marker
+      (progn
+	(setq ws-last-cursorposition (point-marker))
+	(goto-char ws-block-end-marker))
+    (ws-error "Block end marker not set")))
+
+(defun ws-undo ()
+  "In WordStar mode: Undo and give message about undoing more changes."
+  (interactive)
+  (undo)
+  (message "Repeat C-q l to undo more changes."))
+
+(defun ws-goto-last-cursorposition ()
+  "In WordStar mode: "
+  (interactive)
+  (if ws-last-cursorposition
+      (progn
+	(setq ws-last-cursorposition (point-marker))
+	(goto-char ws-last-cursorposition))
+    (ws-error "No last cursor position available.")))
+
+(defun ws-last-error ()
+  "In WordStar mode: repeat last error message.
+This will only work for errors raised by WordStar mode functions."
+  (interactive)
+  (if ws-last-errormessage
+      (message "%s" ws-last-errormessage)
+    (message "No WordStar error yet.")))
+
+(defun ws-kill-eol ()
+  "In WordStar mode: Kill to end of line (like WordStar, not like Emacs)."
+  (interactive)
+  (let ((p (point)))
+    (end-of-line)
+    (kill-region p (point))))
+
+(defun ws-kill-bol ()
+  "In WordStar mode: Kill to beginning of line
+\(like WordStar, not like Emacs)."
+  (interactive)
+  (let ((p (point)))
+    (beginning-of-line)
+    (kill-region (point) p)))
+
+(defun kill-complete-line ()
+  "Kill the complete line."
+  (interactive)
+  (beginning-of-line)
+  (if (eobp) (error "End of buffer"))
+  (let ((beg (point)))
+    (forward-line 1)
+    (kill-region beg (point))))
+
+(defun ws-repeat-search ()
+  "In WordStar mode: Repeat last search."
+  (interactive)
+  (setq ws-last-cursorposition (point-marker))
+  (if ws-search-string
+      (if ws-search-direction
+	  (search-forward ws-search-string)
+	(search-backward ws-search-string))
+    (ws-error "No search to repeat")))
+
+(defun ws-query-replace (from to)
+  "In WordStar mode: Search string, remember string for repetition."
+  (interactive "sReplace: \n\
+sWith: " )
+  (setq ws-search-string from)
+  (setq ws-search-direction t)
+  (setq ws-last-cursorposition (point-marker))
+  (query-replace from to))
+
+(defun ws-copy-block ()
+  "In WordStar mode: Copy block to current cursor position."
+  (interactive)
+  (if (and ws-block-begin-marker ws-block-end-marker)
+      (progn
+	(copy-region-as-kill ws-block-begin-marker ws-block-end-marker)
+	(yank)
+	(save-excursion
+	  (goto-char (region-beginning))
+	  (setq ws-block-begin-marker (point-marker))
+	  (goto-char (region-end))
+	  (setq ws-block-end-marker (point-marker))))
+    (ws-error (cond (ws-block-begin-marker "Block end marker not set")
+		    (ws-block-end-marker "Block begin marker not set")
+		    (t "Block markers not set")))))
+
+(provide 'ws-mode)
+
+;;; ws-mode.el ends here