-;;; edt.el --- EDT emulation in Emacs
+;;; edt.el --- Enhanced EDT Keypad Mode Emulation for GNU Emacs 19
-;; Copyright (C) 1986 Free Software Foundation, Inc.
+;; Copyright (C) 1986, 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
-;; Author: Mike Clarkson <mike@yetti.UUCP>
-;; Maintainer: FSF
-;; Created: 27 Aug 1986
+;; Author: Kevin Gallagher <kgallagh@spd.dsccc.com>
+;; Maintainer: Kevin Gallagher <kgallagh@spd.dsccc.com>
+;; Version: 3.0.2
;; Keywords: emulations
-;; This started from public domain code by Mike Clarkson
-;; but has been greatly altered.
-
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-;;; Commentary:
-
-;; Here's my EDT emulation for GNU Emacs that is based on the EDT emulation
-;; for Gosling's Emacs sent out on the net a couple of years ago by Lynn Olson
-;; at Tektronics. This emulation was widely distributed as the file edt.ml
-;; in the maclib directory of most Emacs distributions.
-;;
-;; I will gladly take all criticisms and complaints to heart, and will fix what
-;; bugs I can find. As this is my first Emacs Lisp hack, you may have to root
-;; out a few nasties hidden in the code. Please let me know if you find any
-;; (sorry, no rewards :-). I would also be interested if there are better,
-;; cleaner, faster ways of doing some of the things that I have done.
-;;
-;; You must understand some design considerations that I had in mind.
-;; The intention was not really to "emulate" EDT, but rather to take advantage
-;; of the years of EDT experience that had accumulated in my right hand,
-;; while at the same time taking advantage of EMACS.
-;;
-;; Some major differences are:
-;;
-;; HELP is describe-key;
-;; GOLD/HELP is describe-function;
-;; FIND is isearch-forward/backward;
-;; GOLD/HELP is occur-menu, which finds all instances of a search string;
-;; ENTER is other-window;
-;; SUBS is subprocess-command. Note that you have to change this
-;; to `shell' if you are running Un*x;
-;; PAGE is next-paragraph, because that's more useful than page.
-;; SPECINS is copy-to-killring;
-;; GOLD/GOLD is mark-section-wisely, which is my command to mark the
-;; section in a manner consistent with the major-mode. It
-;; uses mark-defun for emacs-lisp, lisp, mark-c-function for C,
-;; and mark-paragraph for other modes.
-;;
-;;
-;; Some subtle differences are:
-;;
-;; APPEND is append-to-buffer. One doesn't append to the kill ring
-;; much and SPECINS is now copy-to-killring;
-;; REPLACE is replace-regexp;
-;; FILL is fill-region-wisely, which uses indent-region for C, lisp
-;; emacs-lisp, and fill-region for others. It asks if you
-;; really want to fill-region in TeX-mode, because I find this
-;; to be very dangerous.
-;; CHNGCASE is case-flip for the character under the cursor only.
-;; I felt that case-flip region is unlikely, as usually you
-;; upcase-region or downcase region. Also, unlike EDT it
-;; is independent of the direction you are going, as that
-;; drives me nuts.
-;;
-;; I use Emacs definition of what a word is. This is considerably different
-;; from what EDT thinks a word is. This is not good for dyed-in-the-wool EDT
-;; fans, but is probably preferable for experienced Emacs users. My assumption
-;; is that the former are a dying breed now that GNU Emacs has made it to VMS,
-;; but let me know how you feel. Also, when you undelete a word it leave the
-;; point at the end of the undeleted text, rather than the beginning. I might
-;; change this as I'm not sure if I like this or not. I'm also not sure if I
-;; want it to set the mark each time you delete a character or word.
-;;
-;; Backspace does not invoke beginning-of-line, because ^H is the help prefix,
-;; and I felt it should be left as such. You can change this if you like.
-;;
-;; The ADVANCE and BACKUP keys do not work as terminators for forward or
-;; backward searches. In Emacs, all search strings are terminated by return.
-;; The searches will however go forward or backward depending on your current
-;; direction. Also, when you change directions, the mode line will not be
-;; updated immediately, but only when you next execute an emacs function.
-;; Personally, I consider this to be a bug, not a feature.
-;;
-;; This should also work with VT-2xx's, though I haven't tested it extensively
-;; on those terminals. It assumes that the CSI-map of vt_200.el has been
-;; defined.
-;;
-;; There are also a whole bunch of GOLD letter, and GOLD character bindings:
-;; look at edtdoc.el for them, or better still, look at the edt.el lisp code,
-;; because after all, in the true Lisp tradition, the source code is *assumed*
-;; to be self-documenting :-)
-;;
-;; Mike Clarkson, ...!allegra \ BITNET: mike@YUYETTI or
-;; CRESS, York University, ...!decvax \ SYMALG@YUSOL
-;; 4700 Keele Street, ...!ihnp4 > !utzoo!yetti!mike
-;; North York, Ontario, ...!linus /
-;; CANADA M3J 1P3. ...!watmath / Phone: +1 (416) 736-2100 x 7767
-;;
-;; Note that I am not on ARPA, and must gateway any ARPA mail through BITNET or
-;; UUCP. If you have a UUCP or BITNET address please use it for communication
-;; so that I can reach you directly. If you have both, the BITNET address
-;; is preferred.
-
-;;; Code:
+;;; Usage:
+
+;; See edt-user.doc
+
+;; ====================================================================
+\f
+;;; Electric Help functions are used for keypad help displays. A few
+;;; picture functions are used in rectangular cut and paste commands.
+(require 'ehelp)
+(require 'picture)
+
+;;;;
+;;;; VARIABLES and CONSTANTS
+;;;;
+
+(defconst edt-version "3.0.3" "EDT version number.")
(defvar edt-last-deleted-lines ""
- "Last text deleted by an EDT emulation `line-delete' command.")
+ "Last text deleted by an EDT emulation line delete command.")
+
(defvar edt-last-deleted-words ""
- "Last text deleted by an EDT emulation `word-delete' command.")
+ "Last text deleted by an EDT emulation word delete command.")
+
(defvar edt-last-deleted-chars ""
- "Last text deleted by an EDT emulation `character-delete' command.")
+ "Last text deleted by an EDT emulation character delete command.")
+
+(defvar edt-last-replaced-key-definition ""
+ "Key definition replaced with edt-define-key or edt-learn command.")
+
+(defvar edt-direction-string ""
+ "Current direction of movement.")
+
+(defvar edt-select-mode nil
+ "Select minor mode.")
+
+(defvar edt-select-mode-text ""
+ "Select mode active text.")
+
+(defconst edt-select-mode-string " Select"
+ "String used to indicated select mode is active.")
+
+(defconst edt-forward-string " ADVANCE"
+ "Direction string indicating forward movement.")
+
+(defconst edt-backward-string " BACKUP"
+ "Direction string indicating backward movement.")
+
+(defvar edt-default-map-active nil
+ "Indicates, when true, that default EDT emulation key bindings are active;
+user-defined custom bindings are active when set to nil.")
+
+(defvar edt-user-map-configured nil
+ "Indicates, when true, that user custom EDT emulation key bindings are
+configured and available for use.")
+
+(defvar edt-keep-current-page-delimiter nil
+ "If set to true, when edt-emulation-on is first invoked,
+modification of the page-delimiter varible to "\f" is suppressed,
+thereby retaining current Emacs setting.")
+
+(defvar edt-use-EDT-control-key-bindings nil
+ "If set to true, EDT control key bindings are defined.
+When true, many standard Emacs control key bindings are overwritten.
+If set to nil (the default), EDT control key bindings are not used.
+Instead, the standard Emacs control key bindings are retained.")
+
+(defvar edt-word-entities '(?\t)
+ "*Specifies the list of word entity characters.")
-(defun 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 EDT `undelete-lines' command."
+;;;
+;;; Emacs version identifiers - currently referenced by
+;;;
+;;; o edt-emulation-on o edt-load-xkeys
+;;;
+(defconst edt-emacs19-p (not (string-lessp emacs-version "19"))
+ "Non-NIL if we are running Lucid or GNU Emacs version 19.")
+
+(defconst edt-lucid-emacs19-p
+ (and edt-emacs19-p (string-match "Lucid" emacs-version))
+ "Non-NIL if we are running Lucid Emacs version 19.")
+
+(defconst edt-gnu-emacs19-p (and edt-emacs19-p (not edt-lucid-emacs19-p))
+ "Non-NIL if we are running GNU Emacs version 19.")
+
+(defvar edt-xkeys-file nil
+ "File mapping X function keys to LK-201 keyboard function and keypad keys.")
+\f
+;;;;
+;;;; EDT Emulation Commands
+;;;;
+
+;;; Almost all of EDT's keypad mode commands have equivalent
+;;; counterparts in Emacs. Some behave the same way in Emacs as they
+;;; do in EDT, but most do not.
+;;;
+;;; The following Emacs functions emulate, where practical, the exact
+;;; behavior of the corresponding EDT keypad mode commands. In a few
+;;; cases, the emulation is not exact, but it is close enough for most
+;;; EDT die-hards.
+;;;
+;;; In a very few cases, we chose to use the superior Emacs way of
+;;; handling things. For example, we do not emulate the EDT SUBS
+;;; command. Instead, we chose to use the superior Emacs
+;;; query-replace function.
+;;;
+
+;;;
+;;; PAGE
+;;;
+;;; Emacs uses the regexp assigned to page-delimiter to determine what
+;;; marks a page break. This is normally "^\f", which causes the
+;;; edt-page command to ignore form feeds not located at the beginning
+;;; of a line. To emulate the EDT PAGE command exactly,
+;;; page-delimiter is set to "\f" when EDT emulation is turned on, and
+;;; restored to its original value when EDT emulation is turned off.
+;;; But this can be overridden if the EDT definition is not desired by
+;;; placing
+;;;
+;;; (setq edt-keep-current-page-delimiter t)
+;;;
+;;; in your .emacs file.
+
+(defun edt-page-forward (num)
+ "Move forward to just after next page delimiter.
+Accepts a positive prefix argument for the number of page delimiters to move."
+ (interactive "p")
+ (edt-check-prefix num)
+ (if (eobp)
+ (error "End of buffer")
+ (progn
+ (forward-page num)
+ (if (eobp)
+ (edt-line-to-bottom-of-window)
+ (edt-line-to-top-of-window)))))
+
+(defun edt-page-backward (num)
+ "Move backward to just after previous page delimiter.
+Accepts a positive prefix argument for the number of page delimiters to move."
+ (interactive "p")
+ (edt-check-prefix num)
+ (if (bobp)
+ (error "Beginning of buffer")
+ (progn
+ (backward-page num)
+ (edt-line-to-top-of-window))))
+
+(defun edt-page (num)
+ "Move in current direction to next page delimiter.
+Accepts a positive prefix argument for the number of page delimiters to move."
(interactive "p")
+ (if (equal edt-direction-string edt-forward-string)
+ (edt-page-forward num)
+ (edt-page-backward num)))
+
+;;;
+;;; SECT
+;;;
+;;; EDT defaults a section size to be 16 lines of its one and only
+;;; 24-line window. That's two-thirds of the window at a time. The
+;;; EDT SECT commands moves the cursor, not the window.
+;;;
+;;; This emulation of EDT's SECT moves the cursor approximately two-thirds
+;;; of the current window at a time.
+
+(defun edt-sect-forward (num)
+ "Move cursor forward two-thirds of a window.
+Accepts a positive prefix argument for the number of sections to move."
+ (interactive "p")
+ (edt-check-prefix num)
+ (edt-line-forward (* (* (/ (- (window-height) 1) 3) 2) num)))
+
+(defun edt-sect-backward (num)
+ "Move cursor backward two-thirds of a window.
+Accepts a positive prefix argument for the number of sections to move."
+ (interactive "p")
+ (edt-check-prefix num)
+ (edt-line-backward (* (* (/ (- (window-height) 1) 3) 2) num)))
+
+(defun edt-sect (num)
+ "Move in current direction a full window.
+Accepts a positive prefix argument for the number windows to move."
+ (interactive "p")
+ (if (equal edt-direction-string edt-forward-string)
+ (edt-sect-forward num)
+ (edt-sect-backward num)))
+
+;;;
+;;; BEGINNING OF LINE
+;;;
+;;; EDT's beginning-of-line command is not affected by current
+;;; direction, for some unknown reason.
+
+(defun edt-beginning-of-line (num)
+ "Move backward to next beginning of line mark.
+Accepts a positive prefix argument for the number of BOL marks to move."
+ (interactive "p")
+ (edt-check-prefix num)
+ (if (bolp)
+ (forward-line (* -1 num))
+ (progn
+ (setq num (1- num))
+ (forward-line (* -1 num)))))
+
+;;;
+;;; EOL (End of Line)
+;;;
+
+(defun edt-end-of-line-forward (num)
+ "Move forward to next end of line mark.
+Accepts a positive prefix argument for the number of EOL marks to move."
+ (interactive "p")
+ (edt-check-prefix num)
+ (forward-char)
+ (end-of-line num))
+
+(defun edt-end-of-line-backward (num)
+ "Move backward to next end of line mark.
+Accepts a positive prefix argument for the number of EOL marks to move."
+ (interactive "p")
+ (edt-check-prefix num)
+ (end-of-line (1- num)))
+
+(defun edt-end-of-line (num)
+ "Move in current direction to next end of line mark.
+Accepts a positive prefix argument for the number of EOL marks to move."
+ (interactive "p")
+ (if (equal edt-direction-string edt-forward-string)
+ (edt-end-of-line-forward num)
+ (edt-end-of-line-backward num)))
+
+;;;
+;;; WORD
+;;;
+;;; This one is a tad messy. To emulate EDT's behavior everywhere in
+;;; the file (beginning of file, end of file, beginning of line, end
+;;; of line, etc.) it takes a bit of special handling.
+;;;
+;;; The variable edt-word-entities contains a list of characters which
+;;; are to be viewed as distinct words where ever they appear in the
+;;; buffer. This emulates the EDT line mode command SET ENTITY WORD.
+
+
+(defun edt-one-word-forward ()
+ "Move forward to first character of next word."
+ (interactive)
+ (if (eobp)
+ (error "End of buffer"))
+ (if (eolp)
+ (forward-char)
+ (progn
+ (if (memq (following-char) edt-word-entities)
+ (forward-char)
+ (while (and
+ (not (eolp))
+ (not (eobp))
+ (not (eq ?\ (char-syntax (following-char))))
+ (not (memq (following-char) edt-word-entities)))
+ (forward-char)))
+ (while (and
+ (not (eolp))
+ (not (eobp))
+ (eq ?\ (char-syntax (following-char)))
+ (not (memq (following-char) edt-word-entities)))
+ (forward-char)))))
+
+(defun edt-one-word-backward ()
+ "Move backward to first character of previous word."
+ (interactive)
+ (if (bobp)
+ (error "Beginning of buffer"))
+ (if (bolp)
+ (backward-char)
+ (progn
+ (backward-char)
+ (while (and
+ (not (bolp))
+ (not (bobp))
+ (eq ?\ (char-syntax (following-char)))
+ (not (memq (following-char) edt-word-entities)))
+ (backward-char))
+ (if (not (memq (following-char) edt-word-entities))
+ (while (and
+ (not (bolp))
+ (not (bobp))
+ (not (eq ?\ (char-syntax (preceding-char))))
+ (not (memq (preceding-char) edt-word-entities)))
+ (backward-char))))))
+
+(defun edt-word-forward (num)
+ "Move forward to first character of next word.
+Accepts a positive prefix argument for the number of words to move."
+ (interactive "p")
+ (edt-check-prefix num)
+ (while (> num 0)
+ (edt-one-word-forward)
+ (setq num (1- num))))
+
+(defun edt-word-backward (num)
+ "Move backward to first character of previous word.
+Accepts a positive prefix argument for the number of words to move."
+ (interactive "p")
+ (edt-check-prefix num)
+ (while (> num 0)
+ (edt-one-word-backward)
+ (setq num (1- num))))
+
+(defun edt-word (num)
+ "Move in current direction to first character of next word.
+Accepts a positive prefix argument for the number of words to move."
+ (interactive "p")
+ (if (equal edt-direction-string edt-forward-string)
+ (edt-word-forward num)
+ (edt-word-backward num)))
+
+;;;
+;;; CHAR
+;;;
+
+(defun edt-character (num)
+ "Move in current direction to next character.
+Accepts a positive prefix argument for the number of characters to move."
+ (interactive "p")
+ (edt-check-prefix num)
+ (if (equal edt-direction-string edt-forward-string)
+ (forward-char num)
+ (backward-char num)))
+
+;;;
+;;; LINE
+;;;
+;;; When direction is set to BACKUP, LINE behaves just like BEGINNING
+;;; OF LINE in EDT. So edt-line-backward is not really needed as a
+;;; separate function.
+
+(defun edt-line-backward (num)
+ "Move backward to next beginning of line mark.
+Accepts a positive prefix argument for the number of BOL marks to move."
+ (interactive "p")
+ (edt-beginning-of-line num))
+
+(defun edt-line-forward (num)
+ "Move forward to next beginning of line mark.
+Accepts a positive prefix argument for the number of BOL marks to move."
+ (interactive "p")
+ (edt-check-prefix num)
+ (forward-line num))
+
+(defun edt-line (num)
+ "Move in current direction to next beginning of line mark.
+Accepts a positive prefix argument for the number of BOL marks to move."
+ (interactive "p")
+ (if (equal edt-direction-string edt-forward-string)
+ (edt-line-forward num)
+ (edt-line-backward num)))
+
+;;;
+;;; TOP
+;;;
+
+(defun edt-top ()
+ "Move cursor to the beginning of buffer."
+ (interactive)
+ (goto-char (point-min)))
+
+;;;
+;;; BOTTOM
+;;;
+
+(defun edt-bottom ()
+ "Move cursor to the end of buffer."
+ (interactive)
+ (goto-char (point-max))
+ (edt-line-to-bottom-of-window))
+
+;;;
+;;; FIND
+;;;
+
+(defun edt-find-forward (&optional find)
+ "Find first occurance of a string in the forward direction and save the string."
+ (interactive)
+ (if (not find)
+ (set 'search-last-string (read-string "Search forward: ")))
+ (if (search-forward search-last-string)
+ (search-backward search-last-string)))
+
+(defun edt-find-backward (&optional find)
+ "Find first occurance of a string in the backward direction and save the string."
+ (interactive)
+ (if (not find)
+ (set 'search-last-string (read-string "Search backward: ")))
+ (search-backward search-last-string))
+
+(defun edt-find ()
+ "Find first occurance of string in current direction and save the string."
+ (interactive)
+ (set 'search-last-string (read-string "Search: "))
+ (if (equal edt-direction-string edt-forward-string)
+ (edt-find-forward t)
+ (edt-find-backward t)))
+
+
+;;;
+;;; FNDNXT
+;;;
+
+(defun edt-find-next-forward ()
+ "Find next occurance of a string in forward direction."
+ (interactive)
+ (forward-char 1)
+ (if (search-forward search-last-string nil t)
+ (search-backward search-last-string)
+ (progn
+ (backward-char 1)
+ (error "Search failed: \"%s\"." search-last-string))))
+
+(defun edt-find-next-backward ()
+ "Find next occurance of a string in backward direction."
+ (interactive)
+ (if (eq (search-backward search-last-string nil t) nil)
+ (progn
+ (error "Search failed: \"%s\"." search-last-string))))
+
+(defun edt-find-next ()
+ "Find next occurance of a string in current direction."
+ (interactive)
+ (if (equal edt-direction-string edt-forward-string)
+ (edt-find-next-forward)
+ (edt-find-next-backward)))
+
+;;;
+;;; APPEND
+;;;
+
+(defun edt-append ()
+ "Append this kill region to last killed region."
+ (interactive "*")
+ (edt-check-selection)
+ (append-next-kill)
+ (kill-region (mark) (point))
+ (message "Selected text APPENDED to kill ring"))
+
+;;;
+;;; DEL L
+;;;
+
+(defun edt-delete-line (num)
+ "Delete from cursor up to and including the end of line mark.
+Accepts a positive prefix argument for the number of lines to delete."
+ (interactive "*p")
+ (edt-check-prefix num)
(let ((beg (point)))
(forward-line num)
(if (not (eq (preceding-char) ?\n))
- (insert "\n"))
+ (insert "\n"))
(setq edt-last-deleted-lines
- (buffer-substring beg (point)))
+ (buffer-substring beg (point)))
(delete-region beg (point))))
-(defun delete-to-eol (num)
- "Delete text up to end of line.
-With argument, delete up to to Nth line-end past point.
-They are saved for the EDT `undelete-lines' command."
- (interactive "p")
+;;;
+;;; DEL EOL
+;;;
+
+(defun edt-delete-to-end-of-line (num)
+ "Delete from cursor up to but excluding the end of line mark.
+Accepts a positive prefix argument for the number of lines to delete."
+ (interactive "*p")
+ (edt-check-prefix num)
(let ((beg (point)))
(forward-char 1)
(end-of-line num)
(setq edt-last-deleted-lines
- (buffer-substring beg (point)))
+ (buffer-substring beg (point)))
(delete-region beg (point))))
-(defun delete-current-word (num)
- "Delete one or specified number of words after point.
-They are saved for the EDT `undelete-words' command."
- (interactive "p")
+;;;
+;;; SELECT
+;;;
+
+(defun edt-select-mode (arg)
+ "Turn EDT select mode off if arg is nil; otherwise, turn EDT select mode on.
+In select mode, selected text is highlighted."
+ (if arg
+ (progn
+ (make-local-variable 'edt-select-mode)
+ (setq edt-select-mode 'edt-select-mode-text)
+ (setq rect-start-point (window-point)))
+ (progn
+ (kill-local-variable 'edt-select-mode)))
+ (force-mode-line-update))
+
+(defun edt-select ()
+ "Set mark at cursor and start text selection."
+ (interactive)
+ (set-mark-command nil))
+
+(defun edt-reset ()
+ "Cancel text selection."
+ (interactive)
+ (deactivate-mark))
+
+;;;
+;;; CUT
+;;;
+
+(defun edt-cut ()
+ "Deletes selected text but copies to kill ring."
+ (interactive "*")
+ (edt-check-selection)
+ (kill-region (mark) (point))
+ (message "Selected text CUT to kill ring"))
+
+;;;
+;;; DELETE TO BEGINNING OF LINE
+;;;
+
+(defun edt-delete-to-beginning-of-line (num)
+ "Delete from cursor to beginning of of line.
+Accepts a positive prefix argument for the number of lines to delete."
+ (interactive "*p")
+ (edt-check-prefix num)
(let ((beg (point)))
- (forward-word num)
- (setq edt-last-deleted-words
- (buffer-substring beg (point)))
+ (edt-beginning-of-line num)
+ (setq edt-last-deleted-lines
+ (buffer-substring (point) beg))
(delete-region beg (point))))
-(defun edt-delete-previous-word (num)
- "Delete one or specified number of words before point.
-They are saved for the EDT `undelete-words' command."
- (interactive "p")
+;;;
+;;; DEL W
+;;;
+
+(defun edt-delete-word (num)
+ "Delete from cursor up to but excluding first character of next word.
+Accepts a positive prefix argument for the number of words to delete."
+ (interactive "*p")
+ (edt-check-prefix num)
(let ((beg (point)))
- (forward-word (- num))
- (setq edt-last-deleted-words
- (buffer-substring (point) beg))
+ (edt-word-forward num)
+ (setq edt-last-deleted-words (buffer-substring beg (point)))
(delete-region beg (point))))
-(defun delete-current-char (num)
- "Delete one or specified number of characters after point.
-They are saved for the EDT `undelete-chars' command."
- (interactive "p")
+;;;
+;;; DELETE TO BEGINNING OF WORD
+;;;
+
+(defun edt-delete-to-beginning-of-word (num)
+ "Delete from cursor to beginning of word.
+Accepts a positive prefix argument for the number of words to delete."
+ (interactive "*p")
+ (edt-check-prefix num)
+ (let ((beg (point)))
+ (edt-word-backward num)
+ (setq edt-last-deleted-words (buffer-substring (point) beg))
+ (delete-region beg (point))))
+
+;;;
+;;; DEL C
+;;;
+
+(defun edt-delete-character (num)
+ "Delete character under cursor.
+Accepts a positive prefix argument for the number of characters to delete."
+ (interactive "*p")
+ (edt-check-prefix num)
(setq edt-last-deleted-chars
- (buffer-substring (point) (min (point-max) (+ (point) num))))
+ (buffer-substring (point) (min (point-max) (+ (point) num))))
(delete-region (point) (min (point-max) (+ (point) num))))
-(defun delete-previous-char (num)
- "Delete one or specified number of characters before point.
-They are saved for the EDT `undelete-chars' command."
- (interactive "p")
+;;;
+;;; DELETE CHAR
+;;;
+
+(defun edt-delete-previous-character (num)
+ "Delete character in front of cursor.
+Accepts a positive prefix argument for the number of characters to delete."
+ (interactive "*p")
+ (edt-check-prefix num)
(setq edt-last-deleted-chars
- (buffer-substring (max (point-min) (- (point) num)) (point)))
+ (buffer-substring (max (point-min) (- (point) num)) (point)))
(delete-region (max (point-min) (- (point) num)) (point)))
-(defun undelete-lines ()
- "Yank lines deleted by last EDT `line-delete' command."
+;;;
+;;; UND L
+;;;
+
+(defun edt-undelete-line ()
+ "Undelete previous deleted line(s)."
+ (interactive "*")
+ (point-to-register 1)
+ (insert edt-last-deleted-lines)
+ (register-to-point 1))
+
+;;;
+;;; UND W
+;;;
+
+(defun edt-undelete-word ()
+ "Yank words deleted by last EDT word-deletion command."
+ (interactive "*")
+ (point-to-register 1)
+ (insert edt-last-deleted-words)
+ (register-to-point 1))
+
+;;;
+;;; UND C
+;;;
+
+(defun edt-undelete-character ()
+ "Yank characters deleted by last EDT character-deletion command."
+ (interactive "*")
+ (point-to-register 1)
+ (insert edt-last-deleted-chars)
+ (register-to-point 1))
+
+;;;
+;;; REPLACE
+;;;
+
+(defun edt-replace ()
+ "Replace marked section with last CUT (killed) text."
+ (interactive "*")
+ (exchange-point-and-mark)
+ (let ((beg (point)))
+ (exchange-point-and-mark)
+ (delete-region beg (point)))
+ (yank))
+
+;;;
+;;; ADVANCE
+;;;
+
+(defun edt-advance ()
+ "Set movement direction forward."
(interactive)
- (insert edt-last-deleted-lines))
+ (setq edt-direction-string edt-forward-string)
+ (edt-update-mode-line)
+ (if (string-equal " *Minibuf"
+ (substring (buffer-name) 0 (min (length (buffer-name)) 9)))
+ (exit-minibuffer)))
+
+;;;
+;;; BACKUP
+;;;
-(defun undelete-words ()
- "Yank words deleted by last EDT `word-delete' command."
+(defun edt-backup ()
+ "Set movement direction backward."
(interactive)
- (insert edt-last-deleted-words))
+ (setq edt-direction-string edt-backward-string)
+ (edt-update-mode-line)
+ (if (string-equal " *Minibuf"
+ (substring (buffer-name) 0 (min (length (buffer-name)) 9)))
+ (exit-minibuffer)))
+
+;;;
+;;; CHNGCASE
+;;;
+;; This function is based upon Jeff Kowalski's case-flip function in his
+;; tpu.el.
+
+(defun edt-change-case (num)
+ "Change the case of specified characters.
+If text selection IS active, then characters between the cursor and mark are
+changed. If text selection is NOT active, there are two cases. First, if the
+current direction is ADVANCE, then the prefix number of character(s) under and
+following cursor are changed. Second, if the current direction is BACKUP, then
+the prefix number of character(s) before the cursor are changed. Accepts a
+positive prefix for the number of characters to change, but the prefix is
+ignored if text selection is active."
+ (interactive "*p")
+ (edt-check-prefix num)
+ (if edt-select-mode
+ (let ((end (max (mark) (point)))
+ (point-save (point)))
+ (goto-char (min (point) (mark)))
+ (while (not (eq (point) end))
+ (funcall (if (<= ?a (following-char))
+ 'upcase-region 'downcase-region)
+ (point) (1+ (point)))
+ (forward-char 1))
+ (goto-char point-save))
+ (progn
+ (if (string= edt-direction-string edt-backward-string)
+ (backward-char num))
+ (while (> num 0)
+ (funcall (if (<= ?a (following-char))
+ 'upcase-region 'downcase-region)
+ (point) (1+ (point)))
+ (forward-char 1)
+ (setq num (1- num))))))
-(defun undelete-chars ()
- "Yank characters deleted by last EDT `character-delete' command."
+;;;
+;;; DEFINE KEY
+;;;
+
+(defun edt-define-key ()
+ "Assign an interactively-callable function to a specified key sequence.
+The current key definition is saved in edt-last-replaced-key-definition.
+Use edt-restore-key to restore last replaced key definition."
(interactive)
- (insert edt-last-deleted-chars))
+ (let (edt-function
+ edt-key-definition-string)
+ (setq edt-key-definition-string
+ (read-key-sequence "Press the key to be defined: "))
+ (if (string-equal "\C-m" edt-key-definition-string)
+ (message "Key not defined")
+ (progn
+ (setq edt-function (read-command "Enter command name: "))
+ (if (string-equal "" edt-function)
+ (message "Key not defined")
+ (progn
+ (setq edt-last-replaced-key-definition
+ (lookup-key (current-global-map) edt-key-definition-string))
+ (define-key (current-global-map)
+ edt-key-definition-string edt-function)))))))
-(defun 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)
- (end-of-line num))
+;;;
+;;; FORM FEED INSERT
+;;;
-(defun 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 edt-form-feed-insert (num)
+ "Insert form feed character at cursor position.
+Accepts a positive prefix argument for the number of form feeds to insert."
+ (interactive "*p")
+ (edt-check-prefix num)
+ (while (> num 0)
+ (insert ?\f)
+ (setq num (1- num))))
-(defun forward-to-word (num)
- "Move to next word-beginning, or to Nth following word-beginning."
- (interactive "p")
- (forward-word (1+ num))
- (forward-word -1))
+;;;
+;;; TAB INSERT
+;;;
-(defun backward-to-word (num)
- "Move back to word-end, or to Nth word-end seen."
- (interactive "p")
- (forward-word (- (1+ num)))
- (forward-word 1))
+(defun edt-tab-insert (num)
+ "Insert tab character at cursor position.
+Accepts a positive prefix argument for the number of tabs to insert."
+ (interactive "*p")
+ (edt-check-prefix num)
+ (while (> num 0)
+ (insert ?\t)
+ (setq num (1- num))))
+
+;;;
+;;; Check Prefix
+;;;
+
+(defun edt-check-prefix (num)
+ "Indicate error if prefix is not positive."
+ (if (<= num 0)
+ (error "Prefix must be positive")))
+
+;;;
+;;; Check Selection
+;;;
+
+(defun edt-check-selection ()
+ "Indicate error if EDT selection is not active."
+ (if (not edt-select-mode)
+ (error "Selection NOT active")))
+\f
+;;;;
+;;;; ENHANCEMENTS AND ADDITIONS FOR EDT KEYPAD MODE
+;;;;
+
+;;;
+;;; Several enhancements and additions to EDT keypad mode commands are
+;;; provided here. Some of these have been motivated by similar
+;;; TPU/EVE and EVE-Plus commands. Others are new.
+
+(defun edt-version nil
+ "Print the EDT version number."
+ (interactive)
+ (message
+ "EDT version %s by Kevin Gallagher (kgallagh@spd.dsccc.com)"
+ edt-version))
+
+;;;
+;;; CHANGE DIRECTION
+;;;
-(defun backward-line (num)
- "Move point to start of previous line.
-Prefix argument serves as repeat-count."
+(defun edt-change-direction ()
+ "Toggle movement direction."
+ (interactive)
+ (if (equal edt-direction-string edt-forward-string)
+ (edt-backup)
+ (edt-advance)))
+
+;;;
+;;; TOGGLE SELECT
+;;;
+
+(defun edt-toggle-select ()
+ "Toggle to start (or cancel) text selection."
+ (interactive)
+ (if edt-select-mode
+ (edt-reset)
+ (edt-select)))
+
+;;;
+;;; SENTENCE
+;;;
+
+(defun edt-sentence-forward (num)
+ "Move forward to start of next sentence.
+Accepts a positive prefix argument for the number of sentences to move."
(interactive "p")
- (forward-line (- num)))
+ (edt-check-prefix num)
+ (if (eobp)
+ (progn
+ (error "End of buffer"))
+ (progn
+ (forward-sentence num)
+ (edt-one-word-forward))))
-(defun scroll-window-down (num)
- "Scroll the display down a window-full.
-Accepts a prefix argument for the number of window-fulls to scroll."
+(defun edt-sentence-backward (num)
+ "Move backward to next sentence beginning.
+Accepts a positive prefix argument for the number of sentences to move."
(interactive "p")
- (scroll-down (- (* (window-height) num) 2)))
+ (edt-check-prefix num)
+ (if (eobp)
+ (progn
+ (error "End of buffer"))
+ (backward-sentence num)))
-(defun scroll-window-up (num)
- "Scroll the display up a window-full.
-Accepts a prefix argument for the number of window-fulls to scroll."
+(defun edt-sentence (num)
+ "Move in current direction to next sentence.
+Accepts a positive prefix argument for the number of sentences to move."
(interactive "p")
- (scroll-up (- (* (window-height) num) 2)))
+ (if (equal edt-direction-string edt-forward-string)
+ (edt-sentence-forward num)
+ (edt-sentence-backward num)))
+
+;;;
+;;; PARAGRAPH
+;;;
-(defun next-paragraph (num)
- "Move to beginning of the next indented paragraph.
-Accepts a prefix argument for the number of paragraphs."
+(defun edt-paragraph-forward (num)
+ "Move forward to beginning of paragraph.
+Accepts a positive prefix argument for the number of paragraphs to move."
(interactive "p")
+ (edt-check-prefix num)
(while (> num 0)
(next-line 1)
(forward-paragraph)
(previous-line 1)
- (if (eolp) (next-line 1))
+ (if (eolp)
+ (next-line 1))
(setq num (1- num))))
-(defun previous-paragraph (num)
- "Move to beginning of previous indented paragraph.
-Accepts a prefix argument for the number of paragraphs."
+(defun edt-paragraph-backward (num)
+ "Move backward to beginning of paragraph.
+Accepts a positive prefix argument for the number of paragraphs to move."
(interactive "p")
+ (edt-check-prefix num)
(while (> num 0)
(backward-paragraph)
(previous-line 1)
(if (eolp) (next-line 1))
(setq num (1- num))))
-(defun move-to-beginning ()
- "Move cursor to the beginning of buffer, but don't set the mark."
+(defun edt-paragraph (num)
+ "Move in current direction to next paragraph.
+Accepts a positive prefix argument for the number of paragraph to move."
+ (interactive "p")
+ (if (equal edt-direction-string edt-forward-string)
+ (edt-paragraph-forward num)
+ (edt-paragraph-backward num)))
+
+;;;
+;;; RESTORE KEY
+;;;
+
+(defun edt-restore-key ()
+ "Restore last replaced key definition, which is stored in
+edt-last-replaced-key-definition."
(interactive)
- (goto-char (point-min)))
+ (if edt-last-replaced-key-definition
+ (progn
+ (let (edt-key-definition-string)
+ (set 'edt-key-definition-string
+ (read-key-sequence "Press the key to be restored: "))
+ (if (string-equal "\C-m" edt-key-definition-string)
+ (message "Key not restored")
+ (define-key (current-global-map)
+ edt-key-definition-string edt-last-replaced-key-definition))))
+ (error "No replaced key definition to restore!")))
+
+;;;
+;;; WINDOW TOP
+;;;
-(defun move-to-end ()
- "Move cursor to the end of buffer, but don't set the mark."
+(defun edt-window-top ()
+ "Move the cursor to the top of the window."
(interactive)
- (goto-char (point-max)))
+ (let ((start-column (current-column)))
+ (move-to-window-line 0)
+ (move-to-column start-column)))
-(defun goto-percent (perc)
- "Move point to ARG percentage of the buffer."
- (interactive "NGoto-percentage: ")
- (if (or (> perc 100) (< perc 0))
- (error "Percentage %d out of range 0 < percent < 100" perc)
- (goto-char (/ (* (point-max) perc) 100))))
+;;;
+;;; WINDOW BOTTOM
+;;;
-(defun update-mode-line ()
- "Ensure mode-line reflects all changes."
- (set-buffer-modified-p (buffer-modified-p))
- (sit-for 0))
+(defun edt-window-bottom ()
+ "Move the cursor to the bottom of the window."
+ (interactive)
+ (let ((start-column (current-column)))
+ (move-to-window-line (- (window-height) 2))
+ (move-to-column start-column)))
+
+;;;
+;;; SCROLL WINDOW LINE
+;;;
+
+(defun edt-scroll-window-forward-line ()
+ "Move window forward one line leaving cursor at relative position in window."
+ (interactive)
+ (scroll-up 1))
+
+(defun edt-scroll-window-backward-line ()
+ "Move window backward one line leaving cursor at relative position in window."
+ (interactive)
+ (scroll-down 1))
+
+(defun edt-scroll-line ()
+ "Move window one line in current direction."
+ (interactive)
+ (if (equal edt-direction-string edt-forward-string)
+ (edt-scroll-window-forward-line)
+ (edt-scroll-window-backward-line)))
-(defun advance-direction ()
- "Set EDT Advance mode so keypad commands move forward."
- (interactive)
- (setq edt-direction-string " ADVANCE")
- (global-set-key [kp-f1] 'isearch-forward)
- (global-set-key [kp-8] 'scroll-window-up)
- (global-set-key [kp-7] 'next-paragraph)
- (global-set-key [kp-1] 'forward-to-word)
- (global-set-key [kp-2] 'next-end-of-line)
- (global-set-key [kp-3] 'forward-char)
- (global-set-key [kp-0] 'forward-line)
- (update-mode-line))
-
-(defun backup-direction ()
- "Set EDT Backup mode so keypad commands move backward."
- (interactive)
- (setq edt-direction-string " BACKUP")
- (global-set-key [kp-f3] 'isearch-backward)
- (global-set-key [kp-8] 'scroll-window-down)
- (global-set-key [kp-7] 'previous-paragraph)
- (global-set-key [kp-1] 'backward-to-word)
- (global-set-key [kp-2] 'previous-end-of-line)
- (global-set-key [kp-3] 'backward-char)
- (global-set-key [kp-9] 'backward-line)
- (update-mode-line))
-
-(defun edt-beginning-of-window ()
- "Home cursor to top of window."
- (interactive)
- (move-to-window-line 0))
+;;;
+;;; SCROLL WINDOW
+;;;
+;;; Scroll a window (less one line) at a time. Leave cursor in center of
+;;; window.
+
+(defun edt-scroll-window-forward (num)
+ "Scroll forward one window in buffer, less one line.
+Accepts a positive prefix argument for the number of windows to move."
+ (interactive "p")
+ (edt-check-prefix num)
+ (scroll-up (- (* (window-height) num) 2))
+ (edt-line-forward (/ (- (window-height) 1) 2)))
+
+(defun edt-scroll-window-backward (num)
+ "Scroll backward one window in buffer, less one line.
+Accepts a positive prefix argument for the number of windows to move."
+ (interactive "p")
+ (edt-check-prefix num)
+ (scroll-down (- (* (window-height) num) 2))
+ (edt-line-backward (/ (- (window-height) 1) 2)))
+
+(defun edt-scroll-window (num)
+ "Scroll one window in buffer, less one line, in current direction.
+Accepts a positive prefix argument for the number windows to move."
+ (interactive "p")
+ (if (equal edt-direction-string edt-forward-string)
+ (edt-scroll-window-forward num)
+ (edt-scroll-window-backward num)))
+
+;;;
+;;; LINE TO BOTTOM OF WINDOW
+;;;
(defun edt-line-to-bottom-of-window ()
- "Move the current line to the top of the window."
+ "Move the current line to the bottom of the window."
(interactive)
(recenter -1))
+;;;
+;;; LINE TO TOP OF WINDOW
+;;;
+
(defun edt-line-to-top-of-window ()
"Move the current line to the top of the window."
(interactive)
(recenter 0))
-(defun case-flip-character (num)
- "Change the case of the character under the cursor.
-Accepts a prefix argument of the number of characters to invert."
- (interactive "p")
- (while (> num 0)
- (funcall (if (<= ?a (following-char))
- 'upcase-region 'downcase-region)
- (point) (1+ (point)))
- (forward-char 1)
- (setq num (1- num))))
+;;;
+;;; LINE TO MIDDLE OF WINDOW
+;;;
-(defun indent-or-fill-region ()
- "Fill region in text modes, indent region in programming language modes."
+(defun edt-line-to-middle-of-window ()
+ "Move window so line with cursor is in the middle of the window."
(interactive)
- (if (string= paragraph-start "^$\\|^\f")
+ (recenter '(4)))
+
+;;;
+;;; GOTO PERCENTAGE
+;;;
+
+(defun edt-goto-percentage (num)
+ "Move to specified percentage in buffer from top of buffer."
+ (interactive "NGoto-percentage: ")
+ (if (or (> num 100) (< num 0))
+ (error "Percentage %d out of range 0 < percent < 100" num)
+ (goto-char (/ (* (point-max) num) 100))))
+
+;;;
+;;; FILL REGION
+;;;
+
+(defun edt-fill-region ()
+ "Fill selected text."
+ (interactive "*")
+ (edt-check-selection)
+ (fill-region (point) (mark)))
+
+;;;
+;;; INDENT OR FILL REGION
+;;;
+
+(defun edt-indent-or-fill-region ()
+ "Fill region in text modes, indent region in programming language modes."
+ (interactive "*")
+ (if (string= paragraph-start "$\\|\f")
(indent-region (point) (mark) nil)
- (fill-region (point) (mark))))
+ (fill-region (point) (mark))))
-(defun mark-section-wisely ()
+;;;
+;;; MARK SECTION WISELY
+;;;
+
+(defun edt-mark-section-wisely ()
"Mark the section in a manner consistent with the major-mode.
-Uses mark-defun for emacs-lisp, lisp,
+Uses mark-defun for emacs-lisp and lisp,
mark-c-function for C,
+mark-fortran-subsystem for fortran,
and mark-paragraph for other modes."
(interactive)
- (cond ((eq major-mode 'emacs-lisp-mode)
- (mark-defun))
- ((eq major-mode 'lisp-mode)
- (mark-defun))
- ((eq major-mode 'c-mode)
- (mark-c-function))
- (t (mark-paragraph))))
+ (if edt-select-mode
+ (progn
+ (edt-reset))
+ (progn
+ (cond ((or (eq major-mode 'emacs-lisp-mode)
+ (eq major-mode 'lisp-mode))
+ (mark-defun)
+ (message "Lisp defun selected"))
+ ((eq major-mode 'c-mode)
+ (mark-c-function)
+ (message "C function selected"))
+ ((eq major-mode 'fortran-mode)
+ (mark-fortran-subprogram)
+ (message "Fortran subprogram selected"))
+ (t (mark-paragraph)
+ (message "Paragraph selected"))))))
+
+;;;
+;;; COPY
+;;;
+
+(defun edt-copy ()
+ "Copy selected region to kill ring, but don't delete it!"
+ (interactive)
+ (edt-check-selection)
+ (copy-region-as-kill (mark) (point))
+ (edt-reset)
+ (message "Selected text COPIED to kill ring"))
+
+;;;
+;;; CUT or COPY
+;;;
+
+(defun edt-cut-or-copy ()
+ "Cuts (or copies) selected text to kill ring.
+Cuts selected text if buffer-read-only is nil.
+Copies selected text if buffer-read-only is t."
+ (interactive)
+ (if buffer-read-only
+ (edt-copy)
+ (edt-cut)))
+
+;;;
+;;; DELETE ENTIRE LINE
+;;;
+
+(defun edt-delete-entire-line ()
+ "Delete entire line regardless of cursor position in the line."
+ (interactive "*")
+ (beginning-of-line)
+ (edt-delete-line 1))
+
+;;;
+;;; DUPLICATE LINE
+;;;
+
+(defun edt-duplicate-line (num)
+ "Duplicate a line of text.
+Accepts a positive prefix argument for the number times to duplicate the line."
+ (interactive "*p")
+ (edt-check-prefix num)
+ (let ((old-column (current-column))
+ (count num))
+ (edt-delete-entire-line)
+ (edt-undelete-line)
+ (while (> count 0)
+ (edt-undelete-line)
+ (setq count (1- count)))
+ (edt-line-forward num)
+ (move-to-column old-column)))
+
+;;;
+;;; DUPLICATE WORD
+;;;
+
+(defun edt-duplicate-word()
+ "Duplicate word (or rest of word) found directly above cursor, if any."
+ (interactive "*")
+ (let ((start (point))
+ (start-column (current-column)))
+ (forward-line -1)
+ (move-to-column start-column)
+ (if (and (not (equal start (point)))
+ (not (eolp)))
+ (progn
+ (if (and (equal ?\t (preceding-char))
+ (< start-column (current-column)))
+ (backward-char))
+ (let ((beg (point)))
+ (edt-one-word-forward)
+ (setq edt-last-copied-word (buffer-substring beg (point))))
+ (forward-line)
+ (move-to-column start-column)
+ (insert edt-last-copied-word))
+ (progn
+ (if (not (equal start (point)))
+ (forward-line))
+ (move-to-column start-column)
+ (error "Nothing to duplicate!")))))
+
+;;;
+;;; KEY NOT ASSIGNED
+;;;
+
+(defun edt-key-not-assigned ()
+ "Displays message that key has not been assigned to a function."
+ (interactive)
+ (error "Key not assigned"))
+
+;;;
+;;; TOGGLE CAPITALIZATION OF WORD
+;;;
+
+(defun edt-toggle-capitalization-of-word ()
+ "Toggle the capitalization of the current word and move forward to next."
+ (interactive "*")
+ (edt-one-word-forward)
+ (edt-one-word-backward)
+ (edt-change-case 1)
+ (edt-one-word-backward)
+ (edt-one-word-forward))
+
+;;;
+;;; ELIMINATE ALL TABS
+;;;
+
+(defun edt-eliminate-all-tabs ()
+ "Convert all tabs to spaces in the entire buffer."
+ (interactive "*")
+ (untabify (point-min) (point-max))
+ (message "TABS converted to SPACES"))
+
+;;;
+;;; DISPLAY THE TIME
+;;;
+
+(defun edt-display-the-time ()
+ "Display the current time."
+ (interactive)
+ (set 'time-string (current-time-string))
+ (message time-string))
+
+;;;
+;;; LEARN
+;;;
+
+(defun edt-learn ()
+ "Learn a sequence of key strokes to bind to a key."
+ (interactive)
+ (if (eq defining-kbd-macro t)
+ (edt-remember)
+ (start-kbd-macro nil)))
+
+;;;
+;;; REMEMBER
+;;;
+
+(defun edt-remember ()
+ "Store the sequence of key strokes started by edt-learn to a key."
+ (interactive)
+ (if (eq defining-kbd-macro nil)
+ (error "Nothing to remember!")
+ (progn
+ (end-kbd-macro nil)
+ (let (edt-key-definition-string)
+ (set 'edt-key-definition-string
+ (read-key-sequence "Enter key for binding: "))
+ (if (string-equal "\C-m" edt-key-definition-string)
+ (message "Key sequence not remembered")
+ (progn
+ (set 'edt-learn-macro-count (+ edt-learn-macro-count 1))
+ (setq edt-last-replaced-key-definition
+ (lookup-key (current-global-map)
+ edt-key-definition-string))
+ (define-key (current-global-map) edt-key-definition-string
+ (name-last-kbd-macro
+ (intern (concat "last-learned-sequence-"
+ (int-to-string edt-learn-macro-count)))))))))))
+
+;;;
+;;; EXIT
+;;;
+
+(defun edt-exit ()
+ "Save current buffer, ask to save other buffers, and then exit Emacs."
+ (interactive)
+ (save-buffer)
+ (save-buffers-kill-emacs))
+
+;;;
+;;; QUIT
+;;;
+
+(defun edt-quit ()
+ "Quit Emacs without saving changes."
+ (interactive)
+ (kill-emacs))
+
+;;;
+;;; SPLIT WINDOW
+;;;
+
+(defun edt-split-window ()
+ "Split current window and place cursor in the new window."
+ (interactive)
+ (split-window)
+ (other-window 1))
+
+;;;
+;;; UPDATE MODE LINE
+;;;
+
+(defun edt-update-mode-line ()
+ "Make sure mode-line in the current buffer reflects all changes."
+ (set-buffer-modified-p (buffer-modified-p))
+ (sit-for 0))
+
+;;;
+;;; COPY RECTANGLE
+;;;
+
+(defun edt-copy-rectangle ()
+ "Copy a rectangle of text between mark and cursor to register."
+ (interactive)
+ (edt-check-selection)
+ (copy-rectangle-to-register 3 (region-beginning) (region-end) nil)
+ (edt-reset)
+ (message "Selected rectangle COPIED to register"))
+
+;;;
+;;; CUT RECTANGLE
+;;;
+
+(defun edt-cut-rectangle-overstrike-mode ()
+ "Cut a rectangle of text between mark and cursor to register, replacing
+characters with spaces and moving cursor back to upper left corner."
+ (interactive "*")
+ (edt-check-selection)
+ (setq edt-rect-start-point (region-beginning))
+ (picture-clear-rectangle-to-register (region-beginning) (region-end) 3)
+ (set-window-point (get-buffer-window (window-buffer)) edt-rect-start-point)
+ (message "Selected rectangle CUT to register"))
+
+(defun edt-cut-rectangle-insert-mode ()
+ "Cut a rectangle of text between mark and cursor to register, deleting
+intermediate text and moving cursor back to upper left corner."
+ (interactive "*")
+ (edt-check-selection)
+ (setq edt-rect-start-point (region-beginning))
+ (picture-clear-rectangle-to-register (region-beginning) (region-end) 3 t)
+ (fixup-whitespace)
+ (set-window-point (get-buffer-window (window-buffer)) edt-rect-start-point)
+ (message "Selected rectangle CUT to register"))
+
+(defun edt-cut-rectangle ()
+ "Cut a rectangular region of text to register.
+If overwrite mode is active, cut text is replace with whitespace."
+ (interactive "*")
+ (if overwrite-mode
+ (edt-cut-rectangle-overstrike-mode)
+ (edt-cut-rectangle-insert-mode)))
+
+;;;
+;;; PASTE RECTANGLE
+;;;
+
+(defun edt-paste-rectangle-overstrike-mode ()
+ "Paste a rectangular region of text from register, replacing text at cursor."
+ (interactive "*")
+ (picture-yank-rectangle-from-register 3))
+
+(defun edt-paste-rectangle-insert-mode ()
+ "Paste previously deleted rectangular region, inserting text at cursor."
+ (interactive "*")
+ (picture-yank-rectangle-from-register 3 t))
+
+(defun edt-paste-rectangle ()
+ "Paste a rectangular region of text.
+If overwrite mode is active, existing text is replace with text from register."
+ (interactive)
+ (if overwrite-mode
+ (edt-paste-rectangle-overstrike-mode)
+ (edt-paste-rectangle-insert-mode)))
+
+;;;
+;;; DOWNCASE REGION
+;;;
+
+(defun edt-lowercase ()
+ "Change specified characters to lower case.
+If text selection IS active, then characters between the cursor and
+mark are changed. If text selection is NOT active, there are two
+situations. If the current direction is ADVANCE, then the word under
+the cursor is changed to lower case and the cursor is moved to rest at
+the beginning of the next word. If the current direction is BACKUP,
+the word prior to the word under the cursor is changed to lower case
+and the cursor is left to rest at the beginning of that word."
+ (interactive "*")
+ (if edt-select-mode
+ (progn
+ (downcase-region (mark) (point)))
+ (progn
+ ;; Move to beginning of current word.
+ (if (and
+ (not (bobp))
+ (not (eobp))
+ (not (bolp))
+ (not (eolp))
+ (not (eq ?\ (char-syntax (preceding-char))))
+ (not (memq (preceding-char) edt-word-entities))
+ (not (memq (following-char) edt-word-entities)))
+ (edt-one-word-backward))
+ (if (equal edt-direction-string edt-backward-string)
+ (edt-one-word-backward))
+ (let ((beg (point)))
+ (edt-one-word-forward)
+ (downcase-region beg (point)))
+ (if (equal edt-direction-string edt-backward-string)
+ (edt-one-word-backward)))))
+
+;;;
+;;; UPCASE REGION
+;;;
+
+(defun edt-uppercase ()
+ "Change specified characters to upper case.
+If text selection IS active, then characters between the cursor and
+mark are changed. If text selection is NOT active, there are two
+situations. If the current direction is ADVANCE, then the word under
+the cursor is changed to upper case and the cursor is moved to rest at
+the beginning of the next word. If the current direction is BACKUP,
+the word prior to the word under the cursor is changed to upper case
+and the cursor is left to rest at the beginning of that word."
+ (interactive "*")
+ (if edt-select-mode
+ (progn
+ (upcase-region (mark) (point)))
+ (progn
+ ;; Move to beginning of current word.
+ (if (and
+ (not (bobp))
+ (not (eobp))
+ (not (bolp))
+ (not (eolp))
+ (not (eq ?\ (char-syntax (preceding-char))))
+ (not (memq (preceding-char) edt-word-entities))
+ (not (memq (following-char) edt-word-entities)))
+ (edt-one-word-backward))
+ (if (equal edt-direction-string edt-backward-string)
+ (edt-one-word-backward))
+ (let ((beg (point)))
+ (edt-one-word-forward)
+ (upcase-region beg (point)))
+ (if (equal edt-direction-string edt-backward-string)
+ (edt-one-word-backward)))))
+
+\f
+;;;
+;;; INITIALIZATION COMMANDS.
+;;;
+
+;;;
+;;; Emacs version 19 X-windows key definition support
+;;;
+(defvar edt-last-answer nil "Most recent response to edt-y-or-n-p.")
+
+(defun edt-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, also accepts space as y and DEL as n."
+ (message (format "%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 edt-last-answer t))
+ ((or (= ans ?n) (= ans ?N) (= ans ?\C-?))
+ (setq edt-last-answer nil))
+ ((= ans ?\r) (setq edt-last-answer (not not-yes)))
+ (t
+ (setq doit t) (beep)
+ (message (format "Please answer y or n. %s[%s]"
+ prompt (if not-yes "n" "y"))))))))
+ edt-last-answer)
+
+(defun edt-load-xkeys (file)
+ "Load the EDT X-windows key definitions FILE.
+If FILE is nil, try to load a default file. The default file names are
+~/.edt-lucid-keys for Lucid emacs, and ~/.edt-gnu-keys for GNU emacs."
+ (interactive "fX key definition file: ")
+ (cond (file
+ (setq file (expand-file-name file)))
+ (edt-xkeys-file
+ (setq file (expand-file-name edt-xkeys-file)))
+ (edt-gnu-emacs19-p
+ (setq file (expand-file-name "~/.edt-gnu-keys")))
+ (edt-lucid-emacs19-p
+ (setq file (expand-file-name "~/.edt-lucid-keys"))))
+ (cond ((file-readable-p file)
+ (load-file file))
+ (t
+ (switch-to-buffer "*scratch*")
+ (erase-buffer)
+ (insert "
+
+ Ack!! You're running the Enhanced EDT Emulation under X-windows
+ without loading an EDT X key definition file. To create an EDT X
+ key definition file, run the edt-mapper.el program. But ONLY run
+ it from an Emacs loaded without any of your own customizations
+ found in your .emacs file, etc. Some user customization confuse
+ the edt-mapper function. To do this, you need to invoke Emacs
+ as follows:
+
+ emacs -q -l edt-mapper.el
+
+ The file edt-mapper.el includes these same directions on how to
+ use it! Perhaps it's laying around here someplace. \n ")
+ (let ((file "edt-mapper.el")
+ (found nil)
+ (path nil)
+ (search-list (append (list (expand-file-name ".")) load-path)))
+ (while (and (not found) search-list)
+ (setq path (concat (car search-list)
+ (if (string-match "/$" (car search-list)) "" "/")
+ file))
+ (if (and (file-exists-p path) (not (file-directory-p path)))
+ (setq found t))
+ (setq search-list (cdr search-list)))
+ (cond (found
+ (insert (format
+ "Ah yes, there it is, in \n\n %s \n\n" path))
+ (if (edt-y-or-n-p "Do you want to run it now? ")
+ (load-file path)
+ (error "EDT Emulation not configured.")))
+ (t
+ (insert "Nope, I can't seem to find it. :-(\n\n")
+ (sit-for 20)
+ (error "EDT Emulation not configured.")))))))
-;;; Key Bindings
;;;###autoload
(defun edt-emulation-on ()
- "Emulate DEC's EDT editor.
-Note that many keys are rebound; including nearly all keypad keys.
-Use \\[edt-emulation-off] to undo all rebindings except the keypad keys."
- (interactive)
- (advance-direction)
- (edt-bind-gold-keypad)
- (setq edt-mode-old-c-\\ (lookup-key global-map "\C-\\"))
- (global-set-key "\C-\\" 'quoted-insert)
- (setq edt-mode-old-delete (lookup-key global-map "\177"))
- (global-set-key "\177" 'delete-previous-char) ;"Delete"
- (setq edt-mode-old-lisp-delete (lookup-key emacs-lisp-mode-map "\177"))
- (define-key emacs-lisp-mode-map "\177" 'delete-previous-char) ;"Delete"
- (define-key lisp-mode-map "\177" 'delete-previous-char) ;"Delete"
- (setq edt-mode-old-linefeed (lookup-key global-map "\C-j"))
- (global-set-key "\C-j" 'edt-delete-previous-word) ;"LineFeed"
- (define-key esc-map "?" 'apropos)) ;"<ESC>?"
-
-(defun edt-emulation-off ()
- "Return from EDT emulation to normal Emacs key bindings.
-The keys redefined by \\[edt-emulation-on] are given their old definitions."
- (interactive)
- (setq edt-direction-string nil)
- (global-set-key "\C-\\" edt-mode-old-c-\\)
- (global-set-key "\177" edt-mode-old-delete) ;"Delete"
- (define-key emacs-lisp-mode-map "\177" edt-mode-old-lisp-delete) ;"Delete"
- (define-key lisp-mode-map "\177" edt-mode-old-lisp-delete) ;"Delete"
- (global-set-key "\C-j" edt-mode-old-linefeed)) ;"LineFeed"
-
-(defvar GOLD-map (make-keymap)
- "`GOLD-map' maps the function keys on the VT100 keyboard preceded
-by the PF1 key. GOLD is the ASCII the 7-bit escape sequence <ESC>OP.")
-
-(defalias 'GOLD-prefix GOLD-map)
-
-(global-set-key [home] 'edt-beginning-of-window)
-(global-set-key [kp-f2] 'describe-key)
-(global-set-key [kp-f4] 'delete-current-line)
-(global-set-key [kp-9] 'append-to-buffer)
-(global-set-key [kp-subtract] 'delete-current-word)
-(global-set-key [kp-4] 'advance-direction)
-(global-set-key [kp-5] 'backup-direction)
-(global-set-key [kp-6] 'kill-region)
-(global-set-key [kp-separator] 'delete-current-char)
-(global-set-key [kp-decimal] 'set-mark-command)
-(global-set-key [kp-enter] 'other-window)
-(global-set-key [kp-f1] 'GOLD-prefix)
-
-;;Bind GOLD/Keyboard keys
-
-(define-key GOLD-map "\C-g" 'keyboard-quit) ; just for safety
-(define-key GOLD-map "\177" 'delete-window) ;"Delete"
-(define-key GOLD-map "\C-h" 'delete-other-windows) ;"BackSpace"
-(define-key GOLD-map "\C-m" 'newline-and-indent) ;"Return"
-(define-key GOLD-map " " 'undo) ;"Spacebar"
-(define-key GOLD-map "%" 'goto-percent) ; "%"
-(define-key GOLD-map "=" 'goto-line) ; "="
-(define-key GOLD-map "`" 'what-line) ; "`"
-(define-key GOLD-map "\C-\\" 'split-window-vertically) ; "Control-\"
-
-; GOLD letter combinations:
-(define-key GOLD-map "b" 'buffer-menu) ; "b"
-(define-key GOLD-map "B" 'buffer-menu) ; "B"
-(define-key GOLD-map "d" 'delete-window) ; "d"
-(define-key GOLD-map "D" 'delete-window) ; "D"
-(define-key GOLD-map "e" 'compile) ; "e"
-(define-key GOLD-map "E" 'compile) ; "E"
-(define-key GOLD-map "i" 'insert-file) ; "i"
-(define-key GOLD-map "I" 'insert-file) ; "I"
-(define-key GOLD-map "l" 'goto-line) ; "l"
-(define-key GOLD-map "L" 'goto-line) ; "L"
-(define-key GOLD-map "m" 'save-some-buffers) ; "m"
-(define-key GOLD-map "M" 'save-some-buffers) ; "m"
-(define-key GOLD-map "n" 'next-error) ; "n"
-(define-key GOLD-map "N" 'next-error) ; "N"
-(define-key GOLD-map "o" 'switch-to-buffer-other-window) ; "o"
-(define-key GOLD-map "O" 'switch-to-buffer-other-window) ; "O"
-(define-key GOLD-map "r" 'revert-file) ; "r"
-(define-key GOLD-map "r" 'revert-file) ; "R"
-(define-key GOLD-map "s" 'save-buffer) ; "s"
-(define-key GOLD-map "S" 'save-buffer) ; "S"
-(define-key GOLD-map "v" 'find-file-other-window) ; "v"
-(define-key GOLD-map "V" 'find-file-other-window) ; "V"
-(define-key GOLD-map "w" 'write-file) ; "w"
-(define-key GOLD-map "w" 'write-file) ; "W"
-;(define-key GOLD-map "z" 'shrink-window) ; "z"
-;(define-key GOLD-map "Z" 'shrink-window) ; "z"
-
-;Bind GOLD/Keypad keys
-(defun edt-bind-gold-keypad ()
- (define-key GOLD-map [up] 'edt-line-to-top-of-window)
- (define-key GOLD-map [down] 'edt-line-to-bottom-of-window)
- (define-key GOLD-map [left] 'backward-sentence)
- (define-key GOLD-map [right] 'forward-sentence)
- (define-key GOLD-map [kp-f1] 'mark-section-wisely)
- (define-key GOLD-map [kp-f2] 'describe-function)
- (define-key GOLD-map [kp-f3] 'occur)
- (define-key GOLD-map [kp-f4] 'undelete-lines)
- (define-key GOLD-map [kp-0] 'open-line)
- (define-key GOLD-map [kp-1] 'case-flip-character)
- (define-key GOLD-map [kp-2] 'delete-to-eol)
- (define-key GOLD-map [kp-3] 'copy-region-as-kill)
- (define-key GOLD-map [kp-4] 'move-to-end)
- (define-key GOLD-map [kp-5] 'move-to-beginning)
- (define-key GOLD-map [kp-6] 'yank)
- (define-key GOLD-map [kp-7] 'execute-extended-command)
- (define-key GOLD-map [kp-8] 'indent-or-fill-region)
- (define-key GOLD-map [kp-9] 'replace-regexp)
- (define-key GOLD-map [kp-subtract] 'undelete-words)
- (define-key GOLD-map [kp-separator] 'undelete-chars)
- (define-key GOLD-map [kp-decimal] 'redraw-display)
- (define-key GOLD-map [kp-enter] 'shell-command))
-
-;; Make direction of motion show in mode line
-;; while EDT emulation is turned on.
-;; Note that the keypad is always turned on when in Emacs.
-
-(or (assq 'edt-direction-string minor-mode-alist)
- (setq minor-mode-alist (cons '(edt-direction-string edt-direction-string)
- minor-mode-alist)))
+ "Turn on EDT Emulation."
+ (interactive)
+ ;; If using MS-DOS, need to load edt-pc.el
+ (if (string-equal system-type "ms-dos")
+ (setq edt-term "pc")
+ (setq edt-term (getenv "TERM")))
+ ;; All DEC VT series terminals are supported by loading edt-vt100.el
+ (if (string-equal "vt" (substring edt-term 0 (min (length edt-term) 2)))
+ (setq edt-term "vt100"))
+ ;; Load EDT terminal specific configuration file.
+ (let ((term edt-term)
+ hyphend)
+ (while (and term
+ (not (load (concat "edt-" term) t t)))
+ ;; Strip off last hyphen and what follows, then try again
+ (if (setq hyphend (string-match "[-_][^-_]+$" term))
+ (setq term (substring term 0 hyphend))
+ (setq term nil)))
+ ;; Override terminal-specific file if running X Windows. X Windows support
+ ;; is handled differently in edt-load-xkeys
+ (if window-system
+ (edt-load-xkeys nil)
+ (if (null term)
+ (error "Unable to load EDT terminal specific file for %s" edt-term)))
+ (setq edt-term term))
+ (setq edt-orig-transient-mark-mode transient-mark-mode)
+ (add-hook 'activate-mark-hook
+ (function
+ (lambda ()
+ (edt-select-mode t))))
+ (add-hook 'deactivate-mark-hook
+ (function
+ (lambda ()
+ (edt-select-mode nil))))
+ (if (load "edt-user" t t)
+ (edt-user-emulation-setup)
+ (edt-default-emulation-setup)))
+
+(defun edt-emulation-off()
+ "Select original global key bindings, disabling EDT Emulation."
+ (interactive)
+ (use-global-map global-map)
+ (if (not edt-keep-current-page-delimiter)
+ (setq page-delimiter edt-orig-page-delimiter))
+ (setq edt-direction-string "")
+ (setq edt-select-mode-text nil)
+ (edt-reset)
+ (force-mode-line-update t)
+ (setq transient-mark-mode edt-orig-transient-mark-mode)
+ (message "Original key bindings restored; EDT Emulation disabled"))
+
+(defun edt-default-emulation-setup (&optional user-setup)
+ "Setup emulation of DEC's EDT editor."
+ ;; Setup default EDT global map by copying global map bindings.
+ ;; This preserves ESC and C-x prefix bindings and other bindings we
+ ;; wish to retain in EDT emulation mode keymaps. It also permits
+ ;; customization of these bindings in the EDT global maps without
+ ;; disturbing the original bindings in global-map.
+ (fset 'edt-default-ESC-prefix (copy-keymap 'ESC-prefix))
+ (setq edt-default-global-map (copy-keymap (current-global-map)))
+ (define-key edt-default-global-map "\e" 'edt-default-ESC-prefix)
+ (define-prefix-command 'edt-default-gold-map)
+ (edt-setup-default-bindings)
+ ;; If terminal has additional function keys, the terminal-specific
+ ;; initialization file can assign bindings to them via the optional
+ ;; function edt-setup-extra-default-bindings.
+ (if (fboundp 'edt-setup-extra-default-bindings)
+ (edt-setup-extra-default-bindings))
+ ;; Variable needed by edt-learn.
+ (setq edt-learn-macro-count 0)
+ ;; Display EDT text selection active within the mode line
+ (or (assq 'edt-select-mode minor-mode-alist)
+ (setq minor-mode-alist
+ (cons '(edt-select-mode edt-select-mode) minor-mode-alist)))
+ ;; Display EDT direction of motion within the mode line
+ (or (assq 'edt-direction-string minor-mode-alist)
+ (setq minor-mode-alist
+ (cons
+ '(edt-direction-string edt-direction-string) minor-mode-alist)))
+ (if user-setup
+ (progn
+ (setq edt-user-map-configured t)
+ (fset 'edt-emulation-on (symbol-function 'edt-select-user-global-map)))
+ (progn
+ (fset 'edt-emulation-on (symbol-function 'edt-select-default-global-map))
+ (edt-select-default-global-map))))
+
+(defun edt-user-emulation-setup ()
+ "Setup user custom emulation of DEC's EDT editor."
+ ;; Initialize EDT default bindings.
+ (edt-default-emulation-setup t)
+ ;; Setup user EDT global map by copying default EDT global map bindings.
+ (fset 'edt-user-ESC-prefix (copy-keymap 'edt-default-ESC-prefix))
+ (setq edt-user-global-map (copy-keymap edt-default-global-map))
+ (define-key edt-user-global-map "\e" 'edt-user-ESC-prefix)
+ ;; If terminal has additional function keys, the user's initialization
+ ;; file can assign bindings to them via the optional
+ ;; function edt-setup-extra-default-bindings.
+ (define-prefix-command 'edt-user-gold-map)
+ (fset 'edt-user-gold-map (copy-keymap 'edt-default-gold-map))
+ (edt-setup-user-bindings)
+ (edt-select-user-global-map))
+
+(defun edt-select-default-global-map()
+ "Select default EDT emulation key bindings."
+ (interactive)
+ (transient-mark-mode 1)
+ (use-global-map edt-default-global-map)
+ (if (not edt-keep-current-page-delimiter)
+ (progn
+ (setq edt-orig-page-delimiter page-delimiter)
+ (setq page-delimiter "\f")))
+ (setq edt-default-map-active t)
+ (edt-advance)
+ (setq edt-select-mode-text 'edt-select-mode-string)
+ (edt-reset)
+ (message "Default EDT keymap active"))
+
+(defun edt-select-user-global-map()
+ "Select user EDT emulation custom key bindings."
+ (interactive)
+ (if edt-user-map-configured
+ (progn
+ (transient-mark-mode 1)
+ (use-global-map edt-user-global-map)
+ (if (not edt-keep-current-page-delimiter)
+ (progn
+ (setq edt-orig-page-delimiter page-delimiter)
+ (setq page-delimiter "\f")))
+ (setq edt-default-map-active nil)
+ (edt-advance)
+ (setq edt-select-mode-text 'edt-select-mode-string)
+ (edt-reset)
+ (message "User EDT custom keymap active"))
+ (error "User EDT custom keymap NOT configured!")))
+
+(defun edt-switch-global-maps ()
+ "Toggle between default EDT keymap and user EDT keymap."
+ (interactive)
+ (if edt-default-map-active
+ (edt-select-user-global-map)
+ (edt-select-default-global-map)))
+
+;; There are three key binding functions needed: one for standard keys
+;; (used to bind control keys, primarily), one for Gold sequences of
+;; standard keys, and one for function keys.
+
+(defun edt-bind-gold-key (key gold-binding &optional default)
+ "Binds commands to a gold key sequence in the EDT Emulator."
+ (if default
+ (define-key 'edt-default-gold-map key gold-binding)
+ (define-key 'edt-user-gold-map key gold-binding)))
+
+(defun edt-bind-standard-key (key gold-binding &optional default)
+ "Bind commands to a gold key sequence in the default EDT keymap."
+ (if default
+ (define-key edt-default-global-map key gold-binding)
+ (define-key edt-user-global-map key gold-binding)))
+
+(defun edt-bind-function-key
+ (function-key binding gold-binding &optional default)
+ "Binds function keys in the EDT Emulator."
+ (catch 'edt-key-not-supported
+ (let ((key-vector (cdr (assoc function-key *EDT-keys*))))
+ (if (stringp key-vector)
+ (throw 'edt-key-not-supported t))
+ (if (not (null key-vector))
+ (progn
+ (if default
+ (progn
+ (define-key edt-default-global-map key-vector binding)
+ (define-key 'edt-default-gold-map key-vector gold-binding))
+ (progn
+ (define-key edt-user-global-map key-vector binding)
+ (define-key 'edt-user-gold-map key-vector gold-binding))))
+ (error "%s is not a legal function key name" function-key)))))
+
+(defun edt-setup-default-bindings ()
+ "Assigns default EDT Emulation keyboard bindings."
+
+ ;; Function Key Bindings: Regular and GOLD.
+
+ ;; VT100/VT200/VT300 PF1 (GOLD), PF2, PF3, PF4 Keys
+ (edt-bind-function-key "PF1" 'edt-default-gold-map 'edt-mark-section-wisely t)
+ (edt-bind-function-key "PF2" 'edt-electric-keypad-help 'describe-function t)
+ (edt-bind-function-key "PF3" 'edt-find-next 'edt-find t)
+ (edt-bind-function-key "PF4" 'edt-delete-line 'edt-undelete-line t)
+
+ ;; VT100/VT200/VT300 Arrow Keys
+ (edt-bind-function-key "UP" 'previous-line 'edt-window-top t)
+ (edt-bind-function-key "DOWN" 'next-line 'edt-window-bottom t)
+ (edt-bind-function-key "LEFT" 'backward-char 'edt-sentence-backward t)
+ (edt-bind-function-key "RIGHT" 'forward-char 'edt-sentence-forward t)
+
+ ;; VT100/VT200/VT300 Keypad Keys
+ (edt-bind-function-key "KP0" 'edt-line 'open-line t)
+ (edt-bind-function-key "KP1" 'edt-word 'edt-change-case t)
+ (edt-bind-function-key "KP2" 'edt-end-of-line 'edt-delete-to-end-of-line t)
+ (edt-bind-function-key "KP3" 'edt-character 'quoted-insert t)
+ (edt-bind-function-key "KP4" 'edt-advance 'edt-bottom t)
+ (edt-bind-function-key "KP5" 'edt-backup 'edt-top t)
+ (edt-bind-function-key "KP6" 'edt-cut 'yank t)
+ (edt-bind-function-key "KP7" 'edt-page 'execute-extended-command t)
+ (edt-bind-function-key "KP8" 'edt-sect 'edt-fill-region t)
+ (edt-bind-function-key "KP9" 'edt-append 'edt-replace t)
+ (edt-bind-function-key "KP-" 'edt-delete-word 'edt-undelete-word t)
+ (edt-bind-function-key "KP," 'edt-delete-character 'edt-undelete-character t)
+ (edt-bind-function-key "KPP" 'edt-select 'edt-reset t)
+ (edt-bind-function-key "KPE" 'other-window 'query-replace t)
+
+ ;; VT200/VT300 Function Keys
+ ;; (F1 through F5, on the VT220, are not programmable, so we skip
+ ;; making default bindings to those keys.
+ (edt-bind-function-key "FIND" 'edt-find-next 'edt-find t)
+ (edt-bind-function-key "INSERT" 'yank 'edt-key-not-assigned t)
+ (edt-bind-function-key "REMOVE" 'edt-cut 'edt-copy t)
+ (edt-bind-function-key "SELECT" 'edt-toggle-select 'edt-key-not-assigned t)
+ (edt-bind-function-key "NEXT" 'edt-sect-forward 'edt-key-not-assigned t)
+ (edt-bind-function-key "PREVIOUS" 'edt-sect-backward 'edt-key-not-assigned t)
+ (edt-bind-function-key "F6" 'edt-key-not-assigned 'edt-key-not-assigned t)
+ (edt-bind-function-key "F7" 'edt-copy-rectangle 'edt-key-not-assigned t)
+ (edt-bind-function-key "F8"
+ 'edt-cut-rectangle-overstrike-mode 'edt-paste-rectangle-overstrike-mode t)
+ (edt-bind-function-key "F9"
+ 'edt-cut-rectangle-insert-mode 'edt-paste-rectangle-insert-mode t)
+ (edt-bind-function-key "F10" 'edt-cut-rectangle 'edt-paste-rectangle t)
+ ;; Under X, the F11 key can be bound. If using a VT-200 or higher terminal,
+ ;; the default emacs terminal support causes the VT F11 key to seem as if it
+ ;; is an ESC key when in emacs.
+ (edt-bind-function-key "F11"
+ 'edt-key-not-assigned 'edt-key-not-assigned t)
+ (edt-bind-function-key "F12"
+ 'edt-beginning-of-line 'delete-other-windows t) ;BS
+ (edt-bind-function-key "F13"
+ 'edt-delete-to-beginning-of-word 'edt-key-not-assigned t) ;LF
+ (edt-bind-function-key "F14" 'edt-key-not-assigned 'edt-key-not-assigned t)
+ (edt-bind-function-key "HELP" 'edt-electric-keypad-help 'edt-key-not-assigned t)
+ (edt-bind-function-key "DO" 'execute-extended-command 'edt-key-not-assigned t)
+ (edt-bind-function-key "F17" 'edt-key-not-assigned 'edt-key-not-assigned t)
+ (edt-bind-function-key "F18" 'edt-key-not-assigned 'edt-key-not-assigned t)
+ (edt-bind-function-key "F19" 'edt-key-not-assigned 'edt-key-not-assigned t)
+ (edt-bind-function-key "F20" 'edt-key-not-assigned 'edt-key-not-assigned t)
+
+ ;; Control key bindings: Regular and GOLD
+ ;;
+ ;; Standard EDT control key bindings conflict with standard Emacs
+ ;; control key bindings. Normally, the standard Emacs control key
+ ;; bindings are left unchanged in the default EDT mode. However, if
+ ;; the variable edt-use-EDT-control-key-bindings is set to true
+ ;; before invoking edt-emulation-on for the first time, then the
+ ;; standard EDT bindings (with some enhancements) as defined here are
+ ;; used, instead.
+ (if edt-use-EDT-control-key-bindings
+ (progn
+ (edt-bind-standard-key "\C-a" 'edt-key-not-assigned t)
+ (edt-bind-standard-key "\C-b" 'edt-key-not-assigned t)
+ ;; Leave binding of C-c as original prefix key.
+ (edt-bind-standard-key "\C-d" 'edt-key-not-assigned t)
+ (edt-bind-standard-key "\C-e" 'edt-key-not-assigned t)
+ (edt-bind-standard-key "\C-f" 'edt-key-not-assigned t)
+ ;; Leave binding of C-g to keyboard-quit
+; (edt-bind-standard-key "\C-g" 'keyboard-quit t)
+ ;; Standard EDT binding of C-h. To invoke Emacs help, use
+ ;; GOLD-C-h instead.
+ (edt-bind-standard-key "\C-h" 'edt-beginning-of-line t)
+ (edt-bind-standard-key "\C-i" 'edt-tab-insert t)
+ (edt-bind-standard-key "\C-j" 'edt-delete-to-beginning-of-word t)
+ (edt-bind-standard-key "\C-k" 'edt-define-key t)
+ (edt-bind-gold-key "\C-k" 'edt-restore-key t)
+ (edt-bind-standard-key "\C-l" 'edt-form-feed-insert t)
+ ;; Leave binding of C-m to newline.
+ (edt-bind-standard-key "\C-n" 'edt-set-screen-width-80 t)
+ (edt-bind-standard-key "\C-o" 'edt-key-not-assigned t)
+ (edt-bind-standard-key "\C-p" 'edt-key-not-assigned t)
+ (edt-bind-standard-key "\C-q" 'edt-key-not-assigned t)
+ ;; Leave binding of C-r to isearch-backward.
+ ;; Leave binding of C-s to isearch-forward.
+ (edt-bind-standard-key "\C-t" 'edt-display-the-time t)
+ (edt-bind-standard-key "\C-u" 'edt-delete-to-beginning-of-line t)
+ (edt-bind-standard-key "\C-v" 'redraw-display t)
+ (edt-bind-standard-key "\C-w" 'edt-set-screen-width-132 t)
+ ;; Leave binding of C-x as original prefix key.
+ (edt-bind-standard-key "\C-y" 'edt-key-not-assigned t)
+; (edt-bind-standard-key "\C-z" 'suspend-emacs t)
+ )
+ )
+
+ ;; GOLD bindings for a few Control keys.
+ (edt-bind-gold-key "\C-g" 'keyboard-quit t); Just in case.
+ (edt-bind-gold-key "\C-h" 'help-for-help t)
+ (edt-bind-gold-key "\C-\\" 'split-window-vertically t)
+
+ ;; GOLD bindings for regular keys.
+ (edt-bind-gold-key "a" 'edt-key-not-assigned t)
+ (edt-bind-gold-key "A" 'edt-key-not-assigned t)
+ (edt-bind-gold-key "b" 'buffer-menu t)
+ (edt-bind-gold-key "B" 'buffer-menu t)
+ (edt-bind-gold-key "c" 'compile t)
+ (edt-bind-gold-key "C" 'compile t)
+ (edt-bind-gold-key "d" 'delete-window t)
+ (edt-bind-gold-key "D" 'delete-window t)
+ (edt-bind-gold-key "e" 'edt-exit t)
+ (edt-bind-gold-key "E" 'edt-exit t)
+ (edt-bind-gold-key "f" 'find-file t)
+ (edt-bind-gold-key "F" 'find-file t)
+ (edt-bind-gold-key "g" 'find-file-other-window t)
+ (edt-bind-gold-key "G" 'find-file-other-window t)
+ (edt-bind-gold-key "h" 'edt-electric-keypad-help t)
+ (edt-bind-gold-key "H" 'edt-electric-keypad-help t)
+ (edt-bind-gold-key "i" 'insert-file t)
+ (edt-bind-gold-key "I" 'insert-file t)
+ (edt-bind-gold-key "j" 'edt-key-not-assigned t)
+ (edt-bind-gold-key "J" 'edt-key-not-assigned t)
+ (edt-bind-gold-key "k" 'edt-toggle-capitalization-of-word t)
+ (edt-bind-gold-key "K" 'edt-toggle-capitalization-of-word t)
+ (edt-bind-gold-key "l" 'edt-lowercase t)
+ (edt-bind-gold-key "L" 'edt-lowercase t)
+ (edt-bind-gold-key "m" 'save-some-buffers t)
+ (edt-bind-gold-key "M" 'save-some-buffers t)
+ (edt-bind-gold-key "n" 'next-error t)
+ (edt-bind-gold-key "N" 'next-error t)
+ (edt-bind-gold-key "o" 'switch-to-buffer-other-window t)
+ (edt-bind-gold-key "O" 'switch-to-buffer-other-window t)
+ (edt-bind-gold-key "p" 'edt-key-not-assigned t)
+ (edt-bind-gold-key "P" 'edt-key-not-assigned t)
+ (edt-bind-gold-key "q" 'edt-quit t)
+ (edt-bind-gold-key "Q" 'edt-quit t)
+ (edt-bind-gold-key "r" 'revert-file t)
+ (edt-bind-gold-key "R" 'revert-file t)
+ (edt-bind-gold-key "s" 'save-buffer t)
+ (edt-bind-gold-key "S" 'save-buffer t)
+ (edt-bind-gold-key "t" 'edt-key-not-assigned t)
+ (edt-bind-gold-key "T" 'edt-key-not-assigned t)
+ (edt-bind-gold-key "u" 'edt-uppercase t)
+ (edt-bind-gold-key "U" 'edt-uppercase t)
+ (edt-bind-gold-key "v" 'find-file-other-window t)
+ (edt-bind-gold-key "V" 'find-file-other-window t)
+ (edt-bind-gold-key "w" 'write-file t)
+ (edt-bind-gold-key "W" 'write-file t)
+ (edt-bind-gold-key "x" 'edt-key-not-assigned t)
+ (edt-bind-gold-key "X" 'edt-key-not-assigned t)
+ (edt-bind-gold-key "y" 'edt-emulation-off t)
+ (edt-bind-gold-key "Y" 'edt-emulation-off t)
+ (edt-bind-gold-key "z" 'edt-switch-global-maps t)
+ (edt-bind-gold-key "Z" 'edt-switch-global-maps t)
+ (edt-bind-gold-key "1" 'delete-other-windows t)
+ (edt-bind-gold-key "!" 'edt-key-not-assigned t)
+ (edt-bind-gold-key "2" 'edt-split-window t)
+ (edt-bind-gold-key "@" 'edt-key-not-assigned t)
+ (edt-bind-gold-key "3" 'edt-key-not-assigned t)
+ (edt-bind-gold-key "#" 'edt-key-not-assigned t)
+ (edt-bind-gold-key "4" 'edt-key-not-assigned t)
+ (edt-bind-gold-key "$" 'edt-key-not-assigned t)
+ (edt-bind-gold-key "5" 'edt-key-not-assigned t)
+ (edt-bind-gold-key "%" 'edt-goto-percentage t)
+ (edt-bind-gold-key "6" 'edt-key-not-assigned t)
+ (edt-bind-gold-key "^" 'edt-key-not-assigned t)
+ (edt-bind-gold-key "7" 'edt-key-not-assigned t)
+ (edt-bind-gold-key "&" 'edt-key-not-assigned t)
+ (edt-bind-gold-key "8" 'edt-key-not-assigned t)
+ (edt-bind-gold-key "*" 'edt-key-not-assigned t)
+ (edt-bind-gold-key "9" 'edt-key-not-assigned t)
+ (edt-bind-gold-key "(" 'edt-key-not-assigned t)
+ (edt-bind-gold-key "0" 'edt-key-not-assigned t)
+ (edt-bind-gold-key ")" 'edt-key-not-assigned t)
+ (edt-bind-gold-key " " 'undo t)
+ (edt-bind-gold-key "," 'edt-key-not-assigned t)
+ (edt-bind-gold-key "<" 'edt-key-not-assigned t)
+ (edt-bind-gold-key "." 'edt-key-not-assigned t)
+ (edt-bind-gold-key ">" 'edt-key-not-assigned t)
+ (edt-bind-gold-key "/" 'edt-key-not-assigned t)
+ (edt-bind-gold-key "?" 'edt-key-not-assigned t)
+ (edt-bind-gold-key "\\" 'edt-key-not-assigned t)
+ (edt-bind-gold-key "|" 'edt-key-not-assigned t)
+ (edt-bind-gold-key ";" 'edt-key-not-assigned t)
+ (edt-bind-gold-key ":" 'edt-key-not-assigned t)
+ (edt-bind-gold-key "'" 'edt-key-not-assigned t)
+ (edt-bind-gold-key "\"" 'edt-key-not-assigned t)
+ (edt-bind-gold-key "-" 'edt-key-not-assigned t)
+ (edt-bind-gold-key "_" 'edt-key-not-assigned t)
+ (edt-bind-gold-key "=" 'goto-line t)
+ (edt-bind-gold-key "+" 'edt-key-not-assigned t)
+ (edt-bind-gold-key "[" 'edt-key-not-assigned t)
+ (edt-bind-gold-key "{" 'edt-key-not-assigned t)
+ (edt-bind-gold-key "]" 'edt-key-not-assigned t)
+ (edt-bind-gold-key "}" 'edt-key-not-assigned t)
+ (edt-bind-gold-key "`" 'what-line t)
+ (edt-bind-gold-key "~" 'edt-key-not-assigned t)
+)
+\f
+;;;
+;;; DEFAULT EDT KEYPAD HELP
+;;;
+
+;;;
+;;; Upper case commands in the keypad diagram below indicate that the
+;;; emulation should look and feel very much like EDT. Lower case
+;;; commands are enhancements and/or additions to the EDT keypad
+;;; commands or are native Emacs commands.
+;;;
+
+(defun edt-keypad-help ()
+ "
+ DEFAULT EDT Keypad Active
+
+ F7: Copy Rectangle +----------+----------+----------+----------+
+ F8: Cut Rect Overstrike |Prev Line |Next Line |Bkwd Char |Frwd Char |
+ G-F8: Paste Rect Overstrike | (UP) | (DOWN) | (LEFT) | (RIGHT) |
+ F9: Cut Rect Insert |Window Top|Window Bot|Bkwd Sent |Frwd Sent |
+ G-F9: Paste Rect Insert +----------+----------+----------+----------+
+ F10: Cut Rectangle
+G-F10: Paste Rectangle
+ F11: ESC
+ F12: Begining of Line +----------+----------+----------+----------+
+G-F12: Delete Other Windows | GOLD | HELP | FNDNXT | DEL L |
+ F13: Delete to Begin of Word | (PF1) | (PF2) | (PF3) | (PF4) |
+ HELP: Keypad Help |Mark Wisel|Desc Funct| FIND | UND L |
+ DO: Execute extended command +----------+----------+----------+----------+
+ | PAGE | SECT | APPEND | DEL W |
+ C-g: Keyboard Quit | (7) | (8) | (9) | (-) |
+G-C-g: Keyboard Quit |Ex Ext Cmd|Fill Regio| REPLACE | UND W |
+ C-h: Beginning of Line +----------+----------+----------+----------+
+G-C-h: Emacs Help | ADVANCE | BACKUP | CUT | DEL C |
+ C-i: Tab Insert | (4) | (5) | (6) | (,) |
+ C-j: Delete to Begin of Word | BOTTOM | TOP | Yank | UND C |
+ C-k: Define Key +----------+----------+----------+----------+
+G-C-k: Restore Key | WORD | EOL | CHAR | Next |
+ C-l: Form Feed Insert | (1) | (2) | (3) | Window |
+ C-n: Set Screen Width 80 | CHNGCASE | DEL EOL |Quoted Ins| !
+ C-r: Isearch Backward +---------------------+----------+ (ENTER) |
+ C-s: Isearch Forward | LINE | SELECT | !
+ C-t: Display the Time | (0) | (.) | Query |
+ C-u: Delete to Begin of Line | Open Line | RESET | Replace |
+ C-v: Redraw Display +---------------------+----------+----------+
+ C-w: Set Screen Width 132
+ C-z: Suspend Emacs +----------+----------+----------+
+G-C-\\: Split Window | FNDNXT | Yank | CUT |
+ | (FIND) | (INSERT) | (REMOVE) |
+ G-b: Buffer Menu | FIND | | COPY |
+ G-c: Compile +----------+----------+----------+
+ G-d: Delete Window |SELECT/RES|SECT BACKW|SECT FORWA|
+ G-e: Exit | (SELECT) |(PREVIOUS)| (NEXT) |
+ G-f: Find File | | | |
+ G-g: Find File Other Window +----------+----------+----------+
+ G-h: Keypad Help
+ G-i: Insert File
+ G-k: Toggle Capitalization Word
+ G-l: Downcase Region
+ G-m: Save Some Buffers
+ G-n: Next Error
+ G-o: Switch to Next Window
+ G-q: Quit
+ G-r: Revert File
+ G-s: Save Buffer
+ G-u: Upcase Region
+ G-v: Find File Other Window
+ G-w: Write file
+ G-y: EDT Emulation OFF
+ G-z: Switch to User EDT Key Bindings
+ G-1: Delete Other Windows
+ G-2: Split Window
+ G-%: Go to Percentage
+ G- : Undo (GOLD Spacebar)
+ G-=: Go to Line
+ G-`: What line"
+
+ (interactive)
+ (describe-function 'edt-keypad-help))
+
+(defun edt-electric-helpify (fun)
+ (let ((name "*Help*"))
+ (if (save-window-excursion
+ (let* ((p (symbol-function 'print-help-return-message))
+ (b (get-buffer name))
+ (m (buffer-modified-p b)))
+ (and b (not (get-buffer-window b))
+ (setq b nil))
+ (unwind-protect
+ (progn
+ (message "%s..." (capitalize (symbol-name fun)))
+ (and b
+ (save-excursion
+ (set-buffer b)
+ (set-buffer-modified-p t)))
+ (fset 'print-help-return-message 'ignore)
+ (call-interactively fun)
+ (and (get-buffer name)
+ (get-buffer-window (get-buffer name))
+ (or (not b)
+ (not (eq b (get-buffer name)))
+ (not (buffer-modified-p b)))))
+ (fset 'print-help-return-message p)
+ (and b (buffer-name b)
+ (save-excursion
+ (set-buffer b)
+ (set-buffer-modified-p m))))))
+ (with-electric-help 'delete-other-windows name t))))
+
+(defun edt-electric-keypad-help ()
+ (interactive)
+ (edt-electric-helpify 'edt-keypad-help))
+
+(defun edt-electric-user-keypad-help ()
+ (interactive)
+ (edt-electric-helpify 'edt-user-keypad-help))
+
+;;;
+;;; Generic EDT emulation screen width commands.
+;;;
+;; If modification of terminal attributes is desired when invoking these
+;; commands, then the corresponding terminal specific file will contain a
+;; re-definition of these commands.
+
+(defun edt-set-screen-width-80 ()
+ "Set screen width to 80 columns."
+ (interactive)
+ (set-screen-width 80)
+ (message "Screen width 80"))
+
+(defun edt-set-screen-width-132 ()
+ "Set screen width to 132 columns."
+ (interactive)
+ (set-screen-width 132)
+ (message "Screen width 132"))
+
+(provide 'edt)
;;; edt.el ends here