summaryrefslogtreecommitdiff
path: root/lisp/emulation
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/emulation')
-rw-r--r--lisp/emulation/edt.el106
-rw-r--r--lisp/emulation/tpu-mapper.el68
-rw-r--r--lisp/emulation/vip.el16
-rw-r--r--lisp/emulation/viper-cmd.el29
-rw-r--r--lisp/emulation/viper-ex.el32
-rw-r--r--lisp/emulation/viper-init.el20
-rw-r--r--lisp/emulation/viper-macs.el2
-rw-r--r--lisp/emulation/viper-mous.el28
-rw-r--r--lisp/emulation/viper-util.el126
-rw-r--r--lisp/emulation/viper.el26
10 files changed, 206 insertions, 247 deletions
diff --git a/lisp/emulation/edt.el b/lisp/emulation/edt.el
index bff1a583586..4a68e258cb1 100644
--- a/lisp/emulation/edt.el
+++ b/lisp/emulation/edt.el
@@ -321,24 +321,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 +399,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 +460,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 +476,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 +487,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 +532,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 +556,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 +596,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 +619,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.
@@ -651,7 +641,7 @@ Argument NUM is the number of lines 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-previous-line (num)
"Move cursor up one line.
@@ -661,7 +651,7 @@ Argument NUM is the number of lines to move."
(let ((beg (edt-current-line)))
(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 +662,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 +708,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 +733,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 +779,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 +803,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 +881,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 +1098,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 +1114,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 +1164,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 +1249,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 +1353,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 +1379,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.
@@ -1434,7 +1424,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 +1449,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 +1467,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 +1497,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 +1509,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 +1519,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 +1572,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 +1582,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 +1592,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 +1605,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
@@ -1785,7 +1775,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 +1803,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 +1856,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 +2142,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 +2178,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 +2193,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 +2229,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
@@ -2253,7 +2243,7 @@ Optional argument USER-SETUP non-nil means called from function
(defun edt-select-default-global-map()
"Select default EDT emulation key bindings."
(interactive)
- (if 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 +2261,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/tpu-mapper.el b/lisp/emulation/tpu-mapper.el
index 3e5af7a38bd..b3ad67ec4df 100644
--- a/lisp/emulation/tpu-mapper.el
+++ b/lisp/emulation/tpu-mapper.el
@@ -78,13 +78,6 @@
;;;
-;;; 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
;;;
(defvar tpu-kp4 nil)
@@ -100,7 +93,7 @@
;;;
;;; Make sure the window is big enough to display the instructions
;;;
-(if tpu-lucid-emacs19-p (set-screen-size (selected-screen) 80 36)
+(if (featurep 'xemacs) (set-screen-size (selected-screen) 80 36)
(set-frame-size (selected-frame) 80 36))
@@ -167,7 +160,7 @@
;;; Save <CR> for future reference
;;;
(cond
- (tpu-lucid-emacs19-p
+ ((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
@@ -179,42 +172,29 @@
;;;
;;; Key mapping functions
;;;
-(defun tpu-lucid-map-key (ident descrip func gold-func)
+(defun tpu-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)))
+ (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)
-(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"(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"))
- ;; 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)
-
-(fset 'tpu-map-key (if tpu-lucid-emacs19-p 'tpu-lucid-map-key 'tpu-emacs-map-key))
-
-
(set-buffer "Keys")
(insert "
;; Arrows
@@ -350,7 +330,7 @@
;;
")
-(cond (tpu-lucid-emacs19-p
+(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")
@@ -368,7 +348,7 @@
;;;
(let ((file
(convert-standard-filename
- (if tpu-lucid-emacs19-p "~/.tpu-lucid-keys" "~/.tpu-keys"))))
+ (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)
diff --git a/lisp/emulation/vip.el b/lisp/emulation/vip.el
index c2d00a8ffba..e6fdd55f7c4 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 82dc312cf28..5e13edb9495 100644
--- a/lisp/emulation/viper-cmd.el
+++ b/lisp/emulation/viper-cmd.el
@@ -834,7 +834,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 +861,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 +893,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 +902,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 +1080,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
@@ -1320,7 +1320,7 @@ as a Meta key and any number of multiple escapes is allowed."
(setq last-command-char char)
(setq last-command-event
(viper-copy-event
- (if viper-xemacs-p (character-to-event char) char)))
+ (if (featurep 'xemacs) (character-to-event char) char)))
(condition-case err
(funcall cmd-to-exec-at-end cmd-info)
(error
@@ -1902,7 +1902,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-sequence 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 +1936,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-sequence 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))
@@ -2790,7 +2790,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)))
@@ -3089,7 +3090,8 @@ 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)
@@ -3132,7 +3134,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)
diff --git a/lisp/emulation/viper-ex.el b/lisp/emulation/viper-ex.el
index 627d2ff1814..caeecd12c8a 100644
--- a/lisp/emulation/viper-ex.el
+++ b/lisp/emulation/viper-ex.el
@@ -651,17 +651,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 +1103,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))
@@ -1556,7 +1558,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 +1878,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 +1887,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 1b05ef7189d..1b1e07a0a0c 100644
--- a/lisp/emulation/viper-init.el
+++ b/lisp/emulation/viper-init.el
@@ -49,10 +49,6 @@
(interactive)
(message "Viper version is %s" viper-version))
-;; Is it XEmacs?
-(defconst viper-xemacs-p (featurep 'xemacs))
-;; 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
@@ -116,8 +112,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
@@ -356,9 +352,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)
@@ -370,7 +366,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)))))
@@ -475,7 +471,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."
@@ -1018,13 +1014,13 @@ 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))))
diff --git a/lisp/emulation/viper-macs.el b/lisp/emulation/viper-macs.el
index bf3f0eefb39..788feaf86e6 100644
--- a/lisp/emulation/viper-macs.el
+++ b/lisp/emulation/viper-macs.el
@@ -826,7 +826,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 e95e80aa4e0..7a47d321890 100644
--- a/lisp/emulation/viper-mous.el
+++ b/lisp/emulation/viper-mous.el
@@ -79,7 +79,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 +227,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 +273,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 +364,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 +507,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 +528,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 7073cd019dd..c757eb63aef 100644
--- a/lisp/emulation/viper-util.el
+++ b/lisp/emulation/viper-util.el
@@ -64,48 +64,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)
@@ -201,7 +187,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 +197,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 +207,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 +235,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 +253,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)))
@@ -724,13 +710,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 +774,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 +782,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 +798,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 +830,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 +847,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
@@ -983,7 +970,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)
@@ -1078,7 +1065,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))
@@ -1086,10 +1073,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
@@ -1123,14 +1110,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
@@ -1142,7 +1130,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
diff --git a/lisp/emulation/viper.el b/lisp/emulation/viper.el
index c0118250167..65d40e8bad7 100644
--- a/lisp/emulation/viper.el
+++ b/lisp/emulation/viper.el
@@ -690,7 +690,7 @@ It also can't undo some Viper settings."
(setq default-major-mode
(viper-standard-value 'default-major-mode viper-saved-non-viper-variables))
- (if viper-emacs-p
+ (if (featurep 'emacs)
(setq-default
mark-even-if-inactive
(viper-standard-value
@@ -701,7 +701,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.
@@ -788,7 +788,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
@@ -981,7 +981,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)
@@ -1022,7 +1022,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)
@@ -1094,12 +1094,12 @@ It also can't undo some Viper settings."
"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))))
))
@@ -1108,12 +1108,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))))
))
@@ -1123,12 +1123,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))))
))
@@ -1159,7 +1159,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)
@@ -1227,7 +1227,7 @@ These two lines must come in the order given.
(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)))
)))