diff options
Diffstat (limited to 'lisp/emulation')
-rw-r--r-- | lisp/emulation/edt.el | 106 | ||||
-rw-r--r-- | lisp/emulation/tpu-mapper.el | 68 | ||||
-rw-r--r-- | lisp/emulation/vip.el | 16 | ||||
-rw-r--r-- | lisp/emulation/viper-cmd.el | 29 | ||||
-rw-r--r-- | lisp/emulation/viper-ex.el | 32 | ||||
-rw-r--r-- | lisp/emulation/viper-init.el | 20 | ||||
-rw-r--r-- | lisp/emulation/viper-macs.el | 2 | ||||
-rw-r--r-- | lisp/emulation/viper-mous.el | 28 | ||||
-rw-r--r-- | lisp/emulation/viper-util.el | 126 | ||||
-rw-r--r-- | lisp/emulation/viper.el | 26 |
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))) ))) |