+2014-10-20 Glenn Morris <rgm@gnu.org>
+
+ * ack.texi (Acknowledgments): Remove some obsolete items.
+ * misc.texi (Emulation): Remove section.
+
2014-10-20 Glenn Morris <rgm@gnu.org>
* Version 24.4 released.
location in files between editing sessions.
@item
-Gary Foster wrote @file{crisp.el}, the emulation for CRiSP and Brief
-editors; and @file{scroll-all.el}, a mode for scrolling several buffers
+Gary Foster wrote @file{scroll-all.el}, a mode for scrolling several buffers
together.
@item
@item
Michael Kifer wrote @code{ediff}, an interactive interface to the
@command{diff}, @command{patch}, and @command{merge} programs; and
-Viper, another emulator of the VI editor.
+Viper, an emulator of the VI editor.
@item
Richard King wrote the first version of @file{userlock.el} and
Thien-Thi Nguyen and Dan Nicolaescu wrote @file{hideshow.el}, a minor
mode for selectively displaying blocks of text.
-@item
-Jurgen Nickelsen wrote @file{ws-mode.el}, providing WordStar emulation.
-
@item
Dan Nicolaescu added support for running Emacs as a daemon. He also
wrote @file{romanian.el}, support for editing Romanian text;
of the current function in the mode line.
@item
-Rob Riepel wrote @file{tpu-edt.el} and its associated files, providing
-an emulation of the VMS TPU text editor emulating the VMS EDT editor,
-and @file{vt-control.el}, providing some control functions for the DEC
-VT line of terminals.
+Rob Riepel wrote @file{vt-control.el}, providing some control
+functions for the DEC VT line of terminals.
@item
Nick Roberts wrote @file{t-mouse.el}, for mouse support in text
James B. Salem and Brewster Kahle wrote @file{completion.el}, providing
dynamic word completion.
-@item
-Masahiko Sato wrote @file{vip.el}, an emulation of the VI editor.
-
@item
Holger Schauer wrote @file{fortune.el}, a package for using fortune in
message signatures.
* Editing Binary Files:: Editing binary files with Hexl mode.
* Saving Emacs Sessions:: Saving Emacs state from one session to the next.
* Recursive Edit:: Performing edits while "within another command".
-* Emulation:: Emulating some other editors with Emacs.
* Hyperlinking:: Following links in buffers.
* Amusements:: Various games and hacks.
* Packages:: Installing additional features.
approaches give you more flexibility to go back to unfinished tasks in
the order you choose.
+@ignore
+@c Apart from edt and viper, this is all obsolete.
+@c (Can't believe we were saying ``most other editors'' into 2014!)
+@c There seems no point having a node just for those, which both have
+@c their own manuals.
@node Emulation
@section Emulation
@cindex emulating other editors
@cindex other editors
@cindex EDT
@cindex vi
-@cindex PC key bindings
-@cindex scrolling all windows
-@cindex PC selection
-@cindex Motif key bindings
-@cindex Macintosh key bindings
@cindex WordStar
GNU Emacs can be programmed to emulate (more or less) some other
@item vi (Berkeley editor)
@findex viper-mode
-Viper is the newest emulator for vi. It implements several levels of
+Viper is an emulator for vi. It implements several levels of
emulation; level 1 is closest to vi itself, while level 5 departs
somewhat from strict emulation to take advantage of the capabilities of
Emacs. To invoke Viper, type @kbd{M-x viper-mode}; it will guide you
@kbd{M-x wordstar-mode} provides a major mode with WordStar-like
key bindings.
@end table
+@end ignore
+
@node Hyperlinking
@section Hyperlinking and Navigation Features
+2014-10-20 Glenn Morris <rgm@gnu.org>
+
+ * emacs-lisp-intro.texi (Autoload): Update loaddefs.el details.
+
2014-10-20 Glenn Morris <rgm@gnu.org>
* Version 24.4 released.
first use such a function, while its containing file is evaluated.
Rarely used functions are frequently autoloaded. The
-@file{loaddefs.el} library contains hundreds of autoloaded functions,
-from @code{bookmark-set} to @code{wordstar-mode}. Of course, you may
+@file{loaddefs.el} library contains thousands of autoloaded functions,
+from @code{5x5} to @code{zone}. Of course, you may
come to use a `rare' function frequently. When you do, you should
load that function's file with a @code{load} expression in your
@file{.emacs} file.
+2014-10-20 Glenn Morris <rgm@gnu.org>
+
+ * efaq.texi (Finding a package with particular functionality):
+ Update example.
+ * vip.texi: Mention this is obsolete.
+
2014-10-20 Glenn Morris <rgm@gnu.org>
* Version 24.4 released.
First of all, you should check to make sure that the package isn't
already available. For example, typing @kbd{M-x apropos @key{RET}
-wordstar @key{RET}} lists all functions and variables containing the
-string @samp{wordstar}.
+python @key{RET}} lists all functions and variables containing the
+string @samp{python}.
It is also possible that the package is on your system, but has not been
loaded. To see which packages are available for loading, look through
@dircategory Emacs misc features
@direntry
-* VIP: (vip). An older VI-emulation for Emacs.
+* VIP: (vip). An obsolete VI-emulation for Emacs.
@end direntry
@ifnottex
concentrate mainly on differences from Vi, especially features unique to
VIP.
+VIP is obsolete since Emacs 24.5---consider using Viper instead.
+@xref{Top, Viper,, viper, The Viper VI-emulation mode for Emacs}.
+
It is recommended that you read nodes on survey and on customization before
you start using VIP@. Other nodes may be visited as needed.
concentrate mainly on differences from Vi, especially features unique to
VIP.
+VIP is obsolete since Emacs 24.5---consider using Viper instead.
+@xref{Top, Viper,, viper, The Viper VI-emulation mode for Emacs}.
+
It is recommended that you read chapters on survey and on customization
before you start using VIP@. Other chapters may be used as future
references.
* Changes in Emacs-24.5
+---
** The default value of `history-length' has increased to 100.
\f
* Changes in Specialized Modes and Packages in Emacs 24.5
+---
+*** vi.el, vip.el (try M-x viper instead)
+
+---
+*** crisp.el, tpu-edt.el, ws-mode.el
+These emulations of old editors are believed to be no longer relevant
+ - contact emacs-devel@gnu.org if you disagree.
+
** cc-compat.el is marked as obsolete.
\f
* Installation Changes in Emacs 24.4
+2014-10-20 Glenn Morris <rgm@gnu.org>
+
+ * emulation/crisp.el, emulation/tpu-edt.el, emulation/tpu-extras.el:
+ * emulation/tpu-mapper.el, emulation/vi.el, emulation/vip.el:
+ * emulation/ws-mode.el: Move to obsolete/. [Backport]
+
2014-10-20 Glenn Morris <rgm@gnu.org>
* cus-start.el (history-length): Bump :version. [Backport]
+++ /dev/null
-;;; 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
-
-;; 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
+++ /dev/null
-;;; 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
-
-;; 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))
-
-\f
-;;;### (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)
-
-;;;***
-\f
-(provide 'tpu-edt)
-
-;;; tpu-edt.el ends here
+++ /dev/null
-;;; 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
-
-;; 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
+++ /dev/null
-;;; 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
-
-;; 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
+++ /dev/null
-;;; 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
-
-;;; Commentary:
-
-;; 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))
-\f
-(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
-
-\f
-(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
+++ /dev/null
-;;; vip.el --- a VI Package for GNU Emacs
-
-;; Copyright (C) 1986-1988, 1992-1993, 1998, 2001-2014 Free Software
-;; Foundation, Inc.
-
-;; Author: Masahiko Sato <ms@sail.stanford.edu>
-;; Keywords: emulations
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; A full-featured vi(1) emulator.
-;;
-;; In Japan, the author's address is: masahiko@sato.riec.tohoku.junet
-;;
-;; Send suggestions and bug reports to one of the above addresses.
-;; When you report a bug, be sure to include the version number of VIP and
-;; Emacs you are using.
-
-;; Execute info command by typing "M-x info" to get information on VIP.
-
-;;; Code:
-
-(defgroup vip nil
- "A VI Package for GNU Emacs."
- :prefix "vip-"
- :group 'emulations)
-
-;; external variables
-
-(defvar vip-emacs-local-map nil
- "Local map used in Emacs mode. (Buffer-specific.)")
-
-(defvar vip-insert-local-map nil
- "Local map used in insert command mode. (Buffer-specific.)")
-
-(make-variable-buffer-local 'vip-emacs-local-map)
-(make-variable-buffer-local 'vip-insert-local-map)
-
-(defvar vip-insert-point nil
- "Remember insert point as a marker. (Buffer-specific.)")
-
-(set-default 'vip-insert-point (make-marker))
-(make-variable-buffer-local 'vip-insert-point)
-
-(defvar vip-com-point nil
- "Remember com point as a marker. (Buffer-specific.)")
-
-(set-default 'vip-com-point (make-marker))
-(make-variable-buffer-local 'vip-com-point)
-
-(defvar vip-current-mode nil
- "Current mode. One of `emacs-mode', `vi-mode', `insert-mode'.")
-
-(make-variable-buffer-local 'vip-current-mode)
-(setq-default vip-current-mode 'emacs-mode)
-
-(defvar vip-emacs-mode-line-buffer-identification nil
- "Value of mode-line-buffer-identification in Emacs mode within vip.")
-(make-variable-buffer-local 'vip-emacs-mode-line-buffer-identification)
-(setq-default vip-emacs-mode-line-buffer-identification
- '("Emacs: %17b"))
-
-(defvar vip-current-major-mode nil
- "vip-current-major-mode is the major-mode vi considers it is now.
-\(buffer specific\)")
-
-(make-variable-buffer-local 'vip-current-major-mode)
-
-(defvar vip-last-shell-com nil
- "Last shell command executed by ! command.")
-
-(defvar vip-use-register nil
- "Name of register to store deleted or yanked strings.")
-
-(defvar vip-d-com nil
- "How to reexecute last destructive command. Value is list (M-COM VAL COM).")
-
-(defcustom vip-shift-width 8
- "The number of columns shifted by > and < command."
- :type 'integer
- :group 'vip)
-
-(defcustom vip-re-replace nil
- "If t then do regexp replace, if nil then do string replace."
- :type 'boolean
- :group 'vip)
-
-(defvar vip-d-char nil
- "The character remembered by the vi \"r\" command.")
-
-(defvar vip-f-char nil
- "For use by \";\" command.")
-
-(defvar vip-F-char nil
- "For use by \".\" command.")
-
-(defvar vip-f-forward nil
- "For use by \";\" command.")
-
-(defvar vip-f-offset nil
- "For use by \";\" command.")
-
-(defcustom vip-search-wrap-around t
- "If t, search wraps around."
- :type 'boolean
- :group 'vip)
-
-(defcustom vip-re-search nil
- "If t, search is reg-exp search, otherwise vanilla search."
- :type 'boolean
- :group 'vip)
-
-(defvar vip-s-string nil
- "Last vip search string.")
-
-(defvar vip-s-forward nil
- "If t, search is forward.")
-
-(defcustom vip-case-fold-search nil
- "If t, search ignores cases."
- :type 'boolean
- :group 'vip)
-
-(defcustom vip-re-query-replace nil
- "If t then do regexp replace, if nil then do string replace."
- :type 'boolean
- :group 'vip)
-
-(defcustom vip-open-with-indent nil
- "If t, indent when open a new line."
- :type 'boolean
- :group 'vip)
-
-(defcustom vip-help-in-insert-mode nil
- "If t then C-h is bound to help-command in insert mode.
-If nil then it is bound to `delete-backward-char'."
- :type 'boolean
- :group 'vip)
-
-(defvar vip-quote-string "> "
- "String inserted at the beginning of region.")
-
-(defvar vip-tags-file-name "TAGS")
-
-(defvar vip-inhibit-startup-message nil)
-
-(defvar vip-startup-file (locate-user-emacs-file "vip" ".vip")
- "Filename used as startup file for vip.")
-\f
-;; 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"))
-
-\f
-;; 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)))
-
-\f
-;; 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))
-
-\f
-;; 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)))
-
-\f
-;; 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))))
-
-\f
-;; 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)))))
-
-\f
-;; 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))
-
-\f
-;; 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))
-
-\f
-;; 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)))
-
-\f
-;; 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))))
-
-\f
-;; 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))))))))
-
-\f
-;; 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))))
-
-\f
-;; 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)))
-
-\f
-;; 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)))))
-
-\f
-;; 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))))
-
-\f
-;; 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 ""))))))
-
-\f
-;; 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))))
-
-\f
-;; 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))
-
-\f
-;; splitting window
-
-(defun vip-buffer-in-two-windows ()
- "Show current buffer in two windows."
- (interactive)
- (delete-other-windows)
- (split-window-below))
-
-\f
-;; 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))))
-
-\f
-;; 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)))))
-
-\f
-;; 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)))
-
-\f
-;; 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)))))))
-
-\f
-;; 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))
-
-\f
-;; 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)))))))
-
-\f
-;; 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))))
-\f
-;; 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))))
-
-\f
-;; 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
+++ /dev/null
-;;; 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
-
-;; 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
--- /dev/null
+;;; 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
--- /dev/null
+;;; 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))
+
+\f
+;;;### (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)
+
+;;;***
+\f
+(provide 'tpu-edt)
+
+;;; tpu-edt.el ends here
--- /dev/null
+;;; 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
--- /dev/null
+;;; 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
--- /dev/null
+;;; 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))
+\f
+(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
+
+\f
+(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
--- /dev/null
+;;; 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.")
+\f
+;; 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"))
+
+\f
+;; 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)))
+
+\f
+;; 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))
+
+\f
+;; 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)))
+
+\f
+;; 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))))
+
+\f
+;; 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)))))
+
+\f
+;; 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))
+
+\f
+;; 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))
+
+\f
+;; 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)))
+
+\f
+;; 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))))
+
+\f
+;; 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))))))))
+
+\f
+;; 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))))
+
+\f
+;; 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)))
+
+\f
+;; 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)))))
+
+\f
+;; 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))))
+
+\f
+;; 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 ""))))))
+
+\f
+;; 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))))
+
+\f
+;; 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))
+
+\f
+;; splitting window
+
+(defun vip-buffer-in-two-windows ()
+ "Show current buffer in two windows."
+ (interactive)
+ (delete-other-windows)
+ (split-window-below))
+
+\f
+;; 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))))
+
+\f
+;; 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)))))
+
+\f
+;; 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)))
+
+\f
+;; 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)))))))
+
+\f
+;; 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))
+
+\f
+;; 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)))))))
+
+\f
+;; 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))))
+\f
+;; 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))))
+
+\f
+;; 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
--- /dev/null
+;;; 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
projects / emacs.git / commitdiff