diff options
| -rw-r--r-- | lisp/emulation/edt.el | 211 |
1 files changed, 64 insertions, 147 deletions
diff --git a/lisp/emulation/edt.el b/lisp/emulation/edt.el index dcc327dbd4d..b8c835ce2ce 100644 --- a/lisp/emulation/edt.el +++ b/lisp/emulation/edt.el @@ -106,10 +106,7 @@ ;; 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 +;; 3. 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 @@ -120,7 +117,7 @@ ;; 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 +;; 4. 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, @@ -140,7 +137,7 @@ ;; 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 +;; 5. 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 @@ -180,8 +177,6 @@ (defvar edt-rect-start-point) (defvar edt-user-global-map) (defvar rect-start-point) -(defvar time-string) -(defvar zmacs-region-stays) ;;; ;;; Version Information @@ -310,23 +305,13 @@ This means that an edt-user.el file was found in the user's `load-path'.") ;;; ;;; 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) +(defconst edt-xserver (when (eq 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)))) + (replace-regexp-in-string "[ /]" "-" + (x-server-vendor))) "Indicates X server vendor name, if applicable.") (defvar edt-keys-file nil @@ -388,8 +373,7 @@ Argument NUM is the number of page delimiters to move." (error "Beginning of buffer") (progn (backward-page num) - (edt-line-to-top-of-window) - (if (featurep 'xemacs) (setq zmacs-region-stays t))))) + (edt-line-to-top-of-window)))) (defun edt-page (num) "Move in current direction to next page delimiter. @@ -449,8 +433,7 @@ Argument NUM is the number of BOL marks to move." (progn (setq num (1- num)) (forward-line (* -1 num)))) - (edt-top-check beg num)) - (if (featurep 'xemacs) (setq zmacs-region-stays t))) + (edt-top-check beg num))) ;;; @@ -465,8 +448,7 @@ Argument NUM is the number of EOL marks to move." (let ((beg (edt-current-line))) (forward-char) (end-of-line num) - (edt-bottom-check beg num)) - (if (featurep 'xemacs) (setq zmacs-region-stays t))) + (edt-bottom-check beg num))) (defun edt-end-of-line-backward (num) @@ -476,8 +458,7 @@ Argument NUM is the number of EOL marks to move." (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))) + (edt-top-check beg num))) (defun edt-end-of-line (num) @@ -521,8 +502,7 @@ Argument NUM is the number of EOL marks to move." (not (eobp)) (eq ?\ (char-syntax (following-char))) (not (memq (following-char) edt-word-entities))) - (forward-char)))) - (if (featurep 'xemacs) (setq zmacs-region-stays t))) + (forward-char))))) (defun edt-one-word-backward () "Move backward to first character of previous word." @@ -545,8 +525,7 @@ Argument NUM is the number of EOL marks to move." (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))) + (backward-char)))))) (defun edt-word-forward (num) "Move forward to first character of next word. @@ -585,8 +564,7 @@ Argument NUM is the number of characters to move." (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))) + (backward-char num))) ;;; ;;; LINE @@ -608,8 +586,7 @@ Argument NUM is the number of BOL marks to move." (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))) + (edt-bottom-check beg num))) (defun edt-line (num) "Move in current direction to next beginning of line mark. @@ -631,8 +608,7 @@ Argument NUM is the number of lines to move." (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))) + (edt-bottom-check beg num))) (defun edt-previous-line (num) "Move cursor up one line. @@ -642,8 +618,7 @@ Argument NUM is the number of lines to move." (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))) + (edt-top-check beg num))) ;;; @@ -653,8 +628,7 @@ Argument NUM is the number of lines to move." (defun edt-top () "Move cursor to the beginning of buffer." (interactive) - (goto-char (point-min)) - (if (featurep 'xemacs) (setq zmacs-region-stays t))) + (goto-char (point-min))) ;;; ;;; BOTTOM @@ -703,8 +677,7 @@ Optional argument FIND is t is this function is called from `edt-find'." (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))) + (and (> (point) bottom) (recenter bottom-margin)))))) (defun edt-find-backward (&optional find) "Find first occurrence of a string in the backward direction and save it. @@ -715,8 +688,7 @@ Optional argument FIND is t if this function is called from `edt-find'." (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))) + (and (< (point) top) (recenter (min beg top-margin))))) (defun edt-find () "Find first occurrence of string in current direction and save it." @@ -746,8 +718,7 @@ Optional argument FIND is t if this function is called from `edt-find'." (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))) + (error "Search failed: \"%s\"" edt-find-last-text)))) (defun edt-find-next-backward () "Find next occurrence of a string in backward direction." @@ -756,8 +727,7 @@ Optional argument FIND is t if this function is called from `edt-find'." (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))) + (and (< (point) top) (recenter (min beg top-margin)))))) (defun edt-find-next () "Find next occurrence of a string in current direction." @@ -834,9 +804,7 @@ In select mode, selected text is highlighted." (defun edt-reset () "Cancel text selection." (interactive) - (if (featurep 'emacs) - (deactivate-mark) - (zmacs-deactivate-region))) + (deactivate-mark)) ;;; ;;; CUT @@ -1050,8 +1018,7 @@ Also, execute command specified if in Minibuffer." (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))) + (exit-minibuffer))) ;;; @@ -1066,8 +1033,7 @@ Also, execute command specified if in Minibuffer." (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))) + (exit-minibuffer))) ;;; @@ -1117,14 +1083,11 @@ Argument NUM is the numbers of consecutive characters to change." 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))) + (if (string-equal "\C-m" edt-key-definition) (message "Key not defined") (progn (setq edt-function (read-command "Enter command name: ")) @@ -1202,8 +1165,6 @@ Argument LINES is the number of lines the cursor moved toward the bottom." ;; 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 @@ -1289,8 +1250,7 @@ Argument NUM is the positive number of sentences to move." (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))) + (and (> (point) bottom) (recenter bottom-margin))))) (defun edt-sentence-backward (num) "Move backward to next sentence beginning. @@ -1301,8 +1261,7 @@ Argument NUM is the positive number of sentences to move." (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))) + (and (< (point) top) (recenter (min beg top-margin))))) (defun edt-sentence (num) "Move in current direction to next sentence. @@ -1332,8 +1291,7 @@ Argument NUM is the positive number of paragraphs to move." (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))) + (and (> (point) bottom) (recenter bottom-margin))))) (defun edt-paragraph-backward (num) "Move backward to beginning of paragraph. @@ -1344,8 +1302,7 @@ Argument NUM is the positive number of paragraphs to move." (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))) + (and (< (point) top) (recenter (min beg top-margin))))) (defun edt-paragraph (num) "Move in current direction to next paragraph. @@ -1363,24 +1320,18 @@ Argument NUM is the positive number of paragraphs to move." "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))) + (if (string-equal "\C-m" 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))))))) + (message "Key definition for %s has been restored." + edt-key-definition))))) (error "No replaced key definition to restore!"))) ;;; @@ -1392,8 +1343,7 @@ Definition is stored in `edt-last-replaced-key-definition'." (interactive) (let ((start-column (current-column))) (move-to-window-line 0) - (move-to-column start-column)) - (if (featurep 'xemacs) (setq zmacs-region-stays t))) + (move-to-column start-column))) ;;; ;;; WINDOW BOTTOM @@ -1404,8 +1354,7 @@ Definition is stored in `edt-last-replaced-key-definition'." (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))) + (move-to-column start-column))) ;;; ;;; SCROLL WINDOW LINE @@ -1414,14 +1363,12 @@ Definition is stored in `edt-last-replaced-key-definition'." (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))) + (scroll-up 1)) (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))) + (scroll-down 1)) (defun edt-scroll-line () "Move window one line in current direction." @@ -1467,8 +1414,7 @@ Argument NUM is the positive number of windows to move." (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))) + (recenter -1)) ;;; ;;; LINE TO TOP OF WINDOW @@ -1477,8 +1423,7 @@ Argument NUM is the positive number of windows to move." (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))) + (recenter 0)) ;;; ;;; LINE TO MIDDLE OF WINDOW @@ -1487,8 +1432,7 @@ Argument NUM is the positive number of windows to move." (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))) + (recenter '(4))) ;;; ;;; GOTO PERCENTAGE @@ -1500,8 +1444,7 @@ 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))) + (goto-char (/ (* (point-max) num) 100)))) ;;; ;;; FILL REGION @@ -1673,7 +1616,6 @@ Argument NUM is the number of times to duplicate the line." (defun edt-display-the-time () "Display the current time." (interactive) - (if (featurep 'xemacs) (setq zmacs-region-stays t)) (message "%s" (current-time-string))) ;;; @@ -1701,9 +1643,7 @@ Argument NUM is the number of times to duplicate the line." (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))) + (if (string-equal "\C-m" edt-key-definition) (message "Key sequence not remembered") (progn (set 'edt-learn-macro-count (+ edt-learn-macro-count 1)) @@ -1753,8 +1693,7 @@ Warn user that modifications will be lost." "Split current window and place cursor in the new window." (interactive) (split-window) - (other-window 1) - (if (featurep 'xemacs) (setq zmacs-region-stays t))) + (other-window 1)) ;;; ;;; COPY RECTANGLE @@ -1935,9 +1874,8 @@ Optional argument NOT-YES changes the default to negative." (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 +The default file names are based upon the window system and terminal +type. If a default file does not exist, ask user if one should be created." (interactive "fKey definition file: ") (cond (file @@ -1948,11 +1886,11 @@ created." (setq file (expand-file-name (concat - "~/.edt-" edt-emacs-variant + "~/.edt-gnu" (if edt-term (concat "-" edt-term)) (if edt-xserver (concat "-" edt-xserver)) - (if edt-window-system - (concat "-" (upcase (symbol-name edt-window-system)))) + (if window-system + (concat "-" (upcase (symbol-name window-system)))) "-keys"))))) (cond ((file-readable-p file) (load-file file)) @@ -2002,15 +1940,14 @@ created." "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) + ;; If not a window system, get terminal type. + (if (eq window-system 'pc) (setq edt-term "pc") - (if (or (not edt-window-system) (eq edt-window-system 'tty)) + (if (not window-system) (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))) + (if (or (not window-system) (memq 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 @@ -2037,27 +1974,14 @@ created." (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)))))) + (setq edt-orig-transient-mark-mode + (default-value 'transient-mark-mode)) + (add-hook 'activate-mark-hook + (lambda () + (edt-select-mode t))) + (add-hook 'deactivate-mark-hook + (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) @@ -2074,8 +1998,7 @@ created." (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)) + (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 () @@ -2103,9 +2026,7 @@ Optional argument USER-SETUP non-nil means called from function ;; 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-key edt-default-global-map "\e" 'edt-default-ESC-prefix) (define-prefix-command 'edt-default-gold-map) (edt-setup-default-bindings) ;; If terminal has additional function keys, the terminal-specific @@ -2141,9 +2062,7 @@ Optional argument USER-SETUP non-nil means called from function ;; 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)) + (define-key edt-user-global-map "\e" 'edt-user-ESC-prefix) ;; If terminal has additional function keys, the user's initialization ;; file can assign bindings to them via the optional ;; function edt-setup-extra-default-bindings. @@ -2160,8 +2079,7 @@ Optional argument USER-SETUP non-nil means called from function (defun edt-select-default-global-map() "Select default EDT emulation key bindings." (interactive) - (if (featurep 'emacs) - (transient-mark-mode 1)) + (transient-mark-mode 1) (use-global-map edt-default-global-map) (if (not edt-keep-current-page-delimiter) (progn @@ -2178,8 +2096,7 @@ Optional argument USER-SETUP non-nil means called from function (interactive) (if edt-user-map-configured (progn - (if (featurep 'emacs) - (transient-mark-mode 1)) + (transient-mark-mode 1) (use-global-map edt-user-global-map) (if (not edt-keep-current-page-delimiter) (progn |