aboutsummaryrefslogtreecommitdiffstats
path: root/lisp/emulation
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/emulation')
-rw-r--r--lisp/emulation/edt.el106
-rw-r--r--lisp/emulation/tpu-mapper.el68
-rw-r--r--lisp/emulation/vip.el16
-rw-r--r--lisp/emulation/viper-cmd.el29
-rw-r--r--lisp/emulation/viper-ex.el32
-rw-r--r--lisp/emulation/viper-init.el20
-rw-r--r--lisp/emulation/viper-macs.el2
-rw-r--r--lisp/emulation/viper-mous.el28
-rw-r--r--lisp/emulation/viper-util.el126
-rw-r--r--lisp/emulation/viper.el26
10 files changed, 206 insertions, 247 deletions
diff --git a/lisp/emulation/edt.el b/lisp/emulation/edt.el
index bff1a583586..4a68e258cb1 100644
--- a/lisp/emulation/edt.el
+++ b/lisp/emulation/edt.el
@@ -321,24 +321,14 @@ This means that an edt-user.el file was found in the user's `load-path'.")
321;;; 321;;;
322;;; o edt-emulation-on o edt-load-keys 322;;; o edt-emulation-on o edt-load-keys
323;;; 323;;;
324(defconst edt-emacs19-p (not (string-lessp emacs-version "19")) 324(defconst edt-emacs-variant (if (featurep 'emacs) "gnu" "xemacs")
325 "Non-nil if we are running GNU Emacs or XEmacs version 19, or higher.")
326
327(defconst edt-x-emacs19-p
328 (and edt-emacs19-p (string-match "XEmacs" emacs-version))
329 "Non-nil if we are running XEmacs version 19, or higher.")
330
331(defconst edt-gnu-emacs19-p (and edt-emacs19-p (not edt-x-emacs19-p))
332 "Non-nil if we are running GNU Emacs version 19, or higher.")
333
334(defconst edt-emacs-variant (if edt-gnu-emacs19-p "gnu" "xemacs")
335 "Indicates Emacs variant: GNU Emacs or XEmacs \(aka Lucid Emacs\).") 325 "Indicates Emacs variant: GNU Emacs or XEmacs \(aka Lucid Emacs\).")
336 326
337(defconst edt-window-system (if edt-gnu-emacs19-p window-system (console-type)) 327(defconst edt-window-system (if (featurep 'emacs) window-system (console-type))
338 "Indicates window system \(in GNU Emacs\) or console type \(in XEmacs\).") 328 "Indicates window system \(in GNU Emacs\) or console type \(in XEmacs\).")
339 329
340(defconst edt-xserver (if (eq edt-window-system 'x) 330(defconst edt-xserver (if (eq edt-window-system 'x)
341 (if edt-x-emacs19-p 331 (if (featurep 'xemacs)
342 ;; The Cygwin window manager has a `/' in its 332 ;; The Cygwin window manager has a `/' in its
343 ;; name, which breaks the generated file name of 333 ;; name, which breaks the generated file name of
344 ;; the custom key map file. Replace `/' with a 334 ;; the custom key map file. Replace `/' with a
@@ -409,7 +399,7 @@ Argument NUM is the number of page delimiters to move."
409 (progn 399 (progn
410 (backward-page num) 400 (backward-page num)
411 (edt-line-to-top-of-window) 401 (edt-line-to-top-of-window)
412 (if edt-x-emacs19-p (setq zmacs-region-stays t))))) 402 (if (featurep 'xemacs) (setq zmacs-region-stays t)))))
413 403
414(defun edt-page (num) 404(defun edt-page (num)
415 "Move in current direction to next page delimiter. 405 "Move in current direction to next page delimiter.
@@ -470,7 +460,7 @@ Argument NUM is the number of BOL marks to move."
470 (setq num (1- num)) 460 (setq num (1- num))
471 (forward-line (* -1 num)))) 461 (forward-line (* -1 num))))
472 (edt-top-check beg num)) 462 (edt-top-check beg num))
473 (if edt-x-emacs19-p (setq zmacs-region-stays t))) 463 (if (featurep 'xemacs) (setq zmacs-region-stays t)))
474 464
475 465
476;;; 466;;;
@@ -486,7 +476,7 @@ Argument NUM is the number of EOL marks to move."
486 (forward-char) 476 (forward-char)
487 (end-of-line num) 477 (end-of-line num)
488 (edt-bottom-check beg num)) 478 (edt-bottom-check beg num))
489 (if edt-x-emacs19-p (setq zmacs-region-stays t))) 479 (if (featurep 'xemacs) (setq zmacs-region-stays t)))
490 480
491 481
492(defun edt-end-of-line-backward (num) 482(defun edt-end-of-line-backward (num)
@@ -497,7 +487,7 @@ Argument NUM is the number of EOL marks to move."
497 (let ((beg (edt-current-line))) 487 (let ((beg (edt-current-line)))
498 (end-of-line (1- num)) 488 (end-of-line (1- num))
499 (edt-top-check beg num)) 489 (edt-top-check beg num))
500 (if edt-x-emacs19-p (setq zmacs-region-stays t))) 490 (if (featurep 'xemacs) (setq zmacs-region-stays t)))
501 491
502 492
503(defun edt-end-of-line (num) 493(defun edt-end-of-line (num)
@@ -542,7 +532,7 @@ Argument NUM is the number of EOL marks to move."
542 (eq ?\ (char-syntax (following-char))) 532 (eq ?\ (char-syntax (following-char)))
543 (not (memq (following-char) edt-word-entities))) 533 (not (memq (following-char) edt-word-entities)))
544 (forward-char)))) 534 (forward-char))))
545 (if edt-x-emacs19-p (setq zmacs-region-stays t))) 535 (if (featurep 'xemacs) (setq zmacs-region-stays t)))
546 536
547(defun edt-one-word-backward () 537(defun edt-one-word-backward ()
548 "Move backward to first character of previous word." 538 "Move backward to first character of previous word."
@@ -566,7 +556,7 @@ Argument NUM is the number of EOL marks to move."
566 (not (eq ?\ (char-syntax (preceding-char)))) 556 (not (eq ?\ (char-syntax (preceding-char))))
567 (not (memq (preceding-char) edt-word-entities))) 557 (not (memq (preceding-char) edt-word-entities)))
568 (backward-char))))) 558 (backward-char)))))
569 (if edt-x-emacs19-p (setq zmacs-region-stays t))) 559 (if (featurep 'xemacs) (setq zmacs-region-stays t)))
570 560
571(defun edt-word-forward (num) 561(defun edt-word-forward (num)
572 "Move forward to first character of next word. 562 "Move forward to first character of next word.
@@ -606,7 +596,7 @@ Argument NUM is the number of characters to move."
606 (if (equal edt-direction-string edt-forward-string) 596 (if (equal edt-direction-string edt-forward-string)
607 (forward-char num) 597 (forward-char num)
608 (backward-char num)) 598 (backward-char num))
609 (if edt-x-emacs19-p (setq zmacs-region-stays t))) 599 (if (featurep 'xemacs) (setq zmacs-region-stays t)))
610 600
611;;; 601;;;
612;;; LINE 602;;; LINE
@@ -629,7 +619,7 @@ Argument NUM is the number of BOL marks to move."
629 (let ((beg (edt-current-line))) 619 (let ((beg (edt-current-line)))
630 (forward-line num) 620 (forward-line num)
631 (edt-bottom-check beg num)) 621 (edt-bottom-check beg num))
632 (if edt-x-emacs19-p (setq zmacs-region-stays t))) 622 (if (featurep 'xemacs) (setq zmacs-region-stays t)))
633 623
634(defun edt-line (num) 624(defun edt-line (num)
635 "Move in current direction to next beginning of line mark. 625 "Move in current direction to next beginning of line mark.
@@ -651,7 +641,7 @@ Argument NUM is the number of lines to move."
651 (let ((beg (edt-current-line))) 641 (let ((beg (edt-current-line)))
652 (forward-line num) 642 (forward-line num)
653 (edt-bottom-check beg num)) 643 (edt-bottom-check beg num))
654 (if edt-x-emacs19-p (setq zmacs-region-stays t))) 644 (if (featurep 'xemacs) (setq zmacs-region-stays t)))
655 645
656(defun edt-previous-line (num) 646(defun edt-previous-line (num)
657 "Move cursor up one line. 647 "Move cursor up one line.
@@ -661,7 +651,7 @@ Argument NUM is the number of lines to move."
661 (let ((beg (edt-current-line))) 651 (let ((beg (edt-current-line)))
662 (forward-line (- num)) 652 (forward-line (- num))
663 (edt-top-check beg num)) 653 (edt-top-check beg num))
664 (if edt-x-emacs19-p (setq zmacs-region-stays t))) 654 (if (featurep 'xemacs) (setq zmacs-region-stays t)))
665 655
666 656
667;;; 657;;;
@@ -672,7 +662,7 @@ Argument NUM is the number of lines to move."
672 "Move cursor to the beginning of buffer." 662 "Move cursor to the beginning of buffer."
673 (interactive) 663 (interactive)
674 (goto-char (point-min)) 664 (goto-char (point-min))
675 (if edt-x-emacs19-p (setq zmacs-region-stays t))) 665 (if (featurep 'xemacs) (setq zmacs-region-stays t)))
676 666
677;;; 667;;;
678;;; BOTTOM 668;;; BOTTOM
@@ -718,7 +708,7 @@ Optional argument FIND is t is this function is called from `edt-find'."
718 (recenter (- left bottom-up-margin)))) 708 (recenter (- left bottom-up-margin))))
719 (t 709 (t
720 (and (> (point) bottom) (recenter bottom-margin))))))) 710 (and (> (point) bottom) (recenter bottom-margin)))))))
721 (if edt-x-emacs19-p (setq zmacs-region-stays t))) 711 (if (featurep 'xemacs) (setq zmacs-region-stays t)))
722 712
723(defun edt-find-backward (&optional find) 713(defun edt-find-backward (&optional find)
724 "Find first occurrence of a string in the backward direction and save it. 714 "Find first occurrence of a string in the backward direction and save it.
@@ -743,7 +733,7 @@ Optional argument FIND is t if this function is called from `edt-find'."
743 (if (search-backward edt-find-last-text) 733 (if (search-backward edt-find-last-text)
744 (edt-set-match)) 734 (edt-set-match))
745 (and (< (point) top) (recenter (min beg top-margin)))) 735 (and (< (point) top) (recenter (min beg top-margin))))
746 (if edt-x-emacs19-p (setq zmacs-region-stays t))) 736 (if (featurep 'xemacs) (setq zmacs-region-stays t)))
747 737
748(defun edt-find () 738(defun edt-find ()
749 "Find first occurrence of string in current direction and save it." 739 "Find first occurrence of string in current direction and save it."
@@ -789,7 +779,7 @@ Optional argument FIND is t if this function is called from `edt-find'."
789 (progn 779 (progn
790 (backward-char 1) 780 (backward-char 1)
791 (error "Search failed: \"%s\"" edt-find-last-text)))) 781 (error "Search failed: \"%s\"" edt-find-last-text))))
792 (if edt-x-emacs19-p (setq zmacs-region-stays t))) 782 (if (featurep 'xemacs) (setq zmacs-region-stays t)))
793 783
794(defun edt-find-next-backward () 784(defun edt-find-next-backward ()
795 "Find next occurrence of a string in backward direction." 785 "Find next occurrence of a string in backward direction."
@@ -813,7 +803,7 @@ Optional argument FIND is t if this function is called from `edt-find'."
813 (progn 803 (progn
814 (edt-set-match) 804 (edt-set-match)
815 (and (< (point) top) (recenter (min beg top-margin)))))) 805 (and (< (point) top) (recenter (min beg top-margin))))))
816 (if edt-x-emacs19-p (setq zmacs-region-stays t))) 806 (if (featurep 'xemacs) (setq zmacs-region-stays t)))
817 807
818(defun edt-find-next () 808(defun edt-find-next ()
819 "Find next occurrence of a string in current direction." 809 "Find next occurrence of a string in current direction."
@@ -891,7 +881,7 @@ In select mode, selected text is highlighted."
891(defun edt-reset () 881(defun edt-reset ()
892 "Cancel text selection." 882 "Cancel text selection."
893 (interactive) 883 (interactive)
894 (if edt-gnu-emacs19-p 884 (if (featurep 'emacs)
895 (deactivate-mark) 885 (deactivate-mark)
896 (zmacs-deactivate-region))) 886 (zmacs-deactivate-region)))
897 887
@@ -1108,7 +1098,7 @@ Also, execute command specified if in Minibuffer."
1108 (if (string-equal " *Minibuf" 1098 (if (string-equal " *Minibuf"
1109 (substring (buffer-name) 0 (min (length (buffer-name)) 9))) 1099 (substring (buffer-name) 0 (min (length (buffer-name)) 9)))
1110 (exit-minibuffer)) 1100 (exit-minibuffer))
1111 (if edt-x-emacs19-p (setq zmacs-region-stays t))) 1101 (if (featurep 'xemacs) (setq zmacs-region-stays t)))
1112 1102
1113 1103
1114;;; 1104;;;
@@ -1124,7 +1114,7 @@ Also, execute command specified if in Minibuffer."
1124 (if (string-equal " *Minibuf" 1114 (if (string-equal " *Minibuf"
1125 (substring (buffer-name) 0 (min (length (buffer-name)) 9))) 1115 (substring (buffer-name) 0 (min (length (buffer-name)) 9)))
1126 (exit-minibuffer)) 1116 (exit-minibuffer))
1127 (if edt-x-emacs19-p (setq zmacs-region-stays t))) 1117 (if (featurep 'xemacs) (setq zmacs-region-stays t)))
1128 1118
1129 1119
1130;;; 1120;;;
@@ -1174,12 +1164,12 @@ Argument NUM is the numbers of consecutive characters to change."
1174The current key definition is saved in `edt-last-replaced-key-definition'. 1164The current key definition is saved in `edt-last-replaced-key-definition'.
1175Use `edt-restore-key' to restore last replaced key definition." 1165Use `edt-restore-key' to restore last replaced key definition."
1176 (interactive) 1166 (interactive)
1177 (if edt-x-emacs19-p (setq zmacs-region-stays t)) 1167 (if (featurep 'xemacs) (setq zmacs-region-stays t))
1178 (let (edt-function 1168 (let (edt-function
1179 edt-key-definition) 1169 edt-key-definition)
1180 (setq edt-key-definition 1170 (setq edt-key-definition
1181 (read-key-sequence "Press the key to be defined: ")) 1171 (read-key-sequence "Press the key to be defined: "))
1182 (if (if edt-gnu-emacs19-p 1172 (if (if (featurep 'emacs)
1183 (string-equal "\C-m" edt-key-definition) 1173 (string-equal "\C-m" edt-key-definition)
1184 (string-equal "\C-m" (events-to-keys edt-key-definition))) 1174 (string-equal "\C-m" (events-to-keys edt-key-definition)))
1185 (message "Key not defined") 1175 (message "Key not defined")
@@ -1259,7 +1249,7 @@ Argument LINES is the number of lines the cursor moved toward the bottom."
1259 ;; subtract 1 from height because it includes mode line 1249 ;; subtract 1 from height because it includes mode line
1260 (difference (- height margin 1))) 1250 (difference (- height margin 1)))
1261 (cond ((> beg difference) (recenter beg)) 1251 (cond ((> beg difference) (recenter beg))
1262 ((and edt-x-emacs19-p (> (+ beg lines 1) difference)) 1252 ((and (featurep 'xemacs) (> (+ beg lines 1) difference))
1263 (recenter (- margin))) 1253 (recenter (- margin)))
1264 ((> (+ beg lines) difference) (recenter (- margin)))))) 1254 ((> (+ beg lines) difference) (recenter (- margin))))))
1265 1255
@@ -1363,7 +1353,7 @@ Argument NUM is the positive number of sentences to move."
1363 (recenter (- left bottom-up-margin)))) 1353 (recenter (- left bottom-up-margin))))
1364 (t 1354 (t
1365 (and (> (point) bottom) (recenter bottom-margin))))) 1355 (and (> (point) bottom) (recenter bottom-margin)))))
1366 (if edt-x-emacs19-p (setq zmacs-region-stays t))) 1356 (if (featurep 'xemacs) (setq zmacs-region-stays t)))
1367 1357
1368(defun edt-sentence-backward (num) 1358(defun edt-sentence-backward (num)
1369 "Move backward to next sentence beginning. 1359 "Move backward to next sentence beginning.
@@ -1389,7 +1379,7 @@ Argument NUM is the positive number of sentences to move."
1389 (error "End of buffer")) 1379 (error "End of buffer"))
1390 (backward-sentence num)) 1380 (backward-sentence num))
1391 (and (< (point) top) (recenter (min beg top-margin)))) 1381 (and (< (point) top) (recenter (min beg top-margin))))
1392 (if edt-x-emacs19-p (setq zmacs-region-stays t))) 1382 (if (featurep 'xemacs) (setq zmacs-region-stays t)))
1393 1383
1394(defun edt-sentence (num) 1384(defun edt-sentence (num)
1395 "Move in current direction to next sentence. 1385 "Move in current direction to next sentence.
@@ -1434,7 +1424,7 @@ Argument NUM is the positive number of paragraphs to move."
1434 (recenter (- left bottom-up-margin)))) 1424 (recenter (- left bottom-up-margin))))
1435 (t 1425 (t
1436 (and (> (point) bottom) (recenter bottom-margin))))) 1426 (and (> (point) bottom) (recenter bottom-margin)))))
1437 (if edt-x-emacs19-p (setq zmacs-region-stays t))) 1427 (if (featurep 'xemacs) (setq zmacs-region-stays t)))
1438 1428
1439(defun edt-paragraph-backward (num) 1429(defun edt-paragraph-backward (num)
1440 "Move backward to beginning of paragraph. 1430 "Move backward to beginning of paragraph.
@@ -1459,7 +1449,7 @@ Argument NUM is the positive number of paragraphs to move."
1459 (start-of-paragraph-text) 1449 (start-of-paragraph-text)
1460 (setq num (1- num))) 1450 (setq num (1- num)))
1461 (and (< (point) top) (recenter (min beg top-margin)))) 1451 (and (< (point) top) (recenter (min beg top-margin))))
1462 (if edt-x-emacs19-p (setq zmacs-region-stays t))) 1452 (if (featurep 'xemacs) (setq zmacs-region-stays t)))
1463 1453
1464(defun edt-paragraph (num) 1454(defun edt-paragraph (num)
1465 "Move in current direction to next paragraph. 1455 "Move in current direction to next paragraph.
@@ -1477,20 +1467,20 @@ Argument NUM is the positive number of paragraphs to move."
1477 "Restore last replaced key definition. 1467 "Restore last replaced key definition.
1478Definition is stored in `edt-last-replaced-key-definition'." 1468Definition is stored in `edt-last-replaced-key-definition'."
1479 (interactive) 1469 (interactive)
1480 (if edt-x-emacs19-p (setq zmacs-region-stays t)) 1470 (if (featurep 'xemacs) (setq zmacs-region-stays t))
1481 (if edt-last-replaced-key-definition 1471 (if edt-last-replaced-key-definition
1482 (progn 1472 (progn
1483 (let (edt-key-definition) 1473 (let (edt-key-definition)
1484 (set 'edt-key-definition 1474 (set 'edt-key-definition
1485 (read-key-sequence "Press the key to be restored: ")) 1475 (read-key-sequence "Press the key to be restored: "))
1486 (if (if edt-gnu-emacs19-p 1476 (if (if (featurep 'emacs)
1487 (string-equal "\C-m" edt-key-definition) 1477 (string-equal "\C-m" edt-key-definition)
1488 (string-equal "\C-m" (events-to-keys edt-key-definition))) 1478 (string-equal "\C-m" (events-to-keys edt-key-definition)))
1489 (message "Key not restored") 1479 (message "Key not restored")
1490 (progn 1480 (progn
1491 (define-key (current-global-map) 1481 (define-key (current-global-map)
1492 edt-key-definition edt-last-replaced-key-definition) 1482 edt-key-definition edt-last-replaced-key-definition)
1493 (if edt-gnu-emacs19-p 1483 (if (featurep 'emacs)
1494 (message "Key definition for %s has been restored." 1484 (message "Key definition for %s has been restored."
1495 edt-key-definition) 1485 edt-key-definition)
1496 (message "Key definition for %s has been restored." 1486 (message "Key definition for %s has been restored."
@@ -1507,7 +1497,7 @@ Definition is stored in `edt-last-replaced-key-definition'."
1507 (let ((start-column (current-column))) 1497 (let ((start-column (current-column)))
1508 (move-to-window-line 0) 1498 (move-to-window-line 0)
1509 (move-to-column start-column)) 1499 (move-to-column start-column))
1510 (if edt-x-emacs19-p (setq zmacs-region-stays t))) 1500 (if (featurep 'xemacs) (setq zmacs-region-stays t)))
1511 1501
1512;;; 1502;;;
1513;;; WINDOW BOTTOM 1503;;; WINDOW BOTTOM
@@ -1519,7 +1509,7 @@ Definition is stored in `edt-last-replaced-key-definition'."
1519 (let ((start-column (current-column))) 1509 (let ((start-column (current-column)))
1520 (move-to-window-line (- (window-height) 2)) 1510 (move-to-window-line (- (window-height) 2))
1521 (move-to-column start-column)) 1511 (move-to-column start-column))
1522 (if edt-x-emacs19-p (setq zmacs-region-stays t))) 1512 (if (featurep 'xemacs) (setq zmacs-region-stays t)))
1523 1513
1524;;; 1514;;;
1525;;; SCROLL WINDOW LINE 1515;;; SCROLL WINDOW LINE
@@ -1529,13 +1519,13 @@ Definition is stored in `edt-last-replaced-key-definition'."
1529 "Move window forward one line leaving cursor at position in window." 1519 "Move window forward one line leaving cursor at position in window."
1530 (interactive) 1520 (interactive)
1531 (scroll-up 1) 1521 (scroll-up 1)
1532 (if edt-x-emacs19-p (setq zmacs-region-stays t))) 1522 (if (featurep 'xemacs) (setq zmacs-region-stays t)))
1533 1523
1534(defun edt-scroll-window-backward-line () 1524(defun edt-scroll-window-backward-line ()
1535 "Move window backward one line leaving cursor at position in window." 1525 "Move window backward one line leaving cursor at position in window."
1536 (interactive) 1526 (interactive)
1537 (scroll-down 1) 1527 (scroll-down 1)
1538 (if edt-x-emacs19-p (setq zmacs-region-stays t))) 1528 (if (featurep 'xemacs) (setq zmacs-region-stays t)))
1539 1529
1540(defun edt-scroll-line () 1530(defun edt-scroll-line ()
1541 "Move window one line in current direction." 1531 "Move window one line in current direction."
@@ -1582,7 +1572,7 @@ Argument NUM is the positive number of windows to move."
1582 "Move the current line to the bottom of the window." 1572 "Move the current line to the bottom of the window."
1583 (interactive) 1573 (interactive)
1584 (recenter -1) 1574 (recenter -1)
1585 (if edt-x-emacs19-p (setq zmacs-region-stays t))) 1575 (if (featurep 'xemacs) (setq zmacs-region-stays t)))
1586 1576
1587;;; 1577;;;
1588;;; LINE TO TOP OF WINDOW 1578;;; LINE TO TOP OF WINDOW
@@ -1592,7 +1582,7 @@ Argument NUM is the positive number of windows to move."
1592 "Move the current line to the top of the window." 1582 "Move the current line to the top of the window."
1593 (interactive) 1583 (interactive)
1594 (recenter 0) 1584 (recenter 0)
1595 (if edt-x-emacs19-p (setq zmacs-region-stays t))) 1585 (if (featurep 'xemacs) (setq zmacs-region-stays t)))
1596 1586
1597;;; 1587;;;
1598;;; LINE TO MIDDLE OF WINDOW 1588;;; LINE TO MIDDLE OF WINDOW
@@ -1602,7 +1592,7 @@ Argument NUM is the positive number of windows to move."
1602 "Move window so line with cursor is in the middle of the window." 1592 "Move window so line with cursor is in the middle of the window."
1603 (interactive) 1593 (interactive)
1604 (recenter '(4)) 1594 (recenter '(4))
1605 (if edt-x-emacs19-p (setq zmacs-region-stays t))) 1595 (if (featurep 'xemacs) (setq zmacs-region-stays t)))
1606 1596
1607;;; 1597;;;
1608;;; GOTO PERCENTAGE 1598;;; GOTO PERCENTAGE
@@ -1615,7 +1605,7 @@ Argument NUM is the percentage into the buffer to move."
1615 (if (or (> num 100) (< num 0)) 1605 (if (or (> num 100) (< num 0))
1616 (error "Percentage %d out of range 0 < percent < 100" num) 1606 (error "Percentage %d out of range 0 < percent < 100" num)
1617 (goto-char (/ (* (point-max) num) 100))) 1607 (goto-char (/ (* (point-max) num) 100)))
1618 (if edt-x-emacs19-p (setq zmacs-region-stays t))) 1608 (if (featurep 'xemacs) (setq zmacs-region-stays t)))
1619 1609
1620;;; 1610;;;
1621;;; FILL REGION 1611;;; FILL REGION
@@ -1785,7 +1775,7 @@ Argument NUM is the number of times to duplicate the line."
1785(defun edt-display-the-time () 1775(defun edt-display-the-time ()
1786 "Display the current time." 1776 "Display the current time."
1787 (interactive) 1777 (interactive)
1788 (if edt-x-emacs19-p (setq zmacs-region-stays t)) 1778 (if (featurep 'xemacs) (setq zmacs-region-stays t))
1789 (message "%s" (current-time-string))) 1779 (message "%s" (current-time-string)))
1790 1780
1791;;; 1781;;;
@@ -1813,7 +1803,7 @@ Argument NUM is the number of times to duplicate the line."
1813 (let (edt-key-definition) 1803 (let (edt-key-definition)
1814 (set 'edt-key-definition 1804 (set 'edt-key-definition
1815 (read-key-sequence "Enter key for binding: ")) 1805 (read-key-sequence "Enter key for binding: "))
1816 (if (if edt-gnu-emacs19-p 1806 (if (if (featurep 'emacs)
1817 (string-equal "\C-m" edt-key-definition) 1807 (string-equal "\C-m" edt-key-definition)
1818 (string-equal "\C-m" (events-to-keys edt-key-definition))) 1808 (string-equal "\C-m" (events-to-keys edt-key-definition)))
1819 (message "Key sequence not remembered") 1809 (message "Key sequence not remembered")
@@ -1866,7 +1856,7 @@ Warn user that modifications will be lost."
1866 (interactive) 1856 (interactive)
1867 (split-window) 1857 (split-window)
1868 (other-window 1) 1858 (other-window 1)
1869 (if edt-x-emacs19-p (setq zmacs-region-stays t))) 1859 (if (featurep 'xemacs) (setq zmacs-region-stays t)))
1870 1860
1871;;; 1861;;;
1872;;; COPY RECTANGLE 1862;;; COPY RECTANGLE
@@ -2152,7 +2142,7 @@ created."
2152 (setq edt-term term)))) 2142 (setq edt-term term))))
2153 (edt-load-keys nil)) 2143 (edt-load-keys nil))
2154 ;; Make highlighting of selected text work properly for EDT commands. 2144 ;; Make highlighting of selected text work properly for EDT commands.
2155 (if edt-gnu-emacs19-p 2145 (if (featurep 'emacs)
2156 (progn 2146 (progn
2157 (setq edt-orig-transient-mark-mode transient-mark-mode) 2147 (setq edt-orig-transient-mark-mode transient-mark-mode)
2158 (add-hook 'activate-mark-hook 2148 (add-hook 'activate-mark-hook
@@ -2188,7 +2178,7 @@ created."
2188 (setq edt-select-mode-current nil) 2178 (setq edt-select-mode-current nil)
2189 (edt-reset) 2179 (edt-reset)
2190 (force-mode-line-update t) 2180 (force-mode-line-update t)
2191 (if edt-gnu-emacs19-p 2181 (if (featurep 'emacs)
2192 (setq transient-mark-mode edt-orig-transient-mark-mode)) 2182 (setq transient-mark-mode edt-orig-transient-mark-mode))
2193 (message "Original key bindings restored; EDT Emulation disabled")) 2183 (message "Original key bindings restored; EDT Emulation disabled"))
2194 2184
@@ -2203,7 +2193,7 @@ Optional argument USER-SETUP non-nil means called from function
2203 ;; disturbing the original bindings in global-map. 2193 ;; disturbing the original bindings in global-map.
2204 (fset 'edt-default-ESC-prefix (copy-keymap 'ESC-prefix)) 2194 (fset 'edt-default-ESC-prefix (copy-keymap 'ESC-prefix))
2205 (setq edt-default-global-map (copy-keymap (current-global-map))) 2195 (setq edt-default-global-map (copy-keymap (current-global-map)))
2206 (if edt-gnu-emacs19-p 2196 (if (featurep 'emacs)
2207 (define-key edt-default-global-map "\e" 'edt-default-ESC-prefix) 2197 (define-key edt-default-global-map "\e" 'edt-default-ESC-prefix)
2208 (define-key edt-default-global-map [escape] 'edt-default-ESC-prefix)) 2198 (define-key edt-default-global-map [escape] 'edt-default-ESC-prefix))
2209 (define-prefix-command 'edt-default-gold-map) 2199 (define-prefix-command 'edt-default-gold-map)
@@ -2239,7 +2229,7 @@ Optional argument USER-SETUP non-nil means called from function
2239 ;; Setup user EDT global map by copying default EDT global map bindings. 2229 ;; Setup user EDT global map by copying default EDT global map bindings.
2240 (fset 'edt-user-ESC-prefix (copy-keymap 'edt-default-ESC-prefix)) 2230 (fset 'edt-user-ESC-prefix (copy-keymap 'edt-default-ESC-prefix))
2241 (setq edt-user-global-map (copy-keymap edt-default-global-map)) 2231 (setq edt-user-global-map (copy-keymap edt-default-global-map))
2242 (if edt-gnu-emacs19-p 2232 (if (featurep 'emacs)
2243 (define-key edt-user-global-map "\e" 'edt-user-ESC-prefix) 2233 (define-key edt-user-global-map "\e" 'edt-user-ESC-prefix)
2244 (define-key edt-user-global-map [escape] 'edt-user-ESC-prefix)) 2234 (define-key edt-user-global-map [escape] 'edt-user-ESC-prefix))
2245 ;; If terminal has additional function keys, the user's initialization 2235 ;; If terminal has additional function keys, the user's initialization
@@ -2253,7 +2243,7 @@ Optional argument USER-SETUP non-nil means called from function
2253(defun edt-select-default-global-map() 2243(defun edt-select-default-global-map()
2254 "Select default EDT emulation key bindings." 2244 "Select default EDT emulation key bindings."
2255 (interactive) 2245 (interactive)
2256 (if edt-gnu-emacs19-p 2246 (if (featurep 'emacs)
2257 (transient-mark-mode 1)) 2247 (transient-mark-mode 1))
2258 (use-global-map edt-default-global-map) 2248 (use-global-map edt-default-global-map)
2259 (if (not edt-keep-current-page-delimiter) 2249 (if (not edt-keep-current-page-delimiter)
@@ -2271,7 +2261,7 @@ Optional argument USER-SETUP non-nil means called from function
2271 (interactive) 2261 (interactive)
2272 (if edt-user-map-configured 2262 (if edt-user-map-configured
2273 (progn 2263 (progn
2274 (if edt-gnu-emacs19-p 2264 (if (featurep 'emacs)
2275 (transient-mark-mode 1)) 2265 (transient-mark-mode 1))
2276 (use-global-map edt-user-global-map) 2266 (use-global-map edt-user-global-map)
2277 (if (not edt-keep-current-page-delimiter) 2267 (if (not edt-keep-current-page-delimiter)
diff --git a/lisp/emulation/tpu-mapper.el b/lisp/emulation/tpu-mapper.el
index 3e5af7a38bd..b3ad67ec4df 100644
--- a/lisp/emulation/tpu-mapper.el
+++ b/lisp/emulation/tpu-mapper.el
@@ -78,13 +78,6 @@
78 78
79 79
80;;; 80;;;
81;;; Decide whether we're running Lucid Emacs or Emacs itself.
82;;;
83(defconst tpu-lucid-emacs19-p (string-match "Lucid" emacs-version)
84 "Non-nil if we are running Lucid Emacs version 19.")
85
86
87;;;
88;;; Key variables 81;;; Key variables
89;;; 82;;;
90(defvar tpu-kp4 nil) 83(defvar tpu-kp4 nil)
@@ -100,7 +93,7 @@
100;;; 93;;;
101;;; Make sure the window is big enough to display the instructions 94;;; Make sure the window is big enough to display the instructions
102;;; 95;;;
103(if tpu-lucid-emacs19-p (set-screen-size (selected-screen) 80 36) 96(if (featurep 'xemacs) (set-screen-size (selected-screen) 80 36)
104 (set-frame-size (selected-frame) 80 36)) 97 (set-frame-size (selected-frame) 80 36))
105 98
106 99
@@ -167,7 +160,7 @@
167;;; Save <CR> for future reference 160;;; Save <CR> for future reference
168;;; 161;;;
169(cond 162(cond
170 (tpu-lucid-emacs19-p 163 ((featurep 'xemacs)
171 (setq tpu-return-seq (read-key-sequence "Hit carriage-return <CR> to continue ")) 164 (setq tpu-return-seq (read-key-sequence "Hit carriage-return <CR> to continue "))
172 (setq tpu-return (concat "[" (format "%s" (event-key (aref tpu-return-seq 0))) "]"))) 165 (setq tpu-return (concat "[" (format "%s" (event-key (aref tpu-return-seq 0))) "]")))
173 (t 166 (t
@@ -179,42 +172,29 @@
179;;; 172;;;
180;;; Key mapping functions 173;;; Key mapping functions
181;;; 174;;;
182(defun tpu-lucid-map-key (ident descrip func gold-func) 175(defun tpu-map-key (ident descrip func gold-func)
183 (interactive) 176 (interactive)
184 (setq tpu-key-seq (read-key-sequence (format "Press %s%s: " ident descrip))) 177 (if (featurep 'xemacs)
185 (setq tpu-key (concat "[" (format "%s" (event-key (aref tpu-key-seq 0))) "]")) 178 (progn
186 (cond ((not (equal tpu-key tpu-return)) 179 (setq tpu-key-seq (read-key-sequence
187 (set-buffer "Keys") 180 (format "Press %s%s: " ident descrip))
188 (insert (format"(global-set-key %s %s)\n" tpu-key func)) 181 tpu-key (format "[%s]" (event-key (aref tpu-key-seq 0))))
189 (set-buffer "Gold-Keys") 182 (unless (equal tpu-key tpu-return)
190 (insert (format "(define-key GOLD-map %s %s)\n" tpu-key gold-func)) 183 (set-buffer "Keys")
191 (set-buffer "Directions")) 184 (insert (format"(global-set-key %s %s)\n" tpu-key func))
192 ;; bogosity to get next prompt to come up, if the user hits <CR>! 185 (set-buffer "Gold-Keys")
193 ;; check periodically to see if this is still needed... 186 (insert (format "(define-key GOLD-map %s %s)\n" tpu-key gold-func))))
194 (t 187 (message "Press %s%s: " ident descrip)
195 (format "%s" tpu-key))) 188 (setq tpu-key-seq (read-event)
189 tpu-key (format "[%s]" tpu-key-seq))
190 (unless (equal tpu-key tpu-return)
191 (set-buffer "Keys")
192 (insert (format"(define-key tpu-global-map %s %s)\n" tpu-key func))
193 (set-buffer "Gold-Keys")
194 (insert (format "(define-key tpu-gold-map %s %s)\n" tpu-key gold-func))))
195 (set-buffer "Directions")
196 tpu-key) 196 tpu-key)
197 197
198(defun tpu-emacs-map-key (ident descrip func gold-func)
199 (interactive)
200 (message "Press %s%s: " ident descrip)
201 (setq tpu-key-seq (read-event))
202 (setq tpu-key (concat "[" (format "%s" tpu-key-seq) "]"))
203 (cond ((not (equal tpu-key tpu-return))
204 (set-buffer "Keys")
205 (insert (format"(define-key tpu-global-map %s %s)\n" tpu-key func))
206 (set-buffer "Gold-Keys")
207 (insert (format "(define-key tpu-gold-map %s %s)\n" tpu-key gold-func))
208 (set-buffer "Directions"))
209 ;; bogosity to get next prompt to come up, if the user hits <CR>!
210 ;; check periodically to see if this is still needed...
211 (t
212 (format "%s" tpu-key)))
213 tpu-key)
214
215(fset 'tpu-map-key (if tpu-lucid-emacs19-p 'tpu-lucid-map-key 'tpu-emacs-map-key))
216
217
218(set-buffer "Keys") 198(set-buffer "Keys")
219(insert " 199(insert "
220;; Arrows 200;; Arrows
@@ -350,7 +330,7 @@
350;; 330;;
351") 331")
352 332
353(cond (tpu-lucid-emacs19-p 333(cond ((featurep 'xemacs)
354 (insert (format "(setq tpu-help-enter \"%s\")\n" tpu-enter-seq)) 334 (insert (format "(setq tpu-help-enter \"%s\")\n" tpu-enter-seq))
355 (insert (format "(setq tpu-help-return \"%s\")\n" tpu-return-seq)) 335 (insert (format "(setq tpu-help-return \"%s\")\n" tpu-return-seq))
356 (insert "(setq tpu-help-N \"[#<keypress-event N>]\")\n") 336 (insert "(setq tpu-help-N \"[#<keypress-event N>]\")\n")
@@ -368,7 +348,7 @@
368;;; 348;;;
369(let ((file 349(let ((file
370 (convert-standard-filename 350 (convert-standard-filename
371 (if tpu-lucid-emacs19-p "~/.tpu-lucid-keys" "~/.tpu-keys")))) 351 (if (featurep 'xemacs) "~/.tpu-lucid-keys" "~/.tpu-keys"))))
372 (set-visited-file-name 352 (set-visited-file-name
373 (read-file-name (format "Save key mapping to file (default %s): " file) "" file))) 353 (read-file-name (format "Save key mapping to file (default %s): " file) "" file)))
374(save-buffer) 354(save-buffer)
diff --git a/lisp/emulation/vip.el b/lisp/emulation/vip.el
index c2d00a8ffba..e6fdd55f7c4 100644
--- a/lisp/emulation/vip.el
+++ b/lisp/emulation/vip.el
@@ -874,7 +874,7 @@ is the name of the register for COM."
874 (set-mark beg)) 874 (set-mark beg))
875 (beginning-of-line) 875 (beginning-of-line)
876 (exchange-point-and-mark) 876 (exchange-point-and-mark)
877 (if (or (not (eobp)) (not (bolp))) (next-line 1)) 877 (if (or (not (eobp)) (not (bolp))) (with-no-warnings (next-line 1)))
878 (beginning-of-line) 878 (beginning-of-line)
879 (if (> beg end) (exchange-point-and-mark))) 879 (if (> beg end) (exchange-point-and-mark)))
880 880
@@ -1050,7 +1050,7 @@ command was invoked with argument > 1."
1050(defun vip-line (arg) 1050(defun vip-line (arg)
1051 (let ((val (car arg)) (com (cdr arg))) 1051 (let ((val (car arg)) (com (cdr arg)))
1052 (move-marker vip-com-point (point)) 1052 (move-marker vip-com-point (point))
1053 (next-line (1- val)) 1053 (with-no-warnings (next-line (1- val)))
1054 (vip-execute-com 'vip-line val com))) 1054 (vip-execute-com 'vip-line val com)))
1055 1055
1056(defun vip-yank-line (arg) 1056(defun vip-yank-line (arg)
@@ -1263,7 +1263,7 @@ beginning of buffer, stop and signal error."
1263 (interactive "P") 1263 (interactive "P")
1264 (let ((val (vip-p-val arg)) (com (vip-getCom arg))) 1264 (let ((val (vip-p-val arg)) (com (vip-getCom arg)))
1265 (if com (move-marker vip-com-point (point))) 1265 (if com (move-marker vip-com-point (point)))
1266 (next-line val) 1266 (with-no-warnings (next-line val))
1267 (back-to-indentation) 1267 (back-to-indentation)
1268 (if com (vip-execute-com 'vip-next-line-at-bol val com)))) 1268 (if com (vip-execute-com 'vip-next-line-at-bol val com))))
1269 1269
@@ -1272,7 +1272,7 @@ beginning of buffer, stop and signal error."
1272 (interactive "P") 1272 (interactive "P")
1273 (let ((val (vip-p-val arg)) (com (vip-getCom arg))) 1273 (let ((val (vip-p-val arg)) (com (vip-getCom arg)))
1274 (if com (move-marker vip-com-point (point))) 1274 (if com (move-marker vip-com-point (point)))
1275 (next-line (- val)) 1275 (with-no-warnings (next-line (- val)))
1276 (setq this-command 'previous-line) 1276 (setq this-command 'previous-line)
1277 (if com (vip-execute-com 'vip-previous-line val com)))) 1277 (if com (vip-execute-com 'vip-previous-line val com))))
1278 1278
@@ -1281,7 +1281,7 @@ beginning of buffer, stop and signal error."
1281 (interactive "P") 1281 (interactive "P")
1282 (let ((val (vip-p-val arg)) (com (vip-getCom arg))) 1282 (let ((val (vip-p-val arg)) (com (vip-getCom arg)))
1283 (if com (move-marker vip-com-point (point))) 1283 (if com (move-marker vip-com-point (point)))
1284 (next-line (- val)) 1284 (with-no-warnings (next-line (- val)))
1285 (back-to-indentation) 1285 (back-to-indentation)
1286 (if com (vip-execute-com 'vip-previous-line val com)))) 1286 (if com (vip-execute-com 'vip-previous-line val com))))
1287 1287
@@ -1323,7 +1323,7 @@ after search."
1323 ;; forward search begins here 1323 ;; forward search begins here
1324 (if (eolp) (error "") (point)) 1324 (if (eolp) (error "") (point))
1325 ;; forward search ends here 1325 ;; forward search ends here
1326 (progn (next-line 1) (beginning-of-line) (point))) 1326 (progn (with-no-warnings (next-line 1)) (beginning-of-line) (point)))
1327 (narrow-to-region 1327 (narrow-to-region
1328 ;; backward search begins from here 1328 ;; backward search begins from here
1329 (if (bolp) (error "") (point)) 1329 (if (bolp) (error "") (point))
@@ -1803,7 +1803,7 @@ STRING. Search will be forward if FORWARD, otherwise backward."
1803 (setq vip-use-register nil) 1803 (setq vip-use-register nil)
1804 (if (vip-end-with-a-newline-p text) 1804 (if (vip-end-with-a-newline-p text)
1805 (progn 1805 (progn
1806 (next-line 1) 1806 (with-no-warnings (next-line 1))
1807 (beginning-of-line)) 1807 (beginning-of-line))
1808 (if (and (not (eolp)) (not (eobp))) (forward-char))) 1808 (if (and (not (eolp)) (not (eobp))) (forward-char)))
1809 (setq vip-d-com (list 'vip-put-back val nil vip-use-register)) 1809 (setq vip-d-com (list 'vip-put-back val nil vip-use-register))
@@ -2883,7 +2883,7 @@ a token has type \(command, address, end-mark\) and value."
2883 (let ((point (if (null ex-addresses) (point) (car ex-addresses))) 2883 (let ((point (if (null ex-addresses) (point) (car ex-addresses)))
2884 (variant nil) command file) 2884 (variant nil) command file)
2885 (goto-char point) 2885 (goto-char point)
2886 (if (not (= point 0)) (next-line 1)) 2886 (if (not (= point 0)) (with-no-warnings (next-line 1)))
2887 (beginning-of-line) 2887 (beginning-of-line)
2888 (save-window-excursion 2888 (save-window-excursion
2889 (set-buffer " *ex-working-space*") 2889 (set-buffer " *ex-working-space*")
diff --git a/lisp/emulation/viper-cmd.el b/lisp/emulation/viper-cmd.el
index 82dc312cf28..5e13edb9495 100644
--- a/lisp/emulation/viper-cmd.el
+++ b/lisp/emulation/viper-cmd.el
@@ -834,7 +834,7 @@ Vi's prefix argument will be used. Otherwise, the prefix argument passed to
834 viper-emacs-kbd-minor-mode 834 viper-emacs-kbd-minor-mode
835 ch) 835 ch)
836 (cond ((and viper-special-input-method 836 (cond ((and viper-special-input-method
837 viper-emacs-p 837 (featurep 'emacs)
838 (fboundp 'quail-input-method)) 838 (fboundp 'quail-input-method))
839 ;; (let ...) is used to restore unread-command-events to the 839 ;; (let ...) is used to restore unread-command-events to the
840 ;; original state. We don't want anything left in there after 840 ;; original state. We don't want anything left in there after
@@ -861,7 +861,7 @@ Vi's prefix argument will be used. Otherwise, the prefix argument passed to
861 (1- (length quail-current-str))))) 861 (1- (length quail-current-str)))))
862 )) 862 ))
863 ((and viper-special-input-method 863 ((and viper-special-input-method
864 viper-xemacs-p 864 (featurep 'xemacs)
865 (fboundp 'quail-start-translation)) 865 (fboundp 'quail-start-translation))
866 ;; same as above but for XEmacs, which doesn't have 866 ;; same as above but for XEmacs, which doesn't have
867 ;; quail-input-method 867 ;; quail-input-method
@@ -893,7 +893,7 @@ Vi's prefix argument will be used. Otherwise, the prefix argument passed to
893 (t 893 (t
894 ;;(setq ch (read-char-exclusive)) 894 ;;(setq ch (read-char-exclusive))
895 (setq ch (aref (read-key-sequence nil) 0)) 895 (setq ch (aref (read-key-sequence nil) 0))
896 (if viper-xemacs-p 896 (if (featurep 'xemacs)
897 (setq ch (event-to-character ch))) 897 (setq ch (event-to-character ch)))
898 ;; replace ^M with the newline 898 ;; replace ^M with the newline
899 (if (eq ch ?\C-m) (setq ch ?\n)) 899 (if (eq ch ?\C-m) (setq ch ?\n))
@@ -902,13 +902,13 @@ Vi's prefix argument will be used. Otherwise, the prefix argument passed to
902 (progn 902 (progn
903 ;;(setq ch (read-char-exclusive)) 903 ;;(setq ch (read-char-exclusive))
904 (setq ch (aref (read-key-sequence nil) 0)) 904 (setq ch (aref (read-key-sequence nil) 0))
905 (if viper-xemacs-p 905 (if (featurep 'xemacs)
906 (setq ch (event-to-character ch)))) 906 (setq ch (event-to-character ch))))
907 ) 907 )
908 (insert ch)) 908 (insert ch))
909 ) 909 )
910 (setq last-command-event 910 (setq last-command-event
911 (viper-copy-event (if viper-xemacs-p 911 (viper-copy-event (if (featurep 'xemacs)
912 (character-to-event ch) ch))) 912 (character-to-event ch) ch)))
913 ) ; let 913 ) ; let
914 (error nil) 914 (error nil)
@@ -1080,10 +1080,10 @@ as a Meta key and any number of multiple escapes is allowed."
1080 ;; and return ESC as the key-sequence 1080 ;; and return ESC as the key-sequence
1081 (viper-set-unread-command-events (viper-subseq keyseq 1)) 1081 (viper-set-unread-command-events (viper-subseq keyseq 1))
1082 (setq last-input-event event 1082 (setq last-input-event event
1083 keyseq (if viper-emacs-p 1083 keyseq (if (featurep 'emacs)
1084 "\e" 1084 "\e"
1085 (vector (character-to-event ?\e))))) 1085 (vector (character-to-event ?\e)))))
1086 ((and viper-xemacs-p 1086 ((and (featurep 'xemacs)
1087 (key-press-event-p first-key) 1087 (key-press-event-p first-key)
1088 (equal '(meta) key-mod)) 1088 (equal '(meta) key-mod))
1089 (viper-set-unread-command-events 1089 (viper-set-unread-command-events
@@ -1320,7 +1320,7 @@ as a Meta key and any number of multiple escapes is allowed."
1320 (setq last-command-char char) 1320 (setq last-command-char char)
1321 (setq last-command-event 1321 (setq last-command-event
1322 (viper-copy-event 1322 (viper-copy-event
1323 (if viper-xemacs-p (character-to-event char) char))) 1323 (if (featurep 'xemacs) (character-to-event char) char)))
1324 (condition-case err 1324 (condition-case err
1325 (funcall cmd-to-exec-at-end cmd-info) 1325 (funcall cmd-to-exec-at-end cmd-info)
1326 (error 1326 (error
@@ -1902,7 +1902,7 @@ With prefix argument, find next destructive command."
1902 (setq viper-intermediate-command 1902 (setq viper-intermediate-command
1903 'repeating-display-destructive-command) 1903 'repeating-display-destructive-command)
1904 ;; first search through command history--set temp ring 1904 ;; first search through command history--set temp ring
1905 (setq viper-temp-command-ring (copy-sequence viper-command-ring))) 1905 (setq viper-temp-command-ring (ring-copy viper-command-ring)))
1906 (setq cmd (if next 1906 (setq cmd (if next
1907 (viper-special-ring-rotate1 viper-temp-command-ring 1) 1907 (viper-special-ring-rotate1 viper-temp-command-ring 1)
1908 (viper-special-ring-rotate1 viper-temp-command-ring -1))) 1908 (viper-special-ring-rotate1 viper-temp-command-ring -1)))
@@ -1936,7 +1936,7 @@ to in the global map, instead of cycling through the insertion ring."
1936 (length viper-last-inserted-string-from-insertion-ring)))) 1936 (length viper-last-inserted-string-from-insertion-ring))))
1937 ) 1937 )
1938 ;;first search through insertion history 1938 ;;first search through insertion history
1939 (setq viper-temp-insertion-ring (copy-sequence viper-insertion-ring))) 1939 (setq viper-temp-insertion-ring (ring-copy viper-insertion-ring)))
1940 (setq this-command 'viper-insert-from-insertion-ring) 1940 (setq this-command 'viper-insert-from-insertion-ring)
1941 ;; so that things will be undone properly 1941 ;; so that things will be undone properly
1942 (setq buffer-undo-list (cons nil buffer-undo-list)) 1942 (setq buffer-undo-list (cons nil buffer-undo-list))
@@ -2790,7 +2790,8 @@ On reaching beginning of line, stop and signal error."
2790 2790
2791(defun viper-next-line-carefully (arg) 2791(defun viper-next-line-carefully (arg)
2792 (condition-case nil 2792 (condition-case nil
2793 (next-line arg) 2793 ;; do not use forward-line! need to keep column
2794 (with-no-warnings (next-line arg))
2794 (error nil))) 2795 (error nil)))
2795 2796
2796 2797
@@ -3089,7 +3090,8 @@ On reaching beginning of line, stop and signal error."
3089 (let ((val (viper-p-val arg)) 3090 (let ((val (viper-p-val arg))
3090 (com (viper-getCom arg))) 3091 (com (viper-getCom arg)))
3091 (if com (viper-move-marker-locally 'viper-com-point (point))) 3092 (if com (viper-move-marker-locally 'viper-com-point (point)))
3092 (next-line val) 3093 ;; do not use forward-line! need to keep column
3094 (with-no-warnings (next-line val))
3093 (if viper-ex-style-motion 3095 (if viper-ex-style-motion
3094 (if (and (eolp) (not (bolp))) (backward-char 1))) 3096 (if (and (eolp) (not (bolp))) (backward-char 1)))
3095 (setq this-command 'next-line) 3097 (setq this-command 'next-line)
@@ -3132,7 +3134,8 @@ If point is on a widget or a button, simulate clicking on that widget/button."
3132 (let ((val (viper-p-val arg)) 3134 (let ((val (viper-p-val arg))
3133 (com (viper-getCom arg))) 3135 (com (viper-getCom arg)))
3134 (if com (viper-move-marker-locally 'viper-com-point (point))) 3136 (if com (viper-move-marker-locally 'viper-com-point (point)))
3135 (previous-line val) 3137 ;; do not use forward-line! need to keep column
3138 (with-no-warnings (previous-line val))
3136 (if viper-ex-style-motion 3139 (if viper-ex-style-motion
3137 (if (and (eolp) (not (bolp))) (backward-char 1))) 3140 (if (and (eolp) (not (bolp))) (backward-char 1)))
3138 (setq this-command 'previous-line) 3141 (setq this-command 'previous-line)
diff --git a/lisp/emulation/viper-ex.el b/lisp/emulation/viper-ex.el
index 627d2ff1814..caeecd12c8a 100644
--- a/lisp/emulation/viper-ex.el
+++ b/lisp/emulation/viper-ex.el
@@ -651,17 +651,19 @@ reversed."
651 (setq initial-str (format "%d,%d" reg-beg-line reg-end-line))) 651 (setq initial-str (format "%d,%d" reg-beg-line reg-end-line)))
652 652
653 (setq com-str 653 (setq com-str
654 (or string (viper-read-string-with-history 654 (if string
655 ":" 655 (concat initial-str string)
656 initial-str 656 (viper-read-string-with-history
657 'viper-ex-history 657 ":"
658 ;; no default when working on region 658 initial-str
659 (if initial-str 659 'viper-ex-history
660 nil 660 ;; no default when working on region
661 (car viper-ex-history)) 661 (if initial-str
662 map 662 nil
663 (if initial-str 663 (car viper-ex-history))
664 " [Type command to execute on current region]")))) 664 map
665 (if initial-str
666 " [Type command to execute on current region]"))))
665 (save-window-excursion 667 (save-window-excursion
666 ;; just a precaution 668 ;; just a precaution
667 (setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name)) 669 (setq viper-ex-work-buf (get-buffer-create viper-ex-work-buf-name))
@@ -1101,7 +1103,7 @@ reversed."
1101 beg end cont val) 1103 beg end cont val)
1102 1104
1103 (viper-add-keymap ex-read-filename-map 1105 (viper-add-keymap ex-read-filename-map
1104 (if viper-emacs-p 1106 (if (featurep 'emacs)
1105 minibuffer-local-completion-map 1107 minibuffer-local-completion-map
1106 read-file-name-map)) 1108 read-file-name-map))
1107 1109
@@ -1556,7 +1558,7 @@ reversed."
1556 ;; setup buffer 1558 ;; setup buffer
1557 (if (setq wind (viper-get-visible-buffer-window buf)) 1559 (if (setq wind (viper-get-visible-buffer-window buf))
1558 () 1560 ()
1559 (setq wind (get-lru-window (if viper-xemacs-p nil 'visible))) 1561 (setq wind (get-lru-window (if (featurep 'xemacs) nil 'visible)))
1560 (set-window-buffer wind buf)) 1562 (set-window-buffer wind buf))
1561 1563
1562 (if (viper-window-display-p) 1564 (if (viper-window-display-p)
@@ -1876,7 +1878,7 @@ reversed."
1876 (condition-case nil 1878 (condition-case nil
1877 (progn 1879 (progn
1878 (pop-to-buffer (get-buffer-create "*info*")) 1880 (pop-to-buffer (get-buffer-create "*info*"))
1879 (info (if viper-xemacs-p "viper.info" "viper")) 1881 (info (if (featurep 'xemacs) "viper.info" "viper"))
1880 (message "Type `i' to search for a specific topic")) 1882 (message "Type `i' to search for a specific topic"))
1881 (error (beep 1) 1883 (error (beep 1)
1882 (with-output-to-temp-buffer " *viper-info*" 1884 (with-output-to-temp-buffer " *viper-info*"
@@ -1885,7 +1887,7 @@ The Info file for Viper does not seem to be installed.
1885 1887
1886This file is part of the standard distribution of %sEmacs. 1888This file is part of the standard distribution of %sEmacs.
1887Please contact your system administrator. " 1889Please contact your system administrator. "
1888 (if viper-xemacs-p "X" "") 1890 (if (featurep 'xemacs) "X" "")
1889 )))))) 1891 ))))))
1890 1892
1891;; Ex source command. Loads the file specified as argument or `~/.viper' 1893;; Ex source command. Loads the file specified as argument or `~/.viper'
diff --git a/lisp/emulation/viper-init.el b/lisp/emulation/viper-init.el
index 1b05ef7189d..1b1e07a0a0c 100644
--- a/lisp/emulation/viper-init.el
+++ b/lisp/emulation/viper-init.el
@@ -49,10 +49,6 @@
49 (interactive) 49 (interactive)
50 (message "Viper version is %s" viper-version)) 50 (message "Viper version is %s" viper-version))
51 51
52;; Is it XEmacs?
53(defconst viper-xemacs-p (featurep 'xemacs))
54;; Is it Emacs?
55(defconst viper-emacs-p (not viper-xemacs-p))
56;; Tell whether we are running as a window application or on a TTY 52;; Tell whether we are running as a window application or on a TTY
57 53
58;; This is used to avoid compilation warnings. When emacs/xemacs forms can 54;; This is used to avoid compilation warnings. When emacs/xemacs forms can
@@ -116,8 +112,8 @@ In all likelihood, you don't need to bother with this setting."
116 (cond ((viper-window-display-p)) 112 (cond ((viper-window-display-p))
117 (viper-force-faces) 113 (viper-force-faces)
118 ((viper-color-display-p)) 114 ((viper-color-display-p))
119 (viper-emacs-p (memq (viper-device-type) '(pc))) 115 ((featurep 'emacs) (memq (viper-device-type) '(pc)))
120 (viper-xemacs-p (memq (viper-device-type) '(tty pc))))) 116 ((featurep 'xemacs) (memq (viper-device-type) '(tty pc)))))
121 117
122 118
123;;; Macros 119;;; Macros
@@ -356,9 +352,9 @@ Use `M-x viper-set-expert-level' to change this.")
356 ""))))) 352 "")))))
357 353
358(defun viper-inactivate-input-method () 354(defun viper-inactivate-input-method ()
359 (cond ((and viper-emacs-p (fboundp 'inactivate-input-method)) 355 (cond ((and (featurep 'emacs) (fboundp 'inactivate-input-method))
360 (inactivate-input-method)) 356 (inactivate-input-method))
361 ((and viper-xemacs-p (boundp 'current-input-method)) 357 ((and (featurep 'xemacs) (boundp 'current-input-method))
362 ;; XEmacs had broken quil-mode for some time, so we are working around 358 ;; XEmacs had broken quil-mode for some time, so we are working around
363 ;; it here 359 ;; it here
364 (setq quail-mode nil) 360 (setq quail-mode nil)
@@ -370,7 +366,7 @@ Use `M-x viper-set-expert-level' to change this.")
370 (force-mode-line-update)) 366 (force-mode-line-update))
371 )) 367 ))
372(defun viper-activate-input-method () 368(defun viper-activate-input-method ()
373 (cond ((and viper-emacs-p (fboundp 'activate-input-method)) 369 (cond ((and (featurep 'emacs) (fboundp 'activate-input-method))
374 (activate-input-method default-input-method)) 370 (activate-input-method default-input-method))
375 ((featurep 'xemacs) 371 ((featurep 'xemacs)
376 (if (fboundp 'quail-mode) (quail-mode 1))))) 372 (if (fboundp 'quail-mode) (quail-mode 1)))))
@@ -475,7 +471,7 @@ is non-nil."
475 :group 'viper) 471 :group 'viper)
476(defcustom viper-use-replace-region-delimiters 472(defcustom viper-use-replace-region-delimiters
477 (or (not (viper-has-face-support-p)) 473 (or (not (viper-has-face-support-p))
478 (and viper-xemacs-p (eq (viper-device-type) 'tty))) 474 (and (featurep 'xemacs) (eq (viper-device-type) 'tty)))
479 "*If non-nil, Viper will always use `viper-replace-region-end-delimiter' and 475 "*If non-nil, Viper will always use `viper-replace-region-end-delimiter' and
480`viper-replace-region-start-delimiter' to delimit replacement regions, even on 476`viper-replace-region-start-delimiter' to delimit replacement regions, even on
481color displays. By default, the delimiters are used only on TTYs." 477color displays. By default, the delimiters are used only on TTYs."
@@ -1018,13 +1014,13 @@ Should be set in `~/.viper' file."
1018 1014
1019(defun viper-restore-cursor-type () 1015(defun viper-restore-cursor-type ()
1020 (condition-case nil 1016 (condition-case nil
1021 (if viper-xemacs-p 1017 (if (featurep 'xemacs)
1022 (set (make-local-variable 'bar-cursor) nil) 1018 (set (make-local-variable 'bar-cursor) nil)
1023 (setq cursor-type default-cursor-type)) 1019 (setq cursor-type default-cursor-type))
1024 (error nil))) 1020 (error nil)))
1025 1021
1026(defun viper-set-insert-cursor-type () 1022(defun viper-set-insert-cursor-type ()
1027 (if viper-xemacs-p 1023 (if (featurep 'xemacs)
1028 (set (make-local-variable 'bar-cursor) 2) 1024 (set (make-local-variable 'bar-cursor) 2)
1029 (setq cursor-type '(bar . 2)))) 1025 (setq cursor-type '(bar . 2))))
1030 1026
diff --git a/lisp/emulation/viper-macs.el b/lisp/emulation/viper-macs.el
index bf3f0eefb39..788feaf86e6 100644
--- a/lisp/emulation/viper-macs.el
+++ b/lisp/emulation/viper-macs.el
@@ -826,7 +826,7 @@ name from there."
826(defun viper-char-array-to-macro (array) 826(defun viper-char-array-to-macro (array)
827 (let ((vec (vconcat array)) 827 (let ((vec (vconcat array))
828 macro) 828 macro)
829 (if viper-xemacs-p 829 (if (featurep 'xemacs)
830 (setq macro (mapcar 'character-to-event vec)) 830 (setq macro (mapcar 'character-to-event vec))
831 (setq macro vec)) 831 (setq macro vec))
832 (vconcat (mapcar 'viper-event-key macro)))) 832 (vconcat (mapcar 'viper-event-key macro))))
diff --git a/lisp/emulation/viper-mous.el b/lisp/emulation/viper-mous.el
index e95e80aa4e0..7a47d321890 100644
--- a/lisp/emulation/viper-mous.el
+++ b/lisp/emulation/viper-mous.el
@@ -79,7 +79,7 @@ or a tripple-click."
79;; time interval in millisecond within which successive clicks are 79;; time interval in millisecond within which successive clicks are
80;; considered related 80;; considered related
81(defcustom viper-multiclick-timeout (if (viper-window-display-p) 81(defcustom viper-multiclick-timeout (if (viper-window-display-p)
82 (if viper-xemacs-p 82 (if (featurep 'xemacs)
83 mouse-track-multi-click-time 83 mouse-track-multi-click-time
84 double-click-time) 84 double-click-time)
85 500) 85 500)
@@ -227,7 +227,7 @@ is ignored."
227 ) ; if 227 ) ; if
228 ;; XEmacs doesn't have set-text-properties, but there buffer-substring 228 ;; XEmacs doesn't have set-text-properties, but there buffer-substring
229 ;; doesn't return properties together with the string, so it's not needed. 229 ;; doesn't return properties together with the string, so it's not needed.
230 (if viper-emacs-p 230 (if (featurep 'emacs)
231 (set-text-properties 0 (length result) nil result)) 231 (set-text-properties 0 (length result) nil result))
232 result 232 result
233 )) 233 ))
@@ -273,7 +273,7 @@ See `viper-surrounding-word' for the definition of a word in this case."
273 'viper-mouse-catch-frame-switch)) 273 'viper-mouse-catch-frame-switch))
274 (not (eq (key-binding viper-mouse-up-insert-key-parsed) 274 (not (eq (key-binding viper-mouse-up-insert-key-parsed)
275 'viper-mouse-click-insert-word)) 275 'viper-mouse-click-insert-word))
276 (and viper-xemacs-p (not (event-over-text-area-p click))))) 276 (and (featurep 'xemacs) (not (event-over-text-area-p click)))))
277 () ; do nothing, if binding isn't right or not over text 277 () ; do nothing, if binding isn't right or not over text
278 ;; turn arg into a number 278 ;; turn arg into a number
279 (cond ((integerp arg) nil) 279 (cond ((integerp arg) nil)
@@ -364,7 +364,7 @@ this command."
364 'viper-mouse-catch-frame-switch)) 364 'viper-mouse-catch-frame-switch))
365 (not (eq (key-binding viper-mouse-up-search-key-parsed) 365 (not (eq (key-binding viper-mouse-up-search-key-parsed)
366 'viper-mouse-click-search-word)) 366 'viper-mouse-click-search-word))
367 (and viper-xemacs-p (not (event-over-text-area-p click))))) 367 (and (featurep 'xemacs) (not (event-over-text-area-p click)))))
368 () ; do nothing, if binding isn't right or not over text 368 () ; do nothing, if binding isn't right or not over text
369 (let ((previous-search-string viper-s-string) 369 (let ((previous-search-string viper-s-string)
370 click-word click-count) 370 click-word click-count)
@@ -507,19 +507,19 @@ bindings in the Viper manual."
507 () 507 ()
508 (setq button-spec 508 (setq button-spec
509 (cond ((memq 1 key) 509 (cond ((memq 1 key)
510 (if viper-emacs-p 510 (if (featurep 'emacs)
511 (if (eq 'up event-type) 511 (if (eq 'up event-type)
512 "mouse-1" "down-mouse-1") 512 "mouse-1" "down-mouse-1")
513 (if (eq 'up event-type) 513 (if (eq 'up event-type)
514 'button1up 'button1))) 514 'button1up 'button1)))
515 ((memq 2 key) 515 ((memq 2 key)
516 (if viper-emacs-p 516 (if (featurep 'emacs)
517 (if (eq 'up event-type) 517 (if (eq 'up event-type)
518 "mouse-2" "down-mouse-2") 518 "mouse-2" "down-mouse-2")
519 (if (eq 'up event-type) 519 (if (eq 'up event-type)
520 'button2up 'button2))) 520 'button2up 'button2)))
521 ((memq 3 key) 521 ((memq 3 key)
522 (if viper-emacs-p 522 (if (featurep 'emacs)
523 (if (eq 'up event-type) 523 (if (eq 'up event-type)
524 "mouse-3" "down-mouse-3") 524 "mouse-3" "down-mouse-3")
525 (if (eq 'up event-type) 525 (if (eq 'up event-type)
@@ -528,18 +528,18 @@ bindings in the Viper manual."
528 "%S: invalid button number, %S" key-var key))) 528 "%S: invalid button number, %S" key-var key)))
529 meta-spec 529 meta-spec
530 (if (memq 'meta key) 530 (if (memq 'meta key)
531 (if viper-emacs-p "M-" 'meta) 531 (if (featurep 'emacs) "M-" 'meta)
532 (if viper-emacs-p "" nil)) 532 (if (featurep 'emacs) "" nil))
533 shift-spec 533 shift-spec
534 (if (memq 'shift key) 534 (if (memq 'shift key)
535 (if viper-emacs-p "S-" 'shift) 535 (if (featurep 'emacs) "S-" 'shift)
536 (if viper-emacs-p "" nil)) 536 (if (featurep 'emacs) "" nil))
537 control-spec 537 control-spec
538 (if (memq 'control key) 538 (if (memq 'control key)
539 (if viper-emacs-p "C-" 'control) 539 (if (featurep 'emacs) "C-" 'control)
540 (if viper-emacs-p "" nil))) 540 (if (featurep 'emacs) "" nil)))
541 541
542 (setq key-spec (if viper-emacs-p 542 (setq key-spec (if (featurep 'emacs)
543 (vector 543 (vector
544 (intern 544 (intern
545 (concat 545 (concat
diff --git a/lisp/emulation/viper-util.el b/lisp/emulation/viper-util.el
index 7073cd019dd..c757eb63aef 100644
--- a/lisp/emulation/viper-util.el
+++ b/lisp/emulation/viper-util.el
@@ -64,48 +64,34 @@
64 (fset 'x-color-defined-p (symbol-function 'ns-color-defined-p))) 64 (fset 'x-color-defined-p (symbol-function 'ns-color-defined-p)))
65 65
66 66
67;;; XEmacs support 67(defalias 'viper-overlay-p
68 68 (if (featurep 'xemacs) 'extentp 'overlayp))
69 69(defalias 'viper-make-overlay
70(viper-cond-compile-for-xemacs-or-emacs 70 (if (featurep 'xemacs) 'make-extent 'make-overlay))
71 (progn ; xemacs 71(defalias 'viper-overlay-live-p
72 (fset 'viper-overlay-p (symbol-function 'extentp)) 72 (if (featurep 'xemacs) 'extent-live-p 'overlayp))
73 (fset 'viper-make-overlay (symbol-function 'make-extent)) 73(defalias 'viper-move-overlay
74 (fset 'viper-overlay-live-p (symbol-function 'extent-live-p)) 74 (if (featurep 'xemacs) 'set-extent-endpoints 'move-overlay))
75 (fset 'viper-move-overlay (symbol-function 'set-extent-endpoints)) 75(defalias 'viper-overlay-start
76 (fset 'viper-overlay-start (symbol-function 'extent-start-position)) 76 (if (featurep 'xemacs) 'extent-start-position 'overlay-start))
77 (fset 'viper-overlay-end (symbol-function 'extent-end-position)) 77(defalias 'viper-overlay-end
78 (fset 'viper-overlay-get (symbol-function 'extent-property)) 78 (if (featurep 'xemacs) 'extent-end-position 'overlay-end))
79 (fset 'viper-overlay-put (symbol-function 'set-extent-property)) 79(defalias 'viper-overlay-get
80 (fset 'viper-read-event (symbol-function 'next-command-event)) 80 (if (featurep 'xemacs) 'extent-property 'overlay-get))
81 (fset 'viper-characterp (symbol-function 'characterp)) 81(defalias 'viper-overlay-put
82 (fset 'viper-int-to-char (symbol-function 'int-to-char)) 82 (if (featurep 'xemacs) 'set-extent-property 'overlay-put))
83 (if (viper-window-display-p) 83(defalias 'viper-read-event
84 (fset 'viper-iconify (symbol-function 'iconify-frame))) 84 (if (featurep 'xemacs) 'next-command-event 'read-event))
85 (cond ((viper-has-face-support-p) 85(defalias 'viper-characterp
86 (fset 'viper-get-face (symbol-function 'get-face)) 86 (if (featurep 'xemacs) 'characterp 'integerp))
87 (fset 'viper-color-defined-p (symbol-function 'valid-color-name-p)) 87(defalias 'viper-int-to-char
88 ))) 88 (if (featurep 'xemacs) 'int-to-char 'identity))
89 (progn ; emacs 89(defalias 'viper-get-face
90 (fset 'viper-overlay-p (symbol-function 'overlayp)) 90 (if (featurep 'xemacs) 'get-face 'internal-get-face))
91 (fset 'viper-make-overlay (symbol-function 'make-overlay)) 91(defalias 'viper-color-defined-p
92 (fset 'viper-overlay-live-p (symbol-function 'overlayp)) 92 (if (featurep 'xemacs) 'valid-color-name-p 'x-color-defined-p))
93 (fset 'viper-move-overlay (symbol-function 'move-overlay)) 93(defalias 'viper-iconify
94 (fset 'viper-overlay-start (symbol-function 'overlay-start)) 94 (if (featurep 'xemacs) 'iconify-frame 'iconify-or-deiconify-frame))
95 (fset 'viper-overlay-end (symbol-function 'overlay-end))
96 (fset 'viper-overlay-get (symbol-function 'overlay-get))
97 (fset 'viper-overlay-put (symbol-function 'overlay-put))
98 (fset 'viper-read-event (symbol-function 'read-event))
99 (fset 'viper-characterp (symbol-function 'integerp))
100 (fset 'viper-int-to-char (symbol-function 'identity))
101 (if (viper-window-display-p)
102 (fset 'viper-iconify (symbol-function 'iconify-or-deiconify-frame)))
103 (cond ((viper-has-face-support-p)
104 (fset 'viper-get-face (symbol-function 'internal-get-face))
105 (fset 'viper-color-defined-p (symbol-function 'x-color-defined-p))
106 )))
107 )
108
109 95
110 96
111;; CHAR is supposed to be a char or an integer (positive or negative) 97;; CHAR is supposed to be a char or an integer (positive or negative)
@@ -201,7 +187,7 @@
201(defsubst viper-get-saved-cursor-color-in-replace-mode () 187(defsubst viper-get-saved-cursor-color-in-replace-mode ()
202 (or 188 (or
203 (funcall 189 (funcall
204 (if viper-emacs-p 'frame-parameter 'frame-property) 190 (if (featurep 'emacs) 'frame-parameter 'frame-property)
205 (selected-frame) 191 (selected-frame)
206 'viper-saved-cursor-color-in-replace-mode) 192 'viper-saved-cursor-color-in-replace-mode)
207 (if (and (eq viper-current-state 'emacs-mode) viper-emacs-state-cursor-color) 193 (if (and (eq viper-current-state 'emacs-mode) viper-emacs-state-cursor-color)
@@ -211,7 +197,7 @@
211(defsubst viper-get-saved-cursor-color-in-insert-mode () 197(defsubst viper-get-saved-cursor-color-in-insert-mode ()
212 (or 198 (or
213 (funcall 199 (funcall
214 (if viper-emacs-p 'frame-parameter 'frame-property) 200 (if (featurep 'emacs) 'frame-parameter 'frame-property)
215 (selected-frame) 201 (selected-frame)
216 'viper-saved-cursor-color-in-insert-mode) 202 'viper-saved-cursor-color-in-insert-mode)
217 (if (and (eq viper-current-state 'emacs-mode) viper-emacs-state-cursor-color) 203 (if (and (eq viper-current-state 'emacs-mode) viper-emacs-state-cursor-color)
@@ -221,7 +207,7 @@
221(defsubst viper-get-saved-cursor-color-in-emacs-mode () 207(defsubst viper-get-saved-cursor-color-in-emacs-mode ()
222 (or 208 (or
223 (funcall 209 (funcall
224 (if viper-emacs-p 'frame-parameter 'frame-property) 210 (if (featurep 'emacs) 'frame-parameter 'frame-property)
225 (selected-frame) 211 (selected-frame)
226 'viper-saved-cursor-color-in-emacs-mode) 212 'viper-saved-cursor-color-in-emacs-mode)
227 viper-vi-state-cursor-color)) 213 viper-vi-state-cursor-color))
@@ -249,8 +235,8 @@
249;; testing for sufficiently high Emacs versions. 235;; testing for sufficiently high Emacs versions.
250(defun viper-check-version (op major minor &optional type-of-emacs) 236(defun viper-check-version (op major minor &optional type-of-emacs)
251 (if (and (boundp 'emacs-major-version) (boundp 'emacs-minor-version)) 237 (if (and (boundp 'emacs-major-version) (boundp 'emacs-minor-version))
252 (and (cond ((eq type-of-emacs 'xemacs) viper-xemacs-p) 238 (and (cond ((eq type-of-emacs 'xemacs) (featurep 'xemacs))
253 ((eq type-of-emacs 'emacs) viper-emacs-p) 239 ((eq type-of-emacs 'emacs) (featurep 'emacs))
254 (t t)) 240 (t t))
255 (cond ((eq op '=) (and (= emacs-minor-version minor) 241 (cond ((eq op '=) (and (= emacs-minor-version minor)
256 (= emacs-major-version major))) 242 (= emacs-major-version major)))
@@ -267,7 +253,7 @@
267 253
268 254
269(defun viper-get-visible-buffer-window (wind) 255(defun viper-get-visible-buffer-window (wind)
270 (if viper-xemacs-p 256 (if (featurep 'xemacs)
271 (get-buffer-window wind t) 257 (get-buffer-window wind t)
272 (get-buffer-window wind 'visible))) 258 (get-buffer-window wind 'visible)))
273 259
@@ -724,13 +710,14 @@
724(defsubst viper-file-checked-in-p (file) 710(defsubst viper-file-checked-in-p (file)
725 (and (featurep 'vc-hooks) 711 (and (featurep 'vc-hooks)
726 ;; CVS files are considered not checked in 712 ;; CVS files are considered not checked in
713 ;; FIXME: Should this deal with more than CVS?
727 (not (memq (vc-backend file) '(nil CVS))) 714 (not (memq (vc-backend file) '(nil CVS)))
728 (if (fboundp 'vc-state) 715 (if (fboundp 'vc-state)
729 (and 716 (and
730 (not (memq (vc-state file) '(edited needs-merge))) 717 (not (memq (vc-state file) '(edited needs-merge)))
731 (not (stringp (vc-state file)))) 718 (not (stringp (vc-state file))))
732 ;; XEmacs has no vc-state 719 ;; XEmacs has no vc-state
733 (not (vc-locking-user file))) 720 (if (featurep 'xemacs)(not (vc-locking-user file))))
734 )) 721 ))
735 722
736;; checkout if visited file is checked in 723;; checkout if visited file is checked in
@@ -787,7 +774,7 @@
787 (setq viper-replace-overlay (viper-make-overlay beg end (current-buffer))) 774 (setq viper-replace-overlay (viper-make-overlay beg end (current-buffer)))
788 ;; never detach 775 ;; never detach
789 (viper-overlay-put 776 (viper-overlay-put
790 viper-replace-overlay (if viper-emacs-p 'evaporate 'detachable) nil) 777 viper-replace-overlay (if (featurep 'emacs) 'evaporate 'detachable) nil)
791 (viper-overlay-put 778 (viper-overlay-put
792 viper-replace-overlay 'priority viper-replace-overlay-priority) 779 viper-replace-overlay 'priority viper-replace-overlay-priority)
793 ;; If Emacs will start supporting overlay maps, as it currently supports 780 ;; If Emacs will start supporting overlay maps, as it currently supports
@@ -795,7 +782,7 @@
795 ;; just have keymap attached to replace overlay. 782 ;; just have keymap attached to replace overlay.
796 ;;(viper-overlay-put 783 ;;(viper-overlay-put
797 ;; viper-replace-overlay 784 ;; viper-replace-overlay
798 ;; (if viper-xemacs-p 'keymap 'local-map) 785 ;; (if (featurep 'xemacs) 'keymap 'local-map)
799 ;; viper-replace-map) 786 ;; viper-replace-map)
800 ) 787 )
801 (if (viper-has-face-support-p) 788 (if (viper-has-face-support-p)
@@ -811,8 +798,8 @@
811 (viper-set-replace-overlay (point-min) (point-min))) 798 (viper-set-replace-overlay (point-min) (point-min)))
812 (if (or (not (viper-has-face-support-p)) 799 (if (or (not (viper-has-face-support-p))
813 viper-use-replace-region-delimiters) 800 viper-use-replace-region-delimiters)
814 (let ((before-name (if viper-xemacs-p 'begin-glyph 'before-string)) 801 (let ((before-name (if (featurep 'xemacs) 'begin-glyph 'before-string))
815 (after-name (if viper-xemacs-p 'end-glyph 'after-string))) 802 (after-name (if (featurep 'xemacs) 'end-glyph 'after-string)))
816 (viper-overlay-put viper-replace-overlay before-name before-glyph) 803 (viper-overlay-put viper-replace-overlay before-name before-glyph)
817 (viper-overlay-put viper-replace-overlay after-name after-glyph)))) 804 (viper-overlay-put viper-replace-overlay after-name after-glyph))))
818 805
@@ -843,11 +830,11 @@
843 ;; never detach 830 ;; never detach
844 (viper-overlay-put 831 (viper-overlay-put
845 viper-minibuffer-overlay 832 viper-minibuffer-overlay
846 (if viper-emacs-p 'evaporate 'detachable) 833 (if (featurep 'emacs) 'evaporate 'detachable)
847 nil) 834 nil)
848 ;; make viper-minibuffer-overlay open-ended 835 ;; make viper-minibuffer-overlay open-ended
849 ;; In emacs, it is made open ended at creation time 836 ;; In emacs, it is made open ended at creation time
850 (if viper-xemacs-p 837 (if (featurep 'xemacs)
851 (progn 838 (progn
852 (viper-overlay-put viper-minibuffer-overlay 'start-open nil) 839 (viper-overlay-put viper-minibuffer-overlay 'start-open nil)
853 (viper-overlay-put viper-minibuffer-overlay 'end-open nil))) 840 (viper-overlay-put viper-minibuffer-overlay 'end-open nil)))
@@ -860,7 +847,7 @@
860 (if (fboundp 'minibuffer-prompt-end) (minibuffer-prompt-end) 1) 847 (if (fboundp 'minibuffer-prompt-end) (minibuffer-prompt-end) 1)
861 (1+ (buffer-size))) 848 (1+ (buffer-size)))
862 (setq viper-minibuffer-overlay 849 (setq viper-minibuffer-overlay
863 (if viper-xemacs-p 850 (if (featurep 'xemacs)
864 (viper-make-overlay 1 (1+ (buffer-size)) (current-buffer)) 851 (viper-make-overlay 1 (1+ (buffer-size)) (current-buffer))
865 ;; make overlay open-ended 852 ;; make overlay open-ended
866 (viper-make-overlay 853 (viper-make-overlay
@@ -983,7 +970,7 @@
983(defun viper-read-key-sequence (prompt &optional continue-echo) 970(defun viper-read-key-sequence (prompt &optional continue-echo)
984 (let (inhibit-quit event keyseq) 971 (let (inhibit-quit event keyseq)
985 (setq keyseq (read-key-sequence prompt continue-echo)) 972 (setq keyseq (read-key-sequence prompt continue-echo))
986 (setq event (if viper-xemacs-p 973 (setq event (if (featurep 'xemacs)
987 (elt keyseq 0) ; XEmacs returns vector of events 974 (elt keyseq 0) ; XEmacs returns vector of events
988 (elt (listify-key-sequence keyseq) 0))) 975 (elt (listify-key-sequence keyseq) 0)))
989 (if (viper-ESC-event-p event) 976 (if (viper-ESC-event-p event)
@@ -1078,7 +1065,7 @@
1078 1065
1079(defun viper-key-to-emacs-key (key) 1066(defun viper-key-to-emacs-key (key)
1080 (let (key-name char-p modifiers mod-char-list base-key base-key-name) 1067 (let (key-name char-p modifiers mod-char-list base-key base-key-name)
1081 (cond (viper-xemacs-p key) 1068 (cond ((featurep 'xemacs) key)
1082 1069
1083 ((symbolp key) 1070 ((symbolp key)
1084 (setq key-name (symbol-name key)) 1071 (setq key-name (symbol-name key))
@@ -1086,10 +1073,10 @@
1086 (string-to-char key-name)) 1073 (string-to-char key-name))
1087 ;; Emacs doesn't recognize `return' and `escape' as events on 1074 ;; Emacs doesn't recognize `return' and `escape' as events on
1088 ;; dumb terminals, so we translate them into characters 1075 ;; dumb terminals, so we translate them into characters
1089 ((and viper-emacs-p (not (viper-window-display-p)) 1076 ((and (featurep 'emacs) (not (viper-window-display-p))
1090 (string= key-name "return")) 1077 (string= key-name "return"))
1091 ?\C-m) 1078 ?\C-m)
1092 ((and viper-emacs-p (not (viper-window-display-p)) 1079 ((and (featurep 'emacs) (not (viper-window-display-p))
1093 (string= key-name "escape")) 1080 (string= key-name "escape"))
1094 ?\e) 1081 ?\e)
1095 ;; pass symbol-event as is 1082 ;; pass symbol-event as is
@@ -1123,14 +1110,15 @@
1123 1110
1124;; LIS is assumed to be a list of events of characters 1111;; LIS is assumed to be a list of events of characters
1125(defun viper-eventify-list-xemacs (lis) 1112(defun viper-eventify-list-xemacs (lis)
1126 (mapcar 1113 (if (featurep 'xemacs)
1127 (lambda (elt) 1114 (mapcar
1128 (cond ((viper-characterp elt) (character-to-event elt)) 1115 (lambda (elt)
1129 ((eventp elt) elt) 1116 (cond ((viper-characterp elt) (character-to-event elt))
1130 (t (error 1117 ((eventp elt) elt)
1131 "viper-eventify-list-xemacs: can't convert to event, %S" 1118 (t (error
1132 elt)))) 1119 "viper-eventify-list-xemacs: can't convert to event, %S"
1133 lis)) 1120 elt))))
1121 lis)))
1134 1122
1135 1123
1136;; Smoothes out the difference between Emacs' unread-command-events 1124;; Smoothes out the difference between Emacs' unread-command-events
@@ -1142,7 +1130,7 @@
1142;; into an event. Below, we delete nil from event lists, since nil is the most 1130;; into an event. Below, we delete nil from event lists, since nil is the most
1143;; common symbol that might appear in this wrong context. 1131;; common symbol that might appear in this wrong context.
1144(defun viper-set-unread-command-events (arg) 1132(defun viper-set-unread-command-events (arg)
1145 (if viper-emacs-p 1133 (if (featurep 'emacs)
1146 (setq 1134 (setq
1147 unread-command-events 1135 unread-command-events
1148 (let ((new-events 1136 (let ((new-events
diff --git a/lisp/emulation/viper.el b/lisp/emulation/viper.el
index c0118250167..65d40e8bad7 100644
--- a/lisp/emulation/viper.el
+++ b/lisp/emulation/viper.el
@@ -690,7 +690,7 @@ It also can't undo some Viper settings."
690 (setq default-major-mode 690 (setq default-major-mode
691 (viper-standard-value 'default-major-mode viper-saved-non-viper-variables)) 691 (viper-standard-value 'default-major-mode viper-saved-non-viper-variables))
692 692
693 (if viper-emacs-p 693 (if (featurep 'emacs)
694 (setq-default 694 (setq-default
695 mark-even-if-inactive 695 mark-even-if-inactive
696 (viper-standard-value 696 (viper-standard-value
@@ -701,7 +701,7 @@ It also can't undo some Viper settings."
701 (and (fboundp 'add-to-ordered-list) (boundp 'emulation-mode-map-alists)) 701 (and (fboundp 'add-to-ordered-list) (boundp 'emulation-mode-map-alists))
702 (viper-delocalize-var 'minor-mode-map-alist)) 702 (viper-delocalize-var 'minor-mode-map-alist))
703 (viper-delocalize-var 'require-final-newline) 703 (viper-delocalize-var 'require-final-newline)
704 (if viper-xemacs-p (viper-delocalize-var 'bar-cursor)) 704 (if (featurep 'xemacs) (viper-delocalize-var 'bar-cursor))
705 705
706 706
707 ;; deactivate all advices done by Viper. 707 ;; deactivate all advices done by Viper.
@@ -788,7 +788,7 @@ It also can't undo some Viper settings."
788 ;; In emacs, we have to advice handle-switch-frame 788 ;; In emacs, we have to advice handle-switch-frame
789 ;; This advice is undone earlier, when all advices matchine "viper-" are 789 ;; This advice is undone earlier, when all advices matchine "viper-" are
790 ;; deactivated. 790 ;; deactivated.
791 (if viper-xemacs-p 791 (if (featurep 'xemacs)
792 (remove-hook 'mouse-leave-frame-hook 'viper-remember-current-frame)) 792 (remove-hook 'mouse-leave-frame-hook 'viper-remember-current-frame))
793 ) ; end viper-go-away 793 ) ; end viper-go-away
794 794
@@ -981,7 +981,7 @@ It also can't undo some Viper settings."
981 ))) 981 )))
982 982
983 ;; International input methods 983 ;; International input methods
984 (if viper-emacs-p 984 (if (featurep 'emacs)
985 (eval-after-load "mule-cmds" 985 (eval-after-load "mule-cmds"
986 '(progn 986 '(progn
987 (defadvice inactivate-input-method (after viper-mule-advice activate) 987 (defadvice inactivate-input-method (after viper-mule-advice activate)
@@ -1022,7 +1022,7 @@ It also can't undo some Viper settings."
1022 require-final-newline t) 1022 require-final-newline t)
1023 1023
1024 ;; don't bark when mark is inactive 1024 ;; don't bark when mark is inactive
1025 (if viper-emacs-p 1025 (if (featurep 'emacs)
1026 (setq mark-even-if-inactive t)) 1026 (setq mark-even-if-inactive t))
1027 1027
1028 (setq scroll-step 1) 1028 (setq scroll-step 1)
@@ -1094,12 +1094,12 @@ It also can't undo some Viper settings."
1094 "Use `read-file-name' for reading arguments." 1094 "Use `read-file-name' for reading arguments."
1095 (interactive (cons (read-file-name "Find file: " nil default-directory) 1095 (interactive (cons (read-file-name "Find file: " nil default-directory)
1096 ;; XEmacs: if Mule & prefix arg, ask for coding system 1096 ;; XEmacs: if Mule & prefix arg, ask for coding system
1097 (cond ((and viper-xemacs-p (featurep 'mule)) 1097 (cond ((and (featurep 'xemacs) (featurep 'mule))
1098 (list 1098 (list
1099 (and current-prefix-arg 1099 (and current-prefix-arg
1100 (read-coding-system "Coding-system: ")))) 1100 (read-coding-system "Coding-system: "))))
1101 ;; Emacs: do wildcards 1101 ;; Emacs: do wildcards
1102 ((and viper-emacs-p (boundp 'find-file-wildcards)) 1102 ((and (featurep 'emacs) (boundp 'find-file-wildcards))
1103 (list find-file-wildcards)))) 1103 (list find-file-wildcards))))
1104 )) 1104 ))
1105 1105
@@ -1108,12 +1108,12 @@ It also can't undo some Viper settings."
1108 (interactive (cons (read-file-name "Find file in other window: " 1108 (interactive (cons (read-file-name "Find file in other window: "
1109 nil default-directory) 1109 nil default-directory)
1110 ;; XEmacs: if Mule & prefix arg, ask for coding system 1110 ;; XEmacs: if Mule & prefix arg, ask for coding system
1111 (cond ((and viper-xemacs-p (featurep 'mule)) 1111 (cond ((and (featurep 'xemacs) (featurep 'mule))
1112 (list 1112 (list
1113 (and current-prefix-arg 1113 (and current-prefix-arg
1114 (read-coding-system "Coding-system: ")))) 1114 (read-coding-system "Coding-system: "))))
1115 ;; Emacs: do wildcards 1115 ;; Emacs: do wildcards
1116 ((and viper-emacs-p (boundp 'find-file-wildcards)) 1116 ((and (featurep 'emacs) (boundp 'find-file-wildcards))
1117 (list find-file-wildcards)))) 1117 (list find-file-wildcards))))
1118 )) 1118 ))
1119 1119
@@ -1123,12 +1123,12 @@ It also can't undo some Viper settings."
1123 (interactive (cons (read-file-name "Find file in other frame: " 1123 (interactive (cons (read-file-name "Find file in other frame: "
1124 nil default-directory) 1124 nil default-directory)
1125 ;; XEmacs: if Mule & prefix arg, ask for coding system 1125 ;; XEmacs: if Mule & prefix arg, ask for coding system
1126 (cond ((and viper-xemacs-p (featurep 'mule)) 1126 (cond ((and (featurep 'xemacs) (featurep 'mule))
1127 (list 1127 (list
1128 (and current-prefix-arg 1128 (and current-prefix-arg
1129 (read-coding-system "Coding-system: ")))) 1129 (read-coding-system "Coding-system: "))))
1130 ;; Emacs: do wildcards 1130 ;; Emacs: do wildcards
1131 ((and viper-emacs-p (boundp 'find-file-wildcards)) 1131 ((and (featurep 'emacs) (boundp 'find-file-wildcards))
1132 (list find-file-wildcards)))) 1132 (list find-file-wildcards))))
1133 )) 1133 ))
1134 1134
@@ -1159,7 +1159,7 @@ It also can't undo some Viper settings."
1159 1159
1160 ;; catch frame switching event 1160 ;; catch frame switching event
1161 (if (viper-window-display-p) 1161 (if (viper-window-display-p)
1162 (if viper-xemacs-p 1162 (if (featurep 'xemacs)
1163 (add-hook 'mouse-leave-frame-hook 1163 (add-hook 'mouse-leave-frame-hook
1164 'viper-remember-current-frame) 1164 'viper-remember-current-frame)
1165 (defadvice handle-switch-frame (before viper-frame-advice activate) 1165 (defadvice handle-switch-frame (before viper-frame-advice activate)
@@ -1227,7 +1227,7 @@ These two lines must come in the order given.
1227 (cons 'mode-line-buffer-identification 1227 (cons 'mode-line-buffer-identification
1228 (list (default-value 'mode-line-buffer-identification))) 1228 (list (default-value 'mode-line-buffer-identification)))
1229 (cons 'global-mode-string (list global-mode-string)) 1229 (cons 'global-mode-string (list global-mode-string))
1230 (if viper-emacs-p 1230 (if (featurep 'emacs)
1231 (cons 'mark-even-if-inactive (list mark-even-if-inactive))) 1231 (cons 'mark-even-if-inactive (list mark-even-if-inactive)))
1232 ))) 1232 )))
1233 1233