diff options
Diffstat (limited to 'lisp/emulation')
| -rw-r--r-- | lisp/emulation/cua-base.el | 97 | ||||
| -rw-r--r-- | lisp/emulation/cua-gmrk.el | 4 | ||||
| -rw-r--r-- | lisp/emulation/cua-rect.el | 17 | ||||
| -rw-r--r-- | lisp/emulation/edt-mapper.el | 75 | ||||
| -rw-r--r-- | lisp/emulation/edt-vt100.el | 2 | ||||
| -rw-r--r-- | lisp/emulation/edt.el | 151 | ||||
| -rw-r--r-- | lisp/emulation/pc-select.el | 115 | ||||
| -rw-r--r-- | lisp/emulation/tpu-edt.el | 734 | ||||
| -rw-r--r-- | lisp/emulation/tpu-extras.el | 60 | ||||
| -rw-r--r-- | lisp/emulation/tpu-mapper.el | 446 | ||||
| -rw-r--r-- | lisp/emulation/vi.el | 8 | ||||
| -rw-r--r-- | lisp/emulation/vip.el | 16 | ||||
| -rw-r--r-- | lisp/emulation/viper-cmd.el | 88 | ||||
| -rw-r--r-- | lisp/emulation/viper-ex.el | 40 | ||||
| -rw-r--r-- | lisp/emulation/viper-init.el | 54 | ||||
| -rw-r--r-- | lisp/emulation/viper-keym.el | 25 | ||||
| -rw-r--r-- | lisp/emulation/viper-macs.el | 20 | ||||
| -rw-r--r-- | lisp/emulation/viper-mous.el | 32 | ||||
| -rw-r--r-- | lisp/emulation/viper-util.el | 148 | ||||
| -rw-r--r-- | lisp/emulation/viper.el | 158 |
20 files changed, 1086 insertions, 1204 deletions
diff --git a/lisp/emulation/cua-base.el b/lisp/emulation/cua-base.el index 921e6fa83f5..2bc37a9bc95 100644 --- a/lisp/emulation/cua-base.el +++ b/lisp/emulation/cua-base.el @@ -406,8 +406,8 @@ and after the region marked by the rectangle to search." "Global key used to toggle the cua rectangle mark." :set #'(lambda (symbol value) (set symbol value) - (when (and (boundp 'cua--keymaps-initalized) - cua--keymaps-initalized) + (when (and (boundp 'cua--keymaps-initialized) + cua--keymaps-initialized) (define-key cua-global-keymap value 'cua-set-rectangle-mark) (when (boundp 'cua--rectangle-keymap) @@ -583,35 +583,37 @@ a cons (TYPE . COLOR), then both properties are affected." ;;; Rectangle support is in cua-rect.el -(autoload 'cua-set-rectangle-mark "cua-rect" nil t nil) +(autoload 'cua-set-rectangle-mark "cua-rect" + "Start rectangle at mouse click position." t nil) ;; Stub definitions until it is loaded - -(when (not (featurep 'cua-rect)) - (defvar cua--rectangle) - (setq cua--rectangle nil) - (defvar cua--last-killed-rectangle) - (setq cua--last-killed-rectangle nil)) - - +(defvar cua--rectangle) +(defvar cua--last-killed-rectangle) +(unless (featurep 'cua-rect) + (setq cua--rectangle nil + cua--last-killed-rectangle nil)) + +;; All behind cua--rectangle tests. +(declare-function cua-copy-rectangle "cua-rect" (arg)) +(declare-function cua-cut-rectangle "cua-rect" (arg)) +(declare-function cua--rectangle-left "cua-rect" (&optional val)) +(declare-function cua--delete-rectangle "cua-rect" ()) +(declare-function cua--insert-rectangle "cua-rect" + (rect &optional below paste-column line-count)) +(declare-function cua--rectangle-corner "cua-rect" (&optional advance)) +(declare-function cua--rectangle-assert "cua-rect" ()) ;;; Global Mark support is in cua-gmrk.el (autoload 'cua-toggle-global-mark "cua-gmrk" nil t nil) ;; Stub definitions until cua-gmrk.el is loaded - -(when (not (featurep 'cua-gmrk)) - (defvar cua--global-mark-active) +(defvar cua--global-mark-active) +(unless (featurep 'cua-gmrk) (setq cua--global-mark-active nil)) - -(provide 'cua-base) - -(eval-when-compile - (require 'cua-rect) - (require 'cua-gmrk) - ) +(declare-function cua--insert-at-global-mark "cua-gmrk" (str &optional msg)) +(declare-function cua--global-mark-post-command "cua-gmrk" ()) ;;; Low-level Interface @@ -874,6 +876,8 @@ With numeric prefix arg, copy to register 0-9 instead." (if (fboundp 'cua--cancel-rectangle) (cua--cancel-rectangle))) +(declare-function x-clipboard-yank "../term/x-win" ()) + (defun cua-paste (arg) "Paste last cut or copied region or rectangle. An active region is deleted before executing the command. @@ -898,9 +902,6 @@ If global mark is active, copy from register or one character." (t ;; Must save register here, since delete may override reg 0. (if mark-active - ;; Before a yank command, make sure we don't yank - ;; the same region that we are going to delete. - ;; That would make yank a no-op. (if cua--rectangle (progn (goto-char (min (mark) (point))) @@ -908,13 +909,20 @@ If global mark is active, copy from register or one character." (setq paste-lines (cua--delete-rectangle)) (if (= paste-lines 1) (setq paste-lines nil))) ;; paste all - (if (string= (filter-buffer-substring (point) (mark)) - (car kill-ring)) + ;; Before a yank command, make sure we don't yank the + ;; head of the kill-ring that really comes from the + ;; currently active region we are going to delete. + ;; That would make yank a no-op. + (if (and (string= (filter-buffer-substring (point) (mark)) + (car kill-ring)) + (fboundp 'mouse-region-match) + (mouse-region-match)) (current-kill 1)) (cua-delete-region))) (cond (regtxt (cond + ;; This being a cons implies cua-rect is loaded? ((consp regtxt) (cua--insert-rectangle regtxt)) ((stringp regtxt) (insert-for-yank regtxt)) (t (message "Unknown data in register %c" cua--register)))) @@ -1222,22 +1230,26 @@ If ARG is the atom `-', scroll upward by nearly full screen." ;; Handle shifted cursor keys and other movement commands. ;; If region is not active, region is activated if key is shifted. - ;; If region is active, region is cancelled if key is unshifted (and region not started with C-SPC). - ;; If rectangle is active, expand rectangle in specified direction and ignore the movement. + ;; If region is active, region is cancelled if key is unshifted + ;; (and region not started with C-SPC). + ;; If rectangle is active, expand rectangle in specified direction and + ;; ignore the movement. ((if window-system + ;; Shortcut for window-system, assuming that input-decode-map is empty. (memq 'shift (event-modifiers (aref (this-single-command-raw-keys) 0))) (or + ;; Check if the final key-sequence was shifted. (memq 'shift (event-modifiers (aref (this-single-command-keys) 0))) - ;; See if raw escape sequence maps to a shifted event, e.g. S-up or C-S-home. - (and (boundp 'function-key-map) - function-key-map - (let ((ev (lookup-key function-key-map - (this-single-command-raw-keys)))) - (and (vector ev) - (symbolp (setq ev (aref ev 0))) - (string-match "S-" (symbol-name ev))))))) + ;; If not, maybe the raw key-sequence was mapped by input-decode-map + ;; to a shifted key (and then mapped down to its unshifted form). + (let* ((keys (this-single-command-raw-keys)) + (ev (lookup-key input-decode-map keys))) + (or (and (vector ev) (memq 'shift (event-modifiers (aref ev 0)))) + ;; Or maybe, the raw key-sequence was not an escape sequence + ;; and was shifted (and then mapped down to its unshifted form). + (memq 'shift (event-modifiers (aref keys 0))))))) (unless mark-active (push-mark-command nil t)) (setq cua--last-region-shifted t) @@ -1323,8 +1335,8 @@ If ARG is the atom `-', scroll upward by nearly full screen." (defvar cua--cua-keys-keymap (make-sparse-keymap)) (defvar cua--prefix-override-keymap (make-sparse-keymap)) (defvar cua--prefix-repeat-keymap (make-sparse-keymap)) -(defvar cua--global-mark-keymap (make-sparse-keymap)) ; Initalized when cua-gmrk.el is loaded -(defvar cua--rectangle-keymap (make-sparse-keymap)) ; Initalized when cua-rect.el is loaded +(defvar cua--global-mark-keymap (make-sparse-keymap)) ; Initialized when cua-gmrk.el is loaded +(defvar cua--rectangle-keymap (make-sparse-keymap)) ; Initialized when cua-rect.el is loaded (defvar cua--region-keymap (make-sparse-keymap)) (defvar cua--ena-cua-keys-keymap nil) @@ -1367,7 +1379,7 @@ If ARG is the atom `-', scroll upward by nearly full screen." (and cua--global-mark-active (not (window-minibuffer-p))))) -(defvar cua--keymaps-initalized nil) +(defvar cua--keymaps-initialized nil) (defun cua--shift-control-prefix (prefix arg) ;; handle S-C-x and S-C-c by emulating the fast double prefix function. @@ -1531,9 +1543,9 @@ shifted movement key, set `cua-highlight-region-shift-only'." (setq mark-even-if-inactive t) (setq highlight-nonselected-windows nil) - (unless cua--keymaps-initalized + (unless cua--keymaps-initialized (cua--init-keymaps) - (setq cua--keymaps-initalized t)) + (setq cua--keymaps-initialized t)) (if cua-mode (progn @@ -1596,7 +1608,8 @@ shifted movement key, set `cua-highlight-region-shift-only'." (interactive) (setq cua--debug (not cua--debug))) -(provide 'cua) + +(provide 'cua-base) ;;; arch-tag: 21fb6289-ba25-4fee-bfdc-f9fb351acf05 ;;; cua-base.el ends here diff --git a/lisp/emulation/cua-gmrk.el b/lisp/emulation/cua-gmrk.el index 504f59c4a06..be87804f196 100644 --- a/lisp/emulation/cua-gmrk.el +++ b/lisp/emulation/cua-gmrk.el @@ -27,8 +27,6 @@ ;;; Code: -(provide 'cua-gmrk) - (eval-when-compile (require 'cua-base) (require 'cua-rect) @@ -386,5 +384,7 @@ With prefix argument, don't jump to global mark when cancelling it." (setq cua--global-mark-initialized t)) +(provide 'cua-gmrk) + ;;; arch-tag: 553d8076-a91d-48ae-825d-6cb962a5f67f ;;; cua-gmrk.el ends here diff --git a/lisp/emulation/cua-rect.el b/lisp/emulation/cua-rect.el index 447f2a2ad78..93709f7660c 100644 --- a/lisp/emulation/cua-rect.el +++ b/lisp/emulation/cua-rect.el @@ -33,12 +33,8 @@ ;;; Code: -(provide 'cua-rect) - (eval-when-compile - (require 'cua-base) - (require 'cua-gmrk) -) + (require 'cua-base)) ;;; Rectangle support @@ -731,7 +727,7 @@ If command is repeated at same position, delete the rectangle." (defun cua--deactivate-rectangle () ;; This is used to clean up after `cua--activate-rectangle'. - (mapcar (function delete-overlay) cua--rectangle-overlays) + (mapc (function delete-overlay) cua--rectangle-overlays) (setq cua--last-rectangle (cons (current-buffer) (cons (point) ;; cua-save-point cua--rectangle)) @@ -837,7 +833,7 @@ If command is repeated at same position, delete the rectangle." (overlay-put overlay 'window (selected-window)) (setq new (cons overlay new)))))) ;; Trim old trailing overlays. - (mapcar (function delete-overlay) old) + (mapc (function delete-overlay) old) (setq cua--rectangle-overlays (nreverse new)))) (defun cua--indent-rectangle (&optional ch to-col clear) @@ -1061,6 +1057,9 @@ The text previously in the rectangle is overwritten by the blanks." ;; (setq cua-save-point (point)) )))) +(declare-function cua--cut-rectangle-to-global-mark "cua-gmrk" (as-text)) +(declare-function cua--copy-rectangle-to-global-mark "cua-gmrk" (as-text)) + (defun cua-copy-rectangle-as-text (&optional arg delete) "Copy rectangle, but store as normal text." (interactive "P") @@ -1401,7 +1400,7 @@ With prefix arg, indent to that column." (cua--deactivate-rectangle)) (when cua--rectangle-overlays ;; clean-up after revert-buffer - (mapcar (function delete-overlay) cua--rectangle-overlays) + (mapc (function delete-overlay) cua--rectangle-overlays) (setq cua--rectangle-overlays nil) (setq deactivate-mark t))) (when cua--rect-undo-set-point @@ -1491,5 +1490,7 @@ With prefix arg, indent to that column." (setq cua--rectangle-initialized t)) +(provide 'cua-rect) + ;;; arch-tag: b730df53-17b9-4a89-bd63-4a71ec196731 ;;; cua-rect.el ends here diff --git a/lisp/emulation/edt-mapper.el b/lisp/emulation/edt-mapper.el index acc9f165b13..79dabcc7433 100644 --- a/lisp/emulation/edt-mapper.el +++ b/lisp/emulation/edt-mapper.el @@ -118,17 +118,11 @@ ;;; Decide Emacs Variant, GNU Emacs or XEmacs (aka Lucid Emacs). ;;; Determine Window System, and X Server Vendor (if appropriate). ;;; -(defconst edt-x-emacs-p (string-match "XEmacs" emacs-version) - "Non-nil if we are running XEmacs version 19, or higher.") - -(defconst edt-emacs-variant (if edt-x-emacs-p "xemacs" "gnu") - "Indicates Emacs variant: GNU Emacs or XEmacs \(aka Lucid Emacs\).") - -(defconst edt-window-system (if edt-x-emacs-p (console-type) window-system) +(defconst edt-window-system (if (featurep 'xemacs) (console-type) window-system) "Indicates window system \(in GNU Emacs\) or console type \(in XEmacs\).") (defconst edt-xserver (if (eq edt-window-system 'x) - (if edt-x-emacs-p + (if (featurep 'xemacs) ;; The Cygwin window manager has a `/' in its ;; name, which breaks the generated file name of ;; the custom key map file. Replace `/' with a @@ -245,7 +239,7 @@ ;;; function-key-map. ;;; (cond - (edt-x-emacs-p + ((featurep 'xemacs) (setq edt-return-seq (read-key-sequence "Hit carriage-return <CR> to continue ")) (setq edt-return (concat "[" (format "%s" (event-key (aref edt-return-seq 0))) "]"))) (t @@ -327,40 +321,37 @@ ;;; ;;; Key mapping functions ;;; -(defun edt-lucid-map-key (ident descrip) - (interactive) - (setq edt-key-seq (read-key-sequence (format "Press %s%s: " ident descrip))) - (setq edt-key (concat "[" (format "%s" (event-key (aref edt-key-seq 0))) "]")) - (cond ((not (equal edt-key edt-return)) - (set-buffer "Keys") - (insert (format " (\"%s\" . %s)\n" ident edt-key)) - (set-buffer "Directions")) - ;; bogosity to get next prompt to come up, if the user hits <CR>! - ;; check periodically to see if this is still needed... - (t - (set-buffer "Keys") - (insert (format " (\"%s\" . \"\" )\n" ident)) - (set-buffer "Directions"))) - edt-key) - -(defun edt-gnu-map-key (ident descrip) +(defun edt-map-key (ident descrip) (interactive) - (setq edt-key (read-key-sequence (format "Press %s%s: " ident descrip))) - (cond ((not (equal edt-key edt-return)) - (set-buffer "Keys") - (insert (if (vectorp edt-key) - (format " (\"%s\" . %s)\n" ident edt-key) - (format " (\"%s\" . \"%s\")\n" ident edt-key))) - (set-buffer "Directions")) - ;; bogosity to get next prompt to come up, if the user hits <CR>! - ;; check periodically to see if this is still needed... - (t - (set-buffer "Keys") - (insert (format " (\"%s\" . \"\" )\n" ident)) - (set-buffer "Directions"))) + (if (featurep 'xemacs) + (progn + (setq edt-key-seq (read-key-sequence (format "Press %s%s: " ident descrip))) + (setq edt-key (concat "[" (format "%s" (event-key (aref edt-key-seq 0))) "]")) + (cond ((not (equal edt-key edt-return)) + (set-buffer "Keys") + (insert (format " (\"%s\" . %s)\n" ident edt-key)) + (set-buffer "Directions")) + ;; bogosity to get next prompt to come up, if the user hits <CR>! + ;; check periodically to see if this is still needed... + (t + (set-buffer "Keys") + (insert (format " (\"%s\" . \"\" )\n" ident)) + (set-buffer "Directions")))) + (setq edt-key (read-key-sequence (format "Press %s%s: " ident descrip))) + (cond ((not (equal edt-key edt-return)) + (set-buffer "Keys") + (insert (if (vectorp edt-key) + (format " (\"%s\" . %s)\n" ident edt-key) + (format " (\"%s\" . \"%s\")\n" ident edt-key))) + (set-buffer "Directions")) + ;; bogosity to get next prompt to come up, if the user hits <CR>! + ;; check periodically to see if this is still needed... + (t + (set-buffer "Keys") + (insert (format " (\"%s\" . \"\" )\n" ident)) + (set-buffer "Directions")))) edt-key) -(fset 'edt-map-key (if edt-x-emacs-p 'edt-lucid-map-key 'edt-gnu-map-key)) (set-buffer "Keys") (insert " ;; @@ -494,7 +485,7 @@ ;;; ;;; Restore function-key-map. ;;; -(if (and edt-window-system (not edt-x-emacs-p)) +(if (and edt-window-system (not (featurep 'xemacs))) (setq function-key-map edt-save-function-key-map)) (setq EDT-key-name "") (while (not @@ -517,7 +508,7 @@ ;;; Save the key mapping file ;;; (let ((file (concat - "~/.edt-" edt-emacs-variant + "~/.edt-" (if (featurep 'xemacs) "xemacs" "gnu") (if edt-term (concat "-" edt-term)) (if edt-xserver (concat "-" edt-xserver)) (if edt-window-system (concat "-" (upcase (symbol-name edt-window-system)))) diff --git a/lisp/emulation/edt-vt100.el b/lisp/emulation/edt-vt100.el index c2a778d3a0d..e534927adc2 100644 --- a/lisp/emulation/edt-vt100.el +++ b/lisp/emulation/edt-vt100.el @@ -39,6 +39,8 @@ ;; The following functions are called by the EDT screen width commands defined ;; in edt.el. +(declare-function vt100-wide-mode "../term/vt100" (&optional arg)) + (defun edt-set-term-width-80 () "Set terminal width to 80 columns." (vt100-wide-mode -1)) diff --git a/lisp/emulation/edt.el b/lisp/emulation/edt.el index 880bc0b55c6..eca3ce0f400 100644 --- a/lisp/emulation/edt.el +++ b/lisp/emulation/edt.el @@ -166,28 +166,23 @@ ;;;; 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 @@ -198,11 +193,6 @@ ;;; 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 @@ -321,24 +311,14 @@ 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-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 + (if (featurep 'xemacs) ;; The Cygwin window manager has a `/' in its ;; name, which breaks the generated file name of ;; the custom key map file. Replace `/' with a @@ -409,7 +389,7 @@ Argument NUM is the number of page delimiters to move." (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. @@ -470,7 +450,7 @@ Argument NUM is the number of BOL marks to move." (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))) ;;; @@ -486,7 +466,7 @@ Argument NUM is the number of EOL marks to move." (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) @@ -497,7 +477,7 @@ Argument NUM is the number of EOL marks to move." (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) @@ -542,7 +522,7 @@ Argument NUM is the number of EOL marks to move." (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." @@ -566,7 +546,7 @@ Argument NUM is the number of EOL marks to move." (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. @@ -606,7 +586,7 @@ Argument NUM is the number of characters to move." (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 @@ -629,7 +609,7 @@ Argument NUM is the number of BOL marks to move." (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. @@ -649,9 +629,9 @@ Argument NUM is the number of lines to move." (interactive "p") (edt-check-prefix num) (let ((beg (edt-current-line))) - (next-line num) + (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-previous-line (num) "Move cursor up one line. @@ -659,9 +639,9 @@ Argument NUM is the number of lines to move." (interactive "p") (edt-check-prefix num) (let ((beg (edt-current-line))) - (previous-line num) + (forward-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))) ;;; @@ -672,7 +652,7 @@ Argument NUM is the number of lines to move." "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 @@ -718,7 +698,7 @@ Optional argument FIND is t is this function is called from `edt-find'." (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. @@ -743,7 +723,7 @@ Optional argument FIND is t if this function is called from `edt-find'." (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." @@ -789,7 +769,7 @@ Optional argument FIND is t if this function is called from `edt-find'." (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." @@ -813,7 +793,7 @@ Optional argument FIND is t if this function is called from `edt-find'." (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." @@ -891,7 +871,7 @@ In select mode, selected text is highlighted." (defun edt-reset () "Cancel text selection." (interactive) - (if edt-gnu-emacs19-p + (if (featurep 'emacs) (deactivate-mark) (zmacs-deactivate-region))) @@ -1108,7 +1088,7 @@ Also, execute command specified if in Minibuffer." (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))) ;;; @@ -1124,7 +1104,7 @@ Also, execute command specified if in Minibuffer." (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))) ;;; @@ -1174,12 +1154,12 @@ 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 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") @@ -1259,7 +1239,7 @@ 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 edt-x-emacs19-p (> (+ beg lines 1) difference)) + ((and (featurep 'xemacs) (> (+ beg lines 1) difference)) (recenter (- margin))) ((> (+ beg lines) difference) (recenter (- margin)))))) @@ -1363,7 +1343,7 @@ Argument NUM is the positive number of sentences to move." (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. @@ -1389,7 +1369,7 @@ Argument NUM is the positive number of sentences to move." (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. @@ -1426,7 +1406,7 @@ Argument NUM is the positive number of paragraphs to move." (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))) @@ -1434,7 +1414,7 @@ Argument NUM is the positive number of paragraphs to move." (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. @@ -1459,7 +1439,7 @@ Argument NUM is the positive number of paragraphs to move." (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. @@ -1477,20 +1457,20 @@ 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 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." @@ -1507,7 +1487,7 @@ Definition is stored in `edt-last-replaced-key-definition'." (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 @@ -1519,7 +1499,7 @@ Definition is stored in `edt-last-replaced-key-definition'." (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 @@ -1529,13 +1509,13 @@ Definition is stored in `edt-last-replaced-key-definition'." "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." @@ -1582,7 +1562,7 @@ Argument NUM is the positive number of windows to move." "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 @@ -1592,7 +1572,7 @@ Argument NUM is the positive number of windows to move." "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 @@ -1602,7 +1582,7 @@ Argument NUM is the positive number of windows to move." "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 @@ -1615,7 +1595,7 @@ Argument NUM is the percentage into the buffer to move." (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 @@ -1638,6 +1618,8 @@ Argument NUM is the percentage into the buffer to move." (indent-region (point) (mark) nil) (fill-region (point) (mark)))) + +(declare-function c-mark-function "cc-cmds" ()) ;;; ;;; MARK SECTION WISELY ;;; @@ -1785,7 +1767,7 @@ Argument NUM is the number of times to duplicate the line." (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))) ;;; @@ -1813,7 +1795,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 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") @@ -1866,7 +1848,7 @@ Warn user that modifications will be lost." (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 @@ -2152,7 +2134,7 @@ created." (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 @@ -2188,7 +2170,7 @@ created." (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")) @@ -2203,7 +2185,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 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) @@ -2239,7 +2221,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 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 @@ -2247,13 +2229,16 @@ Optional argument USER-SETUP non-nil means called from function ;; 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) @@ -2271,7 +2256,7 @@ Optional argument USER-SETUP non-nil means called from function (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) diff --git a/lisp/emulation/pc-select.el b/lisp/emulation/pc-select.el index 111ff5e295d..956c61ee098 100644 --- a/lisp/emulation/pc-select.el +++ b/lisp/emulation/pc-select.el @@ -135,8 +135,8 @@ restored to their original values when PC Selection mode is toggled off.") (unless pc-select-default-key-bindings (let ((lst - ;; This is to avoid confusion with the delete-selection-mode - ;; On simple displays you cant see that a region is active and + ;; This is to avoid confusion with the delete-selection-mode. + ;; On simple displays you can't see that a region is active and ;; will be deleted on the next keypress IMHO especially for ;; copy-region-as-kill this is confusing. ;; The same goes for exchange-point-and-mark @@ -182,7 +182,7 @@ restored to their original values when PC Selection mode is toggled off.") ([prior] . scroll-down-nomark) ;; Next four lines are from Pete Forman. - ([C-down] . forward-paragraph-nomark) ; KNextPara cDn + ([C-down] . forward-paragraph-nomark) ; KNextPara cDn ([C-up] . backward-paragraph-nomark) ; KPrevPara cUp ([S-C-down] . forward-paragraph-mark) ([S-C-up] . backward-paragraph-mark)))) @@ -281,10 +281,17 @@ and `transient-mark-mode'." ;;;; ;; non-interactive ;;;; -(defun ensure-mark() +(defun pc-select-ensure-mark () ;; make sure mark is active ;; test if it is active, if it isn't, set it and activate it - (or mark-active (set-mark-command nil))) + (or mark-active (set-mark-command nil)) + ;; Remember who activated the mark. + (setq mark-active 'pc-select)) + +(defun pc-select-maybe-deactivate-mark () + ;; maybe switch off mark (only if *we* switched it on) + (when (eq mark-active 'pc-select) + (deactivate-mark))) ;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;; forward and mark @@ -294,7 +301,7 @@ and `transient-mark-mode'." "Ensure mark is active; move point right ARG characters (left if ARG negative). On reaching end of buffer, stop and signal error." (interactive "p") - (ensure-mark) + (pc-select-ensure-mark) (forward-char arg)) (defun forward-word-mark (&optional arg) @@ -303,13 +310,13 @@ Normally returns t. If an edge of the buffer is reached, point is left there and nil is returned." (interactive "p") - (ensure-mark) + (pc-select-ensure-mark) (forward-word arg)) (defun forward-line-mark (&optional arg) "Ensure mark is active; move cursor vertically down ARG lines." (interactive "p") - (ensure-mark) + (pc-select-ensure-mark) (forward-line arg) (setq this-command 'forward-line) ) @@ -319,7 +326,7 @@ and nil is returned." With argument, do it that many times. Negative arg -N means move backward across N balanced expressions." (interactive "p") - (ensure-mark) + (pc-select-ensure-mark) (forward-sexp arg)) (defun forward-paragraph-mark (&optional arg) @@ -331,7 +338,7 @@ A line which `paragraph-start' matches either separates paragraphs A paragraph end is the beginning of a line which is not part of the paragraph to which the end of the previous line belongs, or the end of the buffer." (interactive "p") - (ensure-mark) + (pc-select-ensure-mark) (forward-paragraph arg)) (defun next-line-mark (&optional arg) @@ -350,8 +357,8 @@ a semipermanent goal column to which this command always moves. Then it does not try to move vertically. This goal column is stored in `goal-column', which is nil when there is none." (interactive "p") - (ensure-mark) - (next-line arg) + (pc-select-ensure-mark) + (with-no-warnings (next-line arg)) (setq this-command 'next-line)) (defun end-of-line-mark (&optional arg) @@ -359,14 +366,14 @@ in `goal-column', which is nil when there is none." With argument ARG not nil or 1, move forward ARG - 1 lines first. If scan reaches end of buffer, stop there without error." (interactive "p") - (ensure-mark) + (pc-select-ensure-mark) (end-of-line arg) (setq this-command 'end-of-line)) (defun backward-line-mark (&optional arg) "Ensure mark is active; move cursor vertically up ARG lines." (interactive "p") - (ensure-mark) + (pc-select-ensure-mark) (if (null arg) (setq arg 1)) (forward-line (- arg)) @@ -379,7 +386,7 @@ A near full screen is `next-screen-context-lines' less than a full screen. Negative ARG means scroll upward. When calling from a program, supply a number as argument or nil." (interactive "P") - (ensure-mark) + (pc-select-ensure-mark) (cond (pc-select-override-scroll-error (condition-case nil (scroll-down arg) (beginning-of-buffer (goto-char (point-min))))) @@ -395,7 +402,7 @@ of the accessible part of the buffer. Don't use this command in Lisp programs! \(goto-char \(point-max)) is faster and avoids clobbering the mark." (interactive "P") - (ensure-mark) + (pc-select-ensure-mark) (let ((size (- (point-max) (point-min)))) (goto-char (if arg (- (point-max) @@ -427,7 +434,7 @@ Don't use this command in Lisp programs! "Deactivate mark; move point right ARG characters \(left if ARG negative). On reaching end of buffer, stop and signal error." (interactive "p") - (setq mark-active nil) + (pc-select-maybe-deactivate-mark) (forward-char arg)) (defun forward-word-nomark (&optional arg) @@ -436,13 +443,13 @@ Normally returns t. If an edge of the buffer is reached, point is left there and nil is returned." (interactive "p") - (setq mark-active nil) + (pc-select-maybe-deactivate-mark) (forward-word arg)) (defun forward-line-nomark (&optional arg) "Deactivate mark; move cursor vertically down ARG lines." (interactive "p") - (setq mark-active nil) + (pc-select-maybe-deactivate-mark) (forward-line arg) (setq this-command 'forward-line) ) @@ -452,7 +459,7 @@ and nil is returned." With argument, do it that many times. Negative arg -N means move backward across N balanced expressions." (interactive "p") - (setq mark-active nil) + (pc-select-maybe-deactivate-mark) (forward-sexp arg)) (defun forward-paragraph-nomark (&optional arg) @@ -464,7 +471,7 @@ A line which `paragraph-start' matches either separates paragraphs A paragraph end is the beginning of a line which is not part of the paragraph to which the end of the previous line belongs, or the end of the buffer." (interactive "p") - (setq mark-active nil) + (pc-select-maybe-deactivate-mark) (forward-paragraph arg)) (defun next-line-nomark (&optional arg) @@ -483,8 +490,8 @@ a semipermanent goal column to which this command always moves. Then it does not try to move vertically. This goal column is stored in `goal-column', which is nil when there is none." (interactive "p") - (setq mark-active nil) - (next-line arg) + (pc-select-maybe-deactivate-mark) + (with-no-warnings (next-line arg)) (setq this-command 'next-line)) (defun end-of-line-nomark (&optional arg) @@ -492,14 +499,14 @@ in `goal-column', which is nil when there is none." With argument ARG not nil or 1, move forward ARG - 1 lines first. If scan reaches end of buffer, stop there without error." (interactive "p") - (setq mark-active nil) + (pc-select-maybe-deactivate-mark) (end-of-line arg) (setq this-command 'end-of-line)) (defun backward-line-nomark (&optional arg) "Deactivate mark; move cursor vertically up ARG lines." (interactive "p") - (setq mark-active nil) + (pc-select-maybe-deactivate-mark) (if (null arg) (setq arg 1)) (forward-line (- arg)) @@ -512,7 +519,7 @@ A near full screen is `next-screen-context-lines' less than a full screen. Negative ARG means scroll upward. When calling from a program, supply a number as argument or nil." (interactive "P") - (setq mark-active nil) + (pc-select-maybe-deactivate-mark) (cond (pc-select-override-scroll-error (condition-case nil (scroll-down arg) (beginning-of-buffer (goto-char (point-min))))) @@ -528,7 +535,7 @@ of the accessible part of the buffer. Don't use this command in Lisp programs! \(goto-char (point-max)) is faster and avoids clobbering the mark." (interactive "P") - (setq mark-active nil) + (pc-select-maybe-deactivate-mark) (let ((size (- (point-max) (point-min)))) (goto-char (if arg (- (point-max) @@ -561,14 +568,14 @@ Don't use this command in Lisp programs! "Ensure mark is active; move point left ARG characters (right if ARG negative). On attempt to pass beginning or end of buffer, stop and signal error." (interactive "p") - (ensure-mark) + (pc-select-ensure-mark) (backward-char arg)) (defun backward-word-mark (&optional arg) "Ensure mark is active; move backward until encountering the end of a word. With argument, do this that many times." (interactive "p") - (ensure-mark) + (pc-select-ensure-mark) (backward-word arg)) (defun backward-sexp-mark (&optional arg) @@ -576,7 +583,7 @@ With argument, do this that many times." With argument, do it that many times. Negative arg -N means move forward across N balanced expressions." (interactive "p") - (ensure-mark) + (pc-select-ensure-mark) (backward-sexp arg)) (defun backward-paragraph-mark (&optional arg) @@ -591,7 +598,7 @@ blank line. See `forward-paragraph' for more information." (interactive "p") - (ensure-mark) + (pc-select-ensure-mark) (backward-paragraph arg)) (defun previous-line-mark (&optional arg) @@ -608,8 +615,8 @@ If you are thinking of using this in a Lisp program, consider using `forward-line' with a negative argument instead. It is usually easier to use and more reliable (no dependence on goal column, etc.)." (interactive "p") - (ensure-mark) - (previous-line arg) + (pc-select-ensure-mark) + (with-no-warnings (previous-line arg)) (setq this-command 'previous-line)) (defun beginning-of-line-mark (&optional arg) @@ -617,7 +624,7 @@ to use and more reliable (no dependence on goal column, etc.)." With argument ARG not nil or 1, move forward ARG - 1 lines first. If scan reaches end of buffer, stop there without error." (interactive "p") - (ensure-mark) + (pc-select-ensure-mark) (beginning-of-line arg)) @@ -627,7 +634,7 @@ A near full screen is `next-screen-context-lines' less than a full screen. Negative ARG means scroll downward. When calling from a program, supply a number as argument or nil." (interactive "P") - (ensure-mark) + (pc-select-ensure-mark) (cond (pc-select-override-scroll-error (condition-case nil (scroll-up arg) (end-of-buffer (goto-char (point-max))))) @@ -643,7 +650,7 @@ of the accessible part of the buffer. Don't use this command in Lisp programs! \(goto-char (p\oint-min)) is faster and avoids clobbering the mark." (interactive "P") - (ensure-mark) + (pc-select-ensure-mark) (let ((size (- (point-max) (point-min)))) (goto-char (if arg (+ (point-min) @@ -663,14 +670,14 @@ Don't use this command in Lisp programs! "Deactivate mark; move point left ARG characters (right if ARG negative). On attempt to pass beginning or end of buffer, stop and signal error." (interactive "p") - (setq mark-active nil) + (pc-select-maybe-deactivate-mark) (backward-char arg)) (defun backward-word-nomark (&optional arg) "Deactivate mark; move backward until encountering the end of a word. With argument, do this that many times." (interactive "p") - (setq mark-active nil) + (pc-select-maybe-deactivate-mark) (backward-word arg)) (defun backward-sexp-nomark (&optional arg) @@ -678,7 +685,7 @@ With argument, do this that many times." With argument, do it that many times. Negative arg -N means move forward across N balanced expressions." (interactive "p") - (setq mark-active nil) + (pc-select-maybe-deactivate-mark) (backward-sexp arg)) (defun backward-paragraph-nomark (&optional arg) @@ -693,7 +700,7 @@ blank line. See `forward-paragraph' for more information." (interactive "p") - (setq mark-active nil) + (pc-select-maybe-deactivate-mark) (backward-paragraph arg)) (defun previous-line-nomark (&optional arg) @@ -706,8 +713,8 @@ The command \\[set-goal-column] can be used to create a semipermanent goal column to which this command always moves. Then it does not try to move vertically." (interactive "p") - (setq mark-active nil) - (previous-line arg) + (pc-select-maybe-deactivate-mark) + (with-no-warnings (previous-line arg)) (setq this-command 'previous-line)) (defun beginning-of-line-nomark (&optional arg) @@ -715,7 +722,7 @@ Then it does not try to move vertically." With argument ARG not nil or 1, move forward ARG - 1 lines first. If scan reaches end of buffer, stop there without error." (interactive "p") - (setq mark-active nil) + (pc-select-maybe-deactivate-mark) (beginning-of-line arg)) (defun scroll-up-nomark (&optional arg) @@ -724,7 +731,7 @@ A near full screen is `next-screen-context-lines' less than a full screen. Negative ARG means scroll downward. When calling from a program, supply a number as argument or nil." (interactive "P") - (setq mark-active nil) + (pc-select-maybe-deactivate-mark) (cond (pc-select-override-scroll-error (condition-case nil (scroll-up arg) (end-of-buffer (goto-char (point-max))))) @@ -740,7 +747,7 @@ of the accessible part of the buffer. Don't use this command in Lisp programs! \(goto-char (point-min)) is faster and avoids clobbering the mark." (interactive "P") - (setq mark-active nil) + (pc-select-maybe-deactivate-mark) (let ((size (- (point-max) (point-min)))) (goto-char (if arg (+ (point-min) @@ -968,21 +975,5 @@ but before calling PC Selection mode): (setq pc-select-key-bindings-alist nil pc-select-saved-settings-alist nil)))) - -;;;###autoload -(defcustom pc-selection-mode nil - "Toggle PC Selection mode. -Change mark behavior to emulate Motif, MAC or MS-Windows cut and paste style, -and cursor movement commands. -This mode enables Delete Selection mode and Transient Mark mode. -Setting this variable directly does not take effect; -you must modify it using \\[customize] or \\[pc-selection-mode]." - :set (lambda (symbol value) - (pc-selection-mode (if value 1 -1))) - :initialize 'custom-initialize-default - :type 'boolean - :group 'pc-select - :require 'pc-select) - -;;; arch-tag: 10697b70-ae07-4f3e-ad23-7814a3f418c2 +;; arch-tag: 10697b70-ae07-4f3e-ad23-7814a3f418c2 ;;; pc-select.el ends here diff --git a/lisp/emulation/tpu-edt.el b/lisp/emulation/tpu-edt.el index 62e0420de1c..686a79c9350 100644 --- a/lisp/emulation/tpu-edt.el +++ b/lisp/emulation/tpu-edt.el @@ -66,11 +66,10 @@ ;; style keyboards. VT terminal emulators, including xterm with the ;; appropriate key translations, work just fine too. -;; TPU-edt works with X-windows. This is accomplished through a TPU-edt X -;; key map. The TPU-edt module tpu-mapper creates this map and stores it -;; in a file. Tpu-mapper will be run automatically the first time you -;; invoke the X-windows version of emacs, or you can run it by hand. See -;; the commentary in tpu-mapper.el for details. +;; TPU-edt works with X-windows. This is accomplished through a TPU-edt +;; X key map. The tpu-mapper command creates this map and stores it in a +;; file. See the tpu-mapper command help for more information, or just +;; run it and follow the directions. ;; %% Differences Between TPU-edt and DEC TPU/edt @@ -80,7 +79,7 @@ ;; mark". The mark is set at one end of a selected region; the cursor is ;; at the other. In cases where the selected region cannot be shown in ;; inverse video an at sign (@) appears in the mode line when mark is set. -;; The native emacs command ^X^X (Control-X twice) exchanges the cursor +;; The native Emacs command ^X^X (Control-X twice) exchanges the cursor ;; with the mark; this provides a handy way to find the location of the ;; mark. @@ -92,8 +91,8 @@ ;; approximation of free mode, see the commentary in tpu-extras.el for ;; details. -;; Like TPU, emacs uses multiple buffers. Some buffers are used to hold -;; files you are editing; other "internal" buffers are used for emacs' own +;; Like TPU, Emacs uses multiple buffers. Some buffers are used to hold +;; files you are editing; other "internal" buffers are used for Emacs' own ;; purposes (like showing you help). Here are some commands for dealing ;; with buffers. @@ -115,9 +114,9 @@ ;; Note that the buffers associated with deleted windows still exist! ;; Like TPU, TPU-edt has a "command" function, invoked with Gold-KP7 or -;; Do. Most of the commands available are emacs commands. Some TPU +;; Do. Most of the commands available are Emacs commands. Some TPU ;; commands are available, they are: replace, exit, quit, include, and -;; Get (unfortunately, "get" is an internal emacs function, so we are +;; Get (unfortunately, "get" is an internal Emacs function, so we are ;; stuck with "Get" - to make life easier, Get is available as Gold-g). ;; TPU-edt supports the recall of commands, file names, and search @@ -128,10 +127,10 @@ ;; a small help file showing the default keypad layout, control key ;; functions, and Gold key functions. Pressing any key inside of help ;; splits the screen and prints a description of the function of the -;; pressed key. Gold-PF2 invokes the native emacs help, with its +;; pressed key. Gold-PF2 invokes the native Emacs help, with its ;; zillions of options. -;; Thanks to emacs, TPU-edt has some extensions that may make your life +;; Thanks to Emacs, TPU-edt has some extensions that may make your life ;; easier, or at least more interesting. For example, Gold-r toggles ;; TPU-edt rectangular mode. In rectangular mode, Remove and Insert work ;; on rectangles. Likewise, Gold-* toggles TPU-edt regular expression @@ -147,27 +146,27 @@ ;; twice) on a particular line moves you back to the original window ;; at that line. Occur is on Gold-o. -;; Finally, as you edit, remember that all the power of emacs is at +;; Finally, as you edit, remember that all the power of Emacs is at ;; your disposal. It really is a fantastic tool. You may even want to -;; take some time and read the emacs tutorial; perhaps not to learn the -;; native emacs key bindings, but to get a feel for all the things -;; emacs can do for you. The emacs tutorial is available from the -;; emacs help function: "Gold-PF2 t" +;; take some time and read the Emacs tutorial; perhaps not to learn the +;; native Emacs key bindings, but to get a feel for all the things +;; Emacs can do for you. The Emacs tutorial is available from the +;; Emacs help function: "Gold-PF2 t" ;; %% Starting TPU-edt ;; All you have to do to start TPU-edt, is turn it on. This can be -;; done from the command line when running emacs. +;; done from the command line when running Emacs. ;; prompt> emacs -f tpu-edt -;; If you've already started emacs, turn on TPU-edt using the tpu-edt +;; If you've already started Emacs, turn on TPU-edt using the tpu-edt ;; command. First press `M-x' (that's usually `ESC' followed by `x') ;; and type `tpu-edt' followed by a carriage return. ;; If you like TPU-edt and want to use it all the time, you can start -;; TPU-edt using the emacs initialization file, .emacs. Simply create +;; TPU-edt using the Emacs initialization file, .emacs. Simply create ;; a .emacs file in your home directory containing the line: ;; (tpu-edt) @@ -177,10 +176,10 @@ ;; %% Customizing TPU-edt using the Emacs Initialization File -;; The following is a sample emacs initialization file. It shows how to +;; The following is a sample Emacs initialization file. It shows how to ;; invoke TPU-edt, and how to customize it. -;; ; .emacs - a sample emacs initialization file +;; ; .emacs - a sample Emacs initialization file ;; ; Turn on TPU-edt ;; (tpu-edt) @@ -200,23 +199,23 @@ ;; (setq require-final-newline t) ;; ; Emacs uses Control-s and Control-q. Problems can occur when using -;; ; emacs on terminals that use these codes for flow control (Xon/Xoff -;; ; flow control). These lines disable emacs' use of these characters. +;; ; Emacs on terminals that use these codes for flow control (Xon/Xoff +;; ; flow control). These lines disable Emacs' use of these characters. ;; (global-unset-key "\C-s") ;; (global-unset-key "\C-q") -;; ; The emacs universal-argument function is very useful. +;; ; The Emacs universal-argument function is very useful. ;; ; This line maps universal-argument to Gold-PF1. -;; (define-key GOLD-SS3-map "P" 'universal-argument) ; Gold-PF1 +;; (define-key tpu-gold-map [kp_f1] 'universal-argument) ; Gold-PF1 ;; ; Make KP7 move by paragraphs, instead of pages. -;; (define-key SS3-map "w" 'tpu-paragraph) ; KP7 +;; (define-key tpu-global-map [kf_7] 'tpu-paragraph) ; KP7 ;; ; Repeat the preceding mappings for X-windows. ;; (cond ;; (window-system -;; (global-set-key [kp_7] 'tpu-paragraph) ; KP7 -;; (define-key GOLD-map [kp_f1] 'universal-argument))) ; GOLD-PF1 +;; (define-key tpu-global-map [kp_7] 'tpu-paragraph) ; KP7 +;; (define-key tpu-gold-map [kp_f1] 'universal-argument))) ; GOLD-PF1 ;; ; Display the TPU-edt version. ;; (tpu-version) @@ -225,9 +224,9 @@ ;; %% Regular Expressions in TPU-edt ;; Gold-* toggles TPU-edt regular expression mode. In regular expression -;; mode, find, find next, replace, and substitute accept emacs regular -;; expressions. A complete list of emacs regular expressions can be found -;; using the emacs "info" command (it's somewhat like the VMS help +;; mode, find, find next, replace, and substitute accept Emacs regular +;; expressions. A complete list of Emacs regular expressions can be found +;; using the Emacs "info" command (it's somewhat like the VMS help ;; command). Try the following sequence of commands: ;; DO info <enter info mode> @@ -256,13 +255,13 @@ ;; Gold-^ Add a string at BOL in region or buffer ;; Gold-$ Add a string at EOL in region or buffer -;; There is also a TPU-edt interface to the native emacs string replacement +;; There is also a TPU-edt interface to the native Emacs string replacement ;; commands. Gold-/ invokes this command. It accepts regular expressions ;; if TPU-edt is in regular expression mode. Given a repeat count, it will ;; perform the replacement without prompting for confirmation. ;; This command replaces empty strings correctly, however, it has its -;; drawbacks. As a native emacs command, it has a different interface +;; drawbacks. As a native Emacs command, it has a different interface ;; than the emulated TPU commands. Also, it works only in the forward ;; direction, regardless of the current TPU-edt direction. @@ -273,7 +272,6 @@ ;;; Code: -(eval-when-compile (require 'cl)) ;; we use picture-mode functions (require 'picture) @@ -293,309 +291,275 @@ ;;; User Configurable Variables ;;; (defcustom tpu-have-ispell t - "*If non-nil (default), TPU-edt uses ispell for spell checking." + "If non-nil (default), TPU-edt uses Ispell for spell checking." :type 'boolean :group 'tpu) (defcustom tpu-kill-buffers-silently nil - "*If non-nil, TPU-edt kills modified buffers without asking." + "If non-nil, TPU-edt kills modified buffers without asking." :type 'boolean :group 'tpu) (defcustom tpu-percent-scroll 75 - "*Percentage of the screen to scroll for next/previous screen commands." + "Percentage of the screen to scroll for next/previous screen commands." :type 'integer :group 'tpu) (defcustom tpu-pan-columns 16 - "*Number of columns the tpu-pan functions scroll left or right." + "Number of columns the tpu-pan functions scroll left or right." :type 'integer :group 'tpu) ;;; -;;; Emacs version identifiers - currently referenced by -;;; -;;; o tpu-mark o tpu-set-mark -;;; o mode line section o tpu-load-xkeys -;;; -(defconst tpu-lucid-emacs-p - (string-match "Lucid" emacs-version) - "Non-nil if we are running Lucid Emacs.") - -;;; ;;; Global Keymaps ;;; -(defvar CSI-map - (let ((map (make-sparse-keymap))) - (define-key map "A" 'tpu-previous-line) ; up - (define-key map "B" 'tpu-next-line) ; down - (define-key map "D" 'tpu-backward-char) ; left - (define-key map "C" 'tpu-forward-char) ; right - - (define-key map "1~" 'tpu-search) ; Find - (define-key map "2~" 'tpu-paste) ; Insert Here - (define-key map "3~" 'tpu-cut) ; Remove - (define-key map "4~" 'tpu-select) ; Select - (define-key map "5~" 'tpu-scroll-window-down) ; Prev Screen - (define-key map "6~" 'tpu-scroll-window-up) ; Next Screen - - (define-key map "11~" 'nil) ; F1 - (define-key map "12~" 'nil) ; F2 - (define-key map "13~" 'nil) ; F3 - (define-key map "14~" 'nil) ; F4 - (define-key map "15~" 'nil) ; F5 - (define-key map "17~" 'nil) ; F6 - (define-key map "18~" 'nil) ; F7 - (define-key map "19~" 'nil) ; F8 - (define-key map "20~" 'nil) ; F9 - (define-key map "21~" 'tpu-exit) ; F10 - (define-key map "23~" 'tpu-insert-escape) ; F11 (ESC) - (define-key map "24~" 'tpu-next-beginning-of-line) ; F12 (BS) - (define-key map "25~" 'tpu-delete-previous-word) ; F13 (LF) - (define-key map "26~" 'tpu-toggle-overwrite-mode) ; F14 - (define-key map "28~" 'tpu-help) ; HELP - (define-key map "29~" 'execute-extended-command) ; DO - (define-key map "31~" 'tpu-goto-breadcrumb) ; F17 - (define-key map "32~" 'nil) ; F18 - (define-key map "33~" 'nil) ; F19 - (define-key map "34~" 'nil) ; F20 - map) - "Maps the CSI function keys on the VT100 keyboard. -CSI is DEC's name for the sequence <ESC>[.") -(defvar GOLD-CSI-map - (let ((map (make-sparse-keymap))) - (define-key map "A" 'tpu-move-to-beginning) ; up-arrow - (define-key map "B" 'tpu-move-to-end) ; down-arrow - (define-key map "C" 'end-of-line) ; right-arrow - (define-key map "D" 'beginning-of-line) ; left-arrow - - (define-key map "1~" 'nil) ; Find - (define-key map "2~" 'nil) ; Insert Here - (define-key map "3~" 'tpu-store-text) ; Remove - (define-key map "4~" 'tpu-unselect) ; Select - (define-key map "5~" 'tpu-previous-window) ; Prev Screen - (define-key map "6~" 'tpu-next-window) ; Next Screen - - (define-key map "11~" 'nil) ; F1 - (define-key map "12~" 'nil) ; F2 - (define-key map "13~" 'nil) ; F3 - (define-key map "14~" 'nil) ; F4 - (define-key map "16~" 'nil) ; F5 - (define-key map "17~" 'nil) ; F6 - (define-key map "18~" 'nil) ; F7 - (define-key map "19~" 'nil) ; F8 - (define-key map "20~" 'nil) ; F9 - (define-key map "21~" 'nil) ; F10 - (define-key map "23~" 'nil) ; F11 - (define-key map "24~" 'nil) ; F12 - (define-key map "25~" 'nil) ; F13 - (define-key map "26~" 'nil) ; F14 - (define-key map "28~" 'describe-bindings) ; HELP - (define-key map "29~" 'nil) ; DO - (define-key map "31~" 'tpu-drop-breadcrumb) ; F17 - (define-key map "32~" 'nil) ; F18 - (define-key map "33~" 'nil) ; F19 - (define-key map "34~" 'nil) ; F20 - map) - "Maps the function keys on the VT100 keyboard preceded by GOLD-CSI.") - -(defvar GOLD-SS3-map - (let ((map (make-sparse-keymap))) - (define-key map "A" 'tpu-move-to-beginning) ; up-arrow - (define-key map "B" 'tpu-move-to-end) ; down-arrow - (define-key map "C" 'end-of-line) ; right-arrow - (define-key map "D" 'beginning-of-line) ; left-arrow - - (define-key map "P" 'keyboard-quit) ; PF1 - (define-key map "Q" 'help-for-help) ; PF2 - (define-key map "R" 'tpu-search) ; PF3 - (define-key map "S" 'tpu-undelete-lines) ; PF4 - (define-key map "p" 'open-line) ; KP0 - (define-key map "q" 'tpu-change-case) ; KP1 - (define-key map "r" 'tpu-delete-to-eol) ; KP2 - (define-key map "s" 'tpu-special-insert) ; KP3 - (define-key map "t" 'tpu-move-to-end) ; KP4 - (define-key map "u" 'tpu-move-to-beginning) ; KP5 - (define-key map "v" 'tpu-paste) ; KP6 - (define-key map "w" 'execute-extended-command) ; KP7 - (define-key map "x" 'tpu-fill) ; KP8 - (define-key map "y" 'tpu-replace) ; KP9 - (define-key map "m" 'tpu-undelete-words) ; KP- - (define-key map "l" 'tpu-undelete-char) ; KP, - (define-key map "n" 'tpu-unselect) ; KP. - (define-key map "M" 'tpu-substitute) ; KPenter - map) - "Maps the function keys on the VT100 keyboard preceded by GOLD-SS3.") - -(defvar GOLD-map +(defvar tpu-gold-map (let ((map (make-keymap))) - (define-key map "\e[" GOLD-CSI-map) ; GOLD-CSI map - (define-key map "\eO" GOLD-SS3-map) ; GOLD-SS3 map + ;; Previously we used escape sequences here. We now instead presume + ;; that term/*.el does its job to map the escape sequence to the right + ;; key-symbol. + + (define-key map [up] 'tpu-move-to-beginning) ; up-arrow + (define-key map [down] 'tpu-move-to-end) ; down-arrow + (define-key map [right] 'end-of-line) ; right-arrow + (define-key map [left] 'beginning-of-line) ; left-arrow + + ;; (define-key map [find] nil) ; Find + ;; (define-key map [insert] nil) ; Insert Here + (define-key map [delete] 'tpu-store-text) ; Remove + (define-key map [select] 'tpu-unselect) ; Select + (define-key map [prior] 'tpu-previous-window) ; Prev Screen + (define-key map [next] 'tpu-next-window) ; Next Screen + + ;; (define-key map [f1] nil) ; F1 + ;; (define-key map [f2] nil) ; F2 + ;; (define-key map [f3] nil) ; F3 + ;; (define-key map [f4] nil) ; F4 + ;; (define-key map [f5] nil) ; F5 + ;; (define-key map [f6] nil) ; F6 + ;; (define-key map [f7] nil) ; F7 + ;; (define-key map [f8] nil) ; F8 + ;; (define-key map [f9] nil) ; F9 + ;; (define-key map [f10] nil) ; F10 + ;; (define-key map [f11] nil) ; F11 + ;; (define-key map [f12] nil) ; F12 + ;; (define-key map [f13] nil) ; F13 + ;; (define-key map [f14] nil) ; F14 + (define-key map [help] 'describe-bindings) ; HELP + ;; (define-key map [menu] nil) ; DO + (define-key map [f17] 'tpu-drop-breadcrumb) ; F17 + ;; (define-key map [f18] nil) ; F18 + ;; (define-key map [f19] nil) ; F19 + ;; (define-key map [f20] nil) ; F20 + + (define-key map [kp-f1] 'keyboard-quit) ; PF1 + (define-key map [kp-f2] 'help-for-help) ; PF2 + (define-key map [kp-f3] 'tpu-search) ; PF3 + (define-key map [kp-f4] 'tpu-undelete-lines) ; PF4 + (define-key map [kp-0] 'open-line) ; KP0 + (define-key map [kp-1] 'tpu-change-case) ; KP1 + (define-key map [kp-2] 'tpu-delete-to-eol) ; KP2 + (define-key map [kp-3] 'tpu-special-insert) ; KP3 + (define-key map [kp-4] 'tpu-move-to-end) ; KP4 + (define-key map [kp-5] 'tpu-move-to-beginning) ; KP5 + (define-key map [kp-6] 'tpu-paste) ; KP6 + (define-key map [kp-7] 'execute-extended-command) ; KP7 + (define-key map [kp-8] 'tpu-fill) ; KP8 + (define-key map [kp-9] 'tpu-replace) ; KP9 + (define-key map [kp-subtract] 'tpu-undelete-words) ; KP- + (define-key map [kp-separator] 'tpu-undelete-char) ; KP, + (define-key map [kp-decimal] 'tpu-unselect) ; KP. + (define-key map [kp-enter] 'tpu-substitute) ; KPenter + ;; - (define-key map "\C-A" 'tpu-toggle-overwrite-mode) ; ^A - (define-key map "\C-B" 'nil) ; ^B - (define-key map "\C-C" 'nil) ; ^C - (define-key map "\C-D" 'nil) ; ^D - (define-key map "\C-E" 'nil) ; ^E - (define-key map "\C-F" 'set-visited-file-name) ; ^F - (define-key map "\C-g" 'keyboard-quit) ; safety first - (define-key map "\C-h" 'delete-other-windows) ; BS - (define-key map "\C-i" 'other-window) ; TAB - (define-key map "\C-J" 'nil) ; ^J - (define-key map "\C-K" 'tpu-define-macro-key) ; ^K - (define-key map "\C-l" 'downcase-region) ; ^L - (define-key map "\C-M" 'nil) ; ^M - (define-key map "\C-N" 'nil) ; ^N - (define-key map "\C-O" 'nil) ; ^O - (define-key map "\C-P" 'nil) ; ^P - (define-key map "\C-Q" 'nil) ; ^Q - (define-key map "\C-R" 'nil) ; ^R - (define-key map "\C-S" 'nil) ; ^S - (define-key map "\C-T" 'tpu-toggle-control-keys) ; ^T - (define-key map "\C-u" 'upcase-region) ; ^U - (define-key map "\C-V" 'nil) ; ^V - (define-key map "\C-w" 'tpu-write-current-buffers) ; ^W - (define-key map "\C-X" 'nil) ; ^X - (define-key map "\C-Y" 'nil) ; ^Y - (define-key map "\C-Z" 'nil) ; ^Z - (define-key map " " 'undo) ; SPC - (define-key map "!" 'nil) ; ! - (define-key map "#" 'nil) ; # - (define-key map "$" 'tpu-add-at-eol) ; $ - (define-key map "%" 'tpu-goto-percent) ; % - (define-key map "&" 'nil) ; & - (define-key map "(" 'nil) ; ( - (define-key map ")" 'nil) ; ) - (define-key map "*" 'tpu-toggle-regexp) ; * - (define-key map "+" 'nil) ; + - (define-key map "," 'tpu-goto-breadcrumb) ; , - (define-key map "-" 'negative-argument) ; - - (define-key map "." 'tpu-drop-breadcrumb) ; . - (define-key map "/" 'tpu-emacs-replace) ; / - (define-key map "0" 'digit-argument) ; 0 - (define-key map "1" 'digit-argument) ; 1 - (define-key map "2" 'digit-argument) ; 2 - (define-key map "3" 'digit-argument) ; 3 - (define-key map "4" 'digit-argument) ; 4 - (define-key map "5" 'digit-argument) ; 5 - (define-key map "6" 'digit-argument) ; 6 - (define-key map "7" 'digit-argument) ; 7 - (define-key map "8" 'digit-argument) ; 8 - (define-key map "9" 'digit-argument) ; 9 - (define-key map ":" 'nil) ; : - (define-key map ";" 'tpu-trim-line-ends) ; ; - (define-key map "<" 'nil) ; < - (define-key map "=" 'nil) ; = - (define-key map ">" 'nil) ; > - (define-key map "?" 'tpu-spell-check) ; ? - (define-key map "A" 'tpu-toggle-newline-and-indent) ; A - (define-key map "B" 'tpu-next-buffer) ; B - (define-key map "C" 'repeat-complex-command) ; C - (define-key map "D" 'shell-command) ; D - (define-key map "E" 'tpu-exit) ; E - (define-key map "F" 'tpu-set-cursor-free) ; F - (define-key map "G" 'tpu-get) ; G - (define-key map "H" 'nil) ; H - (define-key map "I" 'tpu-include) ; I - (define-key map "K" 'tpu-kill-buffer) ; K - (define-key map "L" 'tpu-what-line) ; L - (define-key map "M" 'buffer-menu) ; M - (define-key map "N" 'tpu-next-file-buffer) ; N - (define-key map "O" 'occur) ; O - (define-key map "P" 'lpr-buffer) ; P - (define-key map "Q" 'tpu-quit) ; Q - (define-key map "R" 'tpu-toggle-rectangle) ; R - (define-key map "S" 'replace) ; S - (define-key map "T" 'tpu-line-to-top-of-window) ; T - (define-key map "U" 'undo) ; U - (define-key map "V" 'tpu-version) ; V - (define-key map "W" 'save-buffer) ; W - (define-key map "X" 'tpu-save-all-buffers-kill-emacs) ; X - (define-key map "Y" 'copy-region-as-kill) ; Y - (define-key map "Z" 'suspend-emacs) ; Z - (define-key map "[" 'blink-matching-open) ; [ - (define-key map "\\" 'nil) ; \ - (define-key map "]" 'blink-matching-open) ; ] - (define-key map "^" 'tpu-add-at-bol) ; ^ - (define-key map "_" 'split-window-vertically) ; - - (define-key map "`" 'what-line) ; ` - (define-key map "a" 'tpu-toggle-newline-and-indent) ; a - (define-key map "b" 'tpu-next-buffer) ; b - (define-key map "c" 'repeat-complex-command) ; c - (define-key map "d" 'shell-command) ; d - (define-key map "e" 'tpu-exit) ; e - (define-key map "f" 'tpu-set-cursor-free) ; f - (define-key map "g" 'tpu-get) ; g - (define-key map "h" 'nil) ; h - (define-key map "i" 'tpu-include) ; i - (define-key map "k" 'tpu-kill-buffer) ; k - (define-key map "l" 'goto-line) ; l - (define-key map "m" 'buffer-menu) ; m - (define-key map "n" 'tpu-next-file-buffer) ; n - (define-key map "o" 'occur) ; o - (define-key map "p" 'lpr-region) ; p - (define-key map "q" 'tpu-quit) ; q - (define-key map "r" 'tpu-toggle-rectangle) ; r - (define-key map "s" 'replace) ; s - (define-key map "t" 'tpu-line-to-top-of-window) ; t - (define-key map "u" 'undo) ; u - (define-key map "v" 'tpu-version) ; v - (define-key map "w" 'save-buffer) ; w + (define-key map "\C-A" 'tpu-toggle-overwrite-mode) ; ^A + ;; (define-key map "\C-B" nil) ; ^B + ;; (define-key map "\C-C" nil) ; ^C + ;; (define-key map "\C-D" nil) ; ^D + ;; (define-key map "\C-E" nil) ; ^E + (define-key map "\C-F" 'set-visited-file-name) ; ^F + (define-key map "\C-g" 'keyboard-quit) ; safety first + (define-key map "\C-h" 'delete-other-windows) ; BS + (define-key map "\C-i" 'other-window) ; TAB + ;; (define-key map "\C-J" nil) ; ^J + (define-key map "\C-K" 'tpu-define-macro-key) ; ^K + (define-key map "\C-l" 'downcase-region) ; ^L + ;; (define-key map "\C-M" nil) ; ^M + ;; (define-key map "\C-N" nil) ; ^N + ;; (define-key map "\C-O" nil) ; ^O + ;; (define-key map "\C-P" nil) ; ^P + ;; (define-key map "\C-Q" nil) ; ^Q + ;; (define-key map "\C-R" nil) ; ^R + ;; (define-key map "\C-S" nil) ; ^S + (define-key map "\C-T" 'tpu-toggle-control-keys) ; ^T + (define-key map "\C-u" 'upcase-region) ; ^U + ;; (define-key map "\C-V" nil) ; ^V + (define-key map "\C-w" 'tpu-write-current-buffers) ; ^W + ;; (define-key map "\C-X" nil) ; ^X + ;; (define-key map "\C-Y" nil) ; ^Y + ;; (define-key map "\C-Z" nil) ; ^Z + (define-key map " " 'undo) ; SPC + ;; (define-key map "!" nil) ; ! + ;; (define-key map "#" nil) ; # + (define-key map "$" 'tpu-add-at-eol) ; $ + (define-key map "%" 'tpu-goto-percent) ; % + ;; (define-key map "&" nil) ; & + ;; (define-key map "(" nil) ; ( + ;; (define-key map ")" nil) ; ) + (define-key map "*" 'tpu-toggle-regexp) ; * + ;; (define-key map "+" nil) ; + + (define-key map "," 'tpu-goto-breadcrumb) ; , + (define-key map "-" 'negative-argument) ; - + (define-key map "." 'tpu-drop-breadcrumb) ; . + (define-key map "/" 'tpu-emacs-replace) ; / + (define-key map "0" 'digit-argument) ; 0 + (define-key map "1" 'digit-argument) ; 1 + (define-key map "2" 'digit-argument) ; 2 + (define-key map "3" 'digit-argument) ; 3 + (define-key map "4" 'digit-argument) ; 4 + (define-key map "5" 'digit-argument) ; 5 + (define-key map "6" 'digit-argument) ; 6 + (define-key map "7" 'digit-argument) ; 7 + (define-key map "8" 'digit-argument) ; 8 + (define-key map "9" 'digit-argument) ; 9 + ;; (define-key map ":" nil) ; : + (define-key map ";" 'tpu-trim-line-ends) ; ; + ;; (define-key map "<" nil) ; < + ;; (define-key map "=" nil) ; = + ;; (define-key map ">" nil) ; > + (define-key map "?" 'tpu-spell-check) ; ? + ;; (define-key map "A" 'tpu-toggle-newline-and-indent) ; A + ;; (define-key map "B" 'tpu-next-buffer) ; B + ;; (define-key map "C" 'repeat-complex-command) ; C + ;; (define-key map "D" 'shell-command) ; D + ;; (define-key map "E" 'tpu-exit) ; E + ;; (define-key map "F" 'tpu-cursor-free-mode) ; F + ;; (define-key map "G" 'tpu-get) ; G + ;; (define-key map "H" nil) ; H + ;; (define-key map "I" 'tpu-include) ; I + ;; (define-key map "K" 'tpu-kill-buffer) ; K + (define-key map "L" 'tpu-what-line) ; L + ;; (define-key map "M" 'buffer-menu) ; M + ;; (define-key map "N" 'tpu-next-file-buffer) ; N + ;; (define-key map "O" 'occur) ; O + (define-key map "P" 'lpr-buffer) ; P + ;; (define-key map "Q" 'tpu-quit) ; Q + ;; (define-key map "R" 'tpu-toggle-rectangle) ; R + ;; (define-key map "S" 'replace) ; S + ;; (define-key map "T" 'tpu-line-to-top-of-window) ; T + ;; (define-key map "U" 'undo) ; U + ;; (define-key map "V" 'tpu-version) ; V + ;; (define-key map "W" 'save-buffer) ; W + ;; (define-key map "X" 'tpu-save-all-buffers-kill-emacs) ; X + ;; (define-key map "Y" 'copy-region-as-kill) ; Y + ;; (define-key map "Z" 'suspend-emacs) ; Z + (define-key map "[" 'blink-matching-open) ; [ + ;; (define-key map "\\" nil) ; \ + (define-key map "]" 'blink-matching-open) ; ] + (define-key map "^" 'tpu-add-at-bol) ; ^ + (define-key map "_" 'split-window-vertically) ; - + (define-key map "`" 'what-line) ; ` + (define-key map "a" 'tpu-toggle-newline-and-indent) ; a + (define-key map "b" 'tpu-next-buffer) ; b + (define-key map "c" 'repeat-complex-command) ; c + (define-key map "d" 'shell-command) ; d + (define-key map "e" 'tpu-exit) ; e + (define-key map "f" 'tpu-cursor-free-mode) ; f + (define-key map "g" 'tpu-get) ; g + ;; (define-key map "h" nil) ; h + (define-key map "i" 'tpu-include) ; i + (define-key map "k" 'tpu-kill-buffer) ; k + (define-key map "l" 'goto-line) ; l + (define-key map "m" 'buffer-menu) ; m + (define-key map "n" 'tpu-next-file-buffer) ; n + (define-key map "o" 'occur) ; o + (define-key map "p" 'lpr-region) ; p + (define-key map "q" 'tpu-quit) ; q + (define-key map "r" 'tpu-toggle-rectangle) ; r + (define-key map "s" 'replace) ; s + (define-key map "t" 'tpu-line-to-top-of-window) ; t + (define-key map "u" 'undo) ; u + (define-key map "v" 'tpu-version) ; v + (define-key map "w" 'save-buffer) ; w (define-key map "x" 'tpu-save-all-buffers-kill-emacs) ; x - (define-key map "y" 'copy-region-as-kill) ; y - (define-key map "z" 'suspend-emacs) ; z - (define-key map "{" 'nil) ; { - (define-key map "|" 'split-window-horizontally) ; | - (define-key map "}" 'nil) ; } - (define-key map "~" 'exchange-point-and-mark) ; ~ - (define-key map "\177" 'delete-window) ; <X] + (define-key map "y" 'copy-region-as-kill) ; y + (define-key map "z" 'suspend-emacs) ; z + ;; (define-key map "{" nil) ; { + (define-key map "|" 'split-window-horizontally) ; | + ;; (define-key map "}" nil) ; } + (define-key map "~" 'exchange-point-and-mark) ; ~ + (define-key map "\177" 'delete-window) ; <X] map) "Maps the function keys on the VT100 keyboard preceded by PF1. GOLD is the ASCII 7-bit escape sequence <ESC>OP.") +(define-obsolete-variable-alias 'GOLD-map 'tpu-gold-map "23.1") -(defvar SS3-map +(defvar tpu-global-map (let ((map (make-sparse-keymap))) - (define-key map "P" GOLD-map) ; GOLD map + + ;; Previously defined in CSI-map. We now presume that term/*.el does + ;; its job to map the escape sequence to the right key-symbol. + (define-key map [find] 'tpu-search) ; Find + (define-key map [insert] 'tpu-paste) ; Insert Here + (define-key map [delete] 'tpu-cut) ; Remove + (define-key map [select] 'tpu-select) ; Select + (define-key map [prior] 'tpu-scroll-window-down) ; Prev Screen + (define-key map [next] 'tpu-scroll-window-up) ; Next Screen + + ;; (define-key map [f1] nil) ; F1 + ;; (define-key map [f2] nil) ; F2 + ;; (define-key map [f3] nil) ; F3 + ;; (define-key map [f4] nil) ; F4 + ;; (define-key map [f5] nil) ; F5 + ;; (define-key map [f6] nil) ; F6 + ;; (define-key map [f7] nil) ; F7 + ;; (define-key map [f8] nil) ; F8 + ;; (define-key map [f9] nil) ; F9 + (define-key map [f10] 'tpu-exit) ; F10 + (define-key map [f11] 'tpu-insert-escape) ; F11 (ESC) + (define-key map [f12] 'tpu-next-beginning-of-line) ; F12 (BS) + (define-key map [f13] 'tpu-delete-previous-word) ; F13 (LF) + (define-key map [f14] 'tpu-toggle-overwrite-mode) ; F14 + (define-key map [help] 'tpu-help) ; HELP + (define-key map [menu] 'execute-extended-command) ; DO + (define-key map [f17] 'tpu-goto-breadcrumb) ; F17 + ;; (define-key map [f18] nil) ; F18 + ;; (define-key map [f19] nil) ; F19 + ;; (define-key map [f20] nil) ; F20 + + + ;; Previously defined in SS3-map. We now presume that term/*.el does + ;; its job to map the escape sequence to the right key-symbol. + (define-key map [kp-f1] tpu-gold-map) ; GOLD map ;; - (define-key map "A" 'tpu-previous-line) ; up - (define-key map "B" 'tpu-next-line) ; down - (define-key map "C" 'tpu-forward-char) ; right - (define-key map "D" 'tpu-backward-char) ; left - - (define-key map "Q" 'tpu-help) ; PF2 - (define-key map "R" 'tpu-search-again) ; PF3 - (define-key map "S" 'tpu-delete-current-line) ; PF4 - (define-key map "p" 'tpu-line) ; KP0 - (define-key map "q" 'tpu-word) ; KP1 - (define-key map "r" 'tpu-end-of-line) ; KP2 - (define-key map "s" 'tpu-char) ; KP3 - (define-key map "t" 'tpu-advance-direction) ; KP4 - (define-key map "u" 'tpu-backup-direction) ; KP5 - (define-key map "v" 'tpu-cut) ; KP6 - (define-key map "w" 'tpu-page) ; KP7 - (define-key map "x" 'tpu-scroll-window) ; KP8 - (define-key map "y" 'tpu-append-region) ; KP9 - (define-key map "m" 'tpu-delete-current-word) ; KP- - (define-key map "l" 'tpu-delete-current-char) ; KP, - (define-key map "n" 'tpu-select) ; KP. - (define-key map "M" 'newline) ; KPenter - map) - "Maps the SS3 function keys on the VT100 keyboard. -SS3 is DEC's name for the sequence <ESC>O.") + (define-key map [up] 'tpu-previous-line) ; up + (define-key map [down] 'tpu-next-line) ; down + (define-key map [right] 'tpu-forward-char) ; right + (define-key map [left] 'tpu-backward-char) ; left + + (define-key map [kp-f2] 'tpu-help) ; PF2 + (define-key map [kp-f3] 'tpu-search-again) ; PF3 + (define-key map [kp-f4] 'tpu-delete-current-line) ; PF4 + (define-key map [kp-0] 'tpu-line) ; KP0 + (define-key map [kp-1] 'tpu-word) ; KP1 + (define-key map [kp-2] 'tpu-end-of-line) ; KP2 + (define-key map [kp-3] 'tpu-char) ; KP3 + (define-key map [kp-4] 'tpu-advance-direction) ; KP4 + (define-key map [kp-5] 'tpu-backup-direction) ; KP5 + (define-key map [kp-6] 'tpu-cut) ; KP6 + (define-key map [kp-7] 'tpu-page) ; KP7 + (define-key map [kp-8] 'tpu-scroll-window) ; KP8 + (define-key map [kp-9] 'tpu-append-region) ; KP9 + (define-key map [kp-subtract] 'tpu-delete-current-word) ; KP- + (define-key map [kp-separator] 'tpu-delete-current-char) ; KP, + (define-key map [kp-decimal] 'tpu-select) ; KP. + (define-key map [kp-enter] 'newline) ; KPenter -(defvar tpu-global-map - (let ((map (make-sparse-keymap))) - (define-key map "\e[" CSI-map) - (define-key map "\eO" SS3-map) map) "TPU-edt global keymap.") -(and (not (boundp 'minibuffer-local-ns-map)) - (defvar minibuffer-local-ns-map (make-sparse-keymap) - "Hack to give Lucid Emacs the same maps as ordinary Emacs.")) - ;;; ;;; Global Variables @@ -698,7 +662,7 @@ SS3 is DEC's name for the sequence <ESC>O.") (setq tpu-mark-flag (if transient-mark-mode "" (if (tpu-mark) " @" " "))) (force-mode-line-update)) -(cond (tpu-lucid-emacs-p +(cond ((featurep 'xemacs) (add-hook 'zmacs-deactivate-region-hook 'tpu-update-mode-line) (add-hook 'zmacs-activate-region-hook 'tpu-update-mode-line)) (t @@ -730,15 +694,15 @@ SS3 is DEC's name for the sequence <ESC>O.") (set-marker tpu-match-end-mark nil)) (defun tpu-match-beginning nil - "Returns the location of the last match beginning." + "Return the location of the last match beginning." (marker-position tpu-match-beginning-mark)) (defun tpu-match-end nil - "Returns the location of the last match end." + "Return the location of the last match end." (marker-position tpu-match-end-mark)) (defun tpu-check-match nil - "Returns t if point is between tpu-match markers. + "Return t if point is between tpu-match markers. Otherwise sets the tpu-match markers to nil and returns nil." ;; make sure 1- marker is in this buffer ;; 2- point is at or after beginning marker @@ -779,7 +743,7 @@ Otherwise sets the tpu-match markers to nil and returns nil." "TPU-edt version of the mark function. Return the appropriate value of the mark for the current version of Emacs." - (cond (tpu-lucid-emacs-p (mark (not zmacs-regions))) + (cond ((featurep 'xemacs) (mark (not zmacs-regions))) (t (and mark-active (mark (not transient-mark-mode)))))) (defun tpu-set-mark (pos) @@ -849,7 +813,7 @@ Top line is 0. Counts each text line only once, even if it wraps." (message "Mark %d set." num)) (defun tpu-goto-breadcrumb (num) - "Returns to a breadcrumb set with drop-breadcrumb." + "Return to a breadcrumb set with drop-breadcrumb." (interactive "p") (cond ((get tpu-breadcrumb-plist num) (switch-to-buffer (car (get tpu-breadcrumb-plist num))) @@ -908,7 +872,7 @@ With argument, fill and justify." tpu-version)) (defun tpu-reset-screen-size (height width) - "Sets the screen size." + "Set the screen size." (interactive "nnew screen height: \nnnew screen width: ") (set-frame-height (selected-frame) height) (set-frame-width (selected-frame) width)) @@ -930,8 +894,8 @@ With argument, fill and justify." (if tpu-newline-and-indent-p " and indents." ".")))) (defun tpu-spell-check nil - "Checks the spelling of the region, or of the entire buffer if no - region is selected." + "Check the spelling of the region, or of the entire buffer, +if no region is selected." (interactive) (cond (tpu-have-ispell (if (tpu-mark) (ispell-region (tpu-mark) (point)) (ispell-buffer))) @@ -940,7 +904,7 @@ With argument, fill and justify." (if (tpu-mark) (tpu-unselect t))) (defun tpu-toggle-overwrite-mode nil - "Switches in and out of overwrite mode" + "Switch in and out of overwrite mode." (interactive) (cond (overwrite-mode (tpu-local-set-key "\177" tpu-saved-delete-func) @@ -951,8 +915,7 @@ With argument, fill and justify." (overwrite-mode 1)))) (defun tpu-special-insert (num) - "Insert a character or control code according to -its ASCII decimal value." + "Insert a character or control code according to its ASCII decimal value." (interactive "P") (if overwrite-mode (delete-char 1)) (insert (if num num 0))) @@ -970,19 +933,19 @@ This is useful for inserting control characters." ;;; TPU line-mode commands ;;; (defun tpu-include (file) - "TPU-like include file" + "TPU-like include file." (interactive "fInclude file: ") (insert-file-contents file) (message "")) (defun tpu-get (file) - "TPU-like get file" + "TPU-like get file." (interactive "FFile to get: ") (find-file file find-file-wildcards)) (defun tpu-what-line nil - "Tells what line the point is on, - and the total number of lines in the buffer." + "Tell what line the point is on, +and the total number of lines in the buffer." (interactive) (if (eobp) (message "You are at the End of Buffer. The last line is %d." @@ -1251,12 +1214,12 @@ This is useful for inserting control characters." ;;; Auto-insert ;;; (defun tpu-insert-escape nil - "Inserts an escape character, and so becomes the escape-key alias." + "Insert an escape character, and so becomes the escape-key alias." (interactive) (insert "\e")) (defun tpu-insert-formfeed nil - "Inserts a formfeed character." + "Insert a formfeed character." (interactive) (insert "\C-L")) @@ -1267,7 +1230,7 @@ This is useful for inserting control characters." (defvar tpu-saved-control-r nil "Saved value of Control-r.") (defun tpu-end-define-macro-key (key) - "Ends the current macro definition" + "End the current macro definition." (interactive "kPress the key you want to use to do what was just learned: ") (end-kbd-macro nil) (global-set-key key last-kbd-macro) @@ -1285,7 +1248,7 @@ This is useful for inserting control characters." ;;; Buffers and Windows ;;; (defun tpu-kill-buffer nil - "Kills the current buffer. If tpu-kill-buffers-silently is non-nil, + "Kill the current buffer. If tpu-kill-buffers-silently is non-nil, kills modified buffers without asking." (interactive) (if tpu-kill-buffers-silently (set-buffer-modified-p nil)) @@ -1316,7 +1279,7 @@ kills modified buffers without asking." (switch-to-buffer (car (reverse list))))) (defun tpu-make-file-buffer-list (buffer-list) - "Returns names from BUFFER-LIST excluding those beginning with a space or star." + "Return names from BUFFER-LIST excluding those beginning with a space or star." (delq nil (mapcar '(lambda (b) (if (or (= (aref (buffer-name b) 0) ? ) (= (aref (buffer-name b) 0) ?*)) nil b)) @@ -1339,7 +1302,7 @@ kills modified buffers without asking." ;;; Search ;;; (defun tpu-toggle-regexp nil - "Switches in and out of regular expression search and replace mode." + "Switch in and out of regular expression search and replace mode." (interactive) (setq tpu-regexp-p (not tpu-regexp-p)) (tpu-set-search) @@ -1401,9 +1364,12 @@ The search is performed in the current direction." ;; tpu-search-forward (t) tpu-search-reverse (t) ;; tpu-search-forward-exit (t) tpu-search-backward-exit (t) +(declare-function tpu-emacs-search "tpu-edt") +(declare-function tpu-emacs-rev-search "tpu-edt") + (defun tpu-set-search (&optional arg) - "Set the search functions and set the search direction to the current -direction. If an argument is specified, don't set the search direction." + "Set the search functions and set the search direction to the current direction. +If an argument is specified, don't set the search direction." (if (not arg) (setq tpu-searching-forward tpu-advance)) (cond (tpu-searching-forward (cond (tpu-regexp-p @@ -1460,7 +1426,7 @@ direction. If an argument is specified, don't set the search direction." (defalias 'tpu-search-internal-core (symbol-function 'tpu-search-internal)) (defun tpu-check-search-case (string) - "Returns t if string contains upper case." + "Return t if string contains upper case." ;; if using regexp, eliminate upper case forms (\B \W \S.) (if tpu-regexp-p (let ((pat (copy-sequence string)) (case-fold-search nil) (pos 0)) @@ -1508,7 +1474,7 @@ Used for reversing a search in progress." ;;; Select / Unselect ;;; (defun tpu-select (&optional quiet) - "Sets the mark to define one end of a region." + "Set the mark to define one end of a region." (interactive "P") (cond ((tpu-mark) (tpu-unselect quiet)) @@ -1518,7 +1484,7 @@ Used for reversing a search in progress." (if (not quiet) (message "Move the text cursor to select text."))))) (defun tpu-unselect (&optional quiet) - "Removes the mark to unselect the current region." + "Remove the mark to unselect the current region." (interactive "P") (deactivate-mark) (setq mark-ring nil) @@ -1541,8 +1507,7 @@ Used for reversing a search in progress." (if tpu-rectangular-p "en" "dis")))) (defun tpu-arrange-rectangle nil - "Adjust point and mark to mark upper left and lower right -corners of a rectangle." + "Adjust point and mark to upper left and lower right corners of a rectangle." (let ((mc (current-column)) (pc (progn (exchange-point-and-mark) (current-column)))) @@ -1607,14 +1572,14 @@ The text is saved for the tpu-paste command." (tpu-error "No selection active.")))) (defun tpu-cut (arg) - "Copy selected region to the cut buffer. In the absence of an -argument, delete the selected region too." + "Copy selected region to the cut buffer. +In the absence of an argument, delete the selected region too." (interactive "P") (if arg (tpu-store-text) (tpu-cut-text))) (defun tpu-append-region (arg) - "Append selected region to the tpu-cut buffer. In the absence of an -argument, delete the selected region too." + "Append selected region to the tpu-cut buffer. +In the absence of an argument, delete the selected region too." (interactive "P") (cond ((tpu-mark) (let ((beg (region-beginning)) (end (region-end))) @@ -1690,8 +1655,8 @@ They are saved for the TPU-edt undelete-words command." (delete-region beg (point)))) (defun tpu-delete-current-char (num) - "Delete one or specified number of characters after point. The last -character deleted is saved for the TPU-edt undelete-char command." + "Delete one or specified number of characters after point. +The last character deleted is saved for the TPU-edt undelete-char command." (interactive "p") (while (and (> num 0) (not (eobp))) (setq tpu-last-deleted-char (char-after (point))) @@ -1774,8 +1739,8 @@ With argument reinserts the character that many times." (tpu-error "No selection active.")))) (defun tpu-substitute (num) - "Replace the selected region with the contents of the cut buffer, and -repeat most recent search. A numeric argument serves as a repeat count. + "Replace the selected region with the contents of the cut buffer, +and repeat most recent search. A numeric argument serves as a repeat count. A negative argument means replace all occurrences of the search string." (interactive "p") (cond ((or (tpu-mark) (tpu-check-match)) @@ -1852,10 +1817,10 @@ A negative argument means replace all occurrences of the search string." (message "Replaced %s occurrence%s." strings (if (not (= 1 strings)) "s" "")))) (defun tpu-emacs-replace (&optional dont-ask) - "A TPU-edt interface to the Emacs replace functions. If TPU-edt is -currently in regular expression mode, the Emacs regular expression -replace functions are used. If an argument is supplied, replacements -are performed without asking. Only works in forward direction." + "A TPU-edt interface to the Emacs replace functions. +If TPU-edt is currently in regular expression mode, the Emacs regular +expression replace functions are used. If an argument is supplied, +replacements are performed without asking. Only works in forward direction." (interactive "P") (cond (dont-ask (setq current-prefix-arg nil) @@ -1904,7 +1869,7 @@ or each line of the entire buffer if no region is selected." (end-of-line) (insert text) (forward-line)))))) (defun tpu-trim-line-ends nil - "Removes trailing whitespace from every line in the buffer." + "Remove trailing whitespace from every line in the buffer." (interactive) (save-match-data (save-excursion @@ -2260,8 +2225,8 @@ Accepts a prefix argument for the number of tpu-pan-columns to scroll." ;;; ;;; Minibuffer map additions to set search direction ;;; -(define-key minibuffer-local-map "\eOt" 'tpu-search-forward-exit) ;KP4 -(define-key minibuffer-local-map "\eOu" 'tpu-search-backward-exit) ;KP5 +(define-key minibuffer-local-map [kp-4] 'tpu-search-forward-exit) ;KP4 +(define-key minibuffer-local-map [kp-5] 'tpu-search-backward-exit) ;KP5 ;;; @@ -2306,7 +2271,7 @@ Accepts a prefix argument for the number of tpu-pan-columns to scroll." (setq tpu-control-keys tpu-style))) (defun tpu-toggle-control-keys nil - "Toggles control key bindings between TPU-edt and Emacs." + "Toggle control key bindings between TPU-edt and Emacs." (interactive) (tpu-reset-control-keys (not tpu-control-keys)) (and (interactive-p) @@ -2357,13 +2322,13 @@ Accepts a prefix argument for the number of tpu-pan-columns to scroll." (defun tpu-load-xkeys (file) "Load the TPU-edt X-windows key definitions FILE. If FILE is nil, try to load a default file. The default file names are -`~/.tpu-lucid-keys' for Lucid emacs, and `~/.tpu-keys' for Emacs." +`~/.tpu-lucid-keys' for XEmacs, and `~/.tpu-keys' for Emacs." (interactive "fX key definition file: ") (cond (file (setq file (expand-file-name file))) (tpu-xkeys-file (setq file (expand-file-name tpu-xkeys-file))) - (tpu-lucid-emacs-p + ((featurep 'xemacs) (setq file (convert-standard-filename (expand-file-name "~/.tpu-lucid-keys")))) (t @@ -2379,34 +2344,11 @@ If FILE is nil, try to load a default file. The default file names are (cond ((file-readable-p file) (load-file file)) (t - (switch-to-buffer "*scratch*") - (erase-buffer) - (insert " - - Ack!! You're running TPU-edt under X-windows without loading an - X key definition file. To create a TPU-edt X key definition - file, run the tpu-mapper.el program. It came with TPU-edt. It - even includes directions on how to use it! Perhaps it's lying - around here someplace. ") - (let ((file "tpu-mapper.el") - (found nil) - (path nil) - (search-list (append (list (expand-file-name ".")) load-path))) - (while (and (not found) search-list) - (setq path (concat (car search-list) - (if (string-match "/$" (car search-list)) "" "/") - file)) - (if (and (file-exists-p path) (not (file-directory-p path))) - (setq found t)) - (setq search-list (cdr search-list))) - (cond (found - (insert (format - "Ah yes, there it is, in \n\n %s \n\n" path)) - (if (tpu-y-or-n-p "Do you want to run it now? ") - (load-file path))) - (t - (insert "Nope, I can't seem to find it. :-(\n\n") - (sit-for 120))))))) + ;; This used to force the user to build `file'. With the + ;; new code, such a file may not be necessary. In case it + ;; is, issue a message giving a hint as to how to build it. + (message "%s not found: use M-x tpu-mapper to create it" + (abbreviate-file-name file))))) (defun tpu-copy-keyfile (oldname newname) "Copy the TPU-edt X key definitions file to the new default name." @@ -2489,9 +2431,39 @@ If FILE is nil, try to load a default file. The default file names are (if (eq tpu-global-map parent) (set-keymap-parent map (keymap-parent parent)) (setq map parent))))) - (ignore-errors (ad-disable-regexp "\\`tpu-")) + ;; Only has an effect if the advice in tpu-extras has been activated. + (condition-case nil + (with-no-warnings (ad-disable-regexp "\\`tpu-")) + (error nil)) (setq tpu-edt-mode nil)) + +;;;### (autoloads (tpu-set-cursor-bound tpu-set-cursor-free tpu-set-scroll-margins +;;;;;; tpu-cursor-free-mode) "tpu-extras" "tpu-extras.el" "e0629234f1abe076917a303456b48329") +;;; Generated autoloads from tpu-extras.el + +(autoload 'tpu-cursor-free-mode "tpu-extras" "\ +Minor mode to allow the cursor to move freely about the screen. + +\(fn &optional ARG)" t nil) + +(autoload 'tpu-set-scroll-margins "tpu-extras" "\ +Set scroll margins. + +\(fn TOP BOTTOM)" t nil) + +(autoload 'tpu-set-cursor-free "tpu-extras" "\ +Allow the cursor to move freely about the screen. + +\(fn)" t nil) + +(autoload 'tpu-set-cursor-bound "tpu-extras" "\ +Constrain the cursor to the flow of the text. + +\(fn)" t nil) + +;;;*** + (provide 'tpu-edt) ;; arch-tag: f3dfe61c-2cbd-4f73-b9cc-eb215020b857 diff --git a/lisp/emulation/tpu-extras.el b/lisp/emulation/tpu-extras.el index 4946a775703..518b60db2ec 100644 --- a/lisp/emulation/tpu-extras.el +++ b/lisp/emulation/tpu-extras.el @@ -112,18 +112,18 @@ ;;; Customization variables (defcustom tpu-top-scroll-margin 0 - "*Scroll margin at the top of the screen. + "Scroll margin at the top of the screen. Interpreted as a percent of the current window size." :type 'integer :group 'tpu) (defcustom tpu-bottom-scroll-margin 0 - "*Scroll margin at the bottom of the screen. + "Scroll margin at the bottom of the screen. Interpreted as a percent of the current window size." :type 'integer :group 'tpu) (defcustom tpu-backward-char-like-tpu t - "*If non-nil, in free cursor mode backward-char (left-arrow) works + "If non-nil, in free cursor mode backward-char (left-arrow) works just like TPU/edt. Otherwise, backward-char will move to the end of the previous line when starting from a line beginning." :type 'boolean @@ -132,8 +132,12 @@ the previous line when starting from a line beginning." ;;; Global variables -(defvar tpu-cursor-free nil - "If non-nil, let the cursor roam free.") +;;;###autoload +(define-minor-mode tpu-cursor-free-mode + "Minor mode to allow the cursor to move freely about the screen." + :init-value nil + (if (not tpu-cursor-free-mode) + (tpu-trim-line-ends))) ;;; Hooks -- Set cursor free in picture mode. @@ -141,11 +145,10 @@ the previous line when starting from a line beginning." (add-hook 'picture-mode-hook 'tpu-set-cursor-free) -(defun tpu-before-save-hook () +(defun tpu-trim-line-ends-if-needed () "Eliminate whitespace at ends of lines, if the cursor is free." - (if (and (buffer-modified-p) tpu-cursor-free) (tpu-trim-line-ends))) - -(add-hook 'before-save-hook 'tpu-before-save-hook) + (if (and (buffer-modified-p) tpu-cursor-free-mode) (tpu-trim-line-ends))) +(add-hook 'before-save-hook 'tpu-trim-line-ends-if-needed) ;;; Utility routines for implementing scroll margins @@ -171,12 +174,12 @@ the previous line when starting from a line beginning." (defun tpu-forward-char (num) "Move right ARG characters (left if ARG is negative)." (interactive "p") - (if tpu-cursor-free (picture-forward-column num) (forward-char num))) + (if tpu-cursor-free-mode (picture-forward-column num) (forward-char num))) (defun tpu-backward-char (num) "Move left ARG characters (right if ARG is negative)." (interactive "p") - (cond ((not tpu-cursor-free) + (cond ((not tpu-cursor-free-mode) (backward-char num)) (tpu-backward-char-like-tpu (picture-backward-column num)) @@ -195,7 +198,7 @@ the previous line when starting from a line beginning." Prefix argument serves as a repeat count." (interactive "p") (let ((beg (tpu-current-line))) - (if tpu-cursor-free (or (eobp) (picture-move-down num)) + (if tpu-cursor-free-mode (or (eobp) (picture-move-down num)) (line-move num)) (tpu-bottom-check beg num) (setq this-command 'next-line))) @@ -205,7 +208,7 @@ Prefix argument serves as a repeat count." Prefix argument serves as a repeat count." (interactive "p") (let ((beg (tpu-current-line))) - (if tpu-cursor-free (picture-move-up num) (line-move (- num))) + (if tpu-cursor-free-mode (picture-move-up num) (line-move (- num))) (tpu-top-check beg num) (setq this-command 'previous-line))) @@ -223,7 +226,7 @@ Accepts a prefix argument for the number of lines to move." Accepts a prefix argument for the number of lines to move." (interactive "p") (let ((beg (tpu-current-line))) - (cond (tpu-cursor-free + (cond (tpu-cursor-free-mode (let ((beg (point))) (if (< 1 num) (forward-line num)) (picture-end-of-line) @@ -238,7 +241,7 @@ Accepts a prefix argument for the number of lines to move." Accepts a prefix argument for the number of lines to move." (interactive "p") (let ((beg (tpu-current-line))) - (cond (tpu-cursor-free + (cond (tpu-cursor-free-mode (picture-end-of-line (- 1 num))) (t (end-of-line (- 1 num)))) @@ -248,7 +251,7 @@ Accepts a prefix argument for the number of lines to move." "Move point to end of current line." (interactive) (let ((beg (point))) - (if tpu-cursor-free (picture-end-of-line) (end-of-line)) + (if tpu-cursor-free-mode (picture-end-of-line) (end-of-line)) (if (= beg (point)) (message "You are already at the end of a line.")))) (defun tpu-forward-line (num) @@ -256,9 +259,8 @@ Accepts a prefix argument for the number of lines to move." Prefix argument serves as a repeat count." (interactive "p") (let ((beg (tpu-current-line))) - (line-move num) - (tpu-bottom-check beg num) - (beginning-of-line))) + (forward-line num) + (tpu-bottom-check beg num))) (defun tpu-backward-line (num) "Move to beginning of previous line. @@ -266,9 +268,8 @@ Prefix argument serves as repeat count." (interactive "p") (let ((beg (tpu-current-line))) (or (bolp) (>= 0 num) (setq num (- num 1))) - (line-move (- num)) - (tpu-top-check beg num) - (beginning-of-line))) + (forward-line (- num)) + (tpu-top-check beg num))) ;;; Movement by paragraph @@ -448,22 +449,19 @@ A repeat count means scroll that many sections." (defun tpu-set-cursor-free () "Allow the cursor to move freely about the screen." (interactive) - (setq tpu-cursor-free t) - (substitute-key-definition 'tpu-set-cursor-free - 'tpu-set-cursor-bound - GOLD-map) + (tpu-cursor-free-mode 1) (message "The cursor will now move freely about the screen.")) ;;;###autoload (defun tpu-set-cursor-bound () "Constrain the cursor to the flow of the text." (interactive) - (tpu-trim-line-ends) - (setq tpu-cursor-free nil) - (substitute-key-definition 'tpu-set-cursor-bound - 'tpu-set-cursor-free - GOLD-map) + (tpu-cursor-free-mode -1) (message "The cursor is now bound to the flow of your text.")) +;; Local Variables: +;; generated-autoload-file: "tpu-edt.el" +;; End: + ;; arch-tag: 89676fa4-33ec-48cb-9135-6f3bf230ab1a ;;; tpu-extras.el ends here diff --git a/lisp/emulation/tpu-mapper.el b/lisp/emulation/tpu-mapper.el index 1e39687d1a8..49d67f437f8 100644 --- a/lisp/emulation/tpu-mapper.el +++ b/lisp/emulation/tpu-mapper.el @@ -26,64 +26,11 @@ ;;; Commentary: -;; This emacs lisp program can be used to create an emacs lisp file that -;; defines the TPU-edt keypad for emacs running on x-windows. Please read -;; the "Usage" AND "Known Problems" sections before attempting to run this -;; program. - -;;; Usage: - -;; Simply load this file into the X-windows version of emacs using the -;; following command. - -;; emacs -q -l tpu-mapper - -;; The "-q" option prevents loading of your .emacs file (commands therein -;; might confuse this program). - -;; An instruction screen showing the TPU-edt keypad will be displayed, and -;; you will be prompted to press the TPU-edt editing keys. Tpu-mapper uses -;; the keys you press to create an Emacs Lisp file that will define a -;; TPU-edt keypad for your X server. You can even re-arrange the standard -;; EDT keypad to suit your tastes (or to cope with those silly Sun and PC -;; keypads). - -;; Finally, you will be prompted for the name of the file to store the key -;; definitions. If you chose the default, TPU-edt will find it and load it -;; automatically. If you specify a different file name, you will need to -;; set the variable "tpu-xkeys-file" before starting TPU-edt. Here's how -;; you might go about doing that in your .emacs file. - -;; (setq tpu-xkeys-file (expand-file-name "~/.my-emacs-x-keys")) -;; (tpu-edt) - -;;; Known Problems: - -;; Sometimes, tpu-mapper will ignore a key you press, and just continue to -;; prompt for the same key. This can happen when your window manager sucks -;; up the key and doesn't pass it on to Emacs, or it could be an Emacs bug. -;; Either way, there's nothing that tpu-mapper can do about it. You must -;; press RETURN, to skip the current key and continue. Later, you and/or -;; your local X guru can try to figure out why the key is being ignored. +;; This Emacs Lisp program can be used to create an Emacs Lisp file that +;; defines the TPU-edt keypad for Emacs running on X-Windows. ;;; Code: - -;;; -;;; Make sure we're running X-windows and Emacs version 19 -;;; -(cond - ((not (and window-system (not (string-lessp emacs-version "19")))) - (error "tpu-mapper requires running in Emacs 19, with an X display"))) - - -;;; -;;; Decide whether we're running Lucid Emacs or Emacs itself. -;;; -(defconst tpu-lucid-emacs19-p (string-match "Lucid" emacs-version) - "Non-nil if we are running Lucid Emacs version 19.") - - ;;; ;;; Key variables ;;; @@ -96,37 +43,89 @@ (defvar tpu-enter-seq nil) (defvar tpu-return-seq nil) - ;;; -;;; Make sure the window is big enough to display the instructions +;;; Key mapping function ;;; -(if tpu-lucid-emacs19-p (set-screen-size (selected-screen) 80 36) - (set-frame-size (selected-frame) 80 36)) +(defun tpu-map-key (ident descrip func gold-func) + (interactive) + (if (featurep 'xemacs) + (progn + (setq tpu-key-seq (read-key-sequence + (format "Press %s%s: " ident descrip)) + tpu-key (format "[%s]" (event-key (aref tpu-key-seq 0)))) + (unless (equal tpu-key tpu-return) + (set-buffer "Keys") + (insert (format"(global-set-key %s %s)\n" tpu-key func)) + (set-buffer "Gold-Keys") + (insert (format "(define-key GOLD-map %s %s)\n" tpu-key gold-func)))) + (message "Press %s%s: " ident descrip) + (setq tpu-key-seq (read-event) + tpu-key (format "[%s]" tpu-key-seq)) + (unless (equal tpu-key tpu-return) + (set-buffer "Keys") + (insert (format"(define-key tpu-global-map %s %s)\n" tpu-key func)) + (set-buffer "Gold-Keys") + (insert (format "(define-key tpu-gold-map %s %s)\n" tpu-key gold-func)))) + (set-buffer "Directions") + tpu-key) +;;;###autoload +(defun tpu-mapper () + "Create an Emacs lisp file defining the TPU-edt keypad for X-windows. + +This command displays an instruction screen showing the TPU-edt keypad +and asks you to press the TPU-edt editing keys. It uses the keys you +press to create an Emacs Lisp file that will define a TPU-edt keypad +for your X server. You can even re-arrange the standard EDT keypad to +suit your tastes (or to cope with those silly Sun and PC keypads). + +Finally, you will be prompted for the name of the file to store the key +definitions. If you chose the default, TPU-edt will find it and load it +automatically. If you specify a different file name, you will need to +set the variable ``tpu-xkeys-file'' before starting TPU-edt. Here's how +you might go about doing that in your .emacs file. + + (setq tpu-xkeys-file (expand-file-name \"~/.my-emacs-x-keys\")) + (tpu-edt) + +Known Problems: + +Sometimes, tpu-mapper will ignore a key you press, and just continue to +prompt for the same key. This can happen when your window manager sucks +up the key and doesn't pass it on to Emacs, or it could be an Emacs bug. +Either way, there's nothing that tpu-mapper can do about it. You must +press RETURN, to skip the current key and continue. Later, you and/or +your local X guru can try to figure out why the key is being ignored." + (interactive) -;;; -;;; Create buffers - Directions, Keys, Gold-Keys -;;; -(if (not (get-buffer "Directions")) (generate-new-buffer "Directions")) -(if (not (get-buffer "Keys")) (generate-new-buffer "Keys")) -(if (not (get-buffer "Gold-Keys")) (generate-new-buffer "Gold-Keys")) + ;; Make sure we're running X-windows + (if (not window-system) + (error "tpu-mapper requires running Emacs with an X display")) -;;; -;;; Put headers in the Keys buffer -;;; -(set-buffer "Keys") -(insert "\ + ;; Make sure the window is big enough to display the instructions + + (if (featurep 'xemacs) (set-screen-size (selected-screen) 80 36) + (set-frame-size (selected-frame) 80 36)) + + ;; Create buffers - Directions, Keys, Gold-Keys + + (if (not (get-buffer "Directions")) (generate-new-buffer "Directions")) + (if (not (get-buffer "Keys")) (generate-new-buffer "Keys")) + (if (not (get-buffer "Gold-Keys")) (generate-new-buffer "Gold-Keys")) + + ;; Put headers in the Keys buffer + + (set-buffer "Keys") + (insert "\ ;; Key definitions for TPU-edt ;; ") + ;; Display directions -;;; -;;; Display directions -;;; -(switch-to-buffer "Directions") -(insert " + (switch-to-buffer "Directions") + (insert " This program prompts you to press keys to create a custom keymap file for use with the x-windows version of Emacs and TPU-edt. @@ -160,238 +159,197 @@ ") -(delete-other-windows) -(goto-char (point-min)) - -;;; -;;; Save <CR> for future reference -;;; -(cond - (tpu-lucid-emacs19-p - (setq tpu-return-seq (read-key-sequence "Hit carriage-return <CR> to continue ")) - (setq tpu-return (concat "[" (format "%s" (event-key (aref tpu-return-seq 0))) "]"))) - (t - (message "Hit carriage-return <CR> to continue ") - (setq tpu-return-seq (read-event)) - (setq tpu-return (concat "[" (format "%s" tpu-return-seq) "]")))) - + (delete-other-windows) + (goto-char (point-min)) -;;; -;;; Key mapping functions -;;; -(defun tpu-lucid-map-key (ident descrip func gold-func) - (interactive) - (setq tpu-key-seq (read-key-sequence (format "Press %s%s: " ident descrip))) - (setq tpu-key (concat "[" (format "%s" (event-key (aref tpu-key-seq 0))) "]")) - (cond ((not (equal tpu-key tpu-return)) - (set-buffer "Keys") - (insert (format"(global-set-key %s %s)\n" tpu-key func)) - (set-buffer "Gold-Keys") - (insert (format "(define-key GOLD-map %s %s)\n" tpu-key gold-func)) - (set-buffer "Directions")) - ;; bogosity to get next prompt to come up, if the user hits <CR>! - ;; check periodically to see if this is still needed... - (t - (format "%s" tpu-key))) - tpu-key) - -(defun tpu-emacs-map-key (ident descrip func gold-func) - (interactive) - (message "Press %s%s: " ident descrip) - (setq tpu-key-seq (read-event)) - (setq tpu-key (concat "[" (format "%s" tpu-key-seq) "]")) - (cond ((not (equal tpu-key tpu-return)) - (set-buffer "Keys") - (insert (format"(global-set-key %s %s)\n" tpu-key func)) - (set-buffer "Gold-Keys") - (insert (format "(define-key GOLD-map %s %s)\n" tpu-key gold-func)) - (set-buffer "Directions")) - ;; bogosity to get next prompt to come up, if the user hits <CR>! - ;; check periodically to see if this is still needed... - (t - (format "%s" tpu-key))) - tpu-key) + ;; Save <CR> for future reference -(fset 'tpu-map-key (if tpu-lucid-emacs19-p 'tpu-lucid-map-key 'tpu-emacs-map-key)) + (cond + ((featurep 'xemacs) + (setq tpu-return-seq (read-key-sequence "Hit carriage-return <CR> to continue ")) + (setq tpu-return (concat "[" (format "%s" (event-key (aref tpu-return-seq 0))) "]"))) + (t + (message "Hit carriage-return <CR> to continue ") + (setq tpu-return-seq (read-event)) + (setq tpu-return (concat "[" (format "%s" tpu-return-seq) "]")))) + ;; Build the keymap file -(set-buffer "Keys") -(insert " + (set-buffer "Keys") + (insert " ;; Arrows ;; ") -(set-buffer "Gold-Keys") -(insert " + (set-buffer "Gold-Keys") + (insert " ;; GOLD Arrows ;; ") -(set-buffer "Directions") - -(tpu-map-key "Up-Arrow" "" "'tpu-previous-line" "'tpu-move-to-beginning") -(tpu-map-key "Down-arrow" "" "'tpu-next-line" "'tpu-move-to-end") -(tpu-map-key "Right-arrow" "" "'tpu-forward-char" "'end-of-line") -(tpu-map-key "Left-arrow" "" "'tpu-backward-char" "'beginning-of-line") + (set-buffer "Directions") + (tpu-map-key "Up-Arrow" "" "'tpu-previous-line" "'tpu-move-to-beginning") + (tpu-map-key "Down-arrow" "" "'tpu-next-line" "'tpu-move-to-end") + (tpu-map-key "Right-arrow" "" "'tpu-forward-char" "'end-of-line") + (tpu-map-key "Left-arrow" "" "'tpu-backward-char" "'beginning-of-line") -(set-buffer "Keys") -(insert " + (set-buffer "Keys") + (insert " ;; PF keys ;; ") -(set-buffer "Gold-Keys") -(insert " + (set-buffer "Gold-Keys") + (insert " ;; GOLD PF keys ;; ") -(set-buffer "Directions") + (set-buffer "Directions") -(tpu-map-key "PF1" " - The GOLD key" "GOLD-map" "'keyboard-quit") -(tpu-map-key "PF2" " - The Keypad Help key" "'tpu-help" "'help-for-help") -(tpu-map-key "PF3" " - The Find/Find-Next key" "'tpu-search-again" "'tpu-search") -(tpu-map-key "PF4" " - The Del/Undelete Line key" "'tpu-delete-current-line" "'tpu-undelete-lines") + (tpu-map-key "PF1" " - The GOLD key" "GOLD-map" "'keyboard-quit") + (tpu-map-key "PF2" " - The Keypad Help key" "'tpu-help" "'help-for-help") + (tpu-map-key "PF3" " - The Find/Find-Next key" "'tpu-search-again" "'tpu-search") + (tpu-map-key "PF4" " - The Del/Undelete Line key" "'tpu-delete-current-line" "'tpu-undelete-lines") -(set-buffer "Keys") -(insert " + (set-buffer "Keys") + (insert " ;; KP0-9 KP- KP, KP. and KPenter ;; ") -(set-buffer "Gold-Keys") -(insert " + (set-buffer "Gold-Keys") + (insert " ;; GOLD KP0-9 KP- KP, and KPenter ;; ") -(set-buffer "Directions") - -(tpu-map-key "KP-0" " - The Line/Open-Line key" "'tpu-line" "'open-line") -(tpu-map-key "KP-1" " - The Word/Change-Case key" "'tpu-word" "'tpu-change-case") -(tpu-map-key "KP-2" " - The EOL/Delete-EOL key" "'tpu-end-of-line" "'tpu-delete-to-eol") -(tpu-map-key "KP-3" " - The Character/Special-Insert key" "'tpu-char" "'tpu-special-insert") -(setq tpu-kp4 (tpu-map-key "KP-4" " - The Forward/Bottom key" "'tpu-advance-direction" "'tpu-move-to-end")) -(setq tpu-kp5 (tpu-map-key "KP-5" " - The Reverse/Top key" "'tpu-backup-direction" "'tpu-move-to-beginning")) -(tpu-map-key "KP-6" " - The Remove/Insert key" "'tpu-cut" "'tpu-paste") -(tpu-map-key "KP-7" " - The Page/Do key" "'tpu-page" "'execute-extended-command") -(tpu-map-key "KP-8" " - The Section/Fill key" "'tpu-scroll-window" "'tpu-fill") -(tpu-map-key "KP-9" " - The Append/Replace key" "'tpu-append-region" "'tpu-replace") -(tpu-map-key "KP--" " - The Delete/Undelete Word key" "'tpu-delete-current-word" "'tpu-undelete-words") -(tpu-map-key "KP-," " - The Delete/Undelete Character key" "'tpu-delete-current-char" "'tpu-undelete-char") -(tpu-map-key "KP-." " - The Select/Reset key" "'tpu-select" "'tpu-unselect") -(tpu-map-key "KP-Enter" " - The Enter key on the numeric keypad" "'newline" "'tpu-substitute") -;; Save the enter key -(setq tpu-enter tpu-key) -(setq tpu-enter-seq tpu-key-seq) - -(set-buffer "Keys") -(insert " + (set-buffer "Directions") + + (tpu-map-key "KP-0" " - The Line/Open-Line key" "'tpu-line" "'open-line") + (tpu-map-key "KP-1" " - The Word/Change-Case key" "'tpu-word" "'tpu-change-case") + (tpu-map-key "KP-2" " - The EOL/Delete-EOL key" "'tpu-end-of-line" "'tpu-delete-to-eol") + (tpu-map-key "KP-3" " - The Character/Special-Insert key" "'tpu-char" "'tpu-special-insert") + (setq tpu-kp4 (tpu-map-key "KP-4" " - The Forward/Bottom key" "'tpu-advance-direction" "'tpu-move-to-end")) + (setq tpu-kp5 (tpu-map-key "KP-5" " - The Reverse/Top key" "'tpu-backup-direction" "'tpu-move-to-beginning")) + (tpu-map-key "KP-6" " - The Remove/Insert key" "'tpu-cut" "'tpu-paste") + (tpu-map-key "KP-7" " - The Page/Do key" "'tpu-page" "'execute-extended-command") + (tpu-map-key "KP-8" " - The Section/Fill key" "'tpu-scroll-window" "'tpu-fill") + (tpu-map-key "KP-9" " - The Append/Replace key" "'tpu-append-region" "'tpu-replace") + (tpu-map-key "KP--" " - The Delete/Undelete Word key" "'tpu-delete-current-word" "'tpu-undelete-words") + (tpu-map-key "KP-," " - The Delete/Undelete Character key" "'tpu-delete-current-char" "'tpu-undelete-char") + (tpu-map-key "KP-." " - The Select/Reset key" "'tpu-select" "'tpu-unselect") + (tpu-map-key "KP-Enter" " - The Enter key on the numeric keypad" "'newline" "'tpu-substitute") + ;; Save the enter key + (setq tpu-enter tpu-key) + (setq tpu-enter-seq tpu-key-seq) + + (set-buffer "Keys") + (insert " ;; Editing keypad (find, insert, remove) ;; (select, prev, next) ;; ") -(set-buffer "Gold-Keys") -(insert " + (set-buffer "Gold-Keys") + (insert " ;; GOLD Editing keypad (find, insert, remove) ;; (select, prev, next) ;; ") -(set-buffer "Directions") + (set-buffer "Directions") -(tpu-map-key "Find" " - The Find key on the editing keypad" "'tpu-search" "'nil") -(tpu-map-key "Insert" " - The Insert key on the editing keypad" "'tpu-paste" "'nil") -(tpu-map-key "Remove" " - The Remove key on the editing keypad" "'tpu-cut" "'tpu-store-text") -(tpu-map-key "Select" " - The Select key on the editing keypad" "'tpu-select" "'tpu-unselect") -(tpu-map-key "Prev Scr" " - The Prev Scr key on the editing keypad" "'tpu-scroll-window-down" "'tpu-previous-window") -(tpu-map-key "Next Scr" " - The Next Scr key on the editing keypad" "'tpu-scroll-window-up" "'tpu-next-window") + (tpu-map-key "Find" " - The Find key on the editing keypad" "'tpu-search" "'nil") + (tpu-map-key "Insert" " - The Insert key on the editing keypad" "'tpu-paste" "'nil") + (tpu-map-key "Remove" " - The Remove key on the editing keypad" "'tpu-cut" "'tpu-store-text") + (tpu-map-key "Select" " - The Select key on the editing keypad" "'tpu-select" "'tpu-unselect") + (tpu-map-key "Prev Scr" " - The Prev Scr key on the editing keypad" "'tpu-scroll-window-down" "'tpu-previous-window") + (tpu-map-key "Next Scr" " - The Next Scr key on the editing keypad" "'tpu-scroll-window-up" "'tpu-next-window") -(set-buffer "Keys") -(insert " + (set-buffer "Keys") + (insert " ;; F10-14 Help Do F17 ;; ") -(set-buffer "Gold-Keys") -(insert " + (set-buffer "Gold-Keys") + (insert " ;; GOLD F10-14 Help Do F17 ;; ") -(set-buffer "Directions") - -(tpu-map-key "F10" " - Invokes the Exit function on VT200+ terminals" "'tpu-exit" "'nil") -(tpu-map-key "F11" " - Inserts an Escape character into the text" "'tpu-insert-escape" "'nil") -(tpu-map-key "Backspace" " - Not Delete nor ^H! Sometimes on the F12 key" "'tpu-next-beginning-of-line" "'nil") -(tpu-map-key "F13" " - Invokes the delete previous word function" "'tpu-delete-previous-word" "'nil") -(tpu-map-key "F14" " - Toggles insert/overstrike modes" "'tpu-toggle-overwrite-mode" "'nil") -(tpu-map-key "Help" " - Brings up the help screen, same as PF2" "'tpu-help" "'describe-bindings") -(tpu-map-key "Do" " - Invokes the COMMAND function" "'execute-extended-command" "'nil") -(tpu-map-key "F17" "" "'tpu-goto-breadcrumb" "'tpu-drop-breadcrumb") - -(set-buffer "Gold-Keys") -(cond - ((not (equal tpu-enter tpu-return)) - (insert " + (set-buffer "Directions") + + (tpu-map-key "F10" " - Invokes the Exit function on VT200+ terminals" "'tpu-exit" "'nil") + (tpu-map-key "F11" " - Inserts an Escape character into the text" "'tpu-insert-escape" "'nil") + (tpu-map-key "Backspace" " - Not Delete nor ^H! Sometimes on the F12 key" "'tpu-next-beginning-of-line" "'nil") + (tpu-map-key "F13" " - Invokes the delete previous word function" "'tpu-delete-previous-word" "'nil") + (tpu-map-key "F14" " - Toggles insert/overstrike modes" "'tpu-toggle-overwrite-mode" "'nil") + (tpu-map-key "Help" " - Brings up the help screen, same as PF2" "'tpu-help" "'describe-bindings") + (tpu-map-key "Do" " - Invokes the COMMAND function" "'execute-extended-command" "'nil") + (tpu-map-key "F17" "" "'tpu-goto-breadcrumb" "'tpu-drop-breadcrumb") + + (set-buffer "Gold-Keys") + (cond + ((not (equal tpu-enter tpu-return)) + (insert " ;; Minibuffer map additions to make KP_enter = RET ;; ") - (insert (format "(define-key minibuffer-local-map %s 'exit-minibuffer)\n" tpu-enter)) - (insert (format "(define-key minibuffer-local-ns-map %s 'exit-minibuffer)\n" tpu-enter)) - (insert (format "(define-key minibuffer-local-completion-map %s 'exit-minibuffer)\n" tpu-enter)) - (insert (format "(define-key minibuffer-local-must-match-map %s 'minibuffer-complete-and-exit)\n" tpu-enter)))) + (insert (format "(define-key minibuffer-local-map %s 'exit-minibuffer)\n" tpu-enter)) + ;; These are not necessary because they are inherited. + ;; (insert (format "(define-key minibuffer-local-ns-map %s 'exit-minibuffer)\n" tpu-enter)) + ;; (insert (format "(define-key minibuffer-local-completion-map %s 'exit-minibuffer)\n" tpu-enter)) + (insert (format "(define-key minibuffer-local-must-match-map %s 'minibuffer-complete-and-exit)\n" tpu-enter)))) -(cond - ((not (or (equal tpu-kp4 tpu-return) (equal tpu-kp5 tpu-return))) - (insert " + (cond + ((not (or (equal tpu-kp4 tpu-return) (equal tpu-kp5 tpu-return))) + (insert " ;; Minibuffer map additions to allow KP-4/5 termination of search strings. ;; ") - (insert (format "(define-key minibuffer-local-map %s 'tpu-search-forward-exit)\n" tpu-kp4)) - (insert (format "(define-key minibuffer-local-map %s 'tpu-search-backward-exit)\n" tpu-kp5)))) + (insert (format "(define-key minibuffer-local-map %s 'tpu-search-forward-exit)\n" tpu-kp4)) + (insert (format "(define-key minibuffer-local-map %s 'tpu-search-backward-exit)\n" tpu-kp5)))) -(insert " + (insert " ;; Define the tpu-help-enter/return symbols ;; ") -(cond (tpu-lucid-emacs19-p - (insert (format "(setq tpu-help-enter \"%s\")\n" tpu-enter-seq)) - (insert (format "(setq tpu-help-return \"%s\")\n" tpu-return-seq)) - (insert "(setq tpu-help-N \"[#<keypress-event N>]\")\n") - (insert "(setq tpu-help-n \"[#<keypress-event n>]\")\n") - (insert "(setq tpu-help-P \"[#<keypress-event P>]\")\n") - (insert "(setq tpu-help-p \"[#<keypress-event p>]\")\n")) - (t - (insert (format "(setq tpu-help-enter \"%s\")\n" tpu-enter)))) + (cond ((featurep 'xemacs) + (insert (format "(setq tpu-help-enter \"%s\")\n" tpu-enter-seq)) + (insert (format "(setq tpu-help-return \"%s\")\n" tpu-return-seq)) + (insert "(setq tpu-help-N \"[#<keypress-event N>]\")\n") + (insert "(setq tpu-help-n \"[#<keypress-event n>]\")\n") + (insert "(setq tpu-help-P \"[#<keypress-event P>]\")\n") + (insert "(setq tpu-help-p \"[#<keypress-event p>]\")\n")) + (t + (insert (format "(setq tpu-help-enter \"%s\")\n" tpu-enter)))) -(append-to-buffer "Keys" 1 (point)) -(set-buffer "Keys") + (append-to-buffer "Keys" 1 (point)) + (set-buffer "Keys") -;;; -;;; Save the key mapping program -;;; -(let ((file - (convert-standard-filename - (if tpu-lucid-emacs19-p "~/.tpu-lucid-keys" "~/.tpu-keys")))) - (set-visited-file-name - (read-file-name (format "Save key mapping to file (default %s): " file) "" file))) -(save-buffer) + ;; Save the key mapping program -;;; -;;; Load the newly defined keys and clean up -;;; -(eval-buffer) -(kill-buffer (current-buffer)) -(kill-buffer "*scratch*") -(kill-buffer "Gold-Keys") + (let ((file + (convert-standard-filename + (if (featurep 'xemacs) "~/.tpu-lucid-keys" "~/.tpu-keys")))) + (set-visited-file-name + (read-file-name (format "Save key mapping to file (default %s): " file) "" file))) + (save-buffer) -;;; -;;; Let them know it worked. -;;; -(switch-to-buffer "Directions") -(erase-buffer) -(insert " + ;; Load the newly defined keys and clean up + + (require 'tpu-edt) + (eval-buffer) + (kill-buffer (current-buffer)) + (kill-buffer "*scratch*") + (kill-buffer "Gold-Keys") + + ;; Let them know it worked. + + (switch-to-buffer "Directions") + (erase-buffer) + (insert " A custom TPU-edt keymap file has been created. Press GOLD-k to remove this buffer and continue editing. ") -(goto-char (point-min)) + (goto-char (point-min))) -;;; arch-tag: bab5872f-cd3a-4c1c-aedb-047b67646f6c +;; arch-tag: bab5872f-cd3a-4c1c-aedb-047b67646f6c ;;; tpu-mapper.el ends here diff --git a/lisp/emulation/vi.el b/lisp/emulation/vi.el index 977a7980803..de7bcffdf0e 100644 --- a/lisp/emulation/vi.el +++ b/lisp/emulation/vi.el @@ -801,7 +801,7 @@ The given COUNT is remembered for future scrollings." (defun vi-previous-line-first-nonwhite (count) "Go up COUNT lines. Stop at first non-white." (interactive "p") - (previous-line count) + (forward-line (- count)) (back-to-indentation)) (defun vi-scroll-up-window (count) @@ -1062,7 +1062,7 @@ MOTION-COMMAND with ARG. (setq end (1+ end))) ((eq moving-unit 'line) (goto-char begin) (beginning-of-line) (setq begin (point)) - (goto-char end) (next-line 1) (beginning-of-line) (setq end (point)))) + (goto-char end) (forward-line 1) (beginning-of-line) (setq end (point)))) (if (> end (point-max)) (setq end (point-max))) ; force in buffer region (cons begin end))))) @@ -1124,7 +1124,7 @@ text as lines. If the optional after-p is given, put after/below the cursor." (t (error "Register %c is not containing text string" reg)))) (if (vi-string-end-with-nl-p put-text) ; put back text as lines (if after-p - (progn (next-line 1) (beginning-of-line)) + (progn (forward-line 1) (beginning-of-line)) (beginning-of-line)) (if after-p (forward-char 1))) (push-mark (point)) @@ -1375,6 +1375,8 @@ The following CHAR will be the name for the command or macro." (setq char (read-char)) (vi-ask-for-info char)))) +(declare-function c-mark-function "cc-cmds" ()) + (defun vi-mark-region (arg region) "Mark region appropriately. The next char REGION is d(efun),s(-exp),b(uffer), p(aragraph), P(age), f(unction in C/Pascal etc.), w(ord), e(nd of sentence), diff --git a/lisp/emulation/vip.el b/lisp/emulation/vip.el index 5a4e0cbbd5f..b4f80a9e1ed 100644 --- a/lisp/emulation/vip.el +++ b/lisp/emulation/vip.el @@ -874,7 +874,7 @@ is the name of the register for COM." (set-mark beg)) (beginning-of-line) (exchange-point-and-mark) - (if (or (not (eobp)) (not (bolp))) (next-line 1)) + (if (or (not (eobp)) (not (bolp))) (with-no-warnings (next-line 1))) (beginning-of-line) (if (> beg end) (exchange-point-and-mark))) @@ -1050,7 +1050,7 @@ command was invoked with argument > 1." (defun vip-line (arg) (let ((val (car arg)) (com (cdr arg))) (move-marker vip-com-point (point)) - (next-line (1- val)) + (with-no-warnings (next-line (1- val))) (vip-execute-com 'vip-line val com))) (defun vip-yank-line (arg) @@ -1263,7 +1263,7 @@ beginning of buffer, stop and signal error." (interactive "P") (let ((val (vip-p-val arg)) (com (vip-getCom arg))) (if com (move-marker vip-com-point (point))) - (next-line val) + (with-no-warnings (next-line val)) (back-to-indentation) (if com (vip-execute-com 'vip-next-line-at-bol val com)))) @@ -1272,7 +1272,7 @@ beginning of buffer, stop and signal error." (interactive "P") (let ((val (vip-p-val arg)) (com (vip-getCom arg))) (if com (move-marker vip-com-point (point))) - (next-line (- val)) + (with-no-warnings (next-line (- val))) (setq this-command 'previous-line) (if com (vip-execute-com 'vip-previous-line val com)))) @@ -1281,7 +1281,7 @@ beginning of buffer, stop and signal error." (interactive "P") (let ((val (vip-p-val arg)) (com (vip-getCom arg))) (if com (move-marker vip-com-point (point))) - (next-line (- val)) + (with-no-warnings (next-line (- val))) (back-to-indentation) (if com (vip-execute-com 'vip-previous-line val com)))) @@ -1323,7 +1323,7 @@ after search." ;; forward search begins here (if (eolp) (error "") (point)) ;; forward search ends here - (progn (next-line 1) (beginning-of-line) (point))) + (progn (with-no-warnings (next-line 1)) (beginning-of-line) (point))) (narrow-to-region ;; backward search begins from here (if (bolp) (error "") (point)) @@ -1803,7 +1803,7 @@ STRING. Search will be forward if FORWARD, otherwise backward." (setq vip-use-register nil) (if (vip-end-with-a-newline-p text) (progn - (next-line 1) + (with-no-warnings (next-line 1)) (beginning-of-line)) (if (and (not (eolp)) (not (eobp))) (forward-char))) (setq vip-d-com (list 'vip-put-back val nil vip-use-register)) @@ -2883,7 +2883,7 @@ a token has type \(command, address, end-mark\) and value." (let ((point (if (null ex-addresses) (point) (car ex-addresses))) (variant nil) command file) (goto-char point) - (if (not (= point 0)) (next-line 1)) + (if (not (= point 0)) (with-no-warnings (next-line 1))) (beginning-of-line) (save-window-excursion (set-buffer " *ex-working-space*") diff --git a/lisp/emulation/viper-cmd.el b/lisp/emulation/viper-cmd.el index 4da698fdd0d..3d74286589c 100644 --- a/lisp/emulation/viper-cmd.el +++ b/lisp/emulation/viper-cmd.el @@ -27,7 +27,6 @@ ;;; Code: (provide 'viper-cmd) -(require 'advice) ;; Compiler pacifier (defvar viper-minibuffer-current-face) @@ -48,23 +47,6 @@ (defvar initial) (defvar undo-beg-posn) (defvar undo-end-posn) - -;; loading happens only in non-interactive compilation -;; in order to spare non-viperized emacs from being viperized -(if noninteractive - (eval-when-compile - (let ((load-path (cons (expand-file-name ".") load-path))) - (or (featurep 'viper-util) - (load "viper-util.el" nil nil 'nosuffix)) - (or (featurep 'viper-keym) - (load "viper-keym.el" nil nil 'nosuffix)) - (or (featurep 'viper-mous) - (load "viper-mous.el" nil nil 'nosuffix)) - (or (featurep 'viper-macs) - (load "viper-macs.el" nil nil 'nosuffix)) - (or (featurep 'viper-ex) - (load "viper-ex.el" nil nil 'nosuffix)) - ))) ;; end pacifier @@ -106,7 +88,7 @@ ;; define viper-charpair-command-p (viper-test-com-defun viper-charpair-command) -(defconst viper-movement-commands '(?b ?B ?e ?E ?f ?F ?G ?h ?H ?j ?k ?l +(defconst viper-movement-commands '(?b ?B ?e ?E ?f ?F ?G ?h ?j ?k ?l ?H ?M ?L ?n ?t ?T ?w ?W ?$ ?% ?^ ?( ?) ?- ?+ ?| ?{ ?} ?[ ?] ?' ?` ?\; ?, ?0 ?? ?/ ?\ ?\C-m @@ -834,7 +816,7 @@ Vi's prefix argument will be used. Otherwise, the prefix argument passed to viper-emacs-kbd-minor-mode ch) (cond ((and viper-special-input-method - viper-emacs-p + (featurep 'emacs) (fboundp 'quail-input-method)) ;; (let ...) is used to restore unread-command-events to the ;; original state. We don't want anything left in there after @@ -861,7 +843,7 @@ Vi's prefix argument will be used. Otherwise, the prefix argument passed to (1- (length quail-current-str))))) )) ((and viper-special-input-method - viper-xemacs-p + (featurep 'xemacs) (fboundp 'quail-start-translation)) ;; same as above but for XEmacs, which doesn't have ;; quail-input-method @@ -893,7 +875,7 @@ Vi's prefix argument will be used. Otherwise, the prefix argument passed to (t ;;(setq ch (read-char-exclusive)) (setq ch (aref (read-key-sequence nil) 0)) - (if viper-xemacs-p + (if (featurep 'xemacs) (setq ch (event-to-character ch))) ;; replace ^M with the newline (if (eq ch ?\C-m) (setq ch ?\n)) @@ -902,13 +884,13 @@ Vi's prefix argument will be used. Otherwise, the prefix argument passed to (progn ;;(setq ch (read-char-exclusive)) (setq ch (aref (read-key-sequence nil) 0)) - (if viper-xemacs-p + (if (featurep 'xemacs) (setq ch (event-to-character ch)))) ) (insert ch)) ) (setq last-command-event - (viper-copy-event (if viper-xemacs-p + (viper-copy-event (if (featurep 'xemacs) (character-to-event ch) ch))) ) ; let (error nil) @@ -1080,10 +1062,10 @@ as a Meta key and any number of multiple escapes is allowed." ;; and return ESC as the key-sequence (viper-set-unread-command-events (viper-subseq keyseq 1)) (setq last-input-event event - keyseq (if viper-emacs-p + keyseq (if (featurep 'emacs) "\e" (vector (character-to-event ?\e))))) - ((and viper-xemacs-p + ((and (featurep 'xemacs) (key-press-event-p first-key) (equal '(meta) key-mod)) (viper-set-unread-command-events @@ -1116,7 +1098,7 @@ as a Meta key and any number of multiple escapes is allowed." "Function that implements ESC key in Viper emulation of Vi." (interactive) (let ((cmd (or (key-binding (viper-envelop-ESC-key)) - '(lambda () (interactive) (error ""))))) + '(lambda () (interactive) (error "Viper bell"))))) ;; call the actual function to execute ESC (if no other symbols followed) ;; or the key bound to the ESC sequence (if the sequence was issued @@ -1238,7 +1220,7 @@ as a Meta key and any number of multiple escapes is allowed." ;; it is an error. (progn ;; new com is (CHAR . OLDCOM) - (if (viper-memq-char char '(?# ?\")) (error "")) + (if (viper-memq-char char '(?# ?\")) (error "Viper bell")) (setq com (cons char com)) (setq cont nil)) ;; If com is nil we set com as char, and read more. Again, if char is @@ -1257,7 +1239,7 @@ as a Meta key and any number of multiple escapes is allowed." (let ((reg (read-char))) (if (viper-valid-register reg) (setq viper-use-register reg) - (error "")) + (error "Viper bell")) (setq char (read-char)))) (t (setq com char) @@ -1279,7 +1261,7 @@ as a Meta key and any number of multiple escapes is allowed." (viper-regsuffix-command-p char) (viper= char ?!) ; bang command (viper= char ?g) ; the gg command (like G0) - (error "")) + (error "Viper bell")) (setq cmd-to-exec-at-end (viper-exec-form-in-vi `(key-binding (char-to-string ,char))))) @@ -1313,18 +1295,18 @@ as a Meta key and any number of multiple escapes is allowed." ((equal com '(?= . ?=)) (viper-line (cons value ?=))) ;; gg acts as G0 ((equal (car com) ?g) (viper-goto-line 0)) - (t (error ""))))) + (t (error "Viper bell"))))) (if cmd-to-exec-at-end (progn (setq last-command-char char) (setq last-command-event (viper-copy-event - (if viper-xemacs-p (character-to-event char) char))) - (condition-case nil + (if (featurep 'xemacs) (character-to-event char) char))) + (condition-case err (funcall cmd-to-exec-at-end cmd-info) (error - (error ""))))) + (error "%s" (error-message-string err)))))) )) (defun viper-describe-arg (arg) @@ -1902,7 +1884,7 @@ With prefix argument, find next destructive command." (setq viper-intermediate-command 'repeating-display-destructive-command) ;; first search through command history--set temp ring - (setq viper-temp-command-ring (copy-list viper-command-ring))) + (setq viper-temp-command-ring (ring-copy viper-command-ring))) (setq cmd (if next (viper-special-ring-rotate1 viper-temp-command-ring 1) (viper-special-ring-rotate1 viper-temp-command-ring -1))) @@ -1936,7 +1918,7 @@ to in the global map, instead of cycling through the insertion ring." (length viper-last-inserted-string-from-insertion-ring)))) ) ;;first search through insertion history - (setq viper-temp-insertion-ring (copy-list viper-insertion-ring))) + (setq viper-temp-insertion-ring (ring-copy viper-insertion-ring))) (setq this-command 'viper-insert-from-insertion-ring) ;; so that things will be undone properly (setq buffer-undo-list (cons nil buffer-undo-list)) @@ -2738,9 +2720,9 @@ On reaching end of line, stop and signal error." ;; the forward motion before the 'viper-execute-com', but, of ;; course, 'dl' doesn't work on an empty line, so we have to ;; catch that condition before 'viper-execute-com' - (if (and (eolp) (bolp)) (error "") (forward-char val)) + (if (and (eolp) (bolp)) (error "Viper bell") (forward-char val)) (if com (viper-execute-com 'viper-forward-char val com)) - (if (eolp) (progn (backward-char 1) (error "")))) + (if (eolp) (progn (backward-char 1) (error "Viper bell")))) (forward-char val) (if com (viper-execute-com 'viper-forward-char val com))))) @@ -2755,7 +2737,7 @@ On reaching beginning of line, stop and signal error." (if com (viper-move-marker-locally 'viper-com-point (point))) (if viper-ex-style-motion (progn - (if (bolp) (error "") (backward-char val)) + (if (bolp) (error "Viper bell") (backward-char val)) (if com (viper-execute-com 'viper-backward-char val com))) (backward-char val) (if com (viper-execute-com 'viper-backward-char val com))))) @@ -2790,7 +2772,8 @@ On reaching beginning of line, stop and signal error." (defun viper-next-line-carefully (arg) (condition-case nil - (next-line arg) + ;; do not use forward-line! need to keep column + (with-no-warnings (next-line arg)) (error nil))) @@ -3078,7 +3061,7 @@ On reaching beginning of line, stop and signal error." (if com (viper-execute-com 'viper-goto-col val com)) (save-excursion (end-of-line) - (if (> val (current-column)) (error ""))) + (if (> val (current-column)) (error "Viper bell"))) )) @@ -3089,12 +3072,16 @@ On reaching beginning of line, stop and signal error." (let ((val (viper-p-val arg)) (com (viper-getCom arg))) (if com (viper-move-marker-locally 'viper-com-point (point))) - (next-line val) + ;; do not use forward-line! need to keep column + (with-no-warnings (next-line val)) (if viper-ex-style-motion (if (and (eolp) (not (bolp))) (backward-char 1))) (setq this-command 'next-line) (if com (viper-execute-com 'viper-next-line val com)))) +(declare-function widget-type "wid-edit" (widget)) +(declare-function widget-button-press "wid-edit" (pos &optional event)) +(declare-function viper-set-hooks "viper" ()) (defun viper-next-line-at-bol (arg) "Next line at beginning of line. @@ -3132,7 +3119,8 @@ If point is on a widget or a button, simulate clicking on that widget/button." (let ((val (viper-p-val arg)) (com (viper-getCom arg))) (if com (viper-move-marker-locally 'viper-com-point (point))) - (previous-line val) + ;; do not use forward-line! need to keep column + (with-no-warnings (previous-line val)) (if viper-ex-style-motion (if (and (eolp) (not (bolp))) (backward-char 1))) (setq this-command 'previous-line) @@ -3198,7 +3186,7 @@ If point is on a widget or a button, simulate clicking on that widget/button." ;; If FORWARD then search is forward, otherwise backward. OFFSET is used to ;; adjust point after search. (defun viper-find-char (arg char forward offset) - (or (char-or-string-p char) (error "")) + (or (char-or-string-p char) (error "Viper bell")) (let ((arg (if forward arg (- arg))) (cmd (if (eq viper-intermediate-command 'viper-repeat) (nth 5 viper-d-com) @@ -3544,7 +3532,7 @@ controlled by the sign of prefix numeric value." (if com (viper-move-marker-locally 'viper-com-point (point))) (backward-sexp 1) (if com (viper-execute-com 'viper-paren-match nil com))) - (t (error "")))))) + (t (error "Viper bell")))))) (defun viper-toggle-parse-sexp-ignore-comments () (interactive) @@ -4107,7 +4095,7 @@ Null string will repeat previous search." (let ((reg viper-use-register)) (setq viper-use-register nil) (error viper-EmptyRegister reg)) - (error ""))) + (error "Viper bell"))) (setq viper-use-register nil) (if (viper-end-with-a-newline-p text) (progn @@ -4157,7 +4145,7 @@ Null string will repeat previous search." (let ((reg viper-use-register)) (setq viper-use-register nil) (error viper-EmptyRegister reg)) - (error ""))) + (error "Viper bell"))) (setq viper-use-register nil) (if (viper-end-with-a-newline-p text) (beginning-of-line)) (viper-set-destructive-command @@ -4202,7 +4190,7 @@ Null string will repeat previous search." (> val (viper-chars-in-region (point) (viper-line-pos 'end)))) (setq val (viper-chars-in-region (point) (viper-line-pos 'end)))) (if (and viper-ex-style-motion (eolp)) - (if (bolp) (error "") (setq val 0))) ; not bol---simply back 1 ch + (if (bolp) (error "Viper bell") (setq val 0))) ; not bol---simply back 1 ch (save-excursion (viper-forward-char-carefully val) (setq end-del-pos (point))) @@ -4467,7 +4455,7 @@ and regexp replace." ((viper= char ?,) (viper-cycle-through-mark-ring)) ((viper= char ?^) (push-mark viper-saved-mark t t)) ((viper= char ?D) (mark-defun)) - (t (error "")) + (t (error "Viper bell")) ))) ;; Algorithm: If first invocation of this command save mark on ring, goto @@ -4566,7 +4554,7 @@ One can use `` and '' to temporarily jump 1 step back." (switch-to-buffer buff) (goto-char viper-com-point) (viper-change-state-to-vi) - (error ""))))) + (error "Viper bell"))))) ((and (not skip-white) (viper= char ?`)) (if com (viper-move-marker-locally 'viper-com-point (point))) (if (and (viper-same-line (point) viper-last-jump) diff --git a/lisp/emulation/viper-ex.el b/lisp/emulation/viper-ex.el index 23e399fa79b..6ce34852235 100644 --- a/lisp/emulation/viper-ex.el +++ b/lisp/emulation/viper-ex.el @@ -47,12 +47,8 @@ (if noninteractive (eval-when-compile (let ((load-path (cons (expand-file-name ".") load-path))) - (or (featurep 'viper-util) - (load "viper-util.el" nil nil 'nosuffix)) - (or (featurep 'viper-keym) - (load "viper-keym.el" nil nil 'nosuffix)) (or (featurep 'viper-cmd) - (load "viper-cmd.el" nil nil 'nosuffix)) + (load "viper-cmd.el" nil t 'nosuffix)) ))) ;; end pacifier @@ -651,17 +647,19 @@ reversed." (setq initial-str (format "%d,%d" reg-beg-line reg-end-line))) (setq com-str - (or string (viper-read-string-with-history - ":" - initial-str - 'viper-ex-history - ;; no default when working on region - (if initial-str - nil - (car viper-ex-history)) - map - (if initial-str - " [Type command to execute on current region]")))) + (if string + (concat initial-str string) + (viper-read-string-with-history + ":" + initial-str + 'viper-ex-history + ;; no default when working on region + (if initial-str + nil + (car viper-ex-history)) + map + (if initial-str + " [Type command to execute on current region]")))) (save-window-excursion ;; just a precaution (setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name)) @@ -1101,7 +1099,7 @@ reversed." beg end cont val) (viper-add-keymap ex-read-filename-map - (if viper-emacs-p + (if (featurep 'emacs) minibuffer-local-completion-map read-file-name-map)) @@ -1236,7 +1234,7 @@ reversed." (read-string "[Hit return to confirm] ") (quit (save-excursion (kill-buffer " *delete text*")) - (error ""))) + (error "Viper bell"))) (save-excursion (kill-buffer " *delete text*"))) (if ex-buffer (cond ((viper-valid-register ex-buffer '(Letter)) @@ -1556,7 +1554,7 @@ reversed." ;; setup buffer (if (setq wind (viper-get-visible-buffer-window buf)) () - (setq wind (get-lru-window (if viper-xemacs-p nil 'visible))) + (setq wind (get-lru-window (if (featurep 'xemacs) nil 'visible))) (set-window-buffer wind buf)) (if (viper-window-display-p) @@ -1876,7 +1874,7 @@ reversed." (condition-case nil (progn (pop-to-buffer (get-buffer-create "*info*")) - (info (if viper-xemacs-p "viper.info" "viper")) + (info (if (featurep 'xemacs) "viper.info" "viper")) (message "Type `i' to search for a specific topic")) (error (beep 1) (with-output-to-temp-buffer " *viper-info*" @@ -1885,7 +1883,7 @@ The Info file for Viper does not seem to be installed. This file is part of the standard distribution of %sEmacs. Please contact your system administrator. " - (if viper-xemacs-p "X" "") + (if (featurep 'xemacs) "X" "") )))))) ;; Ex source command. Loads the file specified as argument or `~/.viper' diff --git a/lisp/emulation/viper-init.el b/lisp/emulation/viper-init.el index 2e06b24e0bb..d0f89751d57 100644 --- a/lisp/emulation/viper-init.el +++ b/lisp/emulation/viper-init.el @@ -26,8 +26,6 @@ ;;; Code: -(provide 'viper-init) - ;; compiler pacifier (defvar mark-even-if-inactive) (defvar quail-mode) @@ -49,10 +47,6 @@ (interactive) (message "Viper version is %s" viper-version)) -;; Is it XEmacs? -(defconst viper-xemacs-p (string-match "XEmacs" emacs-version)) -;; Is it Emacs? -(defconst viper-emacs-p (not viper-xemacs-p)) ;; Tell whether we are running as a window application or on a TTY ;; This is used to avoid compilation warnings. When emacs/xemacs forms can @@ -61,7 +55,7 @@ ;; compiler at hand. ;; Suggested by rms. (defmacro viper-cond-compile-for-xemacs-or-emacs (xemacs-form emacs-form) - (if (string-match "XEmacs" emacs-version) + (if (featurep 'xemacs) xemacs-form emacs-form)) @@ -97,6 +91,13 @@ :tag "Is it VMS?" :group 'viper-misc) +(defcustom viper-suppress-input-method-change-message nil + "If t, the message notifying about changes in the input method is not displayed. +Normally, a message is displayed each time on enters the vi, insert or replace +state." + :type 'boolean + :group 'viper-misc) + (defcustom viper-force-faces nil "If t, Viper will think that it is running on a display that supports faces. This is provided as a temporary relief for users of graphics-capable terminals @@ -109,8 +110,8 @@ In all likelihood, you don't need to bother with this setting." (cond ((viper-window-display-p)) (viper-force-faces) ((viper-color-display-p)) - (viper-emacs-p (memq (viper-device-type) '(pc))) - (viper-xemacs-p (memq (viper-device-type) '(tty pc))))) + ((featurep 'emacs) (memq (viper-device-type) '(pc))) + ((featurep 'xemacs) (memq (viper-device-type) '(tty pc))))) ;;; Macros @@ -326,7 +327,8 @@ Use `M-x viper-set-expert-level' to change this.") ;; turn off special input methods in vi-state (if (eq viper-current-state 'vi-state) (viper-set-input-method nil)) - (if (memq viper-current-state '(vi-state insert-state replace-state)) + (if (and (memq viper-current-state '(vi-state insert-state replace-state)) + (not viper-suppress-input-method-change-message)) (message "Viper special input method%s: on" (if (or current-input-method default-input-method) (format " %S" @@ -339,7 +341,8 @@ Use `M-x viper-set-expert-level' to change this.") (if (null viper-mule-hook-flag) () (setq viper-special-input-method nil) - (if (memq viper-current-state '(vi-state insert-state replace-state)) + (if (and (memq viper-current-state '(vi-state insert-state replace-state)) + (not viper-suppress-input-method-change-message)) (message "Viper special input method%s: off" (if (or current-input-method default-input-method) (format " %S" @@ -347,9 +350,9 @@ Use `M-x viper-set-expert-level' to change this.") ""))))) (defun viper-inactivate-input-method () - (cond ((and viper-emacs-p (fboundp 'inactivate-input-method)) + (cond ((and (featurep 'emacs) (fboundp 'inactivate-input-method)) (inactivate-input-method)) - ((and viper-xemacs-p (boundp 'current-input-method)) + ((and (featurep 'xemacs) (boundp 'current-input-method)) ;; XEmacs had broken quil-mode for some time, so we are working around ;; it here (setq quail-mode nil) @@ -361,7 +364,7 @@ Use `M-x viper-set-expert-level' to change this.") (force-mode-line-update)) )) (defun viper-activate-input-method () - (cond ((and viper-emacs-p (fboundp 'activate-input-method)) + (cond ((and (featurep 'emacs) (fboundp 'activate-input-method)) (activate-input-method default-input-method)) ((featurep 'xemacs) (if (fboundp 'quail-mode) (quail-mode 1))))) @@ -369,7 +372,7 @@ Use `M-x viper-set-expert-level' to change this.") ;; Set quail-mode to ARG (defun viper-set-input-method (arg) (setq viper-mule-hook-flag t) ; just a precaution - (let (viper-mule-hook-flag) ; temporarily inactivate viper mule hooks + (let (viper-mule-hook-flag) ; temporarily deactivate viper mule hooks (cond ((and arg (> (prefix-numeric-value arg) 0) default-input-method) ;; activate input method (viper-activate-input-method)) @@ -424,15 +427,11 @@ delete the text being replaced, as in standard Vi." "*Cursor color when Viper is in Replace state." :type 'string :group 'viper) -(if (fboundp 'make-variable-frame-local) - (make-variable-frame-local 'viper-replace-overlay-cursor-color)) (defcustom viper-insert-state-cursor-color "Green" "Cursor color when Viper is in insert state." :type 'string :group 'viper) -(if (fboundp 'make-variable-frame-local) - (make-variable-frame-local 'viper-insert-state-cursor-color)) ;; viper-emacs-state-cursor-color doesn't work well. Causes cursor colors to be ;; confused in some cases. So, this var is nulled for now. @@ -441,13 +440,15 @@ delete the text being replaced, as in standard Vi." "Cursor color when Viper is in Emacs state." :type 'string :group 'viper) -(if (fboundp 'make-variable-frame-local) - (make-variable-frame-local 'viper-emacs-state-cursor-color)) ;; internal var, used to remember the default cursor color of emacs frames (defvar viper-vi-state-cursor-color nil) + (if (fboundp 'make-variable-frame-local) - (make-variable-frame-local 'viper-vi-state-cursor-color)) + (dolist (v '(viper-replace-overlay-cursor-color + viper-insert-state-cursor-color viper-emacs-state-cursor-color + viper-vi-state-cursor-color)) + (make-variable-frame-local v))) (viper-deflocalvar viper-replace-overlay nil "") (put 'viper-replace-overlay 'permanent-local t) @@ -466,7 +467,7 @@ is non-nil." :group 'viper) (defcustom viper-use-replace-region-delimiters (or (not (viper-has-face-support-p)) - (and viper-xemacs-p (eq (viper-device-type) 'tty))) + (and (featurep 'xemacs) (eq (viper-device-type) 'tty))) "*If non-nil, Viper will always use `viper-replace-region-end-delimiter' and `viper-replace-region-start-delimiter' to delimit replacement regions, even on color displays. By default, the delimiters are used only on TTYs." @@ -1009,17 +1010,20 @@ Should be set in `~/.viper' file." (defun viper-restore-cursor-type () (condition-case nil - (if viper-xemacs-p + (if (featurep 'xemacs) (set (make-local-variable 'bar-cursor) nil) (setq cursor-type default-cursor-type)) (error nil))) (defun viper-set-insert-cursor-type () - (if viper-xemacs-p + (if (featurep 'xemacs) (set (make-local-variable 'bar-cursor) 2) (setq cursor-type '(bar . 2)))) +(provide 'viper-init) + + ;; Local Variables: ;; eval: (put 'viper-deflocalvar 'lisp-indent-hook 'defun) ;; End: diff --git a/lisp/emulation/viper-keym.el b/lisp/emulation/viper-keym.el index 7a84a936b3b..f76a9310518 100644 --- a/lisp/emulation/viper-keym.el +++ b/lisp/emulation/viper-keym.el @@ -26,8 +26,6 @@ ;;; Code: -(provide 'viper-keym) - ;; compiler pacifier (defvar viper-always) (defvar viper-current-state) @@ -35,19 +33,13 @@ (defvar viper-expert-level) (defvar viper-ex-style-editing) (defvar viper-ex-style-motion) - -;; loading happens only in non-interactive compilation -;; in order to spare non-viperized emacs from being viperized -(if noninteractive - (eval-when-compile - (let ((load-path (cons (expand-file-name ".") load-path))) - (or (featurep 'viper-util) - (load "viper-util.el" nil nil 'nosuffix)) - ))) ;; end pacifier (require 'viper-util) +(declare-function viper-ex "viper-ex" (arg &optional string)) +(declare-function viper-normalize-minor-mode-map-alist "viper-cmd" ()) +(declare-function viper-set-mode-vars-for "viper-cmd" (state)) ;;; Variables @@ -170,7 +162,7 @@ Enter as a sexp. Examples: \"\\C-z\", [(control ?z)]." (let ((old-value (if (boundp 'viper-toggle-key) viper-toggle-key [(control ?z)]))) - (mapcar + (mapc (lambda (buf) (save-excursion (set-buffer buf) @@ -210,7 +202,7 @@ If running in a terminal, [(escape)] is not understood, so must use \"\\e\"." (let ((old-value (if (boundp 'viper-ESC-key) viper-ESC-key [(escape)]))) - (mapcar + (mapc (lambda (buf) (save-excursion (set-buffer buf) @@ -339,8 +331,8 @@ If running in a terminal, [(escape)] is not understood, so must use \"\\e\"." (define-key viper-vi-basic-map "\C-m" 'viper-next-line-at-bol) (define-key viper-vi-basic-map "\C-u" 'viper-scroll-down) (define-key viper-vi-basic-map "\C-y" 'viper-scroll-down-one) -(define-key viper-vi-basic-map "\C-s" 'viper-isearch-forward) -(define-key viper-vi-basic-map "\C-r" 'viper-isearch-backward) +;;(define-key viper-vi-basic-map "\C-s" 'viper-isearch-forward) +;;(define-key viper-vi-basic-map "\C-r" 'viper-isearch-backward) (define-key viper-vi-basic-map "\C-c/" 'viper-toggle-search-style) (define-key viper-vi-basic-map "\C-c\C-g" 'viper-info-on-file) @@ -702,6 +694,9 @@ form ((key . function) (key . function) ... )." alist)) +(provide 'viper-keym) + + ;;; Local Variables: ;;; eval: (put 'viper-deflocalvar 'lisp-indent-hook 'defun) ;;; End: diff --git a/lisp/emulation/viper-macs.el b/lisp/emulation/viper-macs.el index 094bfcd3a0a..a9e24f28e7b 100644 --- a/lisp/emulation/viper-macs.el +++ b/lisp/emulation/viper-macs.el @@ -39,14 +39,8 @@ (if noninteractive (eval-when-compile (let ((load-path (cons (expand-file-name ".") load-path))) - (or (featurep 'viper-util) - (load "viper-util.el" nil nil 'nosuffix)) - (or (featurep 'viper-keym) - (load "viper-keym.el" nil nil 'nosuffix)) - (or (featurep 'viper-mous) - (load "viper-mous.el" nil nil 'nosuffix)) (or (featurep 'viper-cmd) - (load "viper-cmd.el" nil nil 'nosuffix)) + (load "viper-cmd.el" nil t 'nosuffix)) ))) ;; end pacifier @@ -466,7 +460,7 @@ If SCOPE is nil, the user is asked to specify the scope." (viper-array-to-string macro-name))) (setq lis2 (cons (car lis) lis2)) (setq lis (cdr lis))) - + (setq lis2 (reverse lis2)) (set macro-alist-var (append lis2 (cons new-elt lis))) (setq old-elt new-elt))) @@ -658,9 +652,9 @@ name from there." (interactive) (with-output-to-temp-buffer " *viper-info*" (princ "Macros in Vi state:\n===================\n") - (mapcar 'viper-describe-one-macro viper-vi-kbd-macro-alist) + (mapc 'viper-describe-one-macro viper-vi-kbd-macro-alist) (princ "\n\nMacros in Insert and Replace states:\n====================================\n") - (mapcar 'viper-describe-one-macro viper-insert-kbd-macro-alist) + (mapc 'viper-describe-one-macro viper-insert-kbd-macro-alist) (princ "\n\nMacros in Emacs state:\n======================\n") (mapcar 'viper-describe-one-macro viper-emacs-kbd-macro-alist) )) @@ -670,11 +664,11 @@ name from there." (viper-display-macro (car macro)))) (princ " ** Buffer-specific:") (if (viper-kbd-buf-alist macro) - (mapcar 'viper-describe-one-macro-elt (viper-kbd-buf-alist macro)) + (mapc 'viper-describe-one-macro-elt (viper-kbd-buf-alist macro)) (princ " none\n")) (princ "\n ** Mode-specific:") (if (viper-kbd-mode-alist macro) - (mapcar 'viper-describe-one-macro-elt (viper-kbd-mode-alist macro)) + (mapc 'viper-describe-one-macro-elt (viper-kbd-mode-alist macro)) (princ " none\n")) (princ "\n ** Global:") (if (viper-kbd-global-definition macro) @@ -826,7 +820,7 @@ name from there." (defun viper-char-array-to-macro (array) (let ((vec (vconcat array)) macro) - (if viper-xemacs-p + (if (featurep 'xemacs) (setq macro (mapcar 'character-to-event vec)) (setq macro vec)) (vconcat (mapcar 'viper-event-key macro)))) diff --git a/lisp/emulation/viper-mous.el b/lisp/emulation/viper-mous.el index 841c0c68953..be2739777eb 100644 --- a/lisp/emulation/viper-mous.el +++ b/lisp/emulation/viper-mous.el @@ -42,10 +42,8 @@ (if noninteractive (eval-when-compile (let ((load-path (cons (expand-file-name ".") load-path))) - (or (featurep 'viper-util) - (load "viper-util.el" nil nil 'nosuffix)) (or (featurep 'viper-cmd) - (load "viper-cmd.el" nil nil 'nosuffix)) + (load "viper-cmd.el" nil t 'nosuffix)) ))) ;; end pacifier @@ -79,7 +77,7 @@ or a tripple-click." ;; time interval in millisecond within which successive clicks are ;; considered related (defcustom viper-multiclick-timeout (if (viper-window-display-p) - (if viper-xemacs-p + (if (featurep 'xemacs) mouse-track-multi-click-time double-click-time) 500) @@ -227,7 +225,7 @@ is ignored." ) ; if ;; XEmacs doesn't have set-text-properties, but there buffer-substring ;; doesn't return properties together with the string, so it's not needed. - (if viper-emacs-p + (if (featurep 'emacs) (set-text-properties 0 (length result) nil result)) result )) @@ -273,7 +271,7 @@ See `viper-surrounding-word' for the definition of a word in this case." 'viper-mouse-catch-frame-switch)) (not (eq (key-binding viper-mouse-up-insert-key-parsed) 'viper-mouse-click-insert-word)) - (and viper-xemacs-p (not (event-over-text-area-p click))))) + (and (featurep 'xemacs) (not (event-over-text-area-p click))))) () ; do nothing, if binding isn't right or not over text ;; turn arg into a number (cond ((integerp arg) nil) @@ -364,7 +362,7 @@ this command." 'viper-mouse-catch-frame-switch)) (not (eq (key-binding viper-mouse-up-search-key-parsed) 'viper-mouse-click-search-word)) - (and viper-xemacs-p (not (event-over-text-area-p click))))) + (and (featurep 'xemacs) (not (event-over-text-area-p click))))) () ; do nothing, if binding isn't right or not over text (let ((previous-search-string viper-s-string) click-word click-count) @@ -507,19 +505,19 @@ bindings in the Viper manual." () (setq button-spec (cond ((memq 1 key) - (if viper-emacs-p + (if (featurep 'emacs) (if (eq 'up event-type) "mouse-1" "down-mouse-1") (if (eq 'up event-type) 'button1up 'button1))) ((memq 2 key) - (if viper-emacs-p + (if (featurep 'emacs) (if (eq 'up event-type) "mouse-2" "down-mouse-2") (if (eq 'up event-type) 'button2up 'button2))) ((memq 3 key) - (if viper-emacs-p + (if (featurep 'emacs) (if (eq 'up event-type) "mouse-3" "down-mouse-3") (if (eq 'up event-type) @@ -528,18 +526,18 @@ bindings in the Viper manual." "%S: invalid button number, %S" key-var key))) meta-spec (if (memq 'meta key) - (if viper-emacs-p "M-" 'meta) - (if viper-emacs-p "" nil)) + (if (featurep 'emacs) "M-" 'meta) + (if (featurep 'emacs) "" nil)) shift-spec (if (memq 'shift key) - (if viper-emacs-p "S-" 'shift) - (if viper-emacs-p "" nil)) + (if (featurep 'emacs) "S-" 'shift) + (if (featurep 'emacs) "" nil)) control-spec (if (memq 'control key) - (if viper-emacs-p "C-" 'control) - (if viper-emacs-p "" nil))) + (if (featurep 'emacs) "C-" 'control) + (if (featurep 'emacs) "" nil))) - (setq key-spec (if viper-emacs-p + (setq key-spec (if (featurep 'emacs) (vector (intern (concat diff --git a/lisp/emulation/viper-util.el b/lisp/emulation/viper-util.el index ab62aa20056..33061565196 100644 --- a/lisp/emulation/viper-util.el +++ b/lisp/emulation/viper-util.el @@ -44,12 +44,6 @@ (require 'ring) -(if noninteractive - (eval-when-compile - (let ((load-path (cons (expand-file-name ".") load-path))) - (or (featurep 'viper-init) - (load "viper-init.el" nil nil 'nosuffix)) - ))) ;; end pacifier (require 'viper-init) @@ -64,48 +58,34 @@ (fset 'x-color-defined-p (symbol-function 'ns-color-defined-p))) -;;; XEmacs support - - -(viper-cond-compile-for-xemacs-or-emacs - (progn ; xemacs - (fset 'viper-overlay-p (symbol-function 'extentp)) - (fset 'viper-make-overlay (symbol-function 'make-extent)) - (fset 'viper-overlay-live-p (symbol-function 'extent-live-p)) - (fset 'viper-move-overlay (symbol-function 'set-extent-endpoints)) - (fset 'viper-overlay-start (symbol-function 'extent-start-position)) - (fset 'viper-overlay-end (symbol-function 'extent-end-position)) - (fset 'viper-overlay-get (symbol-function 'extent-property)) - (fset 'viper-overlay-put (symbol-function 'set-extent-property)) - (fset 'viper-read-event (symbol-function 'next-command-event)) - (fset 'viper-characterp (symbol-function 'characterp)) - (fset 'viper-int-to-char (symbol-function 'int-to-char)) - (if (viper-window-display-p) - (fset 'viper-iconify (symbol-function 'iconify-frame))) - (cond ((viper-has-face-support-p) - (fset 'viper-get-face (symbol-function 'get-face)) - (fset 'viper-color-defined-p (symbol-function 'valid-color-name-p)) - ))) - (progn ; emacs - (fset 'viper-overlay-p (symbol-function 'overlayp)) - (fset 'viper-make-overlay (symbol-function 'make-overlay)) - (fset 'viper-overlay-live-p (symbol-function 'overlayp)) - (fset 'viper-move-overlay (symbol-function 'move-overlay)) - (fset 'viper-overlay-start (symbol-function 'overlay-start)) - (fset 'viper-overlay-end (symbol-function 'overlay-end)) - (fset 'viper-overlay-get (symbol-function 'overlay-get)) - (fset 'viper-overlay-put (symbol-function 'overlay-put)) - (fset 'viper-read-event (symbol-function 'read-event)) - (fset 'viper-characterp (symbol-function 'integerp)) - (fset 'viper-int-to-char (symbol-function 'identity)) - (if (viper-window-display-p) - (fset 'viper-iconify (symbol-function 'iconify-or-deiconify-frame))) - (cond ((viper-has-face-support-p) - (fset 'viper-get-face (symbol-function 'internal-get-face)) - (fset 'viper-color-defined-p (symbol-function 'x-color-defined-p)) - ))) - ) - +(defalias 'viper-overlay-p + (if (featurep 'xemacs) 'extentp 'overlayp)) +(defalias 'viper-make-overlay + (if (featurep 'xemacs) 'make-extent 'make-overlay)) +(defalias 'viper-overlay-live-p + (if (featurep 'xemacs) 'extent-live-p 'overlayp)) +(defalias 'viper-move-overlay + (if (featurep 'xemacs) 'set-extent-endpoints 'move-overlay)) +(defalias 'viper-overlay-start + (if (featurep 'xemacs) 'extent-start-position 'overlay-start)) +(defalias 'viper-overlay-end + (if (featurep 'xemacs) 'extent-end-position 'overlay-end)) +(defalias 'viper-overlay-get + (if (featurep 'xemacs) 'extent-property 'overlay-get)) +(defalias 'viper-overlay-put + (if (featurep 'xemacs) 'set-extent-property 'overlay-put)) +(defalias 'viper-read-event + (if (featurep 'xemacs) 'next-command-event 'read-event)) +(defalias 'viper-characterp + (if (featurep 'xemacs) 'characterp 'integerp)) +(defalias 'viper-int-to-char + (if (featurep 'xemacs) 'int-to-char 'identity)) +(defalias 'viper-get-face + (if (featurep 'xemacs) 'get-face 'internal-get-face)) +(defalias 'viper-color-defined-p + (if (featurep 'xemacs) 'valid-color-name-p 'x-color-defined-p)) +(defalias 'viper-iconify + (if (featurep 'xemacs) 'iconify-frame 'iconify-or-deiconify-frame)) ;; CHAR is supposed to be a char or an integer (positive or negative) @@ -168,7 +148,7 @@ (defun viper-set-cursor-color-according-to-state (&optional frame) (cond ((eq viper-current-state 'replace-state) - (viper-change-cursor-color viper-replace-state-cursor-color frame)) + (viper-change-cursor-color viper-replace-overlay-cursor-color frame)) ((and (eq viper-current-state 'emacs-state) viper-emacs-state-cursor-color) (viper-change-cursor-color viper-emacs-state-cursor-color frame)) @@ -201,7 +181,7 @@ (defsubst viper-get-saved-cursor-color-in-replace-mode () (or (funcall - (if viper-emacs-p 'frame-parameter 'frame-property) + (if (featurep 'emacs) 'frame-parameter 'frame-property) (selected-frame) 'viper-saved-cursor-color-in-replace-mode) (if (and (eq viper-current-state 'emacs-mode) viper-emacs-state-cursor-color) @@ -211,7 +191,7 @@ (defsubst viper-get-saved-cursor-color-in-insert-mode () (or (funcall - (if viper-emacs-p 'frame-parameter 'frame-property) + (if (featurep 'emacs) 'frame-parameter 'frame-property) (selected-frame) 'viper-saved-cursor-color-in-insert-mode) (if (and (eq viper-current-state 'emacs-mode) viper-emacs-state-cursor-color) @@ -221,7 +201,7 @@ (defsubst viper-get-saved-cursor-color-in-emacs-mode () (or (funcall - (if viper-emacs-p 'frame-parameter 'frame-property) + (if (featurep 'emacs) 'frame-parameter 'frame-property) (selected-frame) 'viper-saved-cursor-color-in-emacs-mode) viper-vi-state-cursor-color)) @@ -249,8 +229,8 @@ ;; testing for sufficiently high Emacs versions. (defun viper-check-version (op major minor &optional type-of-emacs) (if (and (boundp 'emacs-major-version) (boundp 'emacs-minor-version)) - (and (cond ((eq type-of-emacs 'xemacs) viper-xemacs-p) - ((eq type-of-emacs 'emacs) viper-emacs-p) + (and (cond ((eq type-of-emacs 'xemacs) (featurep 'xemacs)) + ((eq type-of-emacs 'emacs) (featurep 'emacs)) (t t)) (cond ((eq op '=) (and (= emacs-minor-version minor) (= emacs-major-version major))) @@ -267,7 +247,7 @@ (defun viper-get-visible-buffer-window (wind) - (if viper-xemacs-p + (if (featurep 'xemacs) (get-buffer-window wind t) (get-buffer-window wind 'visible))) @@ -394,6 +374,8 @@ +(declare-function viper-forward-Word "viper-cmd" (arg)) + ;;; Support for :e, :r, :w file globbing ;; Glob the file spec. @@ -654,7 +636,7 @@ (regexp (format "^[^;]*%s[ \t\n]*[a-zA-Z---_']*[ \t\n)]" var-name)) (buf (find-file-noselect (substitute-in-file-name custom-file))) ) - (message message) + (message "%s" (or message "")) (save-excursion (set-buffer buf) (goto-char (point-min)) @@ -724,13 +706,14 @@ (defsubst viper-file-checked-in-p (file) (and (featurep 'vc-hooks) ;; CVS files are considered not checked in + ;; FIXME: Should this deal with more than CVS? (not (memq (vc-backend file) '(nil CVS))) (if (fboundp 'vc-state) (and (not (memq (vc-state file) '(edited needs-merge))) (not (stringp (vc-state file)))) ;; XEmacs has no vc-state - (not (vc-locking-user file))) + (if (featurep 'xemacs)(not (vc-locking-user file)))) )) ;; checkout if visited file is checked in @@ -787,7 +770,7 @@ (setq viper-replace-overlay (viper-make-overlay beg end (current-buffer))) ;; never detach (viper-overlay-put - viper-replace-overlay (if viper-emacs-p 'evaporate 'detachable) nil) + viper-replace-overlay (if (featurep 'emacs) 'evaporate 'detachable) nil) (viper-overlay-put viper-replace-overlay 'priority viper-replace-overlay-priority) ;; If Emacs will start supporting overlay maps, as it currently supports @@ -795,7 +778,7 @@ ;; just have keymap attached to replace overlay. ;;(viper-overlay-put ;; viper-replace-overlay - ;; (if viper-xemacs-p 'keymap 'local-map) + ;; (if (featurep 'xemacs) 'keymap 'local-map) ;; viper-replace-map) ) (if (viper-has-face-support-p) @@ -811,8 +794,8 @@ (viper-set-replace-overlay (point-min) (point-min))) (if (or (not (viper-has-face-support-p)) viper-use-replace-region-delimiters) - (let ((before-name (if viper-xemacs-p 'begin-glyph 'before-string)) - (after-name (if viper-xemacs-p 'end-glyph 'after-string))) + (let ((before-name (if (featurep 'xemacs) 'begin-glyph 'before-string)) + (after-name (if (featurep 'xemacs) 'end-glyph 'after-string))) (viper-overlay-put viper-replace-overlay before-name before-glyph) (viper-overlay-put viper-replace-overlay after-name after-glyph)))) @@ -843,11 +826,11 @@ ;; never detach (viper-overlay-put viper-minibuffer-overlay - (if viper-emacs-p 'evaporate 'detachable) + (if (featurep 'emacs) 'evaporate 'detachable) nil) ;; make viper-minibuffer-overlay open-ended ;; In emacs, it is made open ended at creation time - (if viper-xemacs-p + (if (featurep 'xemacs) (progn (viper-overlay-put viper-minibuffer-overlay 'start-open nil) (viper-overlay-put viper-minibuffer-overlay 'end-open nil))) @@ -860,7 +843,7 @@ (if (fboundp 'minibuffer-prompt-end) (minibuffer-prompt-end) 1) (1+ (buffer-size))) (setq viper-minibuffer-overlay - (if viper-xemacs-p + (if (featurep 'xemacs) (viper-make-overlay 1 (1+ (buffer-size)) (current-buffer)) ;; make overlay open-ended (viper-make-overlay @@ -889,9 +872,7 @@ ;; Sit for VAL milliseconds. XEmacs doesn't support the millisecond arg ;; in sit-for, so this function smoothes out the differences. (defsubst viper-sit-for-short (val &optional nodisp) - (if viper-xemacs-p - (sit-for (/ val 1000.0) nodisp) - (sit-for 0 val nodisp))) + (sit-for (/ val 1000.0) nodisp)) ;; EVENT may be a single event of a sequence of events (defsubst viper-ESC-event-p (event) @@ -985,7 +966,7 @@ (defun viper-read-key-sequence (prompt &optional continue-echo) (let (inhibit-quit event keyseq) (setq keyseq (read-key-sequence prompt continue-echo)) - (setq event (if viper-xemacs-p + (setq event (if (featurep 'xemacs) (elt keyseq 0) ; XEmacs returns vector of events (elt (listify-key-sequence keyseq) 0))) (if (viper-ESC-event-p event) @@ -1080,7 +1061,7 @@ (defun viper-key-to-emacs-key (key) (let (key-name char-p modifiers mod-char-list base-key base-key-name) - (cond (viper-xemacs-p key) + (cond ((featurep 'xemacs) key) ((symbolp key) (setq key-name (symbol-name key)) @@ -1088,10 +1069,10 @@ (string-to-char key-name)) ;; Emacs doesn't recognize `return' and `escape' as events on ;; dumb terminals, so we translate them into characters - ((and viper-emacs-p (not (viper-window-display-p)) + ((and (featurep 'emacs) (not (viper-window-display-p)) (string= key-name "return")) ?\C-m) - ((and viper-emacs-p (not (viper-window-display-p)) + ((and (featurep 'emacs) (not (viper-window-display-p)) (string= key-name "escape")) ?\e) ;; pass symbol-event as is @@ -1125,14 +1106,15 @@ ;; LIS is assumed to be a list of events of characters (defun viper-eventify-list-xemacs (lis) - (mapcar - (lambda (elt) - (cond ((viper-characterp elt) (character-to-event elt)) - ((eventp elt) elt) - (t (error - "viper-eventify-list-xemacs: can't convert to event, %S" - elt)))) - lis)) + (if (featurep 'xemacs) + (mapcar + (lambda (elt) + (cond ((viper-characterp elt) (character-to-event elt)) + ((eventp elt) elt) + (t (error + "viper-eventify-list-xemacs: can't convert to event, %S" + elt)))) + lis))) ;; Smoothes out the difference between Emacs' unread-command-events @@ -1144,7 +1126,7 @@ ;; into an event. Below, we delete nil from event lists, since nil is the most ;; common symbol that might appear in this wrong context. (defun viper-set-unread-command-events (arg) - (if viper-emacs-p + (if (featurep 'emacs) (setq unread-command-events (let ((new-events @@ -1262,9 +1244,9 @@ Arguments become related buffers. This function should normally be used in the `Local variables' section of a file." (setq viper-related-files-and-buffers-ring (make-ring (1+ (length other-files-or-buffers)))) - (mapcar '(lambda (elt) - (viper-ring-insert viper-related-files-and-buffers-ring elt)) - other-files-or-buffers) + (mapc '(lambda (elt) + (viper-ring-insert viper-related-files-and-buffers-ring elt)) + other-files-or-buffers) (viper-ring-insert viper-related-files-and-buffers-ring (buffer-name)) ) diff --git a/lisp/emulation/viper.el b/lisp/emulation/viper.el index 5eaf4c70d5c..19d3a7f018a 100644 --- a/lisp/emulation/viper.el +++ b/lisp/emulation/viper.el @@ -9,7 +9,7 @@ ;; Author: Michael Kifer <kifer@cs.stonybrook.edu> ;; Keywords: emulations -(defconst viper-version "3.13.1 of October 23, 2006" +(defconst viper-version "3.14 of August 18, 2007" "The current version of Viper") ;; This file is part of GNU Emacs. @@ -297,29 +297,15 @@ ;;; Code: -(require 'advice) -(require 'cl) -(require 'ring) - ;; compiler pacifier (defvar mark-even-if-inactive) (defvar quail-mode) (defvar viper-expert-level) (defvar viper-mode-string) (defvar viper-major-mode-modifier-list) - -;; loading happens only in non-interactive compilation -;; in order to spare non-viperized emacs from being viperized -(if noninteractive - (eval-when-compile - (let ((load-path (cons (expand-file-name ".") load-path))) - (or (featurep 'viper-init) - (load "viper-init.el" nil nil 'nosuffix)) - (or (featurep 'viper-cmd) - (load "viper-cmd.el" nil nil 'nosuffix)) - ))) ;; end pacifier +(require 'advice) (require 'viper-init) (require 'viper-keym) @@ -457,6 +443,7 @@ unless it is coming up in a wrong Viper state." (defcustom viper-insert-state-mode-list '(internal-ange-ftp-mode comint-mode + gud-mode inferior-emacs-lisp-mode erc-mode eshell-mode @@ -481,6 +468,7 @@ unless it is coming up in a wrong Viper state." '((help-mode emacs-state viper-slash-and-colon-map) (comint-mode insert-state viper-comint-mode-modifier-map) (comint-mode vi-state viper-comint-mode-modifier-map) + (gud-mode insert-state viper-comint-mode-modifier-map) (shell-mode insert-state viper-comint-mode-modifier-map) (inferior-emacs-lisp-mode insert-state viper-comint-mode-modifier-map) (shell-mode vi-state viper-comint-mode-modifier-map) @@ -645,6 +633,11 @@ This startup message appears whenever you load Viper, unless you type `y' now." (remove-hook symbol 'viper-change-state-to-emacs) (remove-hook symbol 'viper-change-state-to-insert) (remove-hook symbol 'viper-change-state-to-vi) + (remove-hook symbol 'viper-minibuffer-post-command-hook) + (remove-hook symbol 'viper-minibuffer-setup-sentinel) + (remove-hook symbol 'viper-major-mode-change-sentinel) + (remove-hook symbol 'set-viper-state-in-major-mode) + (remove-hook symbol 'viper-post-command-sentinel) ))) ;; Remove local value in all existing buffers @@ -681,7 +674,10 @@ It also can't undo some Viper settings." global-mode-string (delq 'viper-mode-string global-mode-string)) - (if viper-emacs-p + (setq default-major-mode + (viper-standard-value 'default-major-mode viper-saved-non-viper-variables)) + + (if (featurep 'emacs) (setq-default mark-even-if-inactive (viper-standard-value @@ -692,7 +688,7 @@ It also can't undo some Viper settings." (and (fboundp 'add-to-ordered-list) (boundp 'emulation-mode-map-alists)) (viper-delocalize-var 'minor-mode-map-alist)) (viper-delocalize-var 'require-final-newline) - (if viper-xemacs-p (viper-delocalize-var 'bar-cursor)) + (if (featurep 'xemacs) (viper-delocalize-var 'bar-cursor)) ;; deactivate all advices done by Viper. @@ -771,9 +767,7 @@ It also can't undo some Viper settings." (mapatoms 'viper-remove-hooks) (remove-hook 'comint-mode-hook 'viper-comint-mode-hook) (remove-hook 'erc-mode-hook 'viper-comint-mode-hook) - (remove-hook 'minibuffer-setup-hook 'viper-minibuffer-setup-sentinel) (remove-hook 'change-major-mode-hook 'viper-major-mode-change-sentinel) - (remove-hook 'post-command-hook 'viper-minibuffer-post-command-hook) ;; unbind Viper mouse bindings (viper-unbind-mouse-search-key) @@ -781,7 +775,7 @@ It also can't undo some Viper settings." ;; In emacs, we have to advice handle-switch-frame ;; This advice is undone earlier, when all advices matchine "viper-" are ;; deactivated. - (if viper-xemacs-p + (if (featurep 'xemacs) (remove-hook 'mouse-leave-frame-hook 'viper-remember-current-frame)) ) ; end viper-go-away @@ -792,7 +786,7 @@ It also can't undo some Viper settings." ;; set appropriate Viper state in buffers that changed major mode (defun set-viper-state-in-major-mode () - (mapcar + (mapc (lambda (buf) (if (viper-buffer-live-p buf) (with-current-buffer buf @@ -974,7 +968,7 @@ It also can't undo some Viper settings." ))) ;; International input methods - (if viper-emacs-p + (if (featurep 'emacs) (eval-after-load "mule-cmds" '(progn (defadvice inactivate-input-method (after viper-mule-advice activate) @@ -1015,7 +1009,7 @@ It also can't undo some Viper settings." require-final-newline t) ;; don't bark when mark is inactive - (if viper-emacs-p + (if (featurep 'emacs) (setq mark-even-if-inactive t)) (setq scroll-step 1) @@ -1025,59 +1019,74 @@ It also can't undo some Viper settings." (setq global-mode-string (append '("" viper-mode-string) (cdr global-mode-string)))) - (defadvice describe-key (before viper-describe-key-ad protect activate) - "Force to read key via `viper-read-key-sequence'." - (interactive (let (key) - (setq key (viper-read-key-sequence - "Describe key (or click or menu item): ")) - (list key - (prefix-numeric-value current-prefix-arg) - ;; If KEY is a down-event, read also the - ;; corresponding up-event. - (and (vectorp key) - (let ((last-idx (1- (length key)))) - (and (eventp (aref key last-idx)) - (memq 'down (event-modifiers - (aref key last-idx))))) - (or (and (eventp (aref key 0)) - (memq 'down (event-modifiers - (aref key 0))) - ;; For the C-down-mouse-2 popup - ;; menu, there is no subsequent up-event. - (= (length key) 1)) - (and (> (length key) 1) - (eventp (aref key 1)) - (memq 'down (event-modifiers (aref key 1))))) - (read-event)))))) - - (defadvice describe-key-briefly - (before viper-describe-key-briefly-ad protect activate) - "Force to read key via `viper-read-key-sequence'." - (interactive (let (key) - (setq key (viper-read-key-sequence - "Describe key (or click or menu item): ")) - ;; If KEY is a down-event, read and discard the - ;; corresponding up-event. - (and (vectorp key) - (let ((last-idx (1- (length key)))) - (and (eventp (aref key last-idx)) - (memq 'down (event-modifiers (aref key last-idx))))) - (read-event)) - (list key - (if current-prefix-arg - (prefix-numeric-value current-prefix-arg)) - 1)))) + (viper-cond-compile-for-xemacs-or-emacs + ;; XEmacs + (defadvice describe-key (before viper-describe-key-ad protect activate) + "Force to read key via `viper-read-key-sequence'." + (interactive (list (viper-read-key-sequence "Describe key: ")))) + ;; Emacs + (defadvice describe-key (before viper-describe-key-ad protect activate) + "Force to read key via `viper-read-key-sequence'." + (interactive (let (key) + (setq key (viper-read-key-sequence + "Describe key (or click or menu item): ")) + (list key + (prefix-numeric-value current-prefix-arg) + ;; If KEY is a down-event, read also the + ;; corresponding up-event. + (and (vectorp key) + (let ((last-idx (1- (length key)))) + (and (eventp (aref key last-idx)) + (memq 'down (event-modifiers + (aref key last-idx))))) + (or (and (eventp (aref key 0)) + (memq 'down (event-modifiers + (aref key 0))) + ;; For the C-down-mouse-2 popup menu, + ;; there is no subsequent up-event + (= (length key) 1)) + (and (> (length key) 1) + (eventp (aref key 1)) + (memq 'down (event-modifiers (aref key 1))))) + (read-event)))))) + ) ; viper-cond-compile-for-xemacs-or-emacs + + (viper-cond-compile-for-xemacs-or-emacs + ;; XEmacs + (defadvice describe-key-briefly + (before viper-describe-key-briefly-ad protect activate) + "Force to read key via `viper-read-key-sequence'." + (interactive (list (viper-read-key-sequence "Describe key briefly: ")))) + ;; Emacs + (defadvice describe-key-briefly + (before viper-describe-key-briefly-ad protect activate) + "Force to read key via `viper-read-key-sequence'." + (interactive (let (key) + (setq key (viper-read-key-sequence + "Describe key (or click or menu item): ")) + ;; If KEY is a down-event, read and discard the + ;; corresponding up-event. + (and (vectorp key) + (let ((last-idx (1- (length key)))) + (and (eventp (aref key last-idx)) + (memq 'down (event-modifiers (aref key last-idx))))) + (read-event)) + (list key + (if current-prefix-arg + (prefix-numeric-value current-prefix-arg)) + 1)))) + ) ;; viper-cond-compile-for-xemacs-or-emacs (defadvice find-file (before viper-add-suffix-advice activate) "Use `read-file-name' for reading arguments." (interactive (cons (read-file-name "Find file: " nil default-directory) ;; XEmacs: if Mule & prefix arg, ask for coding system - (cond ((and viper-xemacs-p (featurep 'mule)) + (cond ((and (featurep 'xemacs) (featurep 'mule)) (list (and current-prefix-arg (read-coding-system "Coding-system: ")))) ;; Emacs: do wildcards - ((and viper-emacs-p (boundp 'find-file-wildcards)) + ((and (featurep 'emacs) (boundp 'find-file-wildcards)) (list find-file-wildcards)))) )) @@ -1086,12 +1095,12 @@ It also can't undo some Viper settings." (interactive (cons (read-file-name "Find file in other window: " nil default-directory) ;; XEmacs: if Mule & prefix arg, ask for coding system - (cond ((and viper-xemacs-p (featurep 'mule)) + (cond ((and (featurep 'xemacs) (featurep 'mule)) (list (and current-prefix-arg (read-coding-system "Coding-system: ")))) ;; Emacs: do wildcards - ((and viper-emacs-p (boundp 'find-file-wildcards)) + ((and (featurep 'emacs) (boundp 'find-file-wildcards)) (list find-file-wildcards)))) )) @@ -1101,12 +1110,12 @@ It also can't undo some Viper settings." (interactive (cons (read-file-name "Find file in other frame: " nil default-directory) ;; XEmacs: if Mule & prefix arg, ask for coding system - (cond ((and viper-xemacs-p (featurep 'mule)) + (cond ((and (featurep 'xemacs) (featurep 'mule)) (list (and current-prefix-arg (read-coding-system "Coding-system: ")))) ;; Emacs: do wildcards - ((and viper-emacs-p (boundp 'find-file-wildcards)) + ((and (featurep 'emacs) (boundp 'find-file-wildcards)) (list find-file-wildcards)))) )) @@ -1137,7 +1146,7 @@ It also can't undo some Viper settings." ;; catch frame switching event (if (viper-window-display-p) - (if viper-xemacs-p + (if (featurep 'xemacs) (add-hook 'mouse-leave-frame-hook 'viper-remember-current-frame) (defadvice handle-switch-frame (before viper-frame-advice activate) @@ -1198,13 +1207,14 @@ These two lines must come in the order given. (if (null viper-saved-non-viper-variables) (setq viper-saved-non-viper-variables (list + (cons 'default-major-mode (list default-major-mode)) (cons 'next-line-add-newlines (list next-line-add-newlines)) (cons 'require-final-newline (list require-final-newline)) (cons 'scroll-step (list scroll-step)) (cons 'mode-line-buffer-identification (list (default-value 'mode-line-buffer-identification))) (cons 'global-mode-string (list global-mode-string)) - (if viper-emacs-p + (if (featurep 'emacs) (cons 'mark-even-if-inactive (list mark-even-if-inactive))) ))) |