;;; edt.el --- enhanced EDT keypad mode emulation for GNU Emacs 19
;; Copyright (C) 1986, 1992, 1993, 1994, 1995, 2000, 2001, 2002, 2003,
-;; 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+;; 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
;; Author: Kevin Gallagher <Kevin.Gallagher@boeing.com>
;; Maintainer: Kevin Gallagher <Kevin.Gallagher@boeing.com>
;; 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 2, or (at your
-;; option) any later version.
+;; 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.
+;; 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; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
\f
;;;; VARIABLES and CONSTANTS
;;;;
-;; For backward compatibility to Emacs 19.
-(or (fboundp 'defgroup)
- (defmacro defgroup (&rest rest)))
-
(defgroup edt nil
"Emacs emulating EDT."
:prefix "edt-"
:group 'emulations)
;; To silence the byte-compiler
-(eval-when-compile
- (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))
+(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
;;; User Configurable Variables
;;;
-;; For backward compatibility to Emacs 19.
-(or (fboundp 'defcustom)
- (defmacro defcustom (var value doc &rest ignore)
- `(defvar ,var ,value ,doc)))
-
(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
;;;
;;; o edt-emulation-on o edt-load-keys
;;;
-(defconst edt-emacs19-p (not (string-lessp emacs-version "19"))
- "Non-nil if we are running GNU Emacs or XEmacs version 19, or higher.")
-
-(defconst edt-x-emacs19-p
- (and edt-emacs19-p (string-match "XEmacs" emacs-version))
- "Non-nil if we are running XEmacs version 19, or higher.")
-
-(defconst edt-gnu-emacs19-p (and edt-emacs19-p (not edt-x-emacs19-p))
- "Non-nil if we are running GNU Emacs version 19, or higher.")
-
-(defconst edt-emacs-variant (if edt-gnu-emacs19-p "gnu" "xemacs")
+(defconst edt-emacs-variant (if (featurep 'emacs) "gnu" "xemacs")
"Indicates Emacs variant: GNU Emacs or XEmacs \(aka Lucid Emacs\).")
-(defconst edt-window-system (if edt-gnu-emacs19-p window-system (console-type))
+(defconst edt-window-system (if (featurep 'emacs) window-system (console-type))
"Indicates window system \(in GNU Emacs\) or console type \(in XEmacs\).")
-(defconst edt-xserver (if (eq edt-window-system 'x)
- (if edt-x-emacs19-p
- ;; 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.
- (replace-in-string (x-server-vendor) "[ /]" "-")
- (subst-char-in-string ?/ ?- (subst-char-in-string ? ?- (x-server-vendor))))
- nil)
+(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
(defvar edt-last-copied-word nil
"Last word that the user copied.")
-(defvar zmacs-region-stays)
\f
;;;;
;;;; EDT Emulation Commands
(progn
(backward-page num)
(edt-line-to-top-of-window)
- (if edt-x-emacs19-p (setq zmacs-region-stays t)))))
+ (if (featurep 'xemacs) (setq zmacs-region-stays t)))))
(defun edt-page (num)
"Move in current direction to next page delimiter.
(setq num (1- num))
(forward-line (* -1 num))))
(edt-top-check beg num))
- (if edt-x-emacs19-p (setq zmacs-region-stays t)))
+ (if (featurep 'xemacs) (setq zmacs-region-stays t)))
;;;
(forward-char)
(end-of-line num)
(edt-bottom-check beg num))
- (if edt-x-emacs19-p (setq zmacs-region-stays t)))
+ (if (featurep 'xemacs) (setq zmacs-region-stays t)))
(defun edt-end-of-line-backward (num)
(let ((beg (edt-current-line)))
(end-of-line (1- num))
(edt-top-check beg num))
- (if edt-x-emacs19-p (setq zmacs-region-stays t)))
+ (if (featurep 'xemacs) (setq zmacs-region-stays t)))
(defun edt-end-of-line (num)
(eq ?\ (char-syntax (following-char)))
(not (memq (following-char) edt-word-entities)))
(forward-char))))
- (if edt-x-emacs19-p (setq zmacs-region-stays t)))
+ (if (featurep 'xemacs) (setq zmacs-region-stays t)))
(defun edt-one-word-backward ()
"Move backward to first character of previous word."
(not (eq ?\ (char-syntax (preceding-char))))
(not (memq (preceding-char) edt-word-entities)))
(backward-char)))))
- (if edt-x-emacs19-p (setq zmacs-region-stays t)))
+ (if (featurep 'xemacs) (setq zmacs-region-stays t)))
(defun edt-word-forward (num)
"Move forward to first character of next word.
(if (equal edt-direction-string edt-forward-string)
(forward-char num)
(backward-char num))
- (if edt-x-emacs19-p (setq zmacs-region-stays t)))
+ (if (featurep 'xemacs) (setq zmacs-region-stays t)))
;;;
;;; LINE
(let ((beg (edt-current-line)))
(forward-line num)
(edt-bottom-check beg num))
- (if edt-x-emacs19-p (setq zmacs-region-stays t)))
+ (if (featurep 'xemacs) (setq zmacs-region-stays t)))
(defun edt-line (num)
"Move in current direction to next beginning of line mark.
(interactive "p")
(edt-check-prefix num)
(let ((beg (edt-current-line)))
- (next-line num)
+ ;; We're deliberately using next-line instead of forward-line.
+ (with-no-warnings (next-line num))
(edt-bottom-check beg num))
- (if edt-x-emacs19-p (setq zmacs-region-stays t)))
+ (if (featurep 'xemacs) (setq zmacs-region-stays t)))
(defun edt-previous-line (num)
"Move cursor up one line.
(interactive "p")
(edt-check-prefix num)
(let ((beg (edt-current-line)))
- (previous-line num)
+ ;; We're deliberately using previous-line instead of forward-line.
+ (with-no-warnings (previous-line num))
(edt-top-check beg num))
- (if edt-x-emacs19-p (setq zmacs-region-stays t)))
+ (if (featurep 'xemacs) (setq zmacs-region-stays t)))
;;;
"Move cursor to the beginning of buffer."
(interactive)
(goto-char (point-min))
- (if edt-x-emacs19-p (setq zmacs-region-stays t)))
+ (if (featurep 'xemacs) (setq zmacs-region-stays t)))
;;;
;;; BOTTOM
(recenter (- left bottom-up-margin))))
(t
(and (> (point) bottom) (recenter bottom-margin)))))))
- (if edt-x-emacs19-p (setq zmacs-region-stays t)))
+ (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.
(if (search-backward edt-find-last-text)
(edt-set-match))
(and (< (point) top) (recenter (min beg top-margin))))
- (if edt-x-emacs19-p (setq zmacs-region-stays t)))
+ (if (featurep 'xemacs) (setq zmacs-region-stays t)))
(defun edt-find ()
"Find first occurrence of string in current direction and save it."
(progn
(backward-char 1)
(error "Search failed: \"%s\"" edt-find-last-text))))
- (if edt-x-emacs19-p (setq zmacs-region-stays t)))
+ (if (featurep 'xemacs) (setq zmacs-region-stays t)))
(defun edt-find-next-backward ()
"Find next occurrence of a string in backward direction."
(progn
(edt-set-match)
(and (< (point) top) (recenter (min beg top-margin))))))
- (if edt-x-emacs19-p (setq zmacs-region-stays t)))
+ (if (featurep 'xemacs) (setq zmacs-region-stays t)))
(defun edt-find-next ()
"Find next occurrence of a string in current direction."
(defun edt-reset ()
"Cancel text selection."
(interactive)
- (if edt-gnu-emacs19-p
+ (if (featurep 'emacs)
(deactivate-mark)
(zmacs-deactivate-region)))
(if (string-equal " *Minibuf"
(substring (buffer-name) 0 (min (length (buffer-name)) 9)))
(exit-minibuffer))
- (if edt-x-emacs19-p (setq zmacs-region-stays t)))
+ (if (featurep 'xemacs) (setq zmacs-region-stays t)))
;;;
(if (string-equal " *Minibuf"
(substring (buffer-name) 0 (min (length (buffer-name)) 9)))
(exit-minibuffer))
- (if edt-x-emacs19-p (setq zmacs-region-stays t)))
+ (if (featurep 'xemacs) (setq zmacs-region-stays t)))
;;;
The current key definition is saved in `edt-last-replaced-key-definition'.
Use `edt-restore-key' to restore last replaced key definition."
(interactive)
- (if edt-x-emacs19-p (setq zmacs-region-stays t))
+ (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 edt-gnu-emacs19-p
+ (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")
;; subtract 1 from height because it includes mode line
(difference (- height margin 1)))
(cond ((> beg difference) (recenter beg))
- ((and edt-x-emacs19-p (> (+ beg lines 1) difference))
+ ((and (featurep 'xemacs) (> (+ beg lines 1) difference))
(recenter (- margin)))
((> (+ beg lines) difference) (recenter (- margin))))))
(/ (1- (+ (* (string-to-number bottom) 100) (window-height)))
(window-height)))))
;; report scroll margin settings if running interactively
- (and (interactive-p)
+ (and (called-interactively-p 'interactive)
(message "Scroll margins set. Top = %s%%, Bottom = %s%%"
edt-top-scroll-margin edt-bottom-scroll-margin)))
(recenter (- left bottom-up-margin))))
(t
(and (> (point) bottom) (recenter bottom-margin)))))
- (if edt-x-emacs19-p (setq zmacs-region-stays t)))
+ (if (featurep 'xemacs) (setq zmacs-region-stays t)))
(defun edt-sentence-backward (num)
"Move backward to next sentence beginning.
(error "End of buffer"))
(backward-sentence num))
(and (< (point) top) (recenter (min beg top-margin))))
- (if edt-x-emacs19-p (setq zmacs-region-stays t)))
+ (if (featurep 'xemacs) (setq zmacs-region-stays t)))
(defun edt-sentence (num)
"Move in current direction to next sentence.
(forward-paragraph (+ num 1))
(start-of-paragraph-text)
(if (eolp)
- (next-line 1))
+ (forward-line 1))
(setq num (1- num)))
(cond((> (point) far)
(setq left (save-excursion (forward-line height)))
(recenter (- left bottom-up-margin))))
(t
(and (> (point) bottom) (recenter bottom-margin)))))
- (if edt-x-emacs19-p (setq zmacs-region-stays t)))
+ (if (featurep 'xemacs) (setq zmacs-region-stays t)))
(defun edt-paragraph-backward (num)
"Move backward to beginning of paragraph.
(start-of-paragraph-text)
(setq num (1- num)))
(and (< (point) top) (recenter (min beg top-margin))))
- (if edt-x-emacs19-p (setq zmacs-region-stays t)))
+ (if (featurep 'xemacs) (setq zmacs-region-stays t)))
(defun edt-paragraph (num)
"Move in current direction to next paragraph.
"Restore last replaced key definition.
Definition is stored in `edt-last-replaced-key-definition'."
(interactive)
- (if edt-x-emacs19-p (setq zmacs-region-stays t))
+ (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 edt-gnu-emacs19-p
+ (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 edt-gnu-emacs19-p
+ (if (featurep 'emacs)
(message "Key definition for %s has been restored."
edt-key-definition)
(message "Key definition for %s has been restored."
(let ((start-column (current-column)))
(move-to-window-line 0)
(move-to-column start-column))
- (if edt-x-emacs19-p (setq zmacs-region-stays t)))
+ (if (featurep 'xemacs) (setq zmacs-region-stays t)))
;;;
;;; WINDOW BOTTOM
(let ((start-column (current-column)))
(move-to-window-line (- (window-height) 2))
(move-to-column start-column))
- (if edt-x-emacs19-p (setq zmacs-region-stays t)))
+ (if (featurep 'xemacs) (setq zmacs-region-stays t)))
;;;
;;; SCROLL WINDOW LINE
"Move window forward one line leaving cursor at position in window."
(interactive)
(scroll-up 1)
- (if edt-x-emacs19-p (setq zmacs-region-stays t)))
+ (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 edt-x-emacs19-p (setq zmacs-region-stays t)))
+ (if (featurep 'xemacs) (setq zmacs-region-stays t)))
(defun edt-scroll-line ()
"Move window one line in current direction."
"Move the current line to the bottom of the window."
(interactive)
(recenter -1)
- (if edt-x-emacs19-p (setq zmacs-region-stays t)))
+ (if (featurep 'xemacs) (setq zmacs-region-stays t)))
;;;
;;; LINE TO TOP OF WINDOW
"Move the current line to the top of the window."
(interactive)
(recenter 0)
- (if edt-x-emacs19-p (setq zmacs-region-stays t)))
+ (if (featurep 'xemacs) (setq zmacs-region-stays t)))
;;;
;;; LINE TO MIDDLE OF WINDOW
"Move window so line with cursor is in the middle of the window."
(interactive)
(recenter '(4))
- (if edt-x-emacs19-p (setq zmacs-region-stays t)))
+ (if (featurep 'xemacs) (setq zmacs-region-stays t)))
;;;
;;; GOTO PERCENTAGE
(if (or (> num 100) (< num 0))
(error "Percentage %d out of range 0 < percent < 100" num)
(goto-char (/ (* (point-max) num) 100)))
- (if edt-x-emacs19-p (setq zmacs-region-stays t)))
+ (if (featurep 'xemacs) (setq zmacs-region-stays t)))
;;;
;;; FILL REGION
(indent-region (point) (mark) nil)
(fill-region (point) (mark))))
+
+(declare-function c-mark-function "cc-cmds" ())
;;;
;;; MARK SECTION WISELY
;;;
(defun edt-display-the-time ()
"Display the current time."
(interactive)
- (if edt-x-emacs19-p (setq zmacs-region-stays t))
+ (if (featurep 'xemacs) (setq zmacs-region-stays t))
(message "%s" (current-time-string)))
;;;
(let (edt-key-definition)
(set 'edt-key-definition
(read-key-sequence "Enter key for binding: "))
- (if (if edt-gnu-emacs19-p
+ (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")
(interactive)
(split-window)
(other-window 1)
- (if edt-x-emacs19-p (setq zmacs-region-stays t)))
+ (if (featurep 'xemacs) (setq zmacs-region-stays t)))
;;;
;;; COPY RECTANGLE
(setq edt-term term))))
(edt-load-keys nil))
;; Make highlighting of selected text work properly for EDT commands.
- (if edt-gnu-emacs19-p
+ (if (featurep 'emacs)
(progn
(setq edt-orig-transient-mark-mode transient-mark-mode)
(add-hook 'activate-mark-hook
(setq edt-select-mode-current nil)
(edt-reset)
(force-mode-line-update t)
- (if edt-gnu-emacs19-p
+ (if (featurep 'emacs)
(setq transient-mark-mode edt-orig-transient-mark-mode))
(message "Original key bindings restored; EDT Emulation disabled"))
;; 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 edt-gnu-emacs19-p
+ (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)
(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))))
+ (edt-select-default-global-map)))
+ ;; We need to share `global-buffers-menu-map' with the saved global
+ ;; keymap, because `menu-bar-update-buffers' directly changes it.
+ (define-key (current-global-map) [menu-bar buffer]
+ (cons "Buffers" global-buffers-menu-map)))
(defun edt-user-emulation-setup ()
"Setup user custom emulation of DEC's EDT editor."
;; 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 edt-gnu-emacs19-p
+ (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
;; function edt-setup-extra-default-bindings.
(define-prefix-command 'edt-user-gold-map)
(fset 'edt-user-gold-map (copy-keymap 'edt-default-gold-map))
- (edt-setup-user-bindings)
+ ;; This is a function that the user can define for custom bindings.
+ ;; See etc/edt-user.doc.
+ (if (fboundp 'edt-setup-user-bindings)
+ (edt-setup-user-bindings))
(edt-select-user-global-map))
(defun edt-select-default-global-map()
"Select default EDT emulation key bindings."
(interactive)
- (if edt-gnu-emacs19-p
+ (if (featurep 'emacs)
(transient-mark-mode 1))
(use-global-map edt-default-global-map)
(if (not edt-keep-current-page-delimiter)
(interactive)
(if edt-user-map-configured
(progn
- (if edt-gnu-emacs19-p
+ (if (featurep 'emacs)
(transient-mark-mode 1))
(use-global-map edt-user-global-map)
(if (not edt-keep-current-page-delimiter)
(defun edt-electric-helpify (fun)
(let ((name "*Help*"))
(if (save-window-excursion
- (let* ((p (symbol-function 'print-help-return-message))
+ (let* ((p (symbol-function 'help-print-return-message))
(b (get-buffer name))
(m (buffer-modified-p b)))
(and b (not (get-buffer-window b))
(progn
(message "%s..." (capitalize (symbol-name fun)))
(and b
- (save-excursion
- (set-buffer b)
+ (with-current-buffer b
(set-buffer-modified-p t)))
- (fset 'print-help-return-message 'ignore)
+ (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 'print-help-return-message p)
+ (fset 'help-print-return-message p)
(and b (buffer-name b)
- (save-excursion
- (set-buffer b)
+ (with-current-buffer b
(set-buffer-modified-p m))))))
(with-electric-help 'delete-other-windows name t))))
(provide 'edt)
-;;; arch-tag: 18d1c54f-6900-4078-8bbc-7c2292f48941
+;; arch-tag: 18d1c54f-6900-4078-8bbc-7c2292f48941
;;; edt.el ends here