mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-11-27 07:37:33 +00:00
2626 lines
88 KiB
EmacsLisp
2626 lines
88 KiB
EmacsLisp
;;; edt.el --- enhanced EDT keypad mode emulation for GNU Emacs
|
||
|
||
;; Copyright (C) 1986, 1992-1995, 2000-2017 Free Software Foundation,
|
||
;; Inc.
|
||
|
||
;; Author: Kevin Gallagher <kevin.gal@verizon.net>
|
||
;; Maintainer: Kevin Gallagher <kevin.gal@verizon.net>
|
||
;; Keywords: emulations
|
||
|
||
;; This file is part of GNU Emacs.
|
||
|
||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||
;; it under the terms of the GNU General Public License as published by
|
||
;; the Free Software Foundation, either version 3 of the License, or
|
||
;; (at your option) any later version.
|
||
|
||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
;; GNU General Public License for more details.
|
||
|
||
;; You should have received a copy of the GNU General Public License
|
||
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
||
|
||
|
||
|
||
;;; Commentary:
|
||
;;
|
||
|
||
;; This is Version 4.0 of the EDT Emulation for Emacs.
|
||
;; It comes with special functions which replicate nearly all of EDT's
|
||
;; keypad mode behavior. It sets up default keypad and function key
|
||
;; bindings which closely match those found in EDT. Support is
|
||
;; provided so that users may reconfigure most keypad and function key
|
||
;; bindings to their own liking.
|
||
|
||
;; NOTE: Version 4.0 contains several enhancements. See the
|
||
;; Enhancement section below for the details.
|
||
|
||
;; Getting Started:
|
||
|
||
;; To start the EDT Emulation, first start Emacs and then enter
|
||
;;
|
||
;; M-x edt-emulation-on
|
||
;;
|
||
;; to begin the emulation. After initialization is complete, the
|
||
;; following message will appear below the status line informing you
|
||
;; that the emulation has been enabled: "Default EDT keymap active".
|
||
|
||
;; You can have the EDT Emulation start up automatically, each time
|
||
;; you initiate a GNU Emacs session, by adding the following line to
|
||
;; your init file:
|
||
;;
|
||
;; (add-hook 'emacs-startup-hook 'edt-emulation-on)
|
||
|
||
;; IMPORTANT: Be sure to read the Info node `edt' for more details.
|
||
;; It contains very helpful user information.
|
||
|
||
;; The EDT emulation consists of the following files:
|
||
;;
|
||
;; edt.texi - User manual
|
||
;; edt-user.el - Sample Customization File (located in Emacs
|
||
;; distribution etc directory)
|
||
;; edt.el - EDT Emulation Functions and Default Configuration
|
||
;; edt-lk201.el - Built-in support for DEC LK-201 Keyboards
|
||
;; edt-vt100.el - Built-in support for DEC VT-100 (and above) terminals
|
||
;; edt-pc.el - Built-in support for PC 101 Keyboards under MS-DOS
|
||
;; edt-mapper.el - Create an EDT LK-201 Map File for Keyboards Without
|
||
;; Built-in Support
|
||
|
||
;; Enhancements:
|
||
|
||
;; Version 4.0 contains the following enhancements:
|
||
|
||
;; 1. Scroll margins at the top and bottom of the window are now
|
||
;; supported. (The design was copied from tpu-extras.el.) By
|
||
;; default, this feature is enabled, with the top margin set to
|
||
;; 10% of the window and the bottom margin set to 15% of the
|
||
;; window. To change these settings, you can invoke the function
|
||
;; edt-set-scroll-margins in your init file. For example, the
|
||
;; following line
|
||
;;
|
||
;; (edt-set-scroll-margins "20%" "25%")
|
||
;;
|
||
;; sets the top margin to 20% of the window and the bottom margin
|
||
;; to 25% of the window. To disable this feature, set each
|
||
;; margin to 0%. You can also invoke edt-set-scroll-margins
|
||
;; interactively while EDT Emulation is active to change the
|
||
;; settings for that session.
|
||
;;
|
||
;; NOTE: Another way to set the scroll margins is to use the
|
||
;; Emacs customization feature to set the following two variables
|
||
;; directly:
|
||
;;
|
||
;; edt-top-scroll-margin and edt-bottom-scroll-margin
|
||
;;
|
||
;; Enter the Emacs `customize' command. First select the Editing
|
||
;; group and then select the Emulations group. Finally, select
|
||
;; the Edt group and follow the directions.
|
||
;;
|
||
;; 2. The SUBS command is now supported and bound to GOLD-Enter by
|
||
;; default. (This design was copied from tpu-edt.el.) Note, in
|
||
;; earlier versions of EDT Emulation, GOLD-Enter was assigned to
|
||
;; the Emacs function `query-replace'. The binding of
|
||
;; `query-replace' has been moved to GOLD-/. If you prefer to
|
||
;; restore `query-replace' to GOLD-Enter, then use an EDT user
|
||
;; customization file, edt-user.el, to do this.
|
||
;; See Info node `edt' for more details.
|
||
|
||
;; 3. EDT Emulation now also works in XEmacs, including the
|
||
;; highlighting of selected text.
|
||
|
||
;; 4. If you access a workstation using an X Server, observe that
|
||
;; the initialization file generated by edt-mapper.el will now
|
||
;; contain the name of the X Server vendor. This is a
|
||
;; convenience for those who have access to their Unix account
|
||
;; from more than one type of X Server. Since different X
|
||
;; Servers typically require different EDT emulation
|
||
;; initialization files, edt-mapper.el will now generate these
|
||
;; different initialization files and save them with different
|
||
;; names. Then, the correct initialization file for the
|
||
;; particular X server in use is loaded correctly automatically.
|
||
|
||
;; 5. Also, edt-mapper.el is now capable of binding an ASCII key
|
||
;; sequence, providing the ASCII key sequence prefix is already
|
||
;; known by Emacs to be a prefix. As a result of providing this
|
||
;; support, some terminal/keyboard/window system configurations,
|
||
;; which don't have a complete set of sensible function key
|
||
;; bindings built into Emacs in `function-key-map', can still be
|
||
;; configured for use with EDT Emulation. (Note: In a few rare
|
||
;; circumstances this does not work properly. In particular, it
|
||
;; does not work if a subset of the leading ASCII characters in a
|
||
;; key sequence are recognized by Emacs as having an existing
|
||
;; binding. For example, if the keypad 7 (KP-7) key generates
|
||
;; the sequence \"<ESC>Ow\" and \"<ESC>O\" is already bound to a
|
||
;; function, pressing KP-7 when told to do so by edt-mapper.el
|
||
;; will result in edt-mapper.el incorrectly mapping \"<ESC>O\" to
|
||
;; KP-7 and \"w\" to KP-8. If something like this happens to
|
||
;; you, it is probably a bug in the support for your keyboard
|
||
;; within Emacs OR a bug in the Unix termcap/terminfo support for
|
||
;; your terminal OR a bug in the terminal emulation software you
|
||
;; are using.)
|
||
|
||
;; 6. The edt-quit function (bound to GOLD-q by default) has been
|
||
;; modified to warn the user when file-related buffer
|
||
;; modifications exist. It now cautions the user that those
|
||
;; modifications will be lost if the user quits without saving
|
||
;; those buffers.
|
||
|
||
|
||
;;; History:
|
||
;;
|
||
;; Version 4.0 2000 Added New Features and Fixed a Few Bugs
|
||
;;
|
||
|
||
|
||
;;; Code:
|
||
|
||
;;; 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
|
||
;;;;
|
||
|
||
(defgroup edt nil
|
||
"Emacs emulating EDT."
|
||
:prefix "edt-"
|
||
:group 'emulations)
|
||
|
||
;; To silence the byte-compiler
|
||
(defvar *EDT-keys*)
|
||
(defvar edt-default-global-map)
|
||
(defvar edt-last-copied-word)
|
||
(defvar edt-learn-macro-count)
|
||
(defvar edt-orig-page-delimiter)
|
||
(defvar edt-orig-transient-mark-mode)
|
||
(defvar edt-rect-start-point)
|
||
(defvar edt-user-global-map)
|
||
(defvar rect-start-point)
|
||
(defvar time-string)
|
||
(defvar zmacs-region-stays)
|
||
|
||
;;;
|
||
;;; Version Information
|
||
;;;
|
||
(defconst edt-version "4.0" "EDT Emulation version number.")
|
||
|
||
;;;
|
||
;;; User Configurable Variables
|
||
;;;
|
||
|
||
(defcustom edt-keep-current-page-delimiter nil
|
||
"Emacs MUST be restarted for a change in value to take effect!
|
||
Non-nil leaves Emacs value of `page-delimiter' unchanged within EDT
|
||
Emulation. If set to nil (the default), the `page-delimiter' variable
|
||
is set to \"\\f\" when edt-emulation-on is first invoked. This
|
||
setting replicates EDT's page delimiter behavior. The original value
|
||
is restored when edt-emulation-off is called."
|
||
:type 'boolean
|
||
:group 'edt)
|
||
|
||
(defcustom edt-use-EDT-control-key-bindings nil
|
||
"Emacs MUST be restarted for a change in value to take effect!
|
||
Non-nil causes the control key bindings to be replaced with EDT
|
||
bindings. If set to nil (the default), EDT control key bindings are
|
||
not used and the current Emacs control key bindings are retained for
|
||
use within the EDT emulation."
|
||
:type 'boolean
|
||
:group 'edt)
|
||
|
||
(defcustom edt-word-entities '(?\t)
|
||
"Specifies the list of EDT word entity characters.
|
||
The default list, (?\\t), contains just the TAB character, which
|
||
emulates EDT. Characters are specified in the list using their
|
||
decimal ASCII values. A question mark, followed by the actual
|
||
character, can be used to indicate the numerical value of the
|
||
character, instead of the actual decimal value. So, ?A means the
|
||
numerical value for the letter A, ?/ means the numerical value for /,
|
||
etc. Several unprintable and special characters have special
|
||
representations, which you can also use:
|
||
|
||
?\\b specifies BS, C-h
|
||
?\\t specifies TAB, C-i
|
||
?\\n specifies LFD, C-j
|
||
?\\v specifies VTAB, C-k
|
||
?\\f specifies FF, C-l
|
||
?\\r specifies CR, C-m
|
||
?\\e specifies ESC, C-[
|
||
?\\\\ specifies \\
|
||
|
||
In EDT Emulation movement-by-word commands, each character in the list
|
||
will be treated as if it were a separate word."
|
||
:type '(repeat integer)
|
||
:group 'edt)
|
||
|
||
(defcustom edt-top-scroll-margin 10
|
||
"Scroll margin at the top of the screen.
|
||
Interpreted as a percent of the current window size with a default
|
||
setting of 10%. If set to 0, top scroll margin is disabled."
|
||
:type 'integer
|
||
:group 'edt)
|
||
|
||
(defcustom edt-bottom-scroll-margin 15
|
||
"Scroll margin at the bottom of the screen.
|
||
Interpreted as a percent of the current window size with a default
|
||
setting of 15%. If set to 0, bottom scroll margin is disabled."
|
||
:type 'integer
|
||
:group 'edt)
|
||
|
||
;;;
|
||
;;; Internal Variables
|
||
;;;
|
||
|
||
(defvar edt-last-deleted-lines ""
|
||
"Last text deleted by the EDT emulation DEL L command.")
|
||
|
||
(defvar edt-last-deleted-words ""
|
||
"Last text deleted by the EDT emulation DEL W command.")
|
||
|
||
(defvar edt-last-deleted-chars ""
|
||
"Last text deleted by the EDT emulation DEL C command.")
|
||
|
||
(defvar edt-find-last-text ""
|
||
"Last text found by the EDT emulation FIND command.")
|
||
|
||
(defvar edt-match-beginning-mark (make-marker)
|
||
"Used internally by the EDT emulation SUBS command.")
|
||
|
||
(defvar edt-match-end-mark (make-marker)
|
||
"Used internally by the EDT emulation SUBS command.")
|
||
|
||
(defvar edt-last-replaced-key-definition nil
|
||
"Key definition replaced with `edt-define-key' or `edt-learn' command.")
|
||
|
||
(defvar edt-direction-string ""
|
||
"String indicating current direction of movement.")
|
||
|
||
(defvar edt-select-mode nil
|
||
"Non-nil means select mode is active.")
|
||
|
||
(defvar edt-select-mode-current ""
|
||
"Text displayed in mode line to indicate the state of EDT select mode.
|
||
When select mode is inactive, it is set to an empty string.")
|
||
|
||
(defconst edt-select-mode-string " Select"
|
||
"Used in mode line to indicate select mode is active.")
|
||
|
||
(defconst edt-forward-string " ADVANCE"
|
||
"Direction string in mode line to indicate forward movement.")
|
||
|
||
(defconst edt-backward-string " BACKUP"
|
||
"Direction string in mode line to indicate backward movement.")
|
||
|
||
(defvar edt-default-map-active nil
|
||
"Non-nil indicates that default EDT emulation key bindings are active.
|
||
nil means user-defined custom bindings are active.")
|
||
|
||
(defvar edt-user-map-configured nil
|
||
"Non-nil indicates that user custom EDT key bindings are configured.
|
||
This means that an edt-user.el file was found in the user's `load-path'.")
|
||
|
||
(defvar edt-term nil
|
||
"Specifies the terminal type, if applicable.")
|
||
|
||
;;;
|
||
;;; Emacs version identifiers - currently referenced by
|
||
;;;
|
||
;;; o edt-emulation-on o edt-load-keys
|
||
;;;
|
||
(defconst edt-emacs-variant (if (featurep 'emacs) "gnu" "xemacs")
|
||
"Indicates Emacs variant: GNU Emacs or XEmacs (aka Lucid Emacs).")
|
||
|
||
(defconst edt-window-system (if (featurep 'emacs) window-system (console-type))
|
||
"Indicates window system (in GNU Emacs) or console type (in XEmacs).")
|
||
|
||
(declare-function x-server-vendor "xfns.c" (&optional terminal))
|
||
|
||
(defconst edt-xserver (when (eq edt-window-system 'x)
|
||
;; The Cygwin window manager has a `/' in its
|
||
;; name, which breaks the generated file name of
|
||
;; the custom key map file. Replace `/' with a
|
||
;; `-' to work around that.
|
||
(if (featurep 'xemacs)
|
||
(replace-in-string (x-server-vendor) "[ /]" "-")
|
||
(replace-regexp-in-string "[ /]" "-"
|
||
(x-server-vendor))))
|
||
"Indicates X server vendor name, if applicable.")
|
||
|
||
(defvar edt-keys-file nil
|
||
"User's custom keypad and function keys mappings to emulate LK-201 keyboard.")
|
||
|
||
(defvar edt-last-copied-word nil
|
||
"Last word that the user copied.")
|
||
|
||
|
||
;;;;
|
||
;;;; EDT Emulation Commands
|
||
;;;;
|
||
|
||
;;; Almost all of EDT's keypad mode commands have equivalent Emacs
|
||
;;; function counterparts. But many of these counterparts behave
|
||
;;; somewhat differently in Emacs.
|
||
;;;
|
||
;;; So, 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 should be close
|
||
;;; enough for most EDT die-hards.
|
||
;;;
|
||
|
||
;;;
|
||
;;; 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 init file.
|
||
|
||
(defun edt-page-forward (num)
|
||
"Move forward to just after next page delimiter.
|
||
Argument NUM is 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.
|
||
Argument NUM is 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)
|
||
(if (featurep 'xemacs) (setq zmacs-region-stays t)))))
|
||
|
||
(defun edt-page (num)
|
||
"Move in current direction to next page delimiter.
|
||
Argument NUM is 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's number of lines.
|
||
Argument NUM is 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.
|
||
Argument NUM is 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.
|
||
Argument NUM is the number of sections 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.
|
||
Argument NUM is the number of BOL marks to move."
|
||
(interactive "p")
|
||
(edt-check-prefix num)
|
||
(let ((beg (edt-current-line)))
|
||
(if (bolp)
|
||
(forward-line (* -1 num))
|
||
(progn
|
||
(setq num (1- num))
|
||
(forward-line (* -1 num))))
|
||
(edt-top-check beg num))
|
||
(if (featurep 'xemacs) (setq zmacs-region-stays t)))
|
||
|
||
|
||
;;;
|
||
;;; EOL (End of Line)
|
||
;;;
|
||
|
||
(defun edt-end-of-line-forward (num)
|
||
"Move forward to next end of line mark.
|
||
Argument NUM is the number of EOL marks to move."
|
||
(interactive "p")
|
||
(edt-check-prefix num)
|
||
(let ((beg (edt-current-line)))
|
||
(forward-char)
|
||
(end-of-line num)
|
||
(edt-bottom-check beg num))
|
||
(if (featurep 'xemacs) (setq zmacs-region-stays t)))
|
||
|
||
|
||
(defun edt-end-of-line-backward (num)
|
||
"Move backward to next end of line mark.
|
||
Argument NUM is the number of EOL marks to move."
|
||
(interactive "p")
|
||
(edt-check-prefix num)
|
||
(let ((beg (edt-current-line)))
|
||
(end-of-line (1- num))
|
||
(edt-top-check beg num))
|
||
(if (featurep 'xemacs) (setq zmacs-region-stays t)))
|
||
|
||
|
||
(defun edt-end-of-line (num)
|
||
"Move in current direction to next end of line mark.
|
||
Argument NUM is 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 wherever 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))))
|
||
(if (featurep 'xemacs) (setq zmacs-region-stays t)))
|
||
|
||
(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)))))
|
||
(if (featurep 'xemacs) (setq zmacs-region-stays t)))
|
||
|
||
(defun edt-word-forward (num)
|
||
"Move forward to first character of next word.
|
||
Argument NUM is 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.
|
||
Argument NUM is 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.
|
||
Argument NUM is 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.
|
||
Argument NUM is 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))
|
||
(if (featurep 'xemacs) (setq zmacs-region-stays t)))
|
||
|
||
;;;
|
||
;;; 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.
|
||
Argument NUM is 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.
|
||
Argument NUM is the number of BOL marks to move."
|
||
(interactive "p")
|
||
(edt-check-prefix num)
|
||
(let ((beg (edt-current-line)))
|
||
(forward-line num)
|
||
(edt-bottom-check beg num))
|
||
(if (featurep 'xemacs) (setq zmacs-region-stays t)))
|
||
|
||
(defun edt-line (num)
|
||
"Move in current direction to next beginning of line mark.
|
||
Argument NUM is 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)))
|
||
|
||
;;;
|
||
;;; UP and DOWN Arrows
|
||
;;;
|
||
|
||
(defun edt-next-line (num)
|
||
"Move cursor down one line.
|
||
Argument NUM is the number of lines to move."
|
||
(interactive "p")
|
||
(edt-check-prefix num)
|
||
(let ((beg (edt-current-line)))
|
||
;; We're deliberately using next-line instead of forward-line.
|
||
(with-no-warnings (next-line num))
|
||
(edt-bottom-check beg num))
|
||
(if (featurep 'xemacs) (setq zmacs-region-stays t)))
|
||
|
||
(defun edt-previous-line (num)
|
||
"Move cursor up one line.
|
||
Argument NUM is the number of lines to move."
|
||
(interactive "p")
|
||
(edt-check-prefix num)
|
||
(let ((beg (edt-current-line)))
|
||
;; We're deliberately using previous-line instead of forward-line.
|
||
(with-no-warnings (previous-line num))
|
||
(edt-top-check beg num))
|
||
(if (featurep 'xemacs) (setq zmacs-region-stays t)))
|
||
|
||
|
||
;;;
|
||
;;; TOP
|
||
;;;
|
||
|
||
(defun edt-top ()
|
||
"Move cursor to the beginning of buffer."
|
||
(interactive)
|
||
(goto-char (point-min))
|
||
(if (featurep 'xemacs) (setq zmacs-region-stays t)))
|
||
|
||
;;;
|
||
;;; BOTTOM
|
||
;;;
|
||
|
||
(defun edt-bottom ()
|
||
"Move cursor to the end of buffer."
|
||
(interactive)
|
||
(goto-char (point-max))
|
||
(edt-line-to-bottom-of-window))
|
||
|
||
(defmacro edt-with-position (&rest body)
|
||
"Execute BODY with some position-related variables bound."
|
||
`(let* ((left nil)
|
||
(beg (edt-current-line))
|
||
(height (window-height))
|
||
(top-percent
|
||
(if (zerop edt-top-scroll-margin) 10 edt-top-scroll-margin))
|
||
(bottom-percent
|
||
(if (zerop edt-bottom-scroll-margin) 15 edt-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))
|
||
|
||
;;;
|
||
;;; FIND
|
||
;;;
|
||
|
||
(defun edt-find-forward (&optional find)
|
||
"Find first occurrence of a string in forward direction and save it.
|
||
Optional argument FIND is t is this function is called from `edt-find'."
|
||
(interactive)
|
||
(or find
|
||
(setq edt-find-last-text (read-string "Search forward: ")))
|
||
(edt-with-position
|
||
(when (search-forward edt-find-last-text) ; FIXME noerror?
|
||
(search-backward edt-find-last-text)
|
||
(edt-set-match)
|
||
(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)))))
|
||
(if (featurep 'xemacs) (setq zmacs-region-stays t)))
|
||
|
||
(defun edt-find-backward (&optional find)
|
||
"Find first occurrence of a string in the backward direction and save it.
|
||
Optional argument FIND is t if this function is called from `edt-find'."
|
||
(interactive)
|
||
(or find
|
||
(setq edt-find-last-text (read-string "Search backward: ")))
|
||
(edt-with-position
|
||
(if (search-backward edt-find-last-text)
|
||
(edt-set-match))
|
||
(and (< (point) top) (recenter (min beg top-margin))))
|
||
(if (featurep 'xemacs) (setq zmacs-region-stays t)))
|
||
|
||
(defun edt-find ()
|
||
"Find first occurrence of string in current direction and save it."
|
||
(interactive)
|
||
(set 'edt-find-last-text (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 occurrence of a string in forward direction."
|
||
(interactive)
|
||
(edt-with-position
|
||
(forward-char 1)
|
||
(if (search-forward edt-find-last-text nil t)
|
||
(progn
|
||
(search-backward edt-find-last-text)
|
||
(edt-set-match)
|
||
(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-char 1)
|
||
(error "Search failed: \"%s\"" edt-find-last-text)))
|
||
(if (featurep 'xemacs) (setq zmacs-region-stays t)))
|
||
|
||
(defun edt-find-next-backward ()
|
||
"Find next occurrence of a string in backward direction."
|
||
(interactive)
|
||
(edt-with-position
|
||
(if (not (search-backward edt-find-last-text nil t))
|
||
(error "Search failed: \"%s\"" edt-find-last-text)
|
||
(edt-set-match)
|
||
(and (< (point) top) (recenter (min beg top-margin)))))
|
||
(if (featurep 'xemacs) (setq zmacs-region-stays t)))
|
||
|
||
(defun edt-find-next ()
|
||
"Find next occurrence 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.
|
||
Argument NUM is 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"))
|
||
(setq edt-last-deleted-lines
|
||
(buffer-substring beg (point)))
|
||
(delete-region beg (point))))
|
||
|
||
;;;
|
||
;;; DEL EOL
|
||
;;;
|
||
|
||
(defun edt-delete-to-end-of-line (num)
|
||
"Delete from cursor up to but excluding the end of line mark.
|
||
Argument NUM is 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)))
|
||
(delete-region beg (point))))
|
||
|
||
;;;
|
||
;;; 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
|
||
(set (make-local-variable 'edt-select-mode) 'edt-select-mode-current)
|
||
(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)
|
||
(if (featurep 'emacs)
|
||
(deactivate-mark)
|
||
(zmacs-deactivate-region)))
|
||
|
||
;;;
|
||
;;; 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 line.
|
||
Argument NUM is the number of lines to delete."
|
||
(interactive "*p")
|
||
(edt-check-prefix num)
|
||
(let ((beg (point)))
|
||
(edt-beginning-of-line num)
|
||
(setq edt-last-deleted-lines
|
||
(buffer-substring (point) beg))
|
||
(delete-region beg (point))))
|
||
|
||
;;;
|
||
;;; DEL W
|
||
;;;
|
||
|
||
(defun edt-delete-word (num)
|
||
"Delete from cursor up to but excluding first character of next word.
|
||
Argument NUM is the number of words to delete."
|
||
(interactive "*p")
|
||
(edt-check-prefix num)
|
||
(let ((beg (point)))
|
||
(edt-word-forward num)
|
||
(setq edt-last-deleted-words (buffer-substring beg (point)))
|
||
(delete-region beg (point))))
|
||
|
||
;;;
|
||
;;; DELETE TO BEGINNING OF WORD
|
||
;;;
|
||
|
||
(defun edt-delete-to-beginning-of-word (num)
|
||
"Delete from cursor to beginning of word.
|
||
Argument NUM is 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.
|
||
Argument NUM is 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))))
|
||
(delete-region (point) (min (point-max) (+ (point) num))))
|
||
|
||
;;;
|
||
;;; DELETE CHAR
|
||
;;;
|
||
|
||
(defun edt-delete-previous-character (num)
|
||
"Delete character in front of cursor.
|
||
Argument NUM is 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)))
|
||
(delete-region (max (point-min) (- (point) num)) (point)))
|
||
|
||
;;;
|
||
;;; 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 ()
|
||
"Undelete previous deleted word(s)."
|
||
(interactive "*")
|
||
(point-to-register 1)
|
||
(insert edt-last-deleted-words)
|
||
(register-to-point 1))
|
||
|
||
;;;
|
||
;;; UND C
|
||
;;;
|
||
|
||
(defun edt-undelete-character ()
|
||
"Undelete previous deleted character(s)."
|
||
(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 "*")
|
||
(if (edt-check-match)
|
||
(replace-match (car kill-ring-yank-pointer))
|
||
(progn
|
||
(exchange-point-and-mark)
|
||
(let ((beg (point)))
|
||
(exchange-point-and-mark)
|
||
(delete-region beg (point)))
|
||
(yank))))
|
||
|
||
;;;
|
||
;;; SUBS
|
||
;;;
|
||
|
||
(defun edt-substitute (num)
|
||
"Replace the selected region with the contents of the CUT buffer and.
|
||
Repeat the most recent FIND command. (The Emacs kill ring is used as
|
||
the CUT buffer.)
|
||
Argument NUM is the repeat count. A positive value indicates the of times
|
||
to repeat the substitution. A negative argument means replace all occurrences
|
||
of the search text."
|
||
(interactive "p")
|
||
(cond ((or edt-select-mode (edt-check-match))
|
||
(while (and (not (= num 0)) (or edt-select-mode (edt-check-match)))
|
||
(edt-replace)
|
||
(edt-find-next)
|
||
(setq num (1- num))))
|
||
(t
|
||
(error "No selection active"))))
|
||
|
||
(defun edt-set-match nil
|
||
"Set markers at match beginning and end."
|
||
;; Add one to beginning mark so it stays with the first character of
|
||
;; the string even if characters are added just before the string.
|
||
(setq edt-match-beginning-mark (copy-marker (1+ (match-beginning 0))))
|
||
(setq edt-match-end-mark (copy-marker (match-end 0))))
|
||
|
||
(defun edt-unset-match nil
|
||
"Unset match beginning and end markers."
|
||
(set-marker edt-match-beginning-mark nil)
|
||
(set-marker edt-match-end-mark nil))
|
||
|
||
(defun edt-match-beginning nil
|
||
"Return the location of the last match beginning."
|
||
(1- (marker-position edt-match-beginning-mark)))
|
||
|
||
(defun edt-match-end nil
|
||
"Return the location of the last match end."
|
||
(marker-position edt-match-end-mark))
|
||
|
||
(defun edt-check-match nil
|
||
"Return t if point is between edt-match markers.
|
||
Otherwise sets the edt-match markers to nil and returns nil."
|
||
;; make sure 1- marker is in this buffer
|
||
;; 2- point is at or after beginning marker
|
||
;; 3- point is before ending marker, or in the case of
|
||
;; zero length regions (like bol, or eol) that the
|
||
;; beginning, end, and point are equal.
|
||
(cond ((and
|
||
(equal (marker-buffer edt-match-beginning-mark) (current-buffer))
|
||
(>= (point) (1- (marker-position edt-match-beginning-mark)))
|
||
(or
|
||
(< (point) (marker-position edt-match-end-mark))
|
||
(and (= (1- (marker-position edt-match-beginning-mark))
|
||
(marker-position edt-match-end-mark))
|
||
(= (marker-position edt-match-end-mark) (point))))) t)
|
||
(t
|
||
(edt-unset-match) nil)))
|
||
|
||
(defun edt-show-match-markers nil
|
||
"Show the values of the match markers."
|
||
(interactive)
|
||
(if (markerp edt-match-beginning-mark)
|
||
(let ((beg (marker-position edt-match-beginning-mark)))
|
||
(message "(%s, %s) in %s -- current %s in %s"
|
||
(if beg (1- beg) nil)
|
||
(marker-position edt-match-end-mark)
|
||
(marker-buffer edt-match-end-mark)
|
||
(point) (current-buffer)))))
|
||
|
||
|
||
;;;
|
||
;;; ADVANCE
|
||
;;;
|
||
|
||
(defun edt-advance ()
|
||
"Set movement direction forward.
|
||
Also, execute command specified if in Minibuffer."
|
||
(interactive)
|
||
(setq edt-direction-string edt-forward-string)
|
||
(force-mode-line-update)
|
||
(if (string-equal " *Minibuf"
|
||
(substring (buffer-name) 0 (min (length (buffer-name)) 9)))
|
||
(exit-minibuffer))
|
||
(if (featurep 'xemacs) (setq zmacs-region-stays t)))
|
||
|
||
|
||
;;;
|
||
;;; BACKUP
|
||
;;;
|
||
|
||
(defun edt-backup ()
|
||
"Set movement direction backward.
|
||
Also, execute command specified if in Minibuffer."
|
||
(interactive)
|
||
(setq edt-direction-string edt-backward-string)
|
||
(force-mode-line-update)
|
||
(if (string-equal " *Minibuf"
|
||
(substring (buffer-name) 0 (min (length (buffer-name)) 9)))
|
||
(exit-minibuffer))
|
||
(if (featurep 'xemacs) (setq zmacs-region-stays t)))
|
||
|
||
|
||
;;;
|
||
;;; 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.
|
||
Argument NUM is the numbers of consecutive characters to change."
|
||
(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))))))
|
||
|
||
;;;
|
||
;;; 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)
|
||
(if (featurep 'xemacs) (setq zmacs-region-stays t))
|
||
(let (edt-function
|
||
edt-key-definition)
|
||
(setq edt-key-definition
|
||
(read-key-sequence "Press the key to be defined: "))
|
||
(if (if (featurep 'emacs)
|
||
(string-equal "\C-m" edt-key-definition)
|
||
(string-equal "\C-m" (events-to-keys edt-key-definition)))
|
||
(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))
|
||
(define-key (current-global-map)
|
||
edt-key-definition edt-function)))))))
|
||
|
||
;;;
|
||
;;; FORM FEED INSERT
|
||
;;;
|
||
|
||
(defun edt-form-feed-insert (num)
|
||
"Insert form feed character at cursor position.
|
||
Argument NUM is the number of form feeds to insert."
|
||
(interactive "*p")
|
||
(edt-check-prefix num)
|
||
(while (> num 0)
|
||
(insert ?\f)
|
||
(setq num (1- num))))
|
||
|
||
;;;
|
||
;;; TAB INSERT
|
||
;;;
|
||
|
||
(defun edt-tab-insert (num)
|
||
"Insert tab character at cursor position.
|
||
Argument NUM is 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.
|
||
Argument NUM is the prefix value tested."
|
||
(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")))
|
||
|
||
;;;
|
||
;;; Scroll Margins
|
||
;;;
|
||
|
||
(defun edt-top-check (beg lines)
|
||
"Enforce scroll margin at the top of screen.
|
||
Argument BEG is the starting line number before cursor was moved.
|
||
Argument LINES is the number of lines the cursor moved toward the top."
|
||
(let ((margin (/ (* (window-height) edt-top-scroll-margin) 100)))
|
||
(cond ((< beg margin) (recenter beg))
|
||
((< (- beg lines) margin) (recenter margin)))))
|
||
|
||
(defun edt-bottom-check (beg lines)
|
||
"Enforce scroll margin at the bottom of screen.
|
||
Argument BEG is the starting line number before cursor was moved.
|
||
Argument LINES is the number of lines the cursor moved toward the bottom."
|
||
(let* ((height (window-height))
|
||
(margin (+ 1 (/ (* height edt-bottom-scroll-margin) 100)))
|
||
;; subtract 1 from height because it includes mode line
|
||
(difference (- height margin 1)))
|
||
(cond ((> beg difference) (recenter beg))
|
||
((and (featurep 'xemacs) (> (+ beg lines 1) difference))
|
||
(recenter (- margin)))
|
||
((> (+ beg lines) difference) (recenter (- margin))))))
|
||
|
||
(defun edt-current-line nil
|
||
"Return the vertical position of point in the selected window.
|
||
Top line is 0. Counts each text line only once, even if it wraps."
|
||
(+ (count-lines (window-start) (point)) (if (= (current-column) 0) 1 0) -1))
|
||
|
||
;;;###autoload
|
||
(defun edt-set-scroll-margins (top bottom)
|
||
"Set scroll margins.
|
||
Argument TOP is the top margin in number of lines or percent of window.
|
||
Argument BOTTOM is the bottom margin in number of lines or percent of window."
|
||
(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 "")
|
||
(if (string= "%" (substring top -1))
|
||
(setq edt-top-scroll-margin (string-to-number top))
|
||
(setq edt-top-scroll-margin
|
||
(/ (1- (+ (* (string-to-number top) 100) (window-height)))
|
||
(window-height)))))
|
||
;; set bottom scroll margin
|
||
(or (string= bottom "")
|
||
(if (string= "%" (substring bottom -1))
|
||
(setq edt-bottom-scroll-margin (string-to-number bottom))
|
||
(setq edt-bottom-scroll-margin
|
||
(/ (1- (+ (* (string-to-number bottom) 100) (window-height)))
|
||
(window-height)))))
|
||
;; report scroll margin settings if running interactively
|
||
(and (called-interactively-p 'interactive)
|
||
(message "Scroll margins set. Top = %s%%, Bottom = %s%%"
|
||
edt-top-scroll-margin edt-bottom-scroll-margin)))
|
||
|
||
|
||
;;;;
|
||
;;;; 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.
|
||
|
||
;;;
|
||
;;; CHANGE DIRECTION
|
||
;;;
|
||
|
||
(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.
|
||
Argument NUM is the positive number of sentences to move."
|
||
(interactive "p")
|
||
(edt-check-prefix num)
|
||
(edt-with-position
|
||
(if (eobp)
|
||
(error "End of buffer")
|
||
(forward-sentence num)
|
||
(forward-word 1)
|
||
(backward-sentence))
|
||
(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))))
|
||
(if (featurep 'xemacs) (setq zmacs-region-stays t)))
|
||
|
||
(defun edt-sentence-backward (num)
|
||
"Move backward to next sentence beginning.
|
||
Argument NUM is the positive number of sentences to move."
|
||
(interactive "p")
|
||
(edt-check-prefix num)
|
||
(edt-with-position
|
||
(if (eobp)
|
||
(error "End of buffer")
|
||
(backward-sentence num))
|
||
(and (< (point) top) (recenter (min beg top-margin))))
|
||
(if (featurep 'xemacs) (setq zmacs-region-stays t)))
|
||
|
||
(defun edt-sentence (num)
|
||
"Move in current direction to next sentence.
|
||
Argument NUM is the positive number of sentences to move."
|
||
(interactive "p")
|
||
(if (equal edt-direction-string edt-forward-string)
|
||
(edt-sentence-forward num)
|
||
(edt-sentence-backward num)))
|
||
|
||
;;;
|
||
;;; PARAGRAPH
|
||
;;;
|
||
|
||
(defun edt-paragraph-forward (num)
|
||
"Move forward to beginning of paragraph.
|
||
Argument NUM is the positive number of paragraphs to move."
|
||
(interactive "p")
|
||
(edt-check-prefix num)
|
||
(edt-with-position
|
||
(while (> num 0)
|
||
(forward-paragraph (+ num 1))
|
||
(start-of-paragraph-text)
|
||
(if (eolp)
|
||
(forward-line 1))
|
||
(setq num (1- 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))))
|
||
(if (featurep 'xemacs) (setq zmacs-region-stays t)))
|
||
|
||
(defun edt-paragraph-backward (num)
|
||
"Move backward to beginning of paragraph.
|
||
Argument NUM is the positive number of paragraphs to move."
|
||
(interactive "p")
|
||
(edt-check-prefix num)
|
||
(edt-with-position
|
||
(while (> num 0)
|
||
(start-of-paragraph-text)
|
||
(setq num (1- num)))
|
||
(and (< (point) top) (recenter (min beg top-margin))))
|
||
(if (featurep 'xemacs) (setq zmacs-region-stays t)))
|
||
|
||
(defun edt-paragraph (num)
|
||
"Move in current direction to next paragraph.
|
||
Argument NUM is the positive number of paragraphs 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.
|
||
Definition is stored in `edt-last-replaced-key-definition'."
|
||
(interactive)
|
||
(if (featurep 'xemacs) (setq zmacs-region-stays t))
|
||
(if edt-last-replaced-key-definition
|
||
(progn
|
||
(let (edt-key-definition)
|
||
(set 'edt-key-definition
|
||
(read-key-sequence "Press the key to be restored: "))
|
||
(if (if (featurep 'emacs)
|
||
(string-equal "\C-m" edt-key-definition)
|
||
(string-equal "\C-m" (events-to-keys edt-key-definition)))
|
||
(message "Key not restored")
|
||
(progn
|
||
(define-key (current-global-map)
|
||
edt-key-definition edt-last-replaced-key-definition)
|
||
(if (featurep 'emacs)
|
||
(message "Key definition for %s has been restored."
|
||
edt-key-definition)
|
||
(message "Key definition for %s has been restored."
|
||
(events-to-keys edt-key-definition)))))))
|
||
(error "No replaced key definition to restore!")))
|
||
|
||
;;;
|
||
;;; WINDOW TOP
|
||
;;;
|
||
|
||
(defun edt-window-top ()
|
||
"Move the cursor to the top of the window."
|
||
(interactive)
|
||
(let ((start-column (current-column)))
|
||
(move-to-window-line 0)
|
||
(move-to-column start-column))
|
||
(if (featurep 'xemacs) (setq zmacs-region-stays t)))
|
||
|
||
;;;
|
||
;;; WINDOW BOTTOM
|
||
;;;
|
||
|
||
(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))
|
||
(if (featurep 'xemacs) (setq zmacs-region-stays t)))
|
||
|
||
;;;
|
||
;;; SCROLL WINDOW LINE
|
||
;;;
|
||
|
||
(defun edt-scroll-window-forward-line ()
|
||
"Move window forward one line leaving cursor at position in window."
|
||
(interactive)
|
||
(scroll-up 1)
|
||
(if (featurep 'xemacs) (setq zmacs-region-stays t)))
|
||
|
||
(defun edt-scroll-window-backward-line ()
|
||
"Move window backward one line leaving cursor at position in window."
|
||
(interactive)
|
||
(scroll-down 1)
|
||
(if (featurep 'xemacs) (setq zmacs-region-stays t)))
|
||
|
||
(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)))
|
||
|
||
;;;
|
||
;;; 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.
|
||
Argument NUM is the positive 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.
|
||
Argument NUM is the positive 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.
|
||
Argument NUM is the positive number of 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 bottom of the window."
|
||
(interactive)
|
||
(recenter -1)
|
||
(if (featurep 'xemacs) (setq zmacs-region-stays t)))
|
||
|
||
;;;
|
||
;;; 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)
|
||
(if (featurep 'xemacs) (setq zmacs-region-stays t)))
|
||
|
||
;;;
|
||
;;; LINE TO MIDDLE OF WINDOW
|
||
;;;
|
||
|
||
(defun edt-line-to-middle-of-window ()
|
||
"Move window so line with cursor is in the middle of the window."
|
||
(interactive)
|
||
(recenter '(4))
|
||
(if (featurep 'xemacs) (setq zmacs-region-stays t)))
|
||
|
||
;;;
|
||
;;; GOTO PERCENTAGE
|
||
;;;
|
||
|
||
(defun edt-goto-percentage (num)
|
||
"Move to specified percentage in buffer from top of buffer.
|
||
Argument NUM is the percentage into the buffer to move."
|
||
(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)))
|
||
(if (featurep 'xemacs) (setq zmacs-region-stays t)))
|
||
|
||
;;;
|
||
;;; 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))))
|
||
|
||
|
||
(declare-function c-mark-function "cc-cmds" ())
|
||
;;;
|
||
;;; 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 and Lisp, and for Fortran,
|
||
`c-mark-function' for C,
|
||
and `mark-paragraph' for other modes."
|
||
(interactive)
|
||
(if edt-select-mode
|
||
(progn
|
||
(edt-reset))
|
||
(progn
|
||
(cond ((or (eq major-mode 'emacs-lisp-mode)
|
||
(eq major-mode 'fortran-mode)
|
||
(eq major-mode 'lisp-mode))
|
||
(mark-defun)
|
||
(message "Lisp defun selected"))
|
||
((eq major-mode 'c-mode)
|
||
(c-mark-function)
|
||
(message "C function 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 the line of text containing the cursor.
|
||
Argument NUM is the number of 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)
|
||
(if (featurep 'xemacs) (setq zmacs-region-stays t))
|
||
(message "%s" (current-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)
|
||
(set 'edt-key-definition
|
||
(read-key-sequence "Enter key for binding: "))
|
||
(if (if (featurep 'emacs)
|
||
(string-equal "\C-m" edt-key-definition)
|
||
(string-equal "\C-m" (events-to-keys edt-key-definition)))
|
||
(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))
|
||
(define-key (current-global-map) edt-key-definition
|
||
(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 buffer modifications.
|
||
Warn user that modifications will be lost."
|
||
(interactive)
|
||
(let ((list (buffer-list))
|
||
(working t))
|
||
(while (and list working)
|
||
(let ((buffer (car list)))
|
||
(if (and (buffer-file-name buffer) (buffer-modified-p buffer))
|
||
(if (edt-y-or-n-p
|
||
"Modifications will not be saved, continue quitting? ")
|
||
(kill-emacs)
|
||
(setq working nil)))
|
||
(setq list (cdr list))))
|
||
(if working (kill-emacs))))
|
||
|
||
;;;
|
||
;;; SPLIT WINDOW
|
||
;;;
|
||
|
||
(defun edt-split-window ()
|
||
"Split current window and place cursor in the new window."
|
||
(interactive)
|
||
(split-window)
|
||
(other-window 1)
|
||
(if (featurep 'xemacs) (setq zmacs-region-stays t)))
|
||
|
||
;;;
|
||
;;; 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.
|
||
Replace cut 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.
|
||
Move 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 replaced 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)))))
|
||
|
||
;;;
|
||
;;; Functions used in loading LK-201 key mapping file.
|
||
;;;
|
||
(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.
|
||
Like Emacs `y-or-n-p', also accepts space as y and DEL as n.
|
||
Argument PROMPT is the prompt string.
|
||
Optional argument NOT-YES changes the default to negative."
|
||
(message "%s[%s]" prompt (if not-yes "n" "y"))
|
||
(let ((doit t))
|
||
(while doit
|
||
(setq doit nil)
|
||
(let ((ans (read-char)))
|
||
(cond ((or (= ans ?y) (= ans ?Y) (= ans ?\ ))
|
||
(setq 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 "Please answer y or n. %s[%s]"
|
||
prompt (if not-yes "n" "y")))))))
|
||
edt-last-answer)
|
||
|
||
;;;
|
||
;;; INITIALIZATION COMMANDS.
|
||
;;;
|
||
|
||
;;;
|
||
;;; Function used to load LK-201 key mapping file generated by edt-mapper.el.
|
||
;;;
|
||
(defun edt-load-keys (file)
|
||
"Load the LK-201 key mapping FILE generated by edt-mapper.el.
|
||
If FILE is nil, which is the normal case, try to load a default file.
|
||
The default file names are based upon the window system, terminal
|
||
type, and version of Emacs in use: GNU Emacs or XEmacs (aka Lucid
|
||
Emacs). If a default file does not exist, ask user if one should be
|
||
created."
|
||
(interactive "fKey definition file: ")
|
||
(cond (file
|
||
(setq file (expand-file-name file)))
|
||
(edt-keys-file
|
||
(setq file (expand-file-name edt-keys-file)))
|
||
(t
|
||
(setq file
|
||
(expand-file-name
|
||
(concat
|
||
"~/.edt-" edt-emacs-variant
|
||
(if edt-term (concat "-" edt-term))
|
||
(if edt-xserver (concat "-" edt-xserver))
|
||
(if edt-window-system
|
||
(concat "-" (upcase (symbol-name edt-window-system))))
|
||
"-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 without loading an
|
||
EDT key mapping file. To create an EDT key mapping file, run the
|
||
edt-mapper program. It is safest to run it from an Emacs loaded
|
||
without any of your own customizations found in your init file, etc.
|
||
The reason for this is that some user customizations confuse edt-mapper.
|
||
You can do this by quitting Emacs and then invoking Emacs again as
|
||
follows:
|
||
|
||
emacs -q -l edt-mapper
|
||
|
||
[NOTE: If you do nothing out of the ordinary in your init file, and
|
||
the search for edt-mapper is successful, you can try running it now.]
|
||
|
||
The library edt-mapper includes these same directions on how to
|
||
use it! Perhaps it's lying around here someplace. \n ")
|
||
(let ((path (locate-library
|
||
"edt-mapper"
|
||
nil (append (list default-directory) load-path))))
|
||
(if path
|
||
(progn
|
||
(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")))
|
||
(insert (substitute-command-keys
|
||
"Nope, I can't seem to find it. :-(\n\n"))
|
||
(sit-for 20)
|
||
(error "EDT Emulation not configured"))))))
|
||
|
||
;;;
|
||
;;; Turning the EDT Emulation on and off.
|
||
;;;
|
||
|
||
;;;###autoload
|
||
(defun edt-emulation-on ()
|
||
"Turn on EDT Emulation."
|
||
(interactive)
|
||
;; If using pc window system (MS-DOS), set terminal type to pc.
|
||
;; If not a window system (GNU) or a tty window system (XEmacs),
|
||
;; get terminal type.
|
||
(if (eq edt-window-system 'pc)
|
||
(setq edt-term "pc")
|
||
(if (or (not edt-window-system) (eq edt-window-system 'tty))
|
||
(setq edt-term (getenv "TERM"))))
|
||
;; Look for a terminal configuration file for this terminal type.
|
||
;; Otherwise, load the user's custom configuration file.
|
||
(if (or (not edt-window-system) (memq edt-window-system '(pc tty)))
|
||
(progn
|
||
;; Load terminal-specific configuration file, if it exists for this
|
||
;; terminal type. Note: All DEC VT series terminals are supported
|
||
;; by the same terminal configuration file: edt-vt100.el.
|
||
(if (string-equal "vt" (substring edt-term 0 (min (length edt-term) 2)))
|
||
(setq edt-term "vt100"))
|
||
(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)))
|
||
;; If no terminal-specific configuration file exists, load user's
|
||
;; custom EDT terminal configuration file.
|
||
;; If this is a pc running MS-DOS, then custom configuration files
|
||
;; are not supported. So, if the file is missing, issue an error
|
||
;; message.
|
||
(if (null term)
|
||
(if (equal edt-term "pc")
|
||
(error "Unable to find EDT terminal specific file edt-pc.el")
|
||
(edt-load-keys nil))
|
||
(setq edt-term term))))
|
||
(edt-load-keys nil))
|
||
;; Make highlighting of selected text work properly for EDT commands.
|
||
(if (featurep 'emacs)
|
||
(progn
|
||
(setq edt-orig-transient-mark-mode
|
||
(default-value '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)))))
|
||
(progn
|
||
(add-hook 'zmacs-activate-region-hook
|
||
(function
|
||
(lambda ()
|
||
(edt-select-mode t))))
|
||
(add-hook 'zmacs-deactivate-region-hook
|
||
(function
|
||
(lambda ()
|
||
(edt-select-mode nil))))))
|
||
;; Load user's EDT custom key bindings file, if it exists.
|
||
;; Otherwise, use the default bindings.
|
||
(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-current nil)
|
||
(edt-reset)
|
||
(force-mode-line-update t)
|
||
(if (featurep 'emacs)
|
||
(setq-default transient-mark-mode edt-orig-transient-mark-mode))
|
||
(message "Original key bindings restored; EDT Emulation disabled"))
|
||
|
||
(defun edt-default-menu-bar-update-buffers ()
|
||
;; Update edt-default-global-map with latest copy of
|
||
;; `global-buffers-menu-map' each time `menu-bar-update-buffers'
|
||
;; updates global-map.
|
||
(define-key edt-default-global-map [menu-bar buffer]
|
||
(cons "Buffers" global-buffers-menu-map)))
|
||
|
||
(defun edt-user-menu-bar-update-buffers ()
|
||
;; We need to update edt-user-global-map with latest copy of
|
||
;; `global-buffers-menu-map' each time `menu-bar-update-buffers'
|
||
;; updates global-map.
|
||
(define-key edt-user-global-map [menu-bar buffer]
|
||
(cons "Buffers" global-buffers-menu-map)))
|
||
|
||
(defun edt-default-emulation-setup (&optional user-setup)
|
||
"Setup emulation of DEC's EDT editor.
|
||
Optional argument USER-SETUP non-nil means called from function
|
||
`edt-user-emulation-setup'."
|
||
;; 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)))
|
||
(if (featurep 'emacs)
|
||
(define-key edt-default-global-map "\e" 'edt-default-ESC-prefix)
|
||
(define-key edt-default-global-map [escape] '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)))
|
||
;; Keep the menu bar Buffers menu up-to-date in edt-default-global-map.
|
||
(add-hook 'menu-bar-update-hook 'edt-default-menu-bar-update-buffers))
|
||
|
||
(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))
|
||
(if (featurep 'emacs)
|
||
(define-key edt-user-global-map "\e" 'edt-user-ESC-prefix)
|
||
(define-key edt-user-global-map [escape] '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))
|
||
;; This is a function that the user can define for custom bindings.
|
||
;; See Info node `edt' for more details, and sample edt-user.el file.
|
||
(if (fboundp 'edt-setup-user-bindings)
|
||
(edt-setup-user-bindings))
|
||
(edt-select-user-global-map)
|
||
;; Keep the menu bar Buffers menu up-to-date in edt-user-global-map.
|
||
(add-hook 'menu-bar-update-hook 'edt-user-menu-bar-update-buffers))
|
||
|
||
(defun edt-select-default-global-map()
|
||
"Select default EDT emulation key bindings."
|
||
(interactive)
|
||
(if (featurep 'emacs)
|
||
(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-current '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
|
||
(if (featurep 'emacs)
|
||
(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-current '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)))
|
||
|
||
;;
|
||
;; Functions used to set up DEFAULT bindings to EDT emulation functions.
|
||
;;
|
||
|
||
(defun edt-bind-function-key-default (function-key binding gold-binding)
|
||
"Binds LK-201 function keys to default bindings in the EDT Emulator.
|
||
Argument FUNCTION-KEY is the name of the function key or keypad function key.
|
||
Argument BINDING is the Emacs function to be bound to <KEY>.
|
||
Argument GOLD-BINDING is the Emacs function to be bound to GOLD <KEY>."
|
||
(let ((key (cdr (assoc function-key *EDT-keys*))))
|
||
(if (and key (not (equal key "")))
|
||
(progn
|
||
(define-key edt-default-global-map key binding)
|
||
(define-key 'edt-default-gold-map key gold-binding)))))
|
||
|
||
(defun edt-bind-key-default (key binding)
|
||
"Bind key sequences to default bindings in the EDT Emulator.
|
||
Argument KEY is the name of a standard key or a function key.
|
||
Argument BINDING is the Emacs function to be bound to <KEY>."
|
||
(define-key edt-default-global-map key binding))
|
||
|
||
(defun edt-bind-gold-key-default (key gold-binding)
|
||
"Binds <GOLD> key sequences to default bindings in the EDT Emulator.
|
||
Argument KEY is the name of a standard key or a function key.
|
||
Argument GOLD-BINDING is the Emacs function to be bound to GOLD <KEY>."
|
||
(define-key 'edt-default-gold-map key gold-binding))
|
||
|
||
;;
|
||
;; Functions used to set up USER CUSTOM bindings to EDT emulation functions.
|
||
;;
|
||
(defun edt-bind-function-key (function-key binding gold-binding)
|
||
"Binds LK-201 function keys to custom bindings in the EDT Emulator.
|
||
Argument FUNCTION-KEY is the name of the function key or keypad function key.
|
||
Argument BINDING is the Emacs function to be bound to <KEY>.
|
||
Argument GOLD-BINDING is the Emacs function to be bound to GOLD <KEY>."
|
||
(let ((key (cdr (assoc function-key *EDT-keys*))))
|
||
(if (and key (not (equal key "")))
|
||
(progn
|
||
(define-key edt-user-global-map key binding)
|
||
(define-key 'edt-user-gold-map key gold-binding)))))
|
||
|
||
(defun edt-bind-key (key binding)
|
||
"Bind standard key sequences to custom bindings in the EDT Emulator.
|
||
Argument KEY is the name of a key. It can be a standard key or a function key.
|
||
Argument BINDING is the Emacs function to be bound to <KEY>."
|
||
(define-key edt-user-global-map key binding))
|
||
|
||
;; For backward compatibility to existing edt-user.el files.
|
||
(fset 'edt-bind-standard-key (symbol-function 'edt-bind-key))
|
||
|
||
(defun edt-bind-gold-key (key gold-binding)
|
||
"Binds <GOLD> standard key sequences to custom bindings in the EDT Emulator.
|
||
Argument KEY is the name of a standard key or a function key.
|
||
Argument GOLD-BINDING is the Emacs function to be bound to GOLD <KEY>."
|
||
(define-key 'edt-user-gold-map key gold-binding))
|
||
|
||
(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-default "PF1"
|
||
'edt-default-gold-map 'edt-mark-section-wisely)
|
||
(edt-bind-function-key-default "PF2"
|
||
'edt-electric-keypad-help 'describe-function)
|
||
(edt-bind-function-key-default "PF3" 'edt-find-next 'edt-find)
|
||
(edt-bind-function-key-default "PF4" 'edt-delete-line 'edt-undelete-line)
|
||
|
||
;; VT100/VT200/VT300 Arrow Keys
|
||
(edt-bind-function-key-default "UP" 'edt-previous-line 'edt-window-top)
|
||
(edt-bind-function-key-default "DOWN" 'edt-next-line 'edt-window-bottom)
|
||
(edt-bind-function-key-default "LEFT" 'backward-char 'edt-sentence-backward)
|
||
(edt-bind-function-key-default "RIGHT" 'forward-char 'edt-sentence-forward)
|
||
|
||
;; VT100/VT200/VT300 Keypad Keys
|
||
(edt-bind-function-key-default "KP0" 'edt-line 'open-line)
|
||
(edt-bind-function-key-default "KP1" 'edt-word 'edt-change-case)
|
||
(edt-bind-function-key-default "KP2"
|
||
'edt-end-of-line 'edt-delete-to-end-of-line)
|
||
(edt-bind-function-key-default "KP3" 'edt-character 'quoted-insert)
|
||
(edt-bind-function-key-default "KP4" 'edt-advance 'edt-bottom)
|
||
(edt-bind-function-key-default "KP5" 'edt-backup 'edt-top)
|
||
(edt-bind-function-key-default "KP6" 'edt-cut 'yank)
|
||
(edt-bind-function-key-default "KP7" 'edt-page 'execute-extended-command)
|
||
(edt-bind-function-key-default "KP8" 'edt-sect 'edt-fill-region)
|
||
(edt-bind-function-key-default "KP9" 'edt-append 'edt-replace)
|
||
(edt-bind-function-key-default "KP-" 'edt-delete-word 'edt-undelete-word)
|
||
(edt-bind-function-key-default "KP,"
|
||
'edt-delete-character 'edt-undelete-character)
|
||
(edt-bind-function-key-default "KPP" 'edt-select 'edt-reset)
|
||
(edt-bind-function-key-default "KPE" 'other-window 'edt-substitute)
|
||
|
||
;; 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-default "FIND" 'edt-find-next 'edt-find)
|
||
(edt-bind-function-key-default "INSERT" 'yank 'edt-key-not-assigned)
|
||
(edt-bind-function-key-default "REMOVE" 'edt-cut 'edt-copy)
|
||
(edt-bind-function-key-default "SELECT"
|
||
'edt-toggle-select 'edt-key-not-assigned)
|
||
(edt-bind-function-key-default "NEXT"
|
||
'edt-sect-forward 'edt-key-not-assigned)
|
||
(edt-bind-function-key-default "PREVIOUS"
|
||
'edt-sect-backward 'edt-key-not-assigned)
|
||
(edt-bind-function-key-default "F6"
|
||
'edt-key-not-assigned 'edt-key-not-assigned)
|
||
(edt-bind-function-key-default "F7"
|
||
'edt-copy-rectangle 'edt-key-not-assigned)
|
||
(edt-bind-function-key-default "F8"
|
||
'edt-cut-rectangle-overstrike-mode 'edt-paste-rectangle-overstrike-mode)
|
||
(edt-bind-function-key-default "F9"
|
||
'edt-cut-rectangle-insert-mode 'edt-paste-rectangle-insert-mode)
|
||
(edt-bind-function-key-default "F10" 'edt-cut-rectangle 'edt-paste-rectangle)
|
||
;; 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-default "F11"
|
||
'edt-key-not-assigned 'edt-key-not-assigned)
|
||
(edt-bind-function-key-default "F12"
|
||
'edt-beginning-of-line 'delete-other-windows) ;BS
|
||
(edt-bind-function-key-default "F13"
|
||
'edt-delete-to-beginning-of-word 'edt-key-not-assigned) ;LF
|
||
(edt-bind-function-key-default "F14"
|
||
'edt-key-not-assigned 'edt-key-not-assigned)
|
||
(edt-bind-function-key-default "HELP"
|
||
'edt-electric-keypad-help 'edt-key-not-assigned)
|
||
(edt-bind-function-key-default "DO"
|
||
'execute-extended-command 'edt-key-not-assigned)
|
||
(edt-bind-function-key-default "F17"
|
||
'edt-key-not-assigned 'edt-key-not-assigned)
|
||
(edt-bind-function-key-default "F18"
|
||
'edt-key-not-assigned 'edt-key-not-assigned)
|
||
(edt-bind-function-key-default "F19"
|
||
'edt-key-not-assigned 'edt-key-not-assigned)
|
||
(edt-bind-function-key-default "F20"
|
||
'edt-key-not-assigned 'edt-key-not-assigned)
|
||
|
||
;; 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-key-default "\C-a" 'edt-key-not-assigned)
|
||
(edt-bind-key-default "\C-b" 'edt-key-not-assigned)
|
||
;; Leave binding of C-c to an Emacs prefix key.
|
||
(edt-bind-key-default "\C-d" 'edt-key-not-assigned)
|
||
(edt-bind-key-default "\C-e" 'edt-key-not-assigned)
|
||
(edt-bind-key-default "\C-f" 'edt-key-not-assigned)
|
||
;; Leave binding of C-g to the Emacs keyboard-quit
|
||
(edt-bind-key-default "\C-h" 'edt-beginning-of-line)
|
||
(edt-bind-key-default "\C-i" 'edt-tab-insert)
|
||
(edt-bind-key-default "\C-j" 'edt-delete-to-beginning-of-word)
|
||
(edt-bind-key-default "\C-k" 'edt-define-key)
|
||
(edt-bind-gold-key-default "\C-k" 'edt-restore-key)
|
||
(edt-bind-key-default "\C-l" 'edt-form-feed-insert)
|
||
;; Leave binding of C-m to newline.
|
||
(edt-bind-key-default "\C-n" 'edt-set-screen-width-80)
|
||
(edt-bind-key-default "\C-o" 'edt-key-not-assigned)
|
||
(edt-bind-key-default "\C-p" 'edt-key-not-assigned)
|
||
(edt-bind-key-default "\C-q" 'edt-key-not-assigned)
|
||
;; Leave binding of C-r to isearch-backward.
|
||
;; Leave binding of C-s to isearch-forward.
|
||
(edt-bind-key-default "\C-t" 'edt-display-the-time)
|
||
(edt-bind-key-default "\C-u" 'edt-delete-to-beginning-of-line)
|
||
(edt-bind-key-default "\C-v" 'redraw-display)
|
||
(edt-bind-key-default "\C-w" 'edt-set-screen-width-132)
|
||
;; Leave binding of C-x as original prefix key.
|
||
(edt-bind-key-default "\C-y" 'edt-key-not-assigned)
|
||
;; Leave binding of C-z to suspend-emacs.
|
||
)
|
||
)
|
||
|
||
;; GOLD bindings for a few keys.
|
||
(edt-bind-gold-key-default "\C-g" 'keyboard-quit); Just in case.
|
||
(edt-bind-gold-key-default "\C-h" 'help-for-help); Just in case.
|
||
(edt-bind-gold-key-default [f1] 'help-for-help)
|
||
(edt-bind-gold-key-default [help] 'help-for-help)
|
||
(edt-bind-gold-key-default "\C-\\" 'split-window-below)
|
||
|
||
;; GOLD bindings for regular keys.
|
||
(edt-bind-gold-key-default "a" 'edt-key-not-assigned)
|
||
(edt-bind-gold-key-default "A" 'edt-key-not-assigned)
|
||
(edt-bind-gold-key-default "b" 'buffer-menu)
|
||
(edt-bind-gold-key-default "B" 'buffer-menu)
|
||
(edt-bind-gold-key-default "c" 'compile)
|
||
(edt-bind-gold-key-default "C" 'compile)
|
||
(edt-bind-gold-key-default "d" 'delete-window)
|
||
(edt-bind-gold-key-default "D" 'delete-window)
|
||
(edt-bind-gold-key-default "e" 'edt-exit)
|
||
(edt-bind-gold-key-default "E" 'edt-exit)
|
||
(edt-bind-gold-key-default "f" 'find-file)
|
||
(edt-bind-gold-key-default "F" 'find-file)
|
||
(edt-bind-gold-key-default "g" 'find-file-other-window)
|
||
(edt-bind-gold-key-default "G" 'find-file-other-window)
|
||
(edt-bind-gold-key-default "h" 'edt-electric-keypad-help)
|
||
(edt-bind-gold-key-default "H" 'edt-electric-keypad-help)
|
||
(edt-bind-gold-key-default "i" 'insert-file)
|
||
(edt-bind-gold-key-default "I" 'insert-file)
|
||
(edt-bind-gold-key-default "j" 'edt-key-not-assigned)
|
||
(edt-bind-gold-key-default "J" 'edt-key-not-assigned)
|
||
(edt-bind-gold-key-default "k" 'edt-toggle-capitalization-of-word)
|
||
(edt-bind-gold-key-default "K" 'edt-toggle-capitalization-of-word)
|
||
(edt-bind-gold-key-default "l" 'edt-lowercase)
|
||
(edt-bind-gold-key-default "L" 'edt-lowercase)
|
||
(edt-bind-gold-key-default "m" 'save-some-buffers)
|
||
(edt-bind-gold-key-default "M" 'save-some-buffers)
|
||
(edt-bind-gold-key-default "n" 'next-error)
|
||
(edt-bind-gold-key-default "N" 'next-error)
|
||
(edt-bind-gold-key-default "o" 'switch-to-buffer-other-window)
|
||
(edt-bind-gold-key-default "O" 'switch-to-buffer-other-window)
|
||
(edt-bind-gold-key-default "p" 'edt-key-not-assigned)
|
||
(edt-bind-gold-key-default "P" 'edt-key-not-assigned)
|
||
(edt-bind-gold-key-default "q" 'edt-quit)
|
||
(edt-bind-gold-key-default "Q" 'edt-quit)
|
||
(edt-bind-gold-key-default "r" 'revert-buffer)
|
||
(edt-bind-gold-key-default "R" 'revert-buffer)
|
||
(edt-bind-gold-key-default "s" 'save-buffer)
|
||
(edt-bind-gold-key-default "S" 'save-buffer)
|
||
(edt-bind-gold-key-default "t" 'edt-key-not-assigned)
|
||
(edt-bind-gold-key-default "T" 'edt-key-not-assigned)
|
||
(edt-bind-gold-key-default "u" 'edt-uppercase)
|
||
(edt-bind-gold-key-default "U" 'edt-uppercase)
|
||
(edt-bind-gold-key-default "v" 'find-file-other-window)
|
||
(edt-bind-gold-key-default "V" 'find-file-other-window)
|
||
(edt-bind-gold-key-default "w" 'write-file)
|
||
(edt-bind-gold-key-default "W" 'write-file)
|
||
(edt-bind-gold-key-default "x" 'edt-key-not-assigned)
|
||
(edt-bind-gold-key-default "X" 'edt-key-not-assigned)
|
||
(edt-bind-gold-key-default "y" 'edt-emulation-off)
|
||
(edt-bind-gold-key-default "Y" 'edt-emulation-off)
|
||
(edt-bind-gold-key-default "z" 'edt-switch-global-maps)
|
||
(edt-bind-gold-key-default "Z" 'edt-switch-global-maps)
|
||
(edt-bind-gold-key-default "1" 'delete-other-windows)
|
||
(edt-bind-gold-key-default "!" 'edt-key-not-assigned)
|
||
(edt-bind-gold-key-default "2" 'edt-split-window)
|
||
(edt-bind-gold-key-default "@" 'edt-key-not-assigned)
|
||
(edt-bind-gold-key-default "3" 'edt-key-not-assigned)
|
||
(edt-bind-gold-key-default "#" 'edt-key-not-assigned)
|
||
(edt-bind-gold-key-default "4" 'edt-key-not-assigned)
|
||
(edt-bind-gold-key-default "$" 'edt-key-not-assigned)
|
||
(edt-bind-gold-key-default "5" 'edt-key-not-assigned)
|
||
(edt-bind-gold-key-default "%" 'edt-goto-percentage)
|
||
(edt-bind-gold-key-default "6" 'edt-key-not-assigned)
|
||
(edt-bind-gold-key-default "^" 'edt-key-not-assigned)
|
||
(edt-bind-gold-key-default "7" 'edt-key-not-assigned)
|
||
(edt-bind-gold-key-default "&" 'edt-key-not-assigned)
|
||
(edt-bind-gold-key-default "8" 'edt-key-not-assigned)
|
||
(edt-bind-gold-key-default "*" 'edt-key-not-assigned)
|
||
(edt-bind-gold-key-default "9" 'edt-key-not-assigned)
|
||
(edt-bind-gold-key-default "(" 'edt-key-not-assigned)
|
||
(edt-bind-gold-key-default "0" 'edt-key-not-assigned)
|
||
(edt-bind-gold-key-default ")" 'edt-key-not-assigned)
|
||
(edt-bind-gold-key-default " " 'undo)
|
||
(edt-bind-gold-key-default "," 'edt-key-not-assigned)
|
||
(edt-bind-gold-key-default "<" 'edt-key-not-assigned)
|
||
(edt-bind-gold-key-default "." 'edt-key-not-assigned)
|
||
(edt-bind-gold-key-default ">" 'edt-key-not-assigned)
|
||
(edt-bind-gold-key-default "/" 'query-replace)
|
||
(edt-bind-gold-key-default "?" 'edt-key-not-assigned)
|
||
(edt-bind-gold-key-default "\\" 'edt-key-not-assigned)
|
||
(edt-bind-gold-key-default "|" 'edt-key-not-assigned)
|
||
(edt-bind-gold-key-default ";" 'edt-key-not-assigned)
|
||
(edt-bind-gold-key-default ":" 'edt-key-not-assigned)
|
||
(edt-bind-gold-key-default "'" 'edt-key-not-assigned)
|
||
(edt-bind-gold-key-default "\"" 'edt-key-not-assigned)
|
||
(edt-bind-gold-key-default "-" 'edt-key-not-assigned)
|
||
(edt-bind-gold-key-default "_" 'edt-key-not-assigned)
|
||
(edt-bind-gold-key-default "=" 'goto-line)
|
||
(edt-bind-gold-key-default "+" 'edt-key-not-assigned)
|
||
(edt-bind-gold-key-default "[" 'edt-key-not-assigned)
|
||
(edt-bind-gold-key-default "{" 'edt-key-not-assigned)
|
||
(edt-bind-gold-key-default "]" 'edt-key-not-assigned)
|
||
(edt-bind-gold-key-default "}" 'edt-key-not-assigned)
|
||
(edt-bind-gold-key-default "`" 'what-line)
|
||
(edt-bind-gold-key-default "~" 'edt-key-not-assigned)
|
||
)
|
||
|
||
;;;
|
||
;;; 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: Beginning 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 |
|
||
G-HELP: Emacs Help +----------+----------+----------+----------+
|
||
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) | (.) | SUBS |
|
||
C-u: Delete to Begin of Line | Open Line | RESET | |
|
||
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
|
||
G-/: Query-Replace"
|
||
|
||
(interactive)
|
||
(describe-function 'edt-keypad-help))
|
||
|
||
(defun edt-electric-helpify (fun)
|
||
(let ((name "*Help*"))
|
||
(if (save-window-excursion
|
||
(let* ((p (symbol-function 'help-print-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
|
||
(with-current-buffer b
|
||
(set-buffer-modified-p t)))
|
||
(fset 'help-print-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 'help-print-return-message p)
|
||
(and b (buffer-name b)
|
||
(with-current-buffer b
|
||
(set-buffer-modified-p m))))))
|
||
(with-electric-help 'delete-other-windows name t))))
|
||
|
||
(defun edt-electric-keypad-help ()
|
||
"Display default EDT bindings."
|
||
(interactive)
|
||
(edt-electric-helpify 'edt-keypad-help))
|
||
|
||
(defun edt-electric-user-keypad-help ()
|
||
"Display user custom EDT bindings."
|
||
(interactive)
|
||
(edt-electric-helpify 'edt-user-keypad-help))
|
||
|
||
;;;
|
||
;;; EDT emulation screen width commands.
|
||
;;
|
||
;; Some terminals require modification of terminal attributes when
|
||
;; changing the number of columns displayed, hence the fboundp tests
|
||
;; below. These functions are defined in the corresponding terminal
|
||
;; specific file, if needed.
|
||
|
||
(defun edt-set-screen-width-80 ()
|
||
"Set screen width to 80 columns."
|
||
(interactive)
|
||
(if (fboundp 'edt-set-term-width-80)
|
||
(edt-set-term-width-80))
|
||
(set-frame-width nil 80)
|
||
(message "Terminal width 80"))
|
||
|
||
(defun edt-set-screen-width-132 ()
|
||
"Set screen width to 132 columns."
|
||
(interactive)
|
||
(if (fboundp 'edt-set-term-width-132)
|
||
(edt-set-term-width-132))
|
||
(set-frame-width nil 132)
|
||
(message "Terminal width 132"))
|
||
|
||
(provide 'edt)
|
||
|
||
;;; edt.el ends here
|