From 4982861a08d0ec3262a0b68ff699920bb2938c40 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Sun, 1 Jun 2014 18:02:21 -0700 Subject: Make some old emulation modes obsolete Ref: http://lists.gnu.org/archive/html/emacs-devel/2014-05/msg00502.html * lisp/emulation/crisp.el, lisp/emulation/tpu-edt.el: * lisp/emulation/tpu-extras.el, lisp/emulation/tpu-mapper.el: * lisp/emulation/vi.el, lisp/emulation/vip.el, lisp/emulation/ws-mode.el: Move to obsolete/. * doc/emacs/ack.texi (Acknowledgments): Remove some obsolete items. * doc/emacs/misc.texi (Emulation): Remove section. * doc/lispintro/emacs-lisp-intro.texi (Autoload): Update loaddefs.el details. * doc/misc/efaq.texi (Finding a package with particular functionality): Update example. * doc/misc/vip.texi: Mention this is obsolete. * etc/NEWS: Mention this. --- doc/emacs/ChangeLog | 3 + doc/emacs/ack.texi | 17 +- doc/emacs/emacs.texi | 1 - doc/emacs/misc.texi | 14 +- doc/lispintro/ChangeLog | 4 + doc/lispintro/emacs-lisp-intro.texi | 4 +- doc/misc/ChangeLog | 6 + doc/misc/efaq.texi | 4 +- doc/misc/vip.texi | 8 +- etc/NEWS | 8 + lisp/ChangeLog | 6 + lisp/emulation/crisp.el | 386 ----- lisp/emulation/tpu-edt.el | 2471 ---------------------------- lisp/emulation/tpu-extras.el | 445 ----- lisp/emulation/tpu-mapper.el | 352 ---- lisp/emulation/vi.el | 1492 ----------------- lisp/emulation/vip.el | 3059 ---------------------------------- lisp/emulation/ws-mode.el | 642 -------- lisp/obsolete/crisp.el | 387 +++++ lisp/obsolete/tpu-edt.el | 2472 ++++++++++++++++++++++++++++ lisp/obsolete/tpu-extras.el | 446 +++++ lisp/obsolete/tpu-mapper.el | 353 ++++ lisp/obsolete/vi.el | 1495 +++++++++++++++++ lisp/obsolete/vip.el | 3062 +++++++++++++++++++++++++++++++++++ lisp/obsolete/ws-mode.el | 643 ++++++++ lisp/scroll-all.el | 2 +- 26 files changed, 8909 insertions(+), 8873 deletions(-) delete mode 100644 lisp/emulation/crisp.el delete mode 100644 lisp/emulation/tpu-edt.el delete mode 100644 lisp/emulation/tpu-extras.el delete mode 100644 lisp/emulation/tpu-mapper.el delete mode 100644 lisp/emulation/vi.el delete mode 100644 lisp/emulation/vip.el delete mode 100644 lisp/emulation/ws-mode.el create mode 100644 lisp/obsolete/crisp.el create mode 100644 lisp/obsolete/tpu-edt.el create mode 100644 lisp/obsolete/tpu-extras.el create mode 100644 lisp/obsolete/tpu-mapper.el create mode 100644 lisp/obsolete/vi.el create mode 100644 lisp/obsolete/vip.el create mode 100644 lisp/obsolete/ws-mode.el diff --git a/doc/emacs/ChangeLog b/doc/emacs/ChangeLog index 2a46642f0dc..cf6d038cc58 100644 --- a/doc/emacs/ChangeLog +++ b/doc/emacs/ChangeLog @@ -1,5 +1,8 @@ 2014-06-02 Glenn Morris + * ack.texi (Acknowledgments): Remove some obsolete items. + * misc.texi (Emulation): Remove section. + * macos.texi (Mac / GNUstep Customization): Mention ns custom group. (Customization options specific to Mac OS / GNUstep): Remove section. diff --git a/doc/emacs/ack.texi b/doc/emacs/ack.texi index ef4e202cea9..93fc51f718d 100644 --- a/doc/emacs/ack.texi +++ b/doc/emacs/ack.texi @@ -346,8 +346,7 @@ mail messages; and @file{saveplace.el}, for preserving point's 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 @@ -593,7 +592,7 @@ buffers. @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 @@ -871,9 +870,6 @@ a mode for editing makefiles. 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; @@ -1025,10 +1021,8 @@ Alex Rezinsky wrote @file{which-func.el}, a mode that shows the name 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 @@ -1070,9 +1064,6 @@ references in Info files. 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. diff --git a/doc/emacs/emacs.texi b/doc/emacs/emacs.texi index d665a9dedaf..d9aabb87daf 100644 --- a/doc/emacs/emacs.texi +++ b/doc/emacs/emacs.texi @@ -201,7 +201,6 @@ Advanced Features * 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. diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index a2813f8b197..b7f1fdd0683 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -2269,17 +2269,17 @@ new major mode which provides a command to switch back. These 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) most other @@ -2319,7 +2319,7 @@ buffers or major modes while in EDT emulation. @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 @@ -2360,6 +2360,8 @@ not use it. @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 diff --git a/doc/lispintro/ChangeLog b/doc/lispintro/ChangeLog index a5878fc7568..304e036e3b1 100644 --- a/doc/lispintro/ChangeLog +++ b/doc/lispintro/ChangeLog @@ -1,3 +1,7 @@ +2014-06-02 Glenn Morris + + * emacs-lisp-intro.texi (Autoload): Update loaddefs.el details. + 2014-04-17 Paul Eggert * Makefile.in (infoclean): Be consistent about reporting failures. diff --git a/doc/lispintro/emacs-lisp-intro.texi b/doc/lispintro/emacs-lisp-intro.texi index f181569ca75..6d5296725b3 100644 --- a/doc/lispintro/emacs-lisp-intro.texi +++ b/doc/lispintro/emacs-lisp-intro.texi @@ -17548,8 +17548,8 @@ are not loaded right away; but you need to wait a moment when you 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. diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog index a0aa2879b5f..0bf989c75d4 100644 --- a/doc/misc/ChangeLog +++ b/doc/misc/ChangeLog @@ -1,3 +1,9 @@ +2014-06-02 Glenn Morris + + * efaq.texi (Finding a package with particular functionality): + Update example. + * vip.texi: Mention this is obsolete. + 2014-05-27 Paul Eggert * texinfo.tex: Update from gnulib. diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi index 2e136017039..3e86f30cdb5 100644 --- a/doc/misc/efaq.texi +++ b/doc/misc/efaq.texi @@ -3264,8 +3264,8 @@ archive sites that make GNU software available. 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 diff --git a/doc/misc/vip.texi b/doc/misc/vip.texi index 193d50f3a46..4008fbecd82 100644 --- a/doc/misc/vip.texi +++ b/doc/misc/vip.texi @@ -38,7 +38,7 @@ modify this GNU manual.'' @dircategory Emacs misc features @direntry -* VIP: (vip). An older VI-emulation for Emacs. +* VIP: (vip). An obsolete VI-emulation for Emacs. @end direntry @ifnottex @@ -53,6 +53,9 @@ are fairly accustomed to Vi but not so much with Emacs. Also we will 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. @@ -83,6 +86,9 @@ fairly accustomed to Vi but not so much with Emacs. Also we will 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. diff --git a/etc/NEWS b/etc/NEWS index f3f953b409f..e98fb52e585 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -109,6 +109,14 @@ protocols as well as for "telnet" and "ftp" are passed to Tramp. --- *** gulp.el +--- +*** 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. + * New Modes and Packages in Emacs 24.5 diff --git a/lisp/ChangeLog b/lisp/ChangeLog index d85aa1e31ab..7d8cf51cc52 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,9 @@ +2014-06-02 Glenn Morris + + * 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/. + 2014-06-02 Eli Zaretskii * simple.el (keyboard-quit): Force update of mode lines, to remove diff --git a/lisp/emulation/crisp.el b/lisp/emulation/crisp.el deleted file mode 100644 index ad463412735..00000000000 --- a/lisp/emulation/crisp.el +++ /dev/null @@ -1,386 +0,0 @@ -;;; crisp.el --- CRiSP/Brief Emacs emulator - -;; Copyright (C) 1997-1999, 2001-2014 Free Software Foundation, Inc. - -;; Author: Gary D. Foster -;; 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 . - -;;; Commentary: - -;; Keybindings and minor functions to duplicate the functionality and -;; finger-feel of the CRiSP/Brief editor. This package is designed to -;; facilitate transitioning from Brief to (XE|E)macs with a minimum -;; amount of hassles. - -;; Enable this package by putting (require 'crisp) in your .emacs and -;; use M-x crisp-mode to toggle it on or off. - -;; This package will automatically load the scroll-all.el package if -;; you put (setq crisp-load-scroll-all t) in your .emacs before -;; loading this package. If this feature is enabled, it will bind -;; meta-f1 to the scroll-all mode toggle. The scroll-all package -;; duplicates the scroll-all feature in CRiSP. - -;; Also, the default keybindings for brief/CRiSP override the M-x -;; key to exit the editor. If you don't like this functionality, you -;; can prevent this behavior (or redefine it dynamically) by setting -;; the value of `crisp-override-meta-x' either in your .emacs or -;; interactively. The default setting is t, which means that M-x will -;; by default run `save-buffers-kill-emacs' instead of the command -;; `execute-extended-command'. - -;; Finally, if you want to change the string displayed in the mode -;; line when this mode is in effect, override the definition of -;; `crisp-mode-mode-line-string' in your .emacs. The default value is -;; " *Crisp*" which may be a bit lengthy if you have a lot of things -;; being displayed there. - -;; All these overrides should go *before* the (require 'crisp) statement. - -;;; Code: - -;; local variables - -(defgroup crisp nil - "Emulator for CRiSP and Brief key bindings." - :prefix "crisp-" - :group 'emulations) - -(defvar crisp-mode-map - (let ((map (make-sparse-keymap))) - (define-key map [(f1)] 'other-window) - - (define-key map [(f2) (down)] 'enlarge-window) - (define-key map [(f2) (left)] 'shrink-window-horizontally) - (define-key map [(f2) (right)] 'enlarge-window-horizontally) - (define-key map [(f2) (up)] 'shrink-window) - (define-key map [(f3) (down)] 'split-window-below) - (define-key map [(f3) (right)] 'split-window-right) - - (define-key map [(f4)] 'delete-window) - (define-key map [(control f4)] 'delete-other-windows) - - (define-key map [(f5)] 'search-forward-regexp) - (define-key map [(f19)] 'search-forward-regexp) - (define-key map [(meta f5)] 'search-backward-regexp) - - (define-key map [(f6)] 'query-replace) - - (define-key map [(f7)] 'start-kbd-macro) - (define-key map [(meta f7)] 'end-kbd-macro) - - (define-key map [(f8)] 'call-last-kbd-macro) - (define-key map [(meta f8)] 'save-kbd-macro) - - (define-key map [(f9)] 'find-file) - (define-key map [(meta f9)] 'load-library) - - (define-key map [(f10)] 'execute-extended-command) - (define-key map [(meta f10)] 'compile) - - (define-key map [(SunF37)] 'kill-buffer) - (define-key map [(kp-add)] 'crisp-copy-line) - (define-key map [(kp-subtract)] 'crisp-kill-line) - ;; just to cover all the bases (GNU Emacs, for instance) - (define-key map [(f24)] 'crisp-kill-line) - (define-key map [(insert)] 'crisp-yank-clipboard) - (define-key map [(f16)] 'crisp-set-clipboard) ; copy on Sun5 kbd - (define-key map [(f20)] 'crisp-kill-region) ; cut on Sun5 kbd - (define-key map [(f18)] 'crisp-yank-clipboard) ; paste on Sun5 kbd - - (define-key map [(control f)] 'fill-paragraph-or-region) - (define-key map [(meta d)] (lambda () - (interactive) - (beginning-of-line) (kill-line))) - (define-key map [(meta e)] 'find-file) - (define-key map [(meta g)] 'goto-line) - (define-key map [(meta h)] 'help) - (define-key map [(meta i)] 'overwrite-mode) - (define-key map [(meta j)] 'bookmark-jump) - (define-key map [(meta l)] 'crisp-mark-line) - (define-key map [(meta m)] 'set-mark-command) - (define-key map [(meta n)] 'bury-buffer) - (define-key map [(meta p)] 'crisp-unbury-buffer) - (define-key map [(meta u)] 'undo) - (define-key map [(f14)] 'undo) - (define-key map [(meta w)] 'save-buffer) - (define-key map [(meta x)] 'crisp-meta-x-wrapper) - (define-key map [(meta ?0)] (lambda () - (interactive) - (bookmark-set "0"))) - (define-key map [(meta ?1)] (lambda () - (interactive) - (bookmark-set "1"))) - (define-key map [(meta ?2)] (lambda () - (interactive) - (bookmark-set "2"))) - (define-key map [(meta ?3)] (lambda () - (interactive) - (bookmark-set "3"))) - (define-key map [(meta ?4)] (lambda () - (interactive) - (bookmark-set "4"))) - (define-key map [(meta ?5)] (lambda () - (interactive) - (bookmark-set "5"))) - (define-key map [(meta ?6)] (lambda () - (interactive) - (bookmark-set "6"))) - (define-key map [(meta ?7)] (lambda () - (interactive) - (bookmark-set "7"))) - (define-key map [(meta ?8)] (lambda () - (interactive) - (bookmark-set "8"))) - (define-key map [(meta ?9)] (lambda () - (interactive) - (bookmark-set "9"))) - - (define-key map [(shift delete)] 'kill-word) - (define-key map [(shift backspace)] 'backward-kill-word) - (define-key map [(control left)] 'backward-word) - (define-key map [(control right)] 'forward-word) - - (define-key map [(home)] 'crisp-home) - (define-key map [(control home)] (lambda () - (interactive) - (move-to-window-line 0))) - (define-key map [(meta home)] 'beginning-of-line) - (define-key map [(end)] 'crisp-end) - (define-key map [(control end)] (lambda () - (interactive) - (move-to-window-line -1))) - (define-key map [(meta end)] 'end-of-line) - map) - "Local keymap for CRiSP emulation mode. -All the bindings are done here instead of globally to try and be -nice to the world.") - -(define-obsolete-variable-alias 'crisp-mode-modeline-string - 'crisp-mode-mode-line-string "24.3") - -(defcustom crisp-mode-mode-line-string " *CRiSP*" - "String to display in the mode line when CRiSP emulation mode is enabled." - :type 'string - :group 'crisp) - -;;;###autoload -(defcustom crisp-mode nil - "Track status of CRiSP emulation mode. -A value of nil means CRiSP mode is not enabled. A value of t -indicates CRiSP mode is enabled. - -Setting this variable directly does not take effect; -use either M-x customize or the function `crisp-mode'." - :set (lambda (symbol value) (crisp-mode (if value 1 0))) - :initialize 'custom-initialize-default - :require 'crisp - :version "20.4" - :type 'boolean - :group 'crisp) - -(defcustom crisp-override-meta-x t - "Controls overriding the normal Emacs M-x key binding in the CRiSP emulator. -Normally the CRiSP emulator rebinds M-x to `save-buffers-exit-emacs', and -provides the usual M-x functionality on the F10 key. If this variable -is non-nil, M-x will exit Emacs." - :type 'boolean - :group 'crisp) - -(defcustom crisp-load-scroll-all nil - "Controls loading of the Scroll Lock in the CRiSP emulator. -Its default behavior is to load and enable the Scroll Lock minor mode -package when enabling the CRiSP emulator. - -If this variable is nil when you start the CRiSP emulator, it -does not load the scroll-all package." - :type 'boolean - :group 'crisp) - -(defcustom crisp-load-hook nil - "Hooks to run after loading the CRiSP emulator package." - :type 'hook - :group 'crisp) - -(defcustom crisp-mode-hook nil - "Hook run by the function `crisp-mode'." - :type 'hook - :group 'crisp) - -(defconst crisp-version "1.34" - "The version of the CRiSP emulator.") - -(defconst crisp-mode-help-address "gfoster@suzieq.ml.org" - "The email address of the CRiSP mode author/maintainer.") - -;; Silence the byte-compiler. -(defvar crisp-last-last-command nil - "The previous value of `last-command'.") - -;; The cut and paste routines are different between XEmacs and Emacs -;; so we need to set up aliases for the functions. - -(defalias 'crisp-set-clipboard - (if (fboundp 'clipboard-kill-ring-save) - 'clipboard-kill-ring-save - 'copy-primary-selection)) - -(defalias 'crisp-kill-region - (if (fboundp 'clipboard-kill-region) - 'clipboard-kill-region - 'kill-primary-selection)) - -(defalias 'crisp-yank-clipboard - (if (fboundp 'clipboard-yank) - 'clipboard-yank - 'yank-clipboard-selection)) - -(defun crisp-region-active () - "Compatibility function to test for an active region." - (if (featurep 'xemacs) - zmacs-region-active-p - mark-active)) - -(defun crisp-version (&optional arg) - "Version number of the CRiSP emulator package. -If ARG, insert results at point." - (interactive "P") - (let ((foo (concat "CRiSP version " crisp-version))) - (if arg - (insert (message foo)) - (message foo)))) - -(defun crisp-mark-line (arg) - "Set mark at the end of the line. -Arg works as in `end-of-line'." - (interactive "p") - (let (newmark) - (save-excursion - (end-of-line arg) - (setq newmark (point))) - (push-mark newmark nil t))) - -(defun crisp-kill-line (arg) - "Mark and kill line(s). -Marks from point to end of the current line (honoring prefix arguments), -copies the region to the kill ring and clipboard, and then deletes it." - (interactive "*p") - (if (crisp-region-active) - (call-interactively 'crisp-kill-region) - (crisp-mark-line arg) - (call-interactively 'crisp-kill-region))) - -(defun crisp-copy-line (arg) - "Mark and copy line(s). -Marks from point to end of the current line (honoring prefix arguments), -copies the region to the kill ring and clipboard, and then deactivates -the region." - (interactive "*p") - (if (crisp-region-active) - (call-interactively 'crisp-set-clipboard) - (crisp-mark-line arg) - (call-interactively 'crisp-set-clipboard)) - ;; clear the region after the operation is complete - ;; XEmacs does this automagically, Emacs doesn't. - (if (boundp 'mark-active) - (setq mark-active nil))) - -(defun crisp-home () - "\"Home\" the point, the way CRiSP would do it. -The first use moves point to beginning of the line. Second -consecutive use moves point to beginning of the screen. Third -consecutive use moves point to the beginning of the buffer." - (interactive nil) - (cond - ((and (eq last-command 'crisp-home) - (eq crisp-last-last-command 'crisp-home)) - (goto-char (point-min))) - ((eq last-command 'crisp-home) - (move-to-window-line 0)) - (t - (beginning-of-line))) - (setq crisp-last-last-command last-command)) - -(defun crisp-end () - "\"End\" the point, the way CRiSP would do it. -The first use moves point to end of the line. Second -consecutive use moves point to the end of the screen. Third -consecutive use moves point to the end of the buffer." - (interactive nil) - (cond - ((and (eq last-command 'crisp-end) - (eq crisp-last-last-command 'crisp-end)) - (goto-char (point-max))) - ((eq last-command 'crisp-end) - (move-to-window-line -1) - (end-of-line)) - (t - (end-of-line))) - (setq crisp-last-last-command last-command)) - -(defun crisp-unbury-buffer () - "Go back one buffer." - (interactive) - (switch-to-buffer (car (last (buffer-list))))) - -(defun crisp-meta-x-wrapper () - "Wrapper function to conditionally override the normal M-x bindings. -When `crisp-override-meta-x' is non-nil, M-x will exit Emacs (the -normal CRiSP binding) and when it is nil M-x will run -`execute-extended-command' (the normal Emacs binding)." - (interactive) - (if crisp-override-meta-x - (save-buffers-kill-emacs) - (call-interactively 'execute-extended-command))) - -;;;###autoload -(define-minor-mode crisp-mode - "Toggle CRiSP/Brief emulation (CRiSP mode). -With a prefix argument ARG, enable CRiSP mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable the mode -if ARG is omitted or nil." - :keymap crisp-mode-map - :lighter crisp-mode-mode-line-string - (when crisp-mode - ;; Make menu entries show M-u or f14 in preference to C-x u. - (put 'undo :advertised-binding - `([?\M-u] [f14] ,@(get 'undo :advertised-binding))) - ;; Force transient-mark-mode, so that the marking routines work as - ;; expected. If the user turns off transient mark mode, most - ;; things will still work fine except the crisp-(copy|kill) - ;; functions won't work quite as nicely when regions are marked - ;; differently and could really confuse people. Caveat emptor. - (if (fboundp 'transient-mark-mode) - (transient-mark-mode t)) - (if crisp-load-scroll-all - (require 'scroll-all)) - (if (featurep 'scroll-all) - (define-key crisp-mode-map [(meta f1)] 'scroll-all-mode)))) - -;; People might use Apropos on `brief'. -;;;###autoload -(defalias 'brief-mode 'crisp-mode) - -;; Interaction with other packages. -(put 'crisp-home 'CUA 'move) -(put 'crisp-end 'CUA 'move) - -(run-hooks 'crisp-load-hook) -(provide 'crisp) - -;;; crisp.el ends here diff --git a/lisp/emulation/tpu-edt.el b/lisp/emulation/tpu-edt.el deleted file mode 100644 index d9ed1908c76..00000000000 --- a/lisp/emulation/tpu-edt.el +++ /dev/null @@ -1,2471 +0,0 @@ -;;; tpu-edt.el --- Emacs emulating TPU emulating EDT - -;; Copyright (C) 1993-1995, 2000-2014 Free Software Foundation, Inc. - -;; Author: Rob Riepel -;; Maintainer: Rob Riepel -;; 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 . - -;; 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 -;; m emacs - -;; 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 "^" "> " " to beginning of line> -;; replace "$" "00711" - -;; 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) ; 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- 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 p - - Where `M-x' might be any of `Gold-KP7', 'Do', or 'ESC-x'. - - When you successfully invoke this part of the Emacs help facility, you - will see a buffer named `*Finder*' listing a number of topics. Look for - tpu-edt under `emulations'. - -\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\f - - *** No more help, use P to view previous screen") - -(defvar tpu-help-enter (format "%s" "\eOM")) ; tpu-help enter key symbol -(defvar tpu-help-return (format "%s" "\r")) ; tpu-help enter key symbol -(defvar tpu-help-N "N") ; tpu-help "N" symbol -(defvar tpu-help-n "n") ; tpu-help "n" symbol -(defvar tpu-help-P "P") ; tpu-help "P" symbol -(defvar tpu-help-p "p") ; tpu-help "p" symbol - -(defun tpu-help nil - "Display TPU-edt help." - (interactive) - ;; Save current window configuration - (save-window-excursion - ;; Create and fill help buffer if necessary - (if (not (get-buffer "*TPU-edt Help*")) - (progn (generate-new-buffer "*TPU-edt Help*") - (switch-to-buffer "*TPU-edt Help*") - (insert tpu-help-keypad-map) - (insert tpu-help-text) - (setq buffer-read-only t))) - - ;; Display the help buffer - (switch-to-buffer "*TPU-edt Help*") - (delete-other-windows) - (tpu-move-to-beginning) - (forward-line 1) - (tpu-line-to-top-of-window) - - ;; Prompt for keys to describe, based on screen state (split/not split) - (let ((key nil) (fkey nil) (split nil)) - (while (not (equal tpu-help-return fkey)) - (if split - (setq key - (read-key-sequence - "Press the key you want help on (RET=exit, ENTER=redisplay, N=next, P=prev): ")) - (setq key - (read-key-sequence - "Press the key you want help on (RET to exit, N next screen, P prev screen): "))) - - ;; Process the read key - ;; - ;; ENTER - Display just the help window - ;; N or n - Next help or describe-key screen - ;; P or p - Previous help or describe-key screen - ;; RETURN - Exit from TPU-help - ;; default - describe the key - ;; - (setq fkey (format "%s" key)) - (cond ((equal tpu-help-enter fkey) - (setq split nil) - (delete-other-windows)) - ((or (equal tpu-help-N fkey) (equal tpu-help-n fkey)) - (cond (split - (condition-case nil - (scroll-other-window 8) - (error nil))) - (t - (forward-page) - (forward-line 1) - (tpu-line-to-top-of-window)))) - ((or (equal tpu-help-P fkey) (equal tpu-help-p fkey)) - (cond (split - (condition-case nil - (scroll-other-window -8) - (error nil))) - (t - (forward-line -1) - (backward-page) - (forward-line 1) - (tpu-line-to-top-of-window)))) - ((not (equal tpu-help-return fkey)) - (setq split t) - (describe-key key) - ;; If the key is undefined, leave the - ;; message in the mini-buffer for 3 seconds - (if (not (key-binding key)) (sit-for 3)))))))) - - -;;; -;;; Auto-insert -;;; -(defun tpu-insert-escape nil - "Insert an escape character, and so becomes the escape-key alias." - (interactive) - (insert "\e")) - -(defun tpu-insert-formfeed nil - "Insert a formfeed character." - (interactive) - (insert "\C-L")) - - -;;; -;;; Define key -;;; -(defvar tpu-saved-control-r nil "Saved value of Control-r.") - -(defun tpu-end-define-macro-key (key) - "End the current macro definition." - (interactive "kPress the key you want to use to do what was just learned: ") - (end-kbd-macro nil) - (global-set-key key last-kbd-macro) - (global-set-key "\C-r" tpu-saved-control-r)) - -(defun tpu-define-macro-key nil - "Bind a set of keystrokes to a single key, or key combination." - (interactive) - (setq tpu-saved-control-r (global-key-binding "\C-r")) - (global-set-key "\C-r" 'tpu-end-define-macro-key) - (start-kbd-macro nil)) - - -;;; -;;; Buffers and Windows -;;; -(defun tpu-kill-buffer nil - "Kill the current buffer. -If `tpu-kill-buffers-silently' is non-nil, -kill modified buffers without asking." - (interactive) - (if tpu-kill-buffers-silently (set-buffer-modified-p nil)) - (kill-buffer (current-buffer))) - -(defun tpu-save-all-buffers-kill-emacs nil - "Save all buffers and exit Emacs." - (interactive) - (let ((delete-old-versions t)) - (save-buffers-kill-emacs t))) - -(defun tpu-write-current-buffers nil - "Save all modified buffers without exiting." - (interactive) - (save-some-buffers t)) - -(defun tpu-next-buffer nil - "Go to next buffer in ring." - (interactive) - (switch-to-buffer (car (reverse (buffer-list))))) - -(defun tpu-next-file-buffer nil - "Go to next buffer in ring that is visiting a file or directory." - (interactive) - (let ((list (tpu-make-file-buffer-list (buffer-list)))) - (setq list (delq (current-buffer) list)) - (if (not list) (tpu-error "No other buffers.")) - (switch-to-buffer (car (reverse list))))) - -(defun tpu-make-file-buffer-list (buffer-list) - "Return names from BUFFER-LIST excluding those beginning with a space or star." - (delq nil (mapcar (lambda (b) - (if (or (= (aref (buffer-name b) 0) ?\s) - (= (aref (buffer-name b) 0) ?*)) nil b)) - buffer-list))) - -(defun tpu-next-window nil - "Move to the next window." - (interactive) - (if (one-window-p) (message "There is only one window on screen.") - (other-window 1))) - -(defun tpu-previous-window nil - "Move to the previous window." - (interactive) - (if (one-window-p) (message "There is only one window on screen.") - (select-window (previous-window)))) - - -;;; -;;; Search -;;; -(defun tpu-toggle-regexp nil - "Switch in and out of regular expression search and replace mode." - (interactive) - (setq tpu-regexp-p (not tpu-regexp-p)) - (tpu-set-search) - (and (called-interactively-p 'interactive) - (message "Regular expression search and substitute %sabled." - (if tpu-regexp-p "en" "dis")))) - -(defun tpu-regexp-prompt (prompt) - "Read a string, adding 'RE' to the prompt if tpu-regexp-p is set." - (let ((re-prompt (concat (if tpu-regexp-p "RE ") prompt))) - (read-from-minibuffer re-prompt nil nil nil 'tpu-regexp-prompt-hist))) - -(defun tpu-search-highlight nil - (if (tpu-check-match) - (move-overlay tpu-search-overlay - (tpu-match-beginning) (tpu-match-end) (current-buffer)) - (unless (equal (overlay-start tpu-search-overlay) - (overlay-end tpu-search-overlay)) - (move-overlay tpu-search-overlay 1 1 (current-buffer))))) - -(defun tpu-search nil - "Search for a string or regular expression. -The search is performed in the current direction." - (interactive) - (tpu-set-search) - (tpu-search-internal "")) - -(defun tpu-search-forward nil - "Search for a string or regular expression. -The search is begins in the forward direction." - (interactive) - (setq tpu-searching-forward t) - (tpu-set-search t) - (tpu-search-internal "")) - -(defun tpu-search-reverse nil - "Search for a string or regular expression. -The search is begins in the reverse direction." - (interactive) - (setq tpu-searching-forward nil) - (tpu-set-search t) - (tpu-search-internal "")) - -(defun tpu-search-again nil - "Search for the same string or regular expression as last time. -The search is performed in the current direction." - (interactive) - (tpu-search-internal tpu-search-last-string)) - -;; tpu-set-search defines the search functions used by the TPU-edt internal -;; search function. It should be called whenever the direction changes, or -;; the regular expression mode is turned on or off. It can also be called -;; to ensure that the next search will be in the current direction. It is -;; called from: - -;; tpu-advance tpu-backup -;; tpu-toggle-regexp tpu-toggle-search-direction (t) -;; tpu-search tpu-lm-replace -;; tpu-search-forward (t) tpu-search-reverse (t) -;; tpu-search-forward-exit (t) tpu-search-backward-exit (t) - -(declare-function tpu-emacs-search "tpu-edt") -(declare-function tpu-emacs-rev-search "tpu-edt") - -(defun tpu-set-search (&optional arg) - "Set the search functions and set the search direction to the current direction. -If an argument is specified, don't set the search direction." - (if (not arg) (setq tpu-searching-forward tpu-advance)) - (cond (tpu-searching-forward - (cond (tpu-regexp-p - (fset 'tpu-emacs-search 're-search-forward) - (fset 'tpu-emacs-rev-search 're-search-backward)) - (t - (fset 'tpu-emacs-search 'search-forward) - (fset 'tpu-emacs-rev-search 'search-backward)))) - (t - (cond (tpu-regexp-p - (fset 'tpu-emacs-search 're-search-backward) - (fset 'tpu-emacs-rev-search 're-search-forward)) - (t - (fset 'tpu-emacs-search 'search-backward) - (fset 'tpu-emacs-rev-search 'search-forward)))))) - -(defun tpu-search-internal (pat &optional quiet) - "Search for a string or regular expression." - (setq tpu-search-last-string - (if (not (string= "" pat)) pat (tpu-regexp-prompt "Search: "))) - - (tpu-unset-match) - (tpu-adjust-search) - - (let ((case-fold-search - (and case-fold-search (tpu-check-search-case tpu-search-last-string)))) - - (cond ((tpu-emacs-search tpu-search-last-string nil t) - (tpu-set-match) (goto-char (tpu-match-beginning))) - - (t - (tpu-adjust-search t) - (let ((found nil) (pos nil)) - (save-excursion - (let ((tpu-searching-forward (not tpu-searching-forward))) - (tpu-adjust-search) - (setq found (tpu-emacs-rev-search tpu-search-last-string nil t)) - (setq pos (match-beginning 0)))) - - (cond - (found - (cond ((tpu-y-or-n-p - (format "Found in %s direction. Go there? " - (if tpu-searching-forward "reverse" "forward"))) - (goto-char pos) (tpu-set-match) - (tpu-toggle-search-direction)))) - - (t - (if (not quiet) - (message - "%sSearch failed: \"%s\"" - (if tpu-regexp-p "RE " "") tpu-search-last-string))))))))) - -(defalias 'tpu-search-internal-core (symbol-function 'tpu-search-internal)) - -(defun tpu-check-search-case (string) - "Return t if string contains upper case." - ;; if using regexp, eliminate upper case forms (\B \W \S.) - (if tpu-regexp-p - (let ((pat (copy-sequence string)) (case-fold-search nil) (pos 0)) - (while (setq pos (string-match "\\\\\\\\" pat)) (aset pat (+ 1 pos) ?.)) - (while (setq pos (string-match "\\\\B" pat)) (aset pat (+ 1 pos) ?.)) - (while (setq pos (string-match "\\\\W" pat)) (aset pat (+ 1 pos) ?.)) - (while (setq pos (string-match "\\\\S." pat)) - (aset pat (+ 1 pos) ?.) (aset pat (+ 2 pos) ?.)) - (string-equal pat (downcase pat))) - (string-equal string (downcase string)))) - -(defun tpu-adjust-search (&optional arg) - "For forward searches, move forward a character before searching, -and backward a character after a failed search. Arg means end of search." - (if tpu-searching-forward - (cond (arg (if (not (bobp)) (forward-char -1))) - (t (if (not (eobp)) (forward-char 1)))))) - -(defun tpu-toggle-search-direction nil - "Toggle the TPU-edt search direction. -Used for reversing a search in progress." - (interactive) - (setq tpu-searching-forward (not tpu-searching-forward)) - (tpu-set-search t) - (and (called-interactively-p 'interactive) - (message "Searching %sward." - (if tpu-searching-forward "for" "back")))) - -(defun tpu-search-forward-exit nil - "Set search direction forward and exit minibuffer." - (interactive) - (setq tpu-searching-forward t) - (tpu-set-search t) - (exit-minibuffer)) - -(defun tpu-search-backward-exit nil - "Set search direction backward and exit minibuffer." - (interactive) - (setq tpu-searching-forward nil) - (tpu-set-search t) - (exit-minibuffer)) - - -;;; -;;; Select / Unselect -;;; -(defun tpu-select (&optional quiet) - "Set the mark to define one end of a region." - (interactive "P") - (cond ((tpu-mark) - (tpu-unselect quiet)) - (t - (tpu-set-mark (point)) - (tpu-update-mode-line) - (if (not quiet) (message "Move the text cursor to select text."))))) - -(defun tpu-unselect (&optional quiet) - "Remove the mark to unselect the current region." - (interactive "P") - (deactivate-mark) - (setq mark-ring nil) - (tpu-set-mark nil) - (tpu-update-mode-line) - (if (not quiet) (message "Selection canceled."))) - - -;;; -;;; Delete / Cut -;;; -(defun tpu-toggle-rectangle nil - "Toggle rectangular mode for remove and insert." - (interactive) - (setq tpu-rectangular-p (not tpu-rectangular-p)) - (setq tpu-rectangle-string (if tpu-rectangular-p " Rect" "")) - (tpu-update-mode-line) - (and (called-interactively-p 'interactive) - (message "Rectangular cut and paste %sabled." - (if tpu-rectangular-p "en" "dis")))) - -(defun tpu-arrange-rectangle nil - "Adjust point and mark to upper left and lower right corners of a rectangle." - (let ((mc (current-column)) - (pc (progn (exchange-point-and-mark) (current-column)))) - - (cond ((> (point) (tpu-mark)) ; point on lower line - (cond ((> pc mc) ; point @ lower-right - (exchange-point-and-mark)) ; point -> upper-left - - (t ; point @ lower-left - (move-to-column mc t) ; point -> lower-right - (exchange-point-and-mark) ; point -> upper-right - (move-to-column pc t)))) ; point -> upper-left - - (t ; point on upper line - (cond ((> pc mc) ; point @ upper-right - (move-to-column mc t) ; point -> upper-left - (exchange-point-and-mark) ; point -> lower-left - (move-to-column pc t) ; point -> lower-right - (exchange-point-and-mark))))))) ; point -> upper-left - -(defun tpu-cut-text nil - "Delete the selected region. -The text is saved for the tpu-paste command." - (interactive) - (cond ((tpu-mark) - (cond (tpu-rectangular-p - (tpu-arrange-rectangle) - (picture-clear-rectangle (point) (tpu-mark) (not overwrite-mode)) - (tpu-unselect t)) - (t - (setq tpu-last-deleted-region - (buffer-substring (tpu-mark) (point))) - (delete-region (tpu-mark) (point)) - (tpu-unselect t)))) - ((tpu-check-match) - (let ((beg (tpu-match-beginning)) (end (tpu-match-end))) - (setq tpu-last-deleted-region (buffer-substring beg end)) - (delete-region beg end) - (tpu-unset-match))) - (t - (tpu-error "No selection active.")))) - -(defun tpu-store-text nil - "Copy the selected region to the cut buffer without deleting it. -The text is saved for the tpu-paste command." - (interactive) - (cond ((tpu-mark) - (cond (tpu-rectangular-p - (save-excursion - (tpu-arrange-rectangle) - (setq picture-killed-rectangle - (extract-rectangle (point) (tpu-mark)))) - (tpu-unselect t)) - (t - (setq tpu-last-deleted-region - (buffer-substring (tpu-mark) (point))) - (tpu-unselect t)))) - ((tpu-check-match) - (setq tpu-last-deleted-region - (buffer-substring (tpu-match-beginning) (tpu-match-end))) - (tpu-unset-match)) - (t - (tpu-error "No selection active.")))) - -(defun tpu-cut (arg) - "Copy selected region to the cut buffer. -In the absence of an argument, delete the selected region too." - (interactive "P") - (if arg (tpu-store-text) (tpu-cut-text))) - -(defun tpu-append-region (arg) - "Append selected region to the tpu-cut buffer. -In the absence of an argument, delete the selected region too." - (interactive "P") - (cond ((tpu-mark) - (let ((beg (region-beginning)) (end (region-end))) - (setq tpu-last-deleted-region - (concat tpu-last-deleted-region - (buffer-substring beg end))) - (if (not arg) (delete-region beg end)) - (tpu-unselect t))) - ((tpu-check-match) - (let ((beg (tpu-match-beginning)) (end (tpu-match-end))) - (setq tpu-last-deleted-region - (concat tpu-last-deleted-region - (buffer-substring beg end))) - (if (not arg) (delete-region beg end)) - (tpu-unset-match))) - (t - (tpu-error "No selection active.")))) - -(defun tpu-delete-current-line (num) - "Delete one or specified number of lines after point. -This includes the newline character at the end of each line. -They are saved for the TPU-edt undelete-lines command." - (interactive "p") - (let ((beg (point))) - (forward-line num) - (if (not (eq (preceding-char) ?\n)) - (insert "\n")) - (setq tpu-last-deleted-lines - (buffer-substring beg (point))) - (delete-region beg (point)))) - -(defun tpu-delete-to-eol (num) - "Delete text up to end of line. -With argument, delete up to the Nth line-end past point. -They are saved for the TPU-edt undelete-lines command." - (interactive "p") - (let ((beg (point))) - (forward-char 1) - (end-of-line num) - (setq tpu-last-deleted-lines - (buffer-substring beg (point))) - (delete-region beg (point)))) - -(defun tpu-delete-to-bol (num) - "Delete text back to beginning of line. -With argument, delete up to the Nth line-end past point. -They are saved for the TPU-edt undelete-lines command." - (interactive "p") - (let ((beg (point))) - (tpu-next-beginning-of-line num) - (setq tpu-last-deleted-lines - (buffer-substring (point) beg)) - (delete-region (point) beg))) - -(defun tpu-delete-current-word (num) - "Delete one or specified number of words after point. -They are saved for the TPU-edt undelete-words command." - (interactive "p") - (let ((beg (point))) - (tpu-forward-to-word num) - (setq tpu-last-deleted-words - (buffer-substring beg (point))) - (delete-region beg (point)))) - -(defun tpu-delete-previous-word (num) - "Delete one or specified number of words before point. -They are saved for the TPU-edt undelete-words command." - (interactive "p") - (let ((beg (point))) - (tpu-backward-to-word num) - (setq tpu-last-deleted-words - (buffer-substring (point) beg)) - (delete-region beg (point)))) - -(defun tpu-delete-current-char (num) - "Delete one or specified number of characters after point. -The last character deleted is saved for the TPU-edt undelete-char command." - (interactive "p") - (while (and (> num 0) (not (eobp))) - (setq tpu-last-deleted-char (char-after (point))) - (cond (overwrite-mode - (picture-clear-column 1) - (forward-char 1)) - (t - (delete-char 1))) - (setq num (1- num)))) - - -;;; -;;; Undelete / Paste -;;; -(defun tpu-paste (num) - "Insert the last region or rectangle of killed text. -With argument reinserts the text that many times." - (interactive "p") - (while (> num 0) - (cond (tpu-rectangular-p - (let ((beg (point))) - (save-excursion - (picture-yank-rectangle (not overwrite-mode)) - (message "")) - (goto-char beg))) - (t - (insert tpu-last-deleted-region))) - (setq num (1- num)))) - -(defun tpu-undelete-lines (num) - "Insert lines deleted by last TPU-edt line-deletion command. -With argument reinserts lines that many times." - (interactive "p") - (let ((beg (point))) - (while (> num 0) - (insert tpu-last-deleted-lines) - (setq num (1- num))) - (goto-char beg))) - -(defun tpu-undelete-words (num) - "Insert words deleted by last TPU-edt word-deletion command. -With argument reinserts words that many times." - (interactive "p") - (let ((beg (point))) - (while (> num 0) - (insert tpu-last-deleted-words) - (setq num (1- num))) - (goto-char beg))) - -(defun tpu-undelete-char (num) - "Insert character deleted by last TPU-edt character-deletion command. -With argument reinserts the character that many times." - (interactive "p") - (while (> num 0) - (if overwrite-mode (prog1 (forward-char -1) (delete-char 1))) - (insert tpu-last-deleted-char) - (forward-char -1) - (setq num (1- num)))) - - -;;; -;;; Replace and Substitute -;;; -(defun tpu-replace nil - "Replace the selected region with the contents of the cut buffer." - (interactive) - (cond ((tpu-mark) - (let ((beg (region-beginning)) (end (region-end))) - (setq tpu-last-replaced-text (buffer-substring beg end)) - (delete-region beg end) - (insert tpu-last-deleted-region) - (tpu-unselect t))) - ((tpu-check-match) - (let ((beg (tpu-match-beginning)) (end (tpu-match-end))) - (setq tpu-last-replaced-text (buffer-substring beg end)) - (replace-match tpu-last-deleted-region - (not case-replace) (not tpu-regexp-p)) - (tpu-unset-match))) - (t - (tpu-error "No selection active.")))) - -(defun tpu-substitute (num) - "Replace the selected region with the contents of the cut buffer, -and repeat most recent search. A numeric argument serves as a repeat count. -A negative argument means replace all occurrences of the search string." - (interactive "p") - (cond ((or (tpu-mark) (tpu-check-match)) - (while (and (not (= num 0)) (or (tpu-mark) (tpu-check-match))) - (let ((beg (point))) - (tpu-replace) - (if tpu-searching-forward (forward-char -1) (goto-char beg)) - (if (= num 1) (tpu-search-internal tpu-search-last-string) - (tpu-search-internal-core tpu-search-last-string))) - (setq num (1- num)))) - (t - (tpu-error "No selection active.")))) - -(defun tpu-lm-replace (from to) - "Interactively search for OLD-string and substitute NEW-string." - (interactive (list (tpu-regexp-prompt "Old String: ") - (tpu-regexp-prompt "New String: "))) - - (let ((doit t) (strings 0)) - - ;; Can't replace null strings - (if (string= "" from) (tpu-error "No string to replace.")) - - ;; Find the first occurrence - (tpu-set-search) - (tpu-search-internal from t) - - ;; Loop on replace question - yes, no, all, last, or quit. - (while doit - (if (not (tpu-check-match)) (setq doit nil) - (progn - (move-overlay tpu-replace-overlay - (tpu-match-beginning) (tpu-match-end) (current-buffer)) - (message "Replace? Type Yes, No, All, Last, or Quit: ") - (let ((ans (read-char))) - - (cond ((or (= ans ?y) (= ans ?Y) (= ans ?\r) (= ans ?\ )) - (let ((beg (point))) - (replace-match to (not case-replace) (not tpu-regexp-p)) - (setq strings (1+ strings)) - (if tpu-searching-forward (forward-char -1) (goto-char beg))) - (tpu-search-internal from t)) - - ((or (= ans ?n) (= ans ?N) (= ans ?\C-?)) - (tpu-search-internal from t)) - - ((or (= ans ?a) (= ans ?A)) - (save-excursion - (let ((beg (point))) - (replace-match to (not case-replace) (not tpu-regexp-p)) - (setq strings (1+ strings)) - (if tpu-searching-forward (forward-char -1) (goto-char beg))) - (tpu-search-internal-core from t) - (while (tpu-check-match) - (let ((beg (point))) - (replace-match to (not case-replace) (not tpu-regexp-p)) - (setq strings (1+ strings)) - (if tpu-searching-forward (forward-char -1) (goto-char beg))) - (tpu-search-internal-core from t))) - (setq doit nil)) - - ((or (= ans ?l) (= ans ?L)) - (let ((beg (point))) - (replace-match to (not case-replace) (not tpu-regexp-p)) - (setq strings (1+ strings)) - (if tpu-searching-forward (forward-char -1) (goto-char beg))) - (setq doit nil)) - - ((or (= ans ?q) (= ans ?Q)) - (tpu-unset-match) - (setq doit nil))))))) - - (move-overlay tpu-replace-overlay 1 1 (current-buffer)) - (message "Replaced %s occurrence%s." strings (if (not (= 1 strings)) "s" "")))) - -(defun tpu-emacs-replace (&optional dont-ask) - "A TPU-edt interface to the Emacs replace functions. -If TPU-edt is currently in regular expression mode, the Emacs regular -expression replace functions are used. If an argument is supplied, -replacements are performed without asking. Only works in forward direction." - (interactive "P") - (cond (dont-ask - (setq current-prefix-arg nil) - (call-interactively - (if tpu-regexp-p 'replace-regexp 'replace-string))) - (t - (call-interactively - (if tpu-regexp-p 'query-replace-regexp 'query-replace))))) - -(defun tpu-add-at-bol (text) - "Add text to the beginning of each line in a region, -or each line in the entire buffer if no region is selected." - (interactive - (list (tpu-string-prompt "String to add: " 'tpu-add-at-bol-hist))) - (if (string= "" text) (tpu-error "No string specified.")) - (cond ((tpu-mark) - (save-excursion - (if (> (point) (tpu-mark)) (exchange-point-and-mark)) - (while (and (< (point) (tpu-mark)) (re-search-forward "^" (tpu-mark) t)) - (if (< (point) (tpu-mark)) (replace-match text)))) - (tpu-unselect t)) - (t - (save-excursion - (goto-char (point-min)) - (while (and (re-search-forward "^" nil t) (not (eobp))) - (replace-match text)))))) - -(defun tpu-add-at-eol (text) - "Add text to the end of each line in a region, -or each line of the entire buffer if no region is selected." - (interactive - (list (tpu-string-prompt "String to add: " 'tpu-add-at-eol-hist))) - (if (string= "" text) (tpu-error "No string specified.")) - (cond ((tpu-mark) - (save-excursion - (if (> (point) (tpu-mark)) (exchange-point-and-mark)) - (while (< (point) (tpu-mark)) - (end-of-line) - (if (<= (point) (tpu-mark)) (insert text)) - (forward-line))) - (tpu-unselect t)) - (t - (save-excursion - (goto-char (point-min)) - (while (not (eobp)) - (end-of-line) (insert text) (forward-line)))))) - -(defun tpu-trim-line-ends nil - "Remove trailing whitespace from every line in the buffer." - (interactive) - (save-match-data - (save-excursion - (goto-char (point-min)) - (while (re-search-forward "[ \t][ \t]*$" nil t) - (delete-region (match-beginning 0) (match-end 0)))))) - - -;;; -;;; Movement by character -;;; -(defun tpu-char (num) - "Move to the next character in the current direction. -A repeat count means move that many characters." - (interactive "p") - (if tpu-advance (tpu-forward-char num) (tpu-backward-char num))) - -(defun tpu-forward-char (num) - "Move right ARG characters (left if ARG is negative)." - (interactive "p") - (forward-char num)) - -(defun tpu-backward-char (num) - "Move left ARG characters (right if ARG is negative)." - (interactive "p") - (backward-char num)) - - -;;; -;;; Movement by word -;;; -(defvar tpu-word-separator-list '() - "List of additional word separators.") -(defvar tpu-skip-chars "^ \t" - "Characters to skip when moving by word. -Additional word separators are added to this string.") - -(defun tpu-word (num) - "Move to the beginning of the next word in the current direction. -A repeat count means move that many words." - (interactive "p") - (if tpu-advance (tpu-forward-to-word num) (tpu-backward-to-word num))) - -(defun tpu-forward-to-word (num) - "Move forward until encountering the beginning of a word. -With argument, do this that many times." - (interactive "p") - (while (and (> num 0) (not (eobp))) - (let* ((beg (point)) - (end (prog2 (end-of-line) (point) (goto-char beg)))) - (cond ((eolp) - (forward-char 1)) - ((memq (char-after (point)) tpu-word-separator-list) - (forward-char 1) - (skip-chars-forward " \t" end)) - (t - (skip-chars-forward tpu-skip-chars end) - (skip-chars-forward " \t" end)))) - (setq num (1- num)))) - -(defun tpu-backward-to-word (num) - "Move backward until encountering the beginning of a word. -With argument, do this that many times." - (interactive "p") - (while (and (> num 0) (not (bobp))) - (let* ((beg (point)) - (end (prog2 (beginning-of-line) (point) (goto-char beg)))) - (cond ((bolp) - ( forward-char -1)) - ((memq (char-after (1- (point))) tpu-word-separator-list) - (forward-char -1)) - (t - (skip-chars-backward " \t" end) - (skip-chars-backward tpu-skip-chars end) - (if (and (not (bolp)) (= ? (char-syntax (char-after (point))))) - (forward-char -1))))) - (setq num (1- num)))) - -(defun tpu-add-word-separators (separators) - "Add new word separators for TPU-edt word commands." - (interactive "sSeparators: ") - (let* ((n 0) (length (length separators))) - (while (< n length) - (let ((char (aref separators n)) - (ss (substring separators n (1+ n)))) - (cond ((not (memq char tpu-word-separator-list)) - (setq tpu-word-separator-list - (append ss tpu-word-separator-list)) - (cond ((= char ?-) - (setq tpu-skip-chars (concat tpu-skip-chars "\\-"))) - ((= char ?\\) - (setq tpu-skip-chars (concat tpu-skip-chars "\\\\"))) - ((= char ?^) - (setq tpu-skip-chars (concat tpu-skip-chars "\\^"))) - (t - (setq tpu-skip-chars (concat tpu-skip-chars ss)))))) - (setq n (1+ n)))))) - -(defun tpu-reset-word-separators nil - "Reset word separators to default value." - (interactive) - (setq tpu-word-separator-list nil) - (setq tpu-skip-chars "^ \t")) - -(defun tpu-set-word-separators (separators) - "Set new word separators for TPU-edt word commands." - (interactive "sSeparators: ") - (tpu-reset-word-separators) - (tpu-add-word-separators separators)) - - -;;; -;;; Movement by line -;;; -(defun tpu-next-line (num) - "Move to next line. -Prefix argument serves as a repeat count." - (interactive "p") - (line-move num) - (setq this-command 'next-line)) - -(defun tpu-previous-line (num) - "Move to previous line. -Prefix argument serves as a repeat count." - (interactive "p") - (line-move (- num)) - (setq this-command 'previous-line)) - -(defun tpu-next-beginning-of-line (num) - "Move to beginning of line; if at beginning, move to beginning of next line. -Accepts a prefix argument for the number of lines to move." - (interactive "p") - (backward-char 1) - (forward-visible-line (- 1 num))) - -(defun tpu-end-of-line (num) - "Move to the next end of line in the current direction. -A repeat count means move that many lines." - (interactive "p") - (if tpu-advance (tpu-next-end-of-line num) (tpu-previous-end-of-line num))) - -(defun tpu-next-end-of-line (num) - "Move to end of line; if at end, move to end of next line. -Accepts a prefix argument for the number of lines to move." - (interactive "p") - (forward-char 1) - (end-of-line num)) - -(defun tpu-previous-end-of-line (num) - "Move EOL upward. -Accepts a prefix argument for the number of lines to move." - (interactive "p") - (end-of-line (- 1 num))) - -(defun tpu-current-end-of-line nil - "Move point to end of current line." - (interactive) - (let ((beg (point))) - (end-of-line) - (if (= beg (point)) (message "You are already at the end of a line.")))) - -(defun tpu-line (num) - "Move to the beginning of the next line in the current direction. -A repeat count means move that many lines." - (interactive "p") - (if tpu-advance (tpu-forward-line num) (tpu-backward-line num))) - -(defun tpu-forward-line (num) - "Move to beginning of next line. -Prefix argument serves as a repeat count." - (interactive "p") - (forward-line num)) - -(defun tpu-backward-line (num) - "Move to beginning of previous line. -Prefix argument serves as repeat count." - (interactive "p") - (or (bolp) (>= 0 num) (setq num (- num 1))) - (forward-line (- num))) - - -;;; -;;; Movement by paragraph -;;; -(defun tpu-paragraph (num) - "Move to the next paragraph in the current direction. -A repeat count means move that many paragraphs." - (interactive "p") - (if tpu-advance - (tpu-next-paragraph num) (tpu-previous-paragraph num))) - -(defun tpu-next-paragraph (num) - "Move to beginning of the next paragraph. -Accepts a prefix argument for the number of paragraphs." - (interactive "p") - (beginning-of-line) - (while (and (not (eobp)) (> num 0)) - (if (re-search-forward "^[ \t]*$" nil t) - (if (re-search-forward "[^ \t\n]" nil t) - (goto-char (match-beginning 0)) - (goto-char (point-max)))) - (setq num (1- num))) - (beginning-of-line)) - - -(defun tpu-previous-paragraph (num) - "Move to beginning of previous paragraph. -Accepts a prefix argument for the number of paragraphs." - (interactive "p") - (end-of-line) - (while (and (not (bobp)) (> num 0)) - (if (not (and (re-search-backward "^[ \t]*$" nil t) - (re-search-backward "[^ \t\n]" nil t) - (re-search-backward "^[ \t]*$" nil t) - (progn (re-search-forward "[^ \t\n]" nil t) - (goto-char (match-beginning 0))))) - (goto-char (point-min))) - (setq num (1- num))) - (beginning-of-line)) - - -;;; -;;; Movement by page -;;; -(defun tpu-page (num) - "Move to the next page in the current direction. -A repeat count means move that many pages." - (interactive "p") - (if tpu-advance (forward-page num) (backward-page num)) - (if (eobp) (recenter -1))) - - -;;; -;;; Scrolling and movement within the buffer -;;; -(defun tpu-scroll-window (num) - "Scroll the display to the next section in the current direction. -A repeat count means scroll that many sections." - (interactive "p") - (if tpu-advance (tpu-scroll-window-up num) (tpu-scroll-window-down num))) - -(defun tpu-scroll-window-down (num) - "Scroll the display down to the next section. -A repeat count means scroll that many sections." - (interactive "p") - (let* ((beg (tpu-current-line)) - (height (1- (window-height))) - (lines (* num (/ (* height tpu-percent-scroll) 100)))) - (line-move (- lines)) - (if (> lines beg) (recenter 0)))) - -(defun tpu-scroll-window-up (num) - "Scroll the display up to the next section. -A repeat count means scroll that many sections." - (interactive "p") - (let* ((beg (tpu-current-line)) - (height (1- (window-height))) - (lines (* num (/ (* height tpu-percent-scroll) 100)))) - (line-move lines) - (if (>= (+ lines beg) height) (recenter -1)))) - -(defun tpu-pan-right (num) - "Pan right tpu-pan-columns (16 by default). -Accepts a prefix argument for the number of tpu-pan-columns to scroll." - (interactive "p") - (scroll-left (* tpu-pan-columns num))) - -(defun tpu-pan-left (num) - "Pan left tpu-pan-columns (16 by default). -Accepts a prefix argument for the number of tpu-pan-columns to scroll." - (interactive "p") - (scroll-right (* tpu-pan-columns num))) - -(defun tpu-move-to-beginning nil - "Move cursor to the beginning of buffer, but don't set the mark." - (interactive) - (goto-char (point-min))) - -(defun tpu-move-to-end nil - "Move cursor to the end of buffer, but don't set the mark." - (interactive) - (goto-char (point-max)) - (recenter -1)) - -(defun tpu-goto-percent (perc) - "Move point to ARG percentage of the buffer." - (interactive "NGoto-percentage: ") - (if (or (> perc 100) (< perc 0)) - (tpu-error "Percentage %d out of range 0 < percent < 100." perc) - (goto-char (/ (* (point-max) perc) 100)))) - -(defun tpu-beginning-of-window nil - "Move cursor to top of window." - (interactive) - (move-to-window-line 0)) - -(defun tpu-end-of-window nil - "Move cursor to bottom of window." - (interactive) - (move-to-window-line -1)) - -(defun tpu-line-to-bottom-of-window nil - "Move the current line to the bottom of the window." - (interactive) - (recenter -1)) - -(defun tpu-line-to-top-of-window nil - "Move the current line to the top of the window." - (interactive) - (recenter 0)) - - -;;; -;;; Direction -;;; -(defun tpu-advance-direction nil - "Set TPU Advance mode so keypad commands move forward." - (interactive) - (setq tpu-direction-string " Advance") - (setq tpu-advance t) - (setq tpu-reverse nil) - (tpu-set-search) - (tpu-update-mode-line)) - -(defun tpu-backup-direction nil - "Set TPU Backup mode so keypad commands move backward." - (interactive) - (setq tpu-direction-string " Reverse") - (setq tpu-advance nil) - (setq tpu-reverse t) - (tpu-set-search) - (tpu-update-mode-line)) - -(defun tpu-toggle-direction nil - "Change the current TPU direction." - (interactive) - (if tpu-advance (tpu-backup-direction) (tpu-advance-direction))) - - -;;; -;;; Minibuffer map additions to make KP_enter = RET -;;; -;; Standard Emacs settings under xterm in function-key-map map -;; "\eOM" to [kp-enter] and [kp-enter] to RET, but since the output of the map -;; is not fed back into the map, the key stays as kp-enter :-(. -(define-key minibuffer-local-map [kp-enter] 'exit-minibuffer) -;; These are not necessary because they are inherited. -;; (define-key minibuffer-local-ns-map [kp-enter] 'exit-minibuffer) -;; (define-key minibuffer-local-completion-map [kp-enter] 'exit-minibuffer) -(define-key minibuffer-local-must-match-map [kp-enter] 'minibuffer-complete-and-exit) - - -;;; -;;; Minibuffer map additions to set search direction -;;; -(define-key minibuffer-local-map [kp-4] 'tpu-search-forward-exit) ;KP4 -(define-key minibuffer-local-map [kp-5] 'tpu-search-backward-exit) ;KP5 - - -;;; -;;; Functions to set, reset, and toggle the control key bindings -;;; - -(defvar tpu-control-keys-map - (let ((map (make-sparse-keymap))) - (define-key map "\C-\\" 'quoted-insert) ; ^\ - (define-key map "\C-a" 'tpu-toggle-overwrite-mode) ; ^A - (define-key map "\C-b" 'repeat-complex-command) ; ^B - (define-key map "\C-e" 'tpu-current-end-of-line) ; ^E - (define-key map "\C-h" 'tpu-next-beginning-of-line) ; ^H (BS) - (define-key map "\C-j" 'tpu-delete-previous-word) ; ^J (LF) - (define-key map "\C-k" 'tpu-define-macro-key) ; ^K - (define-key map "\C-l" 'tpu-insert-formfeed) ; ^L (FF) - (define-key map "\C-r" 'recenter) ; ^R - (define-key map "\C-u" 'tpu-delete-to-bol) ; ^U - (define-key map "\C-v" 'tpu-quoted-insert) ; ^V - (define-key map "\C-w" 'redraw-display) ; ^W - (define-key map "\C-z" 'tpu-exit) ; ^Z - map)) - -(defun tpu-set-control-keys () - "Set control keys to TPU style functions." - (tpu-reset-control-keys 'tpu)) - -(defun tpu-reset-control-keys (tpu-style) - "Set control keys to TPU or Emacs style functions." - (let ((parent (keymap-parent tpu-global-map))) - (if tpu-style - (if (eq parent tpu-control-keys-map) - nil ;All done already. - ;; Insert tpu-control-keys-map in the global map. - (set-keymap-parent tpu-control-keys-map parent) - (set-keymap-parent tpu-global-map tpu-control-keys-map)) - (if (not (eq parent tpu-control-keys-map)) - nil ;All done already. - ;; Remove tpu-control-keys-map from the global map. - (set-keymap-parent tpu-global-map (keymap-parent parent)) - (set-keymap-parent tpu-control-keys-map nil))) - (setq tpu-control-keys tpu-style))) - -(defun tpu-toggle-control-keys nil - "Toggle control key bindings between TPU-edt and Emacs." - (interactive) - (tpu-reset-control-keys (not tpu-control-keys)) - (and (called-interactively-p 'interactive) - (message "Control keys function with %s bindings." - (if tpu-control-keys "TPU-edt" "Emacs")))) - - -;;; -;;; Emacs version 19 minibuffer history support -;;; -(defun tpu-next-history-element (n) - "Insert the next element of the minibuffer history into the minibuffer." - (interactive "p") - (next-history-element n) - (goto-char (point-max))) - -(defun tpu-previous-history-element (n) - "Insert the previous element of the minibuffer history into the minibuffer." - (interactive "p") - (previous-history-element n) - (goto-char (point-max))) - -(defun tpu-arrow-history nil - "Modify minibuffer maps to use arrows for history recall." - (interactive) - (dolist (cur (where-is-internal 'tpu-previous-line)) - (define-key read-expression-map cur 'tpu-previous-history-element) - (define-key minibuffer-local-map cur 'tpu-previous-history-element) - ;; These are inherited anyway. --Stef - ;; (define-key minibuffer-local-ns-map cur 'tpu-previous-history-element) - ;; (define-key minibuffer-local-completion-map cur 'tpu-previous-history-element) - ;; (define-key minibuffer-local-must-match-map cur 'tpu-previous-history-element) - ) - - (dolist (cur (where-is-internal 'tpu-next-line)) - (define-key read-expression-map cur 'tpu-next-history-element) - (define-key minibuffer-local-map cur 'tpu-next-history-element) - ;; These are inherited anyway. --Stef - ;; (define-key minibuffer-local-ns-map cur 'tpu-next-history-element) - ;; (define-key minibuffer-local-completion-map cur 'tpu-next-history-element) - ;; (define-key minibuffer-local-must-match-map cur 'tpu-next-history-element) - )) - - -;;; -;;; Emacs version 19 X-windows key definition support -;;; -(defun tpu-load-xkeys (file) - "Load the TPU-edt X-windows key definitions FILE. -If FILE is nil, try to load a default file. The default file names are -`~/.tpu-lucid-keys' for XEmacs, and `~/.tpu-keys' for Emacs." - (interactive "fX key definition file: ") - (cond (file - (setq file (expand-file-name file))) - (tpu-xkeys-file - (setq file (expand-file-name tpu-xkeys-file))) - ((featurep 'xemacs) - (setq file (convert-standard-filename - (expand-file-name "~/.tpu-lucid-keys")))) - (t - (setq file (convert-standard-filename - (expand-file-name "~/.tpu-keys"))) - (and (not (file-exists-p file)) - (file-exists-p - (convert-standard-filename - (expand-file-name "~/.tpu-gnu-keys"))) - (tpu-copy-keyfile - (convert-standard-filename - (expand-file-name "~/.tpu-gnu-keys")) file)))) - (cond ((file-readable-p file) - (load-file file)) - (t - ;; This used to force the user to build `file'. With the - ;; new code, such a file may not be necessary. In case it - ;; is, issue a message giving a hint as to how to build it. - (message "%s not found: use M-x tpu-mapper to create it" - (abbreviate-file-name file))))) - -(defun tpu-copy-keyfile (oldname newname) - "Copy the TPU-edt X key definitions file to the new default name." - (interactive "fOld name: \nFNew name: ") - (if (not (get-buffer "*TPU-Notice*")) (generate-new-buffer "*TPU-Notice*")) - (set-buffer "*TPU-Notice*") - (erase-buffer) - (insert " - NOTICE -- - - The default name of the TPU-edt key definition file has changed - from `~/.tpu-gnu-keys' to `~/.tpu-keys'. With your permission, - your key definitions will be copied to the new file. If you'll - never use older versions of Emacs, you can remove the old file. - If the copy fails, you'll be asked if you want to create a new - key definitions file. Do you want to copy your key definition - file now? - ") - (save-window-excursion - (switch-to-buffer-other-window "*TPU-Notice*") - (shrink-window-if-larger-than-buffer) - (goto-char (point-min)) - (beep) - (and (tpu-y-or-n-p "Copy key definitions to the new file now? ") - (with-demoted-errors "Sorry, couldn't copy - %s." - (copy-file oldname newname))) - (kill-buffer "*TPU-Notice*"))) - -(defvar tpu-edt-old-global-values nil) - -;;; -;;; Start and Stop TPU-edt -;;; -;;;###autoload -(defun tpu-edt-on () - "Turn on TPU/edt emulation." - (interactive) - ;; To clean things up (and avoid cycles in the global map). - (tpu-edt-off) - ;; First, activate tpu-global-map, while protecting the original keymap. - (set-keymap-parent tpu-global-map global-map) - (setq global-map tpu-global-map) - (use-global-map global-map) - ;; Then do the normal TPU setup. - (transient-mark-mode t) - (add-hook 'post-command-hook 'tpu-search-highlight) - (tpu-set-mode-line t) - (tpu-advance-direction) - ;; set page delimiter, display line truncation, and scrolling like TPU - (dolist (varval '((page-delimiter . "\f") - (truncate-lines . t) - (scroll-step . 1))) - (push (cons (car varval) (default-value (car varval))) - tpu-edt-old-global-values) - (set-default (car varval) (cdr varval))) - (tpu-set-control-keys) - (and window-system (tpu-load-xkeys nil)) - (tpu-arrow-history) - ;; Then protect tpu-global-map from user modifications. - (let ((map (make-sparse-keymap))) - (set-keymap-parent map global-map) - (setq global-map map) - (use-global-map map)) - (setq tpu-edt-mode t)) - -(defun tpu-edt-off () - "Turn off TPU/edt emulation. Note that the keypad is left on." - (interactive) - (tpu-reset-control-keys nil) - (remove-hook 'post-command-hook 'tpu-search-highlight) - (tpu-set-mode-line nil) - (while tpu-edt-old-global-values - (let ((varval (pop tpu-edt-old-global-values))) - (set-default (car varval) (cdr varval)))) - ;; Remove tpu-global-map from the global map. - (let ((map global-map)) - (while map - (let ((parent (keymap-parent map))) - (if (eq tpu-global-map parent) - (set-keymap-parent map (keymap-parent parent)) - (setq map parent))))) - ;; Only has an effect if the advice in tpu-extras has been activated. - (condition-case nil - (with-no-warnings (ad-disable-regexp "\\`tpu-")) - (error nil)) - (setq tpu-edt-mode nil)) - - -;;;### (autoloads nil "tpu-extras" "tpu-extras.el" "cbbb448cff48fab904ac19805aa6f36a") -;;; Generated autoloads from tpu-extras.el - -(autoload 'tpu-cursor-free-mode "tpu-extras" "\ -Minor mode to allow the cursor to move freely about the screen. -With a prefix argument ARG, enable the mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable the mode -if ARG is omitted or nil. - -\(fn &optional ARG)" t nil) - -(autoload 'tpu-set-scroll-margins "tpu-extras" "\ -Set scroll margins. - -\(fn TOP BOTTOM)" t nil) - -(autoload 'tpu-set-cursor-free "tpu-extras" "\ -Allow the cursor to move freely about the screen. - -\(fn)" t nil) - -(autoload 'tpu-set-cursor-bound "tpu-extras" "\ -Constrain the cursor to the flow of the text. - -\(fn)" t nil) - -;;;*** - -(provide 'tpu-edt) - -;;; tpu-edt.el ends here diff --git a/lisp/emulation/tpu-extras.el b/lisp/emulation/tpu-extras.el deleted file mode 100644 index 9ebaaf6ffce..00000000000 --- a/lisp/emulation/tpu-extras.el +++ /dev/null @@ -1,445 +0,0 @@ -;;; 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 -;; Maintainer: Rob Riepel -;; 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 . - -;;; Commentary: - -;; Use the functions defined here to customize TPU-edt to your tastes by -;; setting scroll margins and/or turning on free cursor mode. Here's an -;; example for your init file. - -;; (tpu-set-cursor-free) ; Set cursor free. -;; (tpu-set-scroll-margins "10%" "15%") ; Set scroll margins. - -;; Scroll margins and cursor binding can be changed from within emacs using -;; the following commands: - -;; tpu-set-scroll-margins or set scroll margins -;; tpu-set-cursor-bound or set cursor bound -;; tpu-set-cursor-free or set cursor free - -;; Additionally, Gold-F toggles between bound and free cursor modes. - -;; Note that switching out of free cursor mode or exiting TPU-edt while in -;; free cursor mode strips trailing whitespace from every line in the file. - - -;;; Details: - -;; The functions contained in this file implement scroll margins and free -;; cursor mode. The following keys and commands are affected. - -;; key/command function scroll cursor - -;; Up-Arrow previous line x x -;; Down-Arrow next line x x -;; Right-Arrow next character x -;; Left-Arrow previous character x -;; KP0 next or previous line x -;; KP7 next or previous page x -;; KP8 next or previous screen x -;; KP2 next or previous end-of-line x x -;; Control-e current end-of-line x -;; Control-h previous beginning-of-line x -;; Next Scr next screen x -;; Prev Scr previous screen x -;; Search find a string x -;; Replace find and replace a string x -;; Newline insert a newline x -;; Paragraph next or previous paragraph x -;; Auto-Fill break lines on spaces x - -;; These functions are not part of the base TPU-edt for the following -;; reasons: - -;; Free cursor mode is implemented with the emacs picture-mode functions. -;; These functions support moving the cursor all over the screen, however, -;; when the cursor is moved past the end of a line, spaces or tabs are -;; appended to the line - even if no text is entered in that area. In -;; order for a free cursor mode to work exactly like TPU/edt, this trailing -;; whitespace needs to be dealt with in every function that might encounter -;; it. Such global changes are impractical, however, free cursor mode is -;; too valuable to abandon completely, so it has been implemented in those -;; functions where it serves best. - -;; The implementation of scroll margins adds overhead to previously -;; simple and often used commands. These commands are now responsible -;; for their normal operation and part of the display function. There -;; is a possibility that this display overhead could adversely affect the -;; performance of TPU-edt on slower computers. In order to support the -;; widest range of computers, scroll margin support is optional. - -;; It's actually not known whether the overhead associated with scroll -;; margin support is significant. If you find that it is, please send -;; a note describing the extent of the performance degradation. Be sure -;; to include a description of the platform where you're running TPU-edt. -;; Send your note to the address provided by Gold-V. - -;; Even with these differences and limitations, these functions implement -;; important aspects of the real TPU/edt. Those who miss free cursor mode -;; and/or scroll margins will appreciate these implementations. - -;;; Code: - - -;;; Gotta have tpu-edt - -(require 'tpu-edt) - - -;;; Customization variables - -(defcustom tpu-top-scroll-margin 0 - "Scroll margin at the top of the screen. -Interpreted as a percent of the current window size." - :type 'integer - :group 'tpu) -(defcustom tpu-bottom-scroll-margin 0 - "Scroll margin at the bottom of the screen. -Interpreted as a percent of the current window size." - :type 'integer - :group 'tpu) - -(defcustom tpu-backward-char-like-tpu t - "If non-nil, in free cursor mode backward-char (left-arrow) works -just like TPU/edt. Otherwise, backward-char will move to the end of -the previous line when starting from a line beginning." - :type 'boolean - :group 'tpu) - - -;;; Global variables - -;;;###autoload -(define-minor-mode tpu-cursor-free-mode - "Minor mode to allow the cursor to move freely about the screen. -With a prefix argument ARG, enable the mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable the mode -if ARG is omitted or nil." - :init-value nil - (if (not tpu-cursor-free-mode) - (tpu-trim-line-ends)) - (if (not tpu-cursor-free-mode) - (message "The cursor is now bound to the flow of your text.") - (message "The cursor will now move freely about the screen."))) - - -;;; Hooks -- Set cursor free in picture mode. -;;; Clean up when writing a file from cursor free mode. - -(add-hook 'picture-mode-hook 'tpu-set-cursor-free) - -(defun tpu-trim-line-ends-if-needed () - "Eliminate whitespace at ends of lines, if the cursor is free." - (if (and (buffer-modified-p) tpu-cursor-free-mode) (tpu-trim-line-ends))) -(add-hook 'before-save-hook 'tpu-trim-line-ends-if-needed) - - -;;; Utility routines for implementing scroll margins - -(defun tpu-top-check (beg lines) - "Enforce scroll margin at the top of screen." - (let ((margin (/ (* (window-height) tpu-top-scroll-margin) 100))) - (cond ((< beg margin) (recenter beg)) - ((< (- beg lines) margin) (recenter margin))))) - -(defun tpu-bottom-check (beg lines) - "Enforce scroll margin at the bottom of screen." - (let* ((height (window-height)) - (margin (+ 1 (/ (* height tpu-bottom-scroll-margin) 100))) - ;; subtract 1 from height because it includes mode line - (difference (- height margin 1))) - (cond ((> beg difference) (recenter beg)) - ((> (+ beg lines) difference) (recenter (- margin)))))) - - -;;; Movement by character - -(defun tpu-forward-char (num) - "Move right ARG characters (left if ARG is negative)." - (interactive "p") - (if tpu-cursor-free-mode (picture-forward-column num) (forward-char num))) - -(defun tpu-backward-char (num) - "Move left ARG characters (right if ARG is negative)." - (interactive "p") - (cond ((not tpu-cursor-free-mode) - (backward-char num)) - (tpu-backward-char-like-tpu - (picture-backward-column num)) - ((bolp) - (backward-char 1) - (picture-end-of-line) - (picture-backward-column (1- num))) - (t - (picture-backward-column num)))) - - -;;; Movement by line - -(defun tpu-next-line (num) - "Move to next line. -Prefix argument serves as a repeat count." - (interactive "p") - (let ((beg (tpu-current-line))) - (if tpu-cursor-free-mode (or (eobp) (picture-move-down num)) - (line-move num)) - (tpu-bottom-check beg num) - (setq this-command 'next-line))) - -(defun tpu-previous-line (num) - "Move to previous line. -Prefix argument serves as a repeat count." - (interactive "p") - (let ((beg (tpu-current-line))) - (if tpu-cursor-free-mode (picture-move-up num) (line-move (- num))) - (tpu-top-check beg num) - (setq this-command 'previous-line))) - -(defun tpu-next-beginning-of-line (num) - "Move to beginning of line; if at beginning, move to beginning of next line. -Accepts a prefix argument for the number of lines to move." - (interactive "p") - (let ((beg (tpu-current-line))) - (backward-char 1) - (forward-visible-line (- 1 num)) - (tpu-top-check beg num))) - -(defun tpu-next-end-of-line (num) - "Move to end of line; if at end, move to end of next line. -Accepts a prefix argument for the number of lines to move." - (interactive "p") - (let ((beg (tpu-current-line))) - (cond (tpu-cursor-free-mode - (let ((beg (point))) - (if (< 1 num) (forward-line num)) - (picture-end-of-line) - (if (<= (point) beg) (progn (forward-line) (picture-end-of-line))))) - (t - (forward-char) - (end-of-line num))) - (tpu-bottom-check beg num))) - -(defun tpu-previous-end-of-line (num) - "Move EOL upward. -Accepts a prefix argument for the number of lines to move." - (interactive "p") - (let ((beg (tpu-current-line))) - (cond (tpu-cursor-free-mode - (picture-end-of-line (- 1 num))) - (t - (end-of-line (- 1 num)))) - (tpu-top-check beg num))) - -(defun tpu-current-end-of-line () - "Move point to end of current line." - (interactive) - (let ((beg (point))) - (if tpu-cursor-free-mode (picture-end-of-line) (end-of-line)) - (if (= beg (point)) (message "You are already at the end of a line.")))) - -(defun tpu-forward-line (num) - "Move to beginning of next line. -Prefix argument serves as a repeat count." - (interactive "p") - (let ((beg (tpu-current-line))) - (forward-line num) - (tpu-bottom-check beg num))) - -(defun tpu-backward-line (num) - "Move to beginning of previous line. -Prefix argument serves as repeat count." - (interactive "p") - (let ((beg (tpu-current-line))) - (or (bolp) (>= 0 num) (setq num (- num 1))) - (forward-line (- num)) - (tpu-top-check beg num))) - - -;;; Movement by paragraph - -;; Cf edt-with-position. -(defmacro tpu-with-position (&rest body) - "Execute BODY with some position-related variables bound." - `(let* ((left nil) - (beg (tpu-current-line)) - (height (window-height)) - (top-percent - (if (zerop tpu-top-scroll-margin) 10 tpu-top-scroll-margin)) - (bottom-percent - (if (zerop tpu-bottom-scroll-margin) 15 tpu-bottom-scroll-margin)) - (top-margin (/ (* height top-percent) 100)) - (bottom-up-margin (1+ (/ (* height bottom-percent) 100))) - (bottom-margin (max beg (- height bottom-up-margin 1))) - (top (save-excursion (move-to-window-line top-margin) (point))) - (bottom (save-excursion (move-to-window-line bottom-margin) (point))) - (far (save-excursion - (goto-char bottom) - (point-at-bol (1- height))))) - ,@body)) - -(defun tpu-paragraph (num) - "Move to the next paragraph in the current direction. -A repeat count means move that many paragraphs." - (interactive "p") - (tpu-with-position - (if tpu-advance - (progn - (tpu-next-paragraph num) - (if (> (point) far) - (if (zerop (setq left (save-excursion (forward-line height)))) - (recenter top-margin) - (recenter (- left bottom-up-margin))) - (and (> (point) bottom) (recenter bottom-margin)))) - (tpu-previous-paragraph num) - (and (< (point) top) (recenter (min beg top-margin)))))) - -;;; Movement by page - -(defun tpu-page (num) - "Move to the next page in the current direction. -A repeat count means move that many pages." - (interactive "p") - (tpu-with-position - (if tpu-advance - (progn - (forward-page num) - (if (> (point) far) - (if (zerop (setq left (save-excursion (forward-line height)))) - (recenter top-margin) - (recenter (- left bottom-up-margin))) - (and (> (point) bottom) (recenter bottom-margin)))) - (backward-page num) - (and (< (point) top) (recenter (min beg top-margin)))))) - -;;; Scrolling - -(defun tpu-scroll-window-down (num) - "Scroll the display down to the next section. -A repeat count means scroll that many sections." - (interactive "p") - (let* ((beg (tpu-current-line)) - (height (1- (window-height))) - (lines (* num (/ (* height tpu-percent-scroll) 100)))) - (line-move (- lines)) - (tpu-top-check beg lines))) - -(defun tpu-scroll-window-up (num) - "Scroll the display up to the next section. -A repeat count means scroll that many sections." - (interactive "p") - (let* ((beg (tpu-current-line)) - (height (1- (window-height))) - (lines (* num (/ (* height tpu-percent-scroll) 100)))) - (line-move lines) - (tpu-bottom-check beg lines))) - - -;;; Replace the TPU-edt internal search function - -(defun tpu-search-internal (pat &optional quiet) - "Search for a string or regular expression." - (tpu-with-position - (tpu-search-internal-core pat quiet) - (if tpu-searching-forward - (progn - (if (> (point) far) - (if (zerop (setq left (save-excursion (forward-line height)))) - (recenter top-margin) - (recenter (- left bottom-up-margin))) - (and (> (point) bottom) (recenter bottom-margin)))) - (and (< (point) top) (recenter (min beg top-margin)))))) - -;; Advise the newline, newline-and-indent, and do-auto-fill functions. -(defadvice newline (around tpu-respect-bottom-scroll-margin activate disable) - "Respect `tpu-bottom-scroll-margin'." - (let ((beg (tpu-current-line)) - (num (prefix-numeric-value (ad-get-arg 0)))) - ad-do-it - (tpu-bottom-check beg num))) - -(defadvice newline-and-indent (around tpu-respect-bottom-scroll-margin) - "Respect `tpu-bottom-scroll-margin'." - (let ((beg (tpu-current-line))) - ad-do-it - (tpu-bottom-check beg 1))) - -(defadvice do-auto-fill (around tpu-respect-bottom-scroll-margin) - "Respect `tpu-bottom-scroll-margin'." - (let ((beg (tpu-current-line))) - ad-do-it - (tpu-bottom-check beg 1))) - - -;;; Function to set scroll margins - -;;;###autoload -(defun tpu-set-scroll-margins (top bottom) - "Set scroll margins." - (interactive - "sEnter top scroll margin (N lines or N%% or RETURN for current value): \ -\nsEnter bottom scroll margin (N lines or N%% or RETURN for current value): ") - ;; set top scroll margin - (or (string= top "") - (setq tpu-top-scroll-margin - (if (string= "%" (substring top -1)) - (string-to-number top) - (/ (1- (+ (* (string-to-number top) 100) (window-height))) - (window-height))))) - ;; set bottom scroll margin - (or (string= bottom "") - (setq tpu-bottom-scroll-margin - (if (string= "%" (substring bottom -1)) - (string-to-number bottom) - (/ (1- (+ (* (string-to-number bottom) 100) (window-height))) - (window-height))))) - (dolist (f '(newline newline-and-indent do-auto-fill)) - (ad-enable-advice f 'around 'tpu-respect-bottom-scroll-margin) - (ad-activate f)) - ;; report scroll margin settings if running interactively - (and (called-interactively-p 'interactive) - (message "Scroll margins set. Top = %s%%, Bottom = %s%%" - tpu-top-scroll-margin tpu-bottom-scroll-margin))) - - -;;; Functions to set cursor bound or free - -;;;###autoload -(defun tpu-set-cursor-free () - "Allow the cursor to move freely about the screen." - (interactive) - (tpu-cursor-free-mode 1)) - -;;;###autoload -(defun tpu-set-cursor-bound () - "Constrain the cursor to the flow of the text." - (interactive) - (tpu-cursor-free-mode -1)) - -(provide 'tpu-extras) - -;; Local Variables: -;; generated-autoload-file: "tpu-edt.el" -;; End: - -;;; tpu-extras.el ends here diff --git a/lisp/emulation/tpu-mapper.el b/lisp/emulation/tpu-mapper.el deleted file mode 100644 index 2479389ac3c..00000000000 --- a/lisp/emulation/tpu-mapper.el +++ /dev/null @@ -1,352 +0,0 @@ -;;; tpu-mapper.el --- create a TPU-edt X-windows keymap file - -;; Copyright (C) 1993-1995, 2001-2014 Free Software Foundation, Inc. - -;; Author: Rob Riepel -;; Maintainer: Rob Riepel -;; 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 . - -;;; 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 for future reference - - (cond - ((featurep 'xemacs) - (setq tpu-return-seq (read-key-sequence "Hit carriage-return to continue ")) - (setq tpu-return (concat "[" (format "%s" (event-key (aref tpu-return-seq 0))) "]"))) - (t - (message "Hit carriage-return 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 \"[#]\")\n") - (insert "(setq tpu-help-n \"[#]\")\n") - (insert "(setq tpu-help-P \"[#]\")\n") - (insert "(setq tpu-help-p \"[#]\")\n")) - (t - (insert (format "(setq tpu-help-enter \"%s\")\n" tpu-enter)))) - - (append-to-buffer "Keys" 1 (point)) - (set-buffer "Keys") - - ;; Save the key mapping program - - (let ((file - (convert-standard-filename - (if (featurep 'xemacs) "~/.tpu-lucid-keys" "~/.tpu-keys")))) - (set-visited-file-name - (read-file-name (format "Save key mapping to file (default %s): " file) "" file))) - (save-buffer) - - ;; Load the newly defined keys and clean up - - (require 'tpu-edt) - (eval-buffer) - (kill-buffer (current-buffer)) - (kill-buffer "*scratch*") - (kill-buffer "Gold-Keys") - - ;; Let them know it worked. - - (switch-to-buffer "Directions") - (erase-buffer) - (insert " - A custom TPU-edt keymap file has been created. - - Press GOLD-k to remove this buffer and continue editing. -") - (goto-char (point-min))) - -;;; tpu-mapper.el ends here diff --git a/lisp/emulation/vi.el b/lisp/emulation/vi.el deleted file mode 100644 index 9aae40c0d00..00000000000 --- a/lisp/emulation/vi.el +++ /dev/null @@ -1,1492 +0,0 @@ -;;; 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 -;; Felix S. T. Wu -;; 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)) - -(defun vi-switch-mode (arg mode-char) - "Switch the major mode of current buffer as specified by the following char \\{vi-tilde-map}" - (interactive "P\nc") - (let ((mode-cmd (lookup-key vi-tilde-map (char-to-string mode-char)))) - (if (null mode-cmd) - (with-output-to-temp-buffer "*Help*" - (princ (substitute-command-keys "Possible major modes to switch to: \\{vi-tilde-map}")) - (with-current-buffer standard-output - (help-mode))) - (setq prefix-arg arg) ; prefix arg will be passed down - (command-execute mode-cmd nil) ; may need to save mode-line-format etc - (force-mode-line-update)))) ; just in case - - -(defun vi-debugging (arg) - "Toggle debug-on-error flag. If prefix arg is given, set t." - (interactive "P") - (if arg - (setq debug-on-error t) - (setq debug-on-error (not debug-on-error))) - (if debug-on-error - (message "Debug-on-error ...") - (message "NO more debug-on-error"))) - -(defun vi-back-to-old-mode () - "Go back to the previous mode without setting up for insertion." - (interactive) - (if vi-mode-old-major-mode - (progn - (setq mode-name vi-mode-old-mode-name) - (use-local-map vi-mode-old-local-map) - (setq major-mode vi-mode-old-major-mode) - (setq case-fold-search vi-mode-old-case-fold) - (force-mode-line-update)))) - -(defun vi-readonly-mode () - "Toggle current buffer's readonly flag." - (interactive) - (setq buffer-read-only (not buffer-read-only))) - -(defvar vi-com-map nil - "Keymap used in Evi's command state -Command state includes most of the vi editing commands, with some Emacs -command extensions.") - -(put 'vi-undefined 'suppress-keymap t) -(if vi-com-map nil - (setq vi-com-map (make-keymap)) -;;(fillarray vi-com-map 'vi-undefined) - (define-key vi-com-map "\C-@" 'vi-mark-region) ; extension - (define-key vi-com-map "\C-a" 'vi-ask-for-info) ; extension - (define-key vi-com-map "\C-b" 'vi-backward-windowful) - (define-key vi-com-map "\C-c" 'vi-do-old-mode-C-c-command) ; extension - (define-key vi-com-map "\C-d" 'vi-scroll-down-window) - (define-key vi-com-map "\C-e" 'vi-expose-line-below) - (define-key vi-com-map "\C-f" 'vi-forward-windowful) - (define-key vi-com-map "\C-g" 'keyboard-quit) - (define-key vi-com-map "\C-i" 'indent-relative-maybe) ; TAB - (define-key vi-com-map "\C-j" 'vi-next-line) ; LFD - (define-key vi-com-map "\C-k" 'vi-kill-line) ; extension - (define-key vi-com-map "\C-l" 'recenter) - (define-key vi-com-map "\C-m" 'vi-next-line-first-nonwhite) ; RET - (define-key vi-com-map "\C-n" 'vi-next-line) - (define-key vi-com-map "\C-o" 'vi-split-open-line) - (define-key vi-com-map "\C-p" 'previous-line) - (define-key vi-com-map "\C-q" 'vi-query-replace) ; extension - (define-key vi-com-map "\C-r" 'vi-isearch-backward) ; modification - (define-key vi-com-map "\C-s" 'vi-isearch-forward) ; extension - (define-key vi-com-map "\C-t" 'vi-transpose-objects) ; extension - (define-key vi-com-map "\C-u" 'vi-scroll-up-window) - (define-key vi-com-map "\C-v" 'scroll-up-command) ; extension - (define-key vi-com-map "\C-w" 'vi-kill-region) ; extension - (define-key vi-com-map "\C-x" 'Control-X-prefix) ; extension - (define-key vi-com-map "\C-y" 'vi-expose-line-above) - (define-key vi-com-map "\C-z" 'suspend-emacs) - - (define-key vi-com-map "\e" 'ESC-prefix); C-[ (ESC) - (define-key vi-com-map "\C-\\" 'vi-unimplemented) - (define-key vi-com-map "\C-]" 'find-tag) - (define-key vi-com-map "\C-^" 'vi-locate-def) ; extension - (define-key vi-com-map "\C-_" 'vi-undefined) - - (define-key vi-com-map " " 'forward-char) - (define-key vi-com-map "!" 'vi-operator) - (define-key vi-com-map "\"" 'vi-char-argument) - (define-key vi-com-map "#" 'universal-argument) ; extension - (define-key vi-com-map "$" 'end-of-line) - (define-key vi-com-map "%" 'vi-find-matching-paren) - (define-key vi-com-map "&" 'vi-unimplemented) - (define-key vi-com-map "'" 'vi-goto-line-mark) - (define-key vi-com-map "(" 'backward-sexp) - (define-key vi-com-map ")" 'forward-sexp) - (define-key vi-com-map "*" 'vi-name-last-change-or-macro) ; extension - (define-key vi-com-map "+" 'vi-next-line-first-nonwhite) - (define-key vi-com-map "," 'vi-reverse-last-find-char) - (define-key vi-com-map "-" 'vi-previous-line-first-nonwhite) - (define-key vi-com-map "." 'vi-redo-last-change-command) - (define-key vi-com-map "/" 'vi-search-forward) - (define-key vi-com-map "0" 'beginning-of-line) - - (define-key vi-com-map "1" 'vi-digit-argument) - (define-key vi-com-map "2" 'vi-digit-argument) - (define-key vi-com-map "3" 'vi-digit-argument) - (define-key vi-com-map "4" 'vi-digit-argument) - (define-key vi-com-map "5" 'vi-digit-argument) - (define-key vi-com-map "6" 'vi-digit-argument) - (define-key vi-com-map "7" 'vi-digit-argument) - (define-key vi-com-map "8" 'vi-digit-argument) - (define-key vi-com-map "9" 'vi-digit-argument) - - (define-key vi-com-map ":" 'vi-ex-cmd) - (define-key vi-com-map ";" 'vi-repeat-last-find-char) - (define-key vi-com-map "<" 'vi-operator) - (define-key vi-com-map "=" 'vi-operator) - (define-key vi-com-map ">" 'vi-operator) - (define-key vi-com-map "?" 'vi-search-backward) - (define-key vi-com-map "@" 'vi-call-named-change-or-macro) ; extension - - (define-key vi-com-map "A" 'vi-append-at-end-of-line) - (define-key vi-com-map "B" 'vi-backward-blank-delimited-word) - (define-key vi-com-map "C" 'vi-change-rest-of-line) - (define-key vi-com-map "D" 'vi-kill-line) - (define-key vi-com-map "E" 'vi-end-of-blank-delimited-word) - (define-key vi-com-map "F" 'vi-backward-find-char) - (define-key vi-com-map "G" 'vi-goto-line) - (define-key vi-com-map "H" 'vi-home-window-line) - (define-key vi-com-map "I" 'vi-insert-before-first-nonwhite) - (define-key vi-com-map "J" 'vi-join-lines) - (define-key vi-com-map "K" 'vi-undefined) - (define-key vi-com-map "L" 'vi-last-window-line) - (define-key vi-com-map "M" 'vi-middle-window-line) - (define-key vi-com-map "N" 'vi-reverse-last-search) - (define-key vi-com-map "O" 'vi-open-above) - (define-key vi-com-map "P" 'vi-put-before) - (define-key vi-com-map "Q" 'vi-quote-words) ; extension - (define-key vi-com-map "R" 'vi-replace-chars) - (define-key vi-com-map "S" 'vi-substitute-lines) - (define-key vi-com-map "T" 'vi-backward-upto-char) - (define-key vi-com-map "U" 'vi-unimplemented) - (define-key vi-com-map "V" 'vi-undefined) - (define-key vi-com-map "W" 'vi-forward-blank-delimited-word) - (define-key vi-com-map "X" 'call-last-kbd-macro) ; modification/extension - (define-key vi-com-map "Y" 'vi-yank-line) - (define-key vi-com-map "Z" (make-sparse-keymap)) ;allow below prefix command - (define-key vi-com-map "ZZ" 'vi-save-all-and-exit) - - (define-key vi-com-map "[" 'vi-unimplemented) - (define-key vi-com-map "\\" 'vi-operator) ; extension for vi-narrow-op - (define-key vi-com-map "]" 'vi-unimplemented) - (define-key vi-com-map "^" 'back-to-indentation) - (define-key vi-com-map "_" 'vi-undefined) - (define-key vi-com-map "`" 'vi-goto-char-mark) - - (define-key vi-com-map "a" 'vi-insert-after) - (define-key vi-com-map "b" 'backward-word) - (define-key vi-com-map "c" 'vi-operator) - (define-key vi-com-map "d" 'vi-operator) - (define-key vi-com-map "e" 'vi-end-of-word) - (define-key vi-com-map "f" 'vi-forward-find-char) - (define-key vi-com-map "g" 'vi-beginning-of-buffer) ; extension - (define-key vi-com-map "h" 'backward-char) - (define-key vi-com-map "i" 'vi-insert-before) - (define-key vi-com-map "j" 'vi-next-line) - (define-key vi-com-map "k" 'previous-line) - (define-key vi-com-map "l" 'forward-char) - (define-key vi-com-map "m" 'vi-set-mark) - (define-key vi-com-map "n" 'vi-repeat-last-search) - (define-key vi-com-map "o" 'vi-open-below) - (define-key vi-com-map "p" 'vi-put-after) - (define-key vi-com-map "q" 'vi-replace) - (define-key vi-com-map "r" 'vi-replace-1-char) - (define-key vi-com-map "s" 'vi-substitute-chars) - (define-key vi-com-map "t" 'vi-forward-upto-char) - (define-key vi-com-map "u" 'undo) - (define-key vi-com-map "v" 'vi-verify-spelling) - (define-key vi-com-map "w" 'vi-forward-word) - (define-key vi-com-map "x" 'vi-kill-char) - (define-key vi-com-map "y" 'vi-operator) - (define-key vi-com-map "z" 'vi-adjust-window) - - (define-key vi-com-map "{" 'backward-paragraph) - (define-key vi-com-map "|" 'vi-goto-column) - (define-key vi-com-map "}" 'forward-paragraph) - (define-key vi-com-map "~" 'vi-change-case) - (define-key vi-com-map "\177" 'delete-backward-char)) - -(put 'backward-char 'point-moving-unit 'char) -(put 'vi-next-line 'point-moving-unit 'line) -(put 'next-line 'point-moving-unit 'line) -(put 'forward-line 'point-moving-unit 'line) -(put 'previous-line 'point-moving-unit 'line) -(put 'vi-isearch-backward 'point-moving-unit 'search) -(put 'vi-search-backward 'point-moving-unit 'search) -(put 'vi-isearch-forward 'point-moving-unit 'search) -(put 'vi-search-forward 'point-moving-unit 'search) -(put 'forward-char 'point-moving-unit 'char) -(put 'end-of-line 'point-moving-unit 'char) -(put 'vi-find-matching-paren 'point-moving-unit 'match) -(put 'vi-goto-line-mark 'point-moving-unit 'line) -(put 'backward-sexp 'point-moving-unit 'sexp) -(put 'forward-sexp 'point-moving-unit 'sexp) -(put 'vi-next-line-first-nonwhite 'point-moving-unit 'line) -(put 'vi-previous-line-first-nonwhite 'point-moving-unit 'line) -(put 'vi-reverse-last-find-char 'point-moving-unit 'rev-find) -(put 'vi-re-search-forward 'point-moving-unit 'search) -(put 'beginning-of-line 'point-moving-unit 'char) -(put 'vi-beginning-of-buffer 'point-moving-unit 'char) -(put 'vi-repeat-last-find-char 'point-moving-unit 'find) -(put 'vi-re-search-backward 'point-moving-unit 'search) -(put 'vi-backward-blank-delimited-word 'point-moving-unit 'WORD) -(put 'vi-end-of-blank-delimited-word 'point-moving-unit 'match) -(put 'vi-backward-find-char 'point-moving-unit 'find) -(put 'vi-goto-line 'point-moving-unit 'line) -(put 'vi-home-window-line 'point-moving-unit 'line) -(put 'vi-last-window-line 'point-moving-unit 'line) -(put 'vi-middle-window-line 'point-moving-unit 'line) -(put 'vi-reverse-last-search 'point-moving-unit 'rev-search) -(put 'vi-backward-upto-char 'point-moving-unit 'find) -(put 'vi-forward-blank-delimited-word 'point-moving-unit 'WORD) -(put 'back-to-indentation 'point-moving-unit 'char) -(put 'vi-goto-char-mark 'point-moving-unit 'char) -(put 'backward-word 'point-moving-unit 'word) -(put 'vi-end-of-word 'point-moving-unit 'match) -(put 'vi-forward-find-char 'point-moving-unit 'find) -(put 'backward-char 'point-moving-unit 'char) -(put 'vi-forward-char 'point-moving-unit 'char) -(put 'vi-repeat-last-search 'point-moving-unit 'search) -(put 'vi-forward-upto-char 'point-moving-unit 'find) -(put 'vi-forward-word 'point-moving-unit 'word) -(put 'vi-goto-column 'point-moving-unit 'match) -(put 'forward-paragraph 'point-moving-unit 'paragraph) -(put 'backward-paragraph 'point-moving-unit 'paragraph) - -;;; region mark commands -(put 'mark-page 'point-moving-unit 'region) -(put 'mark-paragraph 'point-moving-unit 'region) -(put 'mark-word 'point-moving-unit 'region) -(put 'mark-sexp 'point-moving-unit 'region) -(put 'mark-defun 'point-moving-unit 'region) -(put 'mark-whole-buffer 'point-moving-unit 'region) -(put 'mark-end-of-sentence 'point-moving-unit 'region) -(put 'c-mark-function 'point-moving-unit 'region) -;;; - -(defvar vi-mark-alist nil - "Alist of (NAME . MARK), marks are local to each buffer.") - -(defvar vi-scroll-amount (/ (window-height) 2) - "Default amount of lines for scrolling (used by \"^D\"/\"^U\").") - -(defvar vi-shift-width 4 - "Shift amount for \"<\"/\">\" operators.") - -(defvar vi-ins-point nil ; integer - "Last insertion point. Should use `mark' instead.") - -(defvar vi-ins-length nil ; integer - "Length of last insertion.") - -(defvar vi-ins-repetition nil ; integer - "The repetition required for last insertion.") - -(defvar vi-ins-overwrt-p nil ; boolean - "T if last insertion was a replace actually.") - -(defvar vi-ins-prefix-code nil ; ready-to-eval sexp - "Code to be eval'ed before (redo-)insertion begins.") - -(defvar vi-last-find-char nil ; cons cell - "Save last direction, char and upto-flag used for char finding.") - -(defvar vi-last-change-command nil ; cons cell - "Save commands for redoing last changes. Each command is in (FUNC . ARGS) -form that is ready to be `apply'ed.") - -(defvar vi-last-shell-command nil ; last shell op command line - "Save last shell command given for \"!\" operator.") - -(defvar vi-insert-state nil ; boolean - "Non-nil if it is in insert state.") - -; in "loaddefs.el" -;(defvar search-last-string "" -; "Last string search for by a search command.") - -(defvar vi-search-last-command nil ; (re-)search-forward(backward) - "Save last search command for possible redo.") - -(defvar vi-mode-old-local-map nil - "Save the local-map used before entering vi-mode.") - -(defvar vi-mode-old-mode-name nil - "Save the mode-name before entering vi-mode.") - -(defvar vi-mode-old-major-mode nil - "Save the major-mode before entering vi-mode.") - -(defvar vi-mode-old-case-fold nil) - -;(defconst vi-add-to-mode-line-1 -; '(overwrite-mode nil " Insert")) - -;; Value is same as vi-add-to-mode-line-1 when in vi mode, -;; but nil in other buffers. -;(defvar vi-add-to-mode-line nil) - -(defun vi-mode-setup () - "Setup a buffer for vi-mode by creating necessary buffer-local variables." -; (make-local-variable 'vi-add-to-mode-line) -; (setq vi-add-to-mode-line vi-add-to-mode-line-1) -; (or (memq vi-add-to-mode-line minor-mode-alist) -; (setq minor-mode-alist (cons vi-add-to-mode-line minor-mode-alist))) - (make-local-variable 'vi-scroll-amount) - (setq vi-scroll-amount (/ (window-height) 2)) - (make-local-variable 'vi-shift-width) - (setq vi-shift-width 4) - (make-local-variable 'vi-ins-point) - (make-local-variable 'vi-ins-length) - (make-local-variable 'vi-ins-repetition) - (make-local-variable 'vi-ins-overwrt-p) - (make-local-variable 'vi-ins-prefix-code) - (make-local-variable 'vi-last-change-command) - (make-local-variable 'vi-last-shell-command) - (make-local-variable 'vi-last-find-char) - (make-local-variable 'vi-mark-alist) - (make-local-variable 'vi-insert-state) - (make-local-variable 'vi-mode-old-local-map) - (make-local-variable 'vi-mode-old-mode-name) - (make-local-variable 'vi-mode-old-major-mode) - (make-local-variable 'vi-mode-old-case-fold) - (run-mode-hooks 'vi-mode-hook)) - -;;;###autoload -(defun vi-mode () - "Major mode that acts like the `vi' editor. -The purpose of this mode is to provide you the combined power of vi (namely, -the \"cross product\" effect of commands and repeat last changes) and Emacs. - -This command redefines nearly all keys to look like vi commands. -It records the previous major mode, and any vi command for input -\(`i', `a', `s', etc.) switches back to that mode. -Thus, ordinary Emacs (in whatever major mode you had been using) -is \"input\" mode as far as vi is concerned. - -To get back into vi from \"input\" mode, you must issue this command again. -Therefore, it is recommended that you assign it to a key. - -Major differences between this mode and real vi : - -* Limitations and unsupported features - - Search patterns with line offset (e.g. /pat/+3 or /pat/z.) are - not supported. - - Ex commands are not implemented; try ':' to get some hints. - - No line undo (i.e. the 'U' command), but multi-undo is a standard feature. - -* Modifications - - The stopping positions for some point motion commands (word boundary, - pattern search) are slightly different from standard 'vi'. - Also, no automatic wrap around at end of buffer for pattern searching. - - Since changes are done in two steps (deletion then insertion), you need - to undo twice to completely undo a change command. But this is not needed - for undoing a repeated change command. - - No need to set/unset 'magic', to search for a string with regular expr - in it just put a prefix arg for the search commands. Replace cmds too. - - ^R is bound to incremental backward search, so use ^L to redraw screen. - -* Extensions - - Some standard (or modified) Emacs commands were integrated, such as - incremental search, query replace, transpose objects, and keyboard macros. - - In command state, ^X links to the 'ctl-x-map', and ESC can be linked to - esc-map or set undefined. These can give you the full power of Emacs. - - See vi-com-map for those keys that are extensions to standard vi, e.g. - `vi-name-last-change-or-macro', `vi-verify-spelling', `vi-locate-def', - `vi-mark-region', and 'vi-quote-words'. Some of them are quite handy. - - Use \\[vi-switch-mode] to switch among different modes quickly. - -Syntax table and abbrevs while in vi mode remain as they were in Emacs." - (interactive) - (if (null vi-mode-old-major-mode) ; very first call for current buffer - (vi-mode-setup)) - - (if (eq major-mode 'vi-mode) - (progn (ding) (message "Already in vi-mode.")) - (setq vi-mode-old-local-map (current-local-map)) - (setq vi-mode-old-mode-name mode-name) - (setq vi-mode-old-major-mode major-mode) - (setq vi-mode-old-case-fold case-fold-search) ; this is needed !! - (setq case-fold-search nil) ; exact case match in searching - (use-local-map vi-com-map) - (setq major-mode 'vi-mode) - (setq mode-name "VI") - (force-mode-line-update) ; force mode line update - (if vi-insert-state ; this is a return from insertion - (vi-end-of-insert-state)))) - -(defun vi-ding() - "Ding !" - (interactive) - (ding)) - -(defun vi-save-all-and-exit () - "Save all modified buffers without asking, then exits emacs." - (interactive) - (save-some-buffers t) - (kill-emacs)) - -;; to be used by "ex" commands -(defvar vi-replaced-string nil) -(defvar vi-replacing-string nil) - -(defun vi-ex-cmd () - "Ex commands are not implemented in Evi mode. For some commonly used ex -commands, you can use the following alternatives for similar effect : -w C-x C-s (save-buffer) -wq C-x C-c (save-buffers-kill-emacs) -w fname C-x C-w (write-file) -e fname C-x C-f (find-file) -r fname C-x i (insert-file) -s/old/new use q (vi-replace) to do unconditional replace - use C-q (vi-query-replace) to do query replace -set sw=n M-x set-variable vi-shift-width n " - (interactive) -;; (let ((cmd (read-string ":")) (lines 1)) -;; (cond ((string-match "s")))) - (with-output-to-temp-buffer "*Help*" - (princ (documentation 'vi-ex-cmd)) - (with-current-buffer standard-output - (help-mode)))) - -(defun vi-undefined () - (interactive) - (message "Command key \"%s\" is undefined in Evi." - (single-key-description last-command-event)) - (ding)) - -(defun vi-unimplemented () - (interactive) - (message "Command key \"%s\" is not implemented in Evi." - (single-key-description last-command-event)) - (ding)) - -;;;;; -(defun vi-goto-insert-state (repetition &optional prefix-code do-it-now-p) - "Go into insert state, the text entered will be repeated if REPETITION > 1. -If PREFIX-CODE is given, do it before insertion begins if DO-IT-NOW-P is T. -In any case, the prefix-code will be done before each 'redo-insert'. -This function expects `overwrite-mode' being set properly beforehand." - (if do-it-now-p (apply (car prefix-code) (cdr prefix-code))) - (setq vi-ins-point (point)) - (setq vi-ins-repetition repetition) - (setq vi-ins-prefix-code prefix-code) - (setq mode-name vi-mode-old-mode-name) - (setq case-fold-search vi-mode-old-case-fold) - (use-local-map vi-mode-old-local-map) - (setq major-mode vi-mode-old-major-mode) - (force-mode-line-update) - (setq vi-insert-state t)) - -(defun vi-end-of-insert-state () - "Terminate insertion and set up last change command." - (if (or (< (point) vi-ins-point) ;Check if there is any effective change - (and (= (point) vi-ins-point) (null vi-ins-prefix-code)) - (<= vi-ins-repetition 0)) - (vi-goto-command-state t) - (if (> vi-ins-repetition 1) - (progn - (let ((str (buffer-substring vi-ins-point (point)))) - (while (> vi-ins-repetition 1) - (insert str) - (setq vi-ins-repetition (1- vi-ins-repetition)))))) - (vi-set-last-change-command 'vi-first-redo-insertion vi-ins-point (point) - overwrite-mode vi-ins-prefix-code) - (vi-goto-command-state t))) - -(defun vi-first-redo-insertion (begin end &optional overwrite-p prefix-code) - "Redo last insertion the first time. Extract the string and save it for -future redoes. Do prefix-code if it's given, use overwrite mode if asked." - (let ((str (buffer-substring begin end))) - (if prefix-code (apply (car prefix-code) (cdr prefix-code))) - (if overwrite-p (delete-region (point) (+ (point) (length str)))) - (insert str) - (vi-set-last-change-command 'vi-more-redo-insertion str overwrite-p prefix-code))) - -(defun vi-more-redo-insertion (str &optional overwrite-p prefix-code) - "Redo more insertion : copy string from STR to point, use overwrite mode -if overwrite-p is T; apply prefix-code first if it's non-nil." - (if prefix-code (apply (car prefix-code) (cdr prefix-code))) - (if overwrite-p (delete-region (point) (+ (point) (length str)))) - (insert str)) - -(defun vi-goto-command-state (&optional from-insert-state-p) - "Go to vi-mode command state. If optional arg exists, means return from -insert state." - (use-local-map vi-com-map) - (setq vi-insert-state nil) - (if from-insert-state-p - (if overwrite-mode - (overwrite-mode 0) -; (set-minor-mode 'ins "Insert" nil) - ))) - -(defun vi-kill-line (arg) - "kill specified number of lines (=d$), text saved in the kill ring." - (interactive "*P") - (kill-line arg) - (vi-set-last-change-command 'kill-line arg)) - -(defun vi-kill-region (start end) - (interactive "*r") - (kill-region start end) - (vi-set-last-change-command 'kill-region)) - -(defun vi-append-at-end-of-line (arg) - "go to end of line and then go into vi insert state." - (interactive "*p") - (vi-goto-insert-state arg '(end-of-line) t)) - -(defun vi-change-rest-of-line (arg) - "Change the rest of (ARG) lines (= c$ in vi)." - (interactive "*P") - (vi-goto-insert-state 1 (list 'kill-line arg) t)) - -(defun vi-insert-before-first-nonwhite (arg) - "(= ^i in vi)" - (interactive "*p") - (vi-goto-insert-state arg '(back-to-indentation) t)) - -(defun vi-open-above (arg) - "open new line(s) above current line and enter insert state." - (interactive "*p") - (vi-goto-insert-state 1 - (list (function (lambda (x) - (or (beginning-of-line) - (open-line x)))) arg) - t)) - -(defun vi-open-below (arg) - "open new line(s) and go into insert mode on the last line." - (interactive "*p") - (vi-goto-insert-state 1 - (list (function (lambda (x) - (or (end-of-line) - (open-line x) - (forward-line x)))) arg) - t)) - -(defun vi-insert-after (arg) - "start vi insert state after cursor." - (interactive "*p") - (vi-goto-insert-state arg - (list (function (lambda () - (if (not (eolp)) (forward-char))))) - t)) - -(defun vi-insert-before (arg) - "enter insert state before the cursor." - (interactive "*p") - (vi-goto-insert-state arg)) - -(defun vi-goto-line (arg) - "Go to ARGth line." - (interactive "P") - (if (null (vi-raw-numeric-prefix arg)) - (with-no-warnings - (end-of-buffer)) - (with-no-warnings (goto-line (vi-prefix-numeric-value arg))))) - -(defun vi-beginning-of-buffer () - "Move point to the beginning of current buffer." - (interactive) - (goto-char (point-min))) - -;;;;; not used now -;;(defvar regexp-search t ; string -;; "*T if search string can contain regular expressions. (= set magic in vi)") -;;;;; - -(defun vi-isearch-forward (arg) - "Incremental search forward. Use regexp version if ARG is non-nil." - (interactive "P") - (let ((scmd (if arg 'isearch-forward-regexp 'isearch-forward)) - (opoint (point))) - (call-interactively scmd) - (if (= opoint (point)) - nil - (setq vi-search-last-command (if arg 're-search-forward 'search-forward))))) - -(defun vi-isearch-backward (arg) - "Incremental search backward. Use regexp version if ARG is non-nil." - (interactive "P") - (let ((scmd (if arg 'isearch-backward-regexp 'isearch-backward)) - (opoint (point))) - (call-interactively scmd) - (if (= opoint (point)) - nil - (setq vi-search-last-command (if arg 're-search-backward 'search-backward))))) - -(defun vi-search-forward (arg string) - "Nonincremental search forward. Use regexp version if ARG is non-nil." - (interactive (if current-prefix-arg - (list t (read-string "regexp/" nil)) - (list nil (read-string "/" nil)))) - (setq vi-search-last-command (if arg 're-search-forward 'search-forward)) - (if (> (length string) 0) - (isearch-update-ring string arg)) - (funcall vi-search-last-command string nil nil 1)) - -(defun vi-search-backward (arg string) - "Nonincremental search backward. Use regexp version if ARG is non-nil." - (interactive (if current-prefix-arg - (list t (read-string "regexp?" nil)) - (list nil (read-string "?" nil)))) - (setq vi-search-last-command (if arg 're-search-backward 'search-backward)) - (if (> (length string) 0) - (isearch-update-ring string arg)) - (funcall vi-search-last-command string nil nil 1)) - -(defun vi-repeat-last-search (arg &optional search-command search-string) - "Repeat last search command. -If optional search-command/string are given, -use those instead of the ones saved." - (interactive "p") - (if (null search-command) (setq search-command vi-search-last-command)) - (if (null search-string) - (setq search-string - (car (if (memq search-command - '(re-search-forward re-search-backward)) - regexp-search-ring - search-ring)))) - (if (null search-command) - (progn (ding) (message "No last search command to repeat.")) - (funcall search-command search-string nil nil arg))) - -(defun vi-reverse-last-search (arg &optional search-command search-string) - "Redo last search command in reverse direction. -If the optional search args are given, use those instead of the ones saved." - (interactive "p") - (if (null search-command) (setq search-command vi-search-last-command)) - (if (null search-string) - (setq search-string - (car (if (memq search-command - '(re-search-forward re-search-backward)) - regexp-search-ring - search-ring)))) - (if (null search-command) - (progn (ding) (message "No last search command to repeat.")) - (funcall (cond ((eq search-command 're-search-forward) 're-search-backward) - ((eq search-command 're-search-backward) 're-search-forward) - ((eq search-command 'search-forward) 'search-backward) - ((eq search-command 'search-backward) 'search-forward)) - search-string nil nil arg))) - -(defun vi-join-lines (arg) - "join ARG lines from current line (default 2), cleaning up white space." - (interactive "P") - (if (null (vi-raw-numeric-prefix arg)) - (delete-indentation t) - (let ((count (vi-prefix-numeric-value arg))) - (while (>= count 2) - (delete-indentation t) - (setq count (1- count))))) - (vi-set-last-change-command 'vi-join-lines arg)) - -(defun vi-backward-kill-line () - "kill the current line. Only works in insert state." - (interactive) - (if (not vi-insert-state) - nil - (beginning-of-line 1) - (kill-line nil))) - -(defun vi-abort-ins () - "abort insert state, kill inserted text and go back to command state." - (interactive) - (if (not vi-insert-state) - nil - (if (> (point) vi-ins-point) - (kill-region vi-ins-point (point))) - (vi-goto-command-state t))) - -(defun vi-backward-windowful (count) - "Backward COUNT windowfuls. Default is one." - (interactive "p") -; (set-mark-command nil) - (while (> count 0) - (scroll-down nil) - (setq count (1- count)))) - -(defun vi-scroll-down-window (count) - "Scrolls down window COUNT lines. -If COUNT is nil (actually, non-integer), scrolls default amount. -The given COUNT is remembered for future scrollings." - (interactive "P") - (if (integerp count) - (setq vi-scroll-amount count)) - (scroll-up vi-scroll-amount)) - -(defun vi-expose-line-below (count) - "Expose COUNT more lines below the current window. Default COUNT is 1." - (interactive "p") - (scroll-up count)) - -(defun vi-forward-windowful (count) - "Forward COUNT windowfuls. Default is one." - (interactive "p") -; (set-mark-command nil) - (while (> count 0) - (scroll-up nil) - (setq count (1- count)))) - -(defun vi-next-line (count) - "Go down count lines, try to keep at the same column." - (interactive "p") - (setq this-command 'next-line) ; this is a needed trick - (if (= (point) (progn (line-move count) (point))) - (ding) ; no moving, already at end of buffer - (setq last-command 'next-line))) - -(defun vi-next-line-first-nonwhite (count) - "Go down COUNT lines. Stop at first non-white." - (interactive "p") - (if (= (point) (progn (forward-line count) (back-to-indentation) (point))) - (ding))) ; no moving, already at end of buffer - -(defun vi-previous-line-first-nonwhite (count) - "Go up COUNT lines. Stop at first non-white." - (interactive "p") - (forward-line (- count)) - (back-to-indentation)) - -(defun vi-scroll-up-window (count) - "Scrolls up window COUNT lines. -If COUNT is nil (actually, non-integer), scrolls default amount. -The given COUNT is remembered for future scrollings." - (interactive "P") - (if (integerp count) - (setq vi-scroll-amount count)) - (scroll-down vi-scroll-amount)) - -(defun vi-expose-line-above (count) - "Expose COUNT more lines above the current window. Default COUNT is 1." - (interactive "p") - (scroll-down count)) - -(defun vi-char-argument (arg) - "Get following character (could be any CHAR) as part of the prefix argument. -Possible prefix-arg cases are nil, INTEGER, (nil . CHAR) or (INTEGER . CHAR)." - (interactive "P") - (let ((char (read-char))) - (cond ((null arg) (setq prefix-arg (cons nil char))) - ((integerp arg) (setq prefix-arg (cons arg char))) - ; This can happen only if the user changed his/her mind for CHAR, - ; Or there are some leading "universal-argument"s - (t (setq prefix-arg (cons (car arg) char)))))) - -(defun vi-goto-mark (mark-char &optional line-flag) - "Go to marked position or line (if line-flag is given). -Goto mark '@' means jump into and pop the top mark on the mark ring." - (cond ((char-equal mark-char last-command-event) ; `` or '' - (exchange-point-and-mark) (if line-flag (back-to-indentation))) - ((char-equal mark-char ?@) ; jump and pop mark - (set-mark-command t) (if line-flag (back-to-indentation))) - (t - (let ((mark (vi-get-mark mark-char))) - (if (null mark) - (progn (vi-ding) (message "Mark register undefined.")) - (set-mark-command nil) - (goto-char mark) - (if line-flag (back-to-indentation))))))) - -(defun vi-goto-line-mark (char) - "Go to the line (at first non-white) marked by next char." - (interactive "c") - (vi-goto-mark char t)) - -(defun vi-goto-char-mark (char) - "Go to the char position marked by next mark-char." - (interactive "c") - (vi-goto-mark char)) - -(defun vi-digit-argument (arg) - "Set numeric prefix argument." - (interactive "P") - (cond ((null arg) (digit-argument arg)) - ((integerp arg) (digit-argument nil) - (setq prefix-arg (* prefix-arg arg))) - (t (digit-argument nil) ; in (NIL . CHAR) or (NUM . CHAR) form - (setq prefix-arg (cons (* prefix-arg - (if (null (car arg)) 1 (car arg))) - (cdr arg)))))) - -(defun vi-raw-numeric-prefix (arg) - "Return the raw value of numeric part prefix argument." - (if (consp arg) (car arg) arg)) - -(defun vi-prefix-numeric-value (arg) - "Return numeric meaning of the raw prefix argument. This is a modification -to the standard one provided in `callint.c' to handle (_ . CHAR) cases." - (cond ((null arg) 1) - ((integerp arg) arg) - ((consp arg) (if (car arg) (car arg) 1)))) - -(defun vi-reverse-last-find-char (count &optional find-arg) - "Reverse last f F t T operation COUNT times. If the optional FIND-ARG -is given, it is used instead of the saved one." - (interactive "p") - (if (null find-arg) (setq find-arg vi-last-find-char)) - (if (null find-arg) - (progn (ding) (message "No last find char to repeat.")) - (vi-find-char (cons (* (car find-arg) -1) (cdr find-arg)) count))) ;6/13/86 - -(defun vi-find-char (arg count) - "Find in DIRECTION (1/-1) for CHAR of COUNT'th times on current line. -If UPTO-FLAG is T, stop before the char. ARG = (DIRECTION.CHAR.UPTO-FLAG." - (let* ((direction (car arg)) (char (car (cdr arg))) - (upto-flag (cdr (cdr arg))) (pos (+ (point) direction))) - (if (catch 'exit-find-char - (while t - (cond ((null (char-after pos)) (throw 'exit-find-char nil)) - ((char-equal (char-after pos) ?\n) (throw 'exit-find-char nil)) - ((char-equal char (char-after pos)) (setq count (1- count)) - (if (= count 0) - (throw 'exit-find-char - (if upto-flag - (setq pos (- pos direction)) - pos))))) - (setq pos (+ pos direction)))) - (goto-char pos) - (ding)))) - -(defun vi-repeat-last-find-char (count &optional find-arg) - "Repeat last f F t T operation COUNT times. If optional FIND-ARG is given, -it is used instead of the saved one." - (interactive "p") - (if (null find-arg) (setq find-arg vi-last-find-char)) - (if (null find-arg) - (progn (ding) (message "No last find char to repeat.")) - (vi-find-char find-arg count))) - -(defun vi-backward-find-char (count char) - "Find the COUNT'th CHAR backward on current line." - (interactive "p\nc") - (setq vi-last-find-char (cons -1 (cons char nil))) - (vi-repeat-last-find-char count)) - -(defun vi-forward-find-char (count char) - "Find the COUNT'th CHAR forward on current line." - (interactive "p\nc") - (setq vi-last-find-char (cons 1 (cons char nil))) - (vi-repeat-last-find-char count)) - -(defun vi-backward-upto-char (count char) - "Find upto the COUNT'th CHAR backward on current line." - (interactive "p\nc") - (setq vi-last-find-char (cons -1 (cons char t))) - (vi-repeat-last-find-char count)) - -(defun vi-forward-upto-char (count char) - "Find upto the COUNT'th CHAR forward on current line." - (interactive "p\nc") - (setq vi-last-find-char (cons 1 (cons char t))) - (vi-repeat-last-find-char count)) - -(defun vi-end-of-word (count) - "Move forward until encountering the end of a word. -With argument, do this that many times." - (interactive "p") - (if (not (eobp)) (forward-char)) - (if (re-search-forward "\\W*\\w+\\>" nil t count) - (backward-char))) - -(defun vi-replace-1-char (count char) - "Replace char after point by CHAR. Repeat COUNT times." - (interactive "p\nc") - (delete-char count nil) ; don't save in kill ring - (setq last-command-event char) - (self-insert-command count) - (vi-set-last-change-command 'vi-replace-1-char count char)) - -(defun vi-replace-chars (arg) - "Replace chars over old ones." - (interactive "*p") - (overwrite-mode 1) - (vi-goto-insert-state arg)) - -(defun vi-substitute-chars (count) - "Substitute COUNT chars by the input chars, enter insert state." - (interactive "*p") - (vi-goto-insert-state 1 (list (function (lambda (c) ; this is a bit tricky - (delete-region (point) - (+ (point) c)))) - count) t)) - -(defun vi-substitute-lines (count) - "Substitute COUNT lines by the input chars. (=cc in vi)" - (interactive "*p") - (vi-goto-insert-state 1 (list 'vi-delete-op 'next-line (1- count)) t)) - -(defun vi-prefix-char-value (arg) - "Get the char part of the current prefix argument." - (cond ((null arg) nil) - ((integerp arg) nil) - ((consp arg) (cdr arg)) - (t nil))) - -(defun vi-operator (arg) - "Handling vi operators (d/c//!/=/y). Current implementation requires -the key bindings of the operators being fixed." - (interactive "P") - (catch 'vi-exit-op - (let ((this-op-char last-command-event)) - (setq last-command-event (read-char)) - (setq this-command (lookup-key vi-com-map (char-to-string last-command-event))) - (if (not (eq this-command 'vi-digit-argument)) - (setq prefix-arg arg) - (vi-digit-argument arg) - (setq last-command-event (read-char)) - (setq this-command (lookup-key vi-com-map (char-to-string last-command-event)))) - (cond ((char-equal this-op-char last-command-event) ; line op - (vi-execute-op this-op-char 'next-line - (cons (1- (vi-prefix-numeric-value prefix-arg)) - (vi-prefix-char-value prefix-arg)))) - ;; We assume any command that has no property 'point-moving-unit' - ;; as having that property with the value 'CHAR'. 3/12/86 - (t ;; (get this-command 'point-moving-unit) - (vi-execute-op this-op-char this-command prefix-arg)))))) - ;; (t (throw 'vi-exit-op (ding))))))) - -(defun vi-execute-op (op-char motion-command arg) - "Execute vi edit operator as specified by OP-CHAR, the operand is the region -determined by the MOTION-COMMAND with ARG." - (cond ((= op-char ?d) - (if (vi-delete-op motion-command arg) - (vi-set-last-change-command 'vi-delete-op (vi-repeat-command-of motion-command) arg))) - ((= op-char ?c) - (if (vi-delete-op motion-command arg) - (vi-goto-insert-state 1 (list 'vi-delete-op - (vi-repeat-command-of motion-command) arg) nil))) - ((= op-char ?y) - (if (vi-yank-op motion-command arg) - (vi-set-last-change-command 'vi-yank-op (vi-repeat-command-of motion-command) arg))) - ((= op-char ?!) - (if (vi-shell-op motion-command arg) - (vi-set-last-change-command 'vi-shell-op (vi-repeat-command-of motion-command) arg vi-last-shell-command))) - ((= op-char ?<) - (if (vi-shift-op motion-command arg (- vi-shift-width)) - (vi-set-last-change-command 'vi-shift-op (vi-repeat-command-of motion-command) arg (- vi-shift-width)))) - ((= op-char ?>) - (if (vi-shift-op motion-command arg vi-shift-width) - (vi-set-last-change-command 'vi-shift-op (vi-repeat-command-of motion-command) arg vi-shift-width))) - ((= op-char ?=) - (if (vi-indent-op motion-command arg) - (vi-set-last-change-command 'vi-indent-op (vi-repeat-command-of motion-command) arg))) - ((= op-char ?\\) - (vi-narrow-op motion-command arg)))) - -(defun vi-repeat-command-of (command) - "Return the command for redo the given command." - (let ((cmd-type (get command 'point-moving-unit))) - (cond ((eq cmd-type 'search) 'vi-repeat-last-search) - ((eq cmd-type 'find) 'vi-repeat-last-find-char) - (t command)))) - -(defun vi-effective-range (motion-command arg) - "Return (begin . end) of the range spanned by executing the given -MOTION-COMMAND with ARG. - MOTION-COMMAND in ready-to-eval list form is not yet supported." - (save-excursion - (let ((begin (point)) end opoint - (moving-unit (get motion-command 'point-moving-unit))) - (setq prefix-arg arg) - (setq opoint (point)) - (command-execute motion-command nil) -;; Check if there is any effective motion. Note that for single line operation -;; the motion-command causes no effective point movement (since it moves up or -;; down zero lines), but it should be counted as effectively moved. - (if (and (= (point) opoint) (not (eq moving-unit 'line))) - (cons opoint opoint) ; no effective motion - (if (eq moving-unit 'region) - (setq begin (or (mark) (point)))) - (if (<= begin (point)) - (setq end (point)) - (setq end begin) - (setq begin (point))) - (cond ((or (eq moving-unit 'match) (eq moving-unit 'find)) - (setq end (1+ end))) - ((eq moving-unit 'line) - (goto-char begin) (beginning-of-line) (setq begin (point)) - (goto-char end) (forward-line 1) (beginning-of-line) (setq end (point)))) - (if (> end (point-max)) (setq end (point-max))) ; force in buffer region - (cons begin end))))) - -(defun vi-delete-op (motion-command arg) - "Delete range specified by MOTION-COMMAND with ARG." - (let* ((range (vi-effective-range motion-command arg)) - (begin (car range)) (end (cdr range)) reg) - (if (= begin end) - nil ; point not moved, abort op - (setq reg (vi-prefix-char-value arg)) - (if (null reg) - (kill-region begin end) ; kill ring as unnamed registers - (if (and (>= reg ?A) (<= reg ?Z)) - (append-to-register (downcase reg) begin end t) - (copy-to-register reg begin end t))) - t))) - -(defun vi-yank-op (motion-command arg) - "Yank (in vi sense) range specified by MOTION-COMMAND with ARG." - (let* ((range (vi-effective-range motion-command arg)) - (begin (car range)) (end (cdr range)) reg) - (if (= begin end) - nil ; point not moved, abort op - (setq reg (vi-prefix-char-value arg)) - (if (null reg) - (copy-region-as-kill begin end); kill ring as unnamed registers - (if (and (>= reg ?A) (<= reg ?Z)) - (append-to-register (downcase reg) begin end nil) - (copy-to-register reg begin end nil))) - t))) - -(defun vi-yank-line (arg) - "Yank (in vi sense) lines (= `yy' command)." - (interactive "*P") - (setq arg (cons (1- (vi-prefix-numeric-value arg)) (vi-prefix-char-value arg))) - (if (vi-yank-op 'next-line arg) - (vi-set-last-change-command 'vi-yank-op 'next-line arg))) - -(defun vi-string-end-with-nl-p (string) - "See if STRING ends with a newline char. -Used in checking whether the yanked text should be put back as lines or not." - (= (aref string (1- (length string))) ?\n)) - -(defun vi-put-before (arg &optional after-p) - "Put yanked (in vi sense) text back before/above cursor. -If a numeric prefix value (currently it should be >1) is given, put back -text as lines. If the optional after-p is given, put after/below the cursor." - (interactive "P") - (let ((reg (vi-prefix-char-value arg)) put-text) - (if (and reg (or (< reg ?1) (> reg ?9)) (null (get-register reg))) - (error "Nothing in register %c" reg) - (if (null reg) (setq reg ?1)) ; the default is the last text killed - (setq put-text - (cond - ((and (>= reg ?1) (<= reg ?9)) - (setq this-command 'yank) ; So we may yank-pop !! - (current-kill (- reg ?0 1) 'do-not-rotate)) - ((stringp (get-register reg)) (get-register reg)) - (t (error "Register %c is not containing text string" reg)))) - (if (vi-string-end-with-nl-p put-text) ; put back text as lines - (if after-p - (progn (forward-line 1) (beginning-of-line)) - (beginning-of-line)) - (if after-p (forward-char 1))) - (push-mark (point)) - (insert put-text) - (exchange-point-and-mark) -;; (back-to-indentation) ; this is not allowed if we allow yank-pop - (vi-set-last-change-command 'vi-put-before arg after-p)))) - -(defun vi-put-after (arg) - "Put yanked (in vi sense) text back after/below cursor." - (interactive "P") - (vi-put-before arg t)) - -(defun vi-shell-op (motion-command arg &optional shell-command) - "Perform shell command (as filter). -Performs command on range specified by MOTION-COMMAND -with ARG. If SHELL-COMMAND is not given, ask for one from minibuffer. -If char argument is given, it directs the output to a *temp* buffer." - (let* ((range (vi-effective-range motion-command arg)) - (begin (car range)) (end (cdr range))) - (if (= begin end) - nil ; point not moved, abort op - (cond ((null shell-command) - (setq shell-command (read-string "!" nil)) - (setq vi-last-shell-command shell-command))) - (shell-command-on-region begin end shell-command (not (vi-prefix-char-value arg)) - (not (vi-prefix-char-value arg))) - t))) - -(defun vi-shift-op (motion-command arg amount) - "Perform shift command on range specified by MOTION-COMMAND with ARG for -AMOUNT on each line. Negative amount means shift left. -SPECIAL FEATURE: char argument can be used to specify shift amount(1-9)." - (let* ((range (vi-effective-range motion-command arg)) - (begin (car range)) (end (cdr range))) - (if (= begin end) - nil ; point not moved, abort op - (if (vi-prefix-char-value arg) - (setq amount (if (> amount 0) - (- (vi-prefix-char-value arg) ?0) - (- ?0 (vi-prefix-char-value arg))))) - (indent-rigidly begin end amount) - t))) - -(defun vi-indent-op (motion-command arg) - "Perform indent command on range specified by MOTION-COMMAND with ARG." - (let* ((range (vi-effective-range motion-command arg)) - (begin (car range)) (end (cdr range))) - (if (= begin end) - nil ; point not moved, abort op - (indent-region begin end nil) ; insert TAB as indent command - t))) - -(defun vi-narrow-op (motion-command arg) - "Narrow to region specified by MOTION-COMMAND with ARG." - (let* ((range (vi-effective-range motion-command arg)) - (begin (car range)) (end (cdr range)) reg) - (if (= begin end) - nil ; point not moved, abort op - (narrow-to-region begin end)))) - -(defun vi-get-mark (char) - "Return contents of vi mark register named CHAR, or nil if undefined." - (cdr (assq char vi-mark-alist))) - -(defun vi-set-mark (char) - "Set contents of vi mark register named CHAR to current point. -'@' is the special anonymous mark register." - (interactive "c") - (if (char-equal char ?@) - (set-mark-command nil) - (let ((aelt (assq char vi-mark-alist))) - (if aelt - (move-marker (cdr aelt) (point)) ; fixed 6/12/86 - (setq aelt (cons char (copy-marker (point)))) - (setq vi-mark-alist (cons aelt vi-mark-alist)))))) - -(defun vi-find-matching-paren () - "Locate the matching paren. It's a hack right now." - (interactive) - (cond ((looking-at "[[({]") (forward-sexp 1) (backward-char 1)) - ((looking-at "[])}]") (forward-char 1) (backward-sexp 1)) - (t (ding)))) - -(defun vi-backward-blank-delimited-word (count) - "Backward COUNT blank-delimited words." - (interactive "p") - (if (re-search-backward "[ \t\n\`][^ \t\n\`]+" nil t count) - (if (not (bobp)) (forward-char 1)))) - -(defun vi-forward-blank-delimited-word (count) - "Forward COUNT blank-delimited words." - (interactive "p") - (if (re-search-forward "[^ \t\n]*[ \t\n]+[^ \t\n]" nil t count) - (if (not (eobp)) (backward-char 1)))) - -(defun vi-end-of-blank-delimited-word (count) - "Forward to the end of the COUNT'th blank-delimited word." - (interactive "p") - (if (re-search-forward "[^ \t\n\']+[ \t\n\']" nil t count) - (if (not (eobp)) (backward-char 2)))) - -(defun vi-home-window-line (arg) - "To window home or arg'th line from the top of the window." - (interactive "p") - (move-to-window-line (1- arg)) - (back-to-indentation)) - -(defun vi-last-window-line (arg) - "To window last line or arg'th line from the bottom of the window." - (interactive "p") - (move-to-window-line (- arg)) - (back-to-indentation)) - -(defun vi-middle-window-line () - "To the middle line of the window." - (interactive) - (move-to-window-line nil) - (back-to-indentation)) - -(defun vi-forward-word (count) - "Stop at the beginning of the COUNT'th words from point." - (interactive "p") - (if (re-search-forward "\\w*\\W+\\<" nil t count) - t - (vi-ding))) - -(defun vi-set-last-change-command (fun &rest args) - "Set (FUN . ARGS) as the `last-change-command'." - (setq vi-last-change-command (cons fun args))) - -(defun vi-redo-last-change-command (count &optional command) - "Redo last change command COUNT times. If the optional COMMAND is given, -it is used instead of the current `last-change-command'." - (interactive "p") - (if (null command) - (setq command vi-last-change-command)) - (if (null command) - (message "No last change command available.") - (while (> count 0) - (apply (car command) (cdr command)) - (setq count (1- count))))) - -(defun vi-kill-char (count) - "Kill COUNT chars from current point." - (interactive "*p") - (delete-char count t) ; save in kill ring - (vi-set-last-change-command 'delete-char count t)) - -(defun vi-transpose-objects (arg unit) - "Transpose objects. -The following char specifies unit of objects to be -transposed -- \"c\" for chars, \"l\" for lines, \"w\" for words, \"s\" for - sexp, \"p\" for paragraph. -For the use of the prefix-arg, refer to individual functions called." - (interactive "*P\nc") - (if (char-equal unit ??) - (progn - (message "Transpose: c(har), l(ine), p(aragraph), s(-exp), w(ord),") - (setq unit (read-char)))) - (vi-set-last-change-command 'vi-transpose-objects arg unit) - (cond ((char-equal unit ?c) (transpose-chars arg)) - ((char-equal unit ?l) (transpose-lines (vi-prefix-numeric-value arg))) - ((char-equal unit ?p) (transpose-paragraphs (vi-prefix-numeric-value arg))) - ((char-equal unit ?s) (transpose-sexps (vi-prefix-numeric-value arg))) - ((char-equal unit ?w) (transpose-words (vi-prefix-numeric-value arg))) - (t (vi-transpose-objects arg ??)))) - -(defun vi-query-replace (arg) - "Query replace, use regexp version if ARG is non-nil." - (interactive "*P") - (let ((rcmd (if arg 'query-replace-regexp 'query-replace))) - (call-interactively rcmd nil))) - -(defun vi-replace (arg) - "Replace strings, use regexp version if ARG is non-nil." - (interactive "*P") - (let ((rcmd (if arg 'replace-regexp 'replace-string))) - (call-interactively rcmd nil))) - -(defun vi-adjust-window (arg position) - "Move current line to the top/center/bottom of the window." - (interactive "p\nc") - (cond ((char-equal position ?\r) (recenter 0)) - ((char-equal position ?-) (recenter -1)) - ((char-equal position ?.) (recenter (/ (window-height) 2))) - (t (message "Move current line to: \\r(top) -(bottom) .(middle)") - (setq position (read-char)) - (vi-adjust-window arg position)))) - -(defun vi-goto-column (col) - "Go to given column of the current line." - (interactive "p") - (let ((opoint (point))) - (beginning-of-line) - (while (> col 1) - (if (eolp) - (setq col 0) - (forward-char 1) - (setq col (1- col)))) - (if (= col 1) - t - (goto-char opoint) - (ding)))) - -(defun vi-name-last-change-or-macro (arg char) - "Give name to the last change command or just defined kbd macro. -If prefix ARG is given, name last macro, otherwise name last change command. -The following CHAR will be the name for the command or macro." - (interactive "P\nc") - (if arg - (name-last-kbd-macro (intern (char-to-string char))) - (if (eq (car vi-last-change-command) 'vi-first-redo-insertion) - (let* ((args (cdr vi-last-change-command)) ; save the insertion text - (str (buffer-substring (nth 0 args) (nth 1 args))) - (overwrite-p (nth 2 args)) - (prefix-code (nth 3 args))) - (vi-set-last-change-command 'vi-more-redo-insertion str - overwrite-p prefix-code))) - (fset (intern (char-to-string char)) vi-last-change-command))) - -(defun vi-call-named-change-or-macro (count char) - "Execute COUNT times the keyboard macro definition named by the following CHAR." - (interactive "p\nc") - (if (stringp (symbol-function (intern (char-to-string char)))) - (execute-kbd-macro (intern (char-to-string char)) count) - (vi-redo-last-change-command count (symbol-function (intern (char-to-string char)))))) - -(defun vi-change-case (arg) ; could be made as an operator ? - "Change the case of the char after point." - (interactive "*p") - (catch 'exit - (if (looking-at "[a-z]") - (upcase-region (point) (+ (point) arg)) - (if (looking-at "[A-Z]") - (downcase-region (point) (+ (point) arg)) - (ding) - (throw 'exit nil))) - (vi-set-last-change-command 'vi-change-case arg) ;should avoid redundant save - (forward-char arg))) - -(defun vi-ask-for-info (char) - "Inquire status info. The next CHAR will specify the particular info requested." - (interactive "c") - (cond ((char-equal char ?l) (what-line)) - ((char-equal char ?c) (what-cursor-position)) - ((char-equal char ?p) (what-page)) - (t (message "Ask for: l(ine number), c(ursor position), p(age number)") - (setq char (read-char)) - (vi-ask-for-info char)))) - -(declare-function c-mark-function "cc-cmds" ()) - -(defun vi-mark-region (arg region) - "Mark region appropriately. The next char REGION is d(efun),s(-exp),b(uffer), -p(aragraph), P(age), f(unction in C/Pascal etc.), w(ord), e(nd of sentence), -l(ines)." - (interactive "p\nc") - (cond ((char-equal region ?d) (mark-defun)) - ((char-equal region ?s) (mark-sexp arg)) - ((char-equal region ?b) (mark-whole-buffer)) - ((char-equal region ?p) (mark-paragraph)) - ((char-equal region ?P) (mark-page arg)) - ((char-equal region ?f) (c-mark-function)) - ((char-equal region ?w) (mark-word arg)) - ((char-equal region ?e) (mark-end-of-sentence arg)) - ((char-equal region ?l) (vi-mark-lines arg)) - (t (message "Mark: d(efun),s(-exp),b(uf),p(arag),P(age),f(unct),w(ord),e(os),l(ines)") - (setq region (read-char)) - (vi-mark-region arg region)))) - -(defun vi-mark-lines (num) - "Mark NUM of lines from current line as current region." - (beginning-of-line 1) - (push-mark) - (end-of-line num)) - -(defun vi-verify-spelling (arg unit) - "Verify spelling for the objects specified by char UNIT : [b(uffer), -r(egion), s(tring), w(ord) ]." - (interactive "P\nc") - (setq prefix-arg arg) ; seems not needed - (cond ((char-equal unit ?b) (call-interactively 'spell-buffer)) - ((char-equal unit ?r) (call-interactively 'spell-region)) - ((char-equal unit ?s) (call-interactively 'spell-string)) - ((char-equal unit ?w) (call-interactively 'spell-word)) - (t (message "Spell check: b(uffer), r(egion), s(tring), w(ord)") - (setq unit (read-char)) - (vi-verify-spelling arg unit)))) - -(defun vi-do-old-mode-C-c-command (arg) - "This is a hack for accessing mode specific C-c commands in vi-mode." - (interactive "P") - (let ((cmd (lookup-key vi-mode-old-local-map - (concat "\C-c" (char-to-string (read-char)))))) - (if (catch 'exit-vi-mode ; kludge hack due to dynamic binding - ; of case-fold-search - (if (null cmd) - (progn (ding) nil) - (let ((case-fold-search vi-mode-old-case-fold)) ; a hack - (setq prefix-arg arg) - (command-execute cmd nil) - nil))) - (progn - (vi-back-to-old-mode) - (setq prefix-arg arg) - (command-execute cmd nil))))) - -(defun vi-quote-words (arg char) - "Quote ARG words from the word point is on with pattern specified by CHAR. -Currently, CHAR could be [,{,(,\",',`,<,*, etc." - (interactive "*p\nc") - (while (not (string-match "[[({<\"'`*]" (char-to-string char))) - (message "Enter any of [,{,(,<,\",',`,* as quoting character.") - (setq char (read-char))) - (vi-set-last-change-command 'vi-quote-words arg char) - (if (not (looking-at "\\<")) (forward-word -1)) - (insert char) - (cond ((char-equal char ?[) (setq char ?])) - ((char-equal char ?{) (setq char ?})) - ((char-equal char ?<) (setq char ?>)) - ((char-equal char ?() (setq char ?))) - ((char-equal char ?`) (setq char ?'))) - (vi-end-of-word arg) - (forward-char 1) - (insert char)) - -(defun vi-locate-def () - "Locate definition in current file for the name before the point. -It assumes a `(def..' always starts at the beginning of a line." - (interactive) - (let (name) - (save-excursion - (setq name (buffer-substring (progn (vi-backward-blank-delimited-word 1) - (skip-chars-forward "^a-zA-Z") - (point)) - (progn (vi-end-of-blank-delimited-word 1) - (forward-char) - (skip-chars-backward "^a-zA-Z") - (point))))) - (set-mark-command nil) - (goto-char (point-min)) - (if (re-search-forward (concat "^(def[unvarconst ]*" name) nil t) - nil - (ding) - (message "No definition for \"%s\" in current file." name) - (set-mark-command t)))) - -(defun vi-split-open-line (arg) - "Insert a newline and leave point before it. -With ARG, inserts that many newlines." - (interactive "*p") - (vi-goto-insert-state 1 - (list (function (lambda (arg) - (let ((flag (and (bolp) (not (bobp))))) - (if flag (forward-char -1)) - (while (> arg 0) - (save-excursion - (insert ?\n) - (if fill-prefix (insert fill-prefix))) - (setq arg (1- arg))) - (if flag (forward-char 1))))) arg) - t)) - -(provide 'vi) - -;;; vi.el ends here diff --git a/lisp/emulation/vip.el b/lisp/emulation/vip.el deleted file mode 100644 index 09456e6320b..00000000000 --- a/lisp/emulation/vip.el +++ /dev/null @@ -1,3059 +0,0 @@ -;;; vip.el --- a VI Package for GNU Emacs - -;; Copyright (C) 1986-1988, 1992-1993, 1998, 2001-2014 Free Software -;; Foundation, Inc. - -;; Author: Masahiko Sato -;; 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 . - -;;; Commentary: - -;; A full-featured vi(1) emulator. -;; -;; In Japan, the author's address is: masahiko@sato.riec.tohoku.junet -;; -;; Send suggestions and bug reports to one of the above addresses. -;; When you report a bug, be sure to include the version number of VIP and -;; Emacs you are using. - -;; Execute info command by typing "M-x info" to get information on VIP. - -;;; Code: - -(defgroup vip nil - "A VI Package for GNU Emacs." - :prefix "vip-" - :group 'emulations) - -;; external variables - -(defvar vip-emacs-local-map nil - "Local map used in Emacs mode. (Buffer-specific.)") - -(defvar vip-insert-local-map nil - "Local map used in insert command mode. (Buffer-specific.)") - -(make-variable-buffer-local 'vip-emacs-local-map) -(make-variable-buffer-local 'vip-insert-local-map) - -(defvar vip-insert-point nil - "Remember insert point as a marker. (Buffer-specific.)") - -(set-default 'vip-insert-point (make-marker)) -(make-variable-buffer-local 'vip-insert-point) - -(defvar vip-com-point nil - "Remember com point as a marker. (Buffer-specific.)") - -(set-default 'vip-com-point (make-marker)) -(make-variable-buffer-local 'vip-com-point) - -(defvar vip-current-mode nil - "Current mode. One of `emacs-mode', `vi-mode', `insert-mode'.") - -(make-variable-buffer-local 'vip-current-mode) -(setq-default vip-current-mode 'emacs-mode) - -(defvar vip-emacs-mode-line-buffer-identification nil - "Value of mode-line-buffer-identification in Emacs mode within vip.") -(make-variable-buffer-local 'vip-emacs-mode-line-buffer-identification) -(setq-default vip-emacs-mode-line-buffer-identification - '("Emacs: %17b")) - -(defvar vip-current-major-mode nil - "vip-current-major-mode is the major-mode vi considers it is now. -\(buffer specific\)") - -(make-variable-buffer-local 'vip-current-major-mode) - -(defvar vip-last-shell-com nil - "Last shell command executed by ! command.") - -(defvar vip-use-register nil - "Name of register to store deleted or yanked strings.") - -(defvar vip-d-com nil - "How to reexecute last destructive command. Value is list (M-COM VAL COM).") - -(defcustom vip-shift-width 8 - "The number of columns shifted by > and < command." - :type 'integer - :group 'vip) - -(defcustom vip-re-replace nil - "If t then do regexp replace, if nil then do string replace." - :type 'boolean - :group 'vip) - -(defvar vip-d-char nil - "The character remembered by the vi \"r\" command.") - -(defvar vip-f-char nil - "For use by \";\" command.") - -(defvar vip-F-char nil - "For use by \".\" command.") - -(defvar vip-f-forward nil - "For use by \";\" command.") - -(defvar vip-f-offset nil - "For use by \";\" command.") - -(defcustom vip-search-wrap-around t - "If t, search wraps around." - :type 'boolean - :group 'vip) - -(defcustom vip-re-search nil - "If t, search is reg-exp search, otherwise vanilla search." - :type 'boolean - :group 'vip) - -(defvar vip-s-string nil - "Last vip search string.") - -(defvar vip-s-forward nil - "If t, search is forward.") - -(defcustom vip-case-fold-search nil - "If t, search ignores cases." - :type 'boolean - :group 'vip) - -(defcustom vip-re-query-replace nil - "If t then do regexp replace, if nil then do string replace." - :type 'boolean - :group 'vip) - -(defcustom vip-open-with-indent nil - "If t, indent when open a new line." - :type 'boolean - :group 'vip) - -(defcustom vip-help-in-insert-mode nil - "If t then C-h is bound to help-command in insert mode. -If nil then it is bound to `delete-backward-char'." - :type 'boolean - :group 'vip) - -(defvar vip-quote-string "> " - "String inserted at the beginning of region.") - -(defvar vip-tags-file-name "TAGS") - -(defvar vip-inhibit-startup-message nil) - -(defvar vip-startup-file (locate-user-emacs-file "vip" ".vip") - "Filename used as startup file for vip.") - -;; key bindings - -(defvar vip-mode-map - (let ((map (make-keymap))) - (define-key map "\C-a" 'beginning-of-line) - (define-key map "\C-b" 'vip-scroll-back) - (define-key map "\C-c" 'vip-ctl-c) - (define-key map "\C-d" 'vip-scroll-up) - (define-key map "\C-e" 'vip-scroll-up-one) - (define-key map "\C-f" 'vip-scroll) - (define-key map "\C-g" 'vip-keyboard-quit) - (define-key map "\C-h" 'help-command) - (define-key map "\C-m" 'vip-scroll-back) - (define-key map "\C-n" 'vip-other-window) - (define-key map "\C-o" 'vip-open-line-at-point) - (define-key map "\C-u" 'vip-scroll-down) - (define-key map "\C-x" 'vip-ctl-x) - (define-key map "\C-y" 'vip-scroll-down-one) - (define-key map "\C-z" 'vip-change-mode-to-emacs) - (define-key map "\e" 'vip-ESC) - - (define-key map [?\S-\ ] 'vip-scroll-back) - (define-key map " " 'vip-scroll) - (define-key map "!" 'vip-command-argument) - (define-key map "\"" 'vip-command-argument) - (define-key map "#" 'vip-command-argument) - (define-key map "$" 'vip-goto-eol) - (define-key map "%" 'vip-paren-match) - (define-key map "&" 'vip-nil) - (define-key map "'" 'vip-goto-mark-and-skip-white) - (define-key map "(" 'vip-backward-sentence) - (define-key map ")" 'vip-forward-sentence) - (define-key map "*" 'call-last-kbd-macro) - (define-key map "+" 'vip-next-line-at-bol) - (define-key map "," 'vip-repeat-find-opposite) - (define-key map "-" 'vip-previous-line-at-bol) - (define-key map "." 'vip-repeat) - (define-key map "/" 'vip-search-forward) - - (define-key map "0" 'vip-beginning-of-line) - (define-key map "1" 'vip-digit-argument) - (define-key map "2" 'vip-digit-argument) - (define-key map "3" 'vip-digit-argument) - (define-key map "4" 'vip-digit-argument) - (define-key map "5" 'vip-digit-argument) - (define-key map "6" 'vip-digit-argument) - (define-key map "7" 'vip-digit-argument) - (define-key map "8" 'vip-digit-argument) - (define-key map "9" 'vip-digit-argument) - - (define-key map ":" 'vip-ex) - (define-key map ";" 'vip-repeat-find) - (define-key map "<" 'vip-command-argument) - (define-key map "=" 'vip-command-argument) - (define-key map ">" 'vip-command-argument) - (define-key map "?" 'vip-search-backward) - (define-key map "@" 'vip-nil) - - (define-key map "A" 'vip-Append) - (define-key map "B" 'vip-backward-Word) - (define-key map "C" 'vip-ctl-c-equivalent) - (define-key map "D" 'vip-kill-line) - (define-key map "E" 'vip-end-of-Word) - (define-key map "F" 'vip-find-char-backward) - (define-key map "G" 'vip-goto-line) - (define-key map "H" 'vip-window-top) - (define-key map "I" 'vip-Insert) - (define-key map "J" 'vip-join-lines) - (define-key map "K" 'vip-kill-buffer) - (define-key map "L" 'vip-window-bottom) - (define-key map "M" 'vip-window-middle) - (define-key map "N" 'vip-search-Next) - (define-key map "O" 'vip-Open-line) - (define-key map "P" 'vip-Put-back) - (define-key map "Q" 'vip-query-replace) - (define-key map "R" 'vip-replace-string) - (define-key map "S" 'vip-switch-to-buffer-other-window) - (define-key map "T" 'vip-goto-char-backward) - (define-key map "U" 'vip-nil) - (define-key map "V" 'vip-find-file-other-window) - (define-key map "W" 'vip-forward-Word) - (define-key map "X" 'vip-ctl-x-equivalent) - (define-key map "Y" 'vip-yank-line) - (define-key map "ZZ" 'save-buffers-kill-emacs) - - (define-key map "[" 'vip-nil) - (define-key map "\\" 'vip-escape-to-emacs) - (define-key map "]" 'vip-nil) - (define-key map "^" 'vip-bol-and-skip-white) - (define-key map "_" 'vip-nil) - (define-key map "`" 'vip-goto-mark) - - (define-key map "a" 'vip-append) - (define-key map "b" 'vip-backward-word) - (define-key map "c" 'vip-command-argument) - (define-key map "d" 'vip-command-argument) - (define-key map "e" 'vip-end-of-word) - (define-key map "f" 'vip-find-char-forward) - (define-key map "g" 'vip-info-on-file) - (define-key map "h" 'vip-backward-char) - (define-key map "i" 'vip-insert) - (define-key map "j" 'vip-next-line) - (define-key map "k" 'vip-previous-line) - (define-key map "l" 'vip-forward-char) - (define-key map "m" 'vip-mark-point) - (define-key map "n" 'vip-search-next) - (define-key map "o" 'vip-open-line) - (define-key map "p" 'vip-put-back) - (define-key map "q" 'vip-nil) - (define-key map "r" 'vip-replace-char) - (define-key map "s" 'vip-switch-to-buffer) - (define-key map "t" 'vip-goto-char-forward) - (define-key map "u" 'vip-undo) - (define-key map "v" 'vip-find-file) - (define-key map "w" 'vip-forward-word) - (define-key map "x" 'vip-delete-char) - (define-key map "y" 'vip-command-argument) - (define-key map "zH" 'vip-line-to-top) - (define-key map "zM" 'vip-line-to-middle) - (define-key map "zL" 'vip-line-to-bottom) - (define-key map "z\C-m" 'vip-line-to-top) - (define-key map "z." 'vip-line-to-middle) - (define-key map "z-" 'vip-line-to-bottom) - - (define-key map "{" 'vip-backward-paragraph) - (define-key map "|" 'vip-goto-col) - (define-key map "}" 'vip-forward-paragraph) - (define-key map "~" 'vip-nil) - (define-key map "\177" 'vip-delete-backward-char) - map)) - -(defun vip-version () - (interactive) - (message "VIP version 3.5 of September 15, 1987")) - - -;; basic set up - -;;;###autoload -(defun vip-setup () - "Set up bindings for C-x 7 and C-z that are useful for VIP users." - (define-key ctl-x-map "7" 'vip-buffer-in-two-windows) - (global-set-key "\C-z" 'vip-change-mode-to-vi)) - -(defmacro vip-loop (count body) - "(COUNT BODY) Execute BODY COUNT times." - `(let ((count ,count)) - (while (> count 0) - ,body - (setq count (1- count))))) - -(defun vip-push-mark-silent (&optional location) - "Set mark at LOCATION (point, by default) and push old mark on mark ring. -No message." - (if (null (mark t)) - nil - (setq mark-ring (cons (copy-marker (mark-marker)) mark-ring)) - (if (> (length mark-ring) mark-ring-max) - (progn - (move-marker (car (nthcdr mark-ring-max mark-ring)) nil) - (setcdr (nthcdr (1- mark-ring-max) mark-ring) nil)))) - (set-mark (or location (point)))) - -(defun vip-goto-col (arg) - "Go to ARG's column." - (interactive "P") - (let ((val (vip-p-val arg)) - (com (vip-getcom arg))) - (save-excursion - (end-of-line) - (if (> val (1+ (current-column))) (error ""))) - (if com (move-marker vip-com-point (point))) - (beginning-of-line) - (forward-char (1- val)) - (if com (vip-execute-com 'vip-goto-col val com)))) - -(defun vip-copy-keymap (map) - (if (null map) (make-sparse-keymap) (copy-keymap map))) - - -;; changing mode - -(defun vip-change-mode (new-mode) - "Change mode to NEW-MODE---either emacs-mode, vi-mode, or insert-mode." - (or (eq new-mode vip-current-mode) - (progn - (cond ((eq new-mode 'vi-mode) - (if (eq vip-current-mode 'insert-mode) - (progn - (vip-copy-region-as-kill (point) vip-insert-point) - (vip-repeat-insert-command)) - (setq vip-emacs-local-map (current-local-map) - vip-emacs-mode-line-buffer-identification - mode-line-buffer-identification - vip-insert-local-map (vip-copy-keymap - (current-local-map)))) - (vip-change-mode-line "Vi: ") - (use-local-map vip-mode-map)) - ((eq new-mode 'insert-mode) - (move-marker vip-insert-point (point)) - (if (eq vip-current-mode 'emacs-mode) - (setq vip-emacs-local-map (current-local-map) - vip-emacs-mode-line-buffer-identification - mode-line-buffer-identification - vip-insert-local-map (vip-copy-keymap - (current-local-map))) - (setq vip-insert-local-map (vip-copy-keymap - vip-emacs-local-map))) - (vip-change-mode-line "Insert") - (use-local-map vip-insert-local-map) - (define-key vip-insert-local-map "\e" 'vip-change-mode-to-vi) - (define-key vip-insert-local-map "\C-z" 'vip-ESC) - (define-key vip-insert-local-map "\C-h" - (if vip-help-in-insert-mode 'help-command - 'delete-backward-char)) - (define-key vip-insert-local-map "\C-w" - 'vip-delete-backward-word)) - ((eq new-mode 'emacs-mode) - (vip-change-mode-line "Emacs:") - (use-local-map vip-emacs-local-map))) - (setq vip-current-mode new-mode) - (force-mode-line-update)))) - -(defun vip-copy-region-as-kill (beg end) - "If BEG and END do not belong to the same buffer, it copies empty region." - (condition-case nil - (copy-region-as-kill beg end) - (error (copy-region-as-kill beg beg)))) - -(defun vip-change-mode-line (string) - "Assuming that the mode line format contains the string \"Emacs:\", this -function replaces the string by \"Vi: \" etc." - (setq mode-line-buffer-identification - (if (string= string "Emacs:") - vip-emacs-mode-line-buffer-identification - (list (concat string " %17b"))))) - -;;;###autoload -(defun vip-mode () - "Turn on VIP emulation of VI." - (interactive) - (if (not vip-inhibit-startup-message) - (progn - (switch-to-buffer "VIP Startup Message") - (erase-buffer) - (insert - "VIP is a Vi emulation package for GNU Emacs. VIP provides most Vi commands -including Ex commands. VIP is however different from Vi in several points. -You can get more information on VIP by: - 1. Typing `M-x info' and selecting menu item \"vip\". - 2. Typing `C-h k' followed by a key whose description you want. - 3. Printing VIP manual which can be found as GNU/man/vip.texinfo - 4. Printing VIP Reference Card which can be found as GNU/etc/vipcard.tex - -This startup message appears whenever you load VIP unless you type `y' now. -Type `n' to quit this window for now.\n") - (goto-char (point-min)) - (if (y-or-n-p "Inhibit VIP startup message? ") - (progn - (with-current-buffer - (find-file-noselect - (substitute-in-file-name vip-startup-file)) - (goto-char (point-max)) - (insert "\n(setq vip-inhibit-startup-message t)\n") - (save-buffer) - (kill-buffer (current-buffer))) - (message "VIP startup message inhibited.") - (sit-for 2))) - (kill-buffer (current-buffer)) - (message "") - (setq vip-inhibit-startup-message t))) - (vip-change-mode-to-vi)) - -(defun vip-change-mode-to-vi () - "Change mode to vi mode." - (interactive) - (vip-change-mode 'vi-mode)) - -(defun vip-change-mode-to-insert () - "Change mode to insert mode." - (interactive) - (vip-change-mode 'insert-mode)) - -(defun vip-change-mode-to-emacs () - "Change mode to Emacs mode." - (interactive) - (vip-change-mode 'emacs-mode)) - - -;; escape to emacs mode temporarily - -(defun vip-escape-to-emacs (arg &optional events) - "Escape to Emacs mode for one Emacs command. -ARG is used as the prefix value for the executed command. If -EVENTS is a list of events, which become the beginning of the command." - (interactive "P") - (let (com key (old-map (current-local-map))) - (if events (setq unread-command-events events)) - (setq prefix-arg arg) - (use-local-map vip-emacs-local-map) - (unwind-protect - (setq com (key-binding (setq key (read-key-sequence nil)))) - (use-local-map old-map)) - (command-execute com prefix-arg) - (setq prefix-arg nil) ;; reset prefix arg - )) - -(defun vip-message-conditions (conditions) - "Print CONDITIONS as a message." - (let ((case (car conditions)) (msg (cdr conditions))) - (if (null msg) - (message "%s" case) - (message "%s %s" case (prin1-to-string msg))) - (ding))) - -(defun vip-ESC (arg) - "Emulate ESC key in Emacs mode." - (interactive "P") - (vip-escape-to-emacs arg '(?\e))) - -(defun vip-ctl-c (arg) - "Emulate C-c key in Emacs mode." - (interactive "P") - (vip-escape-to-emacs arg '(?\C-c))) - -(defun vip-ctl-x (arg) - "Emulate C-x key in Emacs mode." - (interactive "P") - (vip-escape-to-emacs arg '(?\C-x))) - -(defun vip-ctl-h (arg) - "Emulate C-h key in Emacs mode." - (interactive "P") - (vip-escape-to-emacs arg '(?\C-h))) - - -;; prefix argument for vi mode - -;; In vi mode, prefix argument is a dotted pair (NUM . COM) where NUM -;; represents the numeric value of the prefix argument and COM represents -;; command prefix such as "c", "d", "m" and "y". - -(defun vip-prefix-arg-value (char value com) - "Compute numeric prefix arg value. Invoked by CHAR. VALUE is the value -obtained so far, and COM is the command part obtained so far." - (while (and (>= char ?0) (<= char ?9)) - (setq value (+ (* (if (numberp value) value 0) 10) (- char ?0))) - (setq char (read-char))) - (setq prefix-arg value) - (if com (setq prefix-arg (cons prefix-arg com))) - (while (= char ?U) - (vip-describe-arg prefix-arg) - (setq char (read-char))) - (setq unread-command-events (list char))) - -(defun vip-prefix-arg-com (char value com) - "Vi operator as prefix argument." - (let ((cont t)) - (while (and cont - (or (= char ?c) (= char ?d) (= char ?y) - (= char ?!) (= char ?<) (= char ?>) (= char ?=) - (= char ?#) (= char ?r) (= char ?R) (= char ?\"))) - (if com - ;; this means that we already have a command character, so we - ;; construct a com list and exit while. however, if char is " - ;; it is an error. - (progn - ;; new com is (CHAR . OLDCOM) - (if (or (= char ?#) (= char ?\")) (error "")) - (setq com (cons char com)) - (setq cont nil)) - ;; if com is nil we set com as char, and read more. again, if char - ;; is ", we read the name of register and store it in vip-use-register. - ;; if char is !, =, or #, a complete com is formed so we exit while. - (cond ((or (= char ?!) (= char ?=)) - (setq com char) - (setq char (read-char)) - (setq cont nil)) - ((= char ?#) - ;; read a char and encode it as com - (setq com (+ 128 (read-char))) - (setq char (read-char)) - (setq cont nil)) - ((or (= char ?<) (= char ?>)) - (setq com char) - (setq char (read-char)) - (if (= com char) (setq com (cons char com))) - (setq cont nil)) - ((= char ?\") - (let ((reg (read-char))) - (if (or (and (<= ?A reg) (<= reg ?z)) - (and (<= ?1 reg) (<= reg ?9))) - (setq vip-use-register reg) - (error "")) - (setq char (read-char)))) - (t - (setq com char) - (setq char (read-char))))))) - (if (atom com) - ;; com is a single char, so we construct prefix-arg - ;; and if char is ?, describe prefix arg, otherwise exit by - ;; pushing the char back - (progn - (setq prefix-arg (cons value com)) - (while (= char ?U) - (vip-describe-arg prefix-arg) - (setq char (read-char))) - (setq unread-command-events (list char))) - ;; as com is non-nil, this means that we have a command to execute - (if (or (= (car com) ?r) (= (car com) ?R)) - ;; execute appropriate region command. - (let ((char (car com)) (com (cdr com))) - (setq prefix-arg (cons value com)) - (if (= char ?r) (vip-region prefix-arg) - (vip-Region prefix-arg)) - ;; reset prefix-arg - (setq prefix-arg nil)) - ;; otherwise, reset prefix arg and call appropriate command - (setq value (if (null value) 1 value)) - (setq prefix-arg nil) - (cond ((equal com '(?c . ?c)) (vip-line (cons value ?C))) - ((equal com '(?d . ?d)) (vip-line (cons value ?D))) - ((equal com '(?d . ?y)) (vip-yank-defun)) - ((equal com '(?y . ?y)) (vip-line (cons value ?Y))) - ((equal com '(?< . ?<)) (vip-line (cons value ?<))) - ((equal com '(?> . ?>)) (vip-line (cons value ?>))) - ((equal com '(?! . ?!)) (vip-line (cons value ?!))) - ((equal com '(?= . ?=)) (vip-line (cons value ?=))) - (t (error "")))))) - -(defun vip-describe-arg (arg) - (let (val com) - (setq val (vip-P-val arg) - com (vip-getcom arg)) - (if (null val) - (if (null com) - (message "Value is nil, and command is nil.") - (message "Value is nil, and command is %c." com)) - (if (null com) - (message "Value is %d, and command is nil." val) - (message "Value is %d, and command is %c." val com))))) - -(defun vip-digit-argument (arg) - "Begin numeric argument for the next command." - (interactive "P") - (vip-prefix-arg-value last-command-event nil - (if (consp arg) (cdr arg) nil))) - -(defun vip-command-argument (arg) - "Accept a motion command as an argument." - (interactive "P") - (condition-case conditions - (vip-prefix-arg-com - last-command-event - (cond ((null arg) nil) - ((consp arg) (car arg)) - ((numberp arg) arg) - (t (error "strange arg"))) - (cond ((null arg) nil) - ((consp arg) (cdr arg)) - ((numberp arg) nil) - (t (error "strange arg")))) - (quit - (setq vip-use-register nil) - (signal 'quit nil)))) - -(defun vip-p-val (arg) - "Get value part of prefix-argument ARG." - (cond ((null arg) 1) - ((consp arg) (if (null (car arg)) 1 (car arg))) - (t arg))) - -(defun vip-P-val (arg) - "Get value part of prefix-argument ARG." - (cond ((consp arg) (car arg)) - (t arg))) - -(defun vip-getcom (arg) - "Get com part of prefix-argument ARG." - (cond ((null arg) nil) - ((consp arg) (cdr arg)) - (t nil))) - -(defun vip-getCom (arg) - "Get com part of prefix-argument ARG and modify it." - (let ((com (vip-getcom arg))) - (cond ((equal com ?c) ?C) - ((equal com ?d) ?D) - ((equal com ?y) ?Y) - (t com)))) - - -;; repeat last destructive command - -(defun vip-append-to-register (reg start end) - "Append region to text in register REG. -START and END are buffer positions indicating what to append." - (set-register reg (concat (or (get-register reg) "") - (buffer-substring start end)))) - -(defun vip-execute-com (m-com val com) - "(M-COM VAL COM) Execute command COM. The list (M-COM VAL COM) is set -to vip-d-com for later use by vip-repeat" - (let ((reg vip-use-register)) - (if com - (cond ((= com ?c) (vip-change vip-com-point (point))) - ((= com (- ?c)) (vip-change-subr vip-com-point (point))) - ((or (= com ?C) (= com (- ?C))) - (save-excursion - (set-mark vip-com-point) - (vip-enlarge-region (mark) (point)) - (if vip-use-register - (progn - (cond ((and (<= ?a vip-use-register) - (<= vip-use-register ?z)) - (copy-to-register - vip-use-register (mark) (point) nil)) - ((and (<= ?A vip-use-register) - (<= vip-use-register ?Z)) - (vip-append-to-register - (+ vip-use-register 32) (mark) (point))) - (t (setq vip-use-register nil) - (error ""))) - (setq vip-use-register nil))) - (delete-region (mark) (point))) - (open-line 1) - (if (= com ?C) (vip-change-mode-to-insert) (yank))) - ((= com ?d) - (if vip-use-register - (progn - (cond ((and (<= ?a vip-use-register) - (<= vip-use-register ?z)) - (copy-to-register - vip-use-register vip-com-point (point) nil)) - ((and (<= ?A vip-use-register) - (<= vip-use-register ?Z)) - (vip-append-to-register - (+ vip-use-register 32) vip-com-point (point))) - (t (setq vip-use-register nil) - (error ""))) - (setq vip-use-register nil))) - (setq last-command - (if (eq last-command 'd-command) 'kill-region nil)) - (kill-region vip-com-point (point)) - (setq this-command 'd-command)) - ((= com ?D) - (save-excursion - (set-mark vip-com-point) - (vip-enlarge-region (mark) (point)) - (if vip-use-register - (progn - (cond ((and (<= ?a vip-use-register) - (<= vip-use-register ?z)) - (copy-to-register - vip-use-register (mark) (point) nil)) - ((and (<= ?A vip-use-register) - (<= vip-use-register ?Z)) - (vip-append-to-register - (+ vip-use-register 32) (mark) (point))) - (t (setq vip-use-register nil) - (error ""))) - (setq vip-use-register nil))) - (setq last-command - (if (eq last-command 'D-command) 'kill-region nil)) - (kill-region (mark) (point)) - (if (eq m-com 'vip-line) (setq this-command 'D-command))) - (back-to-indentation)) - ((= com ?y) - (if vip-use-register - (progn - (cond ((and (<= ?a vip-use-register) - (<= vip-use-register ?z)) - (copy-to-register - vip-use-register vip-com-point (point) nil)) - ((and (<= ?A vip-use-register) - (<= vip-use-register ?Z)) - (vip-append-to-register - (+ vip-use-register 32) vip-com-point (point))) - (t (setq vip-use-register nil) - (error ""))) - (setq vip-use-register nil))) - (setq last-command nil) - (copy-region-as-kill vip-com-point (point)) - (goto-char vip-com-point)) - ((= com ?Y) - (save-excursion - (set-mark vip-com-point) - (vip-enlarge-region (mark) (point)) - (if vip-use-register - (progn - (cond ((and (<= ?a vip-use-register) - (<= vip-use-register ?z)) - (copy-to-register - vip-use-register (mark) (point) nil)) - ((and (<= ?A vip-use-register) - (<= vip-use-register ?Z)) - (vip-append-to-register - (+ vip-use-register 32) (mark) (point))) - (t (setq vip-use-register nil) - (error ""))) - (setq vip-use-register nil))) - (setq last-command nil) - (copy-region-as-kill (mark) (point))) - (goto-char vip-com-point)) - ((or (= com ?!) (= com (- ?!))) - (save-excursion - (set-mark vip-com-point) - (vip-enlarge-region (mark) (point)) - (shell-command-on-region - (mark) (point) - (if (= com ?!) - (setq vip-last-shell-com (vip-read-string "!")) - vip-last-shell-com) - t t))) - ((= com ?=) - (save-excursion - (set-mark vip-com-point) - (vip-enlarge-region (mark) (point)) - (if (> (mark) (point)) (exchange-point-and-mark)) - (indent-region (mark) (point) nil))) - ((= com ?<) - (save-excursion - (set-mark vip-com-point) - (vip-enlarge-region (mark) (point)) - (indent-rigidly (mark) (point) (- vip-shift-width))) - (goto-char vip-com-point)) - ((= com ?>) - (save-excursion - (set-mark vip-com-point) - (vip-enlarge-region (mark) (point)) - (indent-rigidly (mark) (point) vip-shift-width)) - (goto-char vip-com-point)) - ((>= com 128) - ;; this is special command # - (vip-special-prefix-com (- com 128))))) - (setq vip-d-com (list m-com val (if (or (= com ?c) (= com ?C) (= com ?!)) - (- com) com) - reg)))) - -(defun vip-repeat (arg) - "(ARG) Re-execute last destructive command. vip-d-com has the form -\(COM ARG CH REG), where COM is the command to be re-executed, ARG is the -argument for COM, CH is a flag for repeat, and REG is optional and if exists -is the name of the register for COM." - (interactive "P") - (if (eq last-command 'vip-undo) - ;; if the last command was vip-undo, then undo-more - (vip-undo-more) - ;; otherwise execute the command stored in vip-d-com. if arg is non-nil - ;; its prefix value is used as new prefix value for the command. - (let ((m-com (car vip-d-com)) - (val (vip-P-val arg)) - (com (car (cdr (cdr vip-d-com)))) - (reg (nth 3 vip-d-com))) - (if (null val) (setq val (car (cdr vip-d-com)))) - (if (null m-com) (error "No previous command to repeat")) - (setq vip-use-register reg) - (funcall m-com (cons val com))))) - -(defun vip-special-prefix-com (char) - "This command is invoked interactively by the key sequence #" - (cond ((= char ?c) - (downcase-region (min vip-com-point (point)) - (max vip-com-point (point)))) - ((= char ?C) - (upcase-region (min vip-com-point (point)) - (max vip-com-point (point)))) - ((= char ?g) - (set-mark vip-com-point) - (vip-global-execute)) - ((= char ?q) - (set-mark vip-com-point) - (vip-quote-region)) - ((= char ?s) (ispell-region vip-com-point (point))))) - - -;; undoing - -(defun vip-undo () - "Undo previous change." - (interactive) - (message "undo!") - (undo-start) - (undo-more 2) - (setq this-command 'vip-undo)) - -(defun vip-undo-more () - "Continue undoing previous changes." - (message "undo more!") - (undo-more 1) - (setq this-command 'vip-undo)) - - -;; utilities - -(defun vip-string-tail (str) - (if (or (null str) (string= str "")) nil - (substring str 1))) - -(defun vip-yank-defun () - (mark-defun) - (copy-region-as-kill (point) (mark))) - -(defun vip-enlarge-region (beg end) - "Enlarge region between BEG and END." - (if (< beg end) - (progn (goto-char beg) (set-mark end)) - (goto-char end) - (set-mark beg)) - (beginning-of-line) - (exchange-point-and-mark) - (if (or (not (eobp)) (not (bolp))) (with-no-warnings (next-line 1))) - (beginning-of-line) - (if (> beg end) (exchange-point-and-mark))) - -(defun vip-global-execute () - "Call last keyboard macro for each line in the region." - (if (> (point) (mark)) (exchange-point-and-mark)) - (beginning-of-line) - (call-last-kbd-macro) - (while (< (point) (mark)) - (forward-line 1) - (beginning-of-line) - (call-last-kbd-macro))) - -(defun vip-quote-region () - "Quote region by inserting the user supplied string at the beginning of -each line in the region." - (setq vip-quote-string - (let ((str - (vip-read-string (format "quote string (default %s): " - vip-quote-string)))) - (if (string= str "") vip-quote-string str))) - (vip-enlarge-region (point) (mark)) - (if (> (point) (mark)) (exchange-point-and-mark)) - (insert vip-quote-string) - (beginning-of-line) - (forward-line 1) - (while (and (< (point) (mark)) (bolp)) - (insert vip-quote-string) - (beginning-of-line) - (forward-line 1))) - -(defun vip-end-with-a-newline-p (string) - "Check if the string ends with a newline." - (or (string= string "") - (= (aref string (1- (length string))) ?\n))) - -(defvar vip-save-minibuffer-local-map) - -(defun vip-read-string (prompt &optional init) - (setq vip-save-minibuffer-local-map (copy-keymap minibuffer-local-map)) - (define-key minibuffer-local-map "\C-h" 'backward-char) - (define-key minibuffer-local-map "\C-w" 'backward-word) - (define-key minibuffer-local-map "\e" 'exit-minibuffer) - (let (str) - (condition-case conditions - (setq str (read-string prompt init)) - (quit - (setq minibuffer-local-map vip-save-minibuffer-local-map) - (signal 'quit nil))) - (setq minibuffer-local-map vip-save-minibuffer-local-map) - str)) - - -;; insertion commands - -(defun vip-repeat-insert-command () - "This function is called when mode changes from insertion mode to -vi command mode. It will repeat the insertion command if original insertion -command was invoked with argument > 1." - (let ((i-com (car vip-d-com)) (val (car (cdr vip-d-com)))) - (if (and val (> val 1)) ;; first check that val is non-nil - (progn - (setq vip-d-com (list i-com (1- val) ?r)) - (vip-repeat nil) - (setq vip-d-com (list i-com val ?r)))))) - -(defun vip-insert (arg) "" - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getcom arg))) - (setq vip-d-com (list 'vip-insert val ?r)) - (if com (vip-loop val (yank)) - (vip-change-mode-to-insert)))) - -(defun vip-append (arg) - "Append after point." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getcom arg))) - (setq vip-d-com (list 'vip-append val ?r)) - (if (not (eolp)) (forward-char)) - (if (equal com ?r) - (vip-loop val (yank)) - (vip-change-mode-to-insert)))) - -(defun vip-Append (arg) - "Append at end of line." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getcom arg))) - (setq vip-d-com (list 'vip-Append val ?r)) - (end-of-line) - (if (equal com ?r) - (vip-loop val (yank)) - (vip-change-mode-to-insert)))) - -(defun vip-Insert (arg) - "Insert before first non-white." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getcom arg))) - (setq vip-d-com (list 'vip-Insert val ?r)) - (back-to-indentation) - (if (equal com ?r) - (vip-loop val (yank)) - (vip-change-mode-to-insert)))) - -(defun vip-open-line (arg) - "Open line below." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getcom arg))) - (setq vip-d-com (list 'vip-open-line val ?r)) - (let ((col (current-indentation))) - (if (equal com ?r) - (vip-loop val - (progn - (end-of-line) - (newline 1) - (if vip-open-with-indent (indent-to col)) - (yank))) - (end-of-line) - (newline 1) - (if vip-open-with-indent (indent-to col)) - (vip-change-mode-to-insert))))) - -(defun vip-Open-line (arg) - "Open line above." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getcom arg))) - (setq vip-d-com (list 'vip-Open-line val ?r)) - (let ((col (current-indentation))) - (if (equal com ?r) - (vip-loop val - (progn - (beginning-of-line) - (open-line 1) - (if vip-open-with-indent (indent-to col)) - (yank))) - (beginning-of-line) - (open-line 1) - (if vip-open-with-indent (indent-to col)) - (vip-change-mode-to-insert))))) - -(defun vip-open-line-at-point (arg) - "Open line at point." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getcom arg))) - (setq vip-d-com (list 'vip-open-line-at-point val ?r)) - (if (equal com ?r) - (vip-loop val - (progn - (open-line 1) - (yank))) - (open-line 1) - (vip-change-mode-to-insert)))) - -(defun vip-substitute (arg) - "Substitute characters." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getcom arg))) - (save-excursion - (set-mark (point)) - (forward-char val) - (if (equal com ?r) - (vip-change-subr (mark) (point)) - (vip-change (mark) (point)))) - (setq vip-d-com (list 'vip-substitute val ?r)))) - -(defun vip-substitute-line (arg) - "Substitute lines." - (interactive "p") - (vip-line (cons arg ?C))) - - -;; line command - -(defun vip-line (arg) - (let ((val (car arg)) (com (cdr arg))) - (move-marker vip-com-point (point)) - (with-no-warnings (next-line (1- val))) - (vip-execute-com 'vip-line val com))) - -(defun vip-yank-line (arg) - "Yank ARG lines (in vi's sense)" - (interactive "P") - (let ((val (vip-p-val arg))) - (vip-line (cons val ?Y)))) - - -;; region command - -(defun vip-region (arg) - (interactive "P") - (let ((val (vip-P-val arg)) - (com (vip-getcom arg))) - (move-marker vip-com-point (point)) - (exchange-point-and-mark) - (vip-execute-com 'vip-region val com))) - -(defun vip-Region (arg) - (interactive "P") - (let ((val (vip-P-val arg)) - (com (vip-getCom arg))) - (move-marker vip-com-point (point)) - (exchange-point-and-mark) - (vip-execute-com 'vip-Region val com))) - -(defun vip-replace-char (arg) - "Replace the following ARG chars by the character read." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getcom arg))) - (setq vip-d-com (list 'vip-replace-char val ?r)) - (vip-replace-char-subr (if (equal com ?r) vip-d-char (read-char)) val))) - -(defun vip-replace-char-subr (char arg) - (delete-char arg t) - (setq vip-d-char char) - (vip-loop (if (> arg 0) arg (- arg)) (insert char)) - (backward-char arg)) - -(defun vip-replace-string () - "Replace string. If you supply null string as the string to be replaced, -the query replace mode will toggle between string replace and regexp replace." - (interactive) - (let (str) - (setq str (vip-read-string - (if vip-re-replace "Replace regexp: " "Replace string: "))) - (if (string= str "") - (progn - (setq vip-re-replace (not vip-re-replace)) - (message "Replace mode changed to %s." - (if vip-re-replace "regexp replace" - "string replace"))) - (if vip-re-replace - ;; (replace-regexp - ;; str - ;; (vip-read-string (format "Replace regexp \"%s\" with: " str))) - (while (re-search-forward str nil t) - (replace-match (vip-read-string - (format "Replace regexp \"%s\" with: " str)) - nil nil)) - (with-no-warnings - (replace-string - str - (vip-read-string (format "Replace \"%s\" with: " str)))))))) - - -;; basic cursor movement. j, k, l, m commands. - -(defun vip-forward-char (arg) - "Move point right ARG characters (left if ARG negative).On reaching end -of buffer, stop and signal error." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getcom arg))) - (if com (move-marker vip-com-point (point))) - (forward-char val) - (if com (vip-execute-com 'vip-forward-char val com)))) - -(defun vip-backward-char (arg) - "Move point left ARG characters (right if ARG negative). On reaching -beginning of buffer, stop and signal error." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getcom arg))) - (if com (move-marker vip-com-point (point))) - (backward-char val) - (if com (vip-execute-com 'vip-backward-char val com)))) - - -;; word command - -(defun vip-forward-word (arg) - "Forward word." - (interactive "P") - (let ((val (vip-p-val arg)) - (com (vip-getcom arg))) - (if com (move-marker vip-com-point (point))) - (forward-word val) - (skip-chars-forward " \t\n") - (if com - (progn - (if (or (= com ?c) (= com (- ?c))) - (progn (backward-word 1) (forward-word 1))) - (if (or (= com ?d) (= com ?y)) - (progn - (backward-word 1) - (forward-word 1) - (skip-chars-forward " \t"))) - (vip-execute-com 'vip-forward-word val com))))) - -(defun vip-end-of-word (arg) - "Move point to end of current word." - (interactive "P") - (let ((val (vip-p-val arg)) - (com (vip-getcom arg))) - (if com (move-marker vip-com-point (point))) - (forward-char) - (forward-word val) - (backward-char) - (if com - (progn - (forward-char) - (vip-execute-com 'vip-end-of-word val com))))) - -(defun vip-backward-word (arg) - "Backward word." - (interactive "P") - (let ((val (vip-p-val arg)) - (com (vip-getcom arg))) - (if com (move-marker vip-com-point (point))) - (backward-word val) - (if com (vip-execute-com 'vip-backward-word val com)))) - -(defun vip-forward-Word (arg) - "Forward word delimited by white character." - (interactive "P") - (let ((val (vip-p-val arg)) - (com (vip-getcom arg))) - (if com (move-marker vip-com-point (point))) - (re-search-forward "[^ \t\n]*[ \t\n]+" nil t val) - (if com - (progn - (if (or (= com ?c) (= com (- ?c))) - (progn (backward-word 1) (forward-word 1))) - (if (or (= com ?d) (= com ?y)) - (progn - (backward-word 1) - (forward-word 1) - (skip-chars-forward " \t"))) - (vip-execute-com 'vip-forward-Word val com))))) - -(defun vip-end-of-Word (arg) - "Move forward to end of word delimited by white character." - (interactive "P") - (let ((val (vip-p-val arg)) - (com (vip-getcom arg))) - (if com (move-marker vip-com-point (point))) - (forward-char) - (if (re-search-forward "[^ \t\n]+" nil t val) (backward-char)) - (if com - (progn - (forward-char) - (vip-execute-com 'vip-end-of-Word val com))))) - -(defun vip-backward-Word (arg) - "Backward word delimited by white character." - (interactive "P") - (let ((val (vip-p-val arg)) - (com (vip-getcom arg))) - (if com (move-marker vip-com-point (point))) - (if (re-search-backward "[ \t\n]+[^ \t\n]+" nil t val) - (forward-char) - (goto-char (point-min))) - (if com (vip-execute-com 'vip-backward-Word val com)))) - -(defun vip-beginning-of-line (arg) - "Go to beginning of line." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getcom arg))) - (if com (move-marker vip-com-point (point))) - (beginning-of-line val) - (if com (vip-execute-com 'vip-beginning-of-line val com)))) - -(defun vip-bol-and-skip-white (arg) - "Beginning of line at first non-white character." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getcom arg))) - (if com (move-marker vip-com-point (point))) - (back-to-indentation) - (if com (vip-execute-com 'vip-bol-and-skip-white val com)))) - -(defun vip-goto-eol (arg) - "Go to end of line." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getcom arg))) - (if com (move-marker vip-com-point (point))) - (end-of-line val) - (if com (vip-execute-com 'vip-goto-eol val com)))) - -(defun vip-next-line (arg) - "Go to next line." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getCom arg))) - (if com (move-marker vip-com-point (point))) - (line-move val) - (setq this-command 'next-line) - (if com (vip-execute-com 'vip-next-line val com)))) - -(defun vip-next-line-at-bol (arg) - "Next line at beginning of line." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getCom arg))) - (if com (move-marker vip-com-point (point))) - (with-no-warnings (next-line val)) - (back-to-indentation) - (if com (vip-execute-com 'vip-next-line-at-bol val com)))) - -(defun vip-previous-line (arg) - "Go to previous line." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getCom arg))) - (if com (move-marker vip-com-point (point))) - (with-no-warnings (next-line (- val))) - (setq this-command 'previous-line) - (if com (vip-execute-com 'vip-previous-line val com)))) - -(defun vip-previous-line-at-bol (arg) - "Previous line at beginning of line." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getCom arg))) - (if com (move-marker vip-com-point (point))) - (with-no-warnings (next-line (- val))) - (back-to-indentation) - (if com (vip-execute-com 'vip-previous-line val com)))) - -(defun vip-change-to-eol (arg) - "Change to end of line." - (interactive "P") - (vip-goto-eol (cons arg ?c))) - -(defun vip-kill-line (arg) - "Delete line." - (interactive "P") - (vip-goto-eol (cons arg ?d))) - - -;; moving around - -(defun vip-goto-line (arg) - "Go to ARG's line. Without ARG go to end of buffer." - (interactive "P") - (let ((val (vip-P-val arg)) (com (vip-getCom arg))) - (move-marker vip-com-point (point)) - (set-mark (point)) - (if (null val) - (goto-char (point-max)) - (goto-char (point-min)) - (forward-line (1- val))) - (back-to-indentation) - (if com (vip-execute-com 'vip-goto-line val com)))) - -(defun vip-find-char (arg char forward offset) - "Find ARG's occurrence of CHAR on the current line. If FORWARD then -search is forward, otherwise backward. OFFSET is used to adjust point -after search." - (let ((arg (if forward arg (- arg))) point) - (save-excursion - (save-restriction - (if (> arg 0) - (narrow-to-region - ;; forward search begins here - (if (eolp) (error "") (point)) - ;; forward search ends here - (progn (with-no-warnings (next-line 1)) (beginning-of-line) (point))) - (narrow-to-region - ;; backward search begins from here - (if (bolp) (error "") (point)) - ;; backward search ends here - (progn (beginning-of-line) (point)))) - ;; if arg > 0, point is forwarded before search. - (if (> arg 0) (goto-char (1+ (point-min))) - (goto-char (point-max))) - (let ((case-fold-search nil)) - (search-forward (char-to-string char) nil 0 arg)) - (setq point (point)) - (if (or (and (> arg 0) (= point (point-max))) - (and (< arg 0) (= point (point-min)))) - (error "")))) - (goto-char (+ point (if (> arg 0) (if offset -2 -1) (if offset 1 0)))))) - -(defun vip-find-char-forward (arg) - "Find char on the line. If called interactively read the char to find -from the terminal, and if called from vip-repeat, the char last used is -used. This behavior is controlled by the sign of prefix numeric value." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getcom arg))) - (if (> val 0) - ;; this means that the function was called interactively - (setq vip-f-char (read-char) - vip-f-forward t - vip-f-offset nil) - (setq val (- val))) - (if com (move-marker vip-com-point (point))) - (vip-find-char val (if (> (vip-p-val arg) 0) vip-f-char vip-F-char) t nil) - (setq val (- val)) - (if com - (progn - (setq vip-F-char vip-f-char);; set new vip-F-char - (forward-char) - (vip-execute-com 'vip-find-char-forward val com))))) - -(defun vip-goto-char-forward (arg) - "Go up to char ARG forward on line." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getcom arg))) - (if (> val 0) - ;; this means that the function was called interactively - (setq vip-f-char (read-char) - vip-f-forward t - vip-f-offset t) - (setq val (- val))) - (if com (move-marker vip-com-point (point))) - (vip-find-char val (if (> (vip-p-val arg) 0) vip-f-char vip-F-char) t t) - (setq val (- val)) - (if com - (progn - (setq vip-F-char vip-f-char);; set new vip-F-char - (forward-char) - (vip-execute-com 'vip-goto-char-forward val com))))) - -(defun vip-find-char-backward (arg) - "Find char ARG on line backward." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getcom arg))) - (if (> val 0) - ;; this means that the function was called interactively - (setq vip-f-char (read-char) - vip-f-forward nil - vip-f-offset nil) - (setq val (- val))) - (if com (move-marker vip-com-point (point))) - (vip-find-char - val (if (> (vip-p-val arg) 0) vip-f-char vip-F-char) nil nil) - (setq val (- val)) - (if com - (progn - (setq vip-F-char vip-f-char);; set new vip-F-char - (vip-execute-com 'vip-find-char-backward val com))))) - -(defun vip-goto-char-backward (arg) - "Go up to char ARG backward on line." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getcom arg))) - (if (> val 0) - ;; this means that the function was called interactively - (setq vip-f-char (read-char) - vip-f-forward nil - vip-f-offset t) - (setq val (- val))) - (if com (move-marker vip-com-point (point))) - (vip-find-char val (if (> (vip-p-val arg) 0) vip-f-char vip-F-char) nil t) - (setq val (- val)) - (if com - (progn - (setq vip-F-char vip-f-char);; set new vip-F-char - (vip-execute-com 'vip-goto-char-backward val com))))) - -(defun vip-repeat-find (arg) - "Repeat previous find command." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getcom arg))) - (if com (move-marker vip-com-point (point))) - (vip-find-char val vip-f-char vip-f-forward vip-f-offset) - (if com - (progn - (if vip-f-forward (forward-char)) - (vip-execute-com 'vip-repeat-find val com))))) - -(defun vip-repeat-find-opposite (arg) - "Repeat previous find command in the opposite direction." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getcom arg))) - (if com (move-marker vip-com-point (point))) - (vip-find-char val vip-f-char (not vip-f-forward) vip-f-offset) - (if com - (progn - (if vip-f-forward (forward-char)) - (vip-execute-com 'vip-repeat-find-opposite val com))))) - - -;; window scrolling etc. - -(defun vip-other-window (arg) - "Switch to other window." - (interactive "p") - (other-window arg) - (or (not (eq vip-current-mode 'emacs-mode)) - (string= (buffer-name (current-buffer)) " *Minibuf-1*") - (vip-change-mode-to-vi))) - -(defun vip-window-top (arg) - "Go to home window line." - (interactive "P") - (let ((val (vip-p-val arg)) - (com (vip-getCom arg))) - (if com (move-marker vip-com-point (point))) - (move-to-window-line (1- val)) - (if com (vip-execute-com 'vip-window-top val com)))) - -(defun vip-window-middle (arg) - "Go to middle window line." - (interactive "P") - (let ((val (vip-p-val arg)) - (com (vip-getCom arg))) - (if com (move-marker vip-com-point (point))) - (move-to-window-line (+ (/ (1- (window-height)) 2) (1- val))) - (if com (vip-execute-com 'vip-window-middle val com)))) - -(defun vip-window-bottom (arg) - "Go to last window line." - (interactive "P") - (let ((val (vip-p-val arg)) - (com (vip-getCom arg))) - (if com (move-marker vip-com-point (point))) - (move-to-window-line (- val)) - (if com (vip-execute-com 'vip-window-bottom val com)))) - -(defun vip-line-to-top (arg) - "Put current line on the home line." - (interactive "p") - (recenter (1- arg))) - -(defun vip-line-to-middle (arg) - "Put current line on the middle line." - (interactive "p") - (recenter (+ (1- arg) (/ (1- (window-height)) 2)))) - -(defun vip-line-to-bottom (arg) - "Put current line on the last line." - (interactive "p") - (recenter (- (window-height) (1+ arg)))) - - -;; paren match - -(defun vip-paren-match (arg) - "Go to the matching parenthesis." - (interactive "P") - (let ((com (vip-getcom arg))) - (if (numberp arg) - (if (or (> arg 99) (< arg 1)) - (error "Prefix must be between 1 and 99") - (goto-char - (if (> (point-max) 80000) - (* (/ (point-max) 100) arg) - (/ (* (point-max) arg) 100))) - (back-to-indentation)) - (cond ((looking-at "[\(\[{]") - (if com (move-marker vip-com-point (point))) - (forward-sexp 1) - (if com - (vip-execute-com 'vip-paren-match nil com) - (backward-char))) - ((looking-at "[])}]") - (forward-char) - (if com (move-marker vip-com-point (point))) - (backward-sexp 1) - (if com (vip-execute-com 'vip-paren-match nil com))) - (t (error "")))))) - - -;; sentence and paragraph - -(defun vip-forward-sentence (arg) - "Forward sentence." - (interactive "P") - (let ((val (vip-p-val arg)) - (com (vip-getcom arg))) - (if com (move-marker vip-com-point (point))) - (forward-sentence val) - (if com (vip-execute-com 'vip-forward-sentence nil com)))) - -(defun vip-backward-sentence (arg) - "Backward sentence." - (interactive "P") - (let ((val (vip-p-val arg)) - (com (vip-getcom arg))) - (if com (move-marker vip-com-point (point))) - (backward-sentence val) - (if com (vip-execute-com 'vip-backward-sentence nil com)))) - -(defun vip-forward-paragraph (arg) - "Forward paragraph." - (interactive "P") - (let ((val (vip-p-val arg)) - (com (vip-getCom arg))) - (if com (move-marker vip-com-point (point))) - (forward-paragraph val) - (if com (vip-execute-com 'vip-forward-paragraph nil com)))) - -(defun vip-backward-paragraph (arg) - "Backward paragraph." - (interactive "P") - (let ((val (vip-p-val arg)) - (com (vip-getCom arg))) - (if com (move-marker vip-com-point (point))) - (backward-paragraph val) - (if com (vip-execute-com 'vip-backward-paragraph nil com)))) - - -;; scrolling - -(defun vip-scroll (arg) - "Scroll to next screen." - (interactive "p") - (if (> arg 0) - (while (> arg 0) - (scroll-up) - (setq arg (1- arg))) - (while (> 0 arg) - (scroll-down) - (setq arg (1+ arg))))) - -(defun vip-scroll-back (arg) - "Scroll to previous screen." - (interactive "p") - (vip-scroll (- arg))) - -(defun vip-scroll-down (arg) - "Scroll up half screen." - (interactive "P") - (if (null arg) (scroll-down (/ (window-height) 2)) - (scroll-down arg))) - -(defun vip-scroll-down-one (arg) - "Scroll up one line." - (interactive "p") - (scroll-down arg)) - -(defun vip-scroll-up (arg) - "Scroll down half screen." - (interactive "P") - (if (null arg) (scroll-up (/ (window-height) 2)) - (scroll-up arg))) - -(defun vip-scroll-up-one (arg) - "Scroll down one line." - (interactive "p") - (scroll-up arg)) - - -;; splitting window - -(defun vip-buffer-in-two-windows () - "Show current buffer in two windows." - (interactive) - (delete-other-windows) - (split-window-below)) - - -;; searching - -(defun vip-search-forward (arg) - "Search a string forward. ARG is used to find the ARG's occurrence -of the string. Default is vanilla search. Search mode can be toggled by -giving null search string." - (interactive "P") - (let ((val (vip-P-val arg)) (com (vip-getcom arg))) - (setq vip-s-forward t - vip-s-string (vip-read-string (if vip-re-search "RE-/" "/"))) - (if (string= vip-s-string "") - (progn - (setq vip-re-search (not vip-re-search)) - (message "Search mode changed to %s search." - (if vip-re-search "regular expression" - "vanilla"))) - (vip-search vip-s-string t val) - (if com - (progn - (move-marker vip-com-point (mark)) - (vip-execute-com 'vip-search-next val com)))))) - -(defun vip-search-backward (arg) - "Search a string backward. ARG is used to find the ARG's occurrence -of the string. Default is vanilla search. Search mode can be toggled by -giving null search string." - (interactive "P") - (let ((val (vip-P-val arg)) (com (vip-getcom arg))) - (setq vip-s-forward nil - vip-s-string (vip-read-string (if vip-re-search "RE-?" "?"))) - (if (string= vip-s-string "") - (progn - (setq vip-re-search (not vip-re-search)) - (message "Search mode changed to %s search." - (if vip-re-search "regular expression" - "vanilla"))) - (vip-search vip-s-string nil val) - (if com - (progn - (move-marker vip-com-point (mark)) - (vip-execute-com 'vip-search-next val com)))))) - -(defun vip-search (string forward arg &optional no-offset init-point) - "(STRING FORWARD COUNT &optional NO-OFFSET) Search COUNT's occurrence of -STRING. Search will be forward if FORWARD, otherwise backward." - (let ((val (vip-p-val arg)) (com (vip-getcom arg)) - (null-arg (null (vip-P-val arg))) (offset (not no-offset)) - (case-fold-search vip-case-fold-search) - (start-point (or init-point (point)))) - (if forward - (condition-case conditions - (progn - (if (and offset (not (eobp))) (forward-char)) - (if vip-re-search - (progn - (re-search-forward string nil nil val) - (re-search-backward string)) - (search-forward string nil nil val) - (search-backward string)) - (push-mark start-point)) - (search-failed - (if (and null-arg vip-search-wrap-around) - (progn - (goto-char (point-min)) - (vip-search string forward (cons 1 com) t start-point)) - (goto-char start-point) - (signal 'search-failed (cdr conditions))))) - (condition-case conditions - (progn - (if vip-re-search - (re-search-backward string nil nil val) - (search-backward string nil nil val)) - (push-mark start-point)) - (search-failed - (if (and null-arg vip-search-wrap-around) - (progn - (goto-char (point-max)) - (vip-search string forward (cons 1 com) t start-point)) - (goto-char start-point) - (signal 'search-failed (cdr conditions)))))))) - -(defun vip-search-next (arg) - "Repeat previous search." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getcom arg))) - (if (null vip-s-string) (error "No previous search string")) - (vip-search vip-s-string vip-s-forward arg) - (if com (vip-execute-com 'vip-search-next val com)))) - -(defun vip-search-Next (arg) - "Repeat previous search in the reverse direction." - (interactive "P") - (let ((val (vip-p-val arg)) (com (vip-getcom arg))) - (if (null vip-s-string) (error "No previous search string")) - (vip-search vip-s-string (not vip-s-forward) arg) - (if com (vip-execute-com 'vip-search-Next val com)))) - - -;; visiting and killing files, buffers - -(defun vip-switch-to-buffer () - "Switch to buffer in the current window." - (interactive) - (let (buffer) - (setq buffer - (read-buffer - (format "switch to buffer \(%s\): " - (buffer-name (other-buffer (current-buffer)))))) - (switch-to-buffer buffer) - (vip-change-mode-to-vi))) - -(defun vip-switch-to-buffer-other-window () - "Switch to buffer in another window." - (interactive) - (let (buffer) - (setq buffer - (read-buffer - (format "Switch to buffer \(%s\): " - (buffer-name (other-buffer (current-buffer)))))) - (switch-to-buffer-other-window buffer) - (vip-change-mode-to-vi))) - -(defun vip-kill-buffer () - "Kill a buffer." - (interactive) - (let (buffer buffer-name) - (setq buffer-name - (read-buffer - (format "Kill buffer \(%s\): " - (buffer-name (current-buffer))))) - (setq buffer - (if (null buffer-name) - (current-buffer) - (get-buffer buffer-name))) - (if (null buffer) (error "Buffer %s nonexistent" buffer-name)) - (if (or (not (buffer-modified-p buffer)) - (y-or-n-p "Buffer is modified, are you sure? ")) - (kill-buffer buffer) - (error "Buffer not killed")))) - -(defun vip-find-file () - "Visit file in the current window." - (interactive) - (let (file) - (setq file (read-file-name "visit file: ")) - (switch-to-buffer (find-file-noselect file)) - (vip-change-mode-to-vi))) - -(defun vip-find-file-other-window () - "Visit file in another window." - (interactive) - (let (file) - (setq file (read-file-name "Visit file: ")) - (switch-to-buffer-other-window (find-file-noselect file)) - (vip-change-mode-to-vi))) - -(defun vip-info-on-file () - "Give information of the file associated to the current buffer." - (interactive) - (message "\"%s\" line %d of %d" - (if (buffer-file-name) (buffer-file-name) "") - (1+ (count-lines (point-min) (point))) - (1+ (count-lines (point-min) (point-max))))) - - -;; yank and pop - -(defun vip-yank (text) - "yank TEXT silently." - (save-excursion - (vip-push-mark-silent (point)) - (insert text) - (exchange-point-and-mark)) - (skip-chars-forward " \t")) - -(defun vip-put-back (arg) - "Put back after point/below line." - (interactive "P") - (let ((val (vip-p-val arg)) - (text (if vip-use-register - (if (and (<= ?1 vip-use-register) (<= vip-use-register ?9)) - (current-kill (- vip-use-register ?1) 'do-not-rotate) - (get-register vip-use-register)) - (current-kill 0)))) - (if (null text) - (if vip-use-register - (let ((reg vip-use-register)) - (setq vip-use-register nil) - (error "Nothing in register %c" reg)) - (error ""))) - (setq vip-use-register nil) - (if (vip-end-with-a-newline-p text) - (progn - (with-no-warnings (next-line 1)) - (beginning-of-line)) - (if (and (not (eolp)) (not (eobp))) (forward-char))) - (setq vip-d-com (list 'vip-put-back val nil vip-use-register)) - (vip-loop val (vip-yank text)))) - -(defun vip-Put-back (arg) - "Put back at point/above line." - (interactive "P") - (let ((val (vip-p-val arg)) - (text (if vip-use-register - (if (and (<= ?1 vip-use-register) (<= vip-use-register ?9)) - (current-kill (- vip-use-register ?1) 'do-not-rotate) - (get-register vip-use-register)) - (current-kill 0)))) - (if (null text) - (if vip-use-register - (let ((reg vip-use-register)) - (setq vip-use-register nil) - (error "Nothing in register %c" reg)) - (error ""))) - (setq vip-use-register nil) - (if (vip-end-with-a-newline-p text) (beginning-of-line)) - (setq vip-d-com (list 'vip-Put-back val nil vip-use-register)) - (vip-loop val (vip-yank text)))) - -(defun vip-delete-char (arg) - "Delete character." - (interactive "P") - (let ((val (vip-p-val arg))) - (setq vip-d-com (list 'vip-delete-char val nil)) - (if vip-use-register - (progn - (if (and (<= ?A vip-use-register) (<= vip-use-register ?Z)) - (vip-append-to-register - (+ vip-use-register 32) (point) (- (point) val)) - (copy-to-register vip-use-register (point) (- (point) val) nil)) - (setq vip-use-register nil))) - (delete-char val t))) - -(defun vip-delete-backward-char (arg) - "Delete previous character." - (interactive "P") - (let ((val (vip-p-val arg))) - (setq vip-d-com (list 'vip-delete-backward-char val nil)) - (if vip-use-register - (progn - (if (and (<= ?A vip-use-register) (<= vip-use-register ?Z)) - (vip-append-to-register - (+ vip-use-register 32) (point) (+ (point) val)) - (copy-to-register vip-use-register (point) (+ (point) val) nil)) - (setq vip-use-register nil))) - (delete-backward-char val t))) - - -;; join lines. - -(defun vip-join-lines (arg) - "Join this line to next, if ARG is nil. Otherwise, join ARG lines" - (interactive "*P") - (let ((val (vip-P-val arg))) - (setq vip-d-com (list 'vip-join-lines val nil)) - (vip-loop (if (null val) 1 (1- val)) - (progn - (end-of-line) - (if (not (eobp)) - (progn - (forward-line 1) - (delete-region (point) (1- (point))) - (fixup-whitespace))))))) - - -;; making small changes - -(defvar vip-c-string) - -(defun vip-change (beg end) - (setq vip-c-string - (vip-read-string (format "%s => " (buffer-substring beg end)))) - (vip-change-subr beg end)) - -(defun vip-change-subr (beg end) - (if vip-use-register - (progn - (copy-to-register vip-use-register beg end nil) - (setq vip-use-register nil))) - (kill-region beg end) - (setq this-command 'vip-change) - (insert vip-c-string)) - - -;; query replace - -(defun vip-query-replace () - "Query replace. If you supply null string as the string to be replaced, -the query replace mode will toggle between string replace and regexp replace." - (interactive) - (let (str) - (setq str (vip-read-string - (if vip-re-query-replace "Query replace regexp: " - "Query replace: "))) - (if (string= str "") - (progn - (setq vip-re-query-replace (not vip-re-query-replace)) - (message "Query replace mode changed to %s." - (if vip-re-query-replace "regexp replace" - "string replace"))) - (if vip-re-query-replace - (query-replace-regexp - str - (vip-read-string (format "Query replace regexp \"%s\" with: " str))) - (query-replace - str - (vip-read-string (format "Query replace \"%s\" with: " str))))))) - - -;; marking - -(defun vip-mark-beginning-of-buffer () - (interactive) - (set-mark (point)) - (goto-char (point-min)) - (exchange-point-and-mark) - (message "mark set at the beginning of buffer")) - -(defun vip-mark-end-of-buffer () - (interactive) - (set-mark (point)) - (goto-char (point-max)) - (exchange-point-and-mark) - (message "mark set at the end of buffer")) - -(defun vip-mark-point (char) - (interactive "c") - (cond ((and (<= ?a char) (<= char ?z)) - (point-to-register (- char (- ?a ?\C-a)) nil)) - ((= char ?<) (vip-mark-beginning-of-buffer)) - ((= char ?>) (vip-mark-end-of-buffer)) - ((= char ?.) (push-mark)) - ((= char ?,) (set-mark-command 1)) - ((= char ?D) (mark-defun)) - (t (error "")))) - -(defun vip-goto-mark (arg) - "Go to mark." - (interactive "P") - (let ((char (read-char)) (com (vip-getcom arg))) - (vip-goto-mark-subr char com nil))) - -(defun vip-goto-mark-and-skip-white (arg) - "Go to mark and skip to first non-white on line." - (interactive "P") - (let ((char (read-char)) (com (vip-getCom arg))) - (vip-goto-mark-subr char com t))) - -(defun vip-goto-mark-subr (char com skip-white) - (cond ((and (<= ?a char) (<= char ?z)) - (let ((buff (current-buffer))) - (if com (move-marker vip-com-point (point))) - (goto-char (register-to-point (- char (- ?a ?\C-a)))) - (if skip-white (back-to-indentation)) - (vip-change-mode-to-vi) - (if com - (if (equal buff (current-buffer)) - (vip-execute-com (if skip-white - 'vip-goto-mark-and-skip-white - 'vip-goto-mark) - nil com) - (switch-to-buffer buff) - (goto-char vip-com-point) - (vip-change-mode-to-vi) - (error ""))))) - ((and (not skip-white) (= char ?`)) - (if com (move-marker vip-com-point (point))) - (exchange-point-and-mark) - (if com (vip-execute-com 'vip-goto-mark nil com))) - ((and skip-white (= char ?')) - (if com (move-marker vip-com-point (point))) - (exchange-point-and-mark) - (back-to-indentation) - (if com (vip-execute-com 'vip-goto-mark-and-skip-white nil com))) - (t (error "")))) - -(defun vip-exchange-point-and-mark () - (interactive) - (exchange-point-and-mark) - (back-to-indentation)) - -(defun vip-keyboard-quit () - "Abort partially formed or running command." - (interactive) - (setq vip-use-register nil) - (keyboard-quit)) - -(defun vip-ctl-c-equivalent (arg) - "Emulate C-c in Emacs mode." - (interactive "P") - (vip-ctl-key-equivalent "\C-c" arg)) - -(defun vip-ctl-x-equivalent (arg) - "Emulate C-x in Emacs mode." - (interactive "P") - (vip-ctl-key-equivalent "\C-x" arg)) - -(defun vip-ctl-key-equivalent (key arg) - (let ((char (read-char))) - (if (and (<= ?A char) (<= char ?Z)) - (setq char (- char (- ?A ?\C-a)))) - (vip-escape-to-emacs arg (list (aref key 0) char)))) - -;; commands in insertion mode - -(defun vip-delete-backward-word (arg) - "Delete previous word." - (interactive "p") - (save-excursion - (set-mark (point)) - (backward-word arg) - (delete-region (point) (mark)))) - - -;; implement ex commands - -(defvar ex-token-type nil - "type of token. if non-nil, gives type of address. if nil, it -is a command.") - -(defvar ex-token nil - "value of token.") - -(defvar ex-addresses nil - "list of ex addresses") - -(defvar ex-flag nil - "flag for ex flag") - -(defvar ex-buffer nil - "name of ex buffer") - -(defvar ex-count nil - "value of ex count") - -(defvar ex-g-flag nil - "flag for global command") - -(defvar ex-g-variant nil - "if t global command is executed on lines not matching ex-g-pat") - -(defvar ex-reg-exp nil - "save reg-exp used in substitute") - -(defvar ex-repl nil - "replace pattern for substitute") - -(defvar ex-g-pat nil - "pattern for global command") - -(defvar ex-map (make-sparse-keymap) - "save commands for mapped keys") - -(defvar ex-tag nil - "save ex tag") - -(defvar ex-file nil) - -(defvar ex-variant nil) - -(defvar ex-offset nil) - -(defvar ex-append nil) - -(defun vip-nil () - (interactive) - (error "")) - -(defun vip-looking-back (str) - "returns t if looking back reg-exp STR before point." - (and (save-excursion (re-search-backward str nil t)) - (= (point) (match-end 0)))) - -(defun vip-check-sub (str) - "check if ex-token is an initial segment of STR" - (let ((length (length ex-token))) - (if (and (<= length (length str)) - (string= ex-token (substring str 0 length))) - (setq ex-token str) - (setq ex-token-type "non-command")))) - -(defun vip-get-ex-com-subr () - "get a complete ex command" - (set-mark (point)) - (re-search-forward "[a-z][a-z]*") - (setq ex-token-type "command") - (setq ex-token (buffer-substring (point) (mark))) - (exchange-point-and-mark) - (cond ((looking-at "a") - (cond ((looking-at "ab") (vip-check-sub "abbreviate")) - ((looking-at "ar") (vip-check-sub "args")) - (t (vip-check-sub "append")))) - ((looking-at "[bh]") (setq ex-token-type "non-command")) - ((looking-at "c") - (if (looking-at "co") (vip-check-sub "copy") - (vip-check-sub "change"))) - ((looking-at "d") (vip-check-sub "delete")) - ((looking-at "e") - (if (looking-at "ex") (vip-check-sub "ex") - (vip-check-sub "edit"))) - ((looking-at "f") (vip-check-sub "file")) - ((looking-at "g") (vip-check-sub "global")) - ((looking-at "i") (vip-check-sub "insert")) - ((looking-at "j") (vip-check-sub "join")) - ((looking-at "l") (vip-check-sub "list")) - ((looking-at "m") - (cond ((looking-at "map") (vip-check-sub "map")) - ((looking-at "mar") (vip-check-sub "mark")) - (t (vip-check-sub "move")))) - ((looking-at "n") - (if (looking-at "nu") (vip-check-sub "number") - (vip-check-sub "next"))) - ((looking-at "o") (vip-check-sub "open")) - ((looking-at "p") - (cond ((looking-at "pre") (vip-check-sub "preserve")) - ((looking-at "pu") (vip-check-sub "put")) - (t (vip-check-sub "print")))) - ((looking-at "q") (vip-check-sub "quit")) - ((looking-at "r") - (cond ((looking-at "rec") (vip-check-sub "recover")) - ((looking-at "rew") (vip-check-sub "rewind")) - (t (vip-check-sub "read")))) - ((looking-at "s") - (cond ((looking-at "se") (vip-check-sub "set")) - ((looking-at "sh") (vip-check-sub "shell")) - ((looking-at "so") (vip-check-sub "source")) - ((looking-at "st") (vip-check-sub "stop")) - (t (vip-check-sub "substitute")))) - ((looking-at "t") - (if (looking-at "ta") (vip-check-sub "tag") - (vip-check-sub "t"))) - ((looking-at "u") - (cond ((looking-at "una") (vip-check-sub "unabbreviate")) - ((looking-at "unm") (vip-check-sub "unmap")) - (t (vip-check-sub "undo")))) - ((looking-at "v") - (cond ((looking-at "ve") (vip-check-sub "version")) - ((looking-at "vi") (vip-check-sub "visual")) - (t (vip-check-sub "v")))) - ((looking-at "w") - (if (looking-at "wq") (vip-check-sub "wq") - (vip-check-sub "write"))) - ((looking-at "x") (vip-check-sub "xit")) - ((looking-at "y") (vip-check-sub "yank")) - ((looking-at "z") (vip-check-sub "z"))) - (exchange-point-and-mark)) - -(defun vip-get-ex-token () - "get an ex-token which is either an address or a command. -a token has type \(command, address, end-mark\) and value." - (with-current-buffer " *ex-working-space*" - (skip-chars-forward " \t") - (cond ((looking-at "[k#]") - (setq ex-token-type "command") - (setq ex-token (char-to-string (following-char))) - (forward-char 1)) - ((looking-at "[a-z]") (vip-get-ex-com-subr)) - ((looking-at "\\.") - (forward-char 1) - (setq ex-token-type "dot")) - ((looking-at "[0-9]") - (set-mark (point)) - (re-search-forward "[0-9]*") - (setq ex-token-type - (cond ((string= ex-token-type "plus") "add-number") - ((string= ex-token-type "minus") "sub-number") - (t "abs-number"))) - (setq ex-token (string-to-number (buffer-substring (point) (mark))))) - ((looking-at "\\$") - (forward-char 1) - (setq ex-token-type "end")) - ((looking-at "%") - (forward-char 1) - (setq ex-token-type "whole")) - ((looking-at "+") - (cond ((or (looking-at "+[-+]") (looking-at "+[\n|]")) - (forward-char 1) - (insert "1") - (backward-char 1) - (setq ex-token-type "plus")) - ((looking-at "+[0-9]") - (forward-char 1) - (setq ex-token-type "plus")) - (t - (error "Badly formed address")))) - ((looking-at "-") - (cond ((or (looking-at "-[-+]") (looking-at "-[\n|]")) - (forward-char 1) - (insert "1") - (backward-char 1) - (setq ex-token-type "minus")) - ((looking-at "-[0-9]") - (forward-char 1) - (setq ex-token-type "minus")) - (t - (error "Badly formed address")))) - ((looking-at "/") - (forward-char 1) - (set-mark (point)) - (let ((cont t)) - (while (and (not (eolp)) cont) - ;;(re-search-forward "[^/]*/") - (re-search-forward "[^/]*\\(/\\|\n\\)") - (if (not (vip-looking-back "[^\\\\]\\(\\\\\\\\\\)*\\\\/")) - (setq cont nil)))) - (backward-char 1) - (setq ex-token (buffer-substring (point) (mark))) - (if (looking-at "/") (forward-char 1)) - (setq ex-token-type "search-forward")) - ((looking-at "\\?") - (forward-char 1) - (set-mark (point)) - (let ((cont t)) - (while (and (not (eolp)) cont) - ;;(re-search-forward "[^\\?]*\\?") - (re-search-forward "[^\\?]*\\(\\?\\|\n\\)") - (if (not (vip-looking-back "[^\\\\]\\(\\\\\\\\\\)*\\\\\\?")) - (setq cont nil)) - (backward-char 1) - (if (not (looking-at "\n")) (forward-char 1)))) - (setq ex-token-type "search-backward") - (setq ex-token (buffer-substring (1- (point)) (mark)))) - ((looking-at ",") - (forward-char 1) - (setq ex-token-type "comma")) - ((looking-at ";") - (forward-char 1) - (setq ex-token-type "semi-colon")) - ((looking-at "[!=><&~]") - (setq ex-token-type "command") - (setq ex-token (char-to-string (following-char))) - (forward-char 1)) - ((looking-at "'") - (setq ex-token-type "goto-mark") - (forward-char 1) - (cond ((looking-at "'") (setq ex-token nil)) - ((looking-at "[a-z]") (setq ex-token (following-char))) - (t (error "Marks are ' and a-z"))) - (forward-char 1)) - ((looking-at "\n") - (setq ex-token-type "end-mark") - (setq ex-token "goto")) - (t - (error "invalid token"))))) - -(defun vip-ex (&optional string) - "ex commands within VIP." - (interactive) - (or string - (setq ex-g-flag nil - ex-g-variant nil)) - (let ((com-str (or string (vip-read-string ":"))) - (address nil) (cont t) (dot (point))) - (with-current-buffer (get-buffer-create " *ex-working-space*") - (delete-region (point-min) (point-max)) - (insert com-str "\n") - (goto-char (point-min))) - (setq ex-token-type "") - (setq ex-addresses nil) - (while cont - (vip-get-ex-token) - (cond ((or (string= ex-token-type "command") - (string= ex-token-type "end-mark")) - (if address (setq ex-addresses (cons address ex-addresses))) - (cond ((string= ex-token "global") - (ex-global nil) - (setq cont nil)) - ((string= ex-token "v") - (ex-global t) - (setq cont nil)) - (t - (vip-execute-ex-command) - (with-current-buffer " *ex-working-space*" - (skip-chars-forward " \t") - (cond ((looking-at "|") - (forward-char 1)) - ((looking-at "\n") - (setq cont nil)) - (t (error "Extra character at end of a command"))))))) - ((string= ex-token-type "non-command") - (error "%s: Not an editor command" ex-token)) - ((string= ex-token-type "whole") - (setq ex-addresses - (cons (point-max) (cons (point-min) ex-addresses)))) - ((string= ex-token-type "comma") - (setq ex-addresses - (cons (if (null address) (point) address) ex-addresses))) - ((string= ex-token-type "semi-colon") - (if address (setq dot address)) - (setq ex-addresses - (cons (if (null address) (point) address) ex-addresses))) - (t (let ((ans (vip-get-ex-address-subr address dot))) - (if ans (setq address ans)))))))) - -(defun vip-get-ex-pat () - "get a regular expression and set ex-variant if found" - (with-current-buffer " *ex-working-space*" - (skip-chars-forward " \t") - (if (looking-at "!") - (progn - (setq ex-g-variant (not ex-g-variant) - ex-g-flag (not ex-g-flag)) - (forward-char 1) - (skip-chars-forward " \t"))) - (if (looking-at "/") - (progn - (forward-char 1) - (set-mark (point)) - (let ((cont t)) - (while (and (not (eolp)) cont) - (re-search-forward "[^/]*\\(/\\|\n\\)") - ;;(re-search-forward "[^/]*/") - (if (not (vip-looking-back "[^\\\\]\\(\\\\\\\\\\)*\\\\/")) - (setq cont nil)))) - (setq ex-token - (if (= (mark) (point)) "" - (buffer-substring (1- (point)) (mark)))) - (backward-char 1)) - (setq ex-token nil)))) - -(defun vip-get-ex-command () - "get an ex command" - (with-current-buffer " *ex-working-space*" - (if (looking-at "/") (forward-char 1)) - (skip-chars-forward " \t") - (cond ((looking-at "[a-z]") - (vip-get-ex-com-subr) - (if (string= ex-token-type "non-command") - (error "%s: not an editor command" ex-token))) - ((looking-at "[!=><&~]") - (setq ex-token (char-to-string (following-char))) - (forward-char 1)) - (t (error "Could not find an ex command"))))) - -(defun vip-get-ex-opt-gc () - "get an ex option g or c" - (with-current-buffer " *ex-working-space*" - (if (looking-at "/") (forward-char 1)) - (skip-chars-forward " \t") - (cond ((looking-at "g") - (setq ex-token "g") - (forward-char 1) - t) - ((looking-at "c") - (setq ex-token "c") - (forward-char 1) - t) - (t nil)))) - -(defun vip-default-ex-addresses (&optional whole-flag) - "compute default addresses. whole-flag means whole buffer." - (cond ((null ex-addresses) - (setq ex-addresses - (if whole-flag - (cons (point-max) (cons (point-min) nil)) - (cons (point) (cons (point) nil))))) - ((null (cdr ex-addresses)) - (setq ex-addresses - (cons (car ex-addresses) ex-addresses))))) - -(defun vip-get-ex-address () - "get an ex-address as a marker and set ex-flag if a flag is found" - (let ((address (point-marker)) (cont t)) - (setq ex-token "") - (setq ex-flag nil) - (while cont - (vip-get-ex-token) - (cond ((string= ex-token-type "command") - (if (or (string= ex-token "print") (string= ex-token "list") - (string= ex-token "#")) - (progn - (setq ex-flag t) - (setq cont nil)) - (error "address expected"))) - ((string= ex-token-type "end-mark") - (setq cont nil)) - ((string= ex-token-type "whole") - (error "a trailing address is expected")) - ((string= ex-token-type "comma") - (error "Extra characters after an address")) - (t (let ((ans (vip-get-ex-address-subr address (point-marker)))) - (if ans (setq address ans)))))) - address)) - -(defun vip-get-ex-address-subr (old-address dot) - "returns an address as a point" - (let ((address nil)) - (if (null old-address) (setq old-address dot)) - (cond ((string= ex-token-type "dot") - (setq address dot)) - ((string= ex-token-type "add-number") - (save-excursion - (goto-char old-address) - (forward-line (if (= old-address 0) (1- ex-token) ex-token)) - (setq address (point-marker)))) - ((string= ex-token-type "sub-number") - (save-excursion - (goto-char old-address) - (forward-line (- ex-token)) - (setq address (point-marker)))) - ((string= ex-token-type "abs-number") - (save-excursion - (goto-char (point-min)) - (if (= ex-token 0) (setq address 0) - (forward-line (1- ex-token)) - (setq address (point-marker))))) - ((string= ex-token-type "end") - (setq address (point-max-marker))) - ((string= ex-token-type "plus") t);; do nothing - ((string= ex-token-type "minus") t);; do nothing - ((string= ex-token-type "search-forward") - (save-excursion - (ex-search-address t) - (setq address (point-marker)))) - ((string= ex-token-type "search-backward") - (save-excursion - (ex-search-address nil) - (setq address (point-marker)))) - ((string= ex-token-type "goto-mark") - (save-excursion - (if (null ex-token) - (exchange-point-and-mark) - (goto-char (register-to-point (- ex-token (- ?a ?\C-a))))) - (setq address (point-marker))))) - address)) - -(defun ex-search-address (forward) - "search pattern and set address" - (if (string= ex-token "") - (if (null vip-s-string) (error "No previous search string") - (setq ex-token vip-s-string)) - (setq vip-s-string ex-token)) - (if forward - (progn - (forward-line 1) - (re-search-forward ex-token)) - (forward-line -1) - (re-search-backward ex-token))) - -(defun vip-get-ex-buffer () - "get a buffer name and set ex-count and ex-flag if found" - (setq ex-buffer nil) - (setq ex-count nil) - (setq ex-flag nil) - (with-current-buffer " *ex-working-space*" - (skip-chars-forward " \t") - (if (looking-at "[a-zA-Z]") - (progn - (setq ex-buffer (following-char)) - (forward-char 1) - (skip-chars-forward " \t"))) - (if (looking-at "[0-9]") - (progn - (set-mark (point)) - (re-search-forward "[0-9][0-9]*") - (setq ex-count (string-to-number (buffer-substring (point) (mark)))) - (skip-chars-forward " \t"))) - (if (looking-at "[pl#]") - (progn - (setq ex-flag t) - (forward-char 1))) - (if (not (looking-at "[\n|]")) - (error "Invalid extra characters")))) - -(defun vip-get-ex-count () - (setq ex-variant nil - ex-count nil - ex-flag nil) - (with-current-buffer " *ex-working-space*" - (skip-chars-forward " \t") - (if (looking-at "!") - (progn - (setq ex-variant t) - (forward-char 1))) - (skip-chars-forward " \t") - (if (looking-at "[0-9]") - (progn - (set-mark (point)) - (re-search-forward "[0-9][0-9]*") - (setq ex-count (string-to-number (buffer-substring (point) (mark)))) - (skip-chars-forward " \t"))) - (if (looking-at "[pl#]") - (progn - (setq ex-flag t) - (forward-char 1))) - (if (not (looking-at "[\n|]")) - (error "Invalid extra characters")))) - -(defun vip-get-ex-file () - "get a file name and set ex-variant, ex-append and ex-offset if found" - (setq ex-file nil - ex-variant nil - ex-append nil - ex-offset nil) - (with-current-buffer " *ex-working-space*" - (skip-chars-forward " \t") - (if (looking-at "!") - (progn - (setq ex-variant t) - (forward-char 1) - (skip-chars-forward " \t"))) - (if (looking-at ">>") - (progn - (setq ex-append t - ex-variant t) - (forward-char 2) - (skip-chars-forward " \t"))) - (if (looking-at "+") - (progn - (forward-char 1) - (set-mark (point)) - (re-search-forward "[ \t\n]") - (backward-char 1) - (setq ex-offset (buffer-substring (point) (mark))) - (forward-char 1) - (skip-chars-forward " \t"))) - (set-mark (point)) - (re-search-forward "[ \t\n]") - (backward-char 1) - (setq ex-file (buffer-substring (point) (mark))))) - -(defun vip-execute-ex-command () - "execute ex command using the value of addresses." - (cond ((string= ex-token "goto") (ex-goto)) - ((string= ex-token "copy") (ex-copy nil)) - ((string= ex-token "delete") (ex-delete)) - ((string= ex-token "edit") (ex-edit)) - ((string= ex-token "file") (vip-info-on-file)) - ;((string= ex-token "global") (ex-global nil)) - ((string= ex-token "join") (ex-line "join")) - ((string= ex-token "k") (ex-mark)) - ((string= ex-token "mark") (ex-mark)) - ((string= ex-token "map") (ex-map)) - ((string= ex-token "move") (ex-copy t)) - ((string= ex-token "put") (ex-put)) - ((string= ex-token "quit") (ex-quit)) - ((string= ex-token "read") (ex-read)) - ((string= ex-token "set") (ex-set)) - ((string= ex-token "shell") (ex-shell)) - ((string= ex-token "substitute") (ex-substitute)) - ((string= ex-token "stop") (suspend-emacs)) - ((string= ex-token "t") (ex-copy nil)) - ((string= ex-token "tag") (ex-tag)) - ((string= ex-token "undo") (vip-undo)) - ((string= ex-token "unmap") (ex-unmap)) - ;((string= ex-token "v") (ex-global t)) - ((string= ex-token "version") (vip-version)) - ((string= ex-token "visual") (ex-edit)) - ((string= ex-token "write") (ex-write nil)) - ((string= ex-token "wq") (ex-write t)) - ((string= ex-token "yank") (ex-yank)) - ((string= ex-token "!") (ex-command)) - ((string= ex-token "=") (ex-line-no)) - ((string= ex-token ">") (ex-line "right")) - ((string= ex-token "<") (ex-line "left")) - ((string= ex-token "&") (ex-substitute t)) - ((string= ex-token "~") (ex-substitute t t)) - ((or (string= ex-token "append") - (string= ex-token "args") - (string= ex-token "change") - (string= ex-token "insert") - (string= ex-token "open") - ) - (error "%s: no such command from VIP" ex-token)) - ((or (string= ex-token "abbreviate") - (string= ex-token "list") - (string= ex-token "next") - (string= ex-token "print") - (string= ex-token "preserve") - (string= ex-token "recover") - (string= ex-token "rewind") - (string= ex-token "source") - (string= ex-token "unabbreviate") - (string= ex-token "xit") - (string= ex-token "z") - ) - (error "%s: not implemented in VIP" ex-token)) - (t (error "%s: Not an editor command" ex-token)))) - -(defun ex-goto () - "ex goto command" - (if (null ex-addresses) - (setq ex-addresses (cons (point) nil))) - (push-mark (point)) - (goto-char (car ex-addresses)) - (beginning-of-line)) - -(defun ex-copy (del-flag) - "ex copy and move command. DEL-FLAG means delete." - (vip-default-ex-addresses) - (let ((address (vip-get-ex-address)) - (end (car ex-addresses)) (beg (car (cdr ex-addresses)))) - (goto-char end) - (save-excursion - (set-mark beg) - (vip-enlarge-region (mark) (point)) - (if del-flag (kill-region (point) (mark)) - (copy-region-as-kill (point) (mark))) - (if ex-flag - (progn - (with-output-to-temp-buffer "*copy text*" - (princ - (if (or del-flag ex-g-flag ex-g-variant) - (current-kill 0) - (buffer-substring (point) (mark))))) - (condition-case nil - (progn - (vip-read-string "[Hit return to continue] ") - (save-excursion (kill-buffer "*copy text*"))) - (quit - (save-excursion (kill-buffer "*copy text*")) - (signal 'quit nil)))))) - (if (= address 0) - (goto-char (point-min)) - (goto-char address) - (forward-line 1)) - (insert (current-kill 0)))) - -(defun ex-delete () - "ex delete" - (vip-default-ex-addresses) - (vip-get-ex-buffer) - (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses)))) - (if (> beg end) (error "First address exceeds second")) - (save-excursion - (vip-enlarge-region beg end) - (exchange-point-and-mark) - (if ex-count - (progn - (set-mark (point)) - (forward-line (1- ex-count))) - (set-mark end)) - (vip-enlarge-region (point) (mark)) - (if ex-flag - ;; show text to be deleted and ask for confirmation - (progn - (with-output-to-temp-buffer " *delete text*" - (princ (buffer-substring (point) (mark)))) - (condition-case conditions - (vip-read-string "[Hit return to continue] ") - (quit - (save-excursion (kill-buffer " *delete text*")) - (error ""))) - (save-excursion (kill-buffer " *delete text*"))) - (if ex-buffer - (if (and (<= ?A ex-buffer) (<= ex-buffer ?Z)) - (vip-append-to-register - (+ ex-buffer 32) (point) (mark)) - (copy-to-register ex-buffer (point) (mark) nil))) - (delete-region (point) (mark)))))) - -(defun ex-edit () - "ex-edit" - (vip-get-ex-file) - (if (and (not ex-variant) (buffer-modified-p) buffer-file-name) - (error "No write since last change \(:e! overrides\)")) - (vip-change-mode-to-emacs) - (set-buffer - (find-file-noselect (concat default-directory ex-file))) - (vip-change-mode-to-vi) - (goto-char (point-min)) - (if ex-offset - (progn - (with-current-buffer " *ex-working-space*" - (delete-region (point-min) (point-max)) - (insert ex-offset "\n") - (goto-char (point-min))) - (goto-char (vip-get-ex-address)) - (beginning-of-line)))) - -(defun ex-global (variant) - "ex global command" - (if (or ex-g-flag ex-g-variant) - (error "Global within global not allowed") - (if variant - (setq ex-g-flag nil - ex-g-variant t) - (setq ex-g-flag t - ex-g-variant nil))) - (vip-get-ex-pat) - (if (null ex-token) - (error "Missing regular expression for global command")) - (if (string= ex-token "") - (if (null vip-s-string) (error "No previous search string") - (setq ex-g-pat vip-s-string)) - (setq ex-g-pat ex-token - vip-s-string ex-token)) - (if (null ex-addresses) - (setq ex-addresses (list (point-max) (point-min)))) - (let ((marks nil) (mark-count 0) - com-str (end (car ex-addresses)) (beg (car (cdr ex-addresses)))) - (if (> beg end) (error "First address exceeds second")) - (save-excursion - (vip-enlarge-region beg end) - (exchange-point-and-mark) - (let ((cont t) (limit (point-marker))) - (exchange-point-and-mark) - ;; skip the last line if empty - (beginning-of-line) - (if (and (eobp) (not (bobp))) (backward-char 1)) - (while (and cont (not (bobp)) (>= (point) limit)) - (beginning-of-line) - (set-mark (point)) - (end-of-line) - (let ((found (re-search-backward ex-g-pat (mark) t))) - (if (or (and ex-g-flag found) - (and ex-g-variant (not found))) - (progn - (end-of-line) - (setq mark-count (1+ mark-count)) - (setq marks (cons (point-marker) marks))))) - (beginning-of-line) - (if (bobp) (setq cont nil) - (forward-line -1) - (end-of-line))))) - (with-current-buffer " *ex-working-space*" - (setq com-str (buffer-substring (1+ (point)) (1- (point-max))))) - (while marks - (goto-char (car marks)) - ;; report progress of execution on a slow machine. - ;;(message "Executing global command...") - ;;(if (zerop (% mark-count 10)) - ;; (message "Executing global command...%d" mark-count)) - (vip-ex com-str) - (setq mark-count (1- mark-count)) - (setq marks (cdr marks))))) -;;(message "Executing global command...done"))) - -(defun ex-line (com) - "ex line commands. COM is join, shift-right or shift-left." - (vip-default-ex-addresses) - (vip-get-ex-count) - (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses))) point) - (if (> beg end) (error "First address exceeds second")) - (save-excursion - (vip-enlarge-region beg end) - (exchange-point-and-mark) - (if ex-count - (progn - (set-mark (point)) - (forward-line ex-count))) - (if ex-flag - ;; show text to be joined and ask for confirmation - (progn - (with-output-to-temp-buffer " *text*" - (princ (buffer-substring (point) (mark)))) - (condition-case conditions - (progn - (vip-read-string "[Hit return to continue] ") - (ex-line-subr com (point) (mark))) - (quit - (ding))) - (save-excursion (kill-buffer " *text*"))) - (ex-line-subr com (point) (mark))) - (setq point (point))) - (goto-char (1- point)) - (beginning-of-line))) - -(defun ex-line-subr (com beg end) - (cond ((string= com "join") - (goto-char (min beg end)) - (while (and (not (eobp)) (< (point) (max beg end))) - (end-of-line) - (if (and (<= (point) (max beg end)) (not (eobp))) - (progn - (forward-line 1) - (delete-region (point) (1- (point))) - (if (not ex-variant) (fixup-whitespace)))))) - ((or (string= com "right") (string= com "left")) - (indent-rigidly - (min beg end) (max beg end) - (if (string= com "right") vip-shift-width (- vip-shift-width))) - (goto-char (max beg end)) - (end-of-line) - (forward-char 1)))) - -(defun ex-mark () - "ex mark" - (let (char) - (if (null ex-addresses) - (setq ex-addresses - (cons (point) nil))) - (with-current-buffer " *ex-working-space*" - (skip-chars-forward " \t") - (if (looking-at "[a-z]") - (progn - (setq char (following-char)) - (forward-char 1) - (skip-chars-forward " \t") - (if (not (looking-at "[\n|]")) - (error "Extra characters at end of \"k\" command"))) - (if (looking-at "[\n|]") - (error "\"k\" requires a following letter") - (error "Mark must specify a letter")))) - (save-excursion - (goto-char (car ex-addresses)) - (point-to-register (- char (- ?a ?\C-a)) nil)))) - -(defun ex-map () - "ex map" - (let (char string) - (with-current-buffer " *ex-working-space*" - (skip-chars-forward " \t") - (setq char (char-to-string (following-char))) - (forward-char 1) - (skip-chars-forward " \t") - (if (looking-at "[\n|]") (error "Missing rhs")) - (set-mark (point)) - (with-no-warnings - (end-of-buffer)) - (backward-char 1) - (setq string (buffer-substring (mark) (point)))) - (if (not (lookup-key ex-map char)) - (define-key ex-map char - (or (lookup-key vip-mode-map char) 'vip-nil))) - (define-key vip-mode-map char - (eval - (list 'quote - (cons 'lambda - (list '(count) - '(interactive "p") - (list 'execute-kbd-macro string 'count)))))))) - -(defun ex-unmap () - "ex unmap" - (let (char) - (with-current-buffer " *ex-working-space*" - (skip-chars-forward " \t") - (setq char (char-to-string (following-char))) - (forward-char 1) - (skip-chars-forward " \t") - (if (not (looking-at "[\n|]")) (error "Macro must be a character"))) - (if (not (lookup-key ex-map char)) - (error "That macro wasn't mapped")) - (define-key vip-mode-map char (lookup-key ex-map char)) - (define-key ex-map char nil))) - -(defun ex-put () - "ex put" - (let ((point (if (null ex-addresses) (point) (car ex-addresses)))) - (vip-get-ex-buffer) - (setq vip-use-register ex-buffer) - (goto-char point) - (if (= point 0) (vip-Put-back 1) (vip-put-back 1)))) - -(defun ex-quit () - "ex quit" - (let (char) - (with-current-buffer " *ex-working-space*" - (skip-chars-forward " \t") - (setq char (following-char))) - (if (= char ?!) (kill-emacs t) (save-buffers-kill-emacs)))) - -(defun ex-read () - "ex read" - (let ((point (if (null ex-addresses) (point) (car ex-addresses))) - (variant nil) command file) - (goto-char point) - (if (not (= point 0)) (with-no-warnings (next-line 1))) - (beginning-of-line) - (with-current-buffer " *ex-working-space*" - (skip-chars-forward " \t") - (if (looking-at "!") - (progn - (setq variant t) - (forward-char 1) - (skip-chars-forward " \t") - (set-mark (point)) - (end-of-line) - (setq command (buffer-substring (mark) (point)))) - (set-mark (point)) - (re-search-forward "[ \t\n]") - (backward-char 1) - (setq file (buffer-substring (point) (mark))))) - (if variant - (shell-command command t) - (with-no-warnings - (insert-file file))))) - -(defun ex-set () - (eval (list 'setq - (read-variable "Variable: ") - (eval (read-minibuffer "Value: "))))) - -(defun ex-shell () - "ex shell" - (vip-change-mode-to-emacs) - (shell)) - -(defun ex-substitute (&optional repeat r-flag) - "ex substitute. -If REPEAT use previous reg-exp which is ex-reg-exp or -vip-s-string" - (let (pat repl (opt-g nil) (opt-c nil) (matched-pos nil)) - (if repeat (setq ex-token nil) (vip-get-ex-pat)) - (if (null ex-token) - (setq pat (if r-flag vip-s-string ex-reg-exp) - repl ex-repl) - (setq pat (if (string= ex-token "") vip-s-string ex-token)) - (setq vip-s-string pat - ex-reg-exp pat) - (vip-get-ex-pat) - (if (null ex-token) - (setq ex-token "" - ex-repl "") - (setq repl ex-token - ex-repl ex-token))) - (while (vip-get-ex-opt-gc) - (if (string= ex-token "g") (setq opt-g t) (setq opt-c t))) - (vip-get-ex-count) - (if ex-count - (save-excursion - (if ex-addresses (goto-char (car ex-addresses))) - (set-mark (point)) - (forward-line (1- ex-count)) - (setq ex-addresses (cons (point) (cons (mark) nil)))) - (if (null ex-addresses) - (setq ex-addresses (cons (point) (cons (point) nil))) - (if (null (cdr ex-addresses)) - (setq ex-addresses (cons (car ex-addresses) ex-addresses))))) - ;(setq G opt-g) - (let ((beg (car ex-addresses)) (end (car (cdr ex-addresses))) - (cont t) eol-mark) - (save-excursion - (vip-enlarge-region beg end) - (let ((limit (save-excursion - (goto-char (max (point) (mark))) - (point-marker)))) - (goto-char (min (point) (mark))) - (while (< (point) limit) - (end-of-line) - (setq eol-mark (point-marker)) - (beginning-of-line) - (if opt-g - (progn - (while (and (not (eolp)) - (re-search-forward pat eol-mark t)) - (if (or (not opt-c) (y-or-n-p "Replace? ")) - (progn - (setq matched-pos (point)) - (replace-match repl)))) - (end-of-line) - (forward-char)) - (if (and (re-search-forward pat eol-mark t) - (or (not opt-c) (y-or-n-p "Replace? "))) - (progn - (setq matched-pos (point)) - (replace-match repl))) - (end-of-line) - (forward-char)))))) - (if matched-pos (goto-char matched-pos)) - (beginning-of-line) - (if opt-c (message "done")))) - -(defun ex-tag () - "ex tag" - (let (tag) - (with-current-buffer " *ex-working-space*" - (skip-chars-forward " \t") - (set-mark (point)) - (skip-chars-forward "^ |\t\n") - (setq tag (buffer-substring (mark) (point)))) - (if (not (string= tag "")) (setq ex-tag tag)) - (vip-change-mode-to-emacs) - (condition-case conditions - (progn - (if (string= tag "") - (find-tag ex-tag t) - (find-tag-other-window ex-tag)) - (vip-change-mode-to-vi)) - (error - (vip-change-mode-to-vi) - (vip-message-conditions conditions))))) - -(defun ex-write (q-flag) - "ex write" - (vip-default-ex-addresses t) - (vip-get-ex-file) - (if (string= ex-file "") - (progn - (if (null buffer-file-name) - (error "No file associated with this buffer")) - (setq ex-file buffer-file-name)) - (setq ex-file (expand-file-name ex-file))) - (if (and (not (string= ex-file (buffer-file-name))) - (file-exists-p ex-file) - (not ex-variant)) - (error "\"%s\" File exists - use w! to override" ex-file)) - (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses)))) - (if (> beg end) (error "First address exceeds second")) - (save-excursion - (vip-enlarge-region beg end) - (write-region (point) (mark) ex-file ex-append t))) - (if (null buffer-file-name) (setq buffer-file-name ex-file)) - (if q-flag (save-buffers-kill-emacs))) - -(defun ex-yank () - "ex yank" - (vip-default-ex-addresses) - (vip-get-ex-buffer) - (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses)))) - (if (> beg end) (error "First address exceeds second")) - (save-excursion - (vip-enlarge-region beg end) - (exchange-point-and-mark) - (if (or ex-g-flag ex-g-variant) (error "Can't yank within global")) - (if ex-count - (progn - (set-mark (point)) - (forward-line (1- ex-count))) - (set-mark end)) - (vip-enlarge-region (point) (mark)) - (if ex-flag (error "Extra characters at end of command")) - (if ex-buffer - (copy-to-register ex-buffer (point) (mark) nil)) - (copy-region-as-kill (point) (mark))))) - -(defun ex-command () - "execute shell command" - (let (command) - (with-current-buffer " *ex-working-space*" - (skip-chars-forward " \t") - (set-mark (point)) - (end-of-line) - (setq command (buffer-substring (mark) (point)))) - (if (null ex-addresses) - (shell-command command) - (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses)))) - (if (null beg) (setq beg end)) - (save-excursion - (goto-char beg) - (set-mark end) - (vip-enlarge-region (point) (mark)) - (shell-command-on-region (point) (mark) command t t)) - (goto-char beg))))) - -(defun ex-line-no () - "print line number" - (message "%d" - (1+ (count-lines - (point-min) - (if (null ex-addresses) (point-max) (car ex-addresses)))))) - -(if (file-exists-p vip-startup-file) (load vip-startup-file)) - -(provide 'vip) - -;;; vip.el ends here diff --git a/lisp/emulation/ws-mode.el b/lisp/emulation/ws-mode.el deleted file mode 100644 index fb140e6ebd7..00000000000 --- a/lisp/emulation/ws-mode.el +++ /dev/null @@ -1,642 +0,0 @@ -;;; ws-mode.el --- WordStar emulation mode for GNU Emacs - -;; Copyright (C) 1991, 2001-2014 Free Software Foundation, Inc. - -;; Author: Juergen Nickelsen -;; 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 . - -;;; 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 diff --git a/lisp/obsolete/crisp.el b/lisp/obsolete/crisp.el new file mode 100644 index 00000000000..47cf898190b --- /dev/null +++ b/lisp/obsolete/crisp.el @@ -0,0 +1,387 @@ +;;; crisp.el --- CRiSP/Brief Emacs emulator + +;; Copyright (C) 1997-1999, 2001-2014 Free Software Foundation, Inc. + +;; Author: Gary D. Foster +;; 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 . + +;;; Commentary: + +;; Keybindings and minor functions to duplicate the functionality and +;; finger-feel of the CRiSP/Brief editor. This package is designed to +;; facilitate transitioning from Brief to (XE|E)macs with a minimum +;; amount of hassles. + +;; Enable this package by putting (require 'crisp) in your .emacs and +;; use M-x crisp-mode to toggle it on or off. + +;; This package will automatically load the scroll-all.el package if +;; you put (setq crisp-load-scroll-all t) in your .emacs before +;; loading this package. If this feature is enabled, it will bind +;; meta-f1 to the scroll-all mode toggle. The scroll-all package +;; duplicates the scroll-all feature in CRiSP. + +;; Also, the default keybindings for brief/CRiSP override the M-x +;; key to exit the editor. If you don't like this functionality, you +;; can prevent this behavior (or redefine it dynamically) by setting +;; the value of `crisp-override-meta-x' either in your .emacs or +;; interactively. The default setting is t, which means that M-x will +;; by default run `save-buffers-kill-emacs' instead of the command +;; `execute-extended-command'. + +;; Finally, if you want to change the string displayed in the mode +;; line when this mode is in effect, override the definition of +;; `crisp-mode-mode-line-string' in your .emacs. The default value is +;; " *Crisp*" which may be a bit lengthy if you have a lot of things +;; being displayed there. + +;; All these overrides should go *before* the (require 'crisp) statement. + +;;; Code: + +;; local variables + +(defgroup crisp nil + "Emulator for CRiSP and Brief key bindings." + :prefix "crisp-" + :group 'emulations) + +(defvar crisp-mode-map + (let ((map (make-sparse-keymap))) + (define-key map [(f1)] 'other-window) + + (define-key map [(f2) (down)] 'enlarge-window) + (define-key map [(f2) (left)] 'shrink-window-horizontally) + (define-key map [(f2) (right)] 'enlarge-window-horizontally) + (define-key map [(f2) (up)] 'shrink-window) + (define-key map [(f3) (down)] 'split-window-below) + (define-key map [(f3) (right)] 'split-window-right) + + (define-key map [(f4)] 'delete-window) + (define-key map [(control f4)] 'delete-other-windows) + + (define-key map [(f5)] 'search-forward-regexp) + (define-key map [(f19)] 'search-forward-regexp) + (define-key map [(meta f5)] 'search-backward-regexp) + + (define-key map [(f6)] 'query-replace) + + (define-key map [(f7)] 'start-kbd-macro) + (define-key map [(meta f7)] 'end-kbd-macro) + + (define-key map [(f8)] 'call-last-kbd-macro) + (define-key map [(meta f8)] 'save-kbd-macro) + + (define-key map [(f9)] 'find-file) + (define-key map [(meta f9)] 'load-library) + + (define-key map [(f10)] 'execute-extended-command) + (define-key map [(meta f10)] 'compile) + + (define-key map [(SunF37)] 'kill-buffer) + (define-key map [(kp-add)] 'crisp-copy-line) + (define-key map [(kp-subtract)] 'crisp-kill-line) + ;; just to cover all the bases (GNU Emacs, for instance) + (define-key map [(f24)] 'crisp-kill-line) + (define-key map [(insert)] 'crisp-yank-clipboard) + (define-key map [(f16)] 'crisp-set-clipboard) ; copy on Sun5 kbd + (define-key map [(f20)] 'crisp-kill-region) ; cut on Sun5 kbd + (define-key map [(f18)] 'crisp-yank-clipboard) ; paste on Sun5 kbd + + (define-key map [(control f)] 'fill-paragraph-or-region) + (define-key map [(meta d)] (lambda () + (interactive) + (beginning-of-line) (kill-line))) + (define-key map [(meta e)] 'find-file) + (define-key map [(meta g)] 'goto-line) + (define-key map [(meta h)] 'help) + (define-key map [(meta i)] 'overwrite-mode) + (define-key map [(meta j)] 'bookmark-jump) + (define-key map [(meta l)] 'crisp-mark-line) + (define-key map [(meta m)] 'set-mark-command) + (define-key map [(meta n)] 'bury-buffer) + (define-key map [(meta p)] 'crisp-unbury-buffer) + (define-key map [(meta u)] 'undo) + (define-key map [(f14)] 'undo) + (define-key map [(meta w)] 'save-buffer) + (define-key map [(meta x)] 'crisp-meta-x-wrapper) + (define-key map [(meta ?0)] (lambda () + (interactive) + (bookmark-set "0"))) + (define-key map [(meta ?1)] (lambda () + (interactive) + (bookmark-set "1"))) + (define-key map [(meta ?2)] (lambda () + (interactive) + (bookmark-set "2"))) + (define-key map [(meta ?3)] (lambda () + (interactive) + (bookmark-set "3"))) + (define-key map [(meta ?4)] (lambda () + (interactive) + (bookmark-set "4"))) + (define-key map [(meta ?5)] (lambda () + (interactive) + (bookmark-set "5"))) + (define-key map [(meta ?6)] (lambda () + (interactive) + (bookmark-set "6"))) + (define-key map [(meta ?7)] (lambda () + (interactive) + (bookmark-set "7"))) + (define-key map [(meta ?8)] (lambda () + (interactive) + (bookmark-set "8"))) + (define-key map [(meta ?9)] (lambda () + (interactive) + (bookmark-set "9"))) + + (define-key map [(shift delete)] 'kill-word) + (define-key map [(shift backspace)] 'backward-kill-word) + (define-key map [(control left)] 'backward-word) + (define-key map [(control right)] 'forward-word) + + (define-key map [(home)] 'crisp-home) + (define-key map [(control home)] (lambda () + (interactive) + (move-to-window-line 0))) + (define-key map [(meta home)] 'beginning-of-line) + (define-key map [(end)] 'crisp-end) + (define-key map [(control end)] (lambda () + (interactive) + (move-to-window-line -1))) + (define-key map [(meta end)] 'end-of-line) + map) + "Local keymap for CRiSP emulation mode. +All the bindings are done here instead of globally to try and be +nice to the world.") + +(define-obsolete-variable-alias 'crisp-mode-modeline-string + 'crisp-mode-mode-line-string "24.3") + +(defcustom crisp-mode-mode-line-string " *CRiSP*" + "String to display in the mode line when CRiSP emulation mode is enabled." + :type 'string + :group 'crisp) + +;;;###autoload +(defcustom crisp-mode nil + "Track status of CRiSP emulation mode. +A value of nil means CRiSP mode is not enabled. A value of t +indicates CRiSP mode is enabled. + +Setting this variable directly does not take effect; +use either M-x customize or the function `crisp-mode'." + :set (lambda (symbol value) (crisp-mode (if value 1 0))) + :initialize 'custom-initialize-default + :require 'crisp + :version "20.4" + :type 'boolean + :group 'crisp) + +(defcustom crisp-override-meta-x t + "Controls overriding the normal Emacs M-x key binding in the CRiSP emulator. +Normally the CRiSP emulator rebinds M-x to `save-buffers-exit-emacs', and +provides the usual M-x functionality on the F10 key. If this variable +is non-nil, M-x will exit Emacs." + :type 'boolean + :group 'crisp) + +(defcustom crisp-load-scroll-all nil + "Controls loading of the Scroll Lock in the CRiSP emulator. +Its default behavior is to load and enable the Scroll Lock minor mode +package when enabling the CRiSP emulator. + +If this variable is nil when you start the CRiSP emulator, it +does not load the scroll-all package." + :type 'boolean + :group 'crisp) + +(defcustom crisp-load-hook nil + "Hooks to run after loading the CRiSP emulator package." + :type 'hook + :group 'crisp) + +(defcustom crisp-mode-hook nil + "Hook run by the function `crisp-mode'." + :type 'hook + :group 'crisp) + +(defconst crisp-version "1.34" + "The version of the CRiSP emulator.") + +(defconst crisp-mode-help-address "gfoster@suzieq.ml.org" + "The email address of the CRiSP mode author/maintainer.") + +;; Silence the byte-compiler. +(defvar crisp-last-last-command nil + "The previous value of `last-command'.") + +;; The cut and paste routines are different between XEmacs and Emacs +;; so we need to set up aliases for the functions. + +(defalias 'crisp-set-clipboard + (if (fboundp 'clipboard-kill-ring-save) + 'clipboard-kill-ring-save + 'copy-primary-selection)) + +(defalias 'crisp-kill-region + (if (fboundp 'clipboard-kill-region) + 'clipboard-kill-region + 'kill-primary-selection)) + +(defalias 'crisp-yank-clipboard + (if (fboundp 'clipboard-yank) + 'clipboard-yank + 'yank-clipboard-selection)) + +(defun crisp-region-active () + "Compatibility function to test for an active region." + (if (featurep 'xemacs) + zmacs-region-active-p + mark-active)) + +(defun crisp-version (&optional arg) + "Version number of the CRiSP emulator package. +If ARG, insert results at point." + (interactive "P") + (let ((foo (concat "CRiSP version " crisp-version))) + (if arg + (insert (message foo)) + (message foo)))) + +(defun crisp-mark-line (arg) + "Set mark at the end of the line. +Arg works as in `end-of-line'." + (interactive "p") + (let (newmark) + (save-excursion + (end-of-line arg) + (setq newmark (point))) + (push-mark newmark nil t))) + +(defun crisp-kill-line (arg) + "Mark and kill line(s). +Marks from point to end of the current line (honoring prefix arguments), +copies the region to the kill ring and clipboard, and then deletes it." + (interactive "*p") + (if (crisp-region-active) + (call-interactively 'crisp-kill-region) + (crisp-mark-line arg) + (call-interactively 'crisp-kill-region))) + +(defun crisp-copy-line (arg) + "Mark and copy line(s). +Marks from point to end of the current line (honoring prefix arguments), +copies the region to the kill ring and clipboard, and then deactivates +the region." + (interactive "*p") + (if (crisp-region-active) + (call-interactively 'crisp-set-clipboard) + (crisp-mark-line arg) + (call-interactively 'crisp-set-clipboard)) + ;; clear the region after the operation is complete + ;; XEmacs does this automagically, Emacs doesn't. + (if (boundp 'mark-active) + (setq mark-active nil))) + +(defun crisp-home () + "\"Home\" the point, the way CRiSP would do it. +The first use moves point to beginning of the line. Second +consecutive use moves point to beginning of the screen. Third +consecutive use moves point to the beginning of the buffer." + (interactive nil) + (cond + ((and (eq last-command 'crisp-home) + (eq crisp-last-last-command 'crisp-home)) + (goto-char (point-min))) + ((eq last-command 'crisp-home) + (move-to-window-line 0)) + (t + (beginning-of-line))) + (setq crisp-last-last-command last-command)) + +(defun crisp-end () + "\"End\" the point, the way CRiSP would do it. +The first use moves point to end of the line. Second +consecutive use moves point to the end of the screen. Third +consecutive use moves point to the end of the buffer." + (interactive nil) + (cond + ((and (eq last-command 'crisp-end) + (eq crisp-last-last-command 'crisp-end)) + (goto-char (point-max))) + ((eq last-command 'crisp-end) + (move-to-window-line -1) + (end-of-line)) + (t + (end-of-line))) + (setq crisp-last-last-command last-command)) + +(defun crisp-unbury-buffer () + "Go back one buffer." + (interactive) + (switch-to-buffer (car (last (buffer-list))))) + +(defun crisp-meta-x-wrapper () + "Wrapper function to conditionally override the normal M-x bindings. +When `crisp-override-meta-x' is non-nil, M-x will exit Emacs (the +normal CRiSP binding) and when it is nil M-x will run +`execute-extended-command' (the normal Emacs binding)." + (interactive) + (if crisp-override-meta-x + (save-buffers-kill-emacs) + (call-interactively 'execute-extended-command))) + +;;;###autoload +(define-minor-mode crisp-mode + "Toggle CRiSP/Brief emulation (CRiSP mode). +With a prefix argument ARG, enable CRiSP mode if ARG is positive, +and disable it otherwise. If called from Lisp, enable the mode +if ARG is omitted or nil." + :keymap crisp-mode-map + :lighter crisp-mode-mode-line-string + (when crisp-mode + ;; Make menu entries show M-u or f14 in preference to C-x u. + (put 'undo :advertised-binding + `([?\M-u] [f14] ,@(get 'undo :advertised-binding))) + ;; Force transient-mark-mode, so that the marking routines work as + ;; expected. If the user turns off transient mark mode, most + ;; things will still work fine except the crisp-(copy|kill) + ;; functions won't work quite as nicely when regions are marked + ;; differently and could really confuse people. Caveat emptor. + (if (fboundp 'transient-mark-mode) + (transient-mark-mode t)) + (if crisp-load-scroll-all + (require 'scroll-all)) + (if (featurep 'scroll-all) + (define-key crisp-mode-map [(meta f1)] 'scroll-all-mode)))) + +;; People might use Apropos on `brief'. +;;;###autoload +(defalias 'brief-mode 'crisp-mode) + +;; Interaction with other packages. +(put 'crisp-home 'CUA 'move) +(put 'crisp-end 'CUA 'move) + +(run-hooks 'crisp-load-hook) +(provide 'crisp) + +;;; crisp.el ends here diff --git a/lisp/obsolete/tpu-edt.el b/lisp/obsolete/tpu-edt.el new file mode 100644 index 00000000000..43189319a6a --- /dev/null +++ b/lisp/obsolete/tpu-edt.el @@ -0,0 +1,2472 @@ +;;; tpu-edt.el --- Emacs emulating TPU emulating EDT + +;; Copyright (C) 1993-1995, 2000-2014 Free Software Foundation, Inc. + +;; Author: Rob Riepel +;; Maintainer: Rob Riepel +;; 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 . + +;; 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 +;; m emacs + +;; 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 "^" "> " " to beginning of line> +;; replace "$" "00711" + +;; 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) ; 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- 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 p + + Where `M-x' might be any of `Gold-KP7', 'Do', or 'ESC-x'. + + When you successfully invoke this part of the Emacs help facility, you + will see a buffer named `*Finder*' listing a number of topics. Look for + tpu-edt under `emulations'. + +\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\f + + *** No more help, use P to view previous screen") + +(defvar tpu-help-enter (format "%s" "\eOM")) ; tpu-help enter key symbol +(defvar tpu-help-return (format "%s" "\r")) ; tpu-help enter key symbol +(defvar tpu-help-N "N") ; tpu-help "N" symbol +(defvar tpu-help-n "n") ; tpu-help "n" symbol +(defvar tpu-help-P "P") ; tpu-help "P" symbol +(defvar tpu-help-p "p") ; tpu-help "p" symbol + +(defun tpu-help nil + "Display TPU-edt help." + (interactive) + ;; Save current window configuration + (save-window-excursion + ;; Create and fill help buffer if necessary + (if (not (get-buffer "*TPU-edt Help*")) + (progn (generate-new-buffer "*TPU-edt Help*") + (switch-to-buffer "*TPU-edt Help*") + (insert tpu-help-keypad-map) + (insert tpu-help-text) + (setq buffer-read-only t))) + + ;; Display the help buffer + (switch-to-buffer "*TPU-edt Help*") + (delete-other-windows) + (tpu-move-to-beginning) + (forward-line 1) + (tpu-line-to-top-of-window) + + ;; Prompt for keys to describe, based on screen state (split/not split) + (let ((key nil) (fkey nil) (split nil)) + (while (not (equal tpu-help-return fkey)) + (if split + (setq key + (read-key-sequence + "Press the key you want help on (RET=exit, ENTER=redisplay, N=next, P=prev): ")) + (setq key + (read-key-sequence + "Press the key you want help on (RET to exit, N next screen, P prev screen): "))) + + ;; Process the read key + ;; + ;; ENTER - Display just the help window + ;; N or n - Next help or describe-key screen + ;; P or p - Previous help or describe-key screen + ;; RETURN - Exit from TPU-help + ;; default - describe the key + ;; + (setq fkey (format "%s" key)) + (cond ((equal tpu-help-enter fkey) + (setq split nil) + (delete-other-windows)) + ((or (equal tpu-help-N fkey) (equal tpu-help-n fkey)) + (cond (split + (condition-case nil + (scroll-other-window 8) + (error nil))) + (t + (forward-page) + (forward-line 1) + (tpu-line-to-top-of-window)))) + ((or (equal tpu-help-P fkey) (equal tpu-help-p fkey)) + (cond (split + (condition-case nil + (scroll-other-window -8) + (error nil))) + (t + (forward-line -1) + (backward-page) + (forward-line 1) + (tpu-line-to-top-of-window)))) + ((not (equal tpu-help-return fkey)) + (setq split t) + (describe-key key) + ;; If the key is undefined, leave the + ;; message in the mini-buffer for 3 seconds + (if (not (key-binding key)) (sit-for 3)))))))) + + +;;; +;;; Auto-insert +;;; +(defun tpu-insert-escape nil + "Insert an escape character, and so becomes the escape-key alias." + (interactive) + (insert "\e")) + +(defun tpu-insert-formfeed nil + "Insert a formfeed character." + (interactive) + (insert "\C-L")) + + +;;; +;;; Define key +;;; +(defvar tpu-saved-control-r nil "Saved value of Control-r.") + +(defun tpu-end-define-macro-key (key) + "End the current macro definition." + (interactive "kPress the key you want to use to do what was just learned: ") + (end-kbd-macro nil) + (global-set-key key last-kbd-macro) + (global-set-key "\C-r" tpu-saved-control-r)) + +(defun tpu-define-macro-key nil + "Bind a set of keystrokes to a single key, or key combination." + (interactive) + (setq tpu-saved-control-r (global-key-binding "\C-r")) + (global-set-key "\C-r" 'tpu-end-define-macro-key) + (start-kbd-macro nil)) + + +;;; +;;; Buffers and Windows +;;; +(defun tpu-kill-buffer nil + "Kill the current buffer. +If `tpu-kill-buffers-silently' is non-nil, +kill modified buffers without asking." + (interactive) + (if tpu-kill-buffers-silently (set-buffer-modified-p nil)) + (kill-buffer (current-buffer))) + +(defun tpu-save-all-buffers-kill-emacs nil + "Save all buffers and exit Emacs." + (interactive) + (let ((delete-old-versions t)) + (save-buffers-kill-emacs t))) + +(defun tpu-write-current-buffers nil + "Save all modified buffers without exiting." + (interactive) + (save-some-buffers t)) + +(defun tpu-next-buffer nil + "Go to next buffer in ring." + (interactive) + (switch-to-buffer (car (reverse (buffer-list))))) + +(defun tpu-next-file-buffer nil + "Go to next buffer in ring that is visiting a file or directory." + (interactive) + (let ((list (tpu-make-file-buffer-list (buffer-list)))) + (setq list (delq (current-buffer) list)) + (if (not list) (tpu-error "No other buffers.")) + (switch-to-buffer (car (reverse list))))) + +(defun tpu-make-file-buffer-list (buffer-list) + "Return names from BUFFER-LIST excluding those beginning with a space or star." + (delq nil (mapcar (lambda (b) + (if (or (= (aref (buffer-name b) 0) ?\s) + (= (aref (buffer-name b) 0) ?*)) nil b)) + buffer-list))) + +(defun tpu-next-window nil + "Move to the next window." + (interactive) + (if (one-window-p) (message "There is only one window on screen.") + (other-window 1))) + +(defun tpu-previous-window nil + "Move to the previous window." + (interactive) + (if (one-window-p) (message "There is only one window on screen.") + (select-window (previous-window)))) + + +;;; +;;; Search +;;; +(defun tpu-toggle-regexp nil + "Switch in and out of regular expression search and replace mode." + (interactive) + (setq tpu-regexp-p (not tpu-regexp-p)) + (tpu-set-search) + (and (called-interactively-p 'interactive) + (message "Regular expression search and substitute %sabled." + (if tpu-regexp-p "en" "dis")))) + +(defun tpu-regexp-prompt (prompt) + "Read a string, adding 'RE' to the prompt if tpu-regexp-p is set." + (let ((re-prompt (concat (if tpu-regexp-p "RE ") prompt))) + (read-from-minibuffer re-prompt nil nil nil 'tpu-regexp-prompt-hist))) + +(defun tpu-search-highlight nil + (if (tpu-check-match) + (move-overlay tpu-search-overlay + (tpu-match-beginning) (tpu-match-end) (current-buffer)) + (unless (equal (overlay-start tpu-search-overlay) + (overlay-end tpu-search-overlay)) + (move-overlay tpu-search-overlay 1 1 (current-buffer))))) + +(defun tpu-search nil + "Search for a string or regular expression. +The search is performed in the current direction." + (interactive) + (tpu-set-search) + (tpu-search-internal "")) + +(defun tpu-search-forward nil + "Search for a string or regular expression. +The search is begins in the forward direction." + (interactive) + (setq tpu-searching-forward t) + (tpu-set-search t) + (tpu-search-internal "")) + +(defun tpu-search-reverse nil + "Search for a string or regular expression. +The search is begins in the reverse direction." + (interactive) + (setq tpu-searching-forward nil) + (tpu-set-search t) + (tpu-search-internal "")) + +(defun tpu-search-again nil + "Search for the same string or regular expression as last time. +The search is performed in the current direction." + (interactive) + (tpu-search-internal tpu-search-last-string)) + +;; tpu-set-search defines the search functions used by the TPU-edt internal +;; search function. It should be called whenever the direction changes, or +;; the regular expression mode is turned on or off. It can also be called +;; to ensure that the next search will be in the current direction. It is +;; called from: + +;; tpu-advance tpu-backup +;; tpu-toggle-regexp tpu-toggle-search-direction (t) +;; tpu-search tpu-lm-replace +;; tpu-search-forward (t) tpu-search-reverse (t) +;; tpu-search-forward-exit (t) tpu-search-backward-exit (t) + +(declare-function tpu-emacs-search "tpu-edt") +(declare-function tpu-emacs-rev-search "tpu-edt") + +(defun tpu-set-search (&optional arg) + "Set the search functions and set the search direction to the current direction. +If an argument is specified, don't set the search direction." + (if (not arg) (setq tpu-searching-forward tpu-advance)) + (cond (tpu-searching-forward + (cond (tpu-regexp-p + (fset 'tpu-emacs-search 're-search-forward) + (fset 'tpu-emacs-rev-search 're-search-backward)) + (t + (fset 'tpu-emacs-search 'search-forward) + (fset 'tpu-emacs-rev-search 'search-backward)))) + (t + (cond (tpu-regexp-p + (fset 'tpu-emacs-search 're-search-backward) + (fset 'tpu-emacs-rev-search 're-search-forward)) + (t + (fset 'tpu-emacs-search 'search-backward) + (fset 'tpu-emacs-rev-search 'search-forward)))))) + +(defun tpu-search-internal (pat &optional quiet) + "Search for a string or regular expression." + (setq tpu-search-last-string + (if (not (string= "" pat)) pat (tpu-regexp-prompt "Search: "))) + + (tpu-unset-match) + (tpu-adjust-search) + + (let ((case-fold-search + (and case-fold-search (tpu-check-search-case tpu-search-last-string)))) + + (cond ((tpu-emacs-search tpu-search-last-string nil t) + (tpu-set-match) (goto-char (tpu-match-beginning))) + + (t + (tpu-adjust-search t) + (let ((found nil) (pos nil)) + (save-excursion + (let ((tpu-searching-forward (not tpu-searching-forward))) + (tpu-adjust-search) + (setq found (tpu-emacs-rev-search tpu-search-last-string nil t)) + (setq pos (match-beginning 0)))) + + (cond + (found + (cond ((tpu-y-or-n-p + (format "Found in %s direction. Go there? " + (if tpu-searching-forward "reverse" "forward"))) + (goto-char pos) (tpu-set-match) + (tpu-toggle-search-direction)))) + + (t + (if (not quiet) + (message + "%sSearch failed: \"%s\"" + (if tpu-regexp-p "RE " "") tpu-search-last-string))))))))) + +(defalias 'tpu-search-internal-core (symbol-function 'tpu-search-internal)) + +(defun tpu-check-search-case (string) + "Return t if string contains upper case." + ;; if using regexp, eliminate upper case forms (\B \W \S.) + (if tpu-regexp-p + (let ((pat (copy-sequence string)) (case-fold-search nil) (pos 0)) + (while (setq pos (string-match "\\\\\\\\" pat)) (aset pat (+ 1 pos) ?.)) + (while (setq pos (string-match "\\\\B" pat)) (aset pat (+ 1 pos) ?.)) + (while (setq pos (string-match "\\\\W" pat)) (aset pat (+ 1 pos) ?.)) + (while (setq pos (string-match "\\\\S." pat)) + (aset pat (+ 1 pos) ?.) (aset pat (+ 2 pos) ?.)) + (string-equal pat (downcase pat))) + (string-equal string (downcase string)))) + +(defun tpu-adjust-search (&optional arg) + "For forward searches, move forward a character before searching, +and backward a character after a failed search. Arg means end of search." + (if tpu-searching-forward + (cond (arg (if (not (bobp)) (forward-char -1))) + (t (if (not (eobp)) (forward-char 1)))))) + +(defun tpu-toggle-search-direction nil + "Toggle the TPU-edt search direction. +Used for reversing a search in progress." + (interactive) + (setq tpu-searching-forward (not tpu-searching-forward)) + (tpu-set-search t) + (and (called-interactively-p 'interactive) + (message "Searching %sward." + (if tpu-searching-forward "for" "back")))) + +(defun tpu-search-forward-exit nil + "Set search direction forward and exit minibuffer." + (interactive) + (setq tpu-searching-forward t) + (tpu-set-search t) + (exit-minibuffer)) + +(defun tpu-search-backward-exit nil + "Set search direction backward and exit minibuffer." + (interactive) + (setq tpu-searching-forward nil) + (tpu-set-search t) + (exit-minibuffer)) + + +;;; +;;; Select / Unselect +;;; +(defun tpu-select (&optional quiet) + "Set the mark to define one end of a region." + (interactive "P") + (cond ((tpu-mark) + (tpu-unselect quiet)) + (t + (tpu-set-mark (point)) + (tpu-update-mode-line) + (if (not quiet) (message "Move the text cursor to select text."))))) + +(defun tpu-unselect (&optional quiet) + "Remove the mark to unselect the current region." + (interactive "P") + (deactivate-mark) + (setq mark-ring nil) + (tpu-set-mark nil) + (tpu-update-mode-line) + (if (not quiet) (message "Selection canceled."))) + + +;;; +;;; Delete / Cut +;;; +(defun tpu-toggle-rectangle nil + "Toggle rectangular mode for remove and insert." + (interactive) + (setq tpu-rectangular-p (not tpu-rectangular-p)) + (setq tpu-rectangle-string (if tpu-rectangular-p " Rect" "")) + (tpu-update-mode-line) + (and (called-interactively-p 'interactive) + (message "Rectangular cut and paste %sabled." + (if tpu-rectangular-p "en" "dis")))) + +(defun tpu-arrange-rectangle nil + "Adjust point and mark to upper left and lower right corners of a rectangle." + (let ((mc (current-column)) + (pc (progn (exchange-point-and-mark) (current-column)))) + + (cond ((> (point) (tpu-mark)) ; point on lower line + (cond ((> pc mc) ; point @ lower-right + (exchange-point-and-mark)) ; point -> upper-left + + (t ; point @ lower-left + (move-to-column mc t) ; point -> lower-right + (exchange-point-and-mark) ; point -> upper-right + (move-to-column pc t)))) ; point -> upper-left + + (t ; point on upper line + (cond ((> pc mc) ; point @ upper-right + (move-to-column mc t) ; point -> upper-left + (exchange-point-and-mark) ; point -> lower-left + (move-to-column pc t) ; point -> lower-right + (exchange-point-and-mark))))))) ; point -> upper-left + +(defun tpu-cut-text nil + "Delete the selected region. +The text is saved for the tpu-paste command." + (interactive) + (cond ((tpu-mark) + (cond (tpu-rectangular-p + (tpu-arrange-rectangle) + (picture-clear-rectangle (point) (tpu-mark) (not overwrite-mode)) + (tpu-unselect t)) + (t + (setq tpu-last-deleted-region + (buffer-substring (tpu-mark) (point))) + (delete-region (tpu-mark) (point)) + (tpu-unselect t)))) + ((tpu-check-match) + (let ((beg (tpu-match-beginning)) (end (tpu-match-end))) + (setq tpu-last-deleted-region (buffer-substring beg end)) + (delete-region beg end) + (tpu-unset-match))) + (t + (tpu-error "No selection active.")))) + +(defun tpu-store-text nil + "Copy the selected region to the cut buffer without deleting it. +The text is saved for the tpu-paste command." + (interactive) + (cond ((tpu-mark) + (cond (tpu-rectangular-p + (save-excursion + (tpu-arrange-rectangle) + (setq picture-killed-rectangle + (extract-rectangle (point) (tpu-mark)))) + (tpu-unselect t)) + (t + (setq tpu-last-deleted-region + (buffer-substring (tpu-mark) (point))) + (tpu-unselect t)))) + ((tpu-check-match) + (setq tpu-last-deleted-region + (buffer-substring (tpu-match-beginning) (tpu-match-end))) + (tpu-unset-match)) + (t + (tpu-error "No selection active.")))) + +(defun tpu-cut (arg) + "Copy selected region to the cut buffer. +In the absence of an argument, delete the selected region too." + (interactive "P") + (if arg (tpu-store-text) (tpu-cut-text))) + +(defun tpu-append-region (arg) + "Append selected region to the tpu-cut buffer. +In the absence of an argument, delete the selected region too." + (interactive "P") + (cond ((tpu-mark) + (let ((beg (region-beginning)) (end (region-end))) + (setq tpu-last-deleted-region + (concat tpu-last-deleted-region + (buffer-substring beg end))) + (if (not arg) (delete-region beg end)) + (tpu-unselect t))) + ((tpu-check-match) + (let ((beg (tpu-match-beginning)) (end (tpu-match-end))) + (setq tpu-last-deleted-region + (concat tpu-last-deleted-region + (buffer-substring beg end))) + (if (not arg) (delete-region beg end)) + (tpu-unset-match))) + (t + (tpu-error "No selection active.")))) + +(defun tpu-delete-current-line (num) + "Delete one or specified number of lines after point. +This includes the newline character at the end of each line. +They are saved for the TPU-edt undelete-lines command." + (interactive "p") + (let ((beg (point))) + (forward-line num) + (if (not (eq (preceding-char) ?\n)) + (insert "\n")) + (setq tpu-last-deleted-lines + (buffer-substring beg (point))) + (delete-region beg (point)))) + +(defun tpu-delete-to-eol (num) + "Delete text up to end of line. +With argument, delete up to the Nth line-end past point. +They are saved for the TPU-edt undelete-lines command." + (interactive "p") + (let ((beg (point))) + (forward-char 1) + (end-of-line num) + (setq tpu-last-deleted-lines + (buffer-substring beg (point))) + (delete-region beg (point)))) + +(defun tpu-delete-to-bol (num) + "Delete text back to beginning of line. +With argument, delete up to the Nth line-end past point. +They are saved for the TPU-edt undelete-lines command." + (interactive "p") + (let ((beg (point))) + (tpu-next-beginning-of-line num) + (setq tpu-last-deleted-lines + (buffer-substring (point) beg)) + (delete-region (point) beg))) + +(defun tpu-delete-current-word (num) + "Delete one or specified number of words after point. +They are saved for the TPU-edt undelete-words command." + (interactive "p") + (let ((beg (point))) + (tpu-forward-to-word num) + (setq tpu-last-deleted-words + (buffer-substring beg (point))) + (delete-region beg (point)))) + +(defun tpu-delete-previous-word (num) + "Delete one or specified number of words before point. +They are saved for the TPU-edt undelete-words command." + (interactive "p") + (let ((beg (point))) + (tpu-backward-to-word num) + (setq tpu-last-deleted-words + (buffer-substring (point) beg)) + (delete-region beg (point)))) + +(defun tpu-delete-current-char (num) + "Delete one or specified number of characters after point. +The last character deleted is saved for the TPU-edt undelete-char command." + (interactive "p") + (while (and (> num 0) (not (eobp))) + (setq tpu-last-deleted-char (char-after (point))) + (cond (overwrite-mode + (picture-clear-column 1) + (forward-char 1)) + (t + (delete-char 1))) + (setq num (1- num)))) + + +;;; +;;; Undelete / Paste +;;; +(defun tpu-paste (num) + "Insert the last region or rectangle of killed text. +With argument reinserts the text that many times." + (interactive "p") + (while (> num 0) + (cond (tpu-rectangular-p + (let ((beg (point))) + (save-excursion + (picture-yank-rectangle (not overwrite-mode)) + (message "")) + (goto-char beg))) + (t + (insert tpu-last-deleted-region))) + (setq num (1- num)))) + +(defun tpu-undelete-lines (num) + "Insert lines deleted by last TPU-edt line-deletion command. +With argument reinserts lines that many times." + (interactive "p") + (let ((beg (point))) + (while (> num 0) + (insert tpu-last-deleted-lines) + (setq num (1- num))) + (goto-char beg))) + +(defun tpu-undelete-words (num) + "Insert words deleted by last TPU-edt word-deletion command. +With argument reinserts words that many times." + (interactive "p") + (let ((beg (point))) + (while (> num 0) + (insert tpu-last-deleted-words) + (setq num (1- num))) + (goto-char beg))) + +(defun tpu-undelete-char (num) + "Insert character deleted by last TPU-edt character-deletion command. +With argument reinserts the character that many times." + (interactive "p") + (while (> num 0) + (if overwrite-mode (prog1 (forward-char -1) (delete-char 1))) + (insert tpu-last-deleted-char) + (forward-char -1) + (setq num (1- num)))) + + +;;; +;;; Replace and Substitute +;;; +(defun tpu-replace nil + "Replace the selected region with the contents of the cut buffer." + (interactive) + (cond ((tpu-mark) + (let ((beg (region-beginning)) (end (region-end))) + (setq tpu-last-replaced-text (buffer-substring beg end)) + (delete-region beg end) + (insert tpu-last-deleted-region) + (tpu-unselect t))) + ((tpu-check-match) + (let ((beg (tpu-match-beginning)) (end (tpu-match-end))) + (setq tpu-last-replaced-text (buffer-substring beg end)) + (replace-match tpu-last-deleted-region + (not case-replace) (not tpu-regexp-p)) + (tpu-unset-match))) + (t + (tpu-error "No selection active.")))) + +(defun tpu-substitute (num) + "Replace the selected region with the contents of the cut buffer, +and repeat most recent search. A numeric argument serves as a repeat count. +A negative argument means replace all occurrences of the search string." + (interactive "p") + (cond ((or (tpu-mark) (tpu-check-match)) + (while (and (not (= num 0)) (or (tpu-mark) (tpu-check-match))) + (let ((beg (point))) + (tpu-replace) + (if tpu-searching-forward (forward-char -1) (goto-char beg)) + (if (= num 1) (tpu-search-internal tpu-search-last-string) + (tpu-search-internal-core tpu-search-last-string))) + (setq num (1- num)))) + (t + (tpu-error "No selection active.")))) + +(defun tpu-lm-replace (from to) + "Interactively search for OLD-string and substitute NEW-string." + (interactive (list (tpu-regexp-prompt "Old String: ") + (tpu-regexp-prompt "New String: "))) + + (let ((doit t) (strings 0)) + + ;; Can't replace null strings + (if (string= "" from) (tpu-error "No string to replace.")) + + ;; Find the first occurrence + (tpu-set-search) + (tpu-search-internal from t) + + ;; Loop on replace question - yes, no, all, last, or quit. + (while doit + (if (not (tpu-check-match)) (setq doit nil) + (progn + (move-overlay tpu-replace-overlay + (tpu-match-beginning) (tpu-match-end) (current-buffer)) + (message "Replace? Type Yes, No, All, Last, or Quit: ") + (let ((ans (read-char))) + + (cond ((or (= ans ?y) (= ans ?Y) (= ans ?\r) (= ans ?\ )) + (let ((beg (point))) + (replace-match to (not case-replace) (not tpu-regexp-p)) + (setq strings (1+ strings)) + (if tpu-searching-forward (forward-char -1) (goto-char beg))) + (tpu-search-internal from t)) + + ((or (= ans ?n) (= ans ?N) (= ans ?\C-?)) + (tpu-search-internal from t)) + + ((or (= ans ?a) (= ans ?A)) + (save-excursion + (let ((beg (point))) + (replace-match to (not case-replace) (not tpu-regexp-p)) + (setq strings (1+ strings)) + (if tpu-searching-forward (forward-char -1) (goto-char beg))) + (tpu-search-internal-core from t) + (while (tpu-check-match) + (let ((beg (point))) + (replace-match to (not case-replace) (not tpu-regexp-p)) + (setq strings (1+ strings)) + (if tpu-searching-forward (forward-char -1) (goto-char beg))) + (tpu-search-internal-core from t))) + (setq doit nil)) + + ((or (= ans ?l) (= ans ?L)) + (let ((beg (point))) + (replace-match to (not case-replace) (not tpu-regexp-p)) + (setq strings (1+ strings)) + (if tpu-searching-forward (forward-char -1) (goto-char beg))) + (setq doit nil)) + + ((or (= ans ?q) (= ans ?Q)) + (tpu-unset-match) + (setq doit nil))))))) + + (move-overlay tpu-replace-overlay 1 1 (current-buffer)) + (message "Replaced %s occurrence%s." strings (if (not (= 1 strings)) "s" "")))) + +(defun tpu-emacs-replace (&optional dont-ask) + "A TPU-edt interface to the Emacs replace functions. +If TPU-edt is currently in regular expression mode, the Emacs regular +expression replace functions are used. If an argument is supplied, +replacements are performed without asking. Only works in forward direction." + (interactive "P") + (cond (dont-ask + (setq current-prefix-arg nil) + (call-interactively + (if tpu-regexp-p 'replace-regexp 'replace-string))) + (t + (call-interactively + (if tpu-regexp-p 'query-replace-regexp 'query-replace))))) + +(defun tpu-add-at-bol (text) + "Add text to the beginning of each line in a region, +or each line in the entire buffer if no region is selected." + (interactive + (list (tpu-string-prompt "String to add: " 'tpu-add-at-bol-hist))) + (if (string= "" text) (tpu-error "No string specified.")) + (cond ((tpu-mark) + (save-excursion + (if (> (point) (tpu-mark)) (exchange-point-and-mark)) + (while (and (< (point) (tpu-mark)) (re-search-forward "^" (tpu-mark) t)) + (if (< (point) (tpu-mark)) (replace-match text)))) + (tpu-unselect t)) + (t + (save-excursion + (goto-char (point-min)) + (while (and (re-search-forward "^" nil t) (not (eobp))) + (replace-match text)))))) + +(defun tpu-add-at-eol (text) + "Add text to the end of each line in a region, +or each line of the entire buffer if no region is selected." + (interactive + (list (tpu-string-prompt "String to add: " 'tpu-add-at-eol-hist))) + (if (string= "" text) (tpu-error "No string specified.")) + (cond ((tpu-mark) + (save-excursion + (if (> (point) (tpu-mark)) (exchange-point-and-mark)) + (while (< (point) (tpu-mark)) + (end-of-line) + (if (<= (point) (tpu-mark)) (insert text)) + (forward-line))) + (tpu-unselect t)) + (t + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (end-of-line) (insert text) (forward-line)))))) + +(defun tpu-trim-line-ends nil + "Remove trailing whitespace from every line in the buffer." + (interactive) + (save-match-data + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "[ \t][ \t]*$" nil t) + (delete-region (match-beginning 0) (match-end 0)))))) + + +;;; +;;; Movement by character +;;; +(defun tpu-char (num) + "Move to the next character in the current direction. +A repeat count means move that many characters." + (interactive "p") + (if tpu-advance (tpu-forward-char num) (tpu-backward-char num))) + +(defun tpu-forward-char (num) + "Move right ARG characters (left if ARG is negative)." + (interactive "p") + (forward-char num)) + +(defun tpu-backward-char (num) + "Move left ARG characters (right if ARG is negative)." + (interactive "p") + (backward-char num)) + + +;;; +;;; Movement by word +;;; +(defvar tpu-word-separator-list '() + "List of additional word separators.") +(defvar tpu-skip-chars "^ \t" + "Characters to skip when moving by word. +Additional word separators are added to this string.") + +(defun tpu-word (num) + "Move to the beginning of the next word in the current direction. +A repeat count means move that many words." + (interactive "p") + (if tpu-advance (tpu-forward-to-word num) (tpu-backward-to-word num))) + +(defun tpu-forward-to-word (num) + "Move forward until encountering the beginning of a word. +With argument, do this that many times." + (interactive "p") + (while (and (> num 0) (not (eobp))) + (let* ((beg (point)) + (end (prog2 (end-of-line) (point) (goto-char beg)))) + (cond ((eolp) + (forward-char 1)) + ((memq (char-after (point)) tpu-word-separator-list) + (forward-char 1) + (skip-chars-forward " \t" end)) + (t + (skip-chars-forward tpu-skip-chars end) + (skip-chars-forward " \t" end)))) + (setq num (1- num)))) + +(defun tpu-backward-to-word (num) + "Move backward until encountering the beginning of a word. +With argument, do this that many times." + (interactive "p") + (while (and (> num 0) (not (bobp))) + (let* ((beg (point)) + (end (prog2 (beginning-of-line) (point) (goto-char beg)))) + (cond ((bolp) + ( forward-char -1)) + ((memq (char-after (1- (point))) tpu-word-separator-list) + (forward-char -1)) + (t + (skip-chars-backward " \t" end) + (skip-chars-backward tpu-skip-chars end) + (if (and (not (bolp)) (= ? (char-syntax (char-after (point))))) + (forward-char -1))))) + (setq num (1- num)))) + +(defun tpu-add-word-separators (separators) + "Add new word separators for TPU-edt word commands." + (interactive "sSeparators: ") + (let* ((n 0) (length (length separators))) + (while (< n length) + (let ((char (aref separators n)) + (ss (substring separators n (1+ n)))) + (cond ((not (memq char tpu-word-separator-list)) + (setq tpu-word-separator-list + (append ss tpu-word-separator-list)) + (cond ((= char ?-) + (setq tpu-skip-chars (concat tpu-skip-chars "\\-"))) + ((= char ?\\) + (setq tpu-skip-chars (concat tpu-skip-chars "\\\\"))) + ((= char ?^) + (setq tpu-skip-chars (concat tpu-skip-chars "\\^"))) + (t + (setq tpu-skip-chars (concat tpu-skip-chars ss)))))) + (setq n (1+ n)))))) + +(defun tpu-reset-word-separators nil + "Reset word separators to default value." + (interactive) + (setq tpu-word-separator-list nil) + (setq tpu-skip-chars "^ \t")) + +(defun tpu-set-word-separators (separators) + "Set new word separators for TPU-edt word commands." + (interactive "sSeparators: ") + (tpu-reset-word-separators) + (tpu-add-word-separators separators)) + + +;;; +;;; Movement by line +;;; +(defun tpu-next-line (num) + "Move to next line. +Prefix argument serves as a repeat count." + (interactive "p") + (line-move num) + (setq this-command 'next-line)) + +(defun tpu-previous-line (num) + "Move to previous line. +Prefix argument serves as a repeat count." + (interactive "p") + (line-move (- num)) + (setq this-command 'previous-line)) + +(defun tpu-next-beginning-of-line (num) + "Move to beginning of line; if at beginning, move to beginning of next line. +Accepts a prefix argument for the number of lines to move." + (interactive "p") + (backward-char 1) + (forward-visible-line (- 1 num))) + +(defun tpu-end-of-line (num) + "Move to the next end of line in the current direction. +A repeat count means move that many lines." + (interactive "p") + (if tpu-advance (tpu-next-end-of-line num) (tpu-previous-end-of-line num))) + +(defun tpu-next-end-of-line (num) + "Move to end of line; if at end, move to end of next line. +Accepts a prefix argument for the number of lines to move." + (interactive "p") + (forward-char 1) + (end-of-line num)) + +(defun tpu-previous-end-of-line (num) + "Move EOL upward. +Accepts a prefix argument for the number of lines to move." + (interactive "p") + (end-of-line (- 1 num))) + +(defun tpu-current-end-of-line nil + "Move point to end of current line." + (interactive) + (let ((beg (point))) + (end-of-line) + (if (= beg (point)) (message "You are already at the end of a line.")))) + +(defun tpu-line (num) + "Move to the beginning of the next line in the current direction. +A repeat count means move that many lines." + (interactive "p") + (if tpu-advance (tpu-forward-line num) (tpu-backward-line num))) + +(defun tpu-forward-line (num) + "Move to beginning of next line. +Prefix argument serves as a repeat count." + (interactive "p") + (forward-line num)) + +(defun tpu-backward-line (num) + "Move to beginning of previous line. +Prefix argument serves as repeat count." + (interactive "p") + (or (bolp) (>= 0 num) (setq num (- num 1))) + (forward-line (- num))) + + +;;; +;;; Movement by paragraph +;;; +(defun tpu-paragraph (num) + "Move to the next paragraph in the current direction. +A repeat count means move that many paragraphs." + (interactive "p") + (if tpu-advance + (tpu-next-paragraph num) (tpu-previous-paragraph num))) + +(defun tpu-next-paragraph (num) + "Move to beginning of the next paragraph. +Accepts a prefix argument for the number of paragraphs." + (interactive "p") + (beginning-of-line) + (while (and (not (eobp)) (> num 0)) + (if (re-search-forward "^[ \t]*$" nil t) + (if (re-search-forward "[^ \t\n]" nil t) + (goto-char (match-beginning 0)) + (goto-char (point-max)))) + (setq num (1- num))) + (beginning-of-line)) + + +(defun tpu-previous-paragraph (num) + "Move to beginning of previous paragraph. +Accepts a prefix argument for the number of paragraphs." + (interactive "p") + (end-of-line) + (while (and (not (bobp)) (> num 0)) + (if (not (and (re-search-backward "^[ \t]*$" nil t) + (re-search-backward "[^ \t\n]" nil t) + (re-search-backward "^[ \t]*$" nil t) + (progn (re-search-forward "[^ \t\n]" nil t) + (goto-char (match-beginning 0))))) + (goto-char (point-min))) + (setq num (1- num))) + (beginning-of-line)) + + +;;; +;;; Movement by page +;;; +(defun tpu-page (num) + "Move to the next page in the current direction. +A repeat count means move that many pages." + (interactive "p") + (if tpu-advance (forward-page num) (backward-page num)) + (if (eobp) (recenter -1))) + + +;;; +;;; Scrolling and movement within the buffer +;;; +(defun tpu-scroll-window (num) + "Scroll the display to the next section in the current direction. +A repeat count means scroll that many sections." + (interactive "p") + (if tpu-advance (tpu-scroll-window-up num) (tpu-scroll-window-down num))) + +(defun tpu-scroll-window-down (num) + "Scroll the display down to the next section. +A repeat count means scroll that many sections." + (interactive "p") + (let* ((beg (tpu-current-line)) + (height (1- (window-height))) + (lines (* num (/ (* height tpu-percent-scroll) 100)))) + (line-move (- lines)) + (if (> lines beg) (recenter 0)))) + +(defun tpu-scroll-window-up (num) + "Scroll the display up to the next section. +A repeat count means scroll that many sections." + (interactive "p") + (let* ((beg (tpu-current-line)) + (height (1- (window-height))) + (lines (* num (/ (* height tpu-percent-scroll) 100)))) + (line-move lines) + (if (>= (+ lines beg) height) (recenter -1)))) + +(defun tpu-pan-right (num) + "Pan right tpu-pan-columns (16 by default). +Accepts a prefix argument for the number of tpu-pan-columns to scroll." + (interactive "p") + (scroll-left (* tpu-pan-columns num))) + +(defun tpu-pan-left (num) + "Pan left tpu-pan-columns (16 by default). +Accepts a prefix argument for the number of tpu-pan-columns to scroll." + (interactive "p") + (scroll-right (* tpu-pan-columns num))) + +(defun tpu-move-to-beginning nil + "Move cursor to the beginning of buffer, but don't set the mark." + (interactive) + (goto-char (point-min))) + +(defun tpu-move-to-end nil + "Move cursor to the end of buffer, but don't set the mark." + (interactive) + (goto-char (point-max)) + (recenter -1)) + +(defun tpu-goto-percent (perc) + "Move point to ARG percentage of the buffer." + (interactive "NGoto-percentage: ") + (if (or (> perc 100) (< perc 0)) + (tpu-error "Percentage %d out of range 0 < percent < 100." perc) + (goto-char (/ (* (point-max) perc) 100)))) + +(defun tpu-beginning-of-window nil + "Move cursor to top of window." + (interactive) + (move-to-window-line 0)) + +(defun tpu-end-of-window nil + "Move cursor to bottom of window." + (interactive) + (move-to-window-line -1)) + +(defun tpu-line-to-bottom-of-window nil + "Move the current line to the bottom of the window." + (interactive) + (recenter -1)) + +(defun tpu-line-to-top-of-window nil + "Move the current line to the top of the window." + (interactive) + (recenter 0)) + + +;;; +;;; Direction +;;; +(defun tpu-advance-direction nil + "Set TPU Advance mode so keypad commands move forward." + (interactive) + (setq tpu-direction-string " Advance") + (setq tpu-advance t) + (setq tpu-reverse nil) + (tpu-set-search) + (tpu-update-mode-line)) + +(defun tpu-backup-direction nil + "Set TPU Backup mode so keypad commands move backward." + (interactive) + (setq tpu-direction-string " Reverse") + (setq tpu-advance nil) + (setq tpu-reverse t) + (tpu-set-search) + (tpu-update-mode-line)) + +(defun tpu-toggle-direction nil + "Change the current TPU direction." + (interactive) + (if tpu-advance (tpu-backup-direction) (tpu-advance-direction))) + + +;;; +;;; Minibuffer map additions to make KP_enter = RET +;;; +;; Standard Emacs settings under xterm in function-key-map map +;; "\eOM" to [kp-enter] and [kp-enter] to RET, but since the output of the map +;; is not fed back into the map, the key stays as kp-enter :-(. +(define-key minibuffer-local-map [kp-enter] 'exit-minibuffer) +;; These are not necessary because they are inherited. +;; (define-key minibuffer-local-ns-map [kp-enter] 'exit-minibuffer) +;; (define-key minibuffer-local-completion-map [kp-enter] 'exit-minibuffer) +(define-key minibuffer-local-must-match-map [kp-enter] 'minibuffer-complete-and-exit) + + +;;; +;;; Minibuffer map additions to set search direction +;;; +(define-key minibuffer-local-map [kp-4] 'tpu-search-forward-exit) ;KP4 +(define-key minibuffer-local-map [kp-5] 'tpu-search-backward-exit) ;KP5 + + +;;; +;;; Functions to set, reset, and toggle the control key bindings +;;; + +(defvar tpu-control-keys-map + (let ((map (make-sparse-keymap))) + (define-key map "\C-\\" 'quoted-insert) ; ^\ + (define-key map "\C-a" 'tpu-toggle-overwrite-mode) ; ^A + (define-key map "\C-b" 'repeat-complex-command) ; ^B + (define-key map "\C-e" 'tpu-current-end-of-line) ; ^E + (define-key map "\C-h" 'tpu-next-beginning-of-line) ; ^H (BS) + (define-key map "\C-j" 'tpu-delete-previous-word) ; ^J (LF) + (define-key map "\C-k" 'tpu-define-macro-key) ; ^K + (define-key map "\C-l" 'tpu-insert-formfeed) ; ^L (FF) + (define-key map "\C-r" 'recenter) ; ^R + (define-key map "\C-u" 'tpu-delete-to-bol) ; ^U + (define-key map "\C-v" 'tpu-quoted-insert) ; ^V + (define-key map "\C-w" 'redraw-display) ; ^W + (define-key map "\C-z" 'tpu-exit) ; ^Z + map)) + +(defun tpu-set-control-keys () + "Set control keys to TPU style functions." + (tpu-reset-control-keys 'tpu)) + +(defun tpu-reset-control-keys (tpu-style) + "Set control keys to TPU or Emacs style functions." + (let ((parent (keymap-parent tpu-global-map))) + (if tpu-style + (if (eq parent tpu-control-keys-map) + nil ;All done already. + ;; Insert tpu-control-keys-map in the global map. + (set-keymap-parent tpu-control-keys-map parent) + (set-keymap-parent tpu-global-map tpu-control-keys-map)) + (if (not (eq parent tpu-control-keys-map)) + nil ;All done already. + ;; Remove tpu-control-keys-map from the global map. + (set-keymap-parent tpu-global-map (keymap-parent parent)) + (set-keymap-parent tpu-control-keys-map nil))) + (setq tpu-control-keys tpu-style))) + +(defun tpu-toggle-control-keys nil + "Toggle control key bindings between TPU-edt and Emacs." + (interactive) + (tpu-reset-control-keys (not tpu-control-keys)) + (and (called-interactively-p 'interactive) + (message "Control keys function with %s bindings." + (if tpu-control-keys "TPU-edt" "Emacs")))) + + +;;; +;;; Emacs version 19 minibuffer history support +;;; +(defun tpu-next-history-element (n) + "Insert the next element of the minibuffer history into the minibuffer." + (interactive "p") + (next-history-element n) + (goto-char (point-max))) + +(defun tpu-previous-history-element (n) + "Insert the previous element of the minibuffer history into the minibuffer." + (interactive "p") + (previous-history-element n) + (goto-char (point-max))) + +(defun tpu-arrow-history nil + "Modify minibuffer maps to use arrows for history recall." + (interactive) + (dolist (cur (where-is-internal 'tpu-previous-line)) + (define-key read-expression-map cur 'tpu-previous-history-element) + (define-key minibuffer-local-map cur 'tpu-previous-history-element) + ;; These are inherited anyway. --Stef + ;; (define-key minibuffer-local-ns-map cur 'tpu-previous-history-element) + ;; (define-key minibuffer-local-completion-map cur 'tpu-previous-history-element) + ;; (define-key minibuffer-local-must-match-map cur 'tpu-previous-history-element) + ) + + (dolist (cur (where-is-internal 'tpu-next-line)) + (define-key read-expression-map cur 'tpu-next-history-element) + (define-key minibuffer-local-map cur 'tpu-next-history-element) + ;; These are inherited anyway. --Stef + ;; (define-key minibuffer-local-ns-map cur 'tpu-next-history-element) + ;; (define-key minibuffer-local-completion-map cur 'tpu-next-history-element) + ;; (define-key minibuffer-local-must-match-map cur 'tpu-next-history-element) + )) + + +;;; +;;; Emacs version 19 X-windows key definition support +;;; +(defun tpu-load-xkeys (file) + "Load the TPU-edt X-windows key definitions FILE. +If FILE is nil, try to load a default file. The default file names are +`~/.tpu-lucid-keys' for XEmacs, and `~/.tpu-keys' for Emacs." + (interactive "fX key definition file: ") + (cond (file + (setq file (expand-file-name file))) + (tpu-xkeys-file + (setq file (expand-file-name tpu-xkeys-file))) + ((featurep 'xemacs) + (setq file (convert-standard-filename + (expand-file-name "~/.tpu-lucid-keys")))) + (t + (setq file (convert-standard-filename + (expand-file-name "~/.tpu-keys"))) + (and (not (file-exists-p file)) + (file-exists-p + (convert-standard-filename + (expand-file-name "~/.tpu-gnu-keys"))) + (tpu-copy-keyfile + (convert-standard-filename + (expand-file-name "~/.tpu-gnu-keys")) file)))) + (cond ((file-readable-p file) + (load-file file)) + (t + ;; This used to force the user to build `file'. With the + ;; new code, such a file may not be necessary. In case it + ;; is, issue a message giving a hint as to how to build it. + (message "%s not found: use M-x tpu-mapper to create it" + (abbreviate-file-name file))))) + +(defun tpu-copy-keyfile (oldname newname) + "Copy the TPU-edt X key definitions file to the new default name." + (interactive "fOld name: \nFNew name: ") + (if (not (get-buffer "*TPU-Notice*")) (generate-new-buffer "*TPU-Notice*")) + (set-buffer "*TPU-Notice*") + (erase-buffer) + (insert " + NOTICE -- + + The default name of the TPU-edt key definition file has changed + from `~/.tpu-gnu-keys' to `~/.tpu-keys'. With your permission, + your key definitions will be copied to the new file. If you'll + never use older versions of Emacs, you can remove the old file. + If the copy fails, you'll be asked if you want to create a new + key definitions file. Do you want to copy your key definition + file now? + ") + (save-window-excursion + (switch-to-buffer-other-window "*TPU-Notice*") + (shrink-window-if-larger-than-buffer) + (goto-char (point-min)) + (beep) + (and (tpu-y-or-n-p "Copy key definitions to the new file now? ") + (with-demoted-errors "Sorry, couldn't copy - %s." + (copy-file oldname newname))) + (kill-buffer "*TPU-Notice*"))) + +(defvar tpu-edt-old-global-values nil) + +;;; +;;; Start and Stop TPU-edt +;;; +;;;###autoload +(defun tpu-edt-on () + "Turn on TPU/edt emulation." + (interactive) + ;; To clean things up (and avoid cycles in the global map). + (tpu-edt-off) + ;; First, activate tpu-global-map, while protecting the original keymap. + (set-keymap-parent tpu-global-map global-map) + (setq global-map tpu-global-map) + (use-global-map global-map) + ;; Then do the normal TPU setup. + (transient-mark-mode t) + (add-hook 'post-command-hook 'tpu-search-highlight) + (tpu-set-mode-line t) + (tpu-advance-direction) + ;; set page delimiter, display line truncation, and scrolling like TPU + (dolist (varval '((page-delimiter . "\f") + (truncate-lines . t) + (scroll-step . 1))) + (push (cons (car varval) (default-value (car varval))) + tpu-edt-old-global-values) + (set-default (car varval) (cdr varval))) + (tpu-set-control-keys) + (and window-system (tpu-load-xkeys nil)) + (tpu-arrow-history) + ;; Then protect tpu-global-map from user modifications. + (let ((map (make-sparse-keymap))) + (set-keymap-parent map global-map) + (setq global-map map) + (use-global-map map)) + (setq tpu-edt-mode t)) + +(defun tpu-edt-off () + "Turn off TPU/edt emulation. Note that the keypad is left on." + (interactive) + (tpu-reset-control-keys nil) + (remove-hook 'post-command-hook 'tpu-search-highlight) + (tpu-set-mode-line nil) + (while tpu-edt-old-global-values + (let ((varval (pop tpu-edt-old-global-values))) + (set-default (car varval) (cdr varval)))) + ;; Remove tpu-global-map from the global map. + (let ((map global-map)) + (while map + (let ((parent (keymap-parent map))) + (if (eq tpu-global-map parent) + (set-keymap-parent map (keymap-parent parent)) + (setq map parent))))) + ;; Only has an effect if the advice in tpu-extras has been activated. + (condition-case nil + (with-no-warnings (ad-disable-regexp "\\`tpu-")) + (error nil)) + (setq tpu-edt-mode nil)) + + +;;;### (autoloads nil "tpu-extras" "tpu-extras.el" "cbbb448cff48fab904ac19805aa6f36a") +;;; Generated autoloads from tpu-extras.el + +(autoload 'tpu-cursor-free-mode "tpu-extras" "\ +Minor mode to allow the cursor to move freely about the screen. +With a prefix argument ARG, enable the mode if ARG is positive, +and disable it otherwise. If called from Lisp, enable the mode +if ARG is omitted or nil. + +\(fn &optional ARG)" t nil) + +(autoload 'tpu-set-scroll-margins "tpu-extras" "\ +Set scroll margins. + +\(fn TOP BOTTOM)" t nil) + +(autoload 'tpu-set-cursor-free "tpu-extras" "\ +Allow the cursor to move freely about the screen. + +\(fn)" t nil) + +(autoload 'tpu-set-cursor-bound "tpu-extras" "\ +Constrain the cursor to the flow of the text. + +\(fn)" t nil) + +;;;*** + +(provide 'tpu-edt) + +;;; tpu-edt.el ends here diff --git a/lisp/obsolete/tpu-extras.el b/lisp/obsolete/tpu-extras.el new file mode 100644 index 00000000000..32257e840ac --- /dev/null +++ b/lisp/obsolete/tpu-extras.el @@ -0,0 +1,446 @@ +;;; tpu-extras.el --- scroll margins and free cursor mode for TPU-edt + +;; Copyright (C) 1993-1995, 2000-2014 Free Software Foundation, Inc. + +;; Author: Rob Riepel +;; Maintainer: Rob Riepel +;; 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 . + +;;; Commentary: + +;; Use the functions defined here to customize TPU-edt to your tastes by +;; setting scroll margins and/or turning on free cursor mode. Here's an +;; example for your init file. + +;; (tpu-set-cursor-free) ; Set cursor free. +;; (tpu-set-scroll-margins "10%" "15%") ; Set scroll margins. + +;; Scroll margins and cursor binding can be changed from within emacs using +;; the following commands: + +;; tpu-set-scroll-margins or set scroll margins +;; tpu-set-cursor-bound or set cursor bound +;; tpu-set-cursor-free or set cursor free + +;; Additionally, Gold-F toggles between bound and free cursor modes. + +;; Note that switching out of free cursor mode or exiting TPU-edt while in +;; free cursor mode strips trailing whitespace from every line in the file. + + +;;; Details: + +;; The functions contained in this file implement scroll margins and free +;; cursor mode. The following keys and commands are affected. + +;; key/command function scroll cursor + +;; Up-Arrow previous line x x +;; Down-Arrow next line x x +;; Right-Arrow next character x +;; Left-Arrow previous character x +;; KP0 next or previous line x +;; KP7 next or previous page x +;; KP8 next or previous screen x +;; KP2 next or previous end-of-line x x +;; Control-e current end-of-line x +;; Control-h previous beginning-of-line x +;; Next Scr next screen x +;; Prev Scr previous screen x +;; Search find a string x +;; Replace find and replace a string x +;; Newline insert a newline x +;; Paragraph next or previous paragraph x +;; Auto-Fill break lines on spaces x + +;; These functions are not part of the base TPU-edt for the following +;; reasons: + +;; Free cursor mode is implemented with the emacs picture-mode functions. +;; These functions support moving the cursor all over the screen, however, +;; when the cursor is moved past the end of a line, spaces or tabs are +;; appended to the line - even if no text is entered in that area. In +;; order for a free cursor mode to work exactly like TPU/edt, this trailing +;; whitespace needs to be dealt with in every function that might encounter +;; it. Such global changes are impractical, however, free cursor mode is +;; too valuable to abandon completely, so it has been implemented in those +;; functions where it serves best. + +;; The implementation of scroll margins adds overhead to previously +;; simple and often used commands. These commands are now responsible +;; for their normal operation and part of the display function. There +;; is a possibility that this display overhead could adversely affect the +;; performance of TPU-edt on slower computers. In order to support the +;; widest range of computers, scroll margin support is optional. + +;; It's actually not known whether the overhead associated with scroll +;; margin support is significant. If you find that it is, please send +;; a note describing the extent of the performance degradation. Be sure +;; to include a description of the platform where you're running TPU-edt. +;; Send your note to the address provided by Gold-V. + +;; Even with these differences and limitations, these functions implement +;; important aspects of the real TPU/edt. Those who miss free cursor mode +;; and/or scroll margins will appreciate these implementations. + +;;; Code: + + +;;; Gotta have tpu-edt + +(require 'tpu-edt) + + +;;; Customization variables + +(defcustom tpu-top-scroll-margin 0 + "Scroll margin at the top of the screen. +Interpreted as a percent of the current window size." + :type 'integer + :group 'tpu) +(defcustom tpu-bottom-scroll-margin 0 + "Scroll margin at the bottom of the screen. +Interpreted as a percent of the current window size." + :type 'integer + :group 'tpu) + +(defcustom tpu-backward-char-like-tpu t + "If non-nil, in free cursor mode backward-char (left-arrow) works +just like TPU/edt. Otherwise, backward-char will move to the end of +the previous line when starting from a line beginning." + :type 'boolean + :group 'tpu) + + +;;; Global variables + +;;;###autoload +(define-minor-mode tpu-cursor-free-mode + "Minor mode to allow the cursor to move freely about the screen. +With a prefix argument ARG, enable the mode if ARG is positive, +and disable it otherwise. If called from Lisp, enable the mode +if ARG is omitted or nil." + :init-value nil + (if (not tpu-cursor-free-mode) + (tpu-trim-line-ends)) + (if (not tpu-cursor-free-mode) + (message "The cursor is now bound to the flow of your text.") + (message "The cursor will now move freely about the screen."))) + + +;;; Hooks -- Set cursor free in picture mode. +;;; Clean up when writing a file from cursor free mode. + +(add-hook 'picture-mode-hook 'tpu-set-cursor-free) + +(defun tpu-trim-line-ends-if-needed () + "Eliminate whitespace at ends of lines, if the cursor is free." + (if (and (buffer-modified-p) tpu-cursor-free-mode) (tpu-trim-line-ends))) +(add-hook 'before-save-hook 'tpu-trim-line-ends-if-needed) + + +;;; Utility routines for implementing scroll margins + +(defun tpu-top-check (beg lines) + "Enforce scroll margin at the top of screen." + (let ((margin (/ (* (window-height) tpu-top-scroll-margin) 100))) + (cond ((< beg margin) (recenter beg)) + ((< (- beg lines) margin) (recenter margin))))) + +(defun tpu-bottom-check (beg lines) + "Enforce scroll margin at the bottom of screen." + (let* ((height (window-height)) + (margin (+ 1 (/ (* height tpu-bottom-scroll-margin) 100))) + ;; subtract 1 from height because it includes mode line + (difference (- height margin 1))) + (cond ((> beg difference) (recenter beg)) + ((> (+ beg lines) difference) (recenter (- margin)))))) + + +;;; Movement by character + +(defun tpu-forward-char (num) + "Move right ARG characters (left if ARG is negative)." + (interactive "p") + (if tpu-cursor-free-mode (picture-forward-column num) (forward-char num))) + +(defun tpu-backward-char (num) + "Move left ARG characters (right if ARG is negative)." + (interactive "p") + (cond ((not tpu-cursor-free-mode) + (backward-char num)) + (tpu-backward-char-like-tpu + (picture-backward-column num)) + ((bolp) + (backward-char 1) + (picture-end-of-line) + (picture-backward-column (1- num))) + (t + (picture-backward-column num)))) + + +;;; Movement by line + +(defun tpu-next-line (num) + "Move to next line. +Prefix argument serves as a repeat count." + (interactive "p") + (let ((beg (tpu-current-line))) + (if tpu-cursor-free-mode (or (eobp) (picture-move-down num)) + (line-move num)) + (tpu-bottom-check beg num) + (setq this-command 'next-line))) + +(defun tpu-previous-line (num) + "Move to previous line. +Prefix argument serves as a repeat count." + (interactive "p") + (let ((beg (tpu-current-line))) + (if tpu-cursor-free-mode (picture-move-up num) (line-move (- num))) + (tpu-top-check beg num) + (setq this-command 'previous-line))) + +(defun tpu-next-beginning-of-line (num) + "Move to beginning of line; if at beginning, move to beginning of next line. +Accepts a prefix argument for the number of lines to move." + (interactive "p") + (let ((beg (tpu-current-line))) + (backward-char 1) + (forward-visible-line (- 1 num)) + (tpu-top-check beg num))) + +(defun tpu-next-end-of-line (num) + "Move to end of line; if at end, move to end of next line. +Accepts a prefix argument for the number of lines to move." + (interactive "p") + (let ((beg (tpu-current-line))) + (cond (tpu-cursor-free-mode + (let ((beg (point))) + (if (< 1 num) (forward-line num)) + (picture-end-of-line) + (if (<= (point) beg) (progn (forward-line) (picture-end-of-line))))) + (t + (forward-char) + (end-of-line num))) + (tpu-bottom-check beg num))) + +(defun tpu-previous-end-of-line (num) + "Move EOL upward. +Accepts a prefix argument for the number of lines to move." + (interactive "p") + (let ((beg (tpu-current-line))) + (cond (tpu-cursor-free-mode + (picture-end-of-line (- 1 num))) + (t + (end-of-line (- 1 num)))) + (tpu-top-check beg num))) + +(defun tpu-current-end-of-line () + "Move point to end of current line." + (interactive) + (let ((beg (point))) + (if tpu-cursor-free-mode (picture-end-of-line) (end-of-line)) + (if (= beg (point)) (message "You are already at the end of a line.")))) + +(defun tpu-forward-line (num) + "Move to beginning of next line. +Prefix argument serves as a repeat count." + (interactive "p") + (let ((beg (tpu-current-line))) + (forward-line num) + (tpu-bottom-check beg num))) + +(defun tpu-backward-line (num) + "Move to beginning of previous line. +Prefix argument serves as repeat count." + (interactive "p") + (let ((beg (tpu-current-line))) + (or (bolp) (>= 0 num) (setq num (- num 1))) + (forward-line (- num)) + (tpu-top-check beg num))) + + +;;; Movement by paragraph + +;; Cf edt-with-position. +(defmacro tpu-with-position (&rest body) + "Execute BODY with some position-related variables bound." + `(let* ((left nil) + (beg (tpu-current-line)) + (height (window-height)) + (top-percent + (if (zerop tpu-top-scroll-margin) 10 tpu-top-scroll-margin)) + (bottom-percent + (if (zerop tpu-bottom-scroll-margin) 15 tpu-bottom-scroll-margin)) + (top-margin (/ (* height top-percent) 100)) + (bottom-up-margin (1+ (/ (* height bottom-percent) 100))) + (bottom-margin (max beg (- height bottom-up-margin 1))) + (top (save-excursion (move-to-window-line top-margin) (point))) + (bottom (save-excursion (move-to-window-line bottom-margin) (point))) + (far (save-excursion + (goto-char bottom) + (point-at-bol (1- height))))) + ,@body)) + +(defun tpu-paragraph (num) + "Move to the next paragraph in the current direction. +A repeat count means move that many paragraphs." + (interactive "p") + (tpu-with-position + (if tpu-advance + (progn + (tpu-next-paragraph num) + (if (> (point) far) + (if (zerop (setq left (save-excursion (forward-line height)))) + (recenter top-margin) + (recenter (- left bottom-up-margin))) + (and (> (point) bottom) (recenter bottom-margin)))) + (tpu-previous-paragraph num) + (and (< (point) top) (recenter (min beg top-margin)))))) + +;;; Movement by page + +(defun tpu-page (num) + "Move to the next page in the current direction. +A repeat count means move that many pages." + (interactive "p") + (tpu-with-position + (if tpu-advance + (progn + (forward-page num) + (if (> (point) far) + (if (zerop (setq left (save-excursion (forward-line height)))) + (recenter top-margin) + (recenter (- left bottom-up-margin))) + (and (> (point) bottom) (recenter bottom-margin)))) + (backward-page num) + (and (< (point) top) (recenter (min beg top-margin)))))) + +;;; Scrolling + +(defun tpu-scroll-window-down (num) + "Scroll the display down to the next section. +A repeat count means scroll that many sections." + (interactive "p") + (let* ((beg (tpu-current-line)) + (height (1- (window-height))) + (lines (* num (/ (* height tpu-percent-scroll) 100)))) + (line-move (- lines)) + (tpu-top-check beg lines))) + +(defun tpu-scroll-window-up (num) + "Scroll the display up to the next section. +A repeat count means scroll that many sections." + (interactive "p") + (let* ((beg (tpu-current-line)) + (height (1- (window-height))) + (lines (* num (/ (* height tpu-percent-scroll) 100)))) + (line-move lines) + (tpu-bottom-check beg lines))) + + +;;; Replace the TPU-edt internal search function + +(defun tpu-search-internal (pat &optional quiet) + "Search for a string or regular expression." + (tpu-with-position + (tpu-search-internal-core pat quiet) + (if tpu-searching-forward + (progn + (if (> (point) far) + (if (zerop (setq left (save-excursion (forward-line height)))) + (recenter top-margin) + (recenter (- left bottom-up-margin))) + (and (> (point) bottom) (recenter bottom-margin)))) + (and (< (point) top) (recenter (min beg top-margin)))))) + +;; Advise the newline, newline-and-indent, and do-auto-fill functions. +(defadvice newline (around tpu-respect-bottom-scroll-margin activate disable) + "Respect `tpu-bottom-scroll-margin'." + (let ((beg (tpu-current-line)) + (num (prefix-numeric-value (ad-get-arg 0)))) + ad-do-it + (tpu-bottom-check beg num))) + +(defadvice newline-and-indent (around tpu-respect-bottom-scroll-margin) + "Respect `tpu-bottom-scroll-margin'." + (let ((beg (tpu-current-line))) + ad-do-it + (tpu-bottom-check beg 1))) + +(defadvice do-auto-fill (around tpu-respect-bottom-scroll-margin) + "Respect `tpu-bottom-scroll-margin'." + (let ((beg (tpu-current-line))) + ad-do-it + (tpu-bottom-check beg 1))) + + +;;; Function to set scroll margins + +;;;###autoload +(defun tpu-set-scroll-margins (top bottom) + "Set scroll margins." + (interactive + "sEnter top scroll margin (N lines or N%% or RETURN for current value): \ +\nsEnter bottom scroll margin (N lines or N%% or RETURN for current value): ") + ;; set top scroll margin + (or (string= top "") + (setq tpu-top-scroll-margin + (if (string= "%" (substring top -1)) + (string-to-number top) + (/ (1- (+ (* (string-to-number top) 100) (window-height))) + (window-height))))) + ;; set bottom scroll margin + (or (string= bottom "") + (setq tpu-bottom-scroll-margin + (if (string= "%" (substring bottom -1)) + (string-to-number bottom) + (/ (1- (+ (* (string-to-number bottom) 100) (window-height))) + (window-height))))) + (dolist (f '(newline newline-and-indent do-auto-fill)) + (ad-enable-advice f 'around 'tpu-respect-bottom-scroll-margin) + (ad-activate f)) + ;; report scroll margin settings if running interactively + (and (called-interactively-p 'interactive) + (message "Scroll margins set. Top = %s%%, Bottom = %s%%" + tpu-top-scroll-margin tpu-bottom-scroll-margin))) + + +;;; Functions to set cursor bound or free + +;;;###autoload +(defun tpu-set-cursor-free () + "Allow the cursor to move freely about the screen." + (interactive) + (tpu-cursor-free-mode 1)) + +;;;###autoload +(defun tpu-set-cursor-bound () + "Constrain the cursor to the flow of the text." + (interactive) + (tpu-cursor-free-mode -1)) + +(provide 'tpu-extras) + +;; Local Variables: +;; generated-autoload-file: "tpu-edt.el" +;; End: + +;;; tpu-extras.el ends here diff --git a/lisp/obsolete/tpu-mapper.el b/lisp/obsolete/tpu-mapper.el new file mode 100644 index 00000000000..d653685218b --- /dev/null +++ b/lisp/obsolete/tpu-mapper.el @@ -0,0 +1,353 @@ +;;; tpu-mapper.el --- create a TPU-edt X-windows keymap file + +;; Copyright (C) 1993-1995, 2001-2014 Free Software Foundation, Inc. + +;; Author: Rob Riepel +;; Maintainer: Rob Riepel +;; 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 . + +;;; 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 for future reference + + (cond + ((featurep 'xemacs) + (setq tpu-return-seq (read-key-sequence "Hit carriage-return to continue ")) + (setq tpu-return (concat "[" (format "%s" (event-key (aref tpu-return-seq 0))) "]"))) + (t + (message "Hit carriage-return 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 \"[#]\")\n") + (insert "(setq tpu-help-n \"[#]\")\n") + (insert "(setq tpu-help-P \"[#]\")\n") + (insert "(setq tpu-help-p \"[#]\")\n")) + (t + (insert (format "(setq tpu-help-enter \"%s\")\n" tpu-enter)))) + + (append-to-buffer "Keys" 1 (point)) + (set-buffer "Keys") + + ;; Save the key mapping program + + (let ((file + (convert-standard-filename + (if (featurep 'xemacs) "~/.tpu-lucid-keys" "~/.tpu-keys")))) + (set-visited-file-name + (read-file-name (format "Save key mapping to file (default %s): " file) "" file))) + (save-buffer) + + ;; Load the newly defined keys and clean up + + (require 'tpu-edt) + (eval-buffer) + (kill-buffer (current-buffer)) + (kill-buffer "*scratch*") + (kill-buffer "Gold-Keys") + + ;; Let them know it worked. + + (switch-to-buffer "Directions") + (erase-buffer) + (insert " + A custom TPU-edt keymap file has been created. + + Press GOLD-k to remove this buffer and continue editing. +") + (goto-char (point-min))) + +;;; tpu-mapper.el ends here diff --git a/lisp/obsolete/vi.el b/lisp/obsolete/vi.el new file mode 100644 index 00000000000..bb57735b0a9 --- /dev/null +++ b/lisp/obsolete/vi.el @@ -0,0 +1,1495 @@ +;;; vi.el --- major mode for emulating "vi" editor under GNU Emacs + +;; This file is in the public domain because the authors distributed it +;; without a copyright notice before the US signed the Bern Convention. + +;; This file is part of GNU Emacs. + +;; Author: Neal Ziring +;; Felix S. T. Wu +;; Keywords: emulations +;; Obsolete-since: 24.5 + +;;; Commentary: + +;; This file is obsolete. Consider using viper instead. + +;; Originally written by : seismo!wucs!nz@rsch.wisc.edu (Neal Ziring) +;; Extensively redesigned and rewritten by wu@crys.wisc.edu (Felix S.T. Wu) +;; Last revision: 01/07/87 Wed (for GNU Emacs 18.33) + +;; INSTALLATION PROCEDURE: +;; 1) Add a global key binding for command "vi-mode" (I use ESC ESC instead of +;; the single ESC used in real "vi", so I can access other ESC prefixed emacs +;; commands while I'm in "vi"), say, by putting the following line in your +;; ".emacs" file: +;; (define-key global-map "\e\e" 'vi-mode) ;quick switch into vi-mode +;; 2) If you wish you can define "find-file-hook" to enter "vi" automatically +;; after a file is loaded into the buffer. For example, I defined it as: +;; (setq find-file-hook (list +;; (function (lambda () +;; (if (not (or (eq major-mode 'Info-mode) +;; (eq major-mode 'vi-mode))) +;; (vi-mode)))))) +;; 3) In your init file you can define the command "vi-mode" to be "autoload" +;; or you can execute the "load" command to load "vi" directly. +;; 4) Read the comments for command "vi-mode" before you start using it. + +;; COULD DO +;; 1). A general 'define-operator' function to replace current hack +;; 2). In operator handling, should allow other point moving Emacs commands +;; (such as ESC <, ESC >) to be used as arguments. + +;;; Code: + +(defvar vi-mode-old-major-mode) +(defvar vi-mode-old-mode-name) +(defvar vi-mode-old-local-map) +(defvar vi-mode-old-case-fold) + +(if (null (where-is-internal 'vi-switch-mode (current-local-map))) + (define-key ctl-x-map "~" 'vi-switch-mode)) + +(defvar vi-tilde-map nil + "Keymap used for \\[vi-switch-mode] prefix key. Link to various major modes.") + +(if vi-tilde-map + nil + (setq vi-tilde-map (make-keymap)) + (define-key vi-tilde-map "a" 'abbrev-mode) + (define-key vi-tilde-map "c" 'c-mode) + (define-key vi-tilde-map "d" 'vi-debugging) + (define-key vi-tilde-map "e" 'emacs-lisp-mode) + (define-key vi-tilde-map "f" 'auto-fill-mode) + (define-key vi-tilde-map "g" 'prolog-mode) + (define-key vi-tilde-map "h" 'hanoi) + (define-key vi-tilde-map "i" 'info-mode) + (define-key vi-tilde-map "l" 'lisp-mode) + (define-key vi-tilde-map "n" 'nroff-mode) + (define-key vi-tilde-map "o" 'overwrite-mode) + (define-key vi-tilde-map "O" 'outline-mode) + (define-key vi-tilde-map "P" 'picture-mode) + (define-key vi-tilde-map "r" 'vi-readonly-mode) + (define-key vi-tilde-map "t" 'text-mode) + (define-key vi-tilde-map "v" 'vi-mode) + (define-key vi-tilde-map "x" 'tex-mode) + (define-key vi-tilde-map "~" 'vi-back-to-old-mode)) + +(defun vi-switch-mode (arg mode-char) + "Switch the major mode of current buffer as specified by the following char \\{vi-tilde-map}" + (interactive "P\nc") + (let ((mode-cmd (lookup-key vi-tilde-map (char-to-string mode-char)))) + (if (null mode-cmd) + (with-output-to-temp-buffer "*Help*" + (princ (substitute-command-keys "Possible major modes to switch to: \\{vi-tilde-map}")) + (with-current-buffer standard-output + (help-mode))) + (setq prefix-arg arg) ; prefix arg will be passed down + (command-execute mode-cmd nil) ; may need to save mode-line-format etc + (force-mode-line-update)))) ; just in case + + +(defun vi-debugging (arg) + "Toggle debug-on-error flag. If prefix arg is given, set t." + (interactive "P") + (if arg + (setq debug-on-error t) + (setq debug-on-error (not debug-on-error))) + (if debug-on-error + (message "Debug-on-error ...") + (message "NO more debug-on-error"))) + +(defun vi-back-to-old-mode () + "Go back to the previous mode without setting up for insertion." + (interactive) + (if vi-mode-old-major-mode + (progn + (setq mode-name vi-mode-old-mode-name) + (use-local-map vi-mode-old-local-map) + (setq major-mode vi-mode-old-major-mode) + (setq case-fold-search vi-mode-old-case-fold) + (force-mode-line-update)))) + +(defun vi-readonly-mode () + "Toggle current buffer's readonly flag." + (interactive) + (setq buffer-read-only (not buffer-read-only))) + +(defvar vi-com-map nil + "Keymap used in Evi's command state +Command state includes most of the vi editing commands, with some Emacs +command extensions.") + +(put 'vi-undefined 'suppress-keymap t) +(if vi-com-map nil + (setq vi-com-map (make-keymap)) +;;(fillarray vi-com-map 'vi-undefined) + (define-key vi-com-map "\C-@" 'vi-mark-region) ; extension + (define-key vi-com-map "\C-a" 'vi-ask-for-info) ; extension + (define-key vi-com-map "\C-b" 'vi-backward-windowful) + (define-key vi-com-map "\C-c" 'vi-do-old-mode-C-c-command) ; extension + (define-key vi-com-map "\C-d" 'vi-scroll-down-window) + (define-key vi-com-map "\C-e" 'vi-expose-line-below) + (define-key vi-com-map "\C-f" 'vi-forward-windowful) + (define-key vi-com-map "\C-g" 'keyboard-quit) + (define-key vi-com-map "\C-i" 'indent-relative-maybe) ; TAB + (define-key vi-com-map "\C-j" 'vi-next-line) ; LFD + (define-key vi-com-map "\C-k" 'vi-kill-line) ; extension + (define-key vi-com-map "\C-l" 'recenter) + (define-key vi-com-map "\C-m" 'vi-next-line-first-nonwhite) ; RET + (define-key vi-com-map "\C-n" 'vi-next-line) + (define-key vi-com-map "\C-o" 'vi-split-open-line) + (define-key vi-com-map "\C-p" 'previous-line) + (define-key vi-com-map "\C-q" 'vi-query-replace) ; extension + (define-key vi-com-map "\C-r" 'vi-isearch-backward) ; modification + (define-key vi-com-map "\C-s" 'vi-isearch-forward) ; extension + (define-key vi-com-map "\C-t" 'vi-transpose-objects) ; extension + (define-key vi-com-map "\C-u" 'vi-scroll-up-window) + (define-key vi-com-map "\C-v" 'scroll-up-command) ; extension + (define-key vi-com-map "\C-w" 'vi-kill-region) ; extension + (define-key vi-com-map "\C-x" 'Control-X-prefix) ; extension + (define-key vi-com-map "\C-y" 'vi-expose-line-above) + (define-key vi-com-map "\C-z" 'suspend-emacs) + + (define-key vi-com-map "\e" 'ESC-prefix); C-[ (ESC) + (define-key vi-com-map "\C-\\" 'vi-unimplemented) + (define-key vi-com-map "\C-]" 'find-tag) + (define-key vi-com-map "\C-^" 'vi-locate-def) ; extension + (define-key vi-com-map "\C-_" 'vi-undefined) + + (define-key vi-com-map " " 'forward-char) + (define-key vi-com-map "!" 'vi-operator) + (define-key vi-com-map "\"" 'vi-char-argument) + (define-key vi-com-map "#" 'universal-argument) ; extension + (define-key vi-com-map "$" 'end-of-line) + (define-key vi-com-map "%" 'vi-find-matching-paren) + (define-key vi-com-map "&" 'vi-unimplemented) + (define-key vi-com-map "'" 'vi-goto-line-mark) + (define-key vi-com-map "(" 'backward-sexp) + (define-key vi-com-map ")" 'forward-sexp) + (define-key vi-com-map "*" 'vi-name-last-change-or-macro) ; extension + (define-key vi-com-map "+" 'vi-next-line-first-nonwhite) + (define-key vi-com-map "," 'vi-reverse-last-find-char) + (define-key vi-com-map "-" 'vi-previous-line-first-nonwhite) + (define-key vi-com-map "." 'vi-redo-last-change-command) + (define-key vi-com-map "/" 'vi-search-forward) + (define-key vi-com-map "0" 'beginning-of-line) + + (define-key vi-com-map "1" 'vi-digit-argument) + (define-key vi-com-map "2" 'vi-digit-argument) + (define-key vi-com-map "3" 'vi-digit-argument) + (define-key vi-com-map "4" 'vi-digit-argument) + (define-key vi-com-map "5" 'vi-digit-argument) + (define-key vi-com-map "6" 'vi-digit-argument) + (define-key vi-com-map "7" 'vi-digit-argument) + (define-key vi-com-map "8" 'vi-digit-argument) + (define-key vi-com-map "9" 'vi-digit-argument) + + (define-key vi-com-map ":" 'vi-ex-cmd) + (define-key vi-com-map ";" 'vi-repeat-last-find-char) + (define-key vi-com-map "<" 'vi-operator) + (define-key vi-com-map "=" 'vi-operator) + (define-key vi-com-map ">" 'vi-operator) + (define-key vi-com-map "?" 'vi-search-backward) + (define-key vi-com-map "@" 'vi-call-named-change-or-macro) ; extension + + (define-key vi-com-map "A" 'vi-append-at-end-of-line) + (define-key vi-com-map "B" 'vi-backward-blank-delimited-word) + (define-key vi-com-map "C" 'vi-change-rest-of-line) + (define-key vi-com-map "D" 'vi-kill-line) + (define-key vi-com-map "E" 'vi-end-of-blank-delimited-word) + (define-key vi-com-map "F" 'vi-backward-find-char) + (define-key vi-com-map "G" 'vi-goto-line) + (define-key vi-com-map "H" 'vi-home-window-line) + (define-key vi-com-map "I" 'vi-insert-before-first-nonwhite) + (define-key vi-com-map "J" 'vi-join-lines) + (define-key vi-com-map "K" 'vi-undefined) + (define-key vi-com-map "L" 'vi-last-window-line) + (define-key vi-com-map "M" 'vi-middle-window-line) + (define-key vi-com-map "N" 'vi-reverse-last-search) + (define-key vi-com-map "O" 'vi-open-above) + (define-key vi-com-map "P" 'vi-put-before) + (define-key vi-com-map "Q" 'vi-quote-words) ; extension + (define-key vi-com-map "R" 'vi-replace-chars) + (define-key vi-com-map "S" 'vi-substitute-lines) + (define-key vi-com-map "T" 'vi-backward-upto-char) + (define-key vi-com-map "U" 'vi-unimplemented) + (define-key vi-com-map "V" 'vi-undefined) + (define-key vi-com-map "W" 'vi-forward-blank-delimited-word) + (define-key vi-com-map "X" 'call-last-kbd-macro) ; modification/extension + (define-key vi-com-map "Y" 'vi-yank-line) + (define-key vi-com-map "Z" (make-sparse-keymap)) ;allow below prefix command + (define-key vi-com-map "ZZ" 'vi-save-all-and-exit) + + (define-key vi-com-map "[" 'vi-unimplemented) + (define-key vi-com-map "\\" 'vi-operator) ; extension for vi-narrow-op + (define-key vi-com-map "]" 'vi-unimplemented) + (define-key vi-com-map "^" 'back-to-indentation) + (define-key vi-com-map "_" 'vi-undefined) + (define-key vi-com-map "`" 'vi-goto-char-mark) + + (define-key vi-com-map "a" 'vi-insert-after) + (define-key vi-com-map "b" 'backward-word) + (define-key vi-com-map "c" 'vi-operator) + (define-key vi-com-map "d" 'vi-operator) + (define-key vi-com-map "e" 'vi-end-of-word) + (define-key vi-com-map "f" 'vi-forward-find-char) + (define-key vi-com-map "g" 'vi-beginning-of-buffer) ; extension + (define-key vi-com-map "h" 'backward-char) + (define-key vi-com-map "i" 'vi-insert-before) + (define-key vi-com-map "j" 'vi-next-line) + (define-key vi-com-map "k" 'previous-line) + (define-key vi-com-map "l" 'forward-char) + (define-key vi-com-map "m" 'vi-set-mark) + (define-key vi-com-map "n" 'vi-repeat-last-search) + (define-key vi-com-map "o" 'vi-open-below) + (define-key vi-com-map "p" 'vi-put-after) + (define-key vi-com-map "q" 'vi-replace) + (define-key vi-com-map "r" 'vi-replace-1-char) + (define-key vi-com-map "s" 'vi-substitute-chars) + (define-key vi-com-map "t" 'vi-forward-upto-char) + (define-key vi-com-map "u" 'undo) + (define-key vi-com-map "v" 'vi-verify-spelling) + (define-key vi-com-map "w" 'vi-forward-word) + (define-key vi-com-map "x" 'vi-kill-char) + (define-key vi-com-map "y" 'vi-operator) + (define-key vi-com-map "z" 'vi-adjust-window) + + (define-key vi-com-map "{" 'backward-paragraph) + (define-key vi-com-map "|" 'vi-goto-column) + (define-key vi-com-map "}" 'forward-paragraph) + (define-key vi-com-map "~" 'vi-change-case) + (define-key vi-com-map "\177" 'delete-backward-char)) + +(put 'backward-char 'point-moving-unit 'char) +(put 'vi-next-line 'point-moving-unit 'line) +(put 'next-line 'point-moving-unit 'line) +(put 'forward-line 'point-moving-unit 'line) +(put 'previous-line 'point-moving-unit 'line) +(put 'vi-isearch-backward 'point-moving-unit 'search) +(put 'vi-search-backward 'point-moving-unit 'search) +(put 'vi-isearch-forward 'point-moving-unit 'search) +(put 'vi-search-forward 'point-moving-unit 'search) +(put 'forward-char 'point-moving-unit 'char) +(put 'end-of-line 'point-moving-unit 'char) +(put 'vi-find-matching-paren 'point-moving-unit 'match) +(put 'vi-goto-line-mark 'point-moving-unit 'line) +(put 'backward-sexp 'point-moving-unit 'sexp) +(put 'forward-sexp 'point-moving-unit 'sexp) +(put 'vi-next-line-first-nonwhite 'point-moving-unit 'line) +(put 'vi-previous-line-first-nonwhite 'point-moving-unit 'line) +(put 'vi-reverse-last-find-char 'point-moving-unit 'rev-find) +(put 'vi-re-search-forward 'point-moving-unit 'search) +(put 'beginning-of-line 'point-moving-unit 'char) +(put 'vi-beginning-of-buffer 'point-moving-unit 'char) +(put 'vi-repeat-last-find-char 'point-moving-unit 'find) +(put 'vi-re-search-backward 'point-moving-unit 'search) +(put 'vi-backward-blank-delimited-word 'point-moving-unit 'WORD) +(put 'vi-end-of-blank-delimited-word 'point-moving-unit 'match) +(put 'vi-backward-find-char 'point-moving-unit 'find) +(put 'vi-goto-line 'point-moving-unit 'line) +(put 'vi-home-window-line 'point-moving-unit 'line) +(put 'vi-last-window-line 'point-moving-unit 'line) +(put 'vi-middle-window-line 'point-moving-unit 'line) +(put 'vi-reverse-last-search 'point-moving-unit 'rev-search) +(put 'vi-backward-upto-char 'point-moving-unit 'find) +(put 'vi-forward-blank-delimited-word 'point-moving-unit 'WORD) +(put 'back-to-indentation 'point-moving-unit 'char) +(put 'vi-goto-char-mark 'point-moving-unit 'char) +(put 'backward-word 'point-moving-unit 'word) +(put 'vi-end-of-word 'point-moving-unit 'match) +(put 'vi-forward-find-char 'point-moving-unit 'find) +(put 'backward-char 'point-moving-unit 'char) +(put 'vi-forward-char 'point-moving-unit 'char) +(put 'vi-repeat-last-search 'point-moving-unit 'search) +(put 'vi-forward-upto-char 'point-moving-unit 'find) +(put 'vi-forward-word 'point-moving-unit 'word) +(put 'vi-goto-column 'point-moving-unit 'match) +(put 'forward-paragraph 'point-moving-unit 'paragraph) +(put 'backward-paragraph 'point-moving-unit 'paragraph) + +;;; region mark commands +(put 'mark-page 'point-moving-unit 'region) +(put 'mark-paragraph 'point-moving-unit 'region) +(put 'mark-word 'point-moving-unit 'region) +(put 'mark-sexp 'point-moving-unit 'region) +(put 'mark-defun 'point-moving-unit 'region) +(put 'mark-whole-buffer 'point-moving-unit 'region) +(put 'mark-end-of-sentence 'point-moving-unit 'region) +(put 'c-mark-function 'point-moving-unit 'region) +;;; + +(defvar vi-mark-alist nil + "Alist of (NAME . MARK), marks are local to each buffer.") + +(defvar vi-scroll-amount (/ (window-height) 2) + "Default amount of lines for scrolling (used by \"^D\"/\"^U\").") + +(defvar vi-shift-width 4 + "Shift amount for \"<\"/\">\" operators.") + +(defvar vi-ins-point nil ; integer + "Last insertion point. Should use `mark' instead.") + +(defvar vi-ins-length nil ; integer + "Length of last insertion.") + +(defvar vi-ins-repetition nil ; integer + "The repetition required for last insertion.") + +(defvar vi-ins-overwrt-p nil ; boolean + "T if last insertion was a replace actually.") + +(defvar vi-ins-prefix-code nil ; ready-to-eval sexp + "Code to be eval'ed before (redo-)insertion begins.") + +(defvar vi-last-find-char nil ; cons cell + "Save last direction, char and upto-flag used for char finding.") + +(defvar vi-last-change-command nil ; cons cell + "Save commands for redoing last changes. Each command is in (FUNC . ARGS) +form that is ready to be `apply'ed.") + +(defvar vi-last-shell-command nil ; last shell op command line + "Save last shell command given for \"!\" operator.") + +(defvar vi-insert-state nil ; boolean + "Non-nil if it is in insert state.") + +; in "loaddefs.el" +;(defvar search-last-string "" +; "Last string search for by a search command.") + +(defvar vi-search-last-command nil ; (re-)search-forward(backward) + "Save last search command for possible redo.") + +(defvar vi-mode-old-local-map nil + "Save the local-map used before entering vi-mode.") + +(defvar vi-mode-old-mode-name nil + "Save the mode-name before entering vi-mode.") + +(defvar vi-mode-old-major-mode nil + "Save the major-mode before entering vi-mode.") + +(defvar vi-mode-old-case-fold nil) + +;(defconst vi-add-to-mode-line-1 +; '(overwrite-mode nil " Insert")) + +;; Value is same as vi-add-to-mode-line-1 when in vi mode, +;; but nil in other buffers. +;(defvar vi-add-to-mode-line nil) + +(defun vi-mode-setup () + "Setup a buffer for vi-mode by creating necessary buffer-local variables." +; (make-local-variable 'vi-add-to-mode-line) +; (setq vi-add-to-mode-line vi-add-to-mode-line-1) +; (or (memq vi-add-to-mode-line minor-mode-alist) +; (setq minor-mode-alist (cons vi-add-to-mode-line minor-mode-alist))) + (make-local-variable 'vi-scroll-amount) + (setq vi-scroll-amount (/ (window-height) 2)) + (make-local-variable 'vi-shift-width) + (setq vi-shift-width 4) + (make-local-variable 'vi-ins-point) + (make-local-variable 'vi-ins-length) + (make-local-variable 'vi-ins-repetition) + (make-local-variable 'vi-ins-overwrt-p) + (make-local-variable 'vi-ins-prefix-code) + (make-local-variable 'vi-last-change-command) + (make-local-variable 'vi-last-shell-command) + (make-local-variable 'vi-last-find-char) + (make-local-variable 'vi-mark-alist) + (make-local-variable 'vi-insert-state) + (make-local-variable 'vi-mode-old-local-map) + (make-local-variable 'vi-mode-old-mode-name) + (make-local-variable 'vi-mode-old-major-mode) + (make-local-variable 'vi-mode-old-case-fold) + (run-mode-hooks 'vi-mode-hook)) + +;;;###autoload +(defun vi-mode () + "Major mode that acts like the `vi' editor. +The purpose of this mode is to provide you the combined power of vi (namely, +the \"cross product\" effect of commands and repeat last changes) and Emacs. + +This command redefines nearly all keys to look like vi commands. +It records the previous major mode, and any vi command for input +\(`i', `a', `s', etc.) switches back to that mode. +Thus, ordinary Emacs (in whatever major mode you had been using) +is \"input\" mode as far as vi is concerned. + +To get back into vi from \"input\" mode, you must issue this command again. +Therefore, it is recommended that you assign it to a key. + +Major differences between this mode and real vi : + +* Limitations and unsupported features + - Search patterns with line offset (e.g. /pat/+3 or /pat/z.) are + not supported. + - Ex commands are not implemented; try ':' to get some hints. + - No line undo (i.e. the 'U' command), but multi-undo is a standard feature. + +* Modifications + - The stopping positions for some point motion commands (word boundary, + pattern search) are slightly different from standard 'vi'. + Also, no automatic wrap around at end of buffer for pattern searching. + - Since changes are done in two steps (deletion then insertion), you need + to undo twice to completely undo a change command. But this is not needed + for undoing a repeated change command. + - No need to set/unset 'magic', to search for a string with regular expr + in it just put a prefix arg for the search commands. Replace cmds too. + - ^R is bound to incremental backward search, so use ^L to redraw screen. + +* Extensions + - Some standard (or modified) Emacs commands were integrated, such as + incremental search, query replace, transpose objects, and keyboard macros. + - In command state, ^X links to the 'ctl-x-map', and ESC can be linked to + esc-map or set undefined. These can give you the full power of Emacs. + - See vi-com-map for those keys that are extensions to standard vi, e.g. + `vi-name-last-change-or-macro', `vi-verify-spelling', `vi-locate-def', + `vi-mark-region', and 'vi-quote-words'. Some of them are quite handy. + - Use \\[vi-switch-mode] to switch among different modes quickly. + +Syntax table and abbrevs while in vi mode remain as they were in Emacs." + (interactive) + (if (null vi-mode-old-major-mode) ; very first call for current buffer + (vi-mode-setup)) + + (if (eq major-mode 'vi-mode) + (progn (ding) (message "Already in vi-mode.")) + (setq vi-mode-old-local-map (current-local-map)) + (setq vi-mode-old-mode-name mode-name) + (setq vi-mode-old-major-mode major-mode) + (setq vi-mode-old-case-fold case-fold-search) ; this is needed !! + (setq case-fold-search nil) ; exact case match in searching + (use-local-map vi-com-map) + (setq major-mode 'vi-mode) + (setq mode-name "VI") + (force-mode-line-update) ; force mode line update + (if vi-insert-state ; this is a return from insertion + (vi-end-of-insert-state)))) + +(defun vi-ding() + "Ding !" + (interactive) + (ding)) + +(defun vi-save-all-and-exit () + "Save all modified buffers without asking, then exits emacs." + (interactive) + (save-some-buffers t) + (kill-emacs)) + +;; to be used by "ex" commands +(defvar vi-replaced-string nil) +(defvar vi-replacing-string nil) + +(defun vi-ex-cmd () + "Ex commands are not implemented in Evi mode. For some commonly used ex +commands, you can use the following alternatives for similar effect : +w C-x C-s (save-buffer) +wq C-x C-c (save-buffers-kill-emacs) +w fname C-x C-w (write-file) +e fname C-x C-f (find-file) +r fname C-x i (insert-file) +s/old/new use q (vi-replace) to do unconditional replace + use C-q (vi-query-replace) to do query replace +set sw=n M-x set-variable vi-shift-width n " + (interactive) +;; (let ((cmd (read-string ":")) (lines 1)) +;; (cond ((string-match "s")))) + (with-output-to-temp-buffer "*Help*" + (princ (documentation 'vi-ex-cmd)) + (with-current-buffer standard-output + (help-mode)))) + +(defun vi-undefined () + (interactive) + (message "Command key \"%s\" is undefined in Evi." + (single-key-description last-command-event)) + (ding)) + +(defun vi-unimplemented () + (interactive) + (message "Command key \"%s\" is not implemented in Evi." + (single-key-description last-command-event)) + (ding)) + +;;;;; +(defun vi-goto-insert-state (repetition &optional prefix-code do-it-now-p) + "Go into insert state, the text entered will be repeated if REPETITION > 1. +If PREFIX-CODE is given, do it before insertion begins if DO-IT-NOW-P is T. +In any case, the prefix-code will be done before each 'redo-insert'. +This function expects `overwrite-mode' being set properly beforehand." + (if do-it-now-p (apply (car prefix-code) (cdr prefix-code))) + (setq vi-ins-point (point)) + (setq vi-ins-repetition repetition) + (setq vi-ins-prefix-code prefix-code) + (setq mode-name vi-mode-old-mode-name) + (setq case-fold-search vi-mode-old-case-fold) + (use-local-map vi-mode-old-local-map) + (setq major-mode vi-mode-old-major-mode) + (force-mode-line-update) + (setq vi-insert-state t)) + +(defun vi-end-of-insert-state () + "Terminate insertion and set up last change command." + (if (or (< (point) vi-ins-point) ;Check if there is any effective change + (and (= (point) vi-ins-point) (null vi-ins-prefix-code)) + (<= vi-ins-repetition 0)) + (vi-goto-command-state t) + (if (> vi-ins-repetition 1) + (progn + (let ((str (buffer-substring vi-ins-point (point)))) + (while (> vi-ins-repetition 1) + (insert str) + (setq vi-ins-repetition (1- vi-ins-repetition)))))) + (vi-set-last-change-command 'vi-first-redo-insertion vi-ins-point (point) + overwrite-mode vi-ins-prefix-code) + (vi-goto-command-state t))) + +(defun vi-first-redo-insertion (begin end &optional overwrite-p prefix-code) + "Redo last insertion the first time. Extract the string and save it for +future redoes. Do prefix-code if it's given, use overwrite mode if asked." + (let ((str (buffer-substring begin end))) + (if prefix-code (apply (car prefix-code) (cdr prefix-code))) + (if overwrite-p (delete-region (point) (+ (point) (length str)))) + (insert str) + (vi-set-last-change-command 'vi-more-redo-insertion str overwrite-p prefix-code))) + +(defun vi-more-redo-insertion (str &optional overwrite-p prefix-code) + "Redo more insertion : copy string from STR to point, use overwrite mode +if overwrite-p is T; apply prefix-code first if it's non-nil." + (if prefix-code (apply (car prefix-code) (cdr prefix-code))) + (if overwrite-p (delete-region (point) (+ (point) (length str)))) + (insert str)) + +(defun vi-goto-command-state (&optional from-insert-state-p) + "Go to vi-mode command state. If optional arg exists, means return from +insert state." + (use-local-map vi-com-map) + (setq vi-insert-state nil) + (if from-insert-state-p + (if overwrite-mode + (overwrite-mode 0) +; (set-minor-mode 'ins "Insert" nil) + ))) + +(defun vi-kill-line (arg) + "kill specified number of lines (=d$), text saved in the kill ring." + (interactive "*P") + (kill-line arg) + (vi-set-last-change-command 'kill-line arg)) + +(defun vi-kill-region (start end) + (interactive "*r") + (kill-region start end) + (vi-set-last-change-command 'kill-region)) + +(defun vi-append-at-end-of-line (arg) + "go to end of line and then go into vi insert state." + (interactive "*p") + (vi-goto-insert-state arg '(end-of-line) t)) + +(defun vi-change-rest-of-line (arg) + "Change the rest of (ARG) lines (= c$ in vi)." + (interactive "*P") + (vi-goto-insert-state 1 (list 'kill-line arg) t)) + +(defun vi-insert-before-first-nonwhite (arg) + "(= ^i in vi)" + (interactive "*p") + (vi-goto-insert-state arg '(back-to-indentation) t)) + +(defun vi-open-above (arg) + "open new line(s) above current line and enter insert state." + (interactive "*p") + (vi-goto-insert-state 1 + (list (function (lambda (x) + (or (beginning-of-line) + (open-line x)))) arg) + t)) + +(defun vi-open-below (arg) + "open new line(s) and go into insert mode on the last line." + (interactive "*p") + (vi-goto-insert-state 1 + (list (function (lambda (x) + (or (end-of-line) + (open-line x) + (forward-line x)))) arg) + t)) + +(defun vi-insert-after (arg) + "start vi insert state after cursor." + (interactive "*p") + (vi-goto-insert-state arg + (list (function (lambda () + (if (not (eolp)) (forward-char))))) + t)) + +(defun vi-insert-before (arg) + "enter insert state before the cursor." + (interactive "*p") + (vi-goto-insert-state arg)) + +(defun vi-goto-line (arg) + "Go to ARGth line." + (interactive "P") + (if (null (vi-raw-numeric-prefix arg)) + (with-no-warnings + (end-of-buffer)) + (with-no-warnings (goto-line (vi-prefix-numeric-value arg))))) + +(defun vi-beginning-of-buffer () + "Move point to the beginning of current buffer." + (interactive) + (goto-char (point-min))) + +;;;;; not used now +;;(defvar regexp-search t ; string +;; "*T if search string can contain regular expressions. (= set magic in vi)") +;;;;; + +(defun vi-isearch-forward (arg) + "Incremental search forward. Use regexp version if ARG is non-nil." + (interactive "P") + (let ((scmd (if arg 'isearch-forward-regexp 'isearch-forward)) + (opoint (point))) + (call-interactively scmd) + (if (= opoint (point)) + nil + (setq vi-search-last-command (if arg 're-search-forward 'search-forward))))) + +(defun vi-isearch-backward (arg) + "Incremental search backward. Use regexp version if ARG is non-nil." + (interactive "P") + (let ((scmd (if arg 'isearch-backward-regexp 'isearch-backward)) + (opoint (point))) + (call-interactively scmd) + (if (= opoint (point)) + nil + (setq vi-search-last-command (if arg 're-search-backward 'search-backward))))) + +(defun vi-search-forward (arg string) + "Nonincremental search forward. Use regexp version if ARG is non-nil." + (interactive (if current-prefix-arg + (list t (read-string "regexp/" nil)) + (list nil (read-string "/" nil)))) + (setq vi-search-last-command (if arg 're-search-forward 'search-forward)) + (if (> (length string) 0) + (isearch-update-ring string arg)) + (funcall vi-search-last-command string nil nil 1)) + +(defun vi-search-backward (arg string) + "Nonincremental search backward. Use regexp version if ARG is non-nil." + (interactive (if current-prefix-arg + (list t (read-string "regexp?" nil)) + (list nil (read-string "?" nil)))) + (setq vi-search-last-command (if arg 're-search-backward 'search-backward)) + (if (> (length string) 0) + (isearch-update-ring string arg)) + (funcall vi-search-last-command string nil nil 1)) + +(defun vi-repeat-last-search (arg &optional search-command search-string) + "Repeat last search command. +If optional search-command/string are given, +use those instead of the ones saved." + (interactive "p") + (if (null search-command) (setq search-command vi-search-last-command)) + (if (null search-string) + (setq search-string + (car (if (memq search-command + '(re-search-forward re-search-backward)) + regexp-search-ring + search-ring)))) + (if (null search-command) + (progn (ding) (message "No last search command to repeat.")) + (funcall search-command search-string nil nil arg))) + +(defun vi-reverse-last-search (arg &optional search-command search-string) + "Redo last search command in reverse direction. +If the optional search args are given, use those instead of the ones saved." + (interactive "p") + (if (null search-command) (setq search-command vi-search-last-command)) + (if (null search-string) + (setq search-string + (car (if (memq search-command + '(re-search-forward re-search-backward)) + regexp-search-ring + search-ring)))) + (if (null search-command) + (progn (ding) (message "No last search command to repeat.")) + (funcall (cond ((eq search-command 're-search-forward) 're-search-backward) + ((eq search-command 're-search-backward) 're-search-forward) + ((eq search-command 'search-forward) 'search-backward) + ((eq search-command 'search-backward) 'search-forward)) + search-string nil nil arg))) + +(defun vi-join-lines (arg) + "join ARG lines from current line (default 2), cleaning up white space." + (interactive "P") + (if (null (vi-raw-numeric-prefix arg)) + (delete-indentation t) + (let ((count (vi-prefix-numeric-value arg))) + (while (>= count 2) + (delete-indentation t) + (setq count (1- count))))) + (vi-set-last-change-command 'vi-join-lines arg)) + +(defun vi-backward-kill-line () + "kill the current line. Only works in insert state." + (interactive) + (if (not vi-insert-state) + nil + (beginning-of-line 1) + (kill-line nil))) + +(defun vi-abort-ins () + "abort insert state, kill inserted text and go back to command state." + (interactive) + (if (not vi-insert-state) + nil + (if (> (point) vi-ins-point) + (kill-region vi-ins-point (point))) + (vi-goto-command-state t))) + +(defun vi-backward-windowful (count) + "Backward COUNT windowfuls. Default is one." + (interactive "p") +; (set-mark-command nil) + (while (> count 0) + (scroll-down nil) + (setq count (1- count)))) + +(defun vi-scroll-down-window (count) + "Scrolls down window COUNT lines. +If COUNT is nil (actually, non-integer), scrolls default amount. +The given COUNT is remembered for future scrollings." + (interactive "P") + (if (integerp count) + (setq vi-scroll-amount count)) + (scroll-up vi-scroll-amount)) + +(defun vi-expose-line-below (count) + "Expose COUNT more lines below the current window. Default COUNT is 1." + (interactive "p") + (scroll-up count)) + +(defun vi-forward-windowful (count) + "Forward COUNT windowfuls. Default is one." + (interactive "p") +; (set-mark-command nil) + (while (> count 0) + (scroll-up nil) + (setq count (1- count)))) + +(defun vi-next-line (count) + "Go down count lines, try to keep at the same column." + (interactive "p") + (setq this-command 'next-line) ; this is a needed trick + (if (= (point) (progn (line-move count) (point))) + (ding) ; no moving, already at end of buffer + (setq last-command 'next-line))) + +(defun vi-next-line-first-nonwhite (count) + "Go down COUNT lines. Stop at first non-white." + (interactive "p") + (if (= (point) (progn (forward-line count) (back-to-indentation) (point))) + (ding))) ; no moving, already at end of buffer + +(defun vi-previous-line-first-nonwhite (count) + "Go up COUNT lines. Stop at first non-white." + (interactive "p") + (forward-line (- count)) + (back-to-indentation)) + +(defun vi-scroll-up-window (count) + "Scrolls up window COUNT lines. +If COUNT is nil (actually, non-integer), scrolls default amount. +The given COUNT is remembered for future scrollings." + (interactive "P") + (if (integerp count) + (setq vi-scroll-amount count)) + (scroll-down vi-scroll-amount)) + +(defun vi-expose-line-above (count) + "Expose COUNT more lines above the current window. Default COUNT is 1." + (interactive "p") + (scroll-down count)) + +(defun vi-char-argument (arg) + "Get following character (could be any CHAR) as part of the prefix argument. +Possible prefix-arg cases are nil, INTEGER, (nil . CHAR) or (INTEGER . CHAR)." + (interactive "P") + (let ((char (read-char))) + (cond ((null arg) (setq prefix-arg (cons nil char))) + ((integerp arg) (setq prefix-arg (cons arg char))) + ; This can happen only if the user changed his/her mind for CHAR, + ; Or there are some leading "universal-argument"s + (t (setq prefix-arg (cons (car arg) char)))))) + +(defun vi-goto-mark (mark-char &optional line-flag) + "Go to marked position or line (if line-flag is given). +Goto mark '@' means jump into and pop the top mark on the mark ring." + (cond ((char-equal mark-char last-command-event) ; `` or '' + (exchange-point-and-mark) (if line-flag (back-to-indentation))) + ((char-equal mark-char ?@) ; jump and pop mark + (set-mark-command t) (if line-flag (back-to-indentation))) + (t + (let ((mark (vi-get-mark mark-char))) + (if (null mark) + (progn (vi-ding) (message "Mark register undefined.")) + (set-mark-command nil) + (goto-char mark) + (if line-flag (back-to-indentation))))))) + +(defun vi-goto-line-mark (char) + "Go to the line (at first non-white) marked by next char." + (interactive "c") + (vi-goto-mark char t)) + +(defun vi-goto-char-mark (char) + "Go to the char position marked by next mark-char." + (interactive "c") + (vi-goto-mark char)) + +(defun vi-digit-argument (arg) + "Set numeric prefix argument." + (interactive "P") + (cond ((null arg) (digit-argument arg)) + ((integerp arg) (digit-argument nil) + (setq prefix-arg (* prefix-arg arg))) + (t (digit-argument nil) ; in (NIL . CHAR) or (NUM . CHAR) form + (setq prefix-arg (cons (* prefix-arg + (if (null (car arg)) 1 (car arg))) + (cdr arg)))))) + +(defun vi-raw-numeric-prefix (arg) + "Return the raw value of numeric part prefix argument." + (if (consp arg) (car arg) arg)) + +(defun vi-prefix-numeric-value (arg) + "Return numeric meaning of the raw prefix argument. This is a modification +to the standard one provided in `callint.c' to handle (_ . CHAR) cases." + (cond ((null arg) 1) + ((integerp arg) arg) + ((consp arg) (if (car arg) (car arg) 1)))) + +(defun vi-reverse-last-find-char (count &optional find-arg) + "Reverse last f F t T operation COUNT times. If the optional FIND-ARG +is given, it is used instead of the saved one." + (interactive "p") + (if (null find-arg) (setq find-arg vi-last-find-char)) + (if (null find-arg) + (progn (ding) (message "No last find char to repeat.")) + (vi-find-char (cons (* (car find-arg) -1) (cdr find-arg)) count))) ;6/13/86 + +(defun vi-find-char (arg count) + "Find in DIRECTION (1/-1) for CHAR of COUNT'th times on current line. +If UPTO-FLAG is T, stop before the char. ARG = (DIRECTION.CHAR.UPTO-FLAG." + (let* ((direction (car arg)) (char (car (cdr arg))) + (upto-flag (cdr (cdr arg))) (pos (+ (point) direction))) + (if (catch 'exit-find-char + (while t + (cond ((null (char-after pos)) (throw 'exit-find-char nil)) + ((char-equal (char-after pos) ?\n) (throw 'exit-find-char nil)) + ((char-equal char (char-after pos)) (setq count (1- count)) + (if (= count 0) + (throw 'exit-find-char + (if upto-flag + (setq pos (- pos direction)) + pos))))) + (setq pos (+ pos direction)))) + (goto-char pos) + (ding)))) + +(defun vi-repeat-last-find-char (count &optional find-arg) + "Repeat last f F t T operation COUNT times. If optional FIND-ARG is given, +it is used instead of the saved one." + (interactive "p") + (if (null find-arg) (setq find-arg vi-last-find-char)) + (if (null find-arg) + (progn (ding) (message "No last find char to repeat.")) + (vi-find-char find-arg count))) + +(defun vi-backward-find-char (count char) + "Find the COUNT'th CHAR backward on current line." + (interactive "p\nc") + (setq vi-last-find-char (cons -1 (cons char nil))) + (vi-repeat-last-find-char count)) + +(defun vi-forward-find-char (count char) + "Find the COUNT'th CHAR forward on current line." + (interactive "p\nc") + (setq vi-last-find-char (cons 1 (cons char nil))) + (vi-repeat-last-find-char count)) + +(defun vi-backward-upto-char (count char) + "Find upto the COUNT'th CHAR backward on current line." + (interactive "p\nc") + (setq vi-last-find-char (cons -1 (cons char t))) + (vi-repeat-last-find-char count)) + +(defun vi-forward-upto-char (count char) + "Find upto the COUNT'th CHAR forward on current line." + (interactive "p\nc") + (setq vi-last-find-char (cons 1 (cons char t))) + (vi-repeat-last-find-char count)) + +(defun vi-end-of-word (count) + "Move forward until encountering the end of a word. +With argument, do this that many times." + (interactive "p") + (if (not (eobp)) (forward-char)) + (if (re-search-forward "\\W*\\w+\\>" nil t count) + (backward-char))) + +(defun vi-replace-1-char (count char) + "Replace char after point by CHAR. Repeat COUNT times." + (interactive "p\nc") + (delete-char count nil) ; don't save in kill ring + (setq last-command-event char) + (self-insert-command count) + (vi-set-last-change-command 'vi-replace-1-char count char)) + +(defun vi-replace-chars (arg) + "Replace chars over old ones." + (interactive "*p") + (overwrite-mode 1) + (vi-goto-insert-state arg)) + +(defun vi-substitute-chars (count) + "Substitute COUNT chars by the input chars, enter insert state." + (interactive "*p") + (vi-goto-insert-state 1 (list (function (lambda (c) ; this is a bit tricky + (delete-region (point) + (+ (point) c)))) + count) t)) + +(defun vi-substitute-lines (count) + "Substitute COUNT lines by the input chars. (=cc in vi)" + (interactive "*p") + (vi-goto-insert-state 1 (list 'vi-delete-op 'next-line (1- count)) t)) + +(defun vi-prefix-char-value (arg) + "Get the char part of the current prefix argument." + (cond ((null arg) nil) + ((integerp arg) nil) + ((consp arg) (cdr arg)) + (t nil))) + +(defun vi-operator (arg) + "Handling vi operators (d/c//!/=/y). Current implementation requires +the key bindings of the operators being fixed." + (interactive "P") + (catch 'vi-exit-op + (let ((this-op-char last-command-event)) + (setq last-command-event (read-char)) + (setq this-command (lookup-key vi-com-map (char-to-string last-command-event))) + (if (not (eq this-command 'vi-digit-argument)) + (setq prefix-arg arg) + (vi-digit-argument arg) + (setq last-command-event (read-char)) + (setq this-command (lookup-key vi-com-map (char-to-string last-command-event)))) + (cond ((char-equal this-op-char last-command-event) ; line op + (vi-execute-op this-op-char 'next-line + (cons (1- (vi-prefix-numeric-value prefix-arg)) + (vi-prefix-char-value prefix-arg)))) + ;; We assume any command that has no property 'point-moving-unit' + ;; as having that property with the value 'CHAR'. 3/12/86 + (t ;; (get this-command 'point-moving-unit) + (vi-execute-op this-op-char this-command prefix-arg)))))) + ;; (t (throw 'vi-exit-op (ding))))))) + +(defun vi-execute-op (op-char motion-command arg) + "Execute vi edit operator as specified by OP-CHAR, the operand is the region +determined by the MOTION-COMMAND with ARG." + (cond ((= op-char ?d) + (if (vi-delete-op motion-command arg) + (vi-set-last-change-command 'vi-delete-op (vi-repeat-command-of motion-command) arg))) + ((= op-char ?c) + (if (vi-delete-op motion-command arg) + (vi-goto-insert-state 1 (list 'vi-delete-op + (vi-repeat-command-of motion-command) arg) nil))) + ((= op-char ?y) + (if (vi-yank-op motion-command arg) + (vi-set-last-change-command 'vi-yank-op (vi-repeat-command-of motion-command) arg))) + ((= op-char ?!) + (if (vi-shell-op motion-command arg) + (vi-set-last-change-command 'vi-shell-op (vi-repeat-command-of motion-command) arg vi-last-shell-command))) + ((= op-char ?<) + (if (vi-shift-op motion-command arg (- vi-shift-width)) + (vi-set-last-change-command 'vi-shift-op (vi-repeat-command-of motion-command) arg (- vi-shift-width)))) + ((= op-char ?>) + (if (vi-shift-op motion-command arg vi-shift-width) + (vi-set-last-change-command 'vi-shift-op (vi-repeat-command-of motion-command) arg vi-shift-width))) + ((= op-char ?=) + (if (vi-indent-op motion-command arg) + (vi-set-last-change-command 'vi-indent-op (vi-repeat-command-of motion-command) arg))) + ((= op-char ?\\) + (vi-narrow-op motion-command arg)))) + +(defun vi-repeat-command-of (command) + "Return the command for redo the given command." + (let ((cmd-type (get command 'point-moving-unit))) + (cond ((eq cmd-type 'search) 'vi-repeat-last-search) + ((eq cmd-type 'find) 'vi-repeat-last-find-char) + (t command)))) + +(defun vi-effective-range (motion-command arg) + "Return (begin . end) of the range spanned by executing the given +MOTION-COMMAND with ARG. + MOTION-COMMAND in ready-to-eval list form is not yet supported." + (save-excursion + (let ((begin (point)) end opoint + (moving-unit (get motion-command 'point-moving-unit))) + (setq prefix-arg arg) + (setq opoint (point)) + (command-execute motion-command nil) +;; Check if there is any effective motion. Note that for single line operation +;; the motion-command causes no effective point movement (since it moves up or +;; down zero lines), but it should be counted as effectively moved. + (if (and (= (point) opoint) (not (eq moving-unit 'line))) + (cons opoint opoint) ; no effective motion + (if (eq moving-unit 'region) + (setq begin (or (mark) (point)))) + (if (<= begin (point)) + (setq end (point)) + (setq end begin) + (setq begin (point))) + (cond ((or (eq moving-unit 'match) (eq moving-unit 'find)) + (setq end (1+ end))) + ((eq moving-unit 'line) + (goto-char begin) (beginning-of-line) (setq begin (point)) + (goto-char end) (forward-line 1) (beginning-of-line) (setq end (point)))) + (if (> end (point-max)) (setq end (point-max))) ; force in buffer region + (cons begin end))))) + +(defun vi-delete-op (motion-command arg) + "Delete range specified by MOTION-COMMAND with ARG." + (let* ((range (vi-effective-range motion-command arg)) + (begin (car range)) (end (cdr range)) reg) + (if (= begin end) + nil ; point not moved, abort op + (setq reg (vi-prefix-char-value arg)) + (if (null reg) + (kill-region begin end) ; kill ring as unnamed registers + (if (and (>= reg ?A) (<= reg ?Z)) + (append-to-register (downcase reg) begin end t) + (copy-to-register reg begin end t))) + t))) + +(defun vi-yank-op (motion-command arg) + "Yank (in vi sense) range specified by MOTION-COMMAND with ARG." + (let* ((range (vi-effective-range motion-command arg)) + (begin (car range)) (end (cdr range)) reg) + (if (= begin end) + nil ; point not moved, abort op + (setq reg (vi-prefix-char-value arg)) + (if (null reg) + (copy-region-as-kill begin end); kill ring as unnamed registers + (if (and (>= reg ?A) (<= reg ?Z)) + (append-to-register (downcase reg) begin end nil) + (copy-to-register reg begin end nil))) + t))) + +(defun vi-yank-line (arg) + "Yank (in vi sense) lines (= `yy' command)." + (interactive "*P") + (setq arg (cons (1- (vi-prefix-numeric-value arg)) (vi-prefix-char-value arg))) + (if (vi-yank-op 'next-line arg) + (vi-set-last-change-command 'vi-yank-op 'next-line arg))) + +(defun vi-string-end-with-nl-p (string) + "See if STRING ends with a newline char. +Used in checking whether the yanked text should be put back as lines or not." + (= (aref string (1- (length string))) ?\n)) + +(defun vi-put-before (arg &optional after-p) + "Put yanked (in vi sense) text back before/above cursor. +If a numeric prefix value (currently it should be >1) is given, put back +text as lines. If the optional after-p is given, put after/below the cursor." + (interactive "P") + (let ((reg (vi-prefix-char-value arg)) put-text) + (if (and reg (or (< reg ?1) (> reg ?9)) (null (get-register reg))) + (error "Nothing in register %c" reg) + (if (null reg) (setq reg ?1)) ; the default is the last text killed + (setq put-text + (cond + ((and (>= reg ?1) (<= reg ?9)) + (setq this-command 'yank) ; So we may yank-pop !! + (current-kill (- reg ?0 1) 'do-not-rotate)) + ((stringp (get-register reg)) (get-register reg)) + (t (error "Register %c is not containing text string" reg)))) + (if (vi-string-end-with-nl-p put-text) ; put back text as lines + (if after-p + (progn (forward-line 1) (beginning-of-line)) + (beginning-of-line)) + (if after-p (forward-char 1))) + (push-mark (point)) + (insert put-text) + (exchange-point-and-mark) +;; (back-to-indentation) ; this is not allowed if we allow yank-pop + (vi-set-last-change-command 'vi-put-before arg after-p)))) + +(defun vi-put-after (arg) + "Put yanked (in vi sense) text back after/below cursor." + (interactive "P") + (vi-put-before arg t)) + +(defun vi-shell-op (motion-command arg &optional shell-command) + "Perform shell command (as filter). +Performs command on range specified by MOTION-COMMAND +with ARG. If SHELL-COMMAND is not given, ask for one from minibuffer. +If char argument is given, it directs the output to a *temp* buffer." + (let* ((range (vi-effective-range motion-command arg)) + (begin (car range)) (end (cdr range))) + (if (= begin end) + nil ; point not moved, abort op + (cond ((null shell-command) + (setq shell-command (read-string "!" nil)) + (setq vi-last-shell-command shell-command))) + (shell-command-on-region begin end shell-command (not (vi-prefix-char-value arg)) + (not (vi-prefix-char-value arg))) + t))) + +(defun vi-shift-op (motion-command arg amount) + "Perform shift command on range specified by MOTION-COMMAND with ARG for +AMOUNT on each line. Negative amount means shift left. +SPECIAL FEATURE: char argument can be used to specify shift amount(1-9)." + (let* ((range (vi-effective-range motion-command arg)) + (begin (car range)) (end (cdr range))) + (if (= begin end) + nil ; point not moved, abort op + (if (vi-prefix-char-value arg) + (setq amount (if (> amount 0) + (- (vi-prefix-char-value arg) ?0) + (- ?0 (vi-prefix-char-value arg))))) + (indent-rigidly begin end amount) + t))) + +(defun vi-indent-op (motion-command arg) + "Perform indent command on range specified by MOTION-COMMAND with ARG." + (let* ((range (vi-effective-range motion-command arg)) + (begin (car range)) (end (cdr range))) + (if (= begin end) + nil ; point not moved, abort op + (indent-region begin end nil) ; insert TAB as indent command + t))) + +(defun vi-narrow-op (motion-command arg) + "Narrow to region specified by MOTION-COMMAND with ARG." + (let* ((range (vi-effective-range motion-command arg)) + (begin (car range)) (end (cdr range)) reg) + (if (= begin end) + nil ; point not moved, abort op + (narrow-to-region begin end)))) + +(defun vi-get-mark (char) + "Return contents of vi mark register named CHAR, or nil if undefined." + (cdr (assq char vi-mark-alist))) + +(defun vi-set-mark (char) + "Set contents of vi mark register named CHAR to current point. +'@' is the special anonymous mark register." + (interactive "c") + (if (char-equal char ?@) + (set-mark-command nil) + (let ((aelt (assq char vi-mark-alist))) + (if aelt + (move-marker (cdr aelt) (point)) ; fixed 6/12/86 + (setq aelt (cons char (copy-marker (point)))) + (setq vi-mark-alist (cons aelt vi-mark-alist)))))) + +(defun vi-find-matching-paren () + "Locate the matching paren. It's a hack right now." + (interactive) + (cond ((looking-at "[[({]") (forward-sexp 1) (backward-char 1)) + ((looking-at "[])}]") (forward-char 1) (backward-sexp 1)) + (t (ding)))) + +(defun vi-backward-blank-delimited-word (count) + "Backward COUNT blank-delimited words." + (interactive "p") + (if (re-search-backward "[ \t\n\`][^ \t\n\`]+" nil t count) + (if (not (bobp)) (forward-char 1)))) + +(defun vi-forward-blank-delimited-word (count) + "Forward COUNT blank-delimited words." + (interactive "p") + (if (re-search-forward "[^ \t\n]*[ \t\n]+[^ \t\n]" nil t count) + (if (not (eobp)) (backward-char 1)))) + +(defun vi-end-of-blank-delimited-word (count) + "Forward to the end of the COUNT'th blank-delimited word." + (interactive "p") + (if (re-search-forward "[^ \t\n\']+[ \t\n\']" nil t count) + (if (not (eobp)) (backward-char 2)))) + +(defun vi-home-window-line (arg) + "To window home or arg'th line from the top of the window." + (interactive "p") + (move-to-window-line (1- arg)) + (back-to-indentation)) + +(defun vi-last-window-line (arg) + "To window last line or arg'th line from the bottom of the window." + (interactive "p") + (move-to-window-line (- arg)) + (back-to-indentation)) + +(defun vi-middle-window-line () + "To the middle line of the window." + (interactive) + (move-to-window-line nil) + (back-to-indentation)) + +(defun vi-forward-word (count) + "Stop at the beginning of the COUNT'th words from point." + (interactive "p") + (if (re-search-forward "\\w*\\W+\\<" nil t count) + t + (vi-ding))) + +(defun vi-set-last-change-command (fun &rest args) + "Set (FUN . ARGS) as the `last-change-command'." + (setq vi-last-change-command (cons fun args))) + +(defun vi-redo-last-change-command (count &optional command) + "Redo last change command COUNT times. If the optional COMMAND is given, +it is used instead of the current `last-change-command'." + (interactive "p") + (if (null command) + (setq command vi-last-change-command)) + (if (null command) + (message "No last change command available.") + (while (> count 0) + (apply (car command) (cdr command)) + (setq count (1- count))))) + +(defun vi-kill-char (count) + "Kill COUNT chars from current point." + (interactive "*p") + (delete-char count t) ; save in kill ring + (vi-set-last-change-command 'delete-char count t)) + +(defun vi-transpose-objects (arg unit) + "Transpose objects. +The following char specifies unit of objects to be +transposed -- \"c\" for chars, \"l\" for lines, \"w\" for words, \"s\" for + sexp, \"p\" for paragraph. +For the use of the prefix-arg, refer to individual functions called." + (interactive "*P\nc") + (if (char-equal unit ??) + (progn + (message "Transpose: c(har), l(ine), p(aragraph), s(-exp), w(ord),") + (setq unit (read-char)))) + (vi-set-last-change-command 'vi-transpose-objects arg unit) + (cond ((char-equal unit ?c) (transpose-chars arg)) + ((char-equal unit ?l) (transpose-lines (vi-prefix-numeric-value arg))) + ((char-equal unit ?p) (transpose-paragraphs (vi-prefix-numeric-value arg))) + ((char-equal unit ?s) (transpose-sexps (vi-prefix-numeric-value arg))) + ((char-equal unit ?w) (transpose-words (vi-prefix-numeric-value arg))) + (t (vi-transpose-objects arg ??)))) + +(defun vi-query-replace (arg) + "Query replace, use regexp version if ARG is non-nil." + (interactive "*P") + (let ((rcmd (if arg 'query-replace-regexp 'query-replace))) + (call-interactively rcmd nil))) + +(defun vi-replace (arg) + "Replace strings, use regexp version if ARG is non-nil." + (interactive "*P") + (let ((rcmd (if arg 'replace-regexp 'replace-string))) + (call-interactively rcmd nil))) + +(defun vi-adjust-window (arg position) + "Move current line to the top/center/bottom of the window." + (interactive "p\nc") + (cond ((char-equal position ?\r) (recenter 0)) + ((char-equal position ?-) (recenter -1)) + ((char-equal position ?.) (recenter (/ (window-height) 2))) + (t (message "Move current line to: \\r(top) -(bottom) .(middle)") + (setq position (read-char)) + (vi-adjust-window arg position)))) + +(defun vi-goto-column (col) + "Go to given column of the current line." + (interactive "p") + (let ((opoint (point))) + (beginning-of-line) + (while (> col 1) + (if (eolp) + (setq col 0) + (forward-char 1) + (setq col (1- col)))) + (if (= col 1) + t + (goto-char opoint) + (ding)))) + +(defun vi-name-last-change-or-macro (arg char) + "Give name to the last change command or just defined kbd macro. +If prefix ARG is given, name last macro, otherwise name last change command. +The following CHAR will be the name for the command or macro." + (interactive "P\nc") + (if arg + (name-last-kbd-macro (intern (char-to-string char))) + (if (eq (car vi-last-change-command) 'vi-first-redo-insertion) + (let* ((args (cdr vi-last-change-command)) ; save the insertion text + (str (buffer-substring (nth 0 args) (nth 1 args))) + (overwrite-p (nth 2 args)) + (prefix-code (nth 3 args))) + (vi-set-last-change-command 'vi-more-redo-insertion str + overwrite-p prefix-code))) + (fset (intern (char-to-string char)) vi-last-change-command))) + +(defun vi-call-named-change-or-macro (count char) + "Execute COUNT times the keyboard macro definition named by the following CHAR." + (interactive "p\nc") + (if (stringp (symbol-function (intern (char-to-string char)))) + (execute-kbd-macro (intern (char-to-string char)) count) + (vi-redo-last-change-command count (symbol-function (intern (char-to-string char)))))) + +(defun vi-change-case (arg) ; could be made as an operator ? + "Change the case of the char after point." + (interactive "*p") + (catch 'exit + (if (looking-at "[a-z]") + (upcase-region (point) (+ (point) arg)) + (if (looking-at "[A-Z]") + (downcase-region (point) (+ (point) arg)) + (ding) + (throw 'exit nil))) + (vi-set-last-change-command 'vi-change-case arg) ;should avoid redundant save + (forward-char arg))) + +(defun vi-ask-for-info (char) + "Inquire status info. The next CHAR will specify the particular info requested." + (interactive "c") + (cond ((char-equal char ?l) (what-line)) + ((char-equal char ?c) (what-cursor-position)) + ((char-equal char ?p) (what-page)) + (t (message "Ask for: l(ine number), c(ursor position), p(age number)") + (setq char (read-char)) + (vi-ask-for-info char)))) + +(declare-function c-mark-function "cc-cmds" ()) + +(defun vi-mark-region (arg region) + "Mark region appropriately. The next char REGION is d(efun),s(-exp),b(uffer), +p(aragraph), P(age), f(unction in C/Pascal etc.), w(ord), e(nd of sentence), +l(ines)." + (interactive "p\nc") + (cond ((char-equal region ?d) (mark-defun)) + ((char-equal region ?s) (mark-sexp arg)) + ((char-equal region ?b) (mark-whole-buffer)) + ((char-equal region ?p) (mark-paragraph)) + ((char-equal region ?P) (mark-page arg)) + ((char-equal region ?f) (c-mark-function)) + ((char-equal region ?w) (mark-word arg)) + ((char-equal region ?e) (mark-end-of-sentence arg)) + ((char-equal region ?l) (vi-mark-lines arg)) + (t (message "Mark: d(efun),s(-exp),b(uf),p(arag),P(age),f(unct),w(ord),e(os),l(ines)") + (setq region (read-char)) + (vi-mark-region arg region)))) + +(defun vi-mark-lines (num) + "Mark NUM of lines from current line as current region." + (beginning-of-line 1) + (push-mark) + (end-of-line num)) + +(defun vi-verify-spelling (arg unit) + "Verify spelling for the objects specified by char UNIT : [b(uffer), +r(egion), s(tring), w(ord) ]." + (interactive "P\nc") + (setq prefix-arg arg) ; seems not needed + (cond ((char-equal unit ?b) (call-interactively 'spell-buffer)) + ((char-equal unit ?r) (call-interactively 'spell-region)) + ((char-equal unit ?s) (call-interactively 'spell-string)) + ((char-equal unit ?w) (call-interactively 'spell-word)) + (t (message "Spell check: b(uffer), r(egion), s(tring), w(ord)") + (setq unit (read-char)) + (vi-verify-spelling arg unit)))) + +(defun vi-do-old-mode-C-c-command (arg) + "This is a hack for accessing mode specific C-c commands in vi-mode." + (interactive "P") + (let ((cmd (lookup-key vi-mode-old-local-map + (concat "\C-c" (char-to-string (read-char)))))) + (if (catch 'exit-vi-mode ; kludge hack due to dynamic binding + ; of case-fold-search + (if (null cmd) + (progn (ding) nil) + (let ((case-fold-search vi-mode-old-case-fold)) ; a hack + (setq prefix-arg arg) + (command-execute cmd nil) + nil))) + (progn + (vi-back-to-old-mode) + (setq prefix-arg arg) + (command-execute cmd nil))))) + +(defun vi-quote-words (arg char) + "Quote ARG words from the word point is on with pattern specified by CHAR. +Currently, CHAR could be [,{,(,\",',`,<,*, etc." + (interactive "*p\nc") + (while (not (string-match "[[({<\"'`*]" (char-to-string char))) + (message "Enter any of [,{,(,<,\",',`,* as quoting character.") + (setq char (read-char))) + (vi-set-last-change-command 'vi-quote-words arg char) + (if (not (looking-at "\\<")) (forward-word -1)) + (insert char) + (cond ((char-equal char ?[) (setq char ?])) + ((char-equal char ?{) (setq char ?})) + ((char-equal char ?<) (setq char ?>)) + ((char-equal char ?() (setq char ?))) + ((char-equal char ?`) (setq char ?'))) + (vi-end-of-word arg) + (forward-char 1) + (insert char)) + +(defun vi-locate-def () + "Locate definition in current file for the name before the point. +It assumes a `(def..' always starts at the beginning of a line." + (interactive) + (let (name) + (save-excursion + (setq name (buffer-substring (progn (vi-backward-blank-delimited-word 1) + (skip-chars-forward "^a-zA-Z") + (point)) + (progn (vi-end-of-blank-delimited-word 1) + (forward-char) + (skip-chars-backward "^a-zA-Z") + (point))))) + (set-mark-command nil) + (goto-char (point-min)) + (if (re-search-forward (concat "^(def[unvarconst ]*" name) nil t) + nil + (ding) + (message "No definition for \"%s\" in current file." name) + (set-mark-command t)))) + +(defun vi-split-open-line (arg) + "Insert a newline and leave point before it. +With ARG, inserts that many newlines." + (interactive "*p") + (vi-goto-insert-state 1 + (list (function (lambda (arg) + (let ((flag (and (bolp) (not (bobp))))) + (if flag (forward-char -1)) + (while (> arg 0) + (save-excursion + (insert ?\n) + (if fill-prefix (insert fill-prefix))) + (setq arg (1- arg))) + (if flag (forward-char 1))))) arg) + t)) + +(provide 'vi) + +;;; vi.el ends here diff --git a/lisp/obsolete/vip.el b/lisp/obsolete/vip.el new file mode 100644 index 00000000000..ea102cb0ac5 --- /dev/null +++ b/lisp/obsolete/vip.el @@ -0,0 +1,3062 @@ +;;; vip.el --- a VI Package for GNU Emacs + +;; Copyright (C) 1986-1988, 1992-1993, 1998, 2001-2014 +;; Free Software Foundation, Inc. + +;; Author: Masahiko Sato +;; 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 . + +;;; Commentary: + +;; This file is obsolete. Consider using viper instead. + +;; A full-featured vi(1) emulator. +;; +;; In Japan, the author's address is: masahiko@sato.riec.tohoku.junet +;; +;; Send suggestions and bug reports to one of the above addresses. +;; When you report a bug, be sure to include the version number of VIP and +;; Emacs you are using. + +;; Execute info command by typing "M-x info" to get information on VIP. + +;;; Code: + +(defgroup vip nil + "A VI Package for GNU Emacs." + :prefix "vip-" + :group 'emulations) + +;; external variables + +(defvar vip-emacs-local-map nil + "Local map used in Emacs mode. (Buffer-specific.)") + +(defvar vip-insert-local-map nil + "Local map used in insert command mode. (Buffer-specific.)") + +(make-variable-buffer-local 'vip-emacs-local-map) +(make-variable-buffer-local 'vip-insert-local-map) + +(defvar vip-insert-point nil + "Remember insert point as a marker. (Buffer-specific.)") + +(set-default 'vip-insert-point (make-marker)) +(make-variable-buffer-local 'vip-insert-point) + +(defvar vip-com-point nil + "Remember com point as a marker. (Buffer-specific.)") + +(set-default 'vip-com-point (make-marker)) +(make-variable-buffer-local 'vip-com-point) + +(defvar vip-current-mode nil + "Current mode. One of `emacs-mode', `vi-mode', `insert-mode'.") + +(make-variable-buffer-local 'vip-current-mode) +(setq-default vip-current-mode 'emacs-mode) + +(defvar vip-emacs-mode-line-buffer-identification nil + "Value of mode-line-buffer-identification in Emacs mode within vip.") +(make-variable-buffer-local 'vip-emacs-mode-line-buffer-identification) +(setq-default vip-emacs-mode-line-buffer-identification + '("Emacs: %17b")) + +(defvar vip-current-major-mode nil + "vip-current-major-mode is the major-mode vi considers it is now. +\(buffer specific\)") + +(make-variable-buffer-local 'vip-current-major-mode) + +(defvar vip-last-shell-com nil + "Last shell command executed by ! command.") + +(defvar vip-use-register nil + "Name of register to store deleted or yanked strings.") + +(defvar vip-d-com nil + "How to reexecute last destructive command. Value is list (M-COM VAL COM).") + +(defcustom vip-shift-width 8 + "The number of columns shifted by > and < command." + :type 'integer + :group 'vip) + +(defcustom vip-re-replace nil + "If t then do regexp replace, if nil then do string replace." + :type 'boolean + :group 'vip) + +(defvar vip-d-char nil + "The character remembered by the vi \"r\" command.") + +(defvar vip-f-char nil + "For use by \";\" command.") + +(defvar vip-F-char nil + "For use by \".\" command.") + +(defvar vip-f-forward nil + "For use by \";\" command.") + +(defvar vip-f-offset nil + "For use by \";\" command.") + +(defcustom vip-search-wrap-around t + "If t, search wraps around." + :type 'boolean + :group 'vip) + +(defcustom vip-re-search nil + "If t, search is reg-exp search, otherwise vanilla search." + :type 'boolean + :group 'vip) + +(defvar vip-s-string nil + "Last vip search string.") + +(defvar vip-s-forward nil + "If t, search is forward.") + +(defcustom vip-case-fold-search nil + "If t, search ignores cases." + :type 'boolean + :group 'vip) + +(defcustom vip-re-query-replace nil + "If t then do regexp replace, if nil then do string replace." + :type 'boolean + :group 'vip) + +(defcustom vip-open-with-indent nil + "If t, indent when open a new line." + :type 'boolean + :group 'vip) + +(defcustom vip-help-in-insert-mode nil + "If t then C-h is bound to help-command in insert mode. +If nil then it is bound to `delete-backward-char'." + :type 'boolean + :group 'vip) + +(defvar vip-quote-string "> " + "String inserted at the beginning of region.") + +(defvar vip-tags-file-name "TAGS") + +(defvar vip-inhibit-startup-message nil) + +(defvar vip-startup-file (locate-user-emacs-file "vip" ".vip") + "Filename used as startup file for vip.") + +;; key bindings + +(defvar vip-mode-map + (let ((map (make-keymap))) + (define-key map "\C-a" 'beginning-of-line) + (define-key map "\C-b" 'vip-scroll-back) + (define-key map "\C-c" 'vip-ctl-c) + (define-key map "\C-d" 'vip-scroll-up) + (define-key map "\C-e" 'vip-scroll-up-one) + (define-key map "\C-f" 'vip-scroll) + (define-key map "\C-g" 'vip-keyboard-quit) + (define-key map "\C-h" 'help-command) + (define-key map "\C-m" 'vip-scroll-back) + (define-key map "\C-n" 'vip-other-window) + (define-key map "\C-o" 'vip-open-line-at-point) + (define-key map "\C-u" 'vip-scroll-down) + (define-key map "\C-x" 'vip-ctl-x) + (define-key map "\C-y" 'vip-scroll-down-one) + (define-key map "\C-z" 'vip-change-mode-to-emacs) + (define-key map "\e" 'vip-ESC) + + (define-key map [?\S-\ ] 'vip-scroll-back) + (define-key map " " 'vip-scroll) + (define-key map "!" 'vip-command-argument) + (define-key map "\"" 'vip-command-argument) + (define-key map "#" 'vip-command-argument) + (define-key map "$" 'vip-goto-eol) + (define-key map "%" 'vip-paren-match) + (define-key map "&" 'vip-nil) + (define-key map "'" 'vip-goto-mark-and-skip-white) + (define-key map "(" 'vip-backward-sentence) + (define-key map ")" 'vip-forward-sentence) + (define-key map "*" 'call-last-kbd-macro) + (define-key map "+" 'vip-next-line-at-bol) + (define-key map "," 'vip-repeat-find-opposite) + (define-key map "-" 'vip-previous-line-at-bol) + (define-key map "." 'vip-repeat) + (define-key map "/" 'vip-search-forward) + + (define-key map "0" 'vip-beginning-of-line) + (define-key map "1" 'vip-digit-argument) + (define-key map "2" 'vip-digit-argument) + (define-key map "3" 'vip-digit-argument) + (define-key map "4" 'vip-digit-argument) + (define-key map "5" 'vip-digit-argument) + (define-key map "6" 'vip-digit-argument) + (define-key map "7" 'vip-digit-argument) + (define-key map "8" 'vip-digit-argument) + (define-key map "9" 'vip-digit-argument) + + (define-key map ":" 'vip-ex) + (define-key map ";" 'vip-repeat-find) + (define-key map "<" 'vip-command-argument) + (define-key map "=" 'vip-command-argument) + (define-key map ">" 'vip-command-argument) + (define-key map "?" 'vip-search-backward) + (define-key map "@" 'vip-nil) + + (define-key map "A" 'vip-Append) + (define-key map "B" 'vip-backward-Word) + (define-key map "C" 'vip-ctl-c-equivalent) + (define-key map "D" 'vip-kill-line) + (define-key map "E" 'vip-end-of-Word) + (define-key map "F" 'vip-find-char-backward) + (define-key map "G" 'vip-goto-line) + (define-key map "H" 'vip-window-top) + (define-key map "I" 'vip-Insert) + (define-key map "J" 'vip-join-lines) + (define-key map "K" 'vip-kill-buffer) + (define-key map "L" 'vip-window-bottom) + (define-key map "M" 'vip-window-middle) + (define-key map "N" 'vip-search-Next) + (define-key map "O" 'vip-Open-line) + (define-key map "P" 'vip-Put-back) + (define-key map "Q" 'vip-query-replace) + (define-key map "R" 'vip-replace-string) + (define-key map "S" 'vip-switch-to-buffer-other-window) + (define-key map "T" 'vip-goto-char-backward) + (define-key map "U" 'vip-nil) + (define-key map "V" 'vip-find-file-other-window) + (define-key map "W" 'vip-forward-Word) + (define-key map "X" 'vip-ctl-x-equivalent) + (define-key map "Y" 'vip-yank-line) + (define-key map "ZZ" 'save-buffers-kill-emacs) + + (define-key map "[" 'vip-nil) + (define-key map "\\" 'vip-escape-to-emacs) + (define-key map "]" 'vip-nil) + (define-key map "^" 'vip-bol-and-skip-white) + (define-key map "_" 'vip-nil) + (define-key map "`" 'vip-goto-mark) + + (define-key map "a" 'vip-append) + (define-key map "b" 'vip-backward-word) + (define-key map "c" 'vip-command-argument) + (define-key map "d" 'vip-command-argument) + (define-key map "e" 'vip-end-of-word) + (define-key map "f" 'vip-find-char-forward) + (define-key map "g" 'vip-info-on-file) + (define-key map "h" 'vip-backward-char) + (define-key map "i" 'vip-insert) + (define-key map "j" 'vip-next-line) + (define-key map "k" 'vip-previous-line) + (define-key map "l" 'vip-forward-char) + (define-key map "m" 'vip-mark-point) + (define-key map "n" 'vip-search-next) + (define-key map "o" 'vip-open-line) + (define-key map "p" 'vip-put-back) + (define-key map "q" 'vip-nil) + (define-key map "r" 'vip-replace-char) + (define-key map "s" 'vip-switch-to-buffer) + (define-key map "t" 'vip-goto-char-forward) + (define-key map "u" 'vip-undo) + (define-key map "v" 'vip-find-file) + (define-key map "w" 'vip-forward-word) + (define-key map "x" 'vip-delete-char) + (define-key map "y" 'vip-command-argument) + (define-key map "zH" 'vip-line-to-top) + (define-key map "zM" 'vip-line-to-middle) + (define-key map "zL" 'vip-line-to-bottom) + (define-key map "z\C-m" 'vip-line-to-top) + (define-key map "z." 'vip-line-to-middle) + (define-key map "z-" 'vip-line-to-bottom) + + (define-key map "{" 'vip-backward-paragraph) + (define-key map "|" 'vip-goto-col) + (define-key map "}" 'vip-forward-paragraph) + (define-key map "~" 'vip-nil) + (define-key map "\177" 'vip-delete-backward-char) + map)) + +(defun vip-version () + (interactive) + (message "VIP version 3.5 of September 15, 1987")) + + +;; basic set up + +;;;###autoload +(defun vip-setup () + "Set up bindings for C-x 7 and C-z that are useful for VIP users." + (define-key ctl-x-map "7" 'vip-buffer-in-two-windows) + (global-set-key "\C-z" 'vip-change-mode-to-vi)) + +(defmacro vip-loop (count body) + "(COUNT BODY) Execute BODY COUNT times." + `(let ((count ,count)) + (while (> count 0) + ,body + (setq count (1- count))))) + +(defun vip-push-mark-silent (&optional location) + "Set mark at LOCATION (point, by default) and push old mark on mark ring. +No message." + (if (null (mark t)) + nil + (setq mark-ring (cons (copy-marker (mark-marker)) mark-ring)) + (if (> (length mark-ring) mark-ring-max) + (progn + (move-marker (car (nthcdr mark-ring-max mark-ring)) nil) + (setcdr (nthcdr (1- mark-ring-max) mark-ring) nil)))) + (set-mark (or location (point)))) + +(defun vip-goto-col (arg) + "Go to ARG's column." + (interactive "P") + (let ((val (vip-p-val arg)) + (com (vip-getcom arg))) + (save-excursion + (end-of-line) + (if (> val (1+ (current-column))) (error ""))) + (if com (move-marker vip-com-point (point))) + (beginning-of-line) + (forward-char (1- val)) + (if com (vip-execute-com 'vip-goto-col val com)))) + +(defun vip-copy-keymap (map) + (if (null map) (make-sparse-keymap) (copy-keymap map))) + + +;; changing mode + +(defun vip-change-mode (new-mode) + "Change mode to NEW-MODE---either emacs-mode, vi-mode, or insert-mode." + (or (eq new-mode vip-current-mode) + (progn + (cond ((eq new-mode 'vi-mode) + (if (eq vip-current-mode 'insert-mode) + (progn + (vip-copy-region-as-kill (point) vip-insert-point) + (vip-repeat-insert-command)) + (setq vip-emacs-local-map (current-local-map) + vip-emacs-mode-line-buffer-identification + mode-line-buffer-identification + vip-insert-local-map (vip-copy-keymap + (current-local-map)))) + (vip-change-mode-line "Vi: ") + (use-local-map vip-mode-map)) + ((eq new-mode 'insert-mode) + (move-marker vip-insert-point (point)) + (if (eq vip-current-mode 'emacs-mode) + (setq vip-emacs-local-map (current-local-map) + vip-emacs-mode-line-buffer-identification + mode-line-buffer-identification + vip-insert-local-map (vip-copy-keymap + (current-local-map))) + (setq vip-insert-local-map (vip-copy-keymap + vip-emacs-local-map))) + (vip-change-mode-line "Insert") + (use-local-map vip-insert-local-map) + (define-key vip-insert-local-map "\e" 'vip-change-mode-to-vi) + (define-key vip-insert-local-map "\C-z" 'vip-ESC) + (define-key vip-insert-local-map "\C-h" + (if vip-help-in-insert-mode 'help-command + 'delete-backward-char)) + (define-key vip-insert-local-map "\C-w" + 'vip-delete-backward-word)) + ((eq new-mode 'emacs-mode) + (vip-change-mode-line "Emacs:") + (use-local-map vip-emacs-local-map))) + (setq vip-current-mode new-mode) + (force-mode-line-update)))) + +(defun vip-copy-region-as-kill (beg end) + "If BEG and END do not belong to the same buffer, it copies empty region." + (condition-case nil + (copy-region-as-kill beg end) + (error (copy-region-as-kill beg beg)))) + +(defun vip-change-mode-line (string) + "Assuming that the mode line format contains the string \"Emacs:\", this +function replaces the string by \"Vi: \" etc." + (setq mode-line-buffer-identification + (if (string= string "Emacs:") + vip-emacs-mode-line-buffer-identification + (list (concat string " %17b"))))) + +;;;###autoload +(defun vip-mode () + "Turn on VIP emulation of VI." + (interactive) + (if (not vip-inhibit-startup-message) + (progn + (switch-to-buffer "VIP Startup Message") + (erase-buffer) + (insert + "VIP is a Vi emulation package for GNU Emacs. VIP provides most Vi commands +including Ex commands. VIP is however different from Vi in several points. +You can get more information on VIP by: + 1. Typing `M-x info' and selecting menu item \"vip\". + 2. Typing `C-h k' followed by a key whose description you want. + 3. Printing VIP manual which can be found as GNU/man/vip.texinfo + 4. Printing VIP Reference Card which can be found as GNU/etc/vipcard.tex + +This startup message appears whenever you load VIP unless you type `y' now. +Type `n' to quit this window for now.\n") + (goto-char (point-min)) + (if (y-or-n-p "Inhibit VIP startup message? ") + (progn + (with-current-buffer + (find-file-noselect + (substitute-in-file-name vip-startup-file)) + (goto-char (point-max)) + (insert "\n(setq vip-inhibit-startup-message t)\n") + (save-buffer) + (kill-buffer (current-buffer))) + (message "VIP startup message inhibited.") + (sit-for 2))) + (kill-buffer (current-buffer)) + (message "") + (setq vip-inhibit-startup-message t))) + (vip-change-mode-to-vi)) + +(defun vip-change-mode-to-vi () + "Change mode to vi mode." + (interactive) + (vip-change-mode 'vi-mode)) + +(defun vip-change-mode-to-insert () + "Change mode to insert mode." + (interactive) + (vip-change-mode 'insert-mode)) + +(defun vip-change-mode-to-emacs () + "Change mode to Emacs mode." + (interactive) + (vip-change-mode 'emacs-mode)) + + +;; escape to emacs mode temporarily + +(defun vip-escape-to-emacs (arg &optional events) + "Escape to Emacs mode for one Emacs command. +ARG is used as the prefix value for the executed command. If +EVENTS is a list of events, which become the beginning of the command." + (interactive "P") + (let (com key (old-map (current-local-map))) + (if events (setq unread-command-events events)) + (setq prefix-arg arg) + (use-local-map vip-emacs-local-map) + (unwind-protect + (setq com (key-binding (setq key (read-key-sequence nil)))) + (use-local-map old-map)) + (command-execute com prefix-arg) + (setq prefix-arg nil) ;; reset prefix arg + )) + +(defun vip-message-conditions (conditions) + "Print CONDITIONS as a message." + (let ((case (car conditions)) (msg (cdr conditions))) + (if (null msg) + (message "%s" case) + (message "%s %s" case (prin1-to-string msg))) + (ding))) + +(defun vip-ESC (arg) + "Emulate ESC key in Emacs mode." + (interactive "P") + (vip-escape-to-emacs arg '(?\e))) + +(defun vip-ctl-c (arg) + "Emulate C-c key in Emacs mode." + (interactive "P") + (vip-escape-to-emacs arg '(?\C-c))) + +(defun vip-ctl-x (arg) + "Emulate C-x key in Emacs mode." + (interactive "P") + (vip-escape-to-emacs arg '(?\C-x))) + +(defun vip-ctl-h (arg) + "Emulate C-h key in Emacs mode." + (interactive "P") + (vip-escape-to-emacs arg '(?\C-h))) + + +;; prefix argument for vi mode + +;; In vi mode, prefix argument is a dotted pair (NUM . COM) where NUM +;; represents the numeric value of the prefix argument and COM represents +;; command prefix such as "c", "d", "m" and "y". + +(defun vip-prefix-arg-value (char value com) + "Compute numeric prefix arg value. Invoked by CHAR. VALUE is the value +obtained so far, and COM is the command part obtained so far." + (while (and (>= char ?0) (<= char ?9)) + (setq value (+ (* (if (numberp value) value 0) 10) (- char ?0))) + (setq char (read-char))) + (setq prefix-arg value) + (if com (setq prefix-arg (cons prefix-arg com))) + (while (= char ?U) + (vip-describe-arg prefix-arg) + (setq char (read-char))) + (setq unread-command-events (list char))) + +(defun vip-prefix-arg-com (char value com) + "Vi operator as prefix argument." + (let ((cont t)) + (while (and cont + (or (= char ?c) (= char ?d) (= char ?y) + (= char ?!) (= char ?<) (= char ?>) (= char ?=) + (= char ?#) (= char ?r) (= char ?R) (= char ?\"))) + (if com + ;; this means that we already have a command character, so we + ;; construct a com list and exit while. however, if char is " + ;; it is an error. + (progn + ;; new com is (CHAR . OLDCOM) + (if (or (= char ?#) (= char ?\")) (error "")) + (setq com (cons char com)) + (setq cont nil)) + ;; if com is nil we set com as char, and read more. again, if char + ;; is ", we read the name of register and store it in vip-use-register. + ;; if char is !, =, or #, a complete com is formed so we exit while. + (cond ((or (= char ?!) (= char ?=)) + (setq com char) + (setq char (read-char)) + (setq cont nil)) + ((= char ?#) + ;; read a char and encode it as com + (setq com (+ 128 (read-char))) + (setq char (read-char)) + (setq cont nil)) + ((or (= char ?<) (= char ?>)) + (setq com char) + (setq char (read-char)) + (if (= com char) (setq com (cons char com))) + (setq cont nil)) + ((= char ?\") + (let ((reg (read-char))) + (if (or (and (<= ?A reg) (<= reg ?z)) + (and (<= ?1 reg) (<= reg ?9))) + (setq vip-use-register reg) + (error "")) + (setq char (read-char)))) + (t + (setq com char) + (setq char (read-char))))))) + (if (atom com) + ;; com is a single char, so we construct prefix-arg + ;; and if char is ?, describe prefix arg, otherwise exit by + ;; pushing the char back + (progn + (setq prefix-arg (cons value com)) + (while (= char ?U) + (vip-describe-arg prefix-arg) + (setq char (read-char))) + (setq unread-command-events (list char))) + ;; as com is non-nil, this means that we have a command to execute + (if (or (= (car com) ?r) (= (car com) ?R)) + ;; execute appropriate region command. + (let ((char (car com)) (com (cdr com))) + (setq prefix-arg (cons value com)) + (if (= char ?r) (vip-region prefix-arg) + (vip-Region prefix-arg)) + ;; reset prefix-arg + (setq prefix-arg nil)) + ;; otherwise, reset prefix arg and call appropriate command + (setq value (if (null value) 1 value)) + (setq prefix-arg nil) + (cond ((equal com '(?c . ?c)) (vip-line (cons value ?C))) + ((equal com '(?d . ?d)) (vip-line (cons value ?D))) + ((equal com '(?d . ?y)) (vip-yank-defun)) + ((equal com '(?y . ?y)) (vip-line (cons value ?Y))) + ((equal com '(?< . ?<)) (vip-line (cons value ?<))) + ((equal com '(?> . ?>)) (vip-line (cons value ?>))) + ((equal com '(?! . ?!)) (vip-line (cons value ?!))) + ((equal com '(?= . ?=)) (vip-line (cons value ?=))) + (t (error "")))))) + +(defun vip-describe-arg (arg) + (let (val com) + (setq val (vip-P-val arg) + com (vip-getcom arg)) + (if (null val) + (if (null com) + (message "Value is nil, and command is nil.") + (message "Value is nil, and command is %c." com)) + (if (null com) + (message "Value is %d, and command is nil." val) + (message "Value is %d, and command is %c." val com))))) + +(defun vip-digit-argument (arg) + "Begin numeric argument for the next command." + (interactive "P") + (vip-prefix-arg-value last-command-event nil + (if (consp arg) (cdr arg) nil))) + +(defun vip-command-argument (arg) + "Accept a motion command as an argument." + (interactive "P") + (condition-case conditions + (vip-prefix-arg-com + last-command-event + (cond ((null arg) nil) + ((consp arg) (car arg)) + ((numberp arg) arg) + (t (error "strange arg"))) + (cond ((null arg) nil) + ((consp arg) (cdr arg)) + ((numberp arg) nil) + (t (error "strange arg")))) + (quit + (setq vip-use-register nil) + (signal 'quit nil)))) + +(defun vip-p-val (arg) + "Get value part of prefix-argument ARG." + (cond ((null arg) 1) + ((consp arg) (if (null (car arg)) 1 (car arg))) + (t arg))) + +(defun vip-P-val (arg) + "Get value part of prefix-argument ARG." + (cond ((consp arg) (car arg)) + (t arg))) + +(defun vip-getcom (arg) + "Get com part of prefix-argument ARG." + (cond ((null arg) nil) + ((consp arg) (cdr arg)) + (t nil))) + +(defun vip-getCom (arg) + "Get com part of prefix-argument ARG and modify it." + (let ((com (vip-getcom arg))) + (cond ((equal com ?c) ?C) + ((equal com ?d) ?D) + ((equal com ?y) ?Y) + (t com)))) + + +;; repeat last destructive command + +(defun vip-append-to-register (reg start end) + "Append region to text in register REG. +START and END are buffer positions indicating what to append." + (set-register reg (concat (or (get-register reg) "") + (buffer-substring start end)))) + +(defun vip-execute-com (m-com val com) + "(M-COM VAL COM) Execute command COM. The list (M-COM VAL COM) is set +to vip-d-com for later use by vip-repeat" + (let ((reg vip-use-register)) + (if com + (cond ((= com ?c) (vip-change vip-com-point (point))) + ((= com (- ?c)) (vip-change-subr vip-com-point (point))) + ((or (= com ?C) (= com (- ?C))) + (save-excursion + (set-mark vip-com-point) + (vip-enlarge-region (mark) (point)) + (if vip-use-register + (progn + (cond ((and (<= ?a vip-use-register) + (<= vip-use-register ?z)) + (copy-to-register + vip-use-register (mark) (point) nil)) + ((and (<= ?A vip-use-register) + (<= vip-use-register ?Z)) + (vip-append-to-register + (+ vip-use-register 32) (mark) (point))) + (t (setq vip-use-register nil) + (error ""))) + (setq vip-use-register nil))) + (delete-region (mark) (point))) + (open-line 1) + (if (= com ?C) (vip-change-mode-to-insert) (yank))) + ((= com ?d) + (if vip-use-register + (progn + (cond ((and (<= ?a vip-use-register) + (<= vip-use-register ?z)) + (copy-to-register + vip-use-register vip-com-point (point) nil)) + ((and (<= ?A vip-use-register) + (<= vip-use-register ?Z)) + (vip-append-to-register + (+ vip-use-register 32) vip-com-point (point))) + (t (setq vip-use-register nil) + (error ""))) + (setq vip-use-register nil))) + (setq last-command + (if (eq last-command 'd-command) 'kill-region nil)) + (kill-region vip-com-point (point)) + (setq this-command 'd-command)) + ((= com ?D) + (save-excursion + (set-mark vip-com-point) + (vip-enlarge-region (mark) (point)) + (if vip-use-register + (progn + (cond ((and (<= ?a vip-use-register) + (<= vip-use-register ?z)) + (copy-to-register + vip-use-register (mark) (point) nil)) + ((and (<= ?A vip-use-register) + (<= vip-use-register ?Z)) + (vip-append-to-register + (+ vip-use-register 32) (mark) (point))) + (t (setq vip-use-register nil) + (error ""))) + (setq vip-use-register nil))) + (setq last-command + (if (eq last-command 'D-command) 'kill-region nil)) + (kill-region (mark) (point)) + (if (eq m-com 'vip-line) (setq this-command 'D-command))) + (back-to-indentation)) + ((= com ?y) + (if vip-use-register + (progn + (cond ((and (<= ?a vip-use-register) + (<= vip-use-register ?z)) + (copy-to-register + vip-use-register vip-com-point (point) nil)) + ((and (<= ?A vip-use-register) + (<= vip-use-register ?Z)) + (vip-append-to-register + (+ vip-use-register 32) vip-com-point (point))) + (t (setq vip-use-register nil) + (error ""))) + (setq vip-use-register nil))) + (setq last-command nil) + (copy-region-as-kill vip-com-point (point)) + (goto-char vip-com-point)) + ((= com ?Y) + (save-excursion + (set-mark vip-com-point) + (vip-enlarge-region (mark) (point)) + (if vip-use-register + (progn + (cond ((and (<= ?a vip-use-register) + (<= vip-use-register ?z)) + (copy-to-register + vip-use-register (mark) (point) nil)) + ((and (<= ?A vip-use-register) + (<= vip-use-register ?Z)) + (vip-append-to-register + (+ vip-use-register 32) (mark) (point))) + (t (setq vip-use-register nil) + (error ""))) + (setq vip-use-register nil))) + (setq last-command nil) + (copy-region-as-kill (mark) (point))) + (goto-char vip-com-point)) + ((or (= com ?!) (= com (- ?!))) + (save-excursion + (set-mark vip-com-point) + (vip-enlarge-region (mark) (point)) + (shell-command-on-region + (mark) (point) + (if (= com ?!) + (setq vip-last-shell-com (vip-read-string "!")) + vip-last-shell-com) + t t))) + ((= com ?=) + (save-excursion + (set-mark vip-com-point) + (vip-enlarge-region (mark) (point)) + (if (> (mark) (point)) (exchange-point-and-mark)) + (indent-region (mark) (point) nil))) + ((= com ?<) + (save-excursion + (set-mark vip-com-point) + (vip-enlarge-region (mark) (point)) + (indent-rigidly (mark) (point) (- vip-shift-width))) + (goto-char vip-com-point)) + ((= com ?>) + (save-excursion + (set-mark vip-com-point) + (vip-enlarge-region (mark) (point)) + (indent-rigidly (mark) (point) vip-shift-width)) + (goto-char vip-com-point)) + ((>= com 128) + ;; this is special command # + (vip-special-prefix-com (- com 128))))) + (setq vip-d-com (list m-com val (if (or (= com ?c) (= com ?C) (= com ?!)) + (- com) com) + reg)))) + +(defun vip-repeat (arg) + "(ARG) Re-execute last destructive command. vip-d-com has the form +\(COM ARG CH REG), where COM is the command to be re-executed, ARG is the +argument for COM, CH is a flag for repeat, and REG is optional and if exists +is the name of the register for COM." + (interactive "P") + (if (eq last-command 'vip-undo) + ;; if the last command was vip-undo, then undo-more + (vip-undo-more) + ;; otherwise execute the command stored in vip-d-com. if arg is non-nil + ;; its prefix value is used as new prefix value for the command. + (let ((m-com (car vip-d-com)) + (val (vip-P-val arg)) + (com (car (cdr (cdr vip-d-com)))) + (reg (nth 3 vip-d-com))) + (if (null val) (setq val (car (cdr vip-d-com)))) + (if (null m-com) (error "No previous command to repeat")) + (setq vip-use-register reg) + (funcall m-com (cons val com))))) + +(defun vip-special-prefix-com (char) + "This command is invoked interactively by the key sequence #" + (cond ((= char ?c) + (downcase-region (min vip-com-point (point)) + (max vip-com-point (point)))) + ((= char ?C) + (upcase-region (min vip-com-point (point)) + (max vip-com-point (point)))) + ((= char ?g) + (set-mark vip-com-point) + (vip-global-execute)) + ((= char ?q) + (set-mark vip-com-point) + (vip-quote-region)) + ((= char ?s) (ispell-region vip-com-point (point))))) + + +;; undoing + +(defun vip-undo () + "Undo previous change." + (interactive) + (message "undo!") + (undo-start) + (undo-more 2) + (setq this-command 'vip-undo)) + +(defun vip-undo-more () + "Continue undoing previous changes." + (message "undo more!") + (undo-more 1) + (setq this-command 'vip-undo)) + + +;; utilities + +(defun vip-string-tail (str) + (if (or (null str) (string= str "")) nil + (substring str 1))) + +(defun vip-yank-defun () + (mark-defun) + (copy-region-as-kill (point) (mark))) + +(defun vip-enlarge-region (beg end) + "Enlarge region between BEG and END." + (if (< beg end) + (progn (goto-char beg) (set-mark end)) + (goto-char end) + (set-mark beg)) + (beginning-of-line) + (exchange-point-and-mark) + (if (or (not (eobp)) (not (bolp))) (with-no-warnings (next-line 1))) + (beginning-of-line) + (if (> beg end) (exchange-point-and-mark))) + +(defun vip-global-execute () + "Call last keyboard macro for each line in the region." + (if (> (point) (mark)) (exchange-point-and-mark)) + (beginning-of-line) + (call-last-kbd-macro) + (while (< (point) (mark)) + (forward-line 1) + (beginning-of-line) + (call-last-kbd-macro))) + +(defun vip-quote-region () + "Quote region by inserting the user supplied string at the beginning of +each line in the region." + (setq vip-quote-string + (let ((str + (vip-read-string (format "quote string (default %s): " + vip-quote-string)))) + (if (string= str "") vip-quote-string str))) + (vip-enlarge-region (point) (mark)) + (if (> (point) (mark)) (exchange-point-and-mark)) + (insert vip-quote-string) + (beginning-of-line) + (forward-line 1) + (while (and (< (point) (mark)) (bolp)) + (insert vip-quote-string) + (beginning-of-line) + (forward-line 1))) + +(defun vip-end-with-a-newline-p (string) + "Check if the string ends with a newline." + (or (string= string "") + (= (aref string (1- (length string))) ?\n))) + +(defvar vip-save-minibuffer-local-map) + +(defun vip-read-string (prompt &optional init) + (setq vip-save-minibuffer-local-map (copy-keymap minibuffer-local-map)) + (define-key minibuffer-local-map "\C-h" 'backward-char) + (define-key minibuffer-local-map "\C-w" 'backward-word) + (define-key minibuffer-local-map "\e" 'exit-minibuffer) + (let (str) + (condition-case conditions + (setq str (read-string prompt init)) + (quit + (setq minibuffer-local-map vip-save-minibuffer-local-map) + (signal 'quit nil))) + (setq minibuffer-local-map vip-save-minibuffer-local-map) + str)) + + +;; insertion commands + +(defun vip-repeat-insert-command () + "This function is called when mode changes from insertion mode to +vi command mode. It will repeat the insertion command if original insertion +command was invoked with argument > 1." + (let ((i-com (car vip-d-com)) (val (car (cdr vip-d-com)))) + (if (and val (> val 1)) ;; first check that val is non-nil + (progn + (setq vip-d-com (list i-com (1- val) ?r)) + (vip-repeat nil) + (setq vip-d-com (list i-com val ?r)))))) + +(defun vip-insert (arg) "" + (interactive "P") + (let ((val (vip-p-val arg)) (com (vip-getcom arg))) + (setq vip-d-com (list 'vip-insert val ?r)) + (if com (vip-loop val (yank)) + (vip-change-mode-to-insert)))) + +(defun vip-append (arg) + "Append after point." + (interactive "P") + (let ((val (vip-p-val arg)) (com (vip-getcom arg))) + (setq vip-d-com (list 'vip-append val ?r)) + (if (not (eolp)) (forward-char)) + (if (equal com ?r) + (vip-loop val (yank)) + (vip-change-mode-to-insert)))) + +(defun vip-Append (arg) + "Append at end of line." + (interactive "P") + (let ((val (vip-p-val arg)) (com (vip-getcom arg))) + (setq vip-d-com (list 'vip-Append val ?r)) + (end-of-line) + (if (equal com ?r) + (vip-loop val (yank)) + (vip-change-mode-to-insert)))) + +(defun vip-Insert (arg) + "Insert before first non-white." + (interactive "P") + (let ((val (vip-p-val arg)) (com (vip-getcom arg))) + (setq vip-d-com (list 'vip-Insert val ?r)) + (back-to-indentation) + (if (equal com ?r) + (vip-loop val (yank)) + (vip-change-mode-to-insert)))) + +(defun vip-open-line (arg) + "Open line below." + (interactive "P") + (let ((val (vip-p-val arg)) (com (vip-getcom arg))) + (setq vip-d-com (list 'vip-open-line val ?r)) + (let ((col (current-indentation))) + (if (equal com ?r) + (vip-loop val + (progn + (end-of-line) + (newline 1) + (if vip-open-with-indent (indent-to col)) + (yank))) + (end-of-line) + (newline 1) + (if vip-open-with-indent (indent-to col)) + (vip-change-mode-to-insert))))) + +(defun vip-Open-line (arg) + "Open line above." + (interactive "P") + (let ((val (vip-p-val arg)) (com (vip-getcom arg))) + (setq vip-d-com (list 'vip-Open-line val ?r)) + (let ((col (current-indentation))) + (if (equal com ?r) + (vip-loop val + (progn + (beginning-of-line) + (open-line 1) + (if vip-open-with-indent (indent-to col)) + (yank))) + (beginning-of-line) + (open-line 1) + (if vip-open-with-indent (indent-to col)) + (vip-change-mode-to-insert))))) + +(defun vip-open-line-at-point (arg) + "Open line at point." + (interactive "P") + (let ((val (vip-p-val arg)) (com (vip-getcom arg))) + (setq vip-d-com (list 'vip-open-line-at-point val ?r)) + (if (equal com ?r) + (vip-loop val + (progn + (open-line 1) + (yank))) + (open-line 1) + (vip-change-mode-to-insert)))) + +(defun vip-substitute (arg) + "Substitute characters." + (interactive "P") + (let ((val (vip-p-val arg)) (com (vip-getcom arg))) + (save-excursion + (set-mark (point)) + (forward-char val) + (if (equal com ?r) + (vip-change-subr (mark) (point)) + (vip-change (mark) (point)))) + (setq vip-d-com (list 'vip-substitute val ?r)))) + +(defun vip-substitute-line (arg) + "Substitute lines." + (interactive "p") + (vip-line (cons arg ?C))) + + +;; line command + +(defun vip-line (arg) + (let ((val (car arg)) (com (cdr arg))) + (move-marker vip-com-point (point)) + (with-no-warnings (next-line (1- val))) + (vip-execute-com 'vip-line val com))) + +(defun vip-yank-line (arg) + "Yank ARG lines (in vi's sense)" + (interactive "P") + (let ((val (vip-p-val arg))) + (vip-line (cons val ?Y)))) + + +;; region command + +(defun vip-region (arg) + (interactive "P") + (let ((val (vip-P-val arg)) + (com (vip-getcom arg))) + (move-marker vip-com-point (point)) + (exchange-point-and-mark) + (vip-execute-com 'vip-region val com))) + +(defun vip-Region (arg) + (interactive "P") + (let ((val (vip-P-val arg)) + (com (vip-getCom arg))) + (move-marker vip-com-point (point)) + (exchange-point-and-mark) + (vip-execute-com 'vip-Region val com))) + +(defun vip-replace-char (arg) + "Replace the following ARG chars by the character read." + (interactive "P") + (let ((val (vip-p-val arg)) (com (vip-getcom arg))) + (setq vip-d-com (list 'vip-replace-char val ?r)) + (vip-replace-char-subr (if (equal com ?r) vip-d-char (read-char)) val))) + +(defun vip-replace-char-subr (char arg) + (delete-char arg t) + (setq vip-d-char char) + (vip-loop (if (> arg 0) arg (- arg)) (insert char)) + (backward-char arg)) + +(defun vip-replace-string () + "Replace string. If you supply null string as the string to be replaced, +the query replace mode will toggle between string replace and regexp replace." + (interactive) + (let (str) + (setq str (vip-read-string + (if vip-re-replace "Replace regexp: " "Replace string: "))) + (if (string= str "") + (progn + (setq vip-re-replace (not vip-re-replace)) + (message "Replace mode changed to %s." + (if vip-re-replace "regexp replace" + "string replace"))) + (if vip-re-replace + ;; (replace-regexp + ;; str + ;; (vip-read-string (format "Replace regexp \"%s\" with: " str))) + (while (re-search-forward str nil t) + (replace-match (vip-read-string + (format "Replace regexp \"%s\" with: " str)) + nil nil)) + (with-no-warnings + (replace-string + str + (vip-read-string (format "Replace \"%s\" with: " str)))))))) + + +;; basic cursor movement. j, k, l, m commands. + +(defun vip-forward-char (arg) + "Move point right ARG characters (left if ARG negative).On reaching end +of buffer, stop and signal error." + (interactive "P") + (let ((val (vip-p-val arg)) (com (vip-getcom arg))) + (if com (move-marker vip-com-point (point))) + (forward-char val) + (if com (vip-execute-com 'vip-forward-char val com)))) + +(defun vip-backward-char (arg) + "Move point left ARG characters (right if ARG negative). On reaching +beginning of buffer, stop and signal error." + (interactive "P") + (let ((val (vip-p-val arg)) (com (vip-getcom arg))) + (if com (move-marker vip-com-point (point))) + (backward-char val) + (if com (vip-execute-com 'vip-backward-char val com)))) + + +;; word command + +(defun vip-forward-word (arg) + "Forward word." + (interactive "P") + (let ((val (vip-p-val arg)) + (com (vip-getcom arg))) + (if com (move-marker vip-com-point (point))) + (forward-word val) + (skip-chars-forward " \t\n") + (if com + (progn + (if (or (= com ?c) (= com (- ?c))) + (progn (backward-word 1) (forward-word 1))) + (if (or (= com ?d) (= com ?y)) + (progn + (backward-word 1) + (forward-word 1) + (skip-chars-forward " \t"))) + (vip-execute-com 'vip-forward-word val com))))) + +(defun vip-end-of-word (arg) + "Move point to end of current word." + (interactive "P") + (let ((val (vip-p-val arg)) + (com (vip-getcom arg))) + (if com (move-marker vip-com-point (point))) + (forward-char) + (forward-word val) + (backward-char) + (if com + (progn + (forward-char) + (vip-execute-com 'vip-end-of-word val com))))) + +(defun vip-backward-word (arg) + "Backward word." + (interactive "P") + (let ((val (vip-p-val arg)) + (com (vip-getcom arg))) + (if com (move-marker vip-com-point (point))) + (backward-word val) + (if com (vip-execute-com 'vip-backward-word val com)))) + +(defun vip-forward-Word (arg) + "Forward word delimited by white character." + (interactive "P") + (let ((val (vip-p-val arg)) + (com (vip-getcom arg))) + (if com (move-marker vip-com-point (point))) + (re-search-forward "[^ \t\n]*[ \t\n]+" nil t val) + (if com + (progn + (if (or (= com ?c) (= com (- ?c))) + (progn (backward-word 1) (forward-word 1))) + (if (or (= com ?d) (= com ?y)) + (progn + (backward-word 1) + (forward-word 1) + (skip-chars-forward " \t"))) + (vip-execute-com 'vip-forward-Word val com))))) + +(defun vip-end-of-Word (arg) + "Move forward to end of word delimited by white character." + (interactive "P") + (let ((val (vip-p-val arg)) + (com (vip-getcom arg))) + (if com (move-marker vip-com-point (point))) + (forward-char) + (if (re-search-forward "[^ \t\n]+" nil t val) (backward-char)) + (if com + (progn + (forward-char) + (vip-execute-com 'vip-end-of-Word val com))))) + +(defun vip-backward-Word (arg) + "Backward word delimited by white character." + (interactive "P") + (let ((val (vip-p-val arg)) + (com (vip-getcom arg))) + (if com (move-marker vip-com-point (point))) + (if (re-search-backward "[ \t\n]+[^ \t\n]+" nil t val) + (forward-char) + (goto-char (point-min))) + (if com (vip-execute-com 'vip-backward-Word val com)))) + +(defun vip-beginning-of-line (arg) + "Go to beginning of line." + (interactive "P") + (let ((val (vip-p-val arg)) (com (vip-getcom arg))) + (if com (move-marker vip-com-point (point))) + (beginning-of-line val) + (if com (vip-execute-com 'vip-beginning-of-line val com)))) + +(defun vip-bol-and-skip-white (arg) + "Beginning of line at first non-white character." + (interactive "P") + (let ((val (vip-p-val arg)) (com (vip-getcom arg))) + (if com (move-marker vip-com-point (point))) + (back-to-indentation) + (if com (vip-execute-com 'vip-bol-and-skip-white val com)))) + +(defun vip-goto-eol (arg) + "Go to end of line." + (interactive "P") + (let ((val (vip-p-val arg)) (com (vip-getcom arg))) + (if com (move-marker vip-com-point (point))) + (end-of-line val) + (if com (vip-execute-com 'vip-goto-eol val com)))) + +(defun vip-next-line (arg) + "Go to next line." + (interactive "P") + (let ((val (vip-p-val arg)) (com (vip-getCom arg))) + (if com (move-marker vip-com-point (point))) + (line-move val) + (setq this-command 'next-line) + (if com (vip-execute-com 'vip-next-line val com)))) + +(defun vip-next-line-at-bol (arg) + "Next line at beginning of line." + (interactive "P") + (let ((val (vip-p-val arg)) (com (vip-getCom arg))) + (if com (move-marker vip-com-point (point))) + (with-no-warnings (next-line val)) + (back-to-indentation) + (if com (vip-execute-com 'vip-next-line-at-bol val com)))) + +(defun vip-previous-line (arg) + "Go to previous line." + (interactive "P") + (let ((val (vip-p-val arg)) (com (vip-getCom arg))) + (if com (move-marker vip-com-point (point))) + (with-no-warnings (next-line (- val))) + (setq this-command 'previous-line) + (if com (vip-execute-com 'vip-previous-line val com)))) + +(defun vip-previous-line-at-bol (arg) + "Previous line at beginning of line." + (interactive "P") + (let ((val (vip-p-val arg)) (com (vip-getCom arg))) + (if com (move-marker vip-com-point (point))) + (with-no-warnings (next-line (- val))) + (back-to-indentation) + (if com (vip-execute-com 'vip-previous-line val com)))) + +(defun vip-change-to-eol (arg) + "Change to end of line." + (interactive "P") + (vip-goto-eol (cons arg ?c))) + +(defun vip-kill-line (arg) + "Delete line." + (interactive "P") + (vip-goto-eol (cons arg ?d))) + + +;; moving around + +(defun vip-goto-line (arg) + "Go to ARG's line. Without ARG go to end of buffer." + (interactive "P") + (let ((val (vip-P-val arg)) (com (vip-getCom arg))) + (move-marker vip-com-point (point)) + (set-mark (point)) + (if (null val) + (goto-char (point-max)) + (goto-char (point-min)) + (forward-line (1- val))) + (back-to-indentation) + (if com (vip-execute-com 'vip-goto-line val com)))) + +(defun vip-find-char (arg char forward offset) + "Find ARG's occurrence of CHAR on the current line. If FORWARD then +search is forward, otherwise backward. OFFSET is used to adjust point +after search." + (let ((arg (if forward arg (- arg))) point) + (save-excursion + (save-restriction + (if (> arg 0) + (narrow-to-region + ;; forward search begins here + (if (eolp) (error "") (point)) + ;; forward search ends here + (progn (with-no-warnings (next-line 1)) (beginning-of-line) (point))) + (narrow-to-region + ;; backward search begins from here + (if (bolp) (error "") (point)) + ;; backward search ends here + (progn (beginning-of-line) (point)))) + ;; if arg > 0, point is forwarded before search. + (if (> arg 0) (goto-char (1+ (point-min))) + (goto-char (point-max))) + (let ((case-fold-search nil)) + (search-forward (char-to-string char) nil 0 arg)) + (setq point (point)) + (if (or (and (> arg 0) (= point (point-max))) + (and (< arg 0) (= point (point-min)))) + (error "")))) + (goto-char (+ point (if (> arg 0) (if offset -2 -1) (if offset 1 0)))))) + +(defun vip-find-char-forward (arg) + "Find char on the line. If called interactively read the char to find +from the terminal, and if called from vip-repeat, the char last used is +used. This behavior is controlled by the sign of prefix numeric value." + (interactive "P") + (let ((val (vip-p-val arg)) (com (vip-getcom arg))) + (if (> val 0) + ;; this means that the function was called interactively + (setq vip-f-char (read-char) + vip-f-forward t + vip-f-offset nil) + (setq val (- val))) + (if com (move-marker vip-com-point (point))) + (vip-find-char val (if (> (vip-p-val arg) 0) vip-f-char vip-F-char) t nil) + (setq val (- val)) + (if com + (progn + (setq vip-F-char vip-f-char);; set new vip-F-char + (forward-char) + (vip-execute-com 'vip-find-char-forward val com))))) + +(defun vip-goto-char-forward (arg) + "Go up to char ARG forward on line." + (interactive "P") + (let ((val (vip-p-val arg)) (com (vip-getcom arg))) + (if (> val 0) + ;; this means that the function was called interactively + (setq vip-f-char (read-char) + vip-f-forward t + vip-f-offset t) + (setq val (- val))) + (if com (move-marker vip-com-point (point))) + (vip-find-char val (if (> (vip-p-val arg) 0) vip-f-char vip-F-char) t t) + (setq val (- val)) + (if com + (progn + (setq vip-F-char vip-f-char);; set new vip-F-char + (forward-char) + (vip-execute-com 'vip-goto-char-forward val com))))) + +(defun vip-find-char-backward (arg) + "Find char ARG on line backward." + (interactive "P") + (let ((val (vip-p-val arg)) (com (vip-getcom arg))) + (if (> val 0) + ;; this means that the function was called interactively + (setq vip-f-char (read-char) + vip-f-forward nil + vip-f-offset nil) + (setq val (- val))) + (if com (move-marker vip-com-point (point))) + (vip-find-char + val (if (> (vip-p-val arg) 0) vip-f-char vip-F-char) nil nil) + (setq val (- val)) + (if com + (progn + (setq vip-F-char vip-f-char);; set new vip-F-char + (vip-execute-com 'vip-find-char-backward val com))))) + +(defun vip-goto-char-backward (arg) + "Go up to char ARG backward on line." + (interactive "P") + (let ((val (vip-p-val arg)) (com (vip-getcom arg))) + (if (> val 0) + ;; this means that the function was called interactively + (setq vip-f-char (read-char) + vip-f-forward nil + vip-f-offset t) + (setq val (- val))) + (if com (move-marker vip-com-point (point))) + (vip-find-char val (if (> (vip-p-val arg) 0) vip-f-char vip-F-char) nil t) + (setq val (- val)) + (if com + (progn + (setq vip-F-char vip-f-char);; set new vip-F-char + (vip-execute-com 'vip-goto-char-backward val com))))) + +(defun vip-repeat-find (arg) + "Repeat previous find command." + (interactive "P") + (let ((val (vip-p-val arg)) (com (vip-getcom arg))) + (if com (move-marker vip-com-point (point))) + (vip-find-char val vip-f-char vip-f-forward vip-f-offset) + (if com + (progn + (if vip-f-forward (forward-char)) + (vip-execute-com 'vip-repeat-find val com))))) + +(defun vip-repeat-find-opposite (arg) + "Repeat previous find command in the opposite direction." + (interactive "P") + (let ((val (vip-p-val arg)) (com (vip-getcom arg))) + (if com (move-marker vip-com-point (point))) + (vip-find-char val vip-f-char (not vip-f-forward) vip-f-offset) + (if com + (progn + (if vip-f-forward (forward-char)) + (vip-execute-com 'vip-repeat-find-opposite val com))))) + + +;; window scrolling etc. + +(defun vip-other-window (arg) + "Switch to other window." + (interactive "p") + (other-window arg) + (or (not (eq vip-current-mode 'emacs-mode)) + (string= (buffer-name (current-buffer)) " *Minibuf-1*") + (vip-change-mode-to-vi))) + +(defun vip-window-top (arg) + "Go to home window line." + (interactive "P") + (let ((val (vip-p-val arg)) + (com (vip-getCom arg))) + (if com (move-marker vip-com-point (point))) + (move-to-window-line (1- val)) + (if com (vip-execute-com 'vip-window-top val com)))) + +(defun vip-window-middle (arg) + "Go to middle window line." + (interactive "P") + (let ((val (vip-p-val arg)) + (com (vip-getCom arg))) + (if com (move-marker vip-com-point (point))) + (move-to-window-line (+ (/ (1- (window-height)) 2) (1- val))) + (if com (vip-execute-com 'vip-window-middle val com)))) + +(defun vip-window-bottom (arg) + "Go to last window line." + (interactive "P") + (let ((val (vip-p-val arg)) + (com (vip-getCom arg))) + (if com (move-marker vip-com-point (point))) + (move-to-window-line (- val)) + (if com (vip-execute-com 'vip-window-bottom val com)))) + +(defun vip-line-to-top (arg) + "Put current line on the home line." + (interactive "p") + (recenter (1- arg))) + +(defun vip-line-to-middle (arg) + "Put current line on the middle line." + (interactive "p") + (recenter (+ (1- arg) (/ (1- (window-height)) 2)))) + +(defun vip-line-to-bottom (arg) + "Put current line on the last line." + (interactive "p") + (recenter (- (window-height) (1+ arg)))) + + +;; paren match + +(defun vip-paren-match (arg) + "Go to the matching parenthesis." + (interactive "P") + (let ((com (vip-getcom arg))) + (if (numberp arg) + (if (or (> arg 99) (< arg 1)) + (error "Prefix must be between 1 and 99") + (goto-char + (if (> (point-max) 80000) + (* (/ (point-max) 100) arg) + (/ (* (point-max) arg) 100))) + (back-to-indentation)) + (cond ((looking-at "[\(\[{]") + (if com (move-marker vip-com-point (point))) + (forward-sexp 1) + (if com + (vip-execute-com 'vip-paren-match nil com) + (backward-char))) + ((looking-at "[])}]") + (forward-char) + (if com (move-marker vip-com-point (point))) + (backward-sexp 1) + (if com (vip-execute-com 'vip-paren-match nil com))) + (t (error "")))))) + + +;; sentence and paragraph + +(defun vip-forward-sentence (arg) + "Forward sentence." + (interactive "P") + (let ((val (vip-p-val arg)) + (com (vip-getcom arg))) + (if com (move-marker vip-com-point (point))) + (forward-sentence val) + (if com (vip-execute-com 'vip-forward-sentence nil com)))) + +(defun vip-backward-sentence (arg) + "Backward sentence." + (interactive "P") + (let ((val (vip-p-val arg)) + (com (vip-getcom arg))) + (if com (move-marker vip-com-point (point))) + (backward-sentence val) + (if com (vip-execute-com 'vip-backward-sentence nil com)))) + +(defun vip-forward-paragraph (arg) + "Forward paragraph." + (interactive "P") + (let ((val (vip-p-val arg)) + (com (vip-getCom arg))) + (if com (move-marker vip-com-point (point))) + (forward-paragraph val) + (if com (vip-execute-com 'vip-forward-paragraph nil com)))) + +(defun vip-backward-paragraph (arg) + "Backward paragraph." + (interactive "P") + (let ((val (vip-p-val arg)) + (com (vip-getCom arg))) + (if com (move-marker vip-com-point (point))) + (backward-paragraph val) + (if com (vip-execute-com 'vip-backward-paragraph nil com)))) + + +;; scrolling + +(defun vip-scroll (arg) + "Scroll to next screen." + (interactive "p") + (if (> arg 0) + (while (> arg 0) + (scroll-up) + (setq arg (1- arg))) + (while (> 0 arg) + (scroll-down) + (setq arg (1+ arg))))) + +(defun vip-scroll-back (arg) + "Scroll to previous screen." + (interactive "p") + (vip-scroll (- arg))) + +(defun vip-scroll-down (arg) + "Scroll up half screen." + (interactive "P") + (if (null arg) (scroll-down (/ (window-height) 2)) + (scroll-down arg))) + +(defun vip-scroll-down-one (arg) + "Scroll up one line." + (interactive "p") + (scroll-down arg)) + +(defun vip-scroll-up (arg) + "Scroll down half screen." + (interactive "P") + (if (null arg) (scroll-up (/ (window-height) 2)) + (scroll-up arg))) + +(defun vip-scroll-up-one (arg) + "Scroll down one line." + (interactive "p") + (scroll-up arg)) + + +;; splitting window + +(defun vip-buffer-in-two-windows () + "Show current buffer in two windows." + (interactive) + (delete-other-windows) + (split-window-below)) + + +;; searching + +(defun vip-search-forward (arg) + "Search a string forward. ARG is used to find the ARG's occurrence +of the string. Default is vanilla search. Search mode can be toggled by +giving null search string." + (interactive "P") + (let ((val (vip-P-val arg)) (com (vip-getcom arg))) + (setq vip-s-forward t + vip-s-string (vip-read-string (if vip-re-search "RE-/" "/"))) + (if (string= vip-s-string "") + (progn + (setq vip-re-search (not vip-re-search)) + (message "Search mode changed to %s search." + (if vip-re-search "regular expression" + "vanilla"))) + (vip-search vip-s-string t val) + (if com + (progn + (move-marker vip-com-point (mark)) + (vip-execute-com 'vip-search-next val com)))))) + +(defun vip-search-backward (arg) + "Search a string backward. ARG is used to find the ARG's occurrence +of the string. Default is vanilla search. Search mode can be toggled by +giving null search string." + (interactive "P") + (let ((val (vip-P-val arg)) (com (vip-getcom arg))) + (setq vip-s-forward nil + vip-s-string (vip-read-string (if vip-re-search "RE-?" "?"))) + (if (string= vip-s-string "") + (progn + (setq vip-re-search (not vip-re-search)) + (message "Search mode changed to %s search." + (if vip-re-search "regular expression" + "vanilla"))) + (vip-search vip-s-string nil val) + (if com + (progn + (move-marker vip-com-point (mark)) + (vip-execute-com 'vip-search-next val com)))))) + +(defun vip-search (string forward arg &optional no-offset init-point) + "(STRING FORWARD COUNT &optional NO-OFFSET) Search COUNT's occurrence of +STRING. Search will be forward if FORWARD, otherwise backward." + (let ((val (vip-p-val arg)) (com (vip-getcom arg)) + (null-arg (null (vip-P-val arg))) (offset (not no-offset)) + (case-fold-search vip-case-fold-search) + (start-point (or init-point (point)))) + (if forward + (condition-case conditions + (progn + (if (and offset (not (eobp))) (forward-char)) + (if vip-re-search + (progn + (re-search-forward string nil nil val) + (re-search-backward string)) + (search-forward string nil nil val) + (search-backward string)) + (push-mark start-point)) + (search-failed + (if (and null-arg vip-search-wrap-around) + (progn + (goto-char (point-min)) + (vip-search string forward (cons 1 com) t start-point)) + (goto-char start-point) + (signal 'search-failed (cdr conditions))))) + (condition-case conditions + (progn + (if vip-re-search + (re-search-backward string nil nil val) + (search-backward string nil nil val)) + (push-mark start-point)) + (search-failed + (if (and null-arg vip-search-wrap-around) + (progn + (goto-char (point-max)) + (vip-search string forward (cons 1 com) t start-point)) + (goto-char start-point) + (signal 'search-failed (cdr conditions)))))))) + +(defun vip-search-next (arg) + "Repeat previous search." + (interactive "P") + (let ((val (vip-p-val arg)) (com (vip-getcom arg))) + (if (null vip-s-string) (error "No previous search string")) + (vip-search vip-s-string vip-s-forward arg) + (if com (vip-execute-com 'vip-search-next val com)))) + +(defun vip-search-Next (arg) + "Repeat previous search in the reverse direction." + (interactive "P") + (let ((val (vip-p-val arg)) (com (vip-getcom arg))) + (if (null vip-s-string) (error "No previous search string")) + (vip-search vip-s-string (not vip-s-forward) arg) + (if com (vip-execute-com 'vip-search-Next val com)))) + + +;; visiting and killing files, buffers + +(defun vip-switch-to-buffer () + "Switch to buffer in the current window." + (interactive) + (let (buffer) + (setq buffer + (read-buffer + (format "switch to buffer \(%s\): " + (buffer-name (other-buffer (current-buffer)))))) + (switch-to-buffer buffer) + (vip-change-mode-to-vi))) + +(defun vip-switch-to-buffer-other-window () + "Switch to buffer in another window." + (interactive) + (let (buffer) + (setq buffer + (read-buffer + (format "Switch to buffer \(%s\): " + (buffer-name (other-buffer (current-buffer)))))) + (switch-to-buffer-other-window buffer) + (vip-change-mode-to-vi))) + +(defun vip-kill-buffer () + "Kill a buffer." + (interactive) + (let (buffer buffer-name) + (setq buffer-name + (read-buffer + (format "Kill buffer \(%s\): " + (buffer-name (current-buffer))))) + (setq buffer + (if (null buffer-name) + (current-buffer) + (get-buffer buffer-name))) + (if (null buffer) (error "Buffer %s nonexistent" buffer-name)) + (if (or (not (buffer-modified-p buffer)) + (y-or-n-p "Buffer is modified, are you sure? ")) + (kill-buffer buffer) + (error "Buffer not killed")))) + +(defun vip-find-file () + "Visit file in the current window." + (interactive) + (let (file) + (setq file (read-file-name "visit file: ")) + (switch-to-buffer (find-file-noselect file)) + (vip-change-mode-to-vi))) + +(defun vip-find-file-other-window () + "Visit file in another window." + (interactive) + (let (file) + (setq file (read-file-name "Visit file: ")) + (switch-to-buffer-other-window (find-file-noselect file)) + (vip-change-mode-to-vi))) + +(defun vip-info-on-file () + "Give information of the file associated to the current buffer." + (interactive) + (message "\"%s\" line %d of %d" + (if (buffer-file-name) (buffer-file-name) "") + (1+ (count-lines (point-min) (point))) + (1+ (count-lines (point-min) (point-max))))) + + +;; yank and pop + +(defun vip-yank (text) + "yank TEXT silently." + (save-excursion + (vip-push-mark-silent (point)) + (insert text) + (exchange-point-and-mark)) + (skip-chars-forward " \t")) + +(defun vip-put-back (arg) + "Put back after point/below line." + (interactive "P") + (let ((val (vip-p-val arg)) + (text (if vip-use-register + (if (and (<= ?1 vip-use-register) (<= vip-use-register ?9)) + (current-kill (- vip-use-register ?1) 'do-not-rotate) + (get-register vip-use-register)) + (current-kill 0)))) + (if (null text) + (if vip-use-register + (let ((reg vip-use-register)) + (setq vip-use-register nil) + (error "Nothing in register %c" reg)) + (error ""))) + (setq vip-use-register nil) + (if (vip-end-with-a-newline-p text) + (progn + (with-no-warnings (next-line 1)) + (beginning-of-line)) + (if (and (not (eolp)) (not (eobp))) (forward-char))) + (setq vip-d-com (list 'vip-put-back val nil vip-use-register)) + (vip-loop val (vip-yank text)))) + +(defun vip-Put-back (arg) + "Put back at point/above line." + (interactive "P") + (let ((val (vip-p-val arg)) + (text (if vip-use-register + (if (and (<= ?1 vip-use-register) (<= vip-use-register ?9)) + (current-kill (- vip-use-register ?1) 'do-not-rotate) + (get-register vip-use-register)) + (current-kill 0)))) + (if (null text) + (if vip-use-register + (let ((reg vip-use-register)) + (setq vip-use-register nil) + (error "Nothing in register %c" reg)) + (error ""))) + (setq vip-use-register nil) + (if (vip-end-with-a-newline-p text) (beginning-of-line)) + (setq vip-d-com (list 'vip-Put-back val nil vip-use-register)) + (vip-loop val (vip-yank text)))) + +(defun vip-delete-char (arg) + "Delete character." + (interactive "P") + (let ((val (vip-p-val arg))) + (setq vip-d-com (list 'vip-delete-char val nil)) + (if vip-use-register + (progn + (if (and (<= ?A vip-use-register) (<= vip-use-register ?Z)) + (vip-append-to-register + (+ vip-use-register 32) (point) (- (point) val)) + (copy-to-register vip-use-register (point) (- (point) val) nil)) + (setq vip-use-register nil))) + (delete-char val t))) + +(defun vip-delete-backward-char (arg) + "Delete previous character." + (interactive "P") + (let ((val (vip-p-val arg))) + (setq vip-d-com (list 'vip-delete-backward-char val nil)) + (if vip-use-register + (progn + (if (and (<= ?A vip-use-register) (<= vip-use-register ?Z)) + (vip-append-to-register + (+ vip-use-register 32) (point) (+ (point) val)) + (copy-to-register vip-use-register (point) (+ (point) val) nil)) + (setq vip-use-register nil))) + (delete-backward-char val t))) + + +;; join lines. + +(defun vip-join-lines (arg) + "Join this line to next, if ARG is nil. Otherwise, join ARG lines" + (interactive "*P") + (let ((val (vip-P-val arg))) + (setq vip-d-com (list 'vip-join-lines val nil)) + (vip-loop (if (null val) 1 (1- val)) + (progn + (end-of-line) + (if (not (eobp)) + (progn + (forward-line 1) + (delete-region (point) (1- (point))) + (fixup-whitespace))))))) + + +;; making small changes + +(defvar vip-c-string) + +(defun vip-change (beg end) + (setq vip-c-string + (vip-read-string (format "%s => " (buffer-substring beg end)))) + (vip-change-subr beg end)) + +(defun vip-change-subr (beg end) + (if vip-use-register + (progn + (copy-to-register vip-use-register beg end nil) + (setq vip-use-register nil))) + (kill-region beg end) + (setq this-command 'vip-change) + (insert vip-c-string)) + + +;; query replace + +(defun vip-query-replace () + "Query replace. If you supply null string as the string to be replaced, +the query replace mode will toggle between string replace and regexp replace." + (interactive) + (let (str) + (setq str (vip-read-string + (if vip-re-query-replace "Query replace regexp: " + "Query replace: "))) + (if (string= str "") + (progn + (setq vip-re-query-replace (not vip-re-query-replace)) + (message "Query replace mode changed to %s." + (if vip-re-query-replace "regexp replace" + "string replace"))) + (if vip-re-query-replace + (query-replace-regexp + str + (vip-read-string (format "Query replace regexp \"%s\" with: " str))) + (query-replace + str + (vip-read-string (format "Query replace \"%s\" with: " str))))))) + + +;; marking + +(defun vip-mark-beginning-of-buffer () + (interactive) + (set-mark (point)) + (goto-char (point-min)) + (exchange-point-and-mark) + (message "mark set at the beginning of buffer")) + +(defun vip-mark-end-of-buffer () + (interactive) + (set-mark (point)) + (goto-char (point-max)) + (exchange-point-and-mark) + (message "mark set at the end of buffer")) + +(defun vip-mark-point (char) + (interactive "c") + (cond ((and (<= ?a char) (<= char ?z)) + (point-to-register (- char (- ?a ?\C-a)) nil)) + ((= char ?<) (vip-mark-beginning-of-buffer)) + ((= char ?>) (vip-mark-end-of-buffer)) + ((= char ?.) (push-mark)) + ((= char ?,) (set-mark-command 1)) + ((= char ?D) (mark-defun)) + (t (error "")))) + +(defun vip-goto-mark (arg) + "Go to mark." + (interactive "P") + (let ((char (read-char)) (com (vip-getcom arg))) + (vip-goto-mark-subr char com nil))) + +(defun vip-goto-mark-and-skip-white (arg) + "Go to mark and skip to first non-white on line." + (interactive "P") + (let ((char (read-char)) (com (vip-getCom arg))) + (vip-goto-mark-subr char com t))) + +(defun vip-goto-mark-subr (char com skip-white) + (cond ((and (<= ?a char) (<= char ?z)) + (let ((buff (current-buffer))) + (if com (move-marker vip-com-point (point))) + (goto-char (register-to-point (- char (- ?a ?\C-a)))) + (if skip-white (back-to-indentation)) + (vip-change-mode-to-vi) + (if com + (if (equal buff (current-buffer)) + (vip-execute-com (if skip-white + 'vip-goto-mark-and-skip-white + 'vip-goto-mark) + nil com) + (switch-to-buffer buff) + (goto-char vip-com-point) + (vip-change-mode-to-vi) + (error ""))))) + ((and (not skip-white) (= char ?`)) + (if com (move-marker vip-com-point (point))) + (exchange-point-and-mark) + (if com (vip-execute-com 'vip-goto-mark nil com))) + ((and skip-white (= char ?')) + (if com (move-marker vip-com-point (point))) + (exchange-point-and-mark) + (back-to-indentation) + (if com (vip-execute-com 'vip-goto-mark-and-skip-white nil com))) + (t (error "")))) + +(defun vip-exchange-point-and-mark () + (interactive) + (exchange-point-and-mark) + (back-to-indentation)) + +(defun vip-keyboard-quit () + "Abort partially formed or running command." + (interactive) + (setq vip-use-register nil) + (keyboard-quit)) + +(defun vip-ctl-c-equivalent (arg) + "Emulate C-c in Emacs mode." + (interactive "P") + (vip-ctl-key-equivalent "\C-c" arg)) + +(defun vip-ctl-x-equivalent (arg) + "Emulate C-x in Emacs mode." + (interactive "P") + (vip-ctl-key-equivalent "\C-x" arg)) + +(defun vip-ctl-key-equivalent (key arg) + (let ((char (read-char))) + (if (and (<= ?A char) (<= char ?Z)) + (setq char (- char (- ?A ?\C-a)))) + (vip-escape-to-emacs arg (list (aref key 0) char)))) + +;; commands in insertion mode + +(defun vip-delete-backward-word (arg) + "Delete previous word." + (interactive "p") + (save-excursion + (set-mark (point)) + (backward-word arg) + (delete-region (point) (mark)))) + + +;; implement ex commands + +(defvar ex-token-type nil + "type of token. if non-nil, gives type of address. if nil, it +is a command.") + +(defvar ex-token nil + "value of token.") + +(defvar ex-addresses nil + "list of ex addresses") + +(defvar ex-flag nil + "flag for ex flag") + +(defvar ex-buffer nil + "name of ex buffer") + +(defvar ex-count nil + "value of ex count") + +(defvar ex-g-flag nil + "flag for global command") + +(defvar ex-g-variant nil + "if t global command is executed on lines not matching ex-g-pat") + +(defvar ex-reg-exp nil + "save reg-exp used in substitute") + +(defvar ex-repl nil + "replace pattern for substitute") + +(defvar ex-g-pat nil + "pattern for global command") + +(defvar ex-map (make-sparse-keymap) + "save commands for mapped keys") + +(defvar ex-tag nil + "save ex tag") + +(defvar ex-file nil) + +(defvar ex-variant nil) + +(defvar ex-offset nil) + +(defvar ex-append nil) + +(defun vip-nil () + (interactive) + (error "")) + +(defun vip-looking-back (str) + "returns t if looking back reg-exp STR before point." + (and (save-excursion (re-search-backward str nil t)) + (= (point) (match-end 0)))) + +(defun vip-check-sub (str) + "check if ex-token is an initial segment of STR" + (let ((length (length ex-token))) + (if (and (<= length (length str)) + (string= ex-token (substring str 0 length))) + (setq ex-token str) + (setq ex-token-type "non-command")))) + +(defun vip-get-ex-com-subr () + "get a complete ex command" + (set-mark (point)) + (re-search-forward "[a-z][a-z]*") + (setq ex-token-type "command") + (setq ex-token (buffer-substring (point) (mark))) + (exchange-point-and-mark) + (cond ((looking-at "a") + (cond ((looking-at "ab") (vip-check-sub "abbreviate")) + ((looking-at "ar") (vip-check-sub "args")) + (t (vip-check-sub "append")))) + ((looking-at "[bh]") (setq ex-token-type "non-command")) + ((looking-at "c") + (if (looking-at "co") (vip-check-sub "copy") + (vip-check-sub "change"))) + ((looking-at "d") (vip-check-sub "delete")) + ((looking-at "e") + (if (looking-at "ex") (vip-check-sub "ex") + (vip-check-sub "edit"))) + ((looking-at "f") (vip-check-sub "file")) + ((looking-at "g") (vip-check-sub "global")) + ((looking-at "i") (vip-check-sub "insert")) + ((looking-at "j") (vip-check-sub "join")) + ((looking-at "l") (vip-check-sub "list")) + ((looking-at "m") + (cond ((looking-at "map") (vip-check-sub "map")) + ((looking-at "mar") (vip-check-sub "mark")) + (t (vip-check-sub "move")))) + ((looking-at "n") + (if (looking-at "nu") (vip-check-sub "number") + (vip-check-sub "next"))) + ((looking-at "o") (vip-check-sub "open")) + ((looking-at "p") + (cond ((looking-at "pre") (vip-check-sub "preserve")) + ((looking-at "pu") (vip-check-sub "put")) + (t (vip-check-sub "print")))) + ((looking-at "q") (vip-check-sub "quit")) + ((looking-at "r") + (cond ((looking-at "rec") (vip-check-sub "recover")) + ((looking-at "rew") (vip-check-sub "rewind")) + (t (vip-check-sub "read")))) + ((looking-at "s") + (cond ((looking-at "se") (vip-check-sub "set")) + ((looking-at "sh") (vip-check-sub "shell")) + ((looking-at "so") (vip-check-sub "source")) + ((looking-at "st") (vip-check-sub "stop")) + (t (vip-check-sub "substitute")))) + ((looking-at "t") + (if (looking-at "ta") (vip-check-sub "tag") + (vip-check-sub "t"))) + ((looking-at "u") + (cond ((looking-at "una") (vip-check-sub "unabbreviate")) + ((looking-at "unm") (vip-check-sub "unmap")) + (t (vip-check-sub "undo")))) + ((looking-at "v") + (cond ((looking-at "ve") (vip-check-sub "version")) + ((looking-at "vi") (vip-check-sub "visual")) + (t (vip-check-sub "v")))) + ((looking-at "w") + (if (looking-at "wq") (vip-check-sub "wq") + (vip-check-sub "write"))) + ((looking-at "x") (vip-check-sub "xit")) + ((looking-at "y") (vip-check-sub "yank")) + ((looking-at "z") (vip-check-sub "z"))) + (exchange-point-and-mark)) + +(defun vip-get-ex-token () + "get an ex-token which is either an address or a command. +a token has type \(command, address, end-mark\) and value." + (with-current-buffer " *ex-working-space*" + (skip-chars-forward " \t") + (cond ((looking-at "[k#]") + (setq ex-token-type "command") + (setq ex-token (char-to-string (following-char))) + (forward-char 1)) + ((looking-at "[a-z]") (vip-get-ex-com-subr)) + ((looking-at "\\.") + (forward-char 1) + (setq ex-token-type "dot")) + ((looking-at "[0-9]") + (set-mark (point)) + (re-search-forward "[0-9]*") + (setq ex-token-type + (cond ((string= ex-token-type "plus") "add-number") + ((string= ex-token-type "minus") "sub-number") + (t "abs-number"))) + (setq ex-token (string-to-number (buffer-substring (point) (mark))))) + ((looking-at "\\$") + (forward-char 1) + (setq ex-token-type "end")) + ((looking-at "%") + (forward-char 1) + (setq ex-token-type "whole")) + ((looking-at "+") + (cond ((or (looking-at "+[-+]") (looking-at "+[\n|]")) + (forward-char 1) + (insert "1") + (backward-char 1) + (setq ex-token-type "plus")) + ((looking-at "+[0-9]") + (forward-char 1) + (setq ex-token-type "plus")) + (t + (error "Badly formed address")))) + ((looking-at "-") + (cond ((or (looking-at "-[-+]") (looking-at "-[\n|]")) + (forward-char 1) + (insert "1") + (backward-char 1) + (setq ex-token-type "minus")) + ((looking-at "-[0-9]") + (forward-char 1) + (setq ex-token-type "minus")) + (t + (error "Badly formed address")))) + ((looking-at "/") + (forward-char 1) + (set-mark (point)) + (let ((cont t)) + (while (and (not (eolp)) cont) + ;;(re-search-forward "[^/]*/") + (re-search-forward "[^/]*\\(/\\|\n\\)") + (if (not (vip-looking-back "[^\\\\]\\(\\\\\\\\\\)*\\\\/")) + (setq cont nil)))) + (backward-char 1) + (setq ex-token (buffer-substring (point) (mark))) + (if (looking-at "/") (forward-char 1)) + (setq ex-token-type "search-forward")) + ((looking-at "\\?") + (forward-char 1) + (set-mark (point)) + (let ((cont t)) + (while (and (not (eolp)) cont) + ;;(re-search-forward "[^\\?]*\\?") + (re-search-forward "[^\\?]*\\(\\?\\|\n\\)") + (if (not (vip-looking-back "[^\\\\]\\(\\\\\\\\\\)*\\\\\\?")) + (setq cont nil)) + (backward-char 1) + (if (not (looking-at "\n")) (forward-char 1)))) + (setq ex-token-type "search-backward") + (setq ex-token (buffer-substring (1- (point)) (mark)))) + ((looking-at ",") + (forward-char 1) + (setq ex-token-type "comma")) + ((looking-at ";") + (forward-char 1) + (setq ex-token-type "semi-colon")) + ((looking-at "[!=><&~]") + (setq ex-token-type "command") + (setq ex-token (char-to-string (following-char))) + (forward-char 1)) + ((looking-at "'") + (setq ex-token-type "goto-mark") + (forward-char 1) + (cond ((looking-at "'") (setq ex-token nil)) + ((looking-at "[a-z]") (setq ex-token (following-char))) + (t (error "Marks are ' and a-z"))) + (forward-char 1)) + ((looking-at "\n") + (setq ex-token-type "end-mark") + (setq ex-token "goto")) + (t + (error "invalid token"))))) + +(defun vip-ex (&optional string) + "ex commands within VIP." + (interactive) + (or string + (setq ex-g-flag nil + ex-g-variant nil)) + (let ((com-str (or string (vip-read-string ":"))) + (address nil) (cont t) (dot (point))) + (with-current-buffer (get-buffer-create " *ex-working-space*") + (delete-region (point-min) (point-max)) + (insert com-str "\n") + (goto-char (point-min))) + (setq ex-token-type "") + (setq ex-addresses nil) + (while cont + (vip-get-ex-token) + (cond ((or (string= ex-token-type "command") + (string= ex-token-type "end-mark")) + (if address (setq ex-addresses (cons address ex-addresses))) + (cond ((string= ex-token "global") + (ex-global nil) + (setq cont nil)) + ((string= ex-token "v") + (ex-global t) + (setq cont nil)) + (t + (vip-execute-ex-command) + (with-current-buffer " *ex-working-space*" + (skip-chars-forward " \t") + (cond ((looking-at "|") + (forward-char 1)) + ((looking-at "\n") + (setq cont nil)) + (t (error "Extra character at end of a command"))))))) + ((string= ex-token-type "non-command") + (error "%s: Not an editor command" ex-token)) + ((string= ex-token-type "whole") + (setq ex-addresses + (cons (point-max) (cons (point-min) ex-addresses)))) + ((string= ex-token-type "comma") + (setq ex-addresses + (cons (if (null address) (point) address) ex-addresses))) + ((string= ex-token-type "semi-colon") + (if address (setq dot address)) + (setq ex-addresses + (cons (if (null address) (point) address) ex-addresses))) + (t (let ((ans (vip-get-ex-address-subr address dot))) + (if ans (setq address ans)))))))) + +(defun vip-get-ex-pat () + "get a regular expression and set ex-variant if found" + (with-current-buffer " *ex-working-space*" + (skip-chars-forward " \t") + (if (looking-at "!") + (progn + (setq ex-g-variant (not ex-g-variant) + ex-g-flag (not ex-g-flag)) + (forward-char 1) + (skip-chars-forward " \t"))) + (if (looking-at "/") + (progn + (forward-char 1) + (set-mark (point)) + (let ((cont t)) + (while (and (not (eolp)) cont) + (re-search-forward "[^/]*\\(/\\|\n\\)") + ;;(re-search-forward "[^/]*/") + (if (not (vip-looking-back "[^\\\\]\\(\\\\\\\\\\)*\\\\/")) + (setq cont nil)))) + (setq ex-token + (if (= (mark) (point)) "" + (buffer-substring (1- (point)) (mark)))) + (backward-char 1)) + (setq ex-token nil)))) + +(defun vip-get-ex-command () + "get an ex command" + (with-current-buffer " *ex-working-space*" + (if (looking-at "/") (forward-char 1)) + (skip-chars-forward " \t") + (cond ((looking-at "[a-z]") + (vip-get-ex-com-subr) + (if (string= ex-token-type "non-command") + (error "%s: not an editor command" ex-token))) + ((looking-at "[!=><&~]") + (setq ex-token (char-to-string (following-char))) + (forward-char 1)) + (t (error "Could not find an ex command"))))) + +(defun vip-get-ex-opt-gc () + "get an ex option g or c" + (with-current-buffer " *ex-working-space*" + (if (looking-at "/") (forward-char 1)) + (skip-chars-forward " \t") + (cond ((looking-at "g") + (setq ex-token "g") + (forward-char 1) + t) + ((looking-at "c") + (setq ex-token "c") + (forward-char 1) + t) + (t nil)))) + +(defun vip-default-ex-addresses (&optional whole-flag) + "compute default addresses. whole-flag means whole buffer." + (cond ((null ex-addresses) + (setq ex-addresses + (if whole-flag + (cons (point-max) (cons (point-min) nil)) + (cons (point) (cons (point) nil))))) + ((null (cdr ex-addresses)) + (setq ex-addresses + (cons (car ex-addresses) ex-addresses))))) + +(defun vip-get-ex-address () + "get an ex-address as a marker and set ex-flag if a flag is found" + (let ((address (point-marker)) (cont t)) + (setq ex-token "") + (setq ex-flag nil) + (while cont + (vip-get-ex-token) + (cond ((string= ex-token-type "command") + (if (or (string= ex-token "print") (string= ex-token "list") + (string= ex-token "#")) + (progn + (setq ex-flag t) + (setq cont nil)) + (error "address expected"))) + ((string= ex-token-type "end-mark") + (setq cont nil)) + ((string= ex-token-type "whole") + (error "a trailing address is expected")) + ((string= ex-token-type "comma") + (error "Extra characters after an address")) + (t (let ((ans (vip-get-ex-address-subr address (point-marker)))) + (if ans (setq address ans)))))) + address)) + +(defun vip-get-ex-address-subr (old-address dot) + "returns an address as a point" + (let ((address nil)) + (if (null old-address) (setq old-address dot)) + (cond ((string= ex-token-type "dot") + (setq address dot)) + ((string= ex-token-type "add-number") + (save-excursion + (goto-char old-address) + (forward-line (if (= old-address 0) (1- ex-token) ex-token)) + (setq address (point-marker)))) + ((string= ex-token-type "sub-number") + (save-excursion + (goto-char old-address) + (forward-line (- ex-token)) + (setq address (point-marker)))) + ((string= ex-token-type "abs-number") + (save-excursion + (goto-char (point-min)) + (if (= ex-token 0) (setq address 0) + (forward-line (1- ex-token)) + (setq address (point-marker))))) + ((string= ex-token-type "end") + (setq address (point-max-marker))) + ((string= ex-token-type "plus") t);; do nothing + ((string= ex-token-type "minus") t);; do nothing + ((string= ex-token-type "search-forward") + (save-excursion + (ex-search-address t) + (setq address (point-marker)))) + ((string= ex-token-type "search-backward") + (save-excursion + (ex-search-address nil) + (setq address (point-marker)))) + ((string= ex-token-type "goto-mark") + (save-excursion + (if (null ex-token) + (exchange-point-and-mark) + (goto-char (register-to-point (- ex-token (- ?a ?\C-a))))) + (setq address (point-marker))))) + address)) + +(defun ex-search-address (forward) + "search pattern and set address" + (if (string= ex-token "") + (if (null vip-s-string) (error "No previous search string") + (setq ex-token vip-s-string)) + (setq vip-s-string ex-token)) + (if forward + (progn + (forward-line 1) + (re-search-forward ex-token)) + (forward-line -1) + (re-search-backward ex-token))) + +(defun vip-get-ex-buffer () + "get a buffer name and set ex-count and ex-flag if found" + (setq ex-buffer nil) + (setq ex-count nil) + (setq ex-flag nil) + (with-current-buffer " *ex-working-space*" + (skip-chars-forward " \t") + (if (looking-at "[a-zA-Z]") + (progn + (setq ex-buffer (following-char)) + (forward-char 1) + (skip-chars-forward " \t"))) + (if (looking-at "[0-9]") + (progn + (set-mark (point)) + (re-search-forward "[0-9][0-9]*") + (setq ex-count (string-to-number (buffer-substring (point) (mark)))) + (skip-chars-forward " \t"))) + (if (looking-at "[pl#]") + (progn + (setq ex-flag t) + (forward-char 1))) + (if (not (looking-at "[\n|]")) + (error "Invalid extra characters")))) + +(defun vip-get-ex-count () + (setq ex-variant nil + ex-count nil + ex-flag nil) + (with-current-buffer " *ex-working-space*" + (skip-chars-forward " \t") + (if (looking-at "!") + (progn + (setq ex-variant t) + (forward-char 1))) + (skip-chars-forward " \t") + (if (looking-at "[0-9]") + (progn + (set-mark (point)) + (re-search-forward "[0-9][0-9]*") + (setq ex-count (string-to-number (buffer-substring (point) (mark)))) + (skip-chars-forward " \t"))) + (if (looking-at "[pl#]") + (progn + (setq ex-flag t) + (forward-char 1))) + (if (not (looking-at "[\n|]")) + (error "Invalid extra characters")))) + +(defun vip-get-ex-file () + "get a file name and set ex-variant, ex-append and ex-offset if found" + (setq ex-file nil + ex-variant nil + ex-append nil + ex-offset nil) + (with-current-buffer " *ex-working-space*" + (skip-chars-forward " \t") + (if (looking-at "!") + (progn + (setq ex-variant t) + (forward-char 1) + (skip-chars-forward " \t"))) + (if (looking-at ">>") + (progn + (setq ex-append t + ex-variant t) + (forward-char 2) + (skip-chars-forward " \t"))) + (if (looking-at "+") + (progn + (forward-char 1) + (set-mark (point)) + (re-search-forward "[ \t\n]") + (backward-char 1) + (setq ex-offset (buffer-substring (point) (mark))) + (forward-char 1) + (skip-chars-forward " \t"))) + (set-mark (point)) + (re-search-forward "[ \t\n]") + (backward-char 1) + (setq ex-file (buffer-substring (point) (mark))))) + +(defun vip-execute-ex-command () + "execute ex command using the value of addresses." + (cond ((string= ex-token "goto") (ex-goto)) + ((string= ex-token "copy") (ex-copy nil)) + ((string= ex-token "delete") (ex-delete)) + ((string= ex-token "edit") (ex-edit)) + ((string= ex-token "file") (vip-info-on-file)) + ;((string= ex-token "global") (ex-global nil)) + ((string= ex-token "join") (ex-line "join")) + ((string= ex-token "k") (ex-mark)) + ((string= ex-token "mark") (ex-mark)) + ((string= ex-token "map") (ex-map)) + ((string= ex-token "move") (ex-copy t)) + ((string= ex-token "put") (ex-put)) + ((string= ex-token "quit") (ex-quit)) + ((string= ex-token "read") (ex-read)) + ((string= ex-token "set") (ex-set)) + ((string= ex-token "shell") (ex-shell)) + ((string= ex-token "substitute") (ex-substitute)) + ((string= ex-token "stop") (suspend-emacs)) + ((string= ex-token "t") (ex-copy nil)) + ((string= ex-token "tag") (ex-tag)) + ((string= ex-token "undo") (vip-undo)) + ((string= ex-token "unmap") (ex-unmap)) + ;((string= ex-token "v") (ex-global t)) + ((string= ex-token "version") (vip-version)) + ((string= ex-token "visual") (ex-edit)) + ((string= ex-token "write") (ex-write nil)) + ((string= ex-token "wq") (ex-write t)) + ((string= ex-token "yank") (ex-yank)) + ((string= ex-token "!") (ex-command)) + ((string= ex-token "=") (ex-line-no)) + ((string= ex-token ">") (ex-line "right")) + ((string= ex-token "<") (ex-line "left")) + ((string= ex-token "&") (ex-substitute t)) + ((string= ex-token "~") (ex-substitute t t)) + ((or (string= ex-token "append") + (string= ex-token "args") + (string= ex-token "change") + (string= ex-token "insert") + (string= ex-token "open") + ) + (error "%s: no such command from VIP" ex-token)) + ((or (string= ex-token "abbreviate") + (string= ex-token "list") + (string= ex-token "next") + (string= ex-token "print") + (string= ex-token "preserve") + (string= ex-token "recover") + (string= ex-token "rewind") + (string= ex-token "source") + (string= ex-token "unabbreviate") + (string= ex-token "xit") + (string= ex-token "z") + ) + (error "%s: not implemented in VIP" ex-token)) + (t (error "%s: Not an editor command" ex-token)))) + +(defun ex-goto () + "ex goto command" + (if (null ex-addresses) + (setq ex-addresses (cons (point) nil))) + (push-mark (point)) + (goto-char (car ex-addresses)) + (beginning-of-line)) + +(defun ex-copy (del-flag) + "ex copy and move command. DEL-FLAG means delete." + (vip-default-ex-addresses) + (let ((address (vip-get-ex-address)) + (end (car ex-addresses)) (beg (car (cdr ex-addresses)))) + (goto-char end) + (save-excursion + (set-mark beg) + (vip-enlarge-region (mark) (point)) + (if del-flag (kill-region (point) (mark)) + (copy-region-as-kill (point) (mark))) + (if ex-flag + (progn + (with-output-to-temp-buffer "*copy text*" + (princ + (if (or del-flag ex-g-flag ex-g-variant) + (current-kill 0) + (buffer-substring (point) (mark))))) + (condition-case nil + (progn + (vip-read-string "[Hit return to continue] ") + (save-excursion (kill-buffer "*copy text*"))) + (quit + (save-excursion (kill-buffer "*copy text*")) + (signal 'quit nil)))))) + (if (= address 0) + (goto-char (point-min)) + (goto-char address) + (forward-line 1)) + (insert (current-kill 0)))) + +(defun ex-delete () + "ex delete" + (vip-default-ex-addresses) + (vip-get-ex-buffer) + (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses)))) + (if (> beg end) (error "First address exceeds second")) + (save-excursion + (vip-enlarge-region beg end) + (exchange-point-and-mark) + (if ex-count + (progn + (set-mark (point)) + (forward-line (1- ex-count))) + (set-mark end)) + (vip-enlarge-region (point) (mark)) + (if ex-flag + ;; show text to be deleted and ask for confirmation + (progn + (with-output-to-temp-buffer " *delete text*" + (princ (buffer-substring (point) (mark)))) + (condition-case conditions + (vip-read-string "[Hit return to continue] ") + (quit + (save-excursion (kill-buffer " *delete text*")) + (error ""))) + (save-excursion (kill-buffer " *delete text*"))) + (if ex-buffer + (if (and (<= ?A ex-buffer) (<= ex-buffer ?Z)) + (vip-append-to-register + (+ ex-buffer 32) (point) (mark)) + (copy-to-register ex-buffer (point) (mark) nil))) + (delete-region (point) (mark)))))) + +(defun ex-edit () + "ex-edit" + (vip-get-ex-file) + (if (and (not ex-variant) (buffer-modified-p) buffer-file-name) + (error "No write since last change \(:e! overrides\)")) + (vip-change-mode-to-emacs) + (set-buffer + (find-file-noselect (concat default-directory ex-file))) + (vip-change-mode-to-vi) + (goto-char (point-min)) + (if ex-offset + (progn + (with-current-buffer " *ex-working-space*" + (delete-region (point-min) (point-max)) + (insert ex-offset "\n") + (goto-char (point-min))) + (goto-char (vip-get-ex-address)) + (beginning-of-line)))) + +(defun ex-global (variant) + "ex global command" + (if (or ex-g-flag ex-g-variant) + (error "Global within global not allowed") + (if variant + (setq ex-g-flag nil + ex-g-variant t) + (setq ex-g-flag t + ex-g-variant nil))) + (vip-get-ex-pat) + (if (null ex-token) + (error "Missing regular expression for global command")) + (if (string= ex-token "") + (if (null vip-s-string) (error "No previous search string") + (setq ex-g-pat vip-s-string)) + (setq ex-g-pat ex-token + vip-s-string ex-token)) + (if (null ex-addresses) + (setq ex-addresses (list (point-max) (point-min)))) + (let ((marks nil) (mark-count 0) + com-str (end (car ex-addresses)) (beg (car (cdr ex-addresses)))) + (if (> beg end) (error "First address exceeds second")) + (save-excursion + (vip-enlarge-region beg end) + (exchange-point-and-mark) + (let ((cont t) (limit (point-marker))) + (exchange-point-and-mark) + ;; skip the last line if empty + (beginning-of-line) + (if (and (eobp) (not (bobp))) (backward-char 1)) + (while (and cont (not (bobp)) (>= (point) limit)) + (beginning-of-line) + (set-mark (point)) + (end-of-line) + (let ((found (re-search-backward ex-g-pat (mark) t))) + (if (or (and ex-g-flag found) + (and ex-g-variant (not found))) + (progn + (end-of-line) + (setq mark-count (1+ mark-count)) + (setq marks (cons (point-marker) marks))))) + (beginning-of-line) + (if (bobp) (setq cont nil) + (forward-line -1) + (end-of-line))))) + (with-current-buffer " *ex-working-space*" + (setq com-str (buffer-substring (1+ (point)) (1- (point-max))))) + (while marks + (goto-char (car marks)) + ;; report progress of execution on a slow machine. + ;;(message "Executing global command...") + ;;(if (zerop (% mark-count 10)) + ;; (message "Executing global command...%d" mark-count)) + (vip-ex com-str) + (setq mark-count (1- mark-count)) + (setq marks (cdr marks))))) +;;(message "Executing global command...done"))) + +(defun ex-line (com) + "ex line commands. COM is join, shift-right or shift-left." + (vip-default-ex-addresses) + (vip-get-ex-count) + (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses))) point) + (if (> beg end) (error "First address exceeds second")) + (save-excursion + (vip-enlarge-region beg end) + (exchange-point-and-mark) + (if ex-count + (progn + (set-mark (point)) + (forward-line ex-count))) + (if ex-flag + ;; show text to be joined and ask for confirmation + (progn + (with-output-to-temp-buffer " *text*" + (princ (buffer-substring (point) (mark)))) + (condition-case conditions + (progn + (vip-read-string "[Hit return to continue] ") + (ex-line-subr com (point) (mark))) + (quit + (ding))) + (save-excursion (kill-buffer " *text*"))) + (ex-line-subr com (point) (mark))) + (setq point (point))) + (goto-char (1- point)) + (beginning-of-line))) + +(defun ex-line-subr (com beg end) + (cond ((string= com "join") + (goto-char (min beg end)) + (while (and (not (eobp)) (< (point) (max beg end))) + (end-of-line) + (if (and (<= (point) (max beg end)) (not (eobp))) + (progn + (forward-line 1) + (delete-region (point) (1- (point))) + (if (not ex-variant) (fixup-whitespace)))))) + ((or (string= com "right") (string= com "left")) + (indent-rigidly + (min beg end) (max beg end) + (if (string= com "right") vip-shift-width (- vip-shift-width))) + (goto-char (max beg end)) + (end-of-line) + (forward-char 1)))) + +(defun ex-mark () + "ex mark" + (let (char) + (if (null ex-addresses) + (setq ex-addresses + (cons (point) nil))) + (with-current-buffer " *ex-working-space*" + (skip-chars-forward " \t") + (if (looking-at "[a-z]") + (progn + (setq char (following-char)) + (forward-char 1) + (skip-chars-forward " \t") + (if (not (looking-at "[\n|]")) + (error "Extra characters at end of \"k\" command"))) + (if (looking-at "[\n|]") + (error "\"k\" requires a following letter") + (error "Mark must specify a letter")))) + (save-excursion + (goto-char (car ex-addresses)) + (point-to-register (- char (- ?a ?\C-a)) nil)))) + +(defun ex-map () + "ex map" + (let (char string) + (with-current-buffer " *ex-working-space*" + (skip-chars-forward " \t") + (setq char (char-to-string (following-char))) + (forward-char 1) + (skip-chars-forward " \t") + (if (looking-at "[\n|]") (error "Missing rhs")) + (set-mark (point)) + (with-no-warnings + (end-of-buffer)) + (backward-char 1) + (setq string (buffer-substring (mark) (point)))) + (if (not (lookup-key ex-map char)) + (define-key ex-map char + (or (lookup-key vip-mode-map char) 'vip-nil))) + (define-key vip-mode-map char + (eval + (list 'quote + (cons 'lambda + (list '(count) + '(interactive "p") + (list 'execute-kbd-macro string 'count)))))))) + +(defun ex-unmap () + "ex unmap" + (let (char) + (with-current-buffer " *ex-working-space*" + (skip-chars-forward " \t") + (setq char (char-to-string (following-char))) + (forward-char 1) + (skip-chars-forward " \t") + (if (not (looking-at "[\n|]")) (error "Macro must be a character"))) + (if (not (lookup-key ex-map char)) + (error "That macro wasn't mapped")) + (define-key vip-mode-map char (lookup-key ex-map char)) + (define-key ex-map char nil))) + +(defun ex-put () + "ex put" + (let ((point (if (null ex-addresses) (point) (car ex-addresses)))) + (vip-get-ex-buffer) + (setq vip-use-register ex-buffer) + (goto-char point) + (if (= point 0) (vip-Put-back 1) (vip-put-back 1)))) + +(defun ex-quit () + "ex quit" + (let (char) + (with-current-buffer " *ex-working-space*" + (skip-chars-forward " \t") + (setq char (following-char))) + (if (= char ?!) (kill-emacs t) (save-buffers-kill-emacs)))) + +(defun ex-read () + "ex read" + (let ((point (if (null ex-addresses) (point) (car ex-addresses))) + (variant nil) command file) + (goto-char point) + (if (not (= point 0)) (with-no-warnings (next-line 1))) + (beginning-of-line) + (with-current-buffer " *ex-working-space*" + (skip-chars-forward " \t") + (if (looking-at "!") + (progn + (setq variant t) + (forward-char 1) + (skip-chars-forward " \t") + (set-mark (point)) + (end-of-line) + (setq command (buffer-substring (mark) (point)))) + (set-mark (point)) + (re-search-forward "[ \t\n]") + (backward-char 1) + (setq file (buffer-substring (point) (mark))))) + (if variant + (shell-command command t) + (with-no-warnings + (insert-file file))))) + +(defun ex-set () + (eval (list 'setq + (read-variable "Variable: ") + (eval (read-minibuffer "Value: "))))) + +(defun ex-shell () + "ex shell" + (vip-change-mode-to-emacs) + (shell)) + +(defun ex-substitute (&optional repeat r-flag) + "ex substitute. +If REPEAT use previous reg-exp which is ex-reg-exp or +vip-s-string" + (let (pat repl (opt-g nil) (opt-c nil) (matched-pos nil)) + (if repeat (setq ex-token nil) (vip-get-ex-pat)) + (if (null ex-token) + (setq pat (if r-flag vip-s-string ex-reg-exp) + repl ex-repl) + (setq pat (if (string= ex-token "") vip-s-string ex-token)) + (setq vip-s-string pat + ex-reg-exp pat) + (vip-get-ex-pat) + (if (null ex-token) + (setq ex-token "" + ex-repl "") + (setq repl ex-token + ex-repl ex-token))) + (while (vip-get-ex-opt-gc) + (if (string= ex-token "g") (setq opt-g t) (setq opt-c t))) + (vip-get-ex-count) + (if ex-count + (save-excursion + (if ex-addresses (goto-char (car ex-addresses))) + (set-mark (point)) + (forward-line (1- ex-count)) + (setq ex-addresses (cons (point) (cons (mark) nil)))) + (if (null ex-addresses) + (setq ex-addresses (cons (point) (cons (point) nil))) + (if (null (cdr ex-addresses)) + (setq ex-addresses (cons (car ex-addresses) ex-addresses))))) + ;(setq G opt-g) + (let ((beg (car ex-addresses)) (end (car (cdr ex-addresses))) + (cont t) eol-mark) + (save-excursion + (vip-enlarge-region beg end) + (let ((limit (save-excursion + (goto-char (max (point) (mark))) + (point-marker)))) + (goto-char (min (point) (mark))) + (while (< (point) limit) + (end-of-line) + (setq eol-mark (point-marker)) + (beginning-of-line) + (if opt-g + (progn + (while (and (not (eolp)) + (re-search-forward pat eol-mark t)) + (if (or (not opt-c) (y-or-n-p "Replace? ")) + (progn + (setq matched-pos (point)) + (replace-match repl)))) + (end-of-line) + (forward-char)) + (if (and (re-search-forward pat eol-mark t) + (or (not opt-c) (y-or-n-p "Replace? "))) + (progn + (setq matched-pos (point)) + (replace-match repl))) + (end-of-line) + (forward-char)))))) + (if matched-pos (goto-char matched-pos)) + (beginning-of-line) + (if opt-c (message "done")))) + +(defun ex-tag () + "ex tag" + (let (tag) + (with-current-buffer " *ex-working-space*" + (skip-chars-forward " \t") + (set-mark (point)) + (skip-chars-forward "^ |\t\n") + (setq tag (buffer-substring (mark) (point)))) + (if (not (string= tag "")) (setq ex-tag tag)) + (vip-change-mode-to-emacs) + (condition-case conditions + (progn + (if (string= tag "") + (find-tag ex-tag t) + (find-tag-other-window ex-tag)) + (vip-change-mode-to-vi)) + (error + (vip-change-mode-to-vi) + (vip-message-conditions conditions))))) + +(defun ex-write (q-flag) + "ex write" + (vip-default-ex-addresses t) + (vip-get-ex-file) + (if (string= ex-file "") + (progn + (if (null buffer-file-name) + (error "No file associated with this buffer")) + (setq ex-file buffer-file-name)) + (setq ex-file (expand-file-name ex-file))) + (if (and (not (string= ex-file (buffer-file-name))) + (file-exists-p ex-file) + (not ex-variant)) + (error "\"%s\" File exists - use w! to override" ex-file)) + (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses)))) + (if (> beg end) (error "First address exceeds second")) + (save-excursion + (vip-enlarge-region beg end) + (write-region (point) (mark) ex-file ex-append t))) + (if (null buffer-file-name) (setq buffer-file-name ex-file)) + (if q-flag (save-buffers-kill-emacs))) + +(defun ex-yank () + "ex yank" + (vip-default-ex-addresses) + (vip-get-ex-buffer) + (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses)))) + (if (> beg end) (error "First address exceeds second")) + (save-excursion + (vip-enlarge-region beg end) + (exchange-point-and-mark) + (if (or ex-g-flag ex-g-variant) (error "Can't yank within global")) + (if ex-count + (progn + (set-mark (point)) + (forward-line (1- ex-count))) + (set-mark end)) + (vip-enlarge-region (point) (mark)) + (if ex-flag (error "Extra characters at end of command")) + (if ex-buffer + (copy-to-register ex-buffer (point) (mark) nil)) + (copy-region-as-kill (point) (mark))))) + +(defun ex-command () + "execute shell command" + (let (command) + (with-current-buffer " *ex-working-space*" + (skip-chars-forward " \t") + (set-mark (point)) + (end-of-line) + (setq command (buffer-substring (mark) (point)))) + (if (null ex-addresses) + (shell-command command) + (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses)))) + (if (null beg) (setq beg end)) + (save-excursion + (goto-char beg) + (set-mark end) + (vip-enlarge-region (point) (mark)) + (shell-command-on-region (point) (mark) command t t)) + (goto-char beg))))) + +(defun ex-line-no () + "print line number" + (message "%d" + (1+ (count-lines + (point-min) + (if (null ex-addresses) (point-max) (car ex-addresses)))))) + +(if (file-exists-p vip-startup-file) (load vip-startup-file)) + +(provide 'vip) + +;;; vip.el ends here diff --git a/lisp/obsolete/ws-mode.el b/lisp/obsolete/ws-mode.el new file mode 100644 index 00000000000..d87cc73252b --- /dev/null +++ b/lisp/obsolete/ws-mode.el @@ -0,0 +1,643 @@ +;;; ws-mode.el --- WordStar emulation mode for GNU Emacs + +;; Copyright (C) 1991, 2001-2014 Free Software Foundation, Inc. + +;; Author: Juergen Nickelsen +;; 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 . + +;;; 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 diff --git a/lisp/scroll-all.el b/lisp/scroll-all.el index b56a020c795..1aa2fc7d2bb 100644 --- a/lisp/scroll-all.el +++ b/lisp/scroll-all.el @@ -3,7 +3,7 @@ ;; Copyright (C) 1997, 2001-2014 Free Software Foundation, Inc. ;; Author: Gary D. Foster -;; Keywords: scroll crisp brief lock +;; Keywords: convenience scroll lock ;; This file is part of GNU Emacs. -- cgit v1.2.1