mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-15 10:30:25 -08:00
Code Issues Projects Releases Wiki Activity

Make most emulation packages obsolete. [Backport]

Browse source 
* 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/.
* 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.
This commit is contained in:
Glenn Morris 2014-10-20 18:12:13 -04:00 • committed by Stefan Monnier
parent d9a72916e5
commit ef65424de8
18 changed files with 66 additions and 27 deletions
Download patch file Download diff file Expand all files Collapse all files

387
lisp/obsolete/crisp.el Normal file
View file

@ -0,0 +1,387 @@
;;; crisp.el --- CRiSP/Brief Emacs emulator
;; Copyright (C) 1997-1999, 2001-2014 Free Software Foundation, Inc.
;; Author: Gary D. Foster <Gary.Foster@Corp.Sun.COM>
;; Keywords: emulations brief crisp
;; Obsolete-since: 24.5
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Keybindings and minor functions to duplicate the functionality and
;; finger-feel of the CRiSP/Brief editor. This package is designed to
;; facilitate transitioning from Brief to (XE|E)macs with a minimum
;; amount of hassles.
;; Enable this package by putting (require 'crisp) in your .emacs and
;; use M-x crisp-mode to toggle it on or off.
;; This package will automatically load the scroll-all.el package if
;; you put (setq crisp-load-scroll-all t) in your .emacs before
;; loading this package. If this feature is enabled, it will bind
;; meta-f1 to the scroll-all mode toggle. The scroll-all package
;; duplicates the scroll-all feature in CRiSP.
;; Also, the default keybindings for brief/CRiSP override the M-x
;; key to exit the editor. If you don't like this functionality, you
;; can prevent this behavior (or redefine it dynamically) by setting
;; the value of `crisp-override-meta-x' either in your .emacs or
;; interactively. The default setting is t, which means that M-x will
;; by default run `save-buffers-kill-emacs' instead of the command
;; `execute-extended-command'.
;; Finally, if you want to change the string displayed in the mode
;; line when this mode is in effect, override the definition of
;; `crisp-mode-mode-line-string' in your .emacs. The default value is
;; " *Crisp*" which may be a bit lengthy if you have a lot of things
;; being displayed there.
;; All these overrides should go *before* the (require 'crisp) statement.
;;; Code:
;; local variables
(defgroup crisp nil
"Emulator for CRiSP and Brief key bindings."
:prefix "crisp-"
:group 'emulations)
(defvar crisp-mode-map
(let ((map (make-sparse-keymap)))
(define-key map [(f1)] 'other-window)
(define-key map [(f2) (down)] 'enlarge-window)
(define-key map [(f2) (left)] 'shrink-window-horizontally)
(define-key map [(f2) (right)] 'enlarge-window-horizontally)
(define-key map [(f2) (up)] 'shrink-window)
(define-key map [(f3) (down)] 'split-window-below)
(define-key map [(f3) (right)] 'split-window-right)
(define-key map [(f4)] 'delete-window)
(define-key map [(control f4)] 'delete-other-windows)
(define-key map [(f5)] 'search-forward-regexp)
(define-key map [(f19)] 'search-forward-regexp)
(define-key map [(meta f5)] 'search-backward-regexp)
(define-key map [(f6)] 'query-replace)
(define-key map [(f7)] 'start-kbd-macro)
(define-key map [(meta f7)] 'end-kbd-macro)
(define-key map [(f8)] 'call-last-kbd-macro)
(define-key map [(meta f8)] 'save-kbd-macro)
(define-key map [(f9)] 'find-file)
(define-key map [(meta f9)] 'load-library)
(define-key map [(f10)] 'execute-extended-command)
(define-key map [(meta f10)] 'compile)
(define-key map [(SunF37)] 'kill-buffer)
(define-key map [(kp-add)] 'crisp-copy-line)
(define-key map [(kp-subtract)] 'crisp-kill-line)
;; just to cover all the bases (GNU Emacs, for instance)
(define-key map [(f24)] 'crisp-kill-line)
(define-key map [(insert)] 'crisp-yank-clipboard)
(define-key map [(f16)] 'crisp-set-clipboard) ; copy on Sun5 kbd
(define-key map [(f20)] 'crisp-kill-region) ; cut on Sun5 kbd
(define-key map [(f18)] 'crisp-yank-clipboard) ; paste on Sun5 kbd
(define-key map [(control f)] 'fill-paragraph-or-region)
(define-key map [(meta d)] (lambda ()
(interactive)
(beginning-of-line) (kill-line)))
(define-key map [(meta e)] 'find-file)
(define-key map [(meta g)] 'goto-line)
(define-key map [(meta h)] 'help)
(define-key map [(meta i)] 'overwrite-mode)
(define-key map [(meta j)] 'bookmark-jump)
(define-key map [(meta l)] 'crisp-mark-line)
(define-key map [(meta m)] 'set-mark-command)
(define-key map [(meta n)] 'bury-buffer)
(define-key map [(meta p)] 'crisp-unbury-buffer)
(define-key map [(meta u)] 'undo)
(define-key map [(f14)] 'undo)
(define-key map [(meta w)] 'save-buffer)
(define-key map [(meta x)] 'crisp-meta-x-wrapper)
(define-key map [(meta ?0)] (lambda ()
(interactive)
(bookmark-set "0")))
(define-key map [(meta ?1)] (lambda ()
(interactive)
(bookmark-set "1")))
(define-key map [(meta ?2)] (lambda ()
(interactive)
(bookmark-set "2")))
(define-key map [(meta ?3)] (lambda ()
(interactive)
(bookmark-set "3")))
(define-key map [(meta ?4)] (lambda ()
(interactive)
(bookmark-set "4")))
(define-key map [(meta ?5)] (lambda ()
(interactive)
(bookmark-set "5")))
(define-key map [(meta ?6)] (lambda ()
(interactive)
(bookmark-set "6")))
(define-key map [(meta ?7)] (lambda ()
(interactive)
(bookmark-set "7")))
(define-key map [(meta ?8)] (lambda ()
(interactive)
(bookmark-set "8")))
(define-key map [(meta ?9)] (lambda ()
(interactive)
(bookmark-set "9")))
(define-key map [(shift delete)] 'kill-word)
(define-key map [(shift backspace)] 'backward-kill-word)
(define-key map [(control left)] 'backward-word)
(define-key map [(control right)] 'forward-word)
(define-key map [(home)] 'crisp-home)
(define-key map [(control home)] (lambda ()
(interactive)
(move-to-window-line 0)))
(define-key map [(meta home)] 'beginning-of-line)
(define-key map [(end)] 'crisp-end)
(define-key map [(control end)] (lambda ()
(interactive)
(move-to-window-line -1)))
(define-key map [(meta end)] 'end-of-line)
map)
"Local keymap for CRiSP emulation mode.
All the bindings are done here instead of globally to try and be
nice to the world.")
(define-obsolete-variable-alias 'crisp-mode-modeline-string
'crisp-mode-mode-line-string "24.3")
(defcustom crisp-mode-mode-line-string " *CRiSP*"
"String to display in the mode line when CRiSP emulation mode is enabled."
:type 'string
:group 'crisp)
;;;###autoload
(defcustom crisp-mode nil
"Track status of CRiSP emulation mode.
A value of nil means CRiSP mode is not enabled. A value of t
indicates CRiSP mode is enabled.
Setting this variable directly does not take effect;
use either M-x customize or the function `crisp-mode'."
:set (lambda (symbol value) (crisp-mode (if value 1 0)))
:initialize 'custom-initialize-default
:require 'crisp
:version "20.4"
:type 'boolean
:group 'crisp)
(defcustom crisp-override-meta-x t
"Controls overriding the normal Emacs M-x key binding in the CRiSP emulator.
Normally the CRiSP emulator rebinds M-x to `save-buffers-exit-emacs', and
provides the usual M-x functionality on the F10 key. If this variable
is non-nil, M-x will exit Emacs."
:type 'boolean
:group 'crisp)
(defcustom crisp-load-scroll-all nil
"Controls loading of the Scroll Lock in the CRiSP emulator.
Its default behavior is to load and enable the Scroll Lock minor mode
package when enabling the CRiSP emulator.
If this variable is nil when you start the CRiSP emulator, it
does not load the scroll-all package."
:type 'boolean
:group 'crisp)
(defcustom crisp-load-hook nil
"Hooks to run after loading the CRiSP emulator package."
:type 'hook
:group 'crisp)
(defcustom crisp-mode-hook nil
"Hook run by the function `crisp-mode'."
:type 'hook
:group 'crisp)
(defconst crisp-version "1.34"
"The version of the CRiSP emulator.")
(defconst crisp-mode-help-address "gfoster@suzieq.ml.org"
"The email address of the CRiSP mode author/maintainer.")
;; Silence the byte-compiler.
(defvar crisp-last-last-command nil
"The previous value of `last-command'.")
;; The cut and paste routines are different between XEmacs and Emacs
;; so we need to set up aliases for the functions.
(defalias 'crisp-set-clipboard
(if (fboundp 'clipboard-kill-ring-save)
'clipboard-kill-ring-save
'copy-primary-selection))
(defalias 'crisp-kill-region
(if (fboundp 'clipboard-kill-region)
'clipboard-kill-region
'kill-primary-selection))
(defalias 'crisp-yank-clipboard
(if (fboundp 'clipboard-yank)
'clipboard-yank
'yank-clipboard-selection))
(defun crisp-region-active ()
"Compatibility function to test for an active region."
(if (featurep 'xemacs)
zmacs-region-active-p
mark-active))
(defun crisp-version (&optional arg)
"Version number of the CRiSP emulator package.
If ARG, insert results at point."
(interactive "P")
(let ((foo (concat "CRiSP version " crisp-version)))
(if arg
(insert (message foo))
(message foo))))
(defun crisp-mark-line (arg)
"Set mark at the end of the line.
Arg works as in `end-of-line'."
(interactive "p")
(let (newmark)
(save-excursion
(end-of-line arg)
(setq newmark (point)))
(push-mark newmark nil t)))
(defun crisp-kill-line (arg)
"Mark and kill line(s).
Marks from point to end of the current line (honoring prefix arguments),
copies the region to the kill ring and clipboard, and then deletes it."
(interactive "*p")
(if (crisp-region-active)
(call-interactively 'crisp-kill-region)
(crisp-mark-line arg)
(call-interactively 'crisp-kill-region)))
(defun crisp-copy-line (arg)
"Mark and copy line(s).
Marks from point to end of the current line (honoring prefix arguments),
copies the region to the kill ring and clipboard, and then deactivates
the region."
(interactive "*p")
(if (crisp-region-active)
(call-interactively 'crisp-set-clipboard)
(crisp-mark-line arg)
(call-interactively 'crisp-set-clipboard))
;; clear the region after the operation is complete
;; XEmacs does this automagically, Emacs doesn't.
(if (boundp 'mark-active)
(setq mark-active nil)))
(defun crisp-home ()
"\"Home\" the point, the way CRiSP would do it.
The first use moves point to beginning of the line. Second
consecutive use moves point to beginning of the screen. Third
consecutive use moves point to the beginning of the buffer."
(interactive nil)
(cond
((and (eq last-command 'crisp-home)
(eq crisp-last-last-command 'crisp-home))
(goto-char (point-min)))
((eq last-command 'crisp-home)
(move-to-window-line 0))
(t
(beginning-of-line)))
(setq crisp-last-last-command last-command))
(defun crisp-end ()
"\"End\" the point, the way CRiSP would do it.
The first use moves point to end of the line. Second
consecutive use moves point to the end of the screen. Third
consecutive use moves point to the end of the buffer."
(interactive nil)
(cond
((and (eq last-command 'crisp-end)
(eq crisp-last-last-command 'crisp-end))
(goto-char (point-max)))
((eq last-command 'crisp-end)
(move-to-window-line -1)
(end-of-line))
(t
(end-of-line)))
(setq crisp-last-last-command last-command))
(defun crisp-unbury-buffer ()
"Go back one buffer."
(interactive)
(switch-to-buffer (car (last (buffer-list)))))
(defun crisp-meta-x-wrapper ()
"Wrapper function to conditionally override the normal M-x bindings.
When `crisp-override-meta-x' is non-nil, M-x will exit Emacs (the
normal CRiSP binding) and when it is nil M-x will run
`execute-extended-command' (the normal Emacs binding)."
(interactive)
(if crisp-override-meta-x
(save-buffers-kill-emacs)
(call-interactively 'execute-extended-command)))
;;;###autoload
(define-minor-mode crisp-mode
"Toggle CRiSP/Brief emulation (CRiSP mode).
With a prefix argument ARG, enable CRiSP mode if ARG is positive,
and disable it otherwise. If called from Lisp, enable the mode
if ARG is omitted or nil."
:keymap crisp-mode-map
:lighter crisp-mode-mode-line-string
(when crisp-mode
;; Make menu entries show M-u or f14 in preference to C-x u.
(put 'undo :advertised-binding
`([?\M-u] [f14] ,@(get 'undo :advertised-binding)))
;; Force transient-mark-mode, so that the marking routines work as
;; expected. If the user turns off transient mark mode, most
;; things will still work fine except the crisp-(copy|kill)
;; functions won't work quite as nicely when regions are marked
;; differently and could really confuse people. Caveat emptor.
(if (fboundp 'transient-mark-mode)
(transient-mark-mode t))
(if crisp-load-scroll-all
(require 'scroll-all))
(if (featurep 'scroll-all)
(define-key crisp-mode-map [(meta f1)] 'scroll-all-mode))))
;; People might use Apropos on `brief'.
;;;###autoload
(defalias 'brief-mode 'crisp-mode)
;; Interaction with other packages.
(put 'crisp-home 'CUA 'move)
(put 'crisp-end 'CUA 'move)
(run-hooks 'crisp-load-hook)
(provide 'crisp)
;;; crisp.el ends here

2472
lisp/obsolete/tpu-edt.el Normal file
View file

File diff suppressed because it is too large Load diff

446
lisp/obsolete/tpu-extras.el Normal file
View file

@ -0,0 +1,446 @@
;;; tpu-extras.el --- scroll margins and free cursor mode for TPU-edt
;; Copyright (C) 1993-1995, 2000-2014 Free Software Foundation, Inc.
;; Author: Rob Riepel <riepel@networking.stanford.edu>
;; Maintainer: Rob Riepel <riepel@networking.stanford.edu>
;; Keywords: emulations
;; Package: tpu-edt
;; Obsolete-since: 24.5
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Use the functions defined here to customize TPU-edt to your tastes by
;; setting scroll margins and/or turning on free cursor mode. Here's an
;; example for your init file.
;; (tpu-set-cursor-free) ; Set cursor free.
;; (tpu-set-scroll-margins "10%" "15%") ; Set scroll margins.
;; Scroll margins and cursor binding can be changed from within emacs using
;; the following commands:
;; tpu-set-scroll-margins or set scroll margins
;; tpu-set-cursor-bound or set cursor bound
;; tpu-set-cursor-free or set cursor free
;; Additionally, Gold-F toggles between bound and free cursor modes.
;; Note that switching out of free cursor mode or exiting TPU-edt while in
;; free cursor mode strips trailing whitespace from every line in the file.
;;; Details:
;; The functions contained in this file implement scroll margins and free
;; cursor mode. The following keys and commands are affected.
;; key/command function scroll cursor
;; Up-Arrow previous line x x
;; Down-Arrow next line x x
;; Right-Arrow next character x
;; Left-Arrow previous character x
;; KP0 next or previous line x
;; KP7 next or previous page x
;; KP8 next or previous screen x
;; KP2 next or previous end-of-line x x
;; Control-e current end-of-line x
;; Control-h previous beginning-of-line x
;; Next Scr next screen x
;; Prev Scr previous screen x
;; Search find a string x
;; Replace find and replace a string x
;; Newline insert a newline x
;; Paragraph next or previous paragraph x
;; Auto-Fill break lines on spaces x
;; These functions are not part of the base TPU-edt for the following
;; reasons:
;; Free cursor mode is implemented with the emacs picture-mode functions.
;; These functions support moving the cursor all over the screen, however,
;; when the cursor is moved past the end of a line, spaces or tabs are
;; appended to the line - even if no text is entered in that area. In
;; order for a free cursor mode to work exactly like TPU/edt, this trailing
;; whitespace needs to be dealt with in every function that might encounter
;; it. Such global changes are impractical, however, free cursor mode is
;; too valuable to abandon completely, so it has been implemented in those
;; functions where it serves best.
;; The implementation of scroll margins adds overhead to previously
;; simple and often used commands. These commands are now responsible
;; for their normal operation and part of the display function. There
;; is a possibility that this display overhead could adversely affect the
;; performance of TPU-edt on slower computers. In order to support the
;; widest range of computers, scroll margin support is optional.
;; It's actually not known whether the overhead associated with scroll
;; margin support is significant. If you find that it is, please send
;; a note describing the extent of the performance degradation. Be sure
;; to include a description of the platform where you're running TPU-edt.
;; Send your note to the address provided by Gold-V.
;; Even with these differences and limitations, these functions implement
;; important aspects of the real TPU/edt. Those who miss free cursor mode
;; and/or scroll margins will appreciate these implementations.
;;; Code:
;;; Gotta have tpu-edt
(require 'tpu-edt)
;;; Customization variables
(defcustom tpu-top-scroll-margin 0
"Scroll margin at the top of the screen.
Interpreted as a percent of the current window size."
:type 'integer
:group 'tpu)
(defcustom tpu-bottom-scroll-margin 0
"Scroll margin at the bottom of the screen.
Interpreted as a percent of the current window size."
:type 'integer
:group 'tpu)
(defcustom tpu-backward-char-like-tpu t
"If non-nil, in free cursor mode backward-char (left-arrow) works
just like TPU/edt. Otherwise, backward-char will move to the end of
the previous line when starting from a line beginning."
:type 'boolean
:group 'tpu)
;;; Global variables
;;;###autoload
(define-minor-mode tpu-cursor-free-mode
"Minor mode to allow the cursor to move freely about the screen.
With a prefix argument ARG, enable the mode if ARG is positive,
and disable it otherwise. If called from Lisp, enable the mode
if ARG is omitted or nil."
:init-value nil
(if (not tpu-cursor-free-mode)
(tpu-trim-line-ends))
(if (not tpu-cursor-free-mode)
(message "The cursor is now bound to the flow of your text.")
(message "The cursor will now move freely about the screen.")))
;;; Hooks -- Set cursor free in picture mode.
;;; Clean up when writing a file from cursor free mode.
(add-hook 'picture-mode-hook 'tpu-set-cursor-free)
(defun tpu-trim-line-ends-if-needed ()
"Eliminate whitespace at ends of lines, if the cursor is free."
(if (and (buffer-modified-p) tpu-cursor-free-mode) (tpu-trim-line-ends)))
(add-hook 'before-save-hook 'tpu-trim-line-ends-if-needed)
;;; Utility routines for implementing scroll margins
(defun tpu-top-check (beg lines)
"Enforce scroll margin at the top of screen."
(let ((margin (/ (* (window-height) tpu-top-scroll-margin) 100)))
(cond ((< beg margin) (recenter beg))
((< (- beg lines) margin) (recenter margin)))))
(defun tpu-bottom-check (beg lines)
"Enforce scroll margin at the bottom of screen."
(let* ((height (window-height))
(margin (+ 1 (/ (* height tpu-bottom-scroll-margin) 100)))
;; subtract 1 from height because it includes mode line
(difference (- height margin 1)))
(cond ((> beg difference) (recenter beg))
((> (+ beg lines) difference) (recenter (- margin))))))
;;; Movement by character
(defun tpu-forward-char (num)
"Move right ARG characters (left if ARG is negative)."
(interactive "p")
(if tpu-cursor-free-mode (picture-forward-column num) (forward-char num)))
(defun tpu-backward-char (num)
"Move left ARG characters (right if ARG is negative)."
(interactive "p")
(cond ((not tpu-cursor-free-mode)
(backward-char num))
(tpu-backward-char-like-tpu
(picture-backward-column num))
((bolp)
(backward-char 1)
(picture-end-of-line)
(picture-backward-column (1- num)))
(t
(picture-backward-column num))))
;;; Movement by line
(defun tpu-next-line (num)
"Move to next line.
Prefix argument serves as a repeat count."
(interactive "p")
(let ((beg (tpu-current-line)))
(if tpu-cursor-free-mode (or (eobp) (picture-move-down num))
(line-move num))
(tpu-bottom-check beg num)
(setq this-command 'next-line)))
(defun tpu-previous-line (num)
"Move to previous line.
Prefix argument serves as a repeat count."
(interactive "p")
(let ((beg (tpu-current-line)))
(if tpu-cursor-free-mode (picture-move-up num) (line-move (- num)))
(tpu-top-check beg num)
(setq this-command 'previous-line)))
(defun tpu-next-beginning-of-line (num)
"Move to beginning of line; if at beginning, move to beginning of next line.
Accepts a prefix argument for the number of lines to move."
(interactive "p")
(let ((beg (tpu-current-line)))
(backward-char 1)
(forward-visible-line (- 1 num))
(tpu-top-check beg num)))
(defun tpu-next-end-of-line (num)
"Move to end of line; if at end, move to end of next line.
Accepts a prefix argument for the number of lines to move."
(interactive "p")
(let ((beg (tpu-current-line)))
(cond (tpu-cursor-free-mode
(let ((beg (point)))
(if (< 1 num) (forward-line num))
(picture-end-of-line)
(if (<= (point) beg) (progn (forward-line) (picture-end-of-line)))))
(t
(forward-char)
(end-of-line num)))
(tpu-bottom-check beg num)))
(defun tpu-previous-end-of-line (num)
"Move EOL upward.
Accepts a prefix argument for the number of lines to move."
(interactive "p")
(let ((beg (tpu-current-line)))
(cond (tpu-cursor-free-mode
(picture-end-of-line (- 1 num)))
(t
(end-of-line (- 1 num))))
(tpu-top-check beg num)))
(defun tpu-current-end-of-line ()
"Move point to end of current line."
(interactive)
(let ((beg (point)))
(if tpu-cursor-free-mode (picture-end-of-line) (end-of-line))
(if (= beg (point)) (message "You are already at the end of a line."))))
(defun tpu-forward-line (num)
"Move to beginning of next line.
Prefix argument serves as a repeat count."
(interactive "p")
(let ((beg (tpu-current-line)))
(forward-line num)
(tpu-bottom-check beg num)))
(defun tpu-backward-line (num)
"Move to beginning of previous line.
Prefix argument serves as repeat count."
(interactive "p")
(let ((beg (tpu-current-line)))
(or (bolp) (>= 0 num) (setq num (- num 1)))
(forward-line (- num))
(tpu-top-check beg num)))
;;; Movement by paragraph
;; Cf edt-with-position.
(defmacro tpu-with-position (&rest body)
"Execute BODY with some position-related variables bound."
`(let* ((left nil)
(beg (tpu-current-line))
(height (window-height))
(top-percent
(if (zerop tpu-top-scroll-margin) 10 tpu-top-scroll-margin))
(bottom-percent
(if (zerop tpu-bottom-scroll-margin) 15 tpu-bottom-scroll-margin))
(top-margin (/ (* height top-percent) 100))
(bottom-up-margin (1+ (/ (* height bottom-percent) 100)))
(bottom-margin (max beg (- height bottom-up-margin 1)))
(top (save-excursion (move-to-window-line top-margin) (point)))
(bottom (save-excursion (move-to-window-line bottom-margin) (point)))
(far (save-excursion
(goto-char bottom)
(point-at-bol (1- height)))))
,@body))
(defun tpu-paragraph (num)
"Move to the next paragraph in the current direction.
A repeat count means move that many paragraphs."
(interactive "p")
(tpu-with-position
(if tpu-advance
(progn
(tpu-next-paragraph num)
(if (> (point) far)
(if (zerop (setq left (save-excursion (forward-line height))))
(recenter top-margin)
(recenter (- left bottom-up-margin)))
(and (> (point) bottom) (recenter bottom-margin))))
(tpu-previous-paragraph num)
(and (< (point) top) (recenter (min beg top-margin))))))
;;; Movement by page
(defun tpu-page (num)
"Move to the next page in the current direction.
A repeat count means move that many pages."
(interactive "p")
(tpu-with-position
(if tpu-advance
(progn
(forward-page num)
(if (> (point) far)
(if (zerop (setq left (save-excursion (forward-line height))))
(recenter top-margin)
(recenter (- left bottom-up-margin)))
(and (> (point) bottom) (recenter bottom-margin))))
(backward-page num)
(and (< (point) top) (recenter (min beg top-margin))))))
;;; Scrolling
(defun tpu-scroll-window-down (num)
"Scroll the display down to the next section.
A repeat count means scroll that many sections."
(interactive "p")
(let* ((beg (tpu-current-line))
(height (1- (window-height)))
(lines (* num (/ (* height tpu-percent-scroll) 100))))
(line-move (- lines))
(tpu-top-check beg lines)))
(defun tpu-scroll-window-up (num)
"Scroll the display up to the next section.
A repeat count means scroll that many sections."
(interactive "p")
(let* ((beg (tpu-current-line))
(height (1- (window-height)))
(lines (* num (/ (* height tpu-percent-scroll) 100))))
(line-move lines)
(tpu-bottom-check beg lines)))
;;; Replace the TPU-edt internal search function
(defun tpu-search-internal (pat &optional quiet)
"Search for a string or regular expression."
(tpu-with-position
(tpu-search-internal-core pat quiet)
(if tpu-searching-forward
(progn
(if (> (point) far)
(if (zerop (setq left (save-excursion (forward-line height))))
(recenter top-margin)
(recenter (- left bottom-up-margin)))
(and (> (point) bottom) (recenter bottom-margin))))
(and (< (point) top) (recenter (min beg top-margin))))))
;; Advise the newline, newline-and-indent, and do-auto-fill functions.
(defadvice newline (around tpu-respect-bottom-scroll-margin activate disable)
"Respect `tpu-bottom-scroll-margin'."
(let ((beg (tpu-current-line))
(num (prefix-numeric-value (ad-get-arg 0))))
ad-do-it
(tpu-bottom-check beg num)))
(defadvice newline-and-indent (around tpu-respect-bottom-scroll-margin)
"Respect `tpu-bottom-scroll-margin'."
(let ((beg (tpu-current-line)))
ad-do-it
(tpu-bottom-check beg 1)))
(defadvice do-auto-fill (around tpu-respect-bottom-scroll-margin)
"Respect `tpu-bottom-scroll-margin'."
(let ((beg (tpu-current-line)))
ad-do-it
(tpu-bottom-check beg 1)))
;;; Function to set scroll margins
;;;###autoload
(defun tpu-set-scroll-margins (top bottom)
"Set scroll margins."
(interactive
"sEnter top scroll margin (N lines or N%% or RETURN for current value): \
\nsEnter bottom scroll margin (N lines or N%% or RETURN for current value): ")
;; set top scroll margin
(or (string= top "")
(setq tpu-top-scroll-margin
(if (string= "%" (substring top -1))
(string-to-number top)
(/ (1- (+ (* (string-to-number top) 100) (window-height)))
(window-height)))))
;; set bottom scroll margin
(or (string= bottom "")
(setq tpu-bottom-scroll-margin
(if (string= "%" (substring bottom -1))
(string-to-number bottom)
(/ (1- (+ (* (string-to-number bottom) 100) (window-height)))
(window-height)))))
(dolist (f '(newline newline-and-indent do-auto-fill))
(ad-enable-advice f 'around 'tpu-respect-bottom-scroll-margin)
(ad-activate f))
;; report scroll margin settings if running interactively
(and (called-interactively-p 'interactive)
(message "Scroll margins set. Top = %s%%, Bottom = %s%%"
tpu-top-scroll-margin tpu-bottom-scroll-margin)))
;;; Functions to set cursor bound or free
;;;###autoload
(defun tpu-set-cursor-free ()
"Allow the cursor to move freely about the screen."
(interactive)
(tpu-cursor-free-mode 1))
;;;###autoload
(defun tpu-set-cursor-bound ()
"Constrain the cursor to the flow of the text."
(interactive)
(tpu-cursor-free-mode -1))
(provide 'tpu-extras)
;; Local Variables:
;; generated-autoload-file: "tpu-edt.el"
;; End:
;;; tpu-extras.el ends here

353
lisp/obsolete/tpu-mapper.el Normal file
View file

@ -0,0 +1,353 @@
;;; tpu-mapper.el --- create a TPU-edt X-windows keymap file
;; Copyright (C) 1993-1995, 2001-2014 Free Software Foundation, Inc.
;; Author: Rob Riepel <riepel@networking.stanford.edu>
;; Maintainer: Rob Riepel <riepel@networking.stanford.edu>
;; Keywords: emulations
;; Package: tpu-edt
;; Obsolete-since: 24.5
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This Emacs Lisp program can be used to create an Emacs Lisp file that
;; defines the TPU-edt keypad for Emacs running on X-Windows.
;;; Code:
;;;
;;; Key variables
;;;
(defvar tpu-kp4 nil)
(defvar tpu-kp5 nil)
(defvar tpu-key nil)
(defvar tpu-enter nil)
(defvar tpu-return nil)
(defvar tpu-key-seq nil)
(defvar tpu-enter-seq nil)
(defvar tpu-return-seq nil)
;;;
;;; Key mapping function
;;;
(defun tpu-map-key (ident descrip func gold-func)
(interactive)
(if (featurep 'xemacs)
(progn
(setq tpu-key-seq (read-key-sequence
(format "Press %s%s: " ident descrip))
tpu-key (format "[%s]" (event-key (aref tpu-key-seq 0))))
(unless (equal tpu-key tpu-return)
(set-buffer "Keys")
(insert (format"(global-set-key %s %s)\n" tpu-key func))
(set-buffer "Gold-Keys")
(insert (format "(define-key GOLD-map %s %s)\n" tpu-key gold-func))))
(message "Press %s%s: " ident descrip)
(setq tpu-key-seq (read-event)
tpu-key (format "[%s]" tpu-key-seq))
(unless (equal tpu-key tpu-return)
(set-buffer "Keys")
(insert (format"(define-key tpu-global-map %s %s)\n" tpu-key func))
(set-buffer "Gold-Keys")
(insert (format "(define-key tpu-gold-map %s %s)\n" tpu-key gold-func))))
(set-buffer "Directions")
tpu-key)
;;;###autoload
(defun tpu-mapper ()
"Create an Emacs lisp file defining the TPU-edt keypad for X-windows.
This command displays an instruction screen showing the TPU-edt keypad
and asks you to press the TPU-edt editing keys. It uses the keys you
press to create an Emacs Lisp file that will define a TPU-edt keypad
for your X server. You can even re-arrange the standard EDT keypad to
suit your tastes (or to cope with those silly Sun and PC keypads).
Finally, you will be prompted for the name of the file to store the key
definitions. If you chose the default, TPU-edt will find it and load it
automatically. If you specify a different file name, you will need to
set the variable ``tpu-xkeys-file'' before starting TPU-edt. Here's how
you might go about doing that in your init file.
(setq tpu-xkeys-file (expand-file-name \"~/.my-emacs-x-keys\"))
(tpu-edt)
Known Problems:
Sometimes, tpu-mapper will ignore a key you press, and just continue to
prompt for the same key. This can happen when your window manager sucks
up the key and doesn't pass it on to Emacs, or it could be an Emacs bug.
Either way, there's nothing that tpu-mapper can do about it. You must
press RETURN, to skip the current key and continue. Later, you and/or
your local X guru can try to figure out why the key is being ignored."
(interactive)
;; Make sure we're running X-windows
(if (not window-system)
(error "tpu-mapper requires running Emacs with an X display"))
;; Make sure the window is big enough to display the instructions
(if (featurep 'xemacs) (set-screen-size (selected-screen) 80 36)
(set-frame-size (selected-frame) 80 36))
;; Create buffers - Directions, Keys, Gold-Keys
(if (not (get-buffer "Directions")) (generate-new-buffer "Directions"))
(if (not (get-buffer "Keys")) (generate-new-buffer "Keys"))
(if (not (get-buffer "Gold-Keys")) (generate-new-buffer "Gold-Keys"))
;; Put headers in the Keys buffer
(set-buffer "Keys")
(insert "\
;; Key definitions for TPU-edt
;;
")
;; Display directions
(switch-to-buffer "Directions")
(insert "
This program prompts you to press keys to create a custom keymap file
for use with the x-windows version of Emacs and TPU-edt.
Start by pressing the RETURN key, and continue by pressing the keys
specified in the mini-buffer. You can re-arrange the TPU-edt keypad
by pressing any key you want at any prompt. If you want to entirely
omit a key, just press RETURN at the prompt.
Here's a picture of the standard TPU/edt keypad for reference:
_______________________ _______________________________
| HELP | Do | | | | | |
|KeyDefs| | | | | | |
|_______|_______________| |_______|_______|_______|_______|
_______________________ _______________________________
| Find |Insert |Remove | | Gold | HELP |FndNxt | Del L |
| | |Sto Tex| | key |E-Help | Find |Undel L|
|_______|_______|_______| |_______|_______|_______|_______|
|Select |Pre Scr|Nex Scr| | Page | Sect |Append | Del W |
| Reset |Pre Win|Nex Win| | Do | Fill |Replace|Undel W|
|_______|_______|_______| |_______|_______|_______|_______|
|Move up| |Forward|Reverse|Remove | Del C |
| Top | |Bottom | Top |Insert |Undel C|
_______|_______|_______ |_______|_______|_______|_______|
|Mov Lef|Mov Dow|Mov Rig| | Word | EOL | Char | |
|StaOfLi|Bottom |EndOfLi| |ChngCas|Del EOL|SpecIns| Enter |
|_______|_______|_______| |_______|_______|_______| |
| Line |Select | Subs |
| Open Line | Reset | |
|_______________|_______|_______|
")
(delete-other-windows)
(goto-char (point-min))
;; Save <CR> for future reference
(cond
((featurep 'xemacs)
(setq tpu-return-seq (read-key-sequence "Hit carriage-return <CR> to continue "))
(setq tpu-return (concat "[" (format "%s" (event-key (aref tpu-return-seq 0))) "]")))
(t
(message "Hit carriage-return <CR> to continue ")
(setq tpu-return-seq (read-event))
(setq tpu-return (concat "[" (format "%s" tpu-return-seq) "]"))))
;; Build the keymap file
(set-buffer "Keys")
(insert "
;; Arrows
;;
")
(set-buffer "Gold-Keys")
(insert "
;; GOLD Arrows
;;
")
(set-buffer "Directions")
(tpu-map-key "Up-Arrow" "" "'tpu-previous-line" "'tpu-move-to-beginning")
(tpu-map-key "Down-arrow" "" "'tpu-next-line" "'tpu-move-to-end")
(tpu-map-key "Right-arrow" "" "'tpu-forward-char" "'end-of-line")
(tpu-map-key "Left-arrow" "" "'tpu-backward-char" "'beginning-of-line")
(set-buffer "Keys")
(insert "
;; PF keys
;;
")
(set-buffer "Gold-Keys")
(insert "
;; GOLD PF keys
;;
")
(set-buffer "Directions")
(tpu-map-key "PF1" " - The GOLD key" "GOLD-map" "'keyboard-quit")
(tpu-map-key "PF2" " - The Keypad Help key" "'tpu-help" "'help-for-help")
(tpu-map-key "PF3" " - The Find/Find-Next key" "'tpu-search-again" "'tpu-search")
(tpu-map-key "PF4" " - The Del/Undelete Line key" "'tpu-delete-current-line" "'tpu-undelete-lines")
(set-buffer "Keys")
(insert "
;; KP0-9 KP- KP, KP. and KPenter
;;
")
(set-buffer "Gold-Keys")
(insert "
;; GOLD KP0-9 KP- KP, and KPenter
;;
")
(set-buffer "Directions")
(tpu-map-key "KP-0" " - The Line/Open-Line key" "'tpu-line" "'open-line")
(tpu-map-key "KP-1" " - The Word/Change-Case key" "'tpu-word" "'tpu-change-case")
(tpu-map-key "KP-2" " - The EOL/Delete-EOL key" "'tpu-end-of-line" "'tpu-delete-to-eol")
(tpu-map-key "KP-3" " - The Character/Special-Insert key" "'tpu-char" "'tpu-special-insert")
(setq tpu-kp4 (tpu-map-key "KP-4" " - The Forward/Bottom key" "'tpu-advance-direction" "'tpu-move-to-end"))
(setq tpu-kp5 (tpu-map-key "KP-5" " - The Reverse/Top key" "'tpu-backup-direction" "'tpu-move-to-beginning"))
(tpu-map-key "KP-6" " - The Remove/Insert key" "'tpu-cut" "'tpu-paste")
(tpu-map-key "KP-7" " - The Page/Do key" "'tpu-page" "'execute-extended-command")
(tpu-map-key "KP-8" " - The Section/Fill key" "'tpu-scroll-window" "'tpu-fill")
(tpu-map-key "KP-9" " - The Append/Replace key" "'tpu-append-region" "'tpu-replace")
(tpu-map-key "KP--" " - The Delete/Undelete Word key" "'tpu-delete-current-word" "'tpu-undelete-words")
(tpu-map-key "KP-," " - The Delete/Undelete Character key" "'tpu-delete-current-char" "'tpu-undelete-char")
(tpu-map-key "KP-." " - The Select/Reset key" "'tpu-select" "'tpu-unselect")
(tpu-map-key "KP-Enter" " - The Enter key on the numeric keypad" "'newline" "'tpu-substitute")
;; Save the enter key
(setq tpu-enter tpu-key)
(setq tpu-enter-seq tpu-key-seq)
(set-buffer "Keys")
(insert "
;; Editing keypad (find, insert, remove)
;; (select, prev, next)
;;
")
(set-buffer "Gold-Keys")
(insert "
;; GOLD Editing keypad (find, insert, remove)
;; (select, prev, next)
;;
")
(set-buffer "Directions")
(tpu-map-key "Find" " - The Find key on the editing keypad" "'tpu-search" "'nil")
(tpu-map-key "Insert" " - The Insert key on the editing keypad" "'tpu-paste" "'nil")
(tpu-map-key "Remove" " - The Remove key on the editing keypad" "'tpu-cut" "'tpu-store-text")
(tpu-map-key "Select" " - The Select key on the editing keypad" "'tpu-select" "'tpu-unselect")
(tpu-map-key "Prev Scr" " - The Prev Scr key on the editing keypad" "'tpu-scroll-window-down" "'tpu-previous-window")
(tpu-map-key "Next Scr" " - The Next Scr key on the editing keypad" "'tpu-scroll-window-up" "'tpu-next-window")
(set-buffer "Keys")
(insert "
;; F10-14 Help Do F17
;;
")
(set-buffer "Gold-Keys")
(insert "
;; GOLD F10-14 Help Do F17
;;
")
(set-buffer "Directions")
(tpu-map-key "F10" " - Invokes the Exit function on VT200+ terminals" "'tpu-exit" "'nil")
(tpu-map-key "F11" " - Inserts an Escape character into the text" "'tpu-insert-escape" "'nil")
(tpu-map-key "Backspace" " - Not Delete nor ^H! Sometimes on the F12 key" "'tpu-next-beginning-of-line" "'nil")
(tpu-map-key "F13" " - Invokes the delete previous word function" "'tpu-delete-previous-word" "'nil")
(tpu-map-key "F14" " - Toggles insert/overstrike modes" "'tpu-toggle-overwrite-mode" "'nil")
(tpu-map-key "Help" " - Brings up the help screen, same as PF2" "'tpu-help" "'describe-bindings")
(tpu-map-key "Do" " - Invokes the COMMAND function" "'execute-extended-command" "'nil")
(tpu-map-key "F17" "" "'tpu-goto-breadcrumb" "'tpu-drop-breadcrumb")
(set-buffer "Gold-Keys")
(cond
((not (equal tpu-enter tpu-return))
(insert "
;; Minibuffer map additions to make KP_enter = RET
;;
")
(insert (format "(define-key minibuffer-local-map %s 'exit-minibuffer)\n" tpu-enter))
;; These are not necessary because they are inherited.
;; (insert (format "(define-key minibuffer-local-ns-map %s 'exit-minibuffer)\n" tpu-enter))
;; (insert (format "(define-key minibuffer-local-completion-map %s 'exit-minibuffer)\n" tpu-enter))
(insert (format "(define-key minibuffer-local-must-match-map %s 'minibuffer-complete-and-exit)\n" tpu-enter))))
(cond
((not (or (equal tpu-kp4 tpu-return) (equal tpu-kp5 tpu-return)))
(insert "
;; Minibuffer map additions to allow KP-4/5 termination of search strings.
;;
")
(insert (format "(define-key minibuffer-local-map %s 'tpu-search-forward-exit)\n" tpu-kp4))
(insert (format "(define-key minibuffer-local-map %s 'tpu-search-backward-exit)\n" tpu-kp5))))
(insert "
;; Define the tpu-help-enter/return symbols
;;
")
(cond ((featurep 'xemacs)
(insert (format "(setq tpu-help-enter \"%s\")\n" tpu-enter-seq))
(insert (format "(setq tpu-help-return \"%s\")\n" tpu-return-seq))
(insert "(setq tpu-help-N \"[#<keypress-event N>]\")\n")
(insert "(setq tpu-help-n \"[#<keypress-event n>]\")\n")
(insert "(setq tpu-help-P \"[#<keypress-event P>]\")\n")
(insert "(setq tpu-help-p \"[#<keypress-event p>]\")\n"))
(t
(insert (format "(setq tpu-help-enter \"%s\")\n" tpu-enter))))
(append-to-buffer "Keys" 1 (point))
(set-buffer "Keys")
;; Save the key mapping program
(let ((file
(convert-standard-filename
(if (featurep 'xemacs) "~/.tpu-lucid-keys" "~/.tpu-keys"))))
(set-visited-file-name
(read-file-name (format "Save key mapping to file (default %s): " file) "" file)))
(save-buffer)
;; Load the newly defined keys and clean up
(require 'tpu-edt)
(eval-buffer)
(kill-buffer (current-buffer))
(kill-buffer "*scratch*")
(kill-buffer "Gold-Keys")
;; Let them know it worked.
(switch-to-buffer "Directions")
(erase-buffer)
(insert "
A custom TPU-edt keymap file has been created.
Press GOLD-k to remove this buffer and continue editing.
")
(goto-char (point-min)))
;;; tpu-mapper.el ends here

1495
lisp/obsolete/vi.el Normal file
View file

File diff suppressed because it is too large Load diff

3062
lisp/obsolete/vip.el Normal file
View file

File diff suppressed because it is too large Load diff

643
lisp/obsolete/ws-mode.el Normal file
View file

@ -0,0 +1,643 @@
;;; ws-mode.el --- WordStar emulation mode for GNU Emacs
;; Copyright (C) 1991, 2001-2014 Free Software Foundation, Inc.
;; Author: Juergen Nickelsen <nickel@cs.tu-berlin.de>
;; Version: 0.7
;; Keywords: emulations
;; Obsolete-since: 24.5
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This emulates WordStar, with a major mode.
;;; Code:
(defvar wordstar-C-k-map
(let ((map (make-keymap)))
(define-key map " " ())
(define-key map "0" 'ws-set-marker-0)
(define-key map "1" 'ws-set-marker-1)
(define-key map "2" 'ws-set-marker-2)
(define-key map "3" 'ws-set-marker-3)
(define-key map "4" 'ws-set-marker-4)
(define-key map "5" 'ws-set-marker-5)
(define-key map "6" 'ws-set-marker-6)
(define-key map "7" 'ws-set-marker-7)
(define-key map "8" 'ws-set-marker-8)
(define-key map "9" 'ws-set-marker-9)
(define-key map "b" 'ws-begin-block)
(define-key map "\C-b" 'ws-begin-block)
(define-key map "c" 'ws-copy-block)
(define-key map "\C-c" 'ws-copy-block)
(define-key map "d" 'save-buffers-kill-emacs)
(define-key map "\C-d" 'save-buffers-kill-emacs)
(define-key map "f" 'find-file)
(define-key map "\C-f" 'find-file)
(define-key map "h" 'ws-show-markers)
(define-key map "\C-h" 'ws-show-markers)
(define-key map "i" 'ws-indent-block)
(define-key map "\C-i" 'ws-indent-block)
(define-key map "k" 'ws-end-block)
(define-key map "\C-k" 'ws-end-block)
(define-key map "p" 'ws-print-block)
(define-key map "\C-p" 'ws-print-block)
(define-key map "q" 'kill-emacs)
(define-key map "\C-q" 'kill-emacs)
(define-key map "r" 'insert-file)
(define-key map "\C-r" 'insert-file)
(define-key map "s" 'save-some-buffers)
(define-key map "\C-s" 'save-some-buffers)
(define-key map "t" 'ws-mark-word)
(define-key map "\C-t" 'ws-mark-word)
(define-key map "u" 'ws-exdent-block)
(define-key map "\C-u" 'keyboard-quit)
(define-key map "v" 'ws-move-block)
(define-key map "\C-v" 'ws-move-block)
(define-key map "w" 'ws-write-block)
(define-key map "\C-w" 'ws-write-block)
(define-key map "x" 'save-buffers-kill-emacs)
(define-key map "\C-x" 'save-buffers-kill-emacs)
(define-key map "y" 'ws-delete-block)
(define-key map "\C-y" 'ws-delete-block)
map))
(defvar wordstar-C-o-map
(let ((map (make-keymap)))
(define-key map " " ())
(define-key map "c" 'wordstar-center-line)
(define-key map "\C-c" 'wordstar-center-line)
(define-key map "b" 'switch-to-buffer)
(define-key map "\C-b" 'switch-to-buffer)
(define-key map "j" 'justify-current-line)
(define-key map "\C-j" 'justify-current-line)
(define-key map "k" 'kill-buffer)
(define-key map "\C-k" 'kill-buffer)
(define-key map "l" 'list-buffers)
(define-key map "\C-l" 'list-buffers)
(define-key map "m" 'auto-fill-mode)
(define-key map "\C-m" 'auto-fill-mode)
(define-key map "r" 'set-fill-column)
(define-key map "\C-r" 'set-fill-column)
(define-key map "\C-u" 'keyboard-quit)
(define-key map "wd" 'delete-other-windows)
(define-key map "wh" 'split-window-right)
(define-key map "wo" 'other-window)
(define-key map "wv" 'split-window-below)
map)
"")
(defvar wordstar-C-q-map
(let ((map (make-keymap)))
(define-key map " " ())
(define-key map "0" 'ws-find-marker-0)
(define-key map "1" 'ws-find-marker-1)
(define-key map "2" 'ws-find-marker-2)
(define-key map "3" 'ws-find-marker-3)
(define-key map "4" 'ws-find-marker-4)
(define-key map "5" 'ws-find-marker-5)
(define-key map "6" 'ws-find-marker-6)
(define-key map "7" 'ws-find-marker-7)
(define-key map "8" 'ws-find-marker-8)
(define-key map "9" 'ws-find-marker-9)
(define-key map "a" 'ws-query-replace)
(define-key map "\C-a" 'ws-query-replace)
(define-key map "b" 'ws-goto-block-begin)
(define-key map "\C-b" 'ws-goto-block-begin)
(define-key map "c" 'end-of-buffer)
(define-key map "\C-c" 'end-of-buffer)
(define-key map "d" 'end-of-line)
(define-key map "\C-d" 'end-of-line)
(define-key map "f" 'ws-search)
(define-key map "\C-f" 'ws-search)
(define-key map "k" 'ws-goto-block-end)
(define-key map "\C-k" 'ws-goto-block-end)
(define-key map "l" 'ws-undo)
(define-key map "\C-l" 'ws-undo)
(define-key map "p" 'ws-last-cursorp)
(define-key map "\C-p" 'ws-last-cursorp)
(define-key map "r" 'beginning-of-buffer)
(define-key map "\C-r" 'beginning-of-buffer)
(define-key map "s" 'beginning-of-line)
(define-key map "\C-s" 'beginning-of-line)
(define-key map "\C-u" 'keyboard-quit)
(define-key map "w" 'ws-last-error)
(define-key map "\C-w" 'ws-last-error)
(define-key map "y" 'ws-kill-eol)
(define-key map "\C-y" 'ws-kill-eol)
(define-key map "\177" 'ws-kill-bol)
map))
(defvar wordstar-mode-map
(let ((map (make-keymap)))
(define-key map "\C-a" 'backward-word)
(define-key map "\C-b" 'fill-paragraph)
(define-key map "\C-c" 'scroll-up-command)
(define-key map "\C-d" 'forward-char)
(define-key map "\C-e" 'previous-line)
(define-key map "\C-f" 'forward-word)
(define-key map "\C-g" 'delete-char)
(define-key map "\C-h" 'backward-char)
(define-key map "\C-i" 'indent-for-tab-command)
(define-key map "\C-j" 'help-for-help)
(define-key map "\C-k" wordstar-C-k-map)
(define-key map "\C-l" 'ws-repeat-search)
(define-key map "\C-n" 'open-line)
(define-key map "\C-o" wordstar-C-o-map)
(define-key map "\C-p" 'quoted-insert)
(define-key map "\C-q" wordstar-C-q-map)
(define-key map "\C-r" 'scroll-down-command)
(define-key map "\C-s" 'backward-char)
(define-key map "\C-t" 'kill-word)
(define-key map "\C-u" 'keyboard-quit)
(define-key map "\C-v" 'overwrite-mode)
(define-key map "\C-w" 'scroll-down-line)
(define-key map "\C-x" 'next-line)
(define-key map "\C-y" 'kill-complete-line)
(define-key map "\C-z" 'scroll-up-line)
map))
;; wordstar-C-j-map not yet implemented
(defvar wordstar-C-j-map nil)
(put 'wordstar-mode 'mode-class 'special)
;;;###autoload
(define-derived-mode wordstar-mode fundamental-mode "WordStar"
"Major mode with WordStar-like key bindings.
BUGS:
- Help menus with WordStar commands (C-j just calls help-for-help)
are not implemented
- Options for search and replace
- Show markers (C-k h) is somewhat strange
- Search and replace (C-q a) is only available in forward direction
No key bindings beginning with ESC are installed, they will work
Emacs-like.")
(defun wordstar-center-paragraph ()
"Center each line in the paragraph at or after point.
See `wordstar-center-line' for more info."
(interactive)
(save-excursion
(forward-paragraph)
(or (bolp) (newline 1))
(let ((end (point)))
(backward-paragraph)
(wordstar-center-region (point) end))))
(defun wordstar-center-region (from to)
"Center each line starting in the region.
See `wordstar-center-line' for more info."
(interactive "r")
(if (> from to)
(let ((tem to))
(setq to from from tem)))
(save-excursion
(save-restriction
(narrow-to-region from to)
(goto-char from)
(while (not (eobp))
(wordstar-center-line)
(forward-line 1)))))
(defun wordstar-center-line ()
"Center the line point is on, within the width specified by `fill-column'.
This means adjusting the indentation to match
the distance between the end of the text and `fill-column'."
(interactive)
(save-excursion
(let (line-length)
(beginning-of-line)
(delete-horizontal-space)
(end-of-line)
(delete-horizontal-space)
(setq line-length (current-column))
(beginning-of-line)
(indent-to
(+ left-margin
(/ (- fill-column left-margin line-length) 2))))))
;;;;;;;;;;;
;; wordstar special variables:
(defvar ws-marker-0 nil "Position marker 0 in WordStar mode.")
(defvar ws-marker-1 nil "Position marker 1 in WordStar mode.")
(defvar ws-marker-2 nil "Position marker 2 in WordStar mode.")
(defvar ws-marker-3 nil "Position marker 3 in WordStar mode.")
(defvar ws-marker-4 nil "Position marker 4 in WordStar mode.")
(defvar ws-marker-5 nil "Position marker 5 in WordStar mode.")
(defvar ws-marker-6 nil "Position marker 6 in WordStar mode.")
(defvar ws-marker-7 nil "Position marker 7 in WordStar mode.")
(defvar ws-marker-8 nil "Position marker 8 in WordStar mode.")
(defvar ws-marker-9 nil "Position marker 9 in WordStar mode.")
(defvar ws-block-begin-marker nil "Beginning of \"Block\" in WordStar mode.")
(defvar ws-block-end-marker nil "End of \"Block\" in WordStar mode.")
(defvar ws-search-string nil "String of last search in WordStar mode.")
(defvar ws-search-direction t
"Direction of last search in WordStar mode. t if forward, nil if backward.")
(defvar ws-last-cursorposition nil
"Position before last search etc. in WordStar mode.")
(defvar ws-last-errormessage nil
"Last error message issued by a WordStar mode function.")
;;;;;;;;;;;
;; wordstar special functions:
(defun ws-error (string)
"Report error of a WordStar special function. Error message is saved
in ws-last-errormessage for recovery with C-q w."
(setq ws-last-errormessage string)
(error string))
(defun ws-set-marker-0 ()
"In WordStar mode: Set marker 0 to current cursor position."
(interactive)
(setq ws-marker-0 (point-marker))
(message "Marker 0 set"))
(defun ws-set-marker-1 ()
"In WordStar mode: Set marker 1 to current cursor position."
(interactive)
(setq ws-marker-1 (point-marker))
(message "Marker 1 set"))
(defun ws-set-marker-2 ()
"In WordStar mode: Set marker 2 to current cursor position."
(interactive)
(setq ws-marker-2 (point-marker))
(message "Marker 2 set"))
(defun ws-set-marker-3 ()
"In WordStar mode: Set marker 3 to current cursor position."
(interactive)
(setq ws-marker-3 (point-marker))
(message "Marker 3 set"))
(defun ws-set-marker-4 ()
"In WordStar mode: Set marker 4 to current cursor position."
(interactive)
(setq ws-marker-4 (point-marker))
(message "Marker 4 set"))
(defun ws-set-marker-5 ()
"In WordStar mode: Set marker 5 to current cursor position."
(interactive)
(setq ws-marker-5 (point-marker))
(message "Marker 5 set"))
(defun ws-set-marker-6 ()
"In WordStar mode: Set marker 6 to current cursor position."
(interactive)
(setq ws-marker-6 (point-marker))
(message "Marker 6 set"))
(defun ws-set-marker-7 ()
"In WordStar mode: Set marker 7 to current cursor position."
(interactive)
(setq ws-marker-7 (point-marker))
(message "Marker 7 set"))
(defun ws-set-marker-8 ()
"In WordStar mode: Set marker 8 to current cursor position."
(interactive)
(setq ws-marker-8 (point-marker))
(message "Marker 8 set"))
(defun ws-set-marker-9 ()
"In WordStar mode: Set marker 9 to current cursor position."
(interactive)
(setq ws-marker-9 (point-marker))
(message "Marker 9 set"))
(defun ws-begin-block ()
"In WordStar mode: Set block begin marker to current cursor position."
(interactive)
(setq ws-block-begin-marker (point-marker))
(message "Block begin marker set"))
(defun ws-show-markers ()
"In WordStar mode: Show block markers."
(interactive)
(if (or ws-block-begin-marker ws-block-end-marker)
(save-excursion
(if ws-block-begin-marker
(progn
(goto-char ws-block-begin-marker)
(message "Block begin marker")
(sit-for 2))
(message "Block begin marker not set")
(sit-for 2))
(if ws-block-end-marker
(progn
(goto-char ws-block-end-marker)
(message "Block end marker")
(sit-for 2))
(message "Block end marker not set"))
(message ""))
(message "Block markers not set")))
(defun ws-indent-block ()
"In WordStar mode: Indent block (not yet implemented)."
(interactive)
(ws-error "Indent block not yet implemented"))
(defun ws-end-block ()
"In WordStar mode: Set block end marker to current cursor position."
(interactive)
(setq ws-block-end-marker (point-marker))
(message "Block end marker set"))
(defun ws-print-block ()
"In WordStar mode: Print block."
(interactive)
(message "Don't do this. Write block to a file (C-k w) and print this file."))
(defun ws-mark-word ()
"In WordStar mode: Mark current word as block."
(interactive)
(save-excursion
(forward-word 1)
(sit-for 1)
(ws-end-block)
(forward-word -1)
(sit-for 1)
(ws-begin-block)))
(defun ws-exdent-block ()
"I don't know what this (C-k u) should do."
(interactive)
(ws-error "This won't be done -- not yet implemented."))
(defun ws-move-block ()
"In WordStar mode: Move block to current cursor position."
(interactive)
(if (and ws-block-begin-marker ws-block-end-marker)
(progn
(kill-region ws-block-begin-marker ws-block-end-marker)
(yank)
(save-excursion
(goto-char (region-beginning))
(setq ws-block-begin-marker (point-marker))
(goto-char (region-end))
(setq ws-block-end-marker (point-marker))))
(ws-error (cond (ws-block-begin-marker "Block end marker not set")
(ws-block-end-marker "Block begin marker not set")
(t "Block markers not set")))))
(defun ws-write-block ()
"In WordStar mode: Write block to file."
(interactive)
(if (and ws-block-begin-marker ws-block-end-marker)
(let ((filename (read-file-name "Write block to file: ")))
(write-region ws-block-begin-marker ws-block-end-marker filename))
(ws-error (cond (ws-block-begin-marker "Block end marker not set")
(ws-block-end-marker "Block begin marker not set")
(t "Block markers not set")))))
(defun ws-delete-block ()
"In WordStar mode: Delete block."
(interactive)
(if (and ws-block-begin-marker ws-block-end-marker)
(progn
(kill-region ws-block-begin-marker ws-block-end-marker)
(setq ws-block-end-marker nil)
(setq ws-block-begin-marker nil))
(ws-error (cond (ws-block-begin-marker "Block end marker not set")
(ws-block-end-marker "Block begin marker not set")
(t "Block markers not set")))))
(defun ws-find-marker-0 ()
"In WordStar mode: Go to marker 0."
(interactive)
(if ws-marker-0
(progn
(setq ws-last-cursorposition (point-marker))
(goto-char ws-marker-0))
(ws-error "Marker 0 not set")))
(defun ws-find-marker-1 ()
"In WordStar mode: Go to marker 1."
(interactive)
(if ws-marker-1
(progn
(setq ws-last-cursorposition (point-marker))
(goto-char ws-marker-1))
(ws-error "Marker 1 not set")))
(defun ws-find-marker-2 ()
"In WordStar mode: Go to marker 2."
(interactive)
(if ws-marker-2
(progn
(setq ws-last-cursorposition (point-marker))
(goto-char ws-marker-2))
(ws-error "Marker 2 not set")))
(defun ws-find-marker-3 ()
"In WordStar mode: Go to marker 3."
(interactive)
(if ws-marker-3
(progn
(setq ws-last-cursorposition (point-marker))
(goto-char ws-marker-3))
(ws-error "Marker 3 not set")))
(defun ws-find-marker-4 ()
"In WordStar mode: Go to marker 4."
(interactive)
(if ws-marker-4
(progn
(setq ws-last-cursorposition (point-marker))
(goto-char ws-marker-4))
(ws-error "Marker 4 not set")))
(defun ws-find-marker-5 ()
"In WordStar mode: Go to marker 5."
(interactive)
(if ws-marker-5
(progn
(setq ws-last-cursorposition (point-marker))
(goto-char ws-marker-5))
(ws-error "Marker 5 not set")))
(defun ws-find-marker-6 ()
"In WordStar mode: Go to marker 6."
(interactive)
(if ws-marker-6
(progn
(setq ws-last-cursorposition (point-marker))
(goto-char ws-marker-6))
(ws-error "Marker 6 not set")))
(defun ws-find-marker-7 ()
"In WordStar mode: Go to marker 7."
(interactive)
(if ws-marker-7
(progn
(setq ws-last-cursorposition (point-marker))
(goto-char ws-marker-7))
(ws-error "Marker 7 not set")))
(defun ws-find-marker-8 ()
"In WordStar mode: Go to marker 8."
(interactive)
(if ws-marker-8
(progn
(setq ws-last-cursorposition (point-marker))
(goto-char ws-marker-8))
(ws-error "Marker 8 not set")))
(defun ws-find-marker-9 ()
"In WordStar mode: Go to marker 9."
(interactive)
(if ws-marker-9
(progn
(setq ws-last-cursorposition (point-marker))
(goto-char ws-marker-9))
(ws-error "Marker 9 not set")))
(defun ws-goto-block-begin ()
"In WordStar mode: Go to block begin marker."
(interactive)
(if ws-block-begin-marker
(progn
(setq ws-last-cursorposition (point-marker))
(goto-char ws-block-begin-marker))
(ws-error "Block begin marker not set")))
(defun ws-search (string)
"In WordStar mode: Search string, remember string for repetition."
(interactive "sSearch for: ")
(message "Forward (f) or backward (b)")
(let ((direction
(read-char)))
(cond ((equal (upcase direction) ?F)
(setq ws-search-string string)
(setq ws-search-direction t)
(setq ws-last-cursorposition (point-marker))
(search-forward string))
((equal (upcase direction) ?B)
(setq ws-search-string string)
(setq ws-search-direction nil)
(setq ws-last-cursorposition (point-marker))
(search-backward string))
(t (keyboard-quit)))))
(defun ws-goto-block-end ()
"In WordStar mode: Go to block end marker."
(interactive)
(if ws-block-end-marker
(progn
(setq ws-last-cursorposition (point-marker))
(goto-char ws-block-end-marker))
(ws-error "Block end marker not set")))
(defun ws-undo ()
"In WordStar mode: Undo and give message about undoing more changes."
(interactive)
(undo)
(message "Repeat C-q l to undo more changes."))
(defun ws-goto-last-cursorposition ()
"In WordStar mode: "
(interactive)
(if ws-last-cursorposition
(progn
(setq ws-last-cursorposition (point-marker))
(goto-char ws-last-cursorposition))
(ws-error "No last cursor position available.")))
(defun ws-last-error ()
"In WordStar mode: repeat last error message.
This will only work for errors raised by WordStar mode functions."
(interactive)
(if ws-last-errormessage
(message "%s" ws-last-errormessage)
(message "No WordStar error yet.")))
(defun ws-kill-eol ()
"In WordStar mode: Kill to end of line (like WordStar, not like Emacs)."
(interactive)
(let ((p (point)))
(end-of-line)
(kill-region p (point))))
(defun ws-kill-bol ()
"In WordStar mode: Kill to beginning of line
\(like WordStar, not like Emacs)."
(interactive)
(let ((p (point)))
(beginning-of-line)
(kill-region (point) p)))
(defun kill-complete-line ()
"Kill the complete line."
(interactive)
(beginning-of-line)
(if (eobp) (error "End of buffer"))
(let ((beg (point)))
(forward-line 1)
(kill-region beg (point))))
(defun ws-repeat-search ()
"In WordStar mode: Repeat last search."
(interactive)
(setq ws-last-cursorposition (point-marker))
(if ws-search-string
(if ws-search-direction
(search-forward ws-search-string)
(search-backward ws-search-string))
(ws-error "No search to repeat")))
(defun ws-query-replace (from to)
"In WordStar mode: Search string, remember string for repetition."
(interactive "sReplace: \n\
sWith: " )
(setq ws-search-string from)
(setq ws-search-direction t)
(setq ws-last-cursorposition (point-marker))
(query-replace from to))
(defun ws-copy-block ()
"In WordStar mode: Copy block to current cursor position."
(interactive)
(if (and ws-block-begin-marker ws-block-end-marker)
(progn
(copy-region-as-kill ws-block-begin-marker ws-block-end-marker)
(yank)
(save-excursion
(goto-char (region-beginning))
(setq ws-block-begin-marker (point-marker))
(goto-char (region-end))
(setq ws-block-end-marker (point-marker))))
(ws-error (cond (ws-block-begin-marker "Block end marker not set")
(ws-block-end-marker "Block begin marker not set")
(t "Block markers not set")))))
(provide 'ws-mode)
;;; ws-mode.el ends here