aboutsummaryrefslogtreecommitdiffstats
path: root/lisp/emulation
diff options
context:
space:
mode:
authorLars Ingebrigtsen2019-06-20 00:48:49 +0200
committerLars Ingebrigtsen2019-06-20 12:51:38 +0200
commitdfec2bc7853fbef72f4306dcee3807b5dc9f6064 (patch)
tree199b0bc428b783a65bc6dea1fd88d10387e0cacf /lisp/emulation
parent82aeaf16061e5c79b5d936ae8af33783b572a40f (diff)
downloademacs-dfec2bc7853fbef72f4306dcee3807b5dc9f6064.tar.gz
emacs-dfec2bc7853fbef72f4306dcee3807b5dc9f6064.zip
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.
Diffstat (limited to 'lisp/emulation')
-rw-r--r--lisp/emulation/viper-cmd.el92
-rw-r--r--lisp/emulation/viper-ex.el31
-rw-r--r--lisp/emulation/viper-keym.el8
-rw-r--r--lisp/emulation/viper-macs.el2
-rw-r--r--lisp/emulation/viper-mous.el6
-rw-r--r--lisp/emulation/viper-util.el342
-rw-r--r--lisp/emulation/viper.el26
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 @@
164 viper-insert-point 164 viper-insert-point
165 (>= (point) viper-insert-point)) 165 (>= (point) viper-insert-point))
166 (setq viper-last-posn-while-in-insert-state (point-marker))) 166 (setq viper-last-posn-while-in-insert-state (point-marker)))
167 (or (viper-overlay-p viper-replace-overlay) 167 (or (overlayp viper-replace-overlay)
168 (progn 168 (progn
169 (viper-set-replace-overlay (point-min) (point-min)) 169 (viper-set-replace-overlay (point-min) (point-min))
170 (viper-hide-replace-overlay))) 170 (viper-hide-replace-overlay)))
@@ -603,7 +603,7 @@
603 (if (and viper-first-time (not (viper-is-in-minibuffer))) 603 (if (and viper-first-time (not (viper-is-in-minibuffer)))
604 (viper-mode) 604 (viper-mode)
605 (if overwrite-mode (overwrite-mode -1)) 605 (if overwrite-mode (overwrite-mode -1))
606 (or (viper-overlay-p viper-replace-overlay) 606 (or (overlayp viper-replace-overlay)
607 (viper-set-replace-overlay (point-min) (point-min))) 607 (viper-set-replace-overlay (point-min) (point-min)))
608 (viper-hide-replace-overlay) 608 (viper-hide-replace-overlay)
609 ;; Expand abbrevs iff the previous character has word syntax. 609 ;; Expand abbrevs iff the previous character has word syntax.
@@ -639,7 +639,7 @@
639 (interactive) 639 (interactive)
640 (viper-change-state 'insert-state) 640 (viper-change-state 'insert-state)
641 641
642 (or (viper-overlay-p viper-replace-overlay) 642 (or (overlayp viper-replace-overlay)
643 (viper-set-replace-overlay (point-min) (point-min))) 643 (viper-set-replace-overlay (point-min) (point-min)))
644 (viper-hide-replace-overlay) 644 (viper-hide-replace-overlay)
645 645
@@ -686,7 +686,7 @@
686(defun viper-change-state-to-emacs (&rest _) 686(defun viper-change-state-to-emacs (&rest _)
687 "Change Viper state to Emacs." 687 "Change Viper state to Emacs."
688 (interactive) 688 (interactive)
689 (or (viper-overlay-p viper-replace-overlay) 689 (or (overlayp viper-replace-overlay)
690 (viper-set-replace-overlay (point-min) (point-min))) 690 (viper-set-replace-overlay (point-min) (point-min)))
691 (viper-hide-replace-overlay) 691 (viper-hide-replace-overlay)
692 692
@@ -759,8 +759,7 @@ Vi's prefix argument will be used. Otherwise, the prefix argument passed to
759 ;; this-command, last-command-char, last-command-event 759 ;; this-command, last-command-char, last-command-event
760 (setq this-command com) 760 (setq this-command com)
761 ;; Emacs represents key sequences as sequences (str or vec) 761 ;; Emacs represents key sequences as sequences (str or vec)
762 (setq last-command-event 762 (setq last-command-event (viper-seq-last-elt key))
763 (viper-copy-event (viper-seq-last-elt key)))
764 763
765 (if (commandp com) 764 (if (commandp com)
766 ;; pretend that current state is the state we escaped to 765 ;; 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
831 (if (memq ch '(?\C-v ?\C-q)) 830 (if (memq ch '(?\C-v ?\C-q))
832 (setq ch (aref (read-key-sequence nil) 0))) 831 (setq ch (aref (read-key-sequence nil) 0)))
833 (insert ch))) 832 (insert ch)))
834 (setq last-command-event (viper-copy-event ch)) 833 (setq last-command-event ch)
835 ) ; let 834 ) ; let
836 (error nil) 835 (error nil)
837 ) ; condition-case 836 ) ; condition-case
@@ -941,7 +940,7 @@ as a Meta key and any number of multiple escapes are allowed."
941 (interactive) 940 (interactive)
942 (if (and (< viper-expert-level 2) (equal viper-toggle-key "\C-z")) 941 (if (and (< viper-expert-level 2) (equal viper-toggle-key "\C-z"))
943 (if (viper-window-display-p) 942 (if (viper-window-display-p)
944 (viper-iconify) 943 (iconify-or-deiconify-frame)
945 (suspend-emacs)) 944 (suspend-emacs))
946 (viper-change-state-to-emacs))) 945 (viper-change-state-to-emacs)))
947 946
@@ -1016,20 +1015,20 @@ as a Meta key and any number of multiple escapes are allowed."
1016 (let ((viper-intermediate-command 'viper-digit-argument) 1015 (let ((viper-intermediate-command 'viper-digit-argument)
1017 value func) 1016 value func)
1018 ;; read while number 1017 ;; read while number
1019 (while (and (viper-characterp event-char) 1018 (while (and (characterp event-char)
1020 (>= event-char ?0) (<= event-char ?9)) 1019 (>= event-char ?0) (<= event-char ?9))
1021 (setq value (+ (* (if (integerp value) value 0) 10) (- event-char ?0))) 1020 (setq value (+ (* (if (integerp value) value 0) 10) (- event-char ?0)))
1022 (setq event-char (viper-read-event-convert-to-char))) 1021 (setq event-char (read-event)))
1023 1022
1024 (setq prefix-arg value) 1023 (setq prefix-arg value)
1025 (if com (setq prefix-arg (cons prefix-arg com))) 1024 (if com (setq prefix-arg (cons prefix-arg com)))
1026 (while (eq event-char ?U) 1025 (while (eq event-char ?U)
1027 (viper-describe-arg prefix-arg) 1026 (viper-describe-arg prefix-arg)
1028 (setq event-char (viper-read-event-convert-to-char))) 1027 (setq event-char (read-event)))
1029 1028
1030 (if (or com (and (not (eq viper-current-state 'vi-state)) 1029 (if (or com (and (not (eq viper-current-state 'vi-state))
1031 ;; make sure it is a Vi command 1030 ;; make sure it is a Vi command
1032 (viper-characterp event-char) 1031 (characterp event-char)
1033 (viper-vi-command-p event-char) 1032 (viper-vi-command-p event-char)
1034 )) 1033 ))
1035 ;; If appears to be one of the vi commands, 1034 ;; 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."
1154 1153
1155 (if cmd-to-exec-at-end 1154 (if cmd-to-exec-at-end
1156 (progn 1155 (progn
1157 (setq last-command-event (viper-copy-event char)) 1156 (setq last-command-event char)
1158 (condition-case err 1157 (condition-case err
1159 (funcall cmd-to-exec-at-end cmd-info) 1158 (funcall cmd-to-exec-at-end cmd-info)
1160 (error 1159 (error
@@ -1176,7 +1175,6 @@ as a Meta key and any number of multiple escapes are allowed."
1176(defun viper-digit-argument (arg) 1175(defun viper-digit-argument (arg)
1177 "Begin numeric argument for the next command." 1176 "Begin numeric argument for the next command."
1178 (interactive "P") 1177 (interactive "P")
1179 (viper-leave-region-active)
1180 (viper-prefix-arg-value 1178 (viper-prefix-arg-value
1181 (viper-last-command-char) (if (consp arg) (cdr arg) nil))) 1179 (viper-last-command-char) (if (consp arg) (cdr arg) nil)))
1182 1180
@@ -1197,7 +1195,7 @@ as a Meta key and any number of multiple escapes are allowed."
1197 (t (error viper-InvalidCommandArgument)))) 1195 (t (error viper-InvalidCommandArgument))))
1198 (quit (setq viper-use-register nil) 1196 (quit (setq viper-use-register nil)
1199 (signal 'quit nil))) 1197 (signal 'quit nil)))
1200 (viper-deactivate-mark))) 1198 (deactivate-mark)))
1201 1199
1202 1200
1203;; repeat last destructive command 1201;; repeat last destructive command
@@ -1381,7 +1379,7 @@ as a Meta key and any number of multiple escapes are allowed."
1381 (if (> lines-saved viper-change-notification-threshold) 1379 (if (> lines-saved viper-change-notification-threshold)
1382 (unless (viper-is-in-minibuffer) 1380 (unless (viper-is-in-minibuffer)
1383 (message "Saved %d lines" lines-saved))))) 1381 (message "Saved %d lines" lines-saved)))))
1384 (viper-deactivate-mark) 1382 (deactivate-mark)
1385 (goto-char viper-com-point)) 1383 (goto-char viper-com-point))
1386 1384
1387(defun viper-exec-bang (_m-com com) 1385(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'."
1523 ;; executed by `.' is already on the ring. 1521 ;; executed by `.' is already on the ring.
1524 (if (eq last-command 'viper-display-current-destructive-command) 1522 (if (eq last-command 'viper-display-current-destructive-command)
1525 (viper-push-onto-ring viper-d-com 'viper-command-ring)) 1523 (viper-push-onto-ring viper-d-com 'viper-command-ring))
1526 (viper-deactivate-mark) 1524 (deactivate-mark)
1527 )) 1525 ))
1528 1526
1529(defun viper-repeat-from-history () 1527(defun viper-repeat-from-history ()
@@ -2532,7 +2530,6 @@ These keys are ESC, RET, and LineFeed."
2532 "Move point right ARG characters (left if ARG negative). 2530 "Move point right ARG characters (left if ARG negative).
2533On reaching end of line, stop and signal error." 2531On reaching end of line, stop and signal error."
2534 (interactive "P") 2532 (interactive "P")
2535 (viper-leave-region-active)
2536 (let ((val (viper-p-val arg)) 2533 (let ((val (viper-p-val arg))
2537 (com (viper-getcom arg))) 2534 (com (viper-getcom arg)))
2538 (if com (viper-move-marker-locally 'viper-com-point (point))) 2535 (if com (viper-move-marker-locally 'viper-com-point (point)))
@@ -2555,7 +2552,6 @@ On reaching end of line, stop and signal error."
2555 "Move point left ARG characters (right if ARG negative). 2552 "Move point left ARG characters (right if ARG negative).
2556On reaching beginning of line, stop and signal error." 2553On reaching beginning of line, stop and signal error."
2557 (interactive "P") 2554 (interactive "P")
2558 (viper-leave-region-active)
2559 (let ((val (viper-p-val arg)) 2555 (let ((val (viper-p-val arg))
2560 (com (viper-getcom arg))) 2556 (com (viper-getcom arg)))
2561 (if com (viper-move-marker-locally 'viper-com-point (point))) 2557 (if com (viper-move-marker-locally 'viper-com-point (point)))
@@ -2688,7 +2684,6 @@ On reaching beginning of line, stop and signal error."
2688(defun viper-forward-word (arg) 2684(defun viper-forward-word (arg)
2689 "Forward word." 2685 "Forward word."
2690 (interactive "P") 2686 (interactive "P")
2691 (viper-leave-region-active)
2692 (let ((val (viper-p-val arg)) 2687 (let ((val (viper-p-val arg))
2693 (com (viper-getcom arg))) 2688 (com (viper-getcom arg)))
2694 (if com (viper-move-marker-locally 'viper-com-point (point))) 2689 (if com (viper-move-marker-locally 'viper-com-point (point)))
@@ -2709,7 +2704,6 @@ On reaching beginning of line, stop and signal error."
2709(defun viper-forward-Word (arg) 2704(defun viper-forward-Word (arg)
2710 "Forward word delimited by white characters." 2705 "Forward word delimited by white characters."
2711 (interactive "P") 2706 (interactive "P")
2712 (viper-leave-region-active)
2713 (let ((val (viper-p-val arg)) 2707 (let ((val (viper-p-val arg))
2714 (com (viper-getcom arg))) 2708 (com (viper-getcom arg)))
2715 (if com (viper-move-marker-locally 'viper-com-point (point))) 2709 (if com (viper-move-marker-locally 'viper-com-point (point)))
@@ -2752,7 +2746,6 @@ On reaching beginning of line, stop and signal error."
2752(defun viper-end-of-word (arg &optional _careful) 2746(defun viper-end-of-word (arg &optional _careful)
2753 "Move point to end of current word." 2747 "Move point to end of current word."
2754 (interactive "P") 2748 (interactive "P")
2755 (viper-leave-region-active)
2756 (let ((val (viper-p-val arg)) 2749 (let ((val (viper-p-val arg))
2757 (com (viper-getcom arg))) 2750 (com (viper-getcom arg)))
2758 (if com (viper-move-marker-locally 'viper-com-point (point))) 2751 (if com (viper-move-marker-locally 'viper-com-point (point)))
@@ -2765,7 +2758,6 @@ On reaching beginning of line, stop and signal error."
2765(defun viper-end-of-Word (arg) 2758(defun viper-end-of-Word (arg)
2766 "Forward to end of word delimited by white character." 2759 "Forward to end of word delimited by white character."
2767 (interactive "P") 2760 (interactive "P")
2768 (viper-leave-region-active)
2769 (let ((val (viper-p-val arg)) 2761 (let ((val (viper-p-val arg))
2770 (com (viper-getcom arg))) 2762 (com (viper-getcom arg)))
2771 (if com (viper-move-marker-locally 'viper-com-point (point))) 2763 (if com (viper-move-marker-locally 'viper-com-point (point)))
@@ -2800,7 +2792,6 @@ On reaching beginning of line, stop and signal error."
2800(defun viper-backward-word (arg) 2792(defun viper-backward-word (arg)
2801 "Backward word." 2793 "Backward word."
2802 (interactive "P") 2794 (interactive "P")
2803 (viper-leave-region-active)
2804 (let ((val (viper-p-val arg)) 2795 (let ((val (viper-p-val arg))
2805 (com (viper-getcom arg))) 2796 (com (viper-getcom arg)))
2806 (if com 2797 (if com
@@ -2815,7 +2806,6 @@ On reaching beginning of line, stop and signal error."
2815(defun viper-backward-Word (arg) 2806(defun viper-backward-Word (arg)
2816 "Backward word delimited by white character." 2807 "Backward word delimited by white character."
2817 (interactive "P") 2808 (interactive "P")
2818 (viper-leave-region-active)
2819 (let ((val (viper-p-val arg)) 2809 (let ((val (viper-p-val arg))
2820 (com (viper-getcom arg))) 2810 (com (viper-getcom arg)))
2821 (if com 2811 (if com
@@ -2836,7 +2826,6 @@ On reaching beginning of line, stop and signal error."
2836(defun viper-beginning-of-line (arg) 2826(defun viper-beginning-of-line (arg)
2837 "Go to beginning of line." 2827 "Go to beginning of line."
2838 (interactive "P") 2828 (interactive "P")
2839 (viper-leave-region-active)
2840 (let ((val (viper-p-val arg)) 2829 (let ((val (viper-p-val arg))
2841 (com (viper-getcom arg))) 2830 (com (viper-getcom arg)))
2842 (if com (viper-move-marker-locally 'viper-com-point (point))) 2831 (if com (viper-move-marker-locally 'viper-com-point (point)))
@@ -2846,7 +2835,6 @@ On reaching beginning of line, stop and signal error."
2846(defun viper-bol-and-skip-white (arg) 2835(defun viper-bol-and-skip-white (arg)
2847 "Beginning of line at first non-white character." 2836 "Beginning of line at first non-white character."
2848 (interactive "P") 2837 (interactive "P")
2849 (viper-leave-region-active)
2850 (let ((val (viper-p-val arg)) 2838 (let ((val (viper-p-val arg))
2851 (com (viper-getcom arg))) 2839 (com (viper-getcom arg)))
2852 (if com (viper-move-marker-locally 'viper-com-point (point))) 2840 (if com (viper-move-marker-locally 'viper-com-point (point)))
@@ -2856,7 +2844,6 @@ On reaching beginning of line, stop and signal error."
2856(defun viper-goto-eol (arg) 2844(defun viper-goto-eol (arg)
2857 "Go to end of line." 2845 "Go to end of line."
2858 (interactive "P") 2846 (interactive "P")
2859 (viper-leave-region-active)
2860 (let ((val (viper-p-val arg)) 2847 (let ((val (viper-p-val arg))
2861 (com (viper-getcom arg))) 2848 (com (viper-getcom arg)))
2862 (if com (viper-move-marker-locally 'viper-com-point (point))) 2849 (if com (viper-move-marker-locally 'viper-com-point (point)))
@@ -2873,7 +2860,6 @@ On reaching beginning of line, stop and signal error."
2873(defun viper-goto-col (arg) 2860(defun viper-goto-col (arg)
2874 "Go to ARG's column." 2861 "Go to ARG's column."
2875 (interactive "P") 2862 (interactive "P")
2876 (viper-leave-region-active)
2877 (let ((val (viper-p-val arg)) 2863 (let ((val (viper-p-val arg))
2878 (com (viper-getcom arg)) 2864 (com (viper-getcom arg))
2879 line-len) 2865 line-len)
@@ -2895,7 +2881,6 @@ On reaching beginning of line, stop and signal error."
2895(defun viper-next-line (arg) 2881(defun viper-next-line (arg)
2896 "Go to next line." 2882 "Go to next line."
2897 (interactive "P") 2883 (interactive "P")
2898 (viper-leave-region-active)
2899 (let ((val (viper-p-val arg)) 2884 (let ((val (viper-p-val arg))
2900 (com (viper-getCom arg))) 2885 (com (viper-getCom arg)))
2901 (if com (viper-move-marker-locally 'viper-com-point (point))) 2886 (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."
2930 (if (and (fboundp 'button-at) (fboundp 'push-button) (button-at (point))) 2915 (if (and (fboundp 'button-at) (fboundp 'push-button) (button-at (point)))
2931 (push-button) 2916 (push-button)
2932 ;; not a widget or a button 2917 ;; not a widget or a button
2933 (viper-leave-region-active)
2934 (save-excursion 2918 (save-excursion
2935 (end-of-line) 2919 (end-of-line)
2936 (if (eobp) (error "Last line in buffer"))) 2920 (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."
2945(defun viper-previous-line (arg) 2929(defun viper-previous-line (arg)
2946 "Go to previous line." 2930 "Go to previous line."
2947 (interactive "P") 2931 (interactive "P")
2948 (viper-leave-region-active)
2949 (let ((val (viper-p-val arg)) 2932 (let ((val (viper-p-val arg))
2950 (com (viper-getCom arg))) 2933 (com (viper-getCom arg)))
2951 (if com (viper-move-marker-locally 'viper-com-point (point))) 2934 (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."
2963(defun viper-previous-line-at-bol (arg) 2946(defun viper-previous-line-at-bol (arg)
2964 "Previous line at beginning of line." 2947 "Previous line at beginning of line."
2965 (interactive "P") 2948 (interactive "P")
2966 (viper-leave-region-active)
2967 (save-excursion 2949 (save-excursion
2968 (beginning-of-line) 2950 (beginning-of-line)
2969 (if (bobp) (error "First line in buffer"))) 2951 (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."
2998 (let ((val (viper-P-val arg)) 2980 (let ((val (viper-P-val arg))
2999 (com (viper-getCom arg))) 2981 (com (viper-getCom arg)))
3000 (viper-move-marker-locally 'viper-com-point (point)) 2982 (viper-move-marker-locally 'viper-com-point (point))
3001 (viper-deactivate-mark) 2983 (deactivate-mark)
3002 (push-mark nil t) 2984 (push-mark nil t)
3003 (if (null val) 2985 (if (null val)
3004 (goto-char (point-max)) 2986 (goto-char (point-max))
@@ -3181,7 +3163,7 @@ controlled by the sign of prefix numeric value."
3181 (interactive "P") 3163 (interactive "P")
3182 (let ((val (viper-p-val arg)) 3164 (let ((val (viper-p-val arg))
3183 (com (viper-getcom arg))) 3165 (com (viper-getcom arg)))
3184 (viper-deactivate-mark) 3166 (deactivate-mark)
3185 (if com (viper-move-marker-locally 'viper-com-point (point))) 3167 (if com (viper-move-marker-locally 'viper-com-point (point)))
3186 (viper-find-char val viper-f-char viper-f-forward viper-f-offset) 3168 (viper-find-char val viper-f-char viper-f-forward viper-f-offset)
3187 (if com 3169 (if com
@@ -3194,7 +3176,7 @@ controlled by the sign of prefix numeric value."
3194 (interactive "P") 3176 (interactive "P")
3195 (let ((val (viper-p-val arg)) 3177 (let ((val (viper-p-val arg))
3196 (com (viper-getcom arg))) 3178 (com (viper-getcom arg)))
3197 (viper-deactivate-mark) 3179 (deactivate-mark)
3198 (if com (viper-move-marker-locally 'viper-com-point (point))) 3180 (if com (viper-move-marker-locally 'viper-com-point (point)))
3199 (viper-find-char val viper-f-char (not viper-f-forward) viper-f-offset) 3181 (viper-find-char val viper-f-char (not viper-f-forward) viper-f-offset)
3200 (if com 3182 (if com
@@ -3210,7 +3192,6 @@ controlled by the sign of prefix numeric value."
3210 (interactive "P") 3192 (interactive "P")
3211 (let ((val (viper-p-val arg)) 3193 (let ((val (viper-p-val arg))
3212 (com (viper-getCom arg))) 3194 (com (viper-getCom arg)))
3213 (viper-leave-region-active)
3214 (if com (viper-move-marker-locally 'viper-com-point (point))) 3195 (if com (viper-move-marker-locally 'viper-com-point (point)))
3215 (push-mark nil t) 3196 (push-mark nil t)
3216 (move-to-window-line (1- val)) 3197 (move-to-window-line (1- val))
@@ -3230,7 +3211,6 @@ controlled by the sign of prefix numeric value."
3230 (interactive "P") 3211 (interactive "P")
3231 (let ((val (viper-p-val arg)) 3212 (let ((val (viper-p-val arg))
3232 (com (viper-getCom arg))) 3213 (com (viper-getCom arg)))
3233 (viper-leave-region-active)
3234 (if com (viper-move-marker-locally 'viper-com-point (point))) 3214 (if com (viper-move-marker-locally 'viper-com-point (point)))
3235 (push-mark nil t) 3215 (push-mark nil t)
3236 (move-to-window-line (+ (/ (1- (window-height)) 2) (1- val))) 3216 (move-to-window-line (+ (/ (1- (window-height)) 2) (1- val)))
@@ -3250,7 +3230,6 @@ controlled by the sign of prefix numeric value."
3250 (interactive "P") 3230 (interactive "P")
3251 (let ((val (viper-p-val arg)) 3231 (let ((val (viper-p-val arg))
3252 (com (viper-getCom arg))) 3232 (com (viper-getCom arg)))
3253 (viper-leave-region-active)
3254 (if com (viper-move-marker-locally 'viper-com-point (point))) 3233 (if com (viper-move-marker-locally 'viper-com-point (point)))
3255 (push-mark nil t) 3234 (push-mark nil t)
3256 (move-to-window-line (- val)) 3235 (move-to-window-line (- val))
@@ -3316,7 +3295,6 @@ controlled by the sign of prefix numeric value."
3316(defun viper-paren-match (arg) 3295(defun viper-paren-match (arg)
3317 "Go to the matching parenthesis." 3296 "Go to the matching parenthesis."
3318 (interactive "P") 3297 (interactive "P")
3319 (viper-leave-region-active)
3320 (let ((com (viper-getcom arg)) 3298 (let ((com (viper-getcom arg))
3321 (parse-sexp-ignore-comments viper-parse-sexp-ignore-comments) 3299 (parse-sexp-ignore-comments viper-parse-sexp-ignore-comments)
3322 anchor-point) 3300 anchor-point)
@@ -3723,7 +3701,7 @@ Null string will repeat previous search."
3723 (offset (not no-offset)) 3701 (offset (not no-offset))
3724 (case-fold-search viper-case-fold-search) 3702 (case-fold-search viper-case-fold-search)
3725 (start-point (or init-point (point)))) 3703 (start-point (or init-point (point))))
3726 (viper-deactivate-mark) 3704 (deactivate-mark)
3727 (if forward 3705 (if forward
3728 (condition-case nil 3706 (condition-case nil
3729 (progn 3707 (progn
@@ -3832,7 +3810,7 @@ Null string will repeat previous search."
3832 ;; ?g acts as a default value for viper-buffer-search-char 3810 ;; ?g acts as a default value for viper-buffer-search-char
3833 (setq viper-buffer-search-char ?g))) 3811 (setq viper-buffer-search-char ?g)))
3834 (define-key viper-vi-basic-map 3812 (define-key viper-vi-basic-map
3835 (cond ((viper-characterp viper-buffer-search-char) 3813 (cond ((characterp viper-buffer-search-char)
3836 (char-to-string viper-buffer-search-char)) 3814 (char-to-string viper-buffer-search-char))
3837 (t (error "viper-buffer-search-char: wrong value type, %S" 3815 (t (error "viper-buffer-search-char: wrong value type, %S"
3838 viper-buffer-search-char))) 3816 viper-buffer-search-char)))
@@ -3938,7 +3916,7 @@ Null string will repeat previous search."
3938 (forward-line 1)) 3916 (forward-line 1))
3939 (beginning-of-line)) 3917 (beginning-of-line))
3940 (if (not (eolp)) (viper-forward-char-carefully))) 3918 (if (not (eolp)) (viper-forward-char-carefully)))
3941 (set-marker (viper-mark-marker) (point) (current-buffer)) 3919 (set-marker (mark-marker) (point) (current-buffer))
3942 (viper-set-destructive-command 3920 (viper-set-destructive-command
3943 (list 'viper-put-back val nil viper-use-register nil nil)) 3921 (list 'viper-put-back val nil viper-use-register nil nil))
3944 (setq sv-point (point)) 3922 (setq sv-point (point))
@@ -3958,7 +3936,7 @@ Null string will repeat previous search."
3958 (exchange-point-and-mark) 3936 (exchange-point-and-mark)
3959 (if (bolp) 3937 (if (bolp)
3960 (back-to-indentation))) 3938 (back-to-indentation)))
3961 (viper-deactivate-mark)) 3939 (deactivate-mark))
3962 3940
3963(defun viper-Put-back (arg) 3941(defun viper-Put-back (arg)
3964 "Put back at point/above line." 3942 "Put back at point/above line."
@@ -3983,7 +3961,7 @@ Null string will repeat previous search."
3983 (if (viper-end-with-a-newline-p text) (beginning-of-line)) 3961 (if (viper-end-with-a-newline-p text) (beginning-of-line))
3984 (viper-set-destructive-command 3962 (viper-set-destructive-command
3985 (list 'viper-Put-back val nil viper-use-register nil nil)) 3963 (list 'viper-Put-back val nil viper-use-register nil nil))
3986 (set-marker (viper-mark-marker) (point) (current-buffer)) 3964 (set-marker (mark-marker) (point) (current-buffer))
3987 (setq sv-point (point)) 3965 (setq sv-point (point))
3988 (viper-loop val (viper-yank text)) 3966 (viper-loop val (viper-yank text))
3989 (setq chars-inserted (abs (- (point) sv-point)) 3967 (setq chars-inserted (abs (- (point) sv-point))
@@ -4001,7 +3979,7 @@ Null string will repeat previous search."
4001 (exchange-point-and-mark) 3979 (exchange-point-and-mark)
4002 (if (bolp) 3980 (if (bolp)
4003 (back-to-indentation))) 3981 (back-to-indentation)))
4004 (viper-deactivate-mark)) 3982 (deactivate-mark))
4005 3983
4006 3984
4007;; Copy region to kill-ring. 3985;; Copy region to kill-ring.
@@ -4286,7 +4264,7 @@ and regexp replace."
4286 (interactive) 4264 (interactive)
4287 (let ((char (read-char))) 4265 (let ((char (read-char)))
4288 (cond ((and (<= ?a char) (<= char ?z)) 4266 (cond ((and (<= ?a char) (<= char ?z))
4289 (point-to-register (viper-int-to-char (1+ (- char ?a))))) 4267 (point-to-register (1+ (- char ?a))))
4290 ((viper= char ?<) (viper-mark-beginning-of-buffer)) 4268 ((viper= char ?<) (viper-mark-beginning-of-buffer))
4291 ((viper= char ?>) (viper-mark-end-of-buffer)) 4269 ((viper= char ?>) (viper-mark-end-of-buffer))
4292 ((viper= char ?.) (viper-set-mark-if-necessary)) 4270 ((viper= char ?.) (viper-set-mark-if-necessary))
@@ -4322,15 +4300,15 @@ One can use \\=`\\=` and \\='\\=' to temporarily jump 1 step back."
4322 (if (eq last-command 'viper-cycle-through-mark-ring) 4300 (if (eq last-command 'viper-cycle-through-mark-ring)
4323 () 4301 ()
4324 ;; save current mark if the first iteration 4302 ;; save current mark if the first iteration
4325 (setq mark-ring (delete (viper-mark-marker) mark-ring)) 4303 (setq mark-ring (delete (mark-marker) mark-ring))
4326 (if (mark t) 4304 (if (mark t)
4327 (push-mark (mark t) t)) ) 4305 (push-mark (mark t) t)) )
4328 (pop-mark) 4306 (pop-mark)
4329 (set-mark-command 1) 4307 (set-mark-command 1)
4330 ;; don't duplicate mark on the ring 4308 ;; don't duplicate mark on the ring
4331 (setq mark-ring (delete (viper-mark-marker) mark-ring)) 4309 (setq mark-ring (delete (mark-marker) mark-ring))
4332 (push-mark sv-pt t) 4310 (push-mark sv-pt t)
4333 (viper-deactivate-mark) 4311 (deactivate-mark)
4334 (setq this-command 'viper-cycle-through-mark-ring) 4312 (setq this-command 'viper-cycle-through-mark-ring)
4335 )) 4313 ))
4336 4314
@@ -4356,7 +4334,7 @@ One can use \\=`\\=` and \\='\\=' to temporarily jump 1 step back."
4356 (backward-char 1))) 4334 (backward-char 1)))
4357 (cond ((viper-valid-register char '(letter)) 4335 (cond ((viper-valid-register char '(letter))
4358 (let* ((buff (current-buffer)) 4336 (let* ((buff (current-buffer))
4359 (reg (viper-int-to-char (1+ (- char ?a)))) 4337 (reg (1+ (- char ?a)))
4360 (text-marker (get-register reg))) 4338 (text-marker (get-register reg)))
4361 ;; If marker points to file that had markers set (and those markers 4339 ;; If marker points to file that had markers set (and those markers
4362 ;; were saved (as e.g., in session.el), then restore those markers 4340 ;; 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."
4519 ((viper= ?\] reg) 4497 ((viper= ?\] reg)
4520 (viper-heading-end arg)) 4498 (viper-heading-end arg))
4521 ((viper-valid-register reg '(letter)) 4499 ((viper-valid-register reg '(letter))
4522 (let* ((val (get-register (viper-int-to-char (1+ (- reg ?a))))) 4500 (let* ((val (get-register (1+ (- reg ?a))))
4523 (buf (if (not (markerp val)) 4501 (buf (if (not (markerp val))
4524 (error viper-EmptyTextmarker reg) 4502 (error viper-EmptyTextmarker reg)
4525 (marker-buffer val))) 4503 (marker-buffer val)))
@@ -4756,13 +4734,13 @@ Please, specify your level now: "))
4756 (if (and enforce-buffer 4734 (if (and enforce-buffer
4757 (not (equal (current-buffer) (marker-buffer val)))) 4735 (not (equal (current-buffer) (marker-buffer val))))
4758 (error (concat viper-EmptyTextmarker " in this buffer") 4736 (error (concat viper-EmptyTextmarker " in this buffer")
4759 (viper-int-to-char (1- (+ char ?a))))) 4737 (1- (+ char ?a))))
4760 (pop-to-buffer (marker-buffer val)) 4738 (pop-to-buffer (marker-buffer val))
4761 (goto-char val)) 4739 (goto-char val))
4762 ((and (consp val) (eq (car val) 'file)) 4740 ((and (consp val) (eq (car val) 'file))
4763 (find-file (cdr val))) 4741 (find-file (cdr val)))
4764 (t 4742 (t
4765 (error viper-EmptyTextmarker (viper-int-to-char (1- (+ char ?a)))))))) 4743 (error viper-EmptyTextmarker (1- (+ char ?a)))))))
4766 4744
4767 4745
4768(defun viper-save-kill-buffer () 4746(defun viper-save-kill-buffer ()
@@ -4796,14 +4774,14 @@ Please, specify your level now: "))
4796 (viper-frame-parameters (if (fboundp 'frame-parameters) 4774 (viper-frame-parameters (if (fboundp 'frame-parameters)
4797 (frame-parameters (selected-frame)))) 4775 (frame-parameters (selected-frame))))
4798 (viper-minibuffer-emacs-face (if (viper-has-face-support-p) 4776 (viper-minibuffer-emacs-face (if (viper-has-face-support-p)
4799 (viper-get-face 4777 (facep
4800 viper-minibuffer-emacs-face) 4778 viper-minibuffer-emacs-face)
4801 'non-x)) 4779 'non-x))
4802 (viper-minibuffer-vi-face (if (viper-has-face-support-p) 4780 (viper-minibuffer-vi-face (if (viper-has-face-support-p)
4803 (viper-get-face viper-minibuffer-vi-face) 4781 (facep viper-minibuffer-vi-face)
4804 'non-x)) 4782 'non-x))
4805 (viper-minibuffer-insert-face (if (viper-has-face-support-p) 4783 (viper-minibuffer-insert-face (if (viper-has-face-support-p)
4806 (viper-get-face 4784 (facep
4807 viper-minibuffer-insert-face) 4785 viper-minibuffer-insert-face)
4808 'non-x)) 4786 'non-x))
4809 varlist salutation window-config) 4787 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."
882 (exchange-point-and-mark) 882 (exchange-point-and-mark)
883 (goto-char 883 (goto-char
884 (viper-register-to-point 884 (viper-register-to-point
885 (viper-int-to-char (1+ (- ex-token ?a))) 'enforce-buffer))) 885 (1+ (- ex-token ?a)))
886 'enforce-buffer))
886 (setq address (point-marker))))) 887 (setq address (point-marker)))))
887 address)) 888 address))
888 889
@@ -1085,7 +1086,7 @@ reversed."
1085(defun viper-handle-! () 1086(defun viper-handle-! ()
1086 (interactive) 1087 (interactive)
1087 (if (and (string= 1088 (if (and (string=
1088 (buffer-string) (viper-abbreviate-file-name default-directory)) 1089 (buffer-string) (abbreviate-file-name default-directory))
1089 (member ex-token '("read" "write"))) 1090 (member ex-token '("read" "write")))
1090 (erase-buffer)) 1091 (erase-buffer))
1091 (insert "!")) 1092 (insert "!"))
@@ -1263,7 +1264,7 @@ reversed."
1263 (if (not file) 1264 (if (not file)
1264 (viper-get-ex-file)) 1265 (viper-get-ex-file))
1265 (cond ((and (string= ex-file "") buffer-file-name) 1266 (cond ((and (string= ex-file "") buffer-file-name)
1266 (setq ex-file (viper-abbreviate-file-name (buffer-file-name)))) 1267 (setq ex-file (abbreviate-file-name (buffer-file-name))))
1267 ((string= ex-file "") 1268 ((string= ex-file "")
1268 (error viper-NoFileSpecified))) 1269 (error viper-NoFileSpecified)))
1269 1270
@@ -1480,7 +1481,7 @@ reversed."
1480 (error "`%s' requires a following letter" ex-token)))) 1481 (error "`%s' requires a following letter" ex-token))))
1481 (save-excursion 1482 (save-excursion
1482 (goto-char (car ex-addresses)) 1483 (goto-char (car ex-addresses))
1483 (point-to-register (viper-int-to-char (1+ (- char ?a))))))) 1484 (point-to-register (1+ (- char ?a))))))
1484 1485
1485 1486
1486 1487
@@ -1547,7 +1548,7 @@ reversed."
1547 (if (not (viper-buffer-live-p buf)) 1548 (if (not (viper-buffer-live-p buf))
1548 (error "Didn't find buffer %S or file %S" 1549 (error "Didn't find buffer %S or file %S"
1549 file-or-buffer-name 1550 file-or-buffer-name
1550 (viper-abbreviate-file-name 1551 (abbreviate-file-name
1551 (expand-file-name file-or-buffer-name)))) 1552 (expand-file-name file-or-buffer-name))))
1552 1553
1553 (if (equal buf (current-buffer)) 1554 (if (equal buf (current-buffer))
@@ -1562,7 +1563,7 @@ reversed."
1562 ;; setup buffer 1563 ;; setup buffer
1563 (if (setq wind (viper-get-visible-buffer-window buf)) 1564 (if (setq wind (viper-get-visible-buffer-window buf))
1564 () 1565 ()
1565 (setq wind (get-lru-window (if (featurep 'xemacs) nil 'visible))) 1566 (setq wind (get-lru-window 'visible))
1566 (set-window-buffer wind buf)) 1567 (set-window-buffer wind buf))
1567 1568
1568 (if (viper-window-display-p) 1569 (if (viper-window-display-p)
@@ -1884,17 +1885,15 @@ reversed."
1884 (condition-case nil 1885 (condition-case nil
1885 (progn 1886 (progn
1886 (pop-to-buffer (get-buffer-create "*info*")) 1887 (pop-to-buffer (get-buffer-create "*info*"))
1887 (info (if (featurep 'xemacs) "viper.info" "viper")) 1888 (info "viper")
1888 (message "Type `i' to search for a specific topic")) 1889 (message "Type `i' to search for a specific topic"))
1889 (error (beep 1) 1890 (error (beep 1)
1890 (with-output-to-temp-buffer " *viper-info*" 1891 (with-output-to-temp-buffer " *viper-info*"
1891 (princ (format " 1892 (princ (format "
1892The Info file for Viper does not seem to be installed. 1893The Info file for Viper does not seem to be installed.
1893 1894
1894This file is part of the standard distribution of %sEmacs. 1895This file is part of the standard distribution of Emacs.
1895Please contact your system administrator. " 1896Please contact your system administrator. "))))))
1896 (if (featurep 'xemacs) "X" "")
1897 ))))))
1898 1897
1899;; Ex source command. 1898;; Ex source command.
1900;; Loads the file specified as argument or viper-custom-file-name. 1899;; Loads the file specified as argument or viper-custom-file-name.
@@ -2089,9 +2088,7 @@ Please contact your system administrator. "
2089 ;; create temp buffer for the region 2088 ;; create temp buffer for the region
2090 (setq temp-buf (get-buffer-create " *ex-write*")) 2089 (setq temp-buf (get-buffer-create " *ex-write*"))
2091 (set-buffer temp-buf) 2090 (set-buffer temp-buf)
2092 (if (featurep 'xemacs) 2091 (set-visited-file-name ex-file 'noquery)
2093 (set-visited-file-name ex-file)
2094 (set-visited-file-name ex-file 'noquery))
2095 (erase-buffer) 2092 (erase-buffer)
2096 (if (and file-exists ex-append) 2093 (if (and file-exists ex-append)
2097 (insert-file-contents ex-file)) 2094 (insert-file-contents ex-file))
@@ -2130,7 +2127,7 @@ Please contact your system administrator. "
2130 2127
2131(defun ex-write-info (exists file-name beg end) 2128(defun ex-write-info (exists file-name beg end)
2132 (message "`%s'%s %d lines, %d characters" 2129 (message "`%s'%s %d lines, %d characters"
2133 (viper-abbreviate-file-name file-name) 2130 (abbreviate-file-name file-name)
2134 (if exists "" " [New file]") 2131 (if exists "" " [New file]")
2135 (count-lines beg (min (1+ end) (point-max))) 2132 (count-lines beg (min (1+ end) (point-max)))
2136 (- end beg))) 2133 (- end beg)))
@@ -2226,9 +2223,9 @@ Type `mak ' (including the space) to run make with no args."
2226 lines file info) 2223 lines file info)
2227 (setq lines (count-lines (point-min) (viper-line-pos 'end)) 2224 (setq lines (count-lines (point-min) (viper-line-pos 'end))
2228 file (cond ((buffer-file-name) 2225 file (cond ((buffer-file-name)
2229 (concat (viper-abbreviate-file-name (buffer-file-name)) ":")) 2226 (concat (abbreviate-file-name (buffer-file-name)) ":"))
2230 ((buffer-file-name (buffer-base-buffer)) 2227 ((buffer-file-name (buffer-base-buffer))
2231 (concat (viper-abbreviate-file-name (buffer-file-name (buffer-base-buffer))) " (indirect buffer):")) 2228 (concat (abbreviate-file-name (buffer-file-name (buffer-base-buffer))) " (indirect buffer):"))
2232 (t (concat (buffer-name) " [Not visiting any file]:"))) 2229 (t (concat (buffer-name) " [Not visiting any file]:")))
2233 info (format "line=%d/%d pos=%d/%d col=%d %s" 2230 info (format "line=%d/%d pos=%d/%d col=%d %s"
2234 (if (= pos1 pos2) 2231 (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)"
642 642
643(defun viper-add-keymap (mapsrc mapdst) 643(defun viper-add-keymap (mapsrc mapdst)
644 "Add contents of mapsrc to mapdst. It is assumed that mapsrc is sparse." 644 "Add contents of mapsrc to mapdst. It is assumed that mapsrc is sparse."
645 (if (featurep 'xemacs) 645 (mapc (lambda (p) (define-key mapdst (vector (car p)) (cdr p)))
646 ;; Emacs 22 has map-keymap. 646 (cdr mapsrc)))
647 (map-keymap (lambda (key binding) (define-key mapdst key binding))
648 mapsrc)
649 (mapc (lambda (p) (define-key mapdst (vector (car p)) (cdr p)))
650 (cdr mapsrc))))
651 647
652(defun viper-modify-keymap (map alist) 648(defun viper-modify-keymap (map alist)
653 "Modifies MAP with bindings specified in the ALIST. The alist has the 649 "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."
415 t))) 415 t)))
416 (if (y-or-n-p 416 (if (y-or-n-p
417 (format "Save this macro in %s? " 417 (format "Save this macro in %s? "
418 (viper-abbreviate-file-name viper-custom-file-name))) 418 (abbreviate-file-name viper-custom-file-name)))
419 (viper-save-string-in-file 419 (viper-save-string-in-file
420 (format "\n(viper-record-kbd-macro %S '%S %s '%S)" 420 (format "\n(viper-record-kbd-macro %S '%S %s '%S)"
421 (viper-display-macro macro-name) 421 (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."
280 ;; the next pending event is not a mouse event, we execute the 280 ;; the next pending event is not a mouse event, we execute the
281 ;; current mouse event 281 ;; current mouse event
282 (progn 282 (progn
283 (setq interrupting-event (viper-read-event)) 283 (setq interrupting-event (read-event))
284 (viper-mouse-event-p last-input-event))) 284 (viper-mouse-event-p last-input-event)))
285 (progn ; interrupted wait 285 (progn ; interrupted wait
286 (setq viper-global-prefix-argument arg) 286 (setq viper-global-prefix-argument arg)
@@ -362,7 +362,7 @@ this command."
362 ;; pending event is not a mouse event, we execute the current mouse 362 ;; pending event is not a mouse event, we execute the current mouse
363 ;; event 363 ;; event
364 (progn 364 (progn
365 (viper-read-event) 365 (read-event)
366 (viper-mouse-event-p last-input-event))) 366 (viper-mouse-event-p last-input-event)))
367 (progn ; interrupted wait 367 (progn ; interrupted wait
368 (setq viper-global-prefix-argument (or viper-global-prefix-argument 368 (setq viper-global-prefix-argument (or viper-global-prefix-argument
@@ -380,7 +380,7 @@ this command."
380 viper-global-prefix-argument nil)) 380 viper-global-prefix-argument nil))
381 (setq arg (or arg 1)) 381 (setq arg (or arg 1))
382 382
383 (viper-deactivate-mark) 383 (deactivate-mark)
384 (if (or (not (string= click-word viper-s-string)) 384 (if (or (not (string= click-word viper-s-string))
385 (not (markerp viper-search-start-marker)) 385 (not (markerp viper-search-start-marker))
386 (not (equal (marker-buffer viper-search-start-marker) 386 (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 @@
47 47
48 48
49 49
50(defalias 'viper-overlay-p 50(define-obsolete-function-alias 'viper-overlay-p 'overlayp "27.1")
51 (if (featurep 'xemacs) 'extentp 'overlayp)) 51(define-obsolete-function-alias 'viper-make-overlay 'make-overlay "27.1")
52(defalias 'viper-make-overlay 52(define-obsolete-function-alias 'viper-overlay-live-p 'overlayp "27.1")
53 (if (featurep 'xemacs) 'make-extent 'make-overlay)) 53(define-obsolete-function-alias 'viper-move-overlay 'move-overlay "27.1")
54(defalias 'viper-overlay-live-p 54(define-obsolete-function-alias 'viper-overlay-start 'overlay-start "27.1")
55 (if (featurep 'xemacs) 'extent-live-p 'overlayp)) 55(define-obsolete-function-alias 'viper-overlay-end 'overlay-end "27.1")
56(defalias 'viper-move-overlay 56(define-obsolete-function-alias 'viper-overlay-get 'overlay-get "27.1")
57 (if (featurep 'xemacs) 'set-extent-endpoints 'move-overlay)) 57(define-obsolete-function-alias 'viper-overlay-put 'overlay-put "27.1")
58(defalias 'viper-overlay-start 58(define-obsolete-function-alias 'viper-read-event 'read-event "27.1")
59 (if (featurep 'xemacs) 'extent-start-position 'overlay-start)) 59(define-obsolete-function-alias 'viper-characterp 'integerp "27.1")
60(defalias 'viper-overlay-end 60(define-obsolete-function-alias 'viper-int-to-char 'identity "27.1")
61 (if (featurep 'xemacs) 'extent-end-position 'overlay-end)) 61(define-obsolete-function-alias 'viper-get-face 'facep "27.1")
62(defalias 'viper-overlay-get 62(define-obsolete-function-alias 'viper-color-defined-p
63 (if (featurep 'xemacs) 'extent-property 'overlay-get)) 63 'x-color-defined-p "27.1")
64(defalias 'viper-overlay-put 64(define-obsolete-function-alias 'viper-iconify
65 (if (featurep 'xemacs) 'set-extent-property 'overlay-put)) 65 'iconify-or-deiconify-frame "27.1")
66(defalias 'viper-read-event
67 (if (featurep 'xemacs) 'next-command-event 'read-event))
68(defalias 'viper-characterp
69 (if (featurep 'xemacs) 'characterp 'integerp))
70(defalias 'viper-int-to-char
71 (if (featurep 'xemacs) 'int-to-char 'identity))
72(defalias 'viper-get-face
73 (if (featurep 'xemacs) 'get-face 'facep))
74(defalias 'viper-color-defined-p
75 (if (featurep 'xemacs) 'valid-color-name-p 'x-color-defined-p))
76(defalias 'viper-iconify
77 (if (featurep 'xemacs) 'iconify-frame 'iconify-or-deiconify-frame))
78 66
79 67
80;; CHAR is supposed to be a char or an integer (positive or negative) 68;; CHAR is supposed to be a char or an integer (positive or negative)
@@ -84,60 +72,50 @@
84;; chars. 72;; chars.
85(defun viper-memq-char (char list) 73(defun viper-memq-char (char list)
86 (cond ((and (integerp char) (>= char 0)) 74 (cond ((and (integerp char) (>= char 0))
87 (memq (viper-int-to-char char) list)) 75 (memq char list))
88 ((memq char list)))) 76 ((memq char list))))
89 77
90;; Check if char-or-int and char are the same as characters 78;; Check if char-or-int and char are the same as characters
91(defun viper-char-equal (char-or-int char) 79(defun viper-char-equal (char-or-int char)
92 (cond ((and (integerp char-or-int) (>= char-or-int 0)) 80 (cond ((and (integerp char-or-int) (>= char-or-int 0))
93 (= (viper-int-to-char char-or-int) char)) 81 (= char-or-int char))
94 ((eq char-or-int char)))) 82 ((eq char-or-int char))))
95 83
96;; Like =, but accommodates null and also is t for eq-objects 84;; Like =, but accommodates null and also is t for eq-objects
97(defun viper= (char char1) 85(defun viper= (char char1)
98 (cond ((eq char char1) t) 86 (cond ((eq char char1) t)
99 ((and (viper-characterp char) (viper-characterp char1)) 87 ((and (characterp char) (characterp char1))
100 (= char char1)) 88 (= char char1))
101 (t nil))) 89 (t nil)))
102 90
103(defsubst viper-color-display-p () 91(defsubst viper-color-display-p ()
104 (if (featurep 'xemacs) (eq (device-class (selected-device)) 'color) 92 (x-display-color-p))
105 (x-display-color-p)))
106 93
107(defun viper-get-cursor-color (&optional frame) 94(defun viper-get-cursor-color (&optional _frame)
108 (if (featurep 'xemacs) 95 (cdr (assoc 'cursor-color (frame-parameters))))
109 (color-instance-name
110 (frame-property (or frame (selected-frame)) 'cursor-color))
111 (cdr (assoc 'cursor-color (frame-parameters)))))
112 96
113(defmacro viper-frame-value (variable) 97(defmacro viper-frame-value (variable)
114 "Return the value of VARIABLE local to the current frame, if there is one. 98 "Return the value of VARIABLE local to the current frame, if there is one.
115Otherwise return the normal value." 99Otherwise return the normal value."
116 `(if (featurep 'xemacs) 100 ;; Frame-local variables are obsolete from Emacs 22.2 onwards,
101 ;; so we do it by hand instead.
102 ;; Buffer-local values take precedence over frame-local ones.
103 `(if (local-variable-p ',variable)
117 ,variable 104 ,variable
118 ;; Frame-local variables are obsolete from Emacs 22.2 onwards, 105 ;; Distinguish between no frame parameter and a frame parameter
119 ;; so we do it by hand instead. 106 ;; with a value of nil.
120 ;; Buffer-local values take precedence over frame-local ones. 107 (let ((fp (assoc ',variable (frame-parameters))))
121 (if (local-variable-p ',variable) 108 (if fp (cdr fp)
122 ,variable 109 ,variable))))
123 ;; Distinguish between no frame parameter and a frame parameter
124 ;; with a value of nil.
125 (let ((fp (assoc ',variable (frame-parameters))))
126 (if fp (cdr fp)
127 ,variable)))))
128 110
129;; cursor colors 111;; cursor colors
130(defun viper-change-cursor-color (new-color &optional frame) 112(defun viper-change-cursor-color (new-color &optional frame)
131 (if (and (viper-window-display-p) (viper-color-display-p) 113 (if (and (viper-window-display-p) (viper-color-display-p)
132 (stringp new-color) (viper-color-defined-p new-color) 114 (stringp new-color) (x-color-defined-p new-color)
133 (not (string= new-color (viper-get-cursor-color)))) 115 (not (string= new-color (viper-get-cursor-color))))
134 (if (featurep 'xemacs) 116 (modify-frame-parameters
135 (set-frame-property 117 (or frame (selected-frame))
136 (or frame (selected-frame)) 118 (list (cons 'cursor-color new-color)))))
137 'cursor-color (make-color-instance new-color))
138 (modify-frame-parameters
139 (or frame (selected-frame))
140 (list (cons 'cursor-color new-color))))))
141 119
142;; Note that the colors this function uses might not be those 120;; Note that the colors this function uses might not be those
143;; associated with FRAME, if there are frame-local values. 121;; associated with FRAME, if there are frame-local values.
@@ -166,7 +144,7 @@ Otherwise return the normal value."
166(defun viper-save-cursor-color (before-which-mode) 144(defun viper-save-cursor-color (before-which-mode)
167 (if (and (viper-window-display-p) (viper-color-display-p)) 145 (if (and (viper-window-display-p) (viper-color-display-p))
168 (let ((color (viper-get-cursor-color))) 146 (let ((color (viper-get-cursor-color)))
169 (if (and (stringp color) (viper-color-defined-p color) 147 (if (and (stringp color) (x-color-defined-p color)
170 ;; there is something fishy in that the color is not saved if 148 ;; there is something fishy in that the color is not saved if
171 ;; it is the same as frames default cursor color. need to be 149 ;; it is the same as frames default cursor color. need to be
172 ;; checked. 150 ;; checked.
@@ -216,7 +194,7 @@ Otherwise return the normal value."
216 194
217;; restore cursor color from replace overlay 195;; restore cursor color from replace overlay
218(defun viper-restore-cursor-color(after-which-mode) 196(defun viper-restore-cursor-color(after-which-mode)
219 (if (viper-overlay-p viper-replace-overlay) 197 (if (overlayp viper-replace-overlay)
220 (viper-change-cursor-color 198 (viper-change-cursor-color
221 (cond ((eq after-which-mode 'after-replace-mode) 199 (cond ((eq after-which-mode 'after-replace-mode)
222 (viper-get-saved-cursor-color-in-replace-mode)) 200 (viper-get-saved-cursor-color-in-replace-mode))
@@ -255,10 +233,7 @@ Otherwise return the normal value."
255 233
256 234
257(defun viper-get-visible-buffer-window (wind) 235(defun viper-get-visible-buffer-window (wind)
258 (if (featurep 'xemacs) 236 (get-buffer-window wind 'visible))
259 (get-buffer-window wind t)
260 (get-buffer-window wind 'visible)))
261
262 237
263;; Return line position. 238;; Return line position.
264;; If pos is 'start then returns position of line start. 239;; If pos is 'start then returns position of line start.
@@ -708,9 +683,7 @@ Otherwise return the normal value."
708 (if (fboundp 'vc-state) 683 (if (fboundp 'vc-state)
709 (and 684 (and
710 (not (memq (vc-state file) '(edited needs-merge))) 685 (not (memq (vc-state file) '(edited needs-merge)))
711 (not (stringp (vc-state file)))) 686 (not (stringp (vc-state file)))))))
712 ;; XEmacs has no vc-state
713 (if (featurep 'xemacs) (not (vc-locking-user file))))))
714 687
715;; checkout if visited file is checked in 688;; checkout if visited file is checked in
716(defun viper-maybe-checkout (buf) 689(defun viper-maybe-checkout (buf)
@@ -730,12 +703,12 @@ Otherwise return the normal value."
730 703
731;;; Overlays 704;;; Overlays
732(defun viper-put-on-search-overlay (beg end) 705(defun viper-put-on-search-overlay (beg end)
733 (if (viper-overlay-p viper-search-overlay) 706 (if (overlayp viper-search-overlay)
734 (viper-move-overlay viper-search-overlay beg end) 707 (move-overlay viper-search-overlay beg end)
735 (setq viper-search-overlay (viper-make-overlay beg end (current-buffer))) 708 (setq viper-search-overlay (make-overlay beg end (current-buffer)))
736 (viper-overlay-put 709 (overlay-put
737 viper-search-overlay 'priority viper-search-overlay-priority)) 710 viper-search-overlay 'priority viper-search-overlay-priority))
738 (viper-overlay-put viper-search-overlay 'face viper-search-face)) 711 (overlay-put viper-search-overlay 'face viper-search-face))
739 712
740;; Search 713;; Search
741 714
@@ -744,41 +717,41 @@ Otherwise return the normal value."
744 nil 717 nil
745 (viper-put-on-search-overlay (match-beginning 0) (match-end 0)) 718 (viper-put-on-search-overlay (match-beginning 0) (match-end 0))
746 (sit-for 2) 719 (sit-for 2)
747 (viper-overlay-put viper-search-overlay 'face nil))) 720 (overlay-put viper-search-overlay 'face nil)))
748 721
749(defun viper-hide-search-overlay () 722(defun viper-hide-search-overlay ()
750 (if (not (viper-overlay-p viper-search-overlay)) 723 (if (not (overlayp viper-search-overlay))
751 (progn 724 (progn
752 (setq viper-search-overlay 725 (setq viper-search-overlay
753 (viper-make-overlay (point-min) (point-min) (current-buffer))) 726 (make-overlay (point-min) (point-min) (current-buffer)))
754 (viper-overlay-put 727 (overlay-put
755 viper-search-overlay 'priority viper-search-overlay-priority))) 728 viper-search-overlay 'priority viper-search-overlay-priority)))
756 (viper-overlay-put viper-search-overlay 'face nil)) 729 (overlay-put viper-search-overlay 'face nil))
757 730
758;; Replace state 731;; Replace state
759 732
760(defsubst viper-move-replace-overlay (beg end) 733(defsubst viper-move-replace-overlay (beg end)
761 (viper-move-overlay viper-replace-overlay beg end)) 734 (move-overlay viper-replace-overlay beg end))
762 735
763(defun viper-set-replace-overlay (beg end) 736(defun viper-set-replace-overlay (beg end)
764 (if (viper-overlay-live-p viper-replace-overlay) 737 (if (overlayp viper-replace-overlay)
765 (viper-move-replace-overlay beg end) 738 (viper-move-replace-overlay beg end)
766 (setq viper-replace-overlay (viper-make-overlay beg end (current-buffer))) 739 (setq viper-replace-overlay (make-overlay beg end (current-buffer)))
767 ;; never detach 740 ;; never detach
768 (viper-overlay-put 741 (overlay-put
769 viper-replace-overlay (if (featurep 'emacs) 'evaporate 'detachable) nil) 742 viper-replace-overlay (if (featurep 'emacs) 'evaporate 'detachable) nil)
770 (viper-overlay-put 743 (overlay-put
771 viper-replace-overlay 'priority viper-replace-overlay-priority) 744 viper-replace-overlay 'priority viper-replace-overlay-priority)
772 ;; If Emacs will start supporting overlay maps, as it currently supports 745 ;; If Emacs will start supporting overlay maps, as it currently supports
773 ;; text-property maps, we could do away with viper-replace-minor-mode and 746 ;; text-property maps, we could do away with viper-replace-minor-mode and
774 ;; just have keymap attached to replace overlay. 747 ;; just have keymap attached to replace overlay.
775 ;;(viper-overlay-put 748 ;;(overlay-put
776 ;; viper-replace-overlay 749 ;; viper-replace-overlay
777 ;; (if (featurep 'xemacs) 'keymap 'local-map) 750 ;; (if (featurep 'xemacs) 'keymap 'local-map)
778 ;; viper-replace-map) 751 ;; viper-replace-map)
779 ) 752 )
780 (if (viper-has-face-support-p) 753 (if (viper-has-face-support-p)
781 (viper-overlay-put 754 (overlay-put
782 viper-replace-overlay 'face viper-replace-overlay-face)) 755 viper-replace-overlay 'face viper-replace-overlay-face))
783 (viper-save-cursor-color 'before-replace-mode) 756 (viper-save-cursor-color 'before-replace-mode)
784 (viper-change-cursor-color 757 (viper-change-cursor-color
@@ -786,27 +759,25 @@ Otherwise return the normal value."
786 759
787 760
788(defun viper-set-replace-overlay-glyphs (before-glyph after-glyph) 761(defun viper-set-replace-overlay-glyphs (before-glyph after-glyph)
789 (or (viper-overlay-live-p viper-replace-overlay) 762 (or (overlayp viper-replace-overlay)
790 (viper-set-replace-overlay (point-min) (point-min))) 763 (viper-set-replace-overlay (point-min) (point-min)))
791 (if (or (not (viper-has-face-support-p)) 764 (if (or (not (viper-has-face-support-p))
792 viper-use-replace-region-delimiters) 765 viper-use-replace-region-delimiters)
793 (let ((before-name (if (featurep 'xemacs) 'begin-glyph 'before-string)) 766 (overlay-put viper-replace-overlay 'before-string before-glyph)
794 (after-name (if (featurep 'xemacs) 'end-glyph 'after-string))) 767 (overlay-put viper-replace-overlay 'after-string after-glyph)))
795 (viper-overlay-put viper-replace-overlay before-name before-glyph)
796 (viper-overlay-put viper-replace-overlay after-name after-glyph))))
797 768
798(defun viper-hide-replace-overlay () 769(defun viper-hide-replace-overlay ()
799 (viper-set-replace-overlay-glyphs nil nil) 770 (viper-set-replace-overlay-glyphs nil nil)
800 (viper-restore-cursor-color 'after-replace-mode) 771 (viper-restore-cursor-color 'after-replace-mode)
801 (viper-restore-cursor-color 'after-insert-mode) 772 (viper-restore-cursor-color 'after-insert-mode)
802 (if (viper-has-face-support-p) 773 (if (viper-has-face-support-p)
803 (viper-overlay-put viper-replace-overlay 'face nil))) 774 (overlay-put viper-replace-overlay 'face nil)))
804 775
805 776
806(defsubst viper-replace-start () 777(defsubst viper-replace-start ()
807 (viper-overlay-start viper-replace-overlay)) 778 (overlay-start viper-replace-overlay))
808(defsubst viper-replace-end () 779(defsubst viper-replace-end ()
809 (viper-overlay-end viper-replace-overlay)) 780 (overlay-end viper-replace-overlay))
810 781
811 782
812;; Minibuffer 783;; Minibuffer
@@ -814,35 +785,25 @@ Otherwise return the normal value."
814(defun viper-set-minibuffer-overlay () 785(defun viper-set-minibuffer-overlay ()
815 (viper-check-minibuffer-overlay) 786 (viper-check-minibuffer-overlay)
816 (when (viper-has-face-support-p) 787 (when (viper-has-face-support-p)
817 (viper-overlay-put 788 (overlay-put
818 viper-minibuffer-overlay 'face viper-minibuffer-current-face) 789 viper-minibuffer-overlay 'face viper-minibuffer-current-face)
819 (viper-overlay-put 790 (overlay-put
820 viper-minibuffer-overlay 'priority viper-minibuffer-overlay-priority) 791 viper-minibuffer-overlay 'priority viper-minibuffer-overlay-priority)
821 ;; never detach 792 ;; never detach
822 (viper-overlay-put 793 (overlay-put viper-minibuffer-overlay 'evaporate nil)))
823 viper-minibuffer-overlay
824 (if (featurep 'emacs) 'evaporate 'detachable)
825 nil)
826 ;; make viper-minibuffer-overlay open-ended
827 ;; In emacs, it is made open ended at creation time
828 (when (featurep 'xemacs)
829 (viper-overlay-put viper-minibuffer-overlay 'start-open nil)
830 (viper-overlay-put viper-minibuffer-overlay 'end-open nil))))
831 794
832(defun viper-check-minibuffer-overlay () 795(defun viper-check-minibuffer-overlay ()
833 (if (viper-overlay-live-p viper-minibuffer-overlay) 796 (if (overlayp viper-minibuffer-overlay)
834 (viper-move-overlay 797 (move-overlay
835 viper-minibuffer-overlay 798 viper-minibuffer-overlay
836 (if (fboundp 'minibuffer-prompt-end) (minibuffer-prompt-end) 1) 799 (if (fboundp 'minibuffer-prompt-end) (minibuffer-prompt-end) 1)
837 (1+ (buffer-size))) 800 (1+ (buffer-size)))
838 (setq viper-minibuffer-overlay 801 (setq viper-minibuffer-overlay
839 (if (featurep 'xemacs) 802 ;; make overlay open-ended
840 (viper-make-overlay 1 (1+ (buffer-size)) (current-buffer)) 803 (make-overlay
841 ;; make overlay open-ended 804 (if (fboundp 'minibuffer-prompt-end) (minibuffer-prompt-end) 1)
842 (viper-make-overlay 805 (1+ (buffer-size))
843 (if (fboundp 'minibuffer-prompt-end) (minibuffer-prompt-end) 1) 806 (current-buffer) nil 'rear-advance))))
844 (1+ (buffer-size))
845 (current-buffer) nil 'rear-advance)))))
846 807
847 808
848(defsubst viper-is-in-minibuffer () 809(defsubst viper-is-in-minibuffer ()
@@ -854,9 +815,7 @@ Otherwise return the normal value."
854;;; XEmacs compatibility 815;;; XEmacs compatibility
855 816
856(defun viper-abbreviate-file-name (file) 817(defun viper-abbreviate-file-name (file)
857 (if (featurep 'xemacs) 818 (abbreviate-file-name file))
858 (abbreviate-file-name file t) ; XEmacs requires addl argument
859 (abbreviate-file-name file)))
860 819
861;; Sit for VAL milliseconds. XEmacs doesn't support the millisecond arg 820;; Sit for VAL milliseconds. XEmacs doesn't support the millisecond arg
862;; in sit-for, so this function smooths out the differences. 821;; in sit-for, so this function smooths out the differences.
@@ -877,9 +836,7 @@ Otherwise return the normal value."
877 (with-current-buffer buf 836 (with-current-buffer buf
878 (and (<= pos (point-max)) (<= (point-min) pos)))))) 837 (and (<= pos (point-max)) (<= (point-min) pos))))))
879 838
880(defsubst viper-mark-marker () 839(define-obsolete-function-alias 'viper-mark-marker 'mark-marker "27.1")
881 (if (featurep 'xemacs) (mark-marker t)
882 (mark-marker)))
883 840
884(defvar viper-saved-mark nil 841(defvar viper-saved-mark nil
885 "Where viper saves mark. This mark is resurrected by m^.") 842 "Where viper saves mark. This mark is resurrected by m^.")
@@ -887,20 +844,17 @@ Otherwise return the normal value."
887;; like (set-mark-command nil) but doesn't push twice, if (car mark-ring) 844;; like (set-mark-command nil) but doesn't push twice, if (car mark-ring)
888;; is the same as (mark t). 845;; is the same as (mark t).
889(defsubst viper-set-mark-if-necessary () 846(defsubst viper-set-mark-if-necessary ()
890 (setq mark-ring (delete (viper-mark-marker) mark-ring)) 847 (setq mark-ring (delete (mark-marker) mark-ring))
891 (set-mark-command nil) 848 (set-mark-command nil)
892 (setq viper-saved-mark (point))) 849 (setq viper-saved-mark (point)))
893 850
894;; In transient mark mode (zmacs mode), it is annoying when regions become 851;; In transient mark mode, it is annoying when regions become
895;; highlighted due to Viper's pushing marks. So, we deactivate marks, unless 852;; highlighted due to Viper's pushing marks. So, we deactivate marks,
896;; the user explicitly wants highlighting, e.g., by hitting '' or `` 853;; unless the user explicitly wants highlighting, e.g., by hitting ''
897(defun viper-deactivate-mark () 854;; or ``
898 (if (featurep 'xemacs) 855(define-obsolete-function-alias 'viper-deactivate-mark 'deactivate-mark "27.1")
899 (zmacs-deactivate-region)
900 (deactivate-mark)))
901 856
902(defsubst viper-leave-region-active () 857(define-obsolete-function-alias 'viper-leave-region-active 'ignore "27.1")
903 (if (featurep 'xemacs) (setq zmacs-region-stays t)))
904 858
905;; Check if arg is a valid character for register 859;; Check if arg is a valid character for register
906;; TYPE is a list that can contain `letter', `Letter', and `digit'. 860;; TYPE is a list that can contain `letter', `Letter', and `digit'.
@@ -919,11 +873,7 @@ Otherwise return the normal value."
919 873
920 874
921 875
922;; it is suggested that an event must be copied before it is assigned to 876(define-obsolete-function-alias 'viper-copy-event 'identity "27.1")
923;; last-command-event in XEmacs
924(defun viper-copy-event (event)
925 (if (featurep 'xemacs) (copy-event event)
926 event))
927 877
928;; Uses different timeouts for ESC-sequences and others 878;; Uses different timeouts for ESC-sequences and others
929(defun viper-fast-keysequence-p () 879(defun viper-fast-keysequence-p ()
@@ -933,15 +883,8 @@ Otherwise return the normal value."
933 viper-fast-keyseq-timeout) 883 viper-fast-keyseq-timeout)
934 t))) 884 t)))
935 885
936;; like read-event, but in XEmacs also try to convert to char, if possible 886(define-obsolete-function-alias 'viper-read-event-convert-to-char
937(defun viper-read-event-convert-to-char () 887 'read-event "27.1")
938 (let (event)
939 (if (featurep 'xemacs)
940 (progn
941 (setq event (next-command-event))
942 (or (event-to-character event)
943 event))
944 (read-event))))
945 888
946 889
947;; Emacs has a bug in eventp, which causes (eventp nil) to return (nil) 890;; Emacs has a bug in eventp, which causes (eventp nil) to return (nil)
@@ -950,64 +893,47 @@ Otherwise return the normal value."
950(defun viper-event-key (event) 893(defun viper-event-key (event)
951 (or (and event (eventp event)) 894 (or (and event (eventp event))
952 (error "viper-event-key: Wrong type argument, eventp, %S" event)) 895 (error "viper-event-key: Wrong type argument, eventp, %S" event))
953 (when (if (featurep 'xemacs) 896 (let ((mod (event-modifiers event))
954 (or (key-press-event-p event) (mouse-event-p event)) ; xemacs 897 basis)
955 t ; emacs 898 (setq basis
956 ) 899 ;; Emacs doesn't handle capital letters correctly, since
957 (let ((mod (event-modifiers event)) 900 ;; \S-a isn't considered the same as A (it behaves as
958 basis) 901 ;; plain `a' instead). So we take care of this here
959 (setq basis 902 (cond ((and (characterp event) (<= ?A event) (<= event ?Z))
960 (if (featurep 'xemacs) 903 (setq mod nil
961 ;; XEmacs 904 event event))
962 (cond ((key-press-event-p event) 905 ;; Emacs has the oddity whereby characters 128+char
963 (event-key event)) 906 ;; represent M-char *if* this appears inside a string.
964 ((button-event-p event) 907 ;; So, we convert them manually to (meta char).
965 (concat "mouse-" (prin1-to-string (event-button event)))) 908 ((and (characterp event)
966 (t 909 (< ?\C-? event) (<= event 255))
967 (error "viper-event-key: Unknown event, %S" event))) 910 (setq mod '(meta)
968 ;; Emacs doesn't handle capital letters correctly, since 911 event (- event ?\C-? 1)))
969 ;; \S-a isn't considered the same as A (it behaves as 912 ((and (null mod) (eq event 'return))
970 ;; plain `a' instead). So we take care of this here 913 (setq event ?\C-m))
971 (cond ((and (viper-characterp event) (<= ?A event) (<= event ?Z)) 914 ((and (null mod) (eq event 'space))
972 (setq mod nil 915 (setq event ?\ ))
973 event event)) 916 ((and (null mod) (eq event 'delete))
974 ;; Emacs has the oddity whereby characters 128+char 917 (setq event ?\C-?))
975 ;; represent M-char *if* this appears inside a string. 918 ((and (null mod) (eq event 'backspace))
976 ;; So, we convert them manually to (meta char). 919 (setq event ?\C-h))
977 ((and (viper-characterp event) 920 (t (event-basic-type event))))
978 (< ?\C-? event) (<= event 255)) 921
979 (setq mod '(meta) 922 (if (characterp basis)
980 event (- event ?\C-? 1))) 923 (setq basis
981 ((and (null mod) (eq event 'return)) 924 (if (viper= basis ?\C-?)
982 (setq event ?\C-m)) 925 (list 'control '\?) ; taking care of an emacs bug
983 ((and (null mod) (eq event 'space)) 926 (intern (char-to-string basis)))))
984 (setq event ?\ )) 927 (if mod
985 ((and (null mod) (eq event 'delete)) 928 (append mod (list basis))
986 (setq event ?\C-?)) 929 basis)))
987 ((and (null mod) (eq event 'backspace))
988 (setq event ?\C-h))
989 (t (event-basic-type event)))
990 ) ; (featurep 'xemacs)
991 )
992 (if (viper-characterp basis)
993 (setq basis
994 (if (viper= basis ?\C-?)
995 (list 'control '\?) ; taking care of an emacs bug
996 (intern (char-to-string basis)))))
997 (if mod
998 (append mod (list basis))
999 basis))))
1000 930
1001(defun viper-last-command-char () 931(defun viper-last-command-char ()
1002 (if (featurep 'xemacs) 932 last-command-event)
1003 (event-to-character last-command-event)
1004 last-command-event))
1005 933
1006(defun viper-key-to-emacs-key (key) 934(defun viper-key-to-emacs-key (key)
1007 (let (key-name char-p modifiers mod-char-list base-key base-key-name) 935 (let (key-name char-p modifiers mod-char-list base-key base-key-name)
1008 (cond ((featurep 'xemacs) key) 936 (cond ((symbolp key)
1009
1010 ((symbolp key)
1011 (setq key-name (symbol-name key)) 937 (setq key-name (symbol-name key))
1012 (cond ((= (length key-name) 1) ; character event 938 (cond ((= (length key-name) 1) ; character event
1013 (string-to-char key-name)) 939 (string-to-char key-name))
@@ -1049,16 +975,7 @@ Otherwise return the normal value."
1049 975
1050 976
1051;; LIS is assumed to be a list of events of characters 977;; LIS is assumed to be a list of events of characters
1052(defun viper-eventify-list-xemacs (lis) 978(define-obsolete-function-alias 'viper-eventify-list-xemacs 'ignore "27.1")
1053 (if (featurep 'xemacs)
1054 (mapcar
1055 (lambda (elt)
1056 (cond ((viper-characterp elt) (character-to-event elt))
1057 ((eventp elt) elt)
1058 (t (error
1059 "viper-eventify-list-xemacs: can't convert to event, %S"
1060 elt))))
1061 lis)))
1062 979
1063 980
1064;; Smooths out the difference between Emacs's unread-command-events 981;; Smooths out the difference between Emacs's unread-command-events
@@ -1088,11 +1005,11 @@ Otherwise return the normal value."
1088 (setq 1005 (setq
1089 unread-command-events 1006 unread-command-events
1090 (append 1007 (append
1091 (cond ((viper-characterp arg) (list (character-to-event arg))) 1008 (cond ((characterp arg) (list (character-to-event arg)))
1092 ((eventp arg) (list arg)) 1009 ((eventp arg) (list arg))
1093 ((stringp arg) (mapcar 'character-to-event arg)) 1010 ((stringp arg) (mapcar 'character-to-event arg))
1094 ((vectorp arg) (append arg nil)) ; turn into list 1011 ((vectorp arg) (append arg nil)) ; turn into list
1095 ((listp arg) (viper-eventify-list-xemacs arg)) 1012 ((listp arg) nil)
1096 (t (error 1013 (t (error
1097 "viper-set-unread-command-events: Invalid argument, %S" arg))) 1014 "viper-set-unread-command-events: Invalid argument, %S" arg)))
1098 unread-command-events)))) 1015 unread-command-events))))
@@ -1117,7 +1034,7 @@ Otherwise return the normal value."
1117 1034
1118 1035
1119(defun viper-char-array-p (array) 1036(defun viper-char-array-p (array)
1120 (eval (cons 'and (mapcar 'viper-characterp array)))) 1037 (eval (cons 'and (mapcar 'characterp array))))
1121 1038
1122 1039
1123;; Args can be a sequence of events, a string, or a Viper macro. Will try to 1040;; 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."
1145 (t (prin1-to-string event-seq))))) 1062 (t (prin1-to-string event-seq)))))
1146 1063
1147(defun viper-key-press-events-to-chars (events) 1064(defun viper-key-press-events-to-chars (events)
1148 (mapconcat (if (featurep 'xemacs) 1065 (mapconcat #'char-to-string events ""))
1149 (lambda (elt) (char-to-string (event-to-character elt))) ; xemacs
1150 'char-to-string ; emacs
1151 )
1152 events
1153 ""))
1154 1066
1155 1067
1156(defun viper-read-char-exclusive () 1068(defun viper-read-char-exclusive ()
@@ -1161,7 +1073,7 @@ Otherwise return the normal value."
1161 (setq char (read-char)) 1073 (setq char (read-char))
1162 (error 1074 (error
1163 ;; skip event if not char 1075 ;; skip event if not char
1164 (viper-read-event)))) 1076 (read-event))))
1165 char)) 1077 char))
1166 1078
1167;; key is supposed to be in viper's representation, e.g., (control l), a 1079;; 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."
700 (and (fboundp 'add-to-ordered-list) (boundp 'emulation-mode-map-alists)) 700 (and (fboundp 'add-to-ordered-list) (boundp 'emulation-mode-map-alists))
701 (viper-delocalize-var 'minor-mode-map-alist)) 701 (viper-delocalize-var 'minor-mode-map-alist))
702 (viper-delocalize-var 'require-final-newline) 702 (viper-delocalize-var 'require-final-newline)
703 (if (featurep 'xemacs) (viper-delocalize-var 'bar-cursor))
704
705 703
706 ;; deactivate all advices done by Viper. 704 ;; deactivate all advices done by Viper.
707 (viper--deactivate-advice-list) 705 (viper--deactivate-advice-list)
@@ -787,8 +785,6 @@ It also can't undo some Viper settings."
787 ;; In emacs, we have to advice handle-switch-frame 785 ;; In emacs, we have to advice handle-switch-frame
788 ;; This advice is undone earlier, when all advices matching "viper-" are 786 ;; This advice is undone earlier, when all advices matching "viper-" are
789 ;; deactivated. 787 ;; deactivated.
790 (if (featurep 'xemacs)
791 (remove-hook 'mouse-leave-frame-hook #'viper-remember-current-frame))
792 ) ; end viper-go-away 788 ) ; end viper-go-away
793 789
794 790
@@ -935,15 +931,7 @@ Two differences:
935 (lambda (orig-fun &rest args) 931 (lambda (orig-fun &rest args)
936 ;; FIXME: Use remapping? 932 ;; FIXME: Use remapping?
937 (if (and (eq viper-current-state 'vi-state) 933 (if (and (eq viper-current-state 'vi-state)
938 ;; Do not use called-interactively-p here. XEmacs does not have it 934 (called-interactively-p 'interactive))
939 ;; and interactive-p is just fine.
940 (if (featurep 'xemacs)
941 (interactive-p)
942 ;; Respect the spirit of the above comment, though it
943 ;; seems pointless, since XE doesn't have advice-add or
944 ;; lexical binding or any other of the newer features
945 ;; this file uses.
946 (called-interactively-p 'interactive)))
947 (beep 1) 935 (beep 1)
948 (apply orig-fun args)))) 936 (apply orig-fun args))))
949 937
@@ -1083,13 +1071,11 @@ This may be needed if the previous `:map' command terminated abnormally."
1083 1071
1084 ;; catch frame switching event 1072 ;; catch frame switching event
1085 (if (viper-window-display-p) 1073 (if (viper-window-display-p)
1086 (if (featurep 'xemacs) 1074 (viper--advice-add
1087 (add-hook 'mouse-leave-frame-hook 1075 'handle-switch-frame :before
1088 #'viper-remember-current-frame) 1076 (lambda (&rest _)
1089 (viper--advice-add 'handle-switch-frame :before 1077 "Remember the selected frame before the switch-frame event."
1090 (lambda (&rest _) 1078 (viper-remember-current-frame (selected-frame)))))
1091 "Remember the selected frame before the switch-frame event."
1092 (viper-remember-current-frame (selected-frame))))))
1093 1079
1094 ) ; end viper-non-hook-settings 1080 ) ; end viper-non-hook-settings
1095 1081