From dfec2bc7853fbef72f4306dcee3807b5dc9f6064 Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Thu, 20 Jun 2019 00:48:49 +0200 Subject: [PATCH] Remove most of the XEmacs compat code from viper*.el * lisp/emulation/viper-cmd.el () (viper-insert-state-post-command-sentinel) (viper-change-state-to-vi, viper-change-state-to-insert) (viper-change-state-to-emacs, viper-escape-to-state) (viper-special-read-and-insert-char, viper-toggle-key-action) (viper-prefix-arg-value, viper-prefix-arg-com) (viper-digit-argument, viper-command-argument, ) (viper-exec-Yank, viper-repeat, viper-forward-char) (viper-backward-char, viper-forward-word, viper-forward-Word) (viper-end-of-word, viper-end-of-Word, viper-backward-word) (viper-backward-Word, viper-beginning-of-line) (viper-bol-and-skip-white, viper-goto-eol, viper-goto-col) (viper-next-line, viper-next-line-at-bol, viper-previous-line) (viper-previous-line-at-bol, viper-goto-line, ) (viper-repeat-find, viper-repeat-find-opposite) (viper-window-top, viper-window-middle, viper-window-bottom) (viper-paren-match, viper-search, viper-buffer-search-enable) (viper-put-back, viper-Put-back, viper-mark-point) (viper-cycle-through-mark-ring, viper-goto-mark-subr) (viper-brac-function, viper-register-to-point) (viper-submit-report): Remove some XEmacs compat code. * lisp/emulation/viper-ex.el (viper-get-ex-address-subr) (viper-handle-!, ex-edit, ex-mark, ex-next-related-buffer) (ex-help, ex-write, ex-write-info, viper-info-on-file): Ditto. * lisp/emulation/viper-keym.el (viper-add-keymap): Ditto. * lisp/emulation/viper-macs.el (viper-record-kbd-macro): Remove XEmacs compat code. * lisp/emulation/viper-mous.el (viper-mouse-click-insert-word) (viper-mouse-click-search-word): Remove some XEmacs compat code. * lisp/emulation/viper-util.el (viper-overlay-p) (viper-color-defined-p, viper-iconify, viper-memq-char) (viper-char-equal, viper=, viper-color-display-p) (viper-get-cursor-color, viper-frame-value) (viper-change-cursor-color, viper-save-cursor-color) (viper-restore-cursor-color, viper-get-visible-buffer-window) (viper-file-checked-in-p, viper-put-on-search-overlay) (viper-flash-search-pattern, viper-hide-search-overlay) (viper-move-replace-overlay, viper-set-replace-overlay) (viper-set-replace-overlay-glyphs, viper-hide-replace-overlay) (viper-replace-start, viper-replace-end) (viper-set-minibuffer-overlay, viper-check-minibuffer-overlay) (viper-abbreviate-file-name, viper-mark-marker) (viper-set-mark-if-necessary, viper-leave-region-active) (viper-copy-event, viper-read-event-convert-to-char) (viper-event-key, viper-last-command-char) (viper-key-to-emacs-key, viper-eventify-list-xemacs) (viper-set-unread-command-events, viper-char-array-p) (viper-key-press-events-to-chars, viper-read-char-exclusive): Remove most of the XEmacs compat code. * lisp/emulation/viper.el (viper-go-away, viper-set-hooks) (viper-non-hook-settings): Remove some XEmacs compat code. --- lisp/emulation/viper-cmd.el | 92 ++++------ lisp/emulation/viper-ex.el | 31 ++-- lisp/emulation/viper-keym.el | 8 +- lisp/emulation/viper-macs.el | 2 +- lisp/emulation/viper-mous.el | 6 +- lisp/emulation/viper-util.el | 342 +++++++++++++---------------------- lisp/emulation/viper.el | 26 +-- 7 files changed, 188 insertions(+), 319 deletions(-) diff --git a/lisp/emulation/viper-cmd.el b/lisp/emulation/viper-cmd.el index dc05634f7e3..bdb205ce7c8 100644 --- a/lisp/emulation/viper-cmd.el +++ b/lisp/emulation/viper-cmd.el @@ -164,7 +164,7 @@ viper-insert-point (>= (point) viper-insert-point)) (setq viper-last-posn-while-in-insert-state (point-marker))) - (or (viper-overlay-p viper-replace-overlay) + (or (overlayp viper-replace-overlay) (progn (viper-set-replace-overlay (point-min) (point-min)) (viper-hide-replace-overlay))) @@ -603,7 +603,7 @@ (if (and viper-first-time (not (viper-is-in-minibuffer))) (viper-mode) (if overwrite-mode (overwrite-mode -1)) - (or (viper-overlay-p viper-replace-overlay) + (or (overlayp viper-replace-overlay) (viper-set-replace-overlay (point-min) (point-min))) (viper-hide-replace-overlay) ;; Expand abbrevs iff the previous character has word syntax. @@ -639,7 +639,7 @@ (interactive) (viper-change-state 'insert-state) - (or (viper-overlay-p viper-replace-overlay) + (or (overlayp viper-replace-overlay) (viper-set-replace-overlay (point-min) (point-min))) (viper-hide-replace-overlay) @@ -686,7 +686,7 @@ (defun viper-change-state-to-emacs (&rest _) "Change Viper state to Emacs." (interactive) - (or (viper-overlay-p viper-replace-overlay) + (or (overlayp viper-replace-overlay) (viper-set-replace-overlay (point-min) (point-min))) (viper-hide-replace-overlay) @@ -759,8 +759,7 @@ Vi's prefix argument will be used. Otherwise, the prefix argument passed to ;; this-command, last-command-char, last-command-event (setq this-command com) ;; Emacs represents key sequences as sequences (str or vec) - (setq last-command-event - (viper-copy-event (viper-seq-last-elt key))) + (setq last-command-event (viper-seq-last-elt key)) (if (commandp com) ;; pretend that current state is the state we escaped to @@ -831,7 +830,7 @@ Vi's prefix argument will be used. Otherwise, the prefix argument passed to (if (memq ch '(?\C-v ?\C-q)) (setq ch (aref (read-key-sequence nil) 0))) (insert ch))) - (setq last-command-event (viper-copy-event ch)) + (setq last-command-event ch) ) ; let (error nil) ) ; condition-case @@ -941,7 +940,7 @@ as a Meta key and any number of multiple escapes are allowed." (interactive) (if (and (< viper-expert-level 2) (equal viper-toggle-key "\C-z")) (if (viper-window-display-p) - (viper-iconify) + (iconify-or-deiconify-frame) (suspend-emacs)) (viper-change-state-to-emacs))) @@ -1016,20 +1015,20 @@ as a Meta key and any number of multiple escapes are allowed." (let ((viper-intermediate-command 'viper-digit-argument) value func) ;; read while number - (while (and (viper-characterp event-char) + (while (and (characterp event-char) (>= event-char ?0) (<= event-char ?9)) (setq value (+ (* (if (integerp value) value 0) 10) (- event-char ?0))) - (setq event-char (viper-read-event-convert-to-char))) + (setq event-char (read-event))) (setq prefix-arg value) (if com (setq prefix-arg (cons prefix-arg com))) (while (eq event-char ?U) (viper-describe-arg prefix-arg) - (setq event-char (viper-read-event-convert-to-char))) + (setq event-char (read-event))) (if (or com (and (not (eq viper-current-state 'vi-state)) ;; make sure it is a Vi command - (viper-characterp event-char) + (characterp event-char) (viper-vi-command-p event-char) )) ;; If appears to be one of the vi commands, @@ -1154,7 +1153,7 @@ as a Meta key and any number of multiple escapes are allowed." (if cmd-to-exec-at-end (progn - (setq last-command-event (viper-copy-event char)) + (setq last-command-event char) (condition-case err (funcall cmd-to-exec-at-end cmd-info) (error @@ -1176,7 +1175,6 @@ as a Meta key and any number of multiple escapes are allowed." (defun viper-digit-argument (arg) "Begin numeric argument for the next command." (interactive "P") - (viper-leave-region-active) (viper-prefix-arg-value (viper-last-command-char) (if (consp arg) (cdr arg) nil))) @@ -1197,7 +1195,7 @@ as a Meta key and any number of multiple escapes are allowed." (t (error viper-InvalidCommandArgument)))) (quit (setq viper-use-register nil) (signal 'quit nil))) - (viper-deactivate-mark))) + (deactivate-mark))) ;; repeat last destructive command @@ -1381,7 +1379,7 @@ as a Meta key and any number of multiple escapes are allowed." (if (> lines-saved viper-change-notification-threshold) (unless (viper-is-in-minibuffer) (message "Saved %d lines" lines-saved))))) - (viper-deactivate-mark) + (deactivate-mark) (goto-char viper-com-point)) (defun viper-exec-bang (_m-com com) @@ -1523,7 +1521,7 @@ If the prefix argument ARG is non-nil, it is used instead of `val'." ;; executed by `.' is already on the ring. (if (eq last-command 'viper-display-current-destructive-command) (viper-push-onto-ring viper-d-com 'viper-command-ring)) - (viper-deactivate-mark) + (deactivate-mark) )) (defun viper-repeat-from-history () @@ -2532,7 +2530,6 @@ These keys are ESC, RET, and LineFeed." "Move point right ARG characters (left if ARG negative). On reaching end of line, stop and signal error." (interactive "P") - (viper-leave-region-active) (let ((val (viper-p-val arg)) (com (viper-getcom arg))) (if com (viper-move-marker-locally 'viper-com-point (point))) @@ -2555,7 +2552,6 @@ On reaching end of line, stop and signal error." "Move point left ARG characters (right if ARG negative). On reaching beginning of line, stop and signal error." (interactive "P") - (viper-leave-region-active) (let ((val (viper-p-val arg)) (com (viper-getcom arg))) (if com (viper-move-marker-locally 'viper-com-point (point))) @@ -2688,7 +2684,6 @@ On reaching beginning of line, stop and signal error." (defun viper-forward-word (arg) "Forward word." (interactive "P") - (viper-leave-region-active) (let ((val (viper-p-val arg)) (com (viper-getcom arg))) (if com (viper-move-marker-locally 'viper-com-point (point))) @@ -2709,7 +2704,6 @@ On reaching beginning of line, stop and signal error." (defun viper-forward-Word (arg) "Forward word delimited by white characters." (interactive "P") - (viper-leave-region-active) (let ((val (viper-p-val arg)) (com (viper-getcom arg))) (if com (viper-move-marker-locally 'viper-com-point (point))) @@ -2752,7 +2746,6 @@ On reaching beginning of line, stop and signal error." (defun viper-end-of-word (arg &optional _careful) "Move point to end of current word." (interactive "P") - (viper-leave-region-active) (let ((val (viper-p-val arg)) (com (viper-getcom arg))) (if com (viper-move-marker-locally 'viper-com-point (point))) @@ -2765,7 +2758,6 @@ On reaching beginning of line, stop and signal error." (defun viper-end-of-Word (arg) "Forward to end of word delimited by white character." (interactive "P") - (viper-leave-region-active) (let ((val (viper-p-val arg)) (com (viper-getcom arg))) (if com (viper-move-marker-locally 'viper-com-point (point))) @@ -2800,7 +2792,6 @@ On reaching beginning of line, stop and signal error." (defun viper-backward-word (arg) "Backward word." (interactive "P") - (viper-leave-region-active) (let ((val (viper-p-val arg)) (com (viper-getcom arg))) (if com @@ -2815,7 +2806,6 @@ On reaching beginning of line, stop and signal error." (defun viper-backward-Word (arg) "Backward word delimited by white character." (interactive "P") - (viper-leave-region-active) (let ((val (viper-p-val arg)) (com (viper-getcom arg))) (if com @@ -2836,7 +2826,6 @@ On reaching beginning of line, stop and signal error." (defun viper-beginning-of-line (arg) "Go to beginning of line." (interactive "P") - (viper-leave-region-active) (let ((val (viper-p-val arg)) (com (viper-getcom arg))) (if com (viper-move-marker-locally 'viper-com-point (point))) @@ -2846,7 +2835,6 @@ On reaching beginning of line, stop and signal error." (defun viper-bol-and-skip-white (arg) "Beginning of line at first non-white character." (interactive "P") - (viper-leave-region-active) (let ((val (viper-p-val arg)) (com (viper-getcom arg))) (if com (viper-move-marker-locally 'viper-com-point (point))) @@ -2856,7 +2844,6 @@ On reaching beginning of line, stop and signal error." (defun viper-goto-eol (arg) "Go to end of line." (interactive "P") - (viper-leave-region-active) (let ((val (viper-p-val arg)) (com (viper-getcom arg))) (if com (viper-move-marker-locally 'viper-com-point (point))) @@ -2873,7 +2860,6 @@ On reaching beginning of line, stop and signal error." (defun viper-goto-col (arg) "Go to ARG's column." (interactive "P") - (viper-leave-region-active) (let ((val (viper-p-val arg)) (com (viper-getcom arg)) line-len) @@ -2895,7 +2881,6 @@ On reaching beginning of line, stop and signal error." (defun viper-next-line (arg) "Go to next line." (interactive "P") - (viper-leave-region-active) (let ((val (viper-p-val arg)) (com (viper-getCom arg))) (if com (viper-move-marker-locally 'viper-com-point (point))) @@ -2930,7 +2915,6 @@ If point is on a widget or a button, simulate clicking on that widget/button." (if (and (fboundp 'button-at) (fboundp 'push-button) (button-at (point))) (push-button) ;; not a widget or a button - (viper-leave-region-active) (save-excursion (end-of-line) (if (eobp) (error "Last line in buffer"))) @@ -2945,7 +2929,6 @@ If point is on a widget or a button, simulate clicking on that widget/button." (defun viper-previous-line (arg) "Go to previous line." (interactive "P") - (viper-leave-region-active) (let ((val (viper-p-val arg)) (com (viper-getCom arg))) (if com (viper-move-marker-locally 'viper-com-point (point))) @@ -2963,7 +2946,6 @@ If point is on a widget or a button, simulate clicking on that widget/button." (defun viper-previous-line-at-bol (arg) "Previous line at beginning of line." (interactive "P") - (viper-leave-region-active) (save-excursion (beginning-of-line) (if (bobp) (error "First line in buffer"))) @@ -2998,7 +2980,7 @@ 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))) (viper-move-marker-locally 'viper-com-point (point)) - (viper-deactivate-mark) + (deactivate-mark) (push-mark nil t) (if (null val) (goto-char (point-max)) @@ -3181,7 +3163,7 @@ controlled by the sign of prefix numeric value." (interactive "P") (let ((val (viper-p-val arg)) (com (viper-getcom arg))) - (viper-deactivate-mark) + (deactivate-mark) (if com (viper-move-marker-locally 'viper-com-point (point))) (viper-find-char val viper-f-char viper-f-forward viper-f-offset) (if com @@ -3194,7 +3176,7 @@ controlled by the sign of prefix numeric value." (interactive "P") (let ((val (viper-p-val arg)) (com (viper-getcom arg))) - (viper-deactivate-mark) + (deactivate-mark) (if com (viper-move-marker-locally 'viper-com-point (point))) (viper-find-char val viper-f-char (not viper-f-forward) viper-f-offset) (if com @@ -3210,7 +3192,6 @@ controlled by the sign of prefix numeric value." (interactive "P") (let ((val (viper-p-val arg)) (com (viper-getCom arg))) - (viper-leave-region-active) (if com (viper-move-marker-locally 'viper-com-point (point))) (push-mark nil t) (move-to-window-line (1- val)) @@ -3230,7 +3211,6 @@ controlled by the sign of prefix numeric value." (interactive "P") (let ((val (viper-p-val arg)) (com (viper-getCom arg))) - (viper-leave-region-active) (if com (viper-move-marker-locally 'viper-com-point (point))) (push-mark nil t) (move-to-window-line (+ (/ (1- (window-height)) 2) (1- val))) @@ -3250,7 +3230,6 @@ controlled by the sign of prefix numeric value." (interactive "P") (let ((val (viper-p-val arg)) (com (viper-getCom arg))) - (viper-leave-region-active) (if com (viper-move-marker-locally 'viper-com-point (point))) (push-mark nil t) (move-to-window-line (- val)) @@ -3316,7 +3295,6 @@ controlled by the sign of prefix numeric value." (defun viper-paren-match (arg) "Go to the matching parenthesis." (interactive "P") - (viper-leave-region-active) (let ((com (viper-getcom arg)) (parse-sexp-ignore-comments viper-parse-sexp-ignore-comments) anchor-point) @@ -3723,7 +3701,7 @@ Null string will repeat previous search." (offset (not no-offset)) (case-fold-search viper-case-fold-search) (start-point (or init-point (point)))) - (viper-deactivate-mark) + (deactivate-mark) (if forward (condition-case nil (progn @@ -3832,7 +3810,7 @@ Null string will repeat previous search." ;; ?g acts as a default value for viper-buffer-search-char (setq viper-buffer-search-char ?g))) (define-key viper-vi-basic-map - (cond ((viper-characterp viper-buffer-search-char) + (cond ((characterp viper-buffer-search-char) (char-to-string viper-buffer-search-char)) (t (error "viper-buffer-search-char: wrong value type, %S" viper-buffer-search-char))) @@ -3938,7 +3916,7 @@ Null string will repeat previous search." (forward-line 1)) (beginning-of-line)) (if (not (eolp)) (viper-forward-char-carefully))) - (set-marker (viper-mark-marker) (point) (current-buffer)) + (set-marker (mark-marker) (point) (current-buffer)) (viper-set-destructive-command (list 'viper-put-back val nil viper-use-register nil nil)) (setq sv-point (point)) @@ -3958,7 +3936,7 @@ Null string will repeat previous search." (exchange-point-and-mark) (if (bolp) (back-to-indentation))) - (viper-deactivate-mark)) + (deactivate-mark)) (defun viper-Put-back (arg) "Put back at point/above line." @@ -3983,7 +3961,7 @@ Null string will repeat previous search." (if (viper-end-with-a-newline-p text) (beginning-of-line)) (viper-set-destructive-command (list 'viper-Put-back val nil viper-use-register nil nil)) - (set-marker (viper-mark-marker) (point) (current-buffer)) + (set-marker (mark-marker) (point) (current-buffer)) (setq sv-point (point)) (viper-loop val (viper-yank text)) (setq chars-inserted (abs (- (point) sv-point)) @@ -4001,7 +3979,7 @@ Null string will repeat previous search." (exchange-point-and-mark) (if (bolp) (back-to-indentation))) - (viper-deactivate-mark)) + (deactivate-mark)) ;; Copy region to kill-ring. @@ -4286,7 +4264,7 @@ and regexp replace." (interactive) (let ((char (read-char))) (cond ((and (<= ?a char) (<= char ?z)) - (point-to-register (viper-int-to-char (1+ (- char ?a))))) + (point-to-register (1+ (- char ?a)))) ((viper= char ?<) (viper-mark-beginning-of-buffer)) ((viper= char ?>) (viper-mark-end-of-buffer)) ((viper= char ?.) (viper-set-mark-if-necessary)) @@ -4322,15 +4300,15 @@ One can use \\=`\\=` and \\='\\=' to temporarily jump 1 step back." (if (eq last-command 'viper-cycle-through-mark-ring) () ;; save current mark if the first iteration - (setq mark-ring (delete (viper-mark-marker) mark-ring)) + (setq mark-ring (delete (mark-marker) mark-ring)) (if (mark t) (push-mark (mark t) t)) ) (pop-mark) (set-mark-command 1) ;; don't duplicate mark on the ring - (setq mark-ring (delete (viper-mark-marker) mark-ring)) + (setq mark-ring (delete (mark-marker) mark-ring)) (push-mark sv-pt t) - (viper-deactivate-mark) + (deactivate-mark) (setq this-command 'viper-cycle-through-mark-ring) )) @@ -4356,7 +4334,7 @@ One can use \\=`\\=` and \\='\\=' to temporarily jump 1 step back." (backward-char 1))) (cond ((viper-valid-register char '(letter)) (let* ((buff (current-buffer)) - (reg (viper-int-to-char (1+ (- char ?a)))) + (reg (1+ (- char ?a))) (text-marker (get-register reg))) ;; If marker points to file that had markers set (and those markers ;; were saved (as e.g., in session.el), then restore those markers @@ -4519,7 +4497,7 @@ One can use \\=`\\=` and \\='\\=' to temporarily jump 1 step back." ((viper= ?\] reg) (viper-heading-end arg)) ((viper-valid-register reg '(letter)) - (let* ((val (get-register (viper-int-to-char (1+ (- reg ?a))))) + (let* ((val (get-register (1+ (- reg ?a)))) (buf (if (not (markerp val)) (error viper-EmptyTextmarker reg) (marker-buffer val))) @@ -4756,13 +4734,13 @@ Please, specify your level now: ")) (if (and enforce-buffer (not (equal (current-buffer) (marker-buffer val)))) (error (concat viper-EmptyTextmarker " in this buffer") - (viper-int-to-char (1- (+ char ?a))))) + (1- (+ char ?a)))) (pop-to-buffer (marker-buffer val)) (goto-char val)) ((and (consp val) (eq (car val) 'file)) (find-file (cdr val))) (t - (error viper-EmptyTextmarker (viper-int-to-char (1- (+ char ?a)))))))) + (error viper-EmptyTextmarker (1- (+ char ?a))))))) (defun viper-save-kill-buffer () @@ -4796,14 +4774,14 @@ Please, specify your level now: ")) (viper-frame-parameters (if (fboundp 'frame-parameters) (frame-parameters (selected-frame)))) (viper-minibuffer-emacs-face (if (viper-has-face-support-p) - (viper-get-face + (facep viper-minibuffer-emacs-face) 'non-x)) (viper-minibuffer-vi-face (if (viper-has-face-support-p) - (viper-get-face viper-minibuffer-vi-face) + (facep viper-minibuffer-vi-face) 'non-x)) (viper-minibuffer-insert-face (if (viper-has-face-support-p) - (viper-get-face + (facep viper-minibuffer-insert-face) 'non-x)) varlist salutation window-config) diff --git a/lisp/emulation/viper-ex.el b/lisp/emulation/viper-ex.el index 45b91cd9c0e..56ed2f7d99f 100644 --- a/lisp/emulation/viper-ex.el +++ b/lisp/emulation/viper-ex.el @@ -882,7 +882,8 @@ reversed." (exchange-point-and-mark) (goto-char (viper-register-to-point - (viper-int-to-char (1+ (- ex-token ?a))) 'enforce-buffer))) + (1+ (- ex-token ?a))) + 'enforce-buffer)) (setq address (point-marker))))) address)) @@ -1085,7 +1086,7 @@ reversed." (defun viper-handle-! () (interactive) (if (and (string= - (buffer-string) (viper-abbreviate-file-name default-directory)) + (buffer-string) (abbreviate-file-name default-directory)) (member ex-token '("read" "write"))) (erase-buffer)) (insert "!")) @@ -1263,7 +1264,7 @@ reversed." (if (not file) (viper-get-ex-file)) (cond ((and (string= ex-file "") buffer-file-name) - (setq ex-file (viper-abbreviate-file-name (buffer-file-name)))) + (setq ex-file (abbreviate-file-name (buffer-file-name)))) ((string= ex-file "") (error viper-NoFileSpecified))) @@ -1480,7 +1481,7 @@ reversed." (error "`%s' requires a following letter" ex-token)))) (save-excursion (goto-char (car ex-addresses)) - (point-to-register (viper-int-to-char (1+ (- char ?a))))))) + (point-to-register (1+ (- char ?a)))))) @@ -1547,7 +1548,7 @@ reversed." (if (not (viper-buffer-live-p buf)) (error "Didn't find buffer %S or file %S" file-or-buffer-name - (viper-abbreviate-file-name + (abbreviate-file-name (expand-file-name file-or-buffer-name)))) (if (equal buf (current-buffer)) @@ -1562,7 +1563,7 @@ reversed." ;; setup buffer (if (setq wind (viper-get-visible-buffer-window buf)) () - (setq wind (get-lru-window (if (featurep 'xemacs) nil 'visible))) + (setq wind (get-lru-window 'visible)) (set-window-buffer wind buf)) (if (viper-window-display-p) @@ -1884,17 +1885,15 @@ reversed." (condition-case nil (progn (pop-to-buffer (get-buffer-create "*info*")) - (info (if (featurep 'xemacs) "viper.info" "viper")) + (info "viper") (message "Type `i' to search for a specific topic")) (error (beep 1) (with-output-to-temp-buffer " *viper-info*" (princ (format " 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 (featurep 'xemacs) "X" "") - )))))) +This file is part of the standard distribution of Emacs. +Please contact your system administrator. ")))))) ;; Ex source command. ;; Loads the file specified as argument or viper-custom-file-name. @@ -2089,9 +2088,7 @@ Please contact your system administrator. " ;; create temp buffer for the region (setq temp-buf (get-buffer-create " *ex-write*")) (set-buffer temp-buf) - (if (featurep 'xemacs) - (set-visited-file-name ex-file) - (set-visited-file-name ex-file 'noquery)) + (set-visited-file-name ex-file 'noquery) (erase-buffer) (if (and file-exists ex-append) (insert-file-contents ex-file)) @@ -2130,7 +2127,7 @@ Please contact your system administrator. " (defun ex-write-info (exists file-name beg end) (message "`%s'%s %d lines, %d characters" - (viper-abbreviate-file-name file-name) + (abbreviate-file-name file-name) (if exists "" " [New file]") (count-lines beg (min (1+ end) (point-max))) (- end beg))) @@ -2226,9 +2223,9 @@ Type `mak ' (including the space) to run make with no args." lines file info) (setq lines (count-lines (point-min) (viper-line-pos 'end)) file (cond ((buffer-file-name) - (concat (viper-abbreviate-file-name (buffer-file-name)) ":")) + (concat (abbreviate-file-name (buffer-file-name)) ":")) ((buffer-file-name (buffer-base-buffer)) - (concat (viper-abbreviate-file-name (buffer-file-name (buffer-base-buffer))) " (indirect buffer):")) + (concat (abbreviate-file-name (buffer-file-name (buffer-base-buffer))) " (indirect buffer):")) (t (concat (buffer-name) " [Not visiting any file]:"))) info (format "line=%d/%d pos=%d/%d col=%d %s" (if (= pos1 pos2) diff --git a/lisp/emulation/viper-keym.el b/lisp/emulation/viper-keym.el index 8bb75d65afa..a7de64652fb 100644 --- a/lisp/emulation/viper-keym.el +++ b/lisp/emulation/viper-keym.el @@ -642,12 +642,8 @@ Arguments: (major-mode viper-state keymap)" (defun viper-add-keymap (mapsrc mapdst) "Add contents of mapsrc to mapdst. It is assumed that mapsrc is sparse." - (if (featurep 'xemacs) - ;; Emacs 22 has map-keymap. - (map-keymap (lambda (key binding) (define-key mapdst key binding)) - mapsrc) - (mapc (lambda (p) (define-key mapdst (vector (car p)) (cdr p))) - (cdr mapsrc)))) + (mapc (lambda (p) (define-key mapdst (vector (car p)) (cdr p))) + (cdr mapsrc))) (defun viper-modify-keymap (map alist) "Modifies MAP with bindings specified in the ALIST. The alist has the diff --git a/lisp/emulation/viper-macs.el b/lisp/emulation/viper-macs.el index 1a7f70103db..243a0a8d56f 100644 --- a/lisp/emulation/viper-macs.el +++ b/lisp/emulation/viper-macs.el @@ -415,7 +415,7 @@ If SCOPE is nil, the user is asked to specify the scope." t))) (if (y-or-n-p (format "Save this macro in %s? " - (viper-abbreviate-file-name viper-custom-file-name))) + (abbreviate-file-name viper-custom-file-name))) (viper-save-string-in-file (format "\n(viper-record-kbd-macro %S '%S %s '%S)" (viper-display-macro macro-name) diff --git a/lisp/emulation/viper-mous.el b/lisp/emulation/viper-mous.el index e49fc875418..e1f7c1643bd 100644 --- a/lisp/emulation/viper-mous.el +++ b/lisp/emulation/viper-mous.el @@ -280,7 +280,7 @@ See `viper-surrounding-word' for the definition of a word in this case." ;; the next pending event is not a mouse event, we execute the ;; current mouse event (progn - (setq interrupting-event (viper-read-event)) + (setq interrupting-event (read-event)) (viper-mouse-event-p last-input-event))) (progn ; interrupted wait (setq viper-global-prefix-argument arg) @@ -362,7 +362,7 @@ this command." ;; pending event is not a mouse event, we execute the current mouse ;; event (progn - (viper-read-event) + (read-event) (viper-mouse-event-p last-input-event))) (progn ; interrupted wait (setq viper-global-prefix-argument (or viper-global-prefix-argument @@ -380,7 +380,7 @@ this command." viper-global-prefix-argument nil)) (setq arg (or arg 1)) - (viper-deactivate-mark) + (deactivate-mark) (if (or (not (string= click-word viper-s-string)) (not (markerp viper-search-start-marker)) (not (equal (marker-buffer viper-search-start-marker) diff --git a/lisp/emulation/viper-util.el b/lisp/emulation/viper-util.el index a7e7af3bf85..1d7bb1580ce 100644 --- a/lisp/emulation/viper-util.el +++ b/lisp/emulation/viper-util.el @@ -47,34 +47,22 @@ -(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 'facep)) -(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)) +(define-obsolete-function-alias 'viper-overlay-p 'overlayp "27.1") +(define-obsolete-function-alias 'viper-make-overlay 'make-overlay "27.1") +(define-obsolete-function-alias 'viper-overlay-live-p 'overlayp "27.1") +(define-obsolete-function-alias 'viper-move-overlay 'move-overlay "27.1") +(define-obsolete-function-alias 'viper-overlay-start 'overlay-start "27.1") +(define-obsolete-function-alias 'viper-overlay-end 'overlay-end "27.1") +(define-obsolete-function-alias 'viper-overlay-get 'overlay-get "27.1") +(define-obsolete-function-alias 'viper-overlay-put 'overlay-put "27.1") +(define-obsolete-function-alias 'viper-read-event 'read-event "27.1") +(define-obsolete-function-alias 'viper-characterp 'integerp "27.1") +(define-obsolete-function-alias 'viper-int-to-char 'identity "27.1") +(define-obsolete-function-alias 'viper-get-face 'facep "27.1") +(define-obsolete-function-alias 'viper-color-defined-p + 'x-color-defined-p "27.1") +(define-obsolete-function-alias 'viper-iconify + 'iconify-or-deiconify-frame "27.1") ;; CHAR is supposed to be a char or an integer (positive or negative) @@ -84,60 +72,50 @@ ;; chars. (defun viper-memq-char (char list) (cond ((and (integerp char) (>= char 0)) - (memq (viper-int-to-char char) list)) + (memq char list)) ((memq char list)))) ;; Check if char-or-int and char are the same as characters (defun viper-char-equal (char-or-int char) (cond ((and (integerp char-or-int) (>= char-or-int 0)) - (= (viper-int-to-char char-or-int) char)) + (= char-or-int char)) ((eq char-or-int char)))) ;; Like =, but accommodates null and also is t for eq-objects (defun viper= (char char1) (cond ((eq char char1) t) - ((and (viper-characterp char) (viper-characterp char1)) + ((and (characterp char) (characterp char1)) (= char char1)) (t nil))) (defsubst viper-color-display-p () - (if (featurep 'xemacs) (eq (device-class (selected-device)) 'color) - (x-display-color-p))) + (x-display-color-p)) -(defun viper-get-cursor-color (&optional frame) - (if (featurep 'xemacs) - (color-instance-name - (frame-property (or frame (selected-frame)) 'cursor-color)) - (cdr (assoc 'cursor-color (frame-parameters))))) +(defun viper-get-cursor-color (&optional _frame) + (cdr (assoc 'cursor-color (frame-parameters)))) (defmacro viper-frame-value (variable) "Return the value of VARIABLE local to the current frame, if there is one. Otherwise return the normal value." - `(if (featurep 'xemacs) + ;; Frame-local variables are obsolete from Emacs 22.2 onwards, + ;; so we do it by hand instead. + ;; Buffer-local values take precedence over frame-local ones. + `(if (local-variable-p ',variable) ,variable - ;; Frame-local variables are obsolete from Emacs 22.2 onwards, - ;; so we do it by hand instead. - ;; Buffer-local values take precedence over frame-local ones. - (if (local-variable-p ',variable) - ,variable - ;; Distinguish between no frame parameter and a frame parameter - ;; with a value of nil. - (let ((fp (assoc ',variable (frame-parameters)))) - (if fp (cdr fp) - ,variable))))) + ;; Distinguish between no frame parameter and a frame parameter + ;; with a value of nil. + (let ((fp (assoc ',variable (frame-parameters)))) + (if fp (cdr fp) + ,variable)))) ;; cursor colors (defun viper-change-cursor-color (new-color &optional frame) - (if (and (viper-window-display-p) (viper-color-display-p) - (stringp new-color) (viper-color-defined-p new-color) + (if (and (viper-window-display-p) (viper-color-display-p) + (stringp new-color) (x-color-defined-p new-color) (not (string= new-color (viper-get-cursor-color)))) - (if (featurep 'xemacs) - (set-frame-property - (or frame (selected-frame)) - 'cursor-color (make-color-instance new-color)) - (modify-frame-parameters - (or frame (selected-frame)) - (list (cons 'cursor-color new-color)))))) + (modify-frame-parameters + (or frame (selected-frame)) + (list (cons 'cursor-color new-color))))) ;; Note that the colors this function uses might not be those ;; associated with FRAME, if there are frame-local values. @@ -166,7 +144,7 @@ Otherwise return the normal value." (defun viper-save-cursor-color (before-which-mode) (if (and (viper-window-display-p) (viper-color-display-p)) (let ((color (viper-get-cursor-color))) - (if (and (stringp color) (viper-color-defined-p color) + (if (and (stringp color) (x-color-defined-p color) ;; there is something fishy in that the color is not saved if ;; it is the same as frames default cursor color. need to be ;; checked. @@ -216,7 +194,7 @@ Otherwise return the normal value." ;; restore cursor color from replace overlay (defun viper-restore-cursor-color(after-which-mode) - (if (viper-overlay-p viper-replace-overlay) + (if (overlayp viper-replace-overlay) (viper-change-cursor-color (cond ((eq after-which-mode 'after-replace-mode) (viper-get-saved-cursor-color-in-replace-mode)) @@ -255,10 +233,7 @@ Otherwise return the normal value." (defun viper-get-visible-buffer-window (wind) - (if (featurep 'xemacs) - (get-buffer-window wind t) - (get-buffer-window wind 'visible))) - + (get-buffer-window wind 'visible)) ;; Return line position. ;; If pos is 'start then returns position of line start. @@ -708,9 +683,7 @@ Otherwise return the normal value." (if (fboundp 'vc-state) (and (not (memq (vc-state file) '(edited needs-merge))) - (not (stringp (vc-state file)))) - ;; XEmacs has no vc-state - (if (featurep 'xemacs) (not (vc-locking-user file)))))) + (not (stringp (vc-state file))))))) ;; checkout if visited file is checked in (defun viper-maybe-checkout (buf) @@ -730,12 +703,12 @@ Otherwise return the normal value." ;;; Overlays (defun viper-put-on-search-overlay (beg end) - (if (viper-overlay-p viper-search-overlay) - (viper-move-overlay viper-search-overlay beg end) - (setq viper-search-overlay (viper-make-overlay beg end (current-buffer))) - (viper-overlay-put + (if (overlayp viper-search-overlay) + (move-overlay viper-search-overlay beg end) + (setq viper-search-overlay (make-overlay beg end (current-buffer))) + (overlay-put viper-search-overlay 'priority viper-search-overlay-priority)) - (viper-overlay-put viper-search-overlay 'face viper-search-face)) + (overlay-put viper-search-overlay 'face viper-search-face)) ;; Search @@ -744,41 +717,41 @@ Otherwise return the normal value." nil (viper-put-on-search-overlay (match-beginning 0) (match-end 0)) (sit-for 2) - (viper-overlay-put viper-search-overlay 'face nil))) + (overlay-put viper-search-overlay 'face nil))) (defun viper-hide-search-overlay () - (if (not (viper-overlay-p viper-search-overlay)) + (if (not (overlayp viper-search-overlay)) (progn (setq viper-search-overlay - (viper-make-overlay (point-min) (point-min) (current-buffer))) - (viper-overlay-put + (make-overlay (point-min) (point-min) (current-buffer))) + (overlay-put viper-search-overlay 'priority viper-search-overlay-priority))) - (viper-overlay-put viper-search-overlay 'face nil)) + (overlay-put viper-search-overlay 'face nil)) ;; Replace state (defsubst viper-move-replace-overlay (beg end) - (viper-move-overlay viper-replace-overlay beg end)) + (move-overlay viper-replace-overlay beg end)) (defun viper-set-replace-overlay (beg end) - (if (viper-overlay-live-p viper-replace-overlay) + (if (overlayp viper-replace-overlay) (viper-move-replace-overlay beg end) - (setq viper-replace-overlay (viper-make-overlay beg end (current-buffer))) + (setq viper-replace-overlay (make-overlay beg end (current-buffer))) ;; never detach - (viper-overlay-put + (overlay-put viper-replace-overlay (if (featurep 'emacs) 'evaporate 'detachable) nil) - (viper-overlay-put + (overlay-put viper-replace-overlay 'priority viper-replace-overlay-priority) ;; If Emacs will start supporting overlay maps, as it currently supports ;; text-property maps, we could do away with viper-replace-minor-mode and ;; just have keymap attached to replace overlay. - ;;(viper-overlay-put + ;;(overlay-put ;; viper-replace-overlay ;; (if (featurep 'xemacs) 'keymap 'local-map) ;; viper-replace-map) ) (if (viper-has-face-support-p) - (viper-overlay-put + (overlay-put viper-replace-overlay 'face viper-replace-overlay-face)) (viper-save-cursor-color 'before-replace-mode) (viper-change-cursor-color @@ -786,27 +759,25 @@ Otherwise return the normal value." (defun viper-set-replace-overlay-glyphs (before-glyph after-glyph) - (or (viper-overlay-live-p viper-replace-overlay) + (or (overlayp viper-replace-overlay) (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 (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)))) + (overlay-put viper-replace-overlay 'before-string before-glyph) + (overlay-put viper-replace-overlay 'after-string after-glyph))) (defun viper-hide-replace-overlay () (viper-set-replace-overlay-glyphs nil nil) (viper-restore-cursor-color 'after-replace-mode) (viper-restore-cursor-color 'after-insert-mode) (if (viper-has-face-support-p) - (viper-overlay-put viper-replace-overlay 'face nil))) + (overlay-put viper-replace-overlay 'face nil))) (defsubst viper-replace-start () - (viper-overlay-start viper-replace-overlay)) + (overlay-start viper-replace-overlay)) (defsubst viper-replace-end () - (viper-overlay-end viper-replace-overlay)) + (overlay-end viper-replace-overlay)) ;; Minibuffer @@ -814,35 +785,25 @@ Otherwise return the normal value." (defun viper-set-minibuffer-overlay () (viper-check-minibuffer-overlay) (when (viper-has-face-support-p) - (viper-overlay-put + (overlay-put viper-minibuffer-overlay 'face viper-minibuffer-current-face) - (viper-overlay-put + (overlay-put viper-minibuffer-overlay 'priority viper-minibuffer-overlay-priority) ;; never detach - (viper-overlay-put - viper-minibuffer-overlay - (if (featurep 'emacs) 'evaporate 'detachable) - nil) - ;; make viper-minibuffer-overlay open-ended - ;; In emacs, it is made open ended at creation time - (when (featurep 'xemacs) - (viper-overlay-put viper-minibuffer-overlay 'start-open nil) - (viper-overlay-put viper-minibuffer-overlay 'end-open nil)))) + (overlay-put viper-minibuffer-overlay 'evaporate nil))) (defun viper-check-minibuffer-overlay () - (if (viper-overlay-live-p viper-minibuffer-overlay) - (viper-move-overlay + (if (overlayp viper-minibuffer-overlay) + (move-overlay viper-minibuffer-overlay (if (fboundp 'minibuffer-prompt-end) (minibuffer-prompt-end) 1) (1+ (buffer-size))) (setq viper-minibuffer-overlay - (if (featurep 'xemacs) - (viper-make-overlay 1 (1+ (buffer-size)) (current-buffer)) - ;; make overlay open-ended - (viper-make-overlay - (if (fboundp 'minibuffer-prompt-end) (minibuffer-prompt-end) 1) - (1+ (buffer-size)) - (current-buffer) nil 'rear-advance))))) + ;; make overlay open-ended + (make-overlay + (if (fboundp 'minibuffer-prompt-end) (minibuffer-prompt-end) 1) + (1+ (buffer-size)) + (current-buffer) nil 'rear-advance)))) (defsubst viper-is-in-minibuffer () @@ -854,9 +815,7 @@ Otherwise return the normal value." ;;; XEmacs compatibility (defun viper-abbreviate-file-name (file) - (if (featurep 'xemacs) - (abbreviate-file-name file t) ; XEmacs requires addl argument - (abbreviate-file-name file))) + (abbreviate-file-name file)) ;; Sit for VAL milliseconds. XEmacs doesn't support the millisecond arg ;; in sit-for, so this function smooths out the differences. @@ -877,9 +836,7 @@ Otherwise return the normal value." (with-current-buffer buf (and (<= pos (point-max)) (<= (point-min) pos)))))) -(defsubst viper-mark-marker () - (if (featurep 'xemacs) (mark-marker t) - (mark-marker))) +(define-obsolete-function-alias 'viper-mark-marker 'mark-marker "27.1") (defvar viper-saved-mark nil "Where viper saves mark. This mark is resurrected by m^.") @@ -887,20 +844,17 @@ Otherwise return the normal value." ;; like (set-mark-command nil) but doesn't push twice, if (car mark-ring) ;; is the same as (mark t). (defsubst viper-set-mark-if-necessary () - (setq mark-ring (delete (viper-mark-marker) mark-ring)) + (setq mark-ring (delete (mark-marker) mark-ring)) (set-mark-command nil) (setq viper-saved-mark (point))) -;; In transient mark mode (zmacs mode), it is annoying when regions become -;; highlighted due to Viper's pushing marks. So, we deactivate marks, unless -;; the user explicitly wants highlighting, e.g., by hitting '' or `` -(defun viper-deactivate-mark () - (if (featurep 'xemacs) - (zmacs-deactivate-region) - (deactivate-mark))) +;; In transient mark mode, it is annoying when regions become +;; highlighted due to Viper's pushing marks. So, we deactivate marks, +;; unless the user explicitly wants highlighting, e.g., by hitting '' +;; or `` +(define-obsolete-function-alias 'viper-deactivate-mark 'deactivate-mark "27.1") -(defsubst viper-leave-region-active () - (if (featurep 'xemacs) (setq zmacs-region-stays t))) +(define-obsolete-function-alias 'viper-leave-region-active 'ignore "27.1") ;; Check if arg is a valid character for register ;; TYPE is a list that can contain `letter', `Letter', and `digit'. @@ -919,11 +873,7 @@ Otherwise return the normal value." -;; it is suggested that an event must be copied before it is assigned to -;; last-command-event in XEmacs -(defun viper-copy-event (event) - (if (featurep 'xemacs) (copy-event event) - event)) +(define-obsolete-function-alias 'viper-copy-event 'identity "27.1") ;; Uses different timeouts for ESC-sequences and others (defun viper-fast-keysequence-p () @@ -933,15 +883,8 @@ Otherwise return the normal value." viper-fast-keyseq-timeout) t))) -;; like read-event, but in XEmacs also try to convert to char, if possible -(defun viper-read-event-convert-to-char () - (let (event) - (if (featurep 'xemacs) - (progn - (setq event (next-command-event)) - (or (event-to-character event) - event)) - (read-event)))) +(define-obsolete-function-alias 'viper-read-event-convert-to-char + 'read-event "27.1") ;; Emacs has a bug in eventp, which causes (eventp nil) to return (nil) @@ -950,64 +893,47 @@ Otherwise return the normal value." (defun viper-event-key (event) (or (and event (eventp event)) (error "viper-event-key: Wrong type argument, eventp, %S" event)) - (when (if (featurep 'xemacs) - (or (key-press-event-p event) (mouse-event-p event)) ; xemacs - t ; emacs - ) - (let ((mod (event-modifiers event)) - basis) - (setq basis - (if (featurep 'xemacs) - ;; XEmacs - (cond ((key-press-event-p event) - (event-key event)) - ((button-event-p event) - (concat "mouse-" (prin1-to-string (event-button event)))) - (t - (error "viper-event-key: Unknown event, %S" event))) - ;; Emacs doesn't handle capital letters correctly, since - ;; \S-a isn't considered the same as A (it behaves as - ;; plain `a' instead). So we take care of this here - (cond ((and (viper-characterp event) (<= ?A event) (<= event ?Z)) - (setq mod nil - event event)) - ;; Emacs has the oddity whereby characters 128+char - ;; represent M-char *if* this appears inside a string. - ;; So, we convert them manually to (meta char). - ((and (viper-characterp event) - (< ?\C-? event) (<= event 255)) - (setq mod '(meta) - event (- event ?\C-? 1))) - ((and (null mod) (eq event 'return)) - (setq event ?\C-m)) - ((and (null mod) (eq event 'space)) - (setq event ?\ )) - ((and (null mod) (eq event 'delete)) - (setq event ?\C-?)) - ((and (null mod) (eq event 'backspace)) - (setq event ?\C-h)) - (t (event-basic-type event))) - ) ; (featurep 'xemacs) - ) - (if (viper-characterp basis) - (setq basis - (if (viper= basis ?\C-?) - (list 'control '\?) ; taking care of an emacs bug - (intern (char-to-string basis))))) - (if mod - (append mod (list basis)) - basis)))) + (let ((mod (event-modifiers event)) + basis) + (setq basis + ;; Emacs doesn't handle capital letters correctly, since + ;; \S-a isn't considered the same as A (it behaves as + ;; plain `a' instead). So we take care of this here + (cond ((and (characterp event) (<= ?A event) (<= event ?Z)) + (setq mod nil + event event)) + ;; Emacs has the oddity whereby characters 128+char + ;; represent M-char *if* this appears inside a string. + ;; So, we convert them manually to (meta char). + ((and (characterp event) + (< ?\C-? event) (<= event 255)) + (setq mod '(meta) + event (- event ?\C-? 1))) + ((and (null mod) (eq event 'return)) + (setq event ?\C-m)) + ((and (null mod) (eq event 'space)) + (setq event ?\ )) + ((and (null mod) (eq event 'delete)) + (setq event ?\C-?)) + ((and (null mod) (eq event 'backspace)) + (setq event ?\C-h)) + (t (event-basic-type event)))) + + (if (characterp basis) + (setq basis + (if (viper= basis ?\C-?) + (list 'control '\?) ; taking care of an emacs bug + (intern (char-to-string basis))))) + (if mod + (append mod (list basis)) + basis))) (defun viper-last-command-char () - (if (featurep 'xemacs) - (event-to-character last-command-event) - last-command-event)) + last-command-event) (defun viper-key-to-emacs-key (key) (let (key-name char-p modifiers mod-char-list base-key base-key-name) - (cond ((featurep 'xemacs) key) - - ((symbolp key) + (cond ((symbolp key) (setq key-name (symbol-name key)) (cond ((= (length key-name) 1) ; character event (string-to-char key-name)) @@ -1049,16 +975,7 @@ Otherwise return the normal value." ;; LIS is assumed to be a list of events of characters -(defun viper-eventify-list-xemacs (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))) +(define-obsolete-function-alias 'viper-eventify-list-xemacs 'ignore "27.1") ;; Smooths out the difference between Emacs's unread-command-events @@ -1088,11 +1005,11 @@ Otherwise return the normal value." (setq unread-command-events (append - (cond ((viper-characterp arg) (list (character-to-event arg))) + (cond ((characterp arg) (list (character-to-event arg))) ((eventp arg) (list arg)) ((stringp arg) (mapcar 'character-to-event arg)) ((vectorp arg) (append arg nil)) ; turn into list - ((listp arg) (viper-eventify-list-xemacs arg)) + ((listp arg) nil) (t (error "viper-set-unread-command-events: Invalid argument, %S" arg))) unread-command-events)))) @@ -1117,7 +1034,7 @@ Otherwise return the normal value." (defun viper-char-array-p (array) - (eval (cons 'and (mapcar 'viper-characterp array)))) + (eval (cons 'and (mapcar 'characterp array)))) ;; Args can be a sequence of events, a string, or a Viper macro. Will try to @@ -1145,12 +1062,7 @@ Otherwise return the normal value." (t (prin1-to-string event-seq))))) (defun viper-key-press-events-to-chars (events) - (mapconcat (if (featurep 'xemacs) - (lambda (elt) (char-to-string (event-to-character elt))) ; xemacs - 'char-to-string ; emacs - ) - events - "")) + (mapconcat #'char-to-string events "")) (defun viper-read-char-exclusive () @@ -1161,7 +1073,7 @@ Otherwise return the normal value." (setq char (read-char)) (error ;; skip event if not char - (viper-read-event)))) + (read-event)))) char)) ;; key is supposed to be in viper's representation, e.g., (control l), a diff --git a/lisp/emulation/viper.el b/lisp/emulation/viper.el index d6912ee3675..521edbe6048 100644 --- a/lisp/emulation/viper.el +++ b/lisp/emulation/viper.el @@ -700,8 +700,6 @@ 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 (featurep 'xemacs) (viper-delocalize-var 'bar-cursor)) - ;; deactivate all advices done by Viper. (viper--deactivate-advice-list) @@ -787,8 +785,6 @@ 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 matching "viper-" are ;; deactivated. - (if (featurep 'xemacs) - (remove-hook 'mouse-leave-frame-hook #'viper-remember-current-frame)) ) ; end viper-go-away @@ -935,15 +931,7 @@ Two differences: (lambda (orig-fun &rest args) ;; FIXME: Use remapping? (if (and (eq viper-current-state 'vi-state) - ;; Do not use called-interactively-p here. XEmacs does not have it - ;; and interactive-p is just fine. - (if (featurep 'xemacs) - (interactive-p) - ;; Respect the spirit of the above comment, though it - ;; seems pointless, since XE doesn't have advice-add or - ;; lexical binding or any other of the newer features - ;; this file uses. - (called-interactively-p 'interactive))) + (called-interactively-p 'interactive)) (beep 1) (apply orig-fun args)))) @@ -1083,13 +1071,11 @@ This may be needed if the previous `:map' command terminated abnormally." ;; catch frame switching event (if (viper-window-display-p) - (if (featurep 'xemacs) - (add-hook 'mouse-leave-frame-hook - #'viper-remember-current-frame) - (viper--advice-add 'handle-switch-frame :before - (lambda (&rest _) - "Remember the selected frame before the switch-frame event." - (viper-remember-current-frame (selected-frame)))))) + (viper--advice-add + 'handle-switch-frame :before + (lambda (&rest _) + "Remember the selected frame before the switch-frame event." + (viper-remember-current-frame (selected-frame))))) ) ; end viper-non-hook-settings -- 2.39.2