aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMichael Kifer1998-05-04 22:42:59 +0000
committerMichael Kifer1998-05-04 22:42:59 +0000
commit2eb4bdca8a0ed370b55f2553d72529c427ed504d (patch)
treed94d7f26cab07e80f639cbaa50d62b30f4cdab11
parent38cf95df42408406f3ed33938eb0ecaeb39507fe (diff)
downloademacs-2eb4bdca8a0ed370b55f2553d72529c427ed504d.tar.gz
emacs-2eb4bdca8a0ed370b55f2553d72529c427ed504d.zip
new version
-rw-r--r--lisp/ediff-diff.el2
-rw-r--r--lisp/ediff-init.el405
-rw-r--r--lisp/ediff-util.el90
-rw-r--r--lisp/ediff-vers.el2
-rw-r--r--lisp/ediff-wind.el3
-rw-r--r--lisp/ediff.el4
-rw-r--r--lisp/emulation/viper-cmd.el196
-rw-r--r--lisp/emulation/viper-ex.el206
-rw-r--r--lisp/emulation/viper-init.el126
-rw-r--r--lisp/emulation/viper-keym.el2
-rw-r--r--lisp/emulation/viper-util.el133
-rw-r--r--lisp/emulation/viper.el367
12 files changed, 560 insertions, 976 deletions
diff --git a/lisp/ediff-diff.el b/lisp/ediff-diff.el
index c484f224338..e773ba44e04 100644
--- a/lisp/ediff-diff.el
+++ b/lisp/ediff-diff.el
@@ -1110,7 +1110,7 @@ one optional arguments, diff-number to refine.")
1110 (set-process-sentinel proc 'ediff-process-sentinel) 1110 (set-process-sentinel proc 'ediff-process-sentinel)
1111 (set-process-filter proc 'ediff-process-filter) 1111 (set-process-filter proc 'ediff-process-filter)
1112 ))) 1112 )))
1113 (set-match-data data)))) 1113 (store-match-data data))))
1114 1114
1115;; This is shell-command-filter from simple.el in FSF Emacs. 1115;; This is shell-command-filter from simple.el in FSF Emacs.
1116;; Copied here because XEmacs doesn't have it. 1116;; Copied here because XEmacs doesn't have it.
diff --git a/lisp/ediff-init.el b/lisp/ediff-init.el
index 8f832bf6457..3ed281f02f2 100644
--- a/lisp/ediff-init.el
+++ b/lisp/ediff-init.el
@@ -32,6 +32,7 @@
32(defvar ediff-mouse-pixel-threshold) 32(defvar ediff-mouse-pixel-threshold)
33(defvar ediff-whitespace) 33(defvar ediff-whitespace)
34(defvar ediff-multiframe) 34(defvar ediff-multiframe)
35(defvar ediff-use-toolbar-p)
35 36
36(and noninteractive 37(and noninteractive
37 (eval-when-compile 38 (eval-when-compile
@@ -59,15 +60,22 @@ that Ediff doesn't know about.")
59 (and (ediff-device-type) (not (memq (ediff-device-type) '(tty pc stream))))) 60 (and (ediff-device-type) (not (memq (ediff-device-type) '(tty pc stream)))))
60 61
61;; test if supports faces 62;; test if supports faces
62;; ediff-force-faces is for those devices that support faces, but we don't know
63;; this yet
64(defun ediff-has-face-support-p () 63(defun ediff-has-face-support-p ()
65 (cond ((ediff-window-display-p)) 64 (cond ((ediff-window-display-p))
66 (ediff-force-faces) 65 (ediff-force-faces)
67 (ediff-emacs-p (memq (ediff-device-type) '(pc))) 66 (ediff-emacs-p (memq (ediff-device-type) '(pc)))
68 (ediff-xemacs-p (memq (ediff-device-type) '(tty pc))))) 67 (ediff-xemacs-p (memq (ediff-device-type) '(tty pc)))))
69 68
70 69(defun ediff-has-toolbar-support-p ()
70 (and ediff-xemacs-p
71 (featurep 'toolbar)
72 (console-on-window-system-p)))
73
74(defun ediff-use-toolbar-p ()
75 (and (ediff-has-toolbar-support-p) ;Can it do it ?
76 (boundp 'ediff-use-toolbar-p)
77 ediff-use-toolbar-p)) ;Does the user want it ?
78
71;; Defines SYMBOL as an advertised local variable. 79;; Defines SYMBOL as an advertised local variable.
72;; Performs a defvar, then executes `make-variable-buffer-local' on 80;; Performs a defvar, then executes `make-variable-buffer-local' on
73;; the variable. Also sets the `permanent-local' property, 81;; the variable. Also sets the `permanent-local' property,
@@ -526,13 +534,14 @@ See the documentation string of `ediff-focus-on-regexp-matches' for details.")
526 :group 'ediff) 534 :group 'ediff)
527 535
528 536
529(ediff-defvar-local ediff-use-faces t 537(ediff-defvar-local ediff-use-faces nil "")
538(defcustom ediff-use-faces t
530 "If t, differences are highlighted using faces, if device supports faces. 539 "If t, differences are highlighted using faces, if device supports faces.
531If nil, differences are highlighted using ASCII flags, ediff-before-flag 540If nil, differences are highlighted using ASCII flags, ediff-before-flag
532and ediff-after-flag. On a non-window system, differences are always 541and ediff-after-flag. On a non-window system, differences are always
533highlighted using ASCII flags. 542highlighted using ASCII flags."
534This variable can be set either in .emacs or toggled interactively. 543 :type 'boolean
535Use `setq-default' if setting it in .emacs") 544 :group 'ediff-highlighting)
536 545
537;; this indicates that diff regions are word-size, so fine diffs are 546;; this indicates that diff regions are word-size, so fine diffs are
538;; permanently nixed; used in ediff-windows-wordwise and ediff-regions-wordwise 547;; permanently nixed; used in ediff-windows-wordwise and ediff-regions-wordwise
@@ -569,10 +578,13 @@ meaning of this variable."
569 :type 'boolean 578 :type 'boolean
570 :group 'ediff) 579 :group 'ediff)
571 580
572(ediff-defvar-local ediff-highlight-all-diffs t 581(ediff-defvar-local ediff-highlight-all-diffs nil "")
582(defcustom ediff-highlight-all-diffs t
573 "If nil, only the selected differences are highlighted. 583 "If nil, only the selected differences are highlighted.
574This variable can be set either in .emacs or toggled interactively, using 584Otherwise, all difference regions are highlighted, but the selected region is
575ediff-toggle-hilit. Use `setq-default' to set it.") 585shown in brighter colors."
586 :type 'boolean
587 :group 'ediff-highlighting)
576 588
577;; A var local to each control panel buffer. Indicates highlighting style 589;; A var local to each control panel buffer. Indicates highlighting style
578;; in effect for this buffer: `face', `ascii', nil -- temporarily 590;; in effect for this buffer: `face', `ascii', nil -- temporarily
@@ -819,35 +831,6 @@ appropriate symbol: `rcs', `pcl-cvs', or `generic-sc' if you so desire."
819 (t "")) ; none 831 (t "")) ; none
820 )) 832 ))
821 833
822;;(defun ediff-set-face (ground face color)
823;; "Set face foreground/background."
824;; (if (ediff-has-face-support-p)
825;; (if (ediff-valid-color-p color)
826;; (if (eq ground 'foreground)
827;; (set-face-foreground face color)
828;; (set-face-background face color))
829;; (cond ((memq face
830;; '(ediff-current-diff-face-A
831;; ediff-current-diff-face-B
832;; ediff-current-diff-face-C
833;; ediff-current-diff-face-Ancestor))
834;; (copy-face 'highlight face))
835;; ((memq face
836;; '(ediff-fine-diff-face-A
837;; ediff-fine-diff-face-B
838;; ediff-fine-diff-face-C
839;; ediff-fine-diff-face-Ancestor))
840;; (copy-face 'secondary-selection face)
841;; (set-face-underline-p face t))
842;; ((memq face
843;; '(ediff-even-diff-face-A
844;; ediff-odd-diff-face-A
845;; ediff-even-diff-face-B ediff-odd-diff-face-B
846;; ediff-even-diff-face-C ediff-odd-diff-face-C
847;; ediff-even-diff-face-Ancestor
848;; ediff-odd-diff-face-Ancestor))
849;; (copy-face 'secondary-selection face))))
850;; ))
851 834
852(defun ediff-set-face-pixmap (face pixmap) 835(defun ediff-set-face-pixmap (face pixmap)
853 "Set face pixmap on a monochrome display." 836 "Set face pixmap on a monochrome display."
@@ -863,23 +846,6 @@ appropriate symbol: `rcs', `pcl-cvs', or `generic-sc' if you so desire."
863 (add-to-list 'facemenu-unlisted-faces face))) 846 (add-to-list 'facemenu-unlisted-faces face)))
864 847
865 848
866;;(defvar ediff-current-diff-face-A
867;; (if (ediff-has-face-support-p)
868;; (progn
869;; (make-face 'ediff-current-diff-face-A)
870;; (or (face-differs-from-default-p 'ediff-current-diff-face-A)
871;; (cond ((ediff-color-display-p)
872;; (ediff-set-face
873;; 'foreground 'ediff-current-diff-face-A "firebrick")
874;; (ediff-set-face
875;; 'background 'ediff-current-diff-face-A "pale green"))
876;; (t
877;; (if ediff-xemacs-p
878;; (copy-face 'modeline 'ediff-current-diff-face-A)
879;; (copy-face 'highlight 'ediff-current-diff-face-A))
880;; )))
881;; 'ediff-current-diff-face-A))
882;; "Face for highlighting the selected difference in buffer A.")
883 849
884(defface ediff-current-diff-face-A 850(defface ediff-current-diff-face-A
885 '((((class color)) (:foreground "firebrick" :background "pale green")) 851 '((((class color)) (:foreground "firebrick" :background "pale green"))
@@ -903,24 +869,6 @@ this variable represents.")
903 869
904 870
905 871
906;;(defvar ediff-current-diff-face-B
907;; (if (ediff-has-face-support-p)
908;; (progn
909;; (make-face 'ediff-current-diff-face-B)
910;; (or (face-differs-from-default-p 'ediff-current-diff-face-B)
911;; (cond ((ediff-color-display-p)
912;; (ediff-set-face
913;; 'foreground 'ediff-current-diff-face-B "DarkOrchid")
914;; (ediff-set-face
915;; 'background 'ediff-current-diff-face-B "Yellow"))
916;; (t
917;; (if ediff-xemacs-p
918;; (copy-face 'modeline 'ediff-current-diff-face-B)
919;; (copy-face 'highlight 'ediff-current-diff-face-B))
920;; )))
921;; 'ediff-current-diff-face-B))
922;; "Face for highlighting the selected difference in buffer B.")
923
924(defface ediff-current-diff-face-B 872(defface ediff-current-diff-face-B
925 '((((class color)) (:foreground "DarkOrchid" :background "Yellow")) 873 '((((class color)) (:foreground "DarkOrchid" :background "Yellow"))
926 (t (:inverse-video t))) 874 (t (:inverse-video t)))
@@ -941,23 +889,6 @@ this variable represents.")
941 (not (ediff-color-display-p))) 889 (not (ediff-color-display-p)))
942 (copy-face 'modeline 'ediff-current-diff-face-B)) 890 (copy-face 'modeline 'ediff-current-diff-face-B))
943 891
944;;(defvar ediff-current-diff-face-C
945;; (if (ediff-has-face-support-p)
946;; (progn
947;; (make-face 'ediff-current-diff-face-C)
948;; (or (face-differs-from-default-p 'ediff-current-diff-face-C)
949;; (cond ((ediff-color-display-p)
950;; (ediff-set-face
951;; 'foreground 'ediff-current-diff-face-C "Navy")
952;; (ediff-set-face
953;; 'background 'ediff-current-diff-face-C "Pink"))
954;; (t
955;; (if ediff-xemacs-p
956;; (copy-face 'modeline 'ediff-current-diff-face-C)
957;; (copy-face 'highlight 'ediff-current-diff-face-C))
958;; )))
959;; 'ediff-current-diff-face-C))
960;; "Face for highlighting the selected difference in buffer C.")
961 892
962(defface ediff-current-diff-face-C 893(defface ediff-current-diff-face-C
963 '((((class color)) (:foreground "Navy" :background "Pink")) 894 '((((class color)) (:foreground "Navy" :background "Pink"))
@@ -979,15 +910,6 @@ this variable represents.")
979 (not (ediff-color-display-p))) 910 (not (ediff-color-display-p)))
980 (copy-face 'modeline 'ediff-current-diff-face-C)) 911 (copy-face 'modeline 'ediff-current-diff-face-C))
981 912
982;;(defvar ediff-current-diff-face-Ancestor
983;; (if (ediff-has-face-support-p)
984;; (progn
985;; (make-face 'ediff-current-diff-face-Ancestor)
986;; (or (face-differs-from-default-p 'ediff-current-diff-face-Ancestor)
987;; (copy-face
988;; 'ediff-current-diff-face-C 'ediff-current-diff-face-Ancestor))
989;; 'ediff-current-diff-face-Ancestor))
990;; "Face for highlighting the selected difference in the ancestor buffer.")
991 913
992(defface ediff-current-diff-face-Ancestor 914(defface ediff-current-diff-face-Ancestor
993 '((((class color)) (:foreground "Black" :background "VioletRed")) 915 '((((class color)) (:foreground "Black" :background "VioletRed"))
@@ -1009,31 +931,6 @@ this variable represents.")
1009 (not (ediff-color-display-p))) 931 (not (ediff-color-display-p)))
1010 (copy-face 'modeline 'ediff-current-diff-face-Ancestor)) 932 (copy-face 'modeline 'ediff-current-diff-face-Ancestor))
1011 933
1012;;(defvar ediff-fine-diff-pixmap "gray3"
1013;; "Pixmap to use for highlighting fine differences.")
1014;;(defvar ediff-odd-diff-pixmap "gray1"
1015;; "Pixmap to use for highlighting odd differences.")
1016;;(defvar ediff-even-diff-pixmap "Stipple"
1017;; "Pixmap to use for highlighting even differences.")
1018
1019;;(defvar ediff-fine-diff-face-A
1020;; (if (ediff-has-face-support-p)
1021;; (progn
1022;; (make-face 'ediff-fine-diff-face-A)
1023;; (or (face-differs-from-default-p 'ediff-fine-diff-face-A)
1024;; (cond ((ediff-color-display-p)
1025;; (ediff-set-face 'foreground 'ediff-fine-diff-face-A
1026;; "Navy")
1027;; (ediff-set-face 'background 'ediff-fine-diff-face-A
1028;; "sky blue"))
1029;; (t
1030;; (set-face-underline-p 'ediff-fine-diff-face-A t)
1031;; (ediff-set-face-pixmap 'ediff-fine-diff-face-A
1032;; ediff-fine-diff-pixmap)
1033;; )))
1034;; 'ediff-fine-diff-face-A))
1035;; "Face for highlighting the refinement of the selected diff in buffer A.")
1036
1037 934
1038(defface ediff-fine-diff-face-A 935(defface ediff-fine-diff-face-A
1039 '((((class color)) (:foreground "Navy" :background "sky blue")) 936 '((((class color)) (:foreground "Navy" :background "sky blue"))
@@ -1049,29 +946,6 @@ widget to customize the actual face object `ediff-fine-diff-face-A'
1049this variable represents.") 946this variable represents.")
1050(ediff-hide-face 'ediff-fine-diff-face-A) 947(ediff-hide-face 'ediff-fine-diff-face-A)
1051 948
1052;;;; Until custom.el for XEmacs starts supporting :stipple we do this.
1053;;;; This means that some user customization may be trashed.
1054;;(if (and ediff-xemacs-p
1055;; (ediff-has-face-support-p)
1056;; (not (ediff-color-display-p)))
1057;; (ediff-set-face-pixmap 'ediff-fine-diff-face-A "gray3"))
1058
1059;;(defvar ediff-fine-diff-face-B
1060;; (if (ediff-has-face-support-p)
1061;; (progn
1062;; (make-face 'ediff-fine-diff-face-B)
1063;; (or (face-differs-from-default-p 'ediff-fine-diff-face-B)
1064;; (cond ((ediff-color-display-p)
1065;; (ediff-set-face 'foreground 'ediff-fine-diff-face-B "Black")
1066;; (ediff-set-face 'background 'ediff-fine-diff-face-B "cyan"))
1067;; (t
1068;; (set-face-underline-p 'ediff-fine-diff-face-B t)
1069;; (ediff-set-face-pixmap 'ediff-fine-diff-face-B
1070;; ediff-fine-diff-pixmap)
1071;; )))
1072;; 'ediff-fine-diff-face-B))
1073;; "Face for highlighting the refinement of the selected diff in buffer B.")
1074
1075(defface ediff-fine-diff-face-B 949(defface ediff-fine-diff-face-B
1076 '((((class color)) (:foreground "Black" :background "cyan")) 950 '((((class color)) (:foreground "Black" :background "cyan"))
1077 (t (:underline t :stipple "gray3"))) 951 (t (:underline t :stipple "gray3")))
@@ -1086,30 +960,6 @@ widget to customize the actual face object `ediff-fine-diff-face-B'
1086this variable represents.") 960this variable represents.")
1087(ediff-hide-face 'ediff-fine-diff-face-B) 961(ediff-hide-face 'ediff-fine-diff-face-B)
1088 962
1089;;;; Until custom.el for XEmacs starts supporting :stipple we do this.
1090;;;; This means that some user customization may be trashed.
1091;;(if (and ediff-xemacs-p
1092;; (ediff-has-face-support-p)
1093;; (not (ediff-color-display-p)))
1094;; (ediff-set-face-pixmap 'ediff-fine-diff-face-B "gray3"))
1095
1096;;(defvar ediff-fine-diff-face-C
1097;; (if (ediff-has-face-support-p)
1098;; (progn
1099;; (make-face 'ediff-fine-diff-face-C)
1100;; (or (face-differs-from-default-p 'ediff-fine-diff-face-C)
1101;; (cond ((ediff-color-display-p)
1102;; (ediff-set-face 'foreground 'ediff-fine-diff-face-C "black")
1103;; (ediff-set-face
1104;; 'background 'ediff-fine-diff-face-C "Turquoise"))
1105;; (t
1106;; (set-face-underline-p 'ediff-fine-diff-face-C t)
1107;; (ediff-set-face-pixmap 'ediff-fine-diff-face-C
1108;; ediff-fine-diff-pixmap)
1109;; )))
1110;; 'ediff-fine-diff-face-C))
1111;; "Face for highlighting the refinement of the selected diff in buffer C.")
1112
1113(defface ediff-fine-diff-face-C 963(defface ediff-fine-diff-face-C
1114 '((((class color)) (:foreground "Black" :background "Turquoise")) 964 '((((class color)) (:foreground "Black" :background "Turquoise"))
1115 (t (:underline t :stipple "gray3"))) 965 (t (:underline t :stipple "gray3")))
@@ -1124,29 +974,6 @@ widget to customize the actual face object `ediff-fine-diff-face-C'
1124this variable represents.") 974this variable represents.")
1125(ediff-hide-face 'ediff-fine-diff-face-C) 975(ediff-hide-face 'ediff-fine-diff-face-C)
1126 976
1127;;;; Until custom.el for XEmacs starts supporting :stipple we do this.
1128;;;; This means that some user customization may be trashed.
1129;;(if (and ediff-xemacs-p
1130;; (ediff-has-face-support-p)
1131;; (not (ediff-color-display-p)))
1132;; (ediff-set-face-pixmap 'ediff-fine-diff-face-C "gray3"))
1133
1134;;(defvar ediff-fine-diff-face-Ancestor
1135;; (if (ediff-has-face-support-p)
1136;; (progn
1137;; (make-face 'ediff-fine-diff-face-Ancestor)
1138;; (ediff-hide-face 'ediff-fine-diff-face-Ancestor)
1139;; (or (face-differs-from-default-p 'ediff-fine-diff-face-Ancestor)
1140;; (progn
1141;; (copy-face
1142;; 'ediff-fine-diff-face-C 'ediff-fine-diff-face-Ancestor)
1143;; (ediff-set-face-pixmap 'ediff-fine-diff-face-Ancestor
1144;; ediff-fine-diff-pixmap))
1145;; )))
1146;; "Face highlighting refinements of the selected diff in ancestor buffer.
1147;;Presently, this is not used, as difference regions are not refined in the
1148;;ancestor buffer.")
1149
1150(defface ediff-fine-diff-face-Ancestor 977(defface ediff-fine-diff-face-Ancestor
1151 '((((class color)) (:foreground "Black" :background "Green")) 978 '((((class color)) (:foreground "Black" :background "Green"))
1152 (t (:underline t :stipple "gray3"))) 979 (t (:underline t :stipple "gray3")))
@@ -1163,31 +990,6 @@ widget to customize the actual face object `ediff-fine-diff-face-Ancestor'
1163this variable represents.") 990this variable represents.")
1164(ediff-hide-face 'ediff-fine-diff-face-Ancestor) 991(ediff-hide-face 'ediff-fine-diff-face-Ancestor)
1165 992
1166;;;; Until custom.el for XEmacs starts supporting :stipple we do this.
1167;;;; This means that some user customization may be trashed.
1168;;(if (and ediff-xemacs-p
1169;; (ediff-has-face-support-p)
1170;; (not (ediff-color-display-p)))
1171;; (ediff-set-face-pixmap 'ediff-fine-diff-face-Ancestor "gray3"))
1172
1173;;(defvar ediff-even-diff-face-A
1174;; (if (ediff-has-face-support-p)
1175;; (progn
1176;; (make-face 'ediff-even-diff-face-A)
1177;; (or (face-differs-from-default-p 'ediff-even-diff-face-A)
1178;; (cond ((ediff-color-display-p)
1179;; (ediff-set-face
1180;; 'foreground 'ediff-even-diff-face-A "black")
1181;; (ediff-set-face
1182;; 'background 'ediff-even-diff-face-A "light grey"))
1183;; (t
1184;; (copy-face 'italic 'ediff-even-diff-face-A)
1185;; (ediff-set-face-pixmap 'ediff-even-diff-face-A
1186;; ediff-even-diff-pixmap)
1187;; )))
1188;; 'ediff-even-diff-face-A))
1189;; "Face used for highlighting even-numbered differences in buffer A.")
1190
1191(defface ediff-even-diff-face-A 993(defface ediff-even-diff-face-A
1192 '((((class color)) (:foreground "Black" :background "light grey")) 994 '((((class color)) (:foreground "Black" :background "light grey"))
1193 (t (:italic t :stipple "Stipple"))) 995 (t (:italic t :stipple "Stipple")))
@@ -1202,31 +1004,6 @@ widget to customize the actual face object `ediff-even-diff-face-A'
1202this variable represents.") 1004this variable represents.")
1203(ediff-hide-face 'ediff-even-diff-face-A) 1005(ediff-hide-face 'ediff-even-diff-face-A)
1204 1006
1205;;;; Until custom.el for XEmacs starts supporting :stipple we do this.
1206;;;; This means that some user customization may be trashed.
1207;;(if (and ediff-xemacs-p
1208;; (ediff-has-face-support-p)
1209;; (not (ediff-color-display-p)))
1210;; (ediff-set-face-pixmap 'ediff-even-diff-face-A "Stipple"))
1211
1212;;(defvar ediff-even-diff-face-B
1213;; (if (ediff-has-face-support-p)
1214;; (progn
1215;; (make-face 'ediff-even-diff-face-B)
1216;; (or (face-differs-from-default-p 'ediff-even-diff-face-B)
1217;; (cond ((ediff-color-display-p)
1218;; (ediff-set-face
1219;; 'foreground 'ediff-even-diff-face-B "White")
1220;; (ediff-set-face
1221;; 'background 'ediff-even-diff-face-B "Gray"))
1222;; (t
1223;; (copy-face 'italic 'ediff-even-diff-face-B)
1224;; (ediff-set-face-pixmap 'ediff-even-diff-face-B
1225;; ediff-even-diff-pixmap)
1226;; )))
1227;; 'ediff-even-diff-face-B))
1228;; "Face used for highlighting even-numbered differences in buffer B.")
1229
1230(defface ediff-even-diff-face-B 1007(defface ediff-even-diff-face-B
1231 '((((class color)) (:foreground "White" :background "Grey")) 1008 '((((class color)) (:foreground "White" :background "Grey"))
1232 (t (:italic t :stipple "Stipple"))) 1009 (t (:italic t :stipple "Stipple")))
@@ -1241,26 +1018,6 @@ widget to customize the actual face object `ediff-even-diff-face-B'
1241this variable represents.") 1018this variable represents.")
1242(ediff-hide-face 'ediff-even-diff-face-B) 1019(ediff-hide-face 'ediff-even-diff-face-B)
1243 1020
1244;;;; Until custom.el for XEmacs starts supporting :stipple we do this.
1245;;;; This means that some user customization may be trashed.
1246;;(if (and ediff-xemacs-p
1247;; (ediff-has-face-support-p)
1248;; (not (ediff-color-display-p)))
1249;; (ediff-set-face-pixmap 'ediff-even-diff-face-B "Stipple"))
1250
1251;;(defvar ediff-even-diff-face-C
1252;; (if (ediff-has-face-support-p)
1253;; (progn
1254;; (make-face 'ediff-even-diff-face-C)
1255;; (ediff-hide-face 'ediff-even-diff-face-C)
1256;; (or (face-differs-from-default-p 'ediff-even-diff-face-C)
1257;; (progn
1258;; (copy-face 'ediff-even-diff-face-A 'ediff-even-diff-face-C)
1259;; (ediff-set-face-pixmap 'ediff-even-diff-face-C
1260;; ediff-even-diff-pixmap)))
1261;; 'ediff-even-diff-face-C))
1262;; "Face used for highlighting even-numbered differences in buffer C.")
1263
1264(defface ediff-even-diff-face-C 1021(defface ediff-even-diff-face-C
1265 '((((class color)) (:foreground "Black" :background "light grey")) 1022 '((((class color)) (:foreground "Black" :background "light grey"))
1266 (t (:italic t :stipple "Stipple"))) 1023 (t (:italic t :stipple "Stipple")))
@@ -1275,27 +1032,6 @@ widget to customize the actual face object `ediff-even-diff-face-C'
1275this variable represents.") 1032this variable represents.")
1276(ediff-hide-face 'ediff-even-diff-face-C) 1033(ediff-hide-face 'ediff-even-diff-face-C)
1277 1034
1278;;;; Until custom.el for XEmacs starts supporting :stipple we do this.
1279;;;; This means that some user customization may be trashed.
1280;;(if (and ediff-xemacs-p
1281;; (ediff-has-face-support-p)
1282;; (not (ediff-color-display-p)))
1283;; (ediff-set-face-pixmap 'ediff-even-diff-face-C "Stipple"))
1284
1285;;(defvar ediff-even-diff-face-Ancestor
1286;; (if (ediff-has-face-support-p)
1287;; (progn
1288;; (make-face 'ediff-even-diff-face-Ancestor)
1289;; (ediff-hide-face 'ediff-even-diff-face-Ancestor)
1290;; (or (face-differs-from-default-p 'ediff-even-diff-face-Ancestor)
1291;; (progn
1292;; (copy-face
1293;; 'ediff-even-diff-face-C 'ediff-even-diff-face-Ancestor)
1294;; (ediff-set-face-pixmap 'ediff-even-diff-face-Ancestor
1295;; ediff-even-diff-pixmap)))
1296;; 'ediff-even-diff-face-Ancestor))
1297;; "Face highlighting even-numbered differences in the ancestor buffer.")
1298
1299(defface ediff-even-diff-face-Ancestor 1035(defface ediff-even-diff-face-Ancestor
1300 '((((class color)) (:foreground "White" :background "Grey")) 1036 '((((class color)) (:foreground "White" :background "Grey"))
1301 (t (:italic t :stipple "Stipple"))) 1037 (t (:italic t :stipple "Stipple")))
@@ -1310,13 +1046,6 @@ widget to customize the actual face object `ediff-even-diff-face-Ancestor'
1310this variable represents.") 1046this variable represents.")
1311(ediff-hide-face 'ediff-even-diff-face-Ancestor) 1047(ediff-hide-face 'ediff-even-diff-face-Ancestor)
1312 1048
1313;;;; Until custom.el for XEmacs starts supporting :stipple we do this.
1314;;;; This means that some user customization may be trashed.
1315;;(if (and ediff-xemacs-p
1316;; (ediff-has-face-support-p)
1317;; (not (ediff-color-display-p)))
1318;; (ediff-set-face-pixmap 'ediff-even-diff-face-Ancestor "Stipple"))
1319
1320;; Association between buffer types and even-diff-face symbols 1049;; Association between buffer types and even-diff-face symbols
1321(defconst ediff-even-diff-face-alist 1050(defconst ediff-even-diff-face-alist
1322 '((A . ediff-even-diff-face-A) 1051 '((A . ediff-even-diff-face-A)
@@ -1324,24 +1053,6 @@ this variable represents.")
1324 (C . ediff-even-diff-face-C) 1053 (C . ediff-even-diff-face-C)
1325 (Ancestor . ediff-even-diff-face-Ancestor))) 1054 (Ancestor . ediff-even-diff-face-Ancestor)))
1326 1055
1327;;(defvar ediff-odd-diff-face-A
1328;; (if (ediff-has-face-support-p)
1329;; (progn
1330;; (make-face 'ediff-odd-diff-face-A)
1331;; (or (face-differs-from-default-p 'ediff-odd-diff-face-A)
1332;; (cond ((ediff-color-display-p)
1333;; (ediff-set-face
1334;; 'foreground 'ediff-odd-diff-face-A "White")
1335;; (ediff-set-face
1336;; 'background 'ediff-odd-diff-face-A "Gray"))
1337;; (t
1338;; (copy-face 'italic 'ediff-odd-diff-face-A)
1339;; (ediff-set-face-pixmap 'ediff-odd-diff-face-A
1340;; ediff-odd-diff-pixmap)
1341;; )))
1342;; 'ediff-odd-diff-face-A))
1343;; "Face used for highlighting odd-numbered differences in buffer A.")
1344
1345(defface ediff-odd-diff-face-A 1056(defface ediff-odd-diff-face-A
1346 '((((class color)) (:foreground "White" :background "Grey")) 1057 '((((class color)) (:foreground "White" :background "Grey"))
1347 (t (:italic t :stipple "gray1"))) 1058 (t (:italic t :stipple "gray1")))
@@ -1356,31 +1067,6 @@ widget to customize the actual face object `ediff-odd-diff-face-A'
1356this variable represents.") 1067this variable represents.")
1357(ediff-hide-face 'ediff-odd-diff-face-A) 1068(ediff-hide-face 'ediff-odd-diff-face-A)
1358 1069
1359;;;; Until custom.el for XEmacs starts supporting :stipple we do this.
1360;;;; This means that some user customization may be trashed.
1361;;(if (and ediff-xemacs-p
1362;; (ediff-has-face-support-p)
1363;; (not (ediff-color-display-p)))
1364;; (ediff-set-face-pixmap 'ediff-odd-diff-face-A "gray1"))
1365
1366;;(defvar ediff-odd-diff-face-B
1367;; (if (ediff-has-face-support-p)
1368;; (progn
1369;; (make-face 'ediff-odd-diff-face-B)
1370;; (ediff-hide-face 'ediff-odd-diff-face-B)
1371;; (or (face-differs-from-default-p 'ediff-odd-diff-face-B)
1372;; (cond ((ediff-color-display-p)
1373;; (ediff-set-face
1374;; 'foreground 'ediff-odd-diff-face-B "Black")
1375;; (ediff-set-face
1376;; 'background 'ediff-odd-diff-face-B "light grey"))
1377;; (t
1378;; (copy-face 'italic 'ediff-odd-diff-face-B)
1379;; (ediff-set-face-pixmap 'ediff-odd-diff-face-B
1380;; ediff-odd-diff-pixmap)
1381;; )))
1382;; 'ediff-odd-diff-face-B))
1383;; "Face used for highlighting odd-numbered differences in buffer B.")
1384 1070
1385(defface ediff-odd-diff-face-B 1071(defface ediff-odd-diff-face-B
1386 '((((class color)) (:foreground "Black" :background "light grey")) 1072 '((((class color)) (:foreground "Black" :background "light grey"))
@@ -1396,25 +1082,6 @@ widget to customize the actual face object `ediff-odd-diff-face-B'
1396this variable represents.") 1082this variable represents.")
1397(ediff-hide-face 'ediff-odd-diff-face-B) 1083(ediff-hide-face 'ediff-odd-diff-face-B)
1398 1084
1399;;;; Until custom.el for XEmacs starts supporting :stipple we do this.
1400;;;; This means that some user customization may be trashed.
1401;;(if (and ediff-xemacs-p
1402;; (ediff-has-face-support-p)
1403;; (not (ediff-color-display-p)))
1404;; (ediff-set-face-pixmap 'ediff-odd-diff-face-B "gray1"))
1405
1406;;(defvar ediff-odd-diff-face-C
1407;; (if (ediff-has-face-support-p)
1408;; (progn
1409;; (make-face 'ediff-odd-diff-face-C)
1410;; (or (face-differs-from-default-p 'ediff-odd-diff-face-C)
1411;; (progn
1412;; (copy-face 'ediff-odd-diff-face-A 'ediff-odd-diff-face-C)
1413;; (ediff-set-face-pixmap 'ediff-odd-diff-face-C
1414;; ediff-odd-diff-pixmap)))
1415;; 'ediff-odd-diff-face-C))
1416;; "Face used for highlighting odd-numbered differences in buffer C.")
1417
1418(defface ediff-odd-diff-face-C 1085(defface ediff-odd-diff-face-C
1419 '((((class color)) (:foreground "White" :background "Grey")) 1086 '((((class color)) (:foreground "White" :background "Grey"))
1420 (t (:italic t :stipple "gray1"))) 1087 (t (:italic t :stipple "gray1")))
@@ -1429,25 +1096,6 @@ widget to customize the actual face object `ediff-odd-diff-face-C'
1429this variable represents.") 1096this variable represents.")
1430(ediff-hide-face 'ediff-odd-diff-face-C) 1097(ediff-hide-face 'ediff-odd-diff-face-C)
1431 1098
1432;;;; Until custom.el for XEmacs starts supporting :stipple we do this.
1433;;;; This means that some user customization may be trashed.
1434;;(if (and ediff-xemacs-p
1435;; (ediff-has-face-support-p)
1436;; (not (ediff-color-display-p)))
1437;; (ediff-set-face-pixmap 'ediff-odd-diff-face-C "gray1"))
1438
1439;;(defvar ediff-odd-diff-face-Ancestor
1440;; (if (ediff-has-face-support-p)
1441;; (progn
1442;; (make-face 'ediff-odd-diff-face-Ancestor)
1443;; (or (face-differs-from-default-p 'ediff-odd-diff-face-Ancestor)
1444;; (progn
1445;; (copy-face 'ediff-odd-diff-face-C 'ediff-odd-diff-face-Ancestor)
1446;; (ediff-set-face-pixmap 'ediff-odd-diff-face-Ancestor
1447;; ediff-odd-diff-pixmap)))
1448;; 'ediff-odd-diff-face-Ancestor))
1449;; "Face used for highlighting even-numbered differences in the ancestor buffer.")
1450
1451(defface ediff-odd-diff-face-Ancestor 1099(defface ediff-odd-diff-face-Ancestor
1452 '((((class color)) (:foreground "Black" :background "light grey")) 1100 '((((class color)) (:foreground "Black" :background "light grey"))
1453 (t (:italic t :stipple "gray1"))) 1101 (t (:italic t :stipple "gray1")))
@@ -1462,13 +1110,6 @@ widget to customize the actual face object `ediff-odd-diff-face-Ancestor'
1462this variable represents.") 1110this variable represents.")
1463(ediff-hide-face 'ediff-odd-diff-face-Ancestor) 1111(ediff-hide-face 'ediff-odd-diff-face-Ancestor)
1464 1112
1465;;;; Until custom.el for XEmacs starts supporting :stipple we do this.
1466;;;; This means that some user customization may be trashed.
1467;;(if (and ediff-xemacs-p
1468;; (ediff-has-face-support-p)
1469;; (not (ediff-color-display-p)))
1470;; (ediff-set-face-pixmap 'ediff-odd-diff-face-Ancestor "gray1"))
1471
1472;; Association between buffer types and odd-diff-face symbols 1113;; Association between buffer types and odd-diff-face symbols
1473(defconst ediff-odd-diff-face-alist 1114(defconst ediff-odd-diff-face-alist
1474 '((A . ediff-odd-diff-face-A) 1115 '((A . ediff-odd-diff-face-A)
@@ -1548,7 +1189,7 @@ This property can be toggled interactively."
1548 "*Save the results of merge jobs automatically. 1189 "*Save the results of merge jobs automatically.
1549Nil means don't save automatically. t means always save. Anything but nil or t 1190Nil means don't save automatically. t means always save. Anything but nil or t
1550means save automatically only if the merge job is part of a group of jobs, such 1191means save automatically only if the merge job is part of a group of jobs, such
1551as `ediff-merge-directories' or `ediff-merge-directory-revisions'." 1192as `ediff-merge-directory' or `ediff-merge-directory-revisions'."
1552 :type '(choice (const nil) (const t) (const group-jobs-only)) 1193 :type '(choice (const nil) (const t) (const group-jobs-only))
1553 :group 'ediff-merge) 1194 :group 'ediff-merge)
1554(make-variable-buffer-local 'ediff-autostore-merges) 1195(make-variable-buffer-local 'ediff-autostore-merges)
diff --git a/lisp/ediff-util.el b/lisp/ediff-util.el
index ed7c62661f9..4b790e4c6c9 100644
--- a/lisp/ediff-util.el
+++ b/lisp/ediff-util.el
@@ -52,10 +52,12 @@
52 (or (featurep 'ediff) 52 (or (featurep 'ediff)
53 (load "ediff.el" nil nil 'nosuffix)) 53 (load "ediff.el" nil nil 'nosuffix))
54 (or (featurep 'ediff-tbar) 54 (or (featurep 'ediff-tbar)
55 ediff-emacs-p
55 (load "ediff-tbar.el" 'noerror nil 'nosuffix)) 56 (load "ediff-tbar.el" 'noerror nil 'nosuffix))
56 )) 57 ))
57;; end pacifier 58;; end pacifier
58 59
60
59(require 'ediff-init) 61(require 'ediff-init)
60(require 'ediff-help) 62(require 'ediff-help)
61(require 'ediff-mult) 63(require 'ediff-mult)
@@ -63,14 +65,8 @@
63(require 'ediff-diff) 65(require 'ediff-diff)
64(require 'ediff-merg) 66(require 'ediff-merg)
65 67
66
67;; be careful with ediff-tbar
68(if ediff-xemacs-p 68(if ediff-xemacs-p
69 (condition-case nil 69 (require 'ediff-tbar))
70 (require 'ediff-tbar)
71 (error
72 (defun ediff-use-toolbar-p () nil)))
73 (defun ediff-use-toolbar-p () nil))
74 70
75 71
76;;; Functions 72;;; Functions
@@ -1053,7 +1049,7 @@ of the current buffer."
1053 1049
1054;; checkout if visited file is checked in 1050;; checkout if visited file is checked in
1055(defun ediff-maybe-checkout (buf) 1051(defun ediff-maybe-checkout (buf)
1056 (let ((file (buffer-file-name buf)) 1052 (let ((file (expand-file-name (buffer-file-name buf)))
1057 (checkout-function (key-binding "\C-x\C-q"))) 1053 (checkout-function (key-binding "\C-x\C-q")))
1058 (if (and (ediff-file-checked-in-p file) 1054 (if (and (ediff-file-checked-in-p file)
1059 (or (beep 1) t) 1055 (or (beep 1) t)
@@ -1070,31 +1066,42 @@ of the current buffer."
1070;; in and not checked out for the purpose of patching (since patch won't be 1066;; in and not checked out for the purpose of patching (since patch won't be
1071;; able to read such a file anyway). 1067;; able to read such a file anyway).
1072;; FILE is a string representing file name 1068;; FILE is a string representing file name
1073(defun ediff-file-under-version-control (file) 1069;;(defun ediff-file-under-version-control (file)
1074 (let* ((filedir (file-name-directory file)) 1070;; (let* ((filedir (file-name-directory file))
1075 (file-nondir (file-name-nondirectory file)) 1071;; (file-nondir (file-name-nondirectory file))
1076 (trial (concat file-nondir ",v")) 1072;; (trial (concat file-nondir ",v"))
1077 (full-trial (concat filedir trial)) 1073;; (full-trial (concat filedir trial))
1078 (full-rcs-trial (concat filedir "RCS/" trial))) 1074;; (full-rcs-trial (concat filedir "RCS/" trial)))
1079 (and (stringp file) 1075;; (and (stringp file)
1080 (file-exists-p file) 1076;; (file-exists-p file)
1081 (or 1077;; (or
1082 (and 1078;; (and
1083 (file-exists-p full-trial) 1079;; (file-exists-p full-trial)
1084 ;; in FAT FS, `file,v' and `file' may turn out to be the same! 1080;; ;; in FAT FS, `file,v' and `file' may turn out to be the same!
1085 ;; don't be fooled by this! 1081;; ;; don't be fooled by this!
1086 (not (equal (file-attributes file) 1082;; (not (equal (file-attributes file)
1087 (file-attributes full-trial)))) 1083;; (file-attributes full-trial))))
1088 ;; check if a version is in RCS/ directory 1084;; ;; check if a version is in RCS/ directory
1089 (file-exists-p full-rcs-trial))) 1085;; (file-exists-p full-rcs-trial)))
1090 )) 1086;; ))
1087
1088
1089(defsubst ediff-file-checked-out-p (file)
1090 (or (not (featurep 'vc-hooks))
1091 (and (vc-backend file)
1092 (vc-locking-user file))))
1093(defsubst ediff-file-checked-in-p (file)
1094 (and (featurep 'vc-hooks)
1095 (vc-backend file)
1096 (not (vc-locking-user file))))
1097
1098(defun ediff-file-compressed-p (file)
1099 (condition-case nil
1100 (require 'jka-compr)
1101 (error))
1102 (if (featurep 'jka-compr)
1103 (string-match (jka-compr-build-file-regexp) file)))
1091 1104
1092(defun ediff-file-checked-out-p (file)
1093 (and (ediff-file-under-version-control file)
1094 (file-writable-p file)))
1095(defun ediff-file-checked-in-p (file)
1096 (and (ediff-file-under-version-control file)
1097 (not (file-writable-p file))))
1098 1105
1099(defun ediff-swap-buffers () 1106(defun ediff-swap-buffers ()
1100 "Rotate the display of buffers A, B, and C." 1107 "Rotate the display of buffers A, B, and C."
@@ -1312,7 +1319,7 @@ To change the default, set the variable `ediff-use-toolbar-p', which see."
1312 (set-specifier bottom-toolbar-visible-p (list frame t)) 1319 (set-specifier bottom-toolbar-visible-p (list frame t))
1313 (set-specifier bottom-toolbar-height 1320 (set-specifier bottom-toolbar-height
1314 (list frame ediff-toolbar-height))) 1321 (list frame ediff-toolbar-height)))
1315 (ediff-xemacs-p 1322 ((ediff-has-toolbar-support-p)
1316 (set-specifier bottom-toolbar-height (list frame 0))) 1323 (set-specifier bottom-toolbar-height (list frame 0)))
1317 )) 1324 ))
1318 )) 1325 ))
@@ -1572,18 +1579,19 @@ the width of the A/B/C windows."
1572 lines 1579 lines
1573 )))) 1580 ))))
1574 1581
1575;; get number of lines from window end to region start 1582;; Calculate the number of lines from window end to the start of diff region
1576(defun ediff-get-lines-to-region-start (buf-type &optional n ctl-buf) 1583(defun ediff-get-lines-to-region-start (buf-type &optional diff-num ctl-buf)
1577 (or n (setq n ediff-current-difference)) 1584 (or diff-num (setq diff-num ediff-current-difference))
1578 (or ctl-buf (setq ctl-buf ediff-control-buffer)) 1585 (or ctl-buf (setq ctl-buf ediff-control-buffer))
1579 (ediff-with-current-buffer ctl-buf 1586 (ediff-with-current-buffer ctl-buf
1580 (let* ((buf (ediff-get-buffer buf-type)) 1587 (let* ((buf (ediff-get-buffer buf-type))
1581 (wind (eval (ediff-get-symbol-from-alist 1588 (wind (eval (ediff-get-symbol-from-alist
1582 buf-type ediff-window-alist))) 1589 buf-type ediff-window-alist)))
1583 (end (window-end wind)) 1590 (end (or (window-end wind) (window-end wind t)))
1584 (beg (ediff-get-diff-posn buf-type 'beg))) 1591 (beg (ediff-get-diff-posn buf-type 'beg diff-num)))
1585 (ediff-with-current-buffer buf 1592 (ediff-with-current-buffer buf
1586 (if (< beg end) (count-lines beg end) 0)) 1593 (if (< beg end)
1594 (count-lines (max beg (point-min)) (min end (point-max))) 0))
1587 ))) 1595 )))
1588 1596
1589 1597
@@ -2974,10 +2982,6 @@ Hit \\[ediff-recenter] to reset the windows afterward."
2974 (error "Buffer out of sync for file %s" buffer-file-name)))) 2982 (error "Buffer out of sync for file %s" buffer-file-name))))
2975 2983
2976 2984
2977(defun ediff-file-compressed-p (file)
2978 (require 'jka-compr)
2979 (string-match (jka-compr-build-file-regexp) file))
2980
2981(defun ediff-filename-magic-p (file) 2985(defun ediff-filename-magic-p (file)
2982 (or (ediff-file-compressed-p file) 2986 (or (ediff-file-compressed-p file)
2983 (ediff-file-remote-p file))) 2987 (ediff-file-remote-p file)))
diff --git a/lisp/ediff-vers.el b/lisp/ediff-vers.el
index db555e11b19..42ce45c77b2 100644
--- a/lisp/ediff-vers.el
+++ b/lisp/ediff-vers.el
@@ -338,7 +338,7 @@
338 (tmp-file 338 (tmp-file
339 (cvs-retrieve-revision-to-tmpfile fileinfo)) 339 (cvs-retrieve-revision-to-tmpfile fileinfo))
340 (default-directory 340 (default-directory
341 (file-name-as-directory (cvs-fileinfo->dir fileinfo))) 341 (file-name-as-directory (cvs-fileinfo->dir fileinfo)))
342 ancestor-file) 342 ancestor-file)
343 343
344 (or (memq type '(MERGED CONFLICT MODIFIED)) 344 (or (memq type '(MERGED CONFLICT MODIFIED))
diff --git a/lisp/ediff-wind.el b/lisp/ediff-wind.el
index e5edc2f08f5..dde68ed1f31 100644
--- a/lisp/ediff-wind.el
+++ b/lisp/ediff-wind.el
@@ -46,6 +46,7 @@
46 (or (featurep 'ediff-help) 46 (or (featurep 'ediff-help)
47 (load "ediff-help.el" nil nil 'nosuffix)) 47 (load "ediff-help.el" nil nil 'nosuffix))
48 (or (featurep 'ediff-tbar) 48 (or (featurep 'ediff-tbar)
49 ediff-emacs-p
49 (load "ediff-tbar.el" 'noerror nil 'nosuffix)) 50 (load "ediff-tbar.el" 'noerror nil 'nosuffix))
50 )) 51 ))
51;; end pacifier 52;; end pacifier
@@ -932,7 +933,7 @@ into icons, regardless of the window manager."
932 933
933 ;; In XEmacs, buffer menubar needs to be killed before frame parameters 934 ;; In XEmacs, buffer menubar needs to be killed before frame parameters
934 ;; are changed. 935 ;; are changed.
935 (if ediff-xemacs-p 936 (if (ediff-has-toolbar-support-p)
936 (progn 937 (progn
937 (set-specifier top-toolbar-height (list ctl-frame 2)) 938 (set-specifier top-toolbar-height (list ctl-frame 2))
938 (sit-for 0) 939 (sit-for 0)
diff --git a/lisp/ediff.el b/lisp/ediff.el
index 0068ea3efeb..d8ecd0f91a5 100644
--- a/lisp/ediff.el
+++ b/lisp/ediff.el
@@ -6,8 +6,8 @@
6;; Created: February 2, 1994 6;; Created: February 2, 1994
7;; Keywords: comparing, merging, patching, version control. 7;; Keywords: comparing, merging, patching, version control.
8 8
9(defconst ediff-version "2.69" "The current version of Ediff") 9(defconst ediff-version "2.70.1" "The current version of Ediff")
10(defconst ediff-date "October 10, 1997" "Date of last update") 10(defconst ediff-date "March 7, 1998" "Date of last update")
11 11
12 12
13;; This file is part of GNU Emacs. 13;; This file is part of GNU Emacs.
diff --git a/lisp/emulation/viper-cmd.el b/lisp/emulation/viper-cmd.el
index 3fb8cce6dfa..cfb98fd8ca2 100644
--- a/lisp/emulation/viper-cmd.el
+++ b/lisp/emulation/viper-cmd.el
@@ -144,17 +144,11 @@
144 144
145;; Runs viper-after-change-functions inside after-change-functions 145;; Runs viper-after-change-functions inside after-change-functions
146(defun viper-after-change-sentinel (beg end len) 146(defun viper-after-change-sentinel (beg end len)
147 (let ((list viper-after-change-functions)) 147 (run-hook-with-args 'viper-after-change-functions beg end len))
148 (while list
149 (funcall (car list) beg end len)
150 (setq list (cdr list)))))
151 148
152;; Runs viper-before-change-functions inside before-change-functions 149;; Runs viper-before-change-functions inside before-change-functions
153(defun viper-before-change-sentinel (beg end) 150(defun viper-before-change-sentinel (beg end)
154 (let ((list viper-before-change-functions)) 151 (run-hook-with-args 'viper-before-change-functions beg end))
155 (while list
156 (funcall (car list) beg end)
157 (setq list (cdr list)))))
158 152
159(defsubst viper-post-command-sentinel () 153(defsubst viper-post-command-sentinel ()
160 (run-hooks 'viper-post-command-hooks)) 154 (run-hooks 'viper-post-command-hooks))
@@ -264,15 +258,21 @@
264 ;; We remove then add viper-post/pre-command-sentinel since it is very 258 ;; We remove then add viper-post/pre-command-sentinel since it is very
265 ;; desirable that viper-pre-command-sentinel is the last hook and 259 ;; desirable that viper-pre-command-sentinel is the last hook and
266 ;; viper-post-command-sentinel is the first hook. 260 ;; viper-post-command-sentinel is the first hook.
261
262 (make-local-hook 'viper-after-change-functions)
263 (make-local-hook 'viper-before-change-functions)
264 (make-local-hook 'viper-post-command-hooks)
265 (make-local-hook 'viper-pre-command-hooks)
266
267 (remove-hook 'post-command-hook 'viper-post-command-sentinel) 267 (remove-hook 'post-command-hook 'viper-post-command-sentinel)
268 (add-hook 'post-command-hook 'viper-post-command-sentinel) 268 (add-hook 'post-command-hook 'viper-post-command-sentinel)
269 (remove-hook 'pre-command-hook 'viper-pre-command-sentinel) 269 (remove-hook 'pre-command-hook 'viper-pre-command-sentinel)
270 (add-hook 'pre-command-hook 'viper-pre-command-sentinel t) 270 (add-hook 'pre-command-hook 'viper-pre-command-sentinel t)
271 ;; These hooks will be added back if switching to insert/replace mode 271 ;; These hooks will be added back if switching to insert/replace mode
272 (viper-remove-hook 'viper-post-command-hooks 272 (remove-hook 'viper-post-command-hooks
273 'viper-insert-state-post-command-sentinel) 273 'viper-insert-state-post-command-sentinel 'local)
274 (viper-remove-hook 'viper-pre-command-hooks 274 (remove-hook 'viper-pre-command-hooks
275 'viper-insert-state-pre-command-sentinel) 275 'viper-insert-state-pre-command-sentinel 'local)
276 (setq viper-intermediate-command nil) 276 (setq viper-intermediate-command nil)
277 (cond ((eq new-state 'vi-state) 277 (cond ((eq new-state 'vi-state)
278 (cond ((member viper-current-state '(insert-state replace-state)) 278 (cond ((member viper-current-state '(insert-state replace-state))
@@ -314,10 +314,10 @@
314 (viper-move-marker-locally 'viper-insert-point (point))) 314 (viper-move-marker-locally 'viper-insert-point (point)))
315 (viper-move-marker-locally 315 (viper-move-marker-locally
316 'viper-last-posn-while-in-insert-state (point)) 316 'viper-last-posn-while-in-insert-state (point))
317 (viper-add-hook 'viper-post-command-hooks 317 (add-hook 'viper-post-command-hooks
318 'viper-insert-state-post-command-sentinel t) 318 'viper-insert-state-post-command-sentinel t 'local)
319 (viper-add-hook 'viper-pre-command-hooks 319 (add-hook 'viper-pre-command-hooks
320 'viper-insert-state-pre-command-sentinel t)) 320 'viper-insert-state-pre-command-sentinel t 'local))
321 ) ; outermost cond 321 ) ; outermost cond
322 322
323 ;; Nothing needs to be done to switch to emacs mode! Just set some 323 ;; Nothing needs to be done to switch to emacs mode! Just set some
@@ -958,23 +958,25 @@ as a Meta key and any number of multiple escapes is allowed."
958 958
959;; Compute numeric prefix arg value. 959;; Compute numeric prefix arg value.
960;; Invoked by EVENT. COM is the command part obtained so far. 960;; Invoked by EVENT. COM is the command part obtained so far.
961(defun viper-prefix-arg-value (event com) 961(defun viper-prefix-arg-value (event-char com)
962 (let ((viper-intermediate-command 'viper-digit-argument) 962 (let ((viper-intermediate-command 'viper-digit-argument)
963 value func) 963 value func)
964 ;; read while number 964 ;; read while number
965 (while (and (viper-characterp event) (>= event ?0) (<= event ?9)) 965 (while (and (viper-characterp event-char)
966 (setq value (+ (* (if (integerp value) value 0) 10) (- event ?0))) 966 (>= event-char ?0) (<= event-char ?9))
967 (setq event (viper-read-event-convert-to-char))) 967 (setq value (+ (* (if (integerp value) value 0) 10) (- event-char ?0)))
968 (setq event-char (viper-read-event-convert-to-char)))
968 969
969 (setq prefix-arg value) 970 (setq prefix-arg value)
970 (if com (setq prefix-arg (cons prefix-arg com))) 971 (if com (setq prefix-arg (cons prefix-arg com)))
971 (while (eq event ?U) 972 (while (eq event-char ?U)
972 (viper-describe-arg prefix-arg) 973 (viper-describe-arg prefix-arg)
973 (setq event (viper-read-event-convert-to-char))) 974 (setq event-char (viper-read-event-convert-to-char)))
974 975
975 (if (or com (and (not (eq viper-current-state 'vi-state)) 976 (if (or com (and (not (eq viper-current-state 'vi-state))
976 ;; make sure it is a Vi command 977 ;; make sure it is a Vi command
977 (viper-characterp event) (viper-vi-command-p event) 978 (viper-characterp event-char)
979 (viper-vi-command-p event-char)
978 )) 980 ))
979 ;; If appears to be one of the vi commands, 981 ;; If appears to be one of the vi commands,
980 ;; then execute it with funcall and clear prefix-arg in order to not 982 ;; then execute it with funcall and clear prefix-arg in order to not
@@ -986,21 +988,21 @@ as a Meta key and any number of multiple escapes is allowed."
986 ;; etc., i.e., the user typed, say, d2. In this case, `com' would be 988 ;; etc., i.e., the user typed, say, d2. In this case, `com' would be
987 ;; `d', `w', etc. If viper-digit-argument was invoked by 989 ;; `d', `w', etc. If viper-digit-argument was invoked by
988 ;; viper-escape-to-vi (which is indicated by the fact that the 990 ;; viper-escape-to-vi (which is indicated by the fact that the
989 ;; current state is not vi-state), then `event' represents the vi 991 ;; current state is not vi-state), then `event-char' represents the
990 ;; command to be executed (e.g., `d', `w', etc). Again, 992 ;; vi command to be executed (e.g., `d', `w', etc). Again,
991 ;; last-command-char must make emacs believe that this is the command 993 ;; last-command-char must make emacs believe that this is the command
992 ;; we typed. 994 ;; we typed.
993 (cond ((eq event 'return) (setq event ?\C-m)) 995 (cond ((eq event-char 'return) (setq event-char ?\C-m))
994 ((eq event 'delete) (setq event ?\C-?)) 996 ((eq event-char 'delete) (setq event-char ?\C-?))
995 ((eq event 'backspace) (setq event ?\C-h)) 997 ((eq event-char 'backspace) (setq event-char ?\C-h))
996 ((eq event 'space) (setq event ?\ ))) 998 ((eq event-char 'space) (setq event-char ?\ )))
997 (setq last-command-char (or com event)) 999 (setq last-command-char (or com event-char))
998 (setq func (viper-exec-form-in-vi 1000 (setq func (viper-exec-form-in-vi
999 (` (key-binding (char-to-string (, event)))))) 1001 (` (key-binding (char-to-string (, event-char))))))
1000 (funcall func prefix-arg) 1002 (funcall func prefix-arg)
1001 (setq prefix-arg nil)) 1003 (setq prefix-arg nil))
1002 ;; some other command -- let emacs do it in its own way 1004 ;; some other command -- let emacs do it in its own way
1003 (viper-set-unread-command-events event)) 1005 (viper-set-unread-command-events event-char))
1004 )) 1006 ))
1005 1007
1006 1008
@@ -1239,6 +1241,7 @@ as a Meta key and any number of multiple escapes is allowed."
1239 (setq viper-use-register nil))) 1241 (setq viper-use-register nil)))
1240 (setq last-command 1242 (setq last-command
1241 (if (eq last-command 'd-command) 'kill-region nil)) 1243 (if (eq last-command 'd-command) 'kill-region nil))
1244 (message "Deleted %d characters" (abs (- (point) viper-com-point)))
1242 (kill-region viper-com-point (point)) 1245 (kill-region viper-com-point (point))
1243 (setq this-command 'd-command) 1246 (setq this-command 'd-command)
1244 (if viper-ex-style-motion 1247 (if viper-ex-style-motion
@@ -1261,10 +1264,12 @@ as a Meta key and any number of multiple escapes is allowed."
1261 (setq viper-use-register nil))) 1264 (setq viper-use-register nil)))
1262 (setq last-command 1265 (setq last-command
1263 (if (eq last-command 'D-command) 'kill-region nil)) 1266 (if (eq last-command 'D-command) 'kill-region nil))
1267 (message "Deleted %d lines" (count-lines (point) viper-com-point))
1264 (kill-region (mark t) (point)) 1268 (kill-region (mark t) (point))
1265 (if (eq m-com 'viper-line) (setq this-command 'D-command))) 1269 (if (eq m-com 'viper-line) (setq this-command 'D-command)))
1266 (back-to-indentation)) 1270 (back-to-indentation))
1267 1271
1272;; save region
1268(defun viper-exec-yank (m-com com) 1273(defun viper-exec-yank (m-com com)
1269 (or (and (markerp viper-com-point) (marker-position viper-com-point)) 1274 (or (and (markerp viper-com-point) (marker-position viper-com-point))
1270 (set-marker viper-com-point (point) (current-buffer))) 1275 (set-marker viper-com-point (point) (current-buffer)))
@@ -1281,8 +1286,10 @@ as a Meta key and any number of multiple escapes is allowed."
1281 (setq viper-use-register nil))) 1286 (setq viper-use-register nil)))
1282 (setq last-command nil) 1287 (setq last-command nil)
1283 (copy-region-as-kill viper-com-point (point)) 1288 (copy-region-as-kill viper-com-point (point))
1289 (message "Saved %d characters" (abs (- (point) viper-com-point)))
1284 (goto-char viper-com-point)) 1290 (goto-char viper-com-point))
1285 1291
1292;; save lines
1286(defun viper-exec-Yank (m-com com) 1293(defun viper-exec-Yank (m-com com)
1287 (save-excursion 1294 (save-excursion
1288 (set-mark viper-com-point) 1295 (set-mark viper-com-point)
@@ -1299,7 +1306,8 @@ as a Meta key and any number of multiple escapes is allowed."
1299 (error viper-InvalidRegister viper-use-register))) 1306 (error viper-InvalidRegister viper-use-register)))
1300 (setq viper-use-register nil))) 1307 (setq viper-use-register nil)))
1301 (setq last-command nil) 1308 (setq last-command nil)
1302 (copy-region-as-kill (mark t) (point))) 1309 (copy-region-as-kill (mark t) (point))
1310 (message "Saved %d lines" (count-lines (mark t) (point))))
1303 (viper-deactivate-mark) 1311 (viper-deactivate-mark)
1304 (goto-char viper-com-point)) 1312 (goto-char viper-com-point))
1305 1313
@@ -2110,22 +2118,23 @@ problems."
2110 (setq viper-began-as-replace t 2118 (setq viper-began-as-replace t
2111 viper-sitting-in-replace t 2119 viper-sitting-in-replace t
2112 viper-replace-chars-to-delete 0) 2120 viper-replace-chars-to-delete 0)
2113 (viper-add-hook 2121 (add-hook
2114 'viper-after-change-functions 'viper-replace-mode-spy-after t) 2122 'viper-after-change-functions 'viper-replace-mode-spy-after t 'local)
2115 (viper-add-hook 2123 (add-hook
2116 'viper-before-change-functions 'viper-replace-mode-spy-before t) 2124 'viper-before-change-functions 'viper-replace-mode-spy-before t 'local)
2117 ;; this will get added repeatedly, but no harm 2125 ;; this will get added repeatedly, but no harm
2118 (add-hook 'after-change-functions 'viper-after-change-sentinel t) 2126 (add-hook 'after-change-functions 'viper-after-change-sentinel t)
2119 (add-hook 'before-change-functions 'viper-before-change-sentinel t) 2127 (add-hook 'before-change-functions 'viper-before-change-sentinel t)
2120 (viper-move-marker-locally 'viper-last-posn-in-replace-region 2128 (viper-move-marker-locally
2121 (viper-replace-start)) 2129 'viper-last-posn-in-replace-region (viper-replace-start))
2122 (viper-add-hook 2130 (add-hook
2123 'viper-post-command-hooks 'viper-replace-state-post-command-sentinel t) 2131 'viper-post-command-hooks 'viper-replace-state-post-command-sentinel
2124 (viper-add-hook 2132 t 'local)
2125 'viper-pre-command-hooks 'viper-replace-state-pre-command-sentinel t) 2133 (add-hook
2134 'viper-pre-command-hooks 'viper-replace-state-pre-command-sentinel t 'local)
2126 ;; guard against a smartie who switched from R-replace to normal replace 2135 ;; guard against a smartie who switched from R-replace to normal replace
2127 (viper-remove-hook 2136 (remove-hook
2128 'viper-post-command-hooks 'viper-R-state-post-command-sentinel) 2137 'viper-post-command-hooks 'viper-R-state-post-command-sentinel 'local)
2129 (if overwrite-mode (overwrite-mode nil)) 2138 (if overwrite-mode (overwrite-mode nil))
2130 ) 2139 )
2131 2140
@@ -2210,14 +2219,14 @@ problems."
2210;; the overlay and current point is before the end of the overlay. 2219;; the overlay and current point is before the end of the overlay.
2211;; Don't delete anything if current point is past the end of the overlay. 2220;; Don't delete anything if current point is past the end of the overlay.
2212(defun viper-finish-change () 2221(defun viper-finish-change ()
2213 (viper-remove-hook 2222 (remove-hook
2214 'viper-after-change-functions 'viper-replace-mode-spy-after) 2223 'viper-after-change-functions 'viper-replace-mode-spy-after 'local)
2215 (viper-remove-hook 2224 (remove-hook
2216 'viper-before-change-functions 'viper-replace-mode-spy-before) 2225 'viper-before-change-functions 'viper-replace-mode-spy-before 'local)
2217 (viper-remove-hook 2226 (remove-hook
2218 'viper-post-command-hooks 'viper-replace-state-post-command-sentinel) 2227 'viper-post-command-hooks 'viper-replace-state-post-command-sentinel 'local)
2219 (viper-remove-hook 2228 (remove-hook
2220 'viper-pre-command-hooks 'viper-replace-state-pre-command-sentinel) 2229 'viper-pre-command-hooks 'viper-replace-state-pre-command-sentinel 'local)
2221 (viper-restore-cursor-color-after-replace) 2230 (viper-restore-cursor-color-after-replace)
2222 (setq viper-sitting-in-replace nil) ; just in case we'll need to know it 2231 (setq viper-sitting-in-replace nil) ; just in case we'll need to know it
2223 (save-excursion 2232 (save-excursion
@@ -2246,22 +2255,22 @@ problems."
2246 (setq kill-ring-yank-pointer kill-ring)) 2255 (setq kill-ring-yank-pointer kill-ring))
2247 2256
2248(defun viper-finish-R-mode () 2257(defun viper-finish-R-mode ()
2249 (viper-remove-hook 2258 (remove-hook
2250 'viper-post-command-hooks 'viper-R-state-post-command-sentinel) 2259 'viper-post-command-hooks 'viper-R-state-post-command-sentinel 'local)
2251 (viper-remove-hook 2260 (remove-hook
2252 'viper-pre-command-hooks 'viper-replace-state-pre-command-sentinel) 2261 'viper-pre-command-hooks 'viper-replace-state-pre-command-sentinel 'local)
2253 (viper-downgrade-to-insert)) 2262 (viper-downgrade-to-insert))
2254 2263
2255(defun viper-start-R-mode () 2264(defun viper-start-R-mode ()
2256 ;; Leave arg as 1, not t: XEmacs insists that it must be a pos number 2265 ;; Leave arg as 1, not t: XEmacs insists that it must be a pos number
2257 (overwrite-mode 1) 2266 (overwrite-mode 1)
2258 (viper-add-hook 2267 (add-hook
2259 'viper-post-command-hooks 'viper-R-state-post-command-sentinel t) 2268 'viper-post-command-hooks 'viper-R-state-post-command-sentinel t 'local)
2260 (viper-add-hook 2269 (add-hook
2261 'viper-pre-command-hooks 'viper-replace-state-pre-command-sentinel t) 2270 'viper-pre-command-hooks 'viper-replace-state-pre-command-sentinel t 'local)
2262 ;; guard against a smartie who switched from R-replace to normal replace 2271 ;; guard against a smartie who switched from R-replace to normal replace
2263 (viper-remove-hook 2272 (remove-hook
2264 'viper-post-command-hooks 'viper-replace-state-post-command-sentinel) 2273 'viper-post-command-hooks 'viper-replace-state-post-command-sentinel 'local)
2265 ) 2274 )
2266 2275
2267 2276
@@ -2907,21 +2916,37 @@ On reaching beginning of line, stop and signal error."
2907 (cmd (if (eq viper-intermediate-command 'viper-repeat) 2916 (cmd (if (eq viper-intermediate-command 'viper-repeat)
2908 (nth 5 viper-d-com) 2917 (nth 5 viper-d-com)
2909 (viper-array-to-string (this-command-keys)))) 2918 (viper-array-to-string (this-command-keys))))
2910 point) 2919 point region-beg region-end)
2911 (save-excursion 2920 (save-excursion
2912 (save-restriction 2921 (save-restriction
2913 (if (> arg 0) 2922 (if (> arg 0) ; forward
2914 (narrow-to-region 2923 (progn
2915 ;; forward search begins here 2924 (setq region-beg (point))
2916 (if (eolp) (error "Command `%s': At end of line" cmd) (point)) 2925 (if viper-allow-multiline-replace-regions
2917 ;; forward search ends here 2926 (viper-forward-paragraph 1)
2918 (progn (end-of-line) (point))) 2927 (end-of-line))
2919 (narrow-to-region 2928 (setq region-end (point)))
2920 ;; backward search begins from here 2929 (setq region-end (point))
2921 (if (bolp) 2930 (if viper-allow-multiline-replace-regions
2922 (error "Command `%s': At beginning of line" cmd) (point)) 2931 (viper-backward-paragraph 1)
2923 ;; backward search ends here 2932 (beginning-of-line))
2924 (progn (beginning-of-line) (point)))) 2933 (setq region-beg (point)))
2934 (if (or (and (< arg 0)
2935 (< (- region-end region-beg)
2936 (if viper-allow-multiline-replace-regions
2937 2 1))
2938 (bolp))
2939 (and (> arg 0)
2940 (< (- region-end region-beg)
2941 (if viper-allow-multiline-replace-regions
2942 3 2))
2943 (eolp)))
2944 (error "Command `%s': At %s of %s"
2945 cmd
2946 (if (> arg 0) "end" "beginning")
2947 (if viper-allow-multiline-replace-regions
2948 "paragraph" "line")))
2949 (narrow-to-region region-beg region-end)
2925 ;; if arg > 0, point is forwarded before search. 2950 ;; if arg > 0, point is forwarded before search.
2926 (if (> arg 0) (goto-char (1+ (point-min))) 2951 (if (> arg 0) (goto-char (1+ (point-min)))
2927 (goto-char (point-max))) 2952 (goto-char (point-max)))
@@ -3242,7 +3267,7 @@ controlled by the sign of prefix numeric value."
3242 (if viper-parse-sexp-ignore-comments "" "NOT ")))) 3267 (if viper-parse-sexp-ignore-comments "" "NOT "))))
3243 3268
3244 3269
3245;; sentence ,paragraph and heading 3270;; sentence, paragraph and heading
3246 3271
3247(defun viper-forward-sentence (arg) 3272(defun viper-forward-sentence (arg)
3248 "Forward sentence." 3273 "Forward sentence."
@@ -3272,7 +3297,9 @@ controlled by the sign of prefix numeric value."
3272 (or (eq last-command this-command) 3297 (or (eq last-command this-command)
3273 (push-mark nil t)) 3298 (push-mark nil t))
3274 (let ((val (viper-p-val arg)) 3299 (let ((val (viper-p-val arg))
3275 (com (viper-getCom arg))) 3300 ;; if you want d} operate on whole lines, change viper-getcom to
3301 ;; viper-getCom below
3302 (com (viper-getcom arg)))
3276 (if com (viper-move-marker-locally 'viper-com-point (point))) 3303 (if com (viper-move-marker-locally 'viper-com-point (point)))
3277 (forward-paragraph val) 3304 (forward-paragraph val)
3278 (if com 3305 (if com
@@ -3286,7 +3313,9 @@ controlled by the sign of prefix numeric value."
3286 (or (eq last-command this-command) 3313 (or (eq last-command this-command)
3287 (push-mark nil t)) 3314 (push-mark nil t))
3288 (let ((val (viper-p-val arg)) 3315 (let ((val (viper-p-val arg))
3289 (com (viper-getCom arg))) 3316 ;; if you want d{ operate on whole lines, change viper-getcom to
3317 ;; viper-getCom below
3318 (com (viper-getcom arg)))
3290 (if com (viper-move-marker-locally 'viper-com-point (point))) 3319 (if com (viper-move-marker-locally 'viper-com-point (point)))
3291 (backward-paragraph val) 3320 (backward-paragraph val)
3292 (if com 3321 (if com
@@ -3768,7 +3797,8 @@ Null string will repeat previous search."
3768 ((viper-valid-register viper-use-register) 3797 ((viper-valid-register viper-use-register)
3769 (get-register (downcase viper-use-register))) 3798 (get-register (downcase viper-use-register)))
3770 (t (error viper-InvalidRegister viper-use-register))) 3799 (t (error viper-InvalidRegister viper-use-register)))
3771 (current-kill 0)))) 3800 (current-kill 0)))
3801 sv-point)
3772 (if (null text) 3802 (if (null text)
3773 (if viper-use-register 3803 (if viper-use-register
3774 (let ((reg viper-use-register)) 3804 (let ((reg viper-use-register))
@@ -3787,7 +3817,11 @@ Null string will repeat previous search."
3787 (set-marker (viper-mark-marker) (point) (current-buffer)) 3817 (set-marker (viper-mark-marker) (point) (current-buffer))
3788 (viper-set-destructive-command 3818 (viper-set-destructive-command
3789 (list 'viper-put-back val nil viper-use-register nil nil)) 3819 (list 'viper-put-back val nil viper-use-register nil nil))
3790 (viper-loop val (viper-yank text))) 3820 (setq sv-point (point))
3821 (viper-loop val (viper-yank text))
3822 (message "Inserted %d character(s), %d line(s)"
3823 (abs (- (point) sv-point))
3824 (abs (count-lines (point) sv-point))))
3791 ;; Vi puts cursor on the last char when the yanked text doesn't contain a 3825 ;; Vi puts cursor on the last char when the yanked text doesn't contain a
3792 ;; newline; it leaves the cursor at the beginning when the text contains 3826 ;; newline; it leaves the cursor at the beginning when the text contains
3793 ;; a newline 3827 ;; a newline
diff --git a/lisp/emulation/viper-ex.el b/lisp/emulation/viper-ex.el
index 849124b5c43..a4d5bea9613 100644
--- a/lisp/emulation/viper-ex.el
+++ b/lisp/emulation/viper-ex.el
@@ -1,6 +1,6 @@
1;;; viper-ex.el --- functions implementing the Ex commands for Viper 1;;; viper-ex.el --- functions implementing the Ex commands for Viper
2 2
3;; Copyright (C) 1994, 1995, 1996, 1997 Free Software Foundation, Inc. 3;; Copyright (C) 1994, 1995, 1996, 1997, 1998 Free Software Foundation, Inc.
4 4
5;; This file is part of GNU Emacs. 5;; This file is part of GNU Emacs.
6 6
@@ -457,7 +457,9 @@ reversed."
457 "\\|" "jo.*" 457 "\\|" "jo.*"
458 "\\|" "^[ \t]*ta.*" 458 "\\|" "^[ \t]*ta.*"
459 "\\|" "^[ \t]*una.*" 459 "\\|" "^[ \t]*una.*"
460 "\\|" "^[ \t]*su.*" 460 ;; don't jump up in :s command
461 "\\|" "^[ \t]*\\([`'][a-z]\\|[.,%]\\)*[ \t]*su.*"
462 "\\|" "^[ \t]*\\([`'][a-z]\\|[.,%]\\)*[ \t]*s[^a-z].*"
461 "\\|" "['`][a-z][ \t]*" 463 "\\|" "['`][a-z][ \t]*"
462 ;; r! assumes that the next one is a shell command 464 ;; r! assumes that the next one is a shell command
463 "\\|" "\\(r\\|re\\|rea\\|read\\)[ \t]*!" 465 "\\|" "\\(r\\|re\\|rea\\|read\\)[ \t]*!"
@@ -631,40 +633,53 @@ reversed."
631 (set-buffer viper-ex-work-buf) 633 (set-buffer viper-ex-work-buf)
632 (skip-chars-forward " \t") 634 (skip-chars-forward " \t")
633 (if (looking-at "!") 635 (if (looking-at "!")
636 ;; this is probably a variant command r!
634 (progn 637 (progn
635 (setq ex-g-variant (not ex-g-variant) 638 (setq ex-g-variant (not ex-g-variant)
636 ex-g-flag (not ex-g-flag)) 639 ex-g-flag (not ex-g-flag))
637 (forward-char 1) 640 (forward-char 1)
638 (skip-chars-forward " \t"))) 641 (skip-chars-forward " \t")))
639 (let ((c (following-char))) 642 (let ((c (following-char)))
640 (if (string-match "[0-9A-Za-z]" (format "%c" c)) 643 (cond ((string-match "[0-9A-Za-z]" (format "%c" c))
641 (error 644 (error
642 "Global regexp must be inside matching non-alphanumeric chars")) 645 "Global regexp must be inside matching non-alphanumeric chars"))
646 ((= c ??) (error "`?' is not an allowed pattern delimiter here")))
643 (if (looking-at "[^\\\\\n]") 647 (if (looking-at "[^\\\\\n]")
644 (progn 648 (progn
645 (forward-char 1) 649 (forward-char 1)
646 (set-mark (point)) 650 (set-mark (point))
647 (let ((cont t)) 651 (let ((cont t))
648 (while (and (not (eolp)) cont) 652 ;; the use of eobp instead of eolp permits the use of newlines in
653 ;; pat2 in s/pat1/pat2/
654 (while (and (not (eobp)) cont)
649 (if (not (re-search-forward (format "[^%c]*%c" c c) nil t)) 655 (if (not (re-search-forward (format "[^%c]*%c" c c) nil t))
650 (if (member ex-token '("global" "vglobal")) 656 (if (member ex-token '("global" "vglobal"))
651 (error 657 (error "Missing closing delimiter for global regexp")
652 "Missing closing delimiter for global regexp")
653 (goto-char (point-max)))) 658 (goto-char (point-max))))
654 (if (not (viper-looking-back 659 (if (not (viper-looking-back
655 (format "[^\\\\]\\(\\\\\\\\\\)*\\\\%c" c))) 660 (format "[^\\\\]\\(\\\\\\\\\\)*\\\\%c" c)))
656 (setq cont nil)))) 661 (setq cont nil)
662 ;; we are at an escaped delimiter: unescape it and continue
663 (delete-backward-char 2)
664 (insert c)
665 (if (eolp)
666 ;; if at eol, exit loop and go to next line
667 ;; later, delim will be inserted at the end
668 (progn
669 (setq cont nil)
670 (forward-char))))
671 ))
657 (setq ex-token 672 (setq ex-token
658 (if (= (mark t) (point)) "" 673 (if (= (mark t) (point)) ""
659 (buffer-substring (1- (point)) (mark t)))) 674 (buffer-substring (1- (point)) (mark t))))
660 (backward-char 1) 675 (backward-char 1)
661 ;; if the user doesn't specify the final pattern delimiter, we're 676 ;; if the user didn't insert the final pattern delimiter, we're
662 ;; at newline now. In this case, insert the initial delimiter 677 ;; at newline now. In this case, insert the initial delimiter
663 ;; specified in variable c 678 ;; specified in variable c
664 (if (looking-at "\n") 679 (if (eolp)
665 (progn 680 (progn
666 (insert c) 681 (insert c)
667 (backward-char 1))) 682 (backward-char 1)))
668 ) 683 )
669 (setq ex-token nil)) 684 (setq ex-token nil))
670 c))) 685 c)))
@@ -707,8 +722,8 @@ reversed."
707 (cond ((null ex-addresses) 722 (cond ((null ex-addresses)
708 (setq ex-addresses 723 (setq ex-addresses
709 (if whole-flag 724 (if whole-flag
710 (cons (point-max) (cons (point-min) nil)) 725 (list (point-max) (point-min))
711 (cons (point) (cons (point) nil))))) 726 (list (point) (point)))))
712 ((null (cdr ex-addresses)) 727 ((null (cdr ex-addresses))
713 (setq ex-addresses 728 (setq ex-addresses
714 (cons (car ex-addresses) ex-addresses))))) 729 (cons (car ex-addresses) ex-addresses)))))
@@ -871,7 +886,7 @@ reversed."
871 (char (buffer-substring (match-beginning 0) (match-end 0)))) 886 (char (buffer-substring (match-beginning 0) (match-end 0))))
872 (if (viper-looking-back (concat "\\\\" char)) 887 (if (viper-looking-back (concat "\\\\" char))
873 (replace-match char) 888 (replace-match char)
874 (set-match-data data) 889 (store-match-data data)
875 (if (string= char "%") 890 (if (string= char "%")
876 (replace-match cf) 891 (replace-match cf)
877 (replace-match pf))))) 892 (replace-match pf)))))
@@ -1009,8 +1024,10 @@ reversed."
1009 (while cont 1024 (while cont
1010 (setq viper-keep-reading-filename nil 1025 (setq viper-keep-reading-filename nil
1011 val (read-file-name (concat prompt str) nil default-directory)) 1026 val (read-file-name (concat prompt str) nil default-directory))
1012 (if (string-match " " val) 1027 (setq val (expand-file-name val))
1013 (setq val (concat "\\\"" val "\\\""))) 1028 (if (and (string-match " " val)
1029 (ex-cmd-accepts-multiple-files-p ex-token))
1030 (setq val (concat "\"" val "\"")))
1014 (setq str (concat str (if (equal val "") "" " ") 1031 (setq str (concat str (if (equal val "") "" " ")
1015 val (if (equal val "") "" " "))) 1032 val (if (equal val "") "" " ")))
1016 1033
@@ -1237,27 +1254,27 @@ reversed."
1237 ((string= ex-file "") 1254 ((string= ex-file "")
1238 (error viper-NoFileSpecified))) 1255 (error viper-NoFileSpecified)))
1239 1256
1240 (let (msg do-edit) 1257;;; (let (msg do-edit)
1241 (if buffer-file-name 1258;;; (if buffer-file-name
1242 (cond ((buffer-modified-p) 1259;;; (cond ((buffer-modified-p)
1243 (setq msg 1260;;; (setq msg
1244 (format "Buffer %s is modified. Discard changes? " 1261;;; (format "Buffer %s is modified. Discard changes? "
1245 (buffer-name)) 1262;;; (buffer-name))
1246 do-edit t)) 1263;;; do-edit t))
1247 ((not (verify-visited-file-modtime (current-buffer))) 1264;;; ((not (verify-visited-file-modtime (current-buffer)))
1248 (setq msg 1265;;; (setq msg
1249 (format "File %s changed on disk. Reread from disk? " 1266;;; (format "File %s changed on disk. Reread from disk? "
1250 buffer-file-name) 1267;;; buffer-file-name)
1251 do-edit t)) 1268;;; do-edit t))
1252 (t (setq do-edit nil)))) 1269;;; (t (setq do-edit nil))))
1253 1270;;;
1254 (if do-edit 1271;;; (if do-edit
1255 (if (yes-or-no-p msg) 1272;;; (if (yes-or-no-p msg)
1256 (progn 1273;;; (progn
1257 (set-buffer-modified-p nil) 1274;;; (set-buffer-modified-p nil)
1258 (kill-buffer (current-buffer))) 1275;;; (kill-buffer (current-buffer)))
1259 (message "Buffer %s was left intact" (buffer-name)))) 1276;;; (message "Buffer %s was left intact" (buffer-name))))
1260 ) ; let 1277;;; ) ; let
1261 1278
1262 (if (null (setq file (get-file-buffer ex-file))) 1279 (if (null (setq file (get-file-buffer ex-file)))
1263 (progn 1280 (progn
@@ -1279,7 +1296,7 @@ reversed."
1279 (ex-fixup-history viper-last-ex-prompt ex-file)) 1296 (ex-fixup-history viper-last-ex-prompt ex-file))
1280 1297
1281;; Find-file FILESPEC if it appears to specify a single file. 1298;; Find-file FILESPEC if it appears to specify a single file.
1282;; Otherwise, assume that FILES{EC is a wildcard. 1299;; Otherwise, assume that FILESPEC is a wildcard.
1283;; In this case, split it into substrings separated by newlines. 1300;; In this case, split it into substrings separated by newlines.
1284;; Each line is assumed to be a file name. find-file's each file thus obtained. 1301;; Each line is assumed to be a file name. find-file's each file thus obtained.
1285(defun ex-find-file (filespec) 1302(defun ex-find-file (filespec)
@@ -1652,7 +1669,7 @@ reversed."
1652 (ask-if-save t) 1669 (ask-if-save t)
1653 (auto-cmd-label "; don't touch or else...") 1670 (auto-cmd-label "; don't touch or else...")
1654 (delete-turn-on-auto-fill-pattern 1671 (delete-turn-on-auto-fill-pattern
1655 "([ \t]*add-hook[ \t]+'viper-insert-state-hooks[ \t]+'turn-on-auto-fill.*)") 1672 "([ \t]*add-hook[ \t]+'viper-insert-state-hook[ \t]+'turn-on-auto-fill.*)")
1656 actual-lisp-cmd lisp-cmd-del-pattern 1673 actual-lisp-cmd lisp-cmd-del-pattern
1657 val2 orig-var) 1674 val2 orig-var)
1658 (setq orig-var var) 1675 (setq orig-var var)
@@ -1770,7 +1787,7 @@ reversed."
1770 (if (> val2 0) 1787 (if (> val2 0)
1771 (viper-save-string-in-file 1788 (viper-save-string-in-file
1772 (concat 1789 (concat
1773 "(add-hook 'viper-insert-state-hooks 'turn-on-auto-fill) " 1790 "(add-hook 'viper-insert-state-hook 'turn-on-auto-fill) "
1774 auto-cmd-label) 1791 auto-cmd-label)
1775 viper-custom-file-name 1792 viper-custom-file-name
1776 delete-turn-on-auto-fill-pattern) 1793 delete-turn-on-auto-fill-pattern)
@@ -1902,8 +1919,12 @@ Please contact your system administrator. "
1902 (point-marker)))) 1919 (point-marker))))
1903 (goto-char (min (point) (mark t))) 1920 (goto-char (min (point) (mark t)))
1904 (while (< (point) limit) 1921 (while (< (point) limit)
1905 (end-of-line) 1922 (save-excursion
1906 (setq eol-mark (point-marker)) 1923 (end-of-line)
1924 ;; This move allows the use of newline as the last character in
1925 ;; the substitution pattern
1926 (viper-forward-char-carefully)
1927 (setq eol-mark (point-marker)))
1907 (beginning-of-line) 1928 (beginning-of-line)
1908 (if opt-g 1929 (if opt-g
1909 (progn 1930 (progn
@@ -1927,8 +1948,10 @@ Please contact your system administrator. "
1927 (if (not (stringp repl)) 1948 (if (not (stringp repl))
1928 (error "Can't perform Ex substitution: No previous replacement pattern")) 1949 (error "Can't perform Ex substitution: No previous replacement pattern"))
1929 (replace-match repl t))) 1950 (replace-match repl t)))
1930 (end-of-line) 1951 ;;(end-of-line)
1931 (viper-forward-char-carefully)))))) 1952 ;;(viper-forward-char-carefully)
1953 (goto-char eol-mark)
1954 )))))
1932 (if matched-pos (goto-char matched-pos)) 1955 (if matched-pos (goto-char matched-pos))
1933 (beginning-of-line) 1956 (beginning-of-line)
1934 (if opt-c (message "done")))) 1957 (if opt-c (message "done"))))
@@ -1994,68 +2017,59 @@ Please contact your system administrator. "
1994 (setq file-exists (file-exists-p ex-file) 2017 (setq file-exists (file-exists-p ex-file)
1995 writing-same-file (string= ex-file (buffer-file-name))) 2018 writing-same-file (string= ex-file (buffer-file-name)))
1996 2019
2020 ;; do actual writing
1997 (if (and writing-whole-file writing-same-file) 2021 (if (and writing-whole-file writing-same-file)
2022 ;; saving whole buffer in visited file
1998 (if (not (buffer-modified-p)) 2023 (if (not (buffer-modified-p))
1999 (message "(No changes need to be saved)") 2024 (message "(No changes need to be saved)")
2025 (viper-maybe-checkout (current-buffer))
2000 (save-buffer) 2026 (save-buffer)
2001 (save-restriction 2027 (save-restriction
2002 (widen) 2028 (widen)
2003 (ex-write-info file-exists ex-file (point-min) (point-max)) 2029 (ex-write-info file-exists ex-file (point-min) (point-max))
2004 )) 2030 ))
2005 ;; writing some other file or portion of the current file 2031 ;; writing to non-visited file and it already exists
2006 (cond ((and file-exists 2032 (if (and file-exists (not writing-same-file)
2007 (not writing-same-file) 2033 (not (yes-or-no-p
2008 (not (yes-or-no-p 2034 (format "File %s exists. Overwrite? " ex-file))))
2009 (format "File %s exists. Overwrite? " ex-file)))) 2035 (error "Quit"))
2010 (error "Quit")) 2036 ;; writing a region or whole buffer to non-visited file
2011 ((and writing-whole-file (not ex-append)) 2037 (unwind-protect
2012 (unwind-protect 2038 (save-excursion
2013 (progn 2039 (viper-enlarge-region beg end)
2014 (set-visited-file-name ex-file) 2040 (setq region (buffer-substring (point) (mark t)))
2015 (set-buffer-modified-p t) 2041 ;; create temp buffer for the region
2016 (save-buffer)) 2042 (setq temp-buf (get-buffer-create " *ex-write*"))
2017 ;; restore the buffer file name 2043 (set-buffer temp-buf)
2018 (set-visited-file-name orig-buf-file-name) 2044 (set-visited-file-name ex-file 'noquerry)
2019 (set-buffer-modified-p buff-changed-p) 2045 (erase-buffer)
2020 ;; If the buffer wasn't visiting a file, restore buffer name. 2046 (if (and file-exists ex-append)
2021 ;; Name could've been changed by packages such as uniquify. 2047 (insert-file-contents ex-file))
2022 (or orig-buf-file-name 2048 (goto-char (point-max))
2023 (progn 2049 (insert region)
2024 (unlock-buffer) 2050 ;; ask user
2025 (rename-buffer orig-buf-name)))) 2051 (viper-maybe-checkout (current-buffer))
2026 (save-restriction 2052 (save-buffer)
2027 (widen) 2053 (ex-write-info
2028 (ex-write-info 2054 file-exists ex-file (point-min) (point-max))
2029 file-exists ex-file (point-min) (point-max)))) 2055 )
2030 (t ; writing a region 2056 ;; this must be under unwind-protect so that
2031 (unwind-protect 2057 ;; temp-buf will be deleted in case of an error
2032 (save-excursion 2058 (set-buffer temp-buf)
2033 (viper-enlarge-region beg end) 2059 (set-buffer-modified-p nil)
2034 (setq region (buffer-substring (point) (mark t))) 2060 (kill-buffer temp-buf)
2035 ;; create temp buffer for the region 2061 ;; buffer/region has been written, now take care of details
2036 (setq temp-buf (get-buffer-create " *ex-write*")) 2062 (set-buffer orig-buf)))
2037 (set-buffer temp-buf) 2063 ;; set the right file modification time
2038 (set-visited-file-name ex-file 'noquerry)
2039 (erase-buffer)
2040 (if (and file-exists ex-append)
2041 (insert-file-contents ex-file))
2042 (goto-char (point-max))
2043 (insert region)
2044 (save-buffer)
2045 (ex-write-info
2046 file-exists ex-file (point-min) (point-max))
2047 ))
2048 (set-buffer temp-buf)
2049 (set-buffer-modified-p nil)
2050 (kill-buffer temp-buf))
2051 ))
2052 (set-buffer orig-buf)
2053 ;; this prevents the loss of data if writing part of the buffer
2054 (if (and (buffer-file-name) writing-same-file) 2064 (if (and (buffer-file-name) writing-same-file)
2055 (set-visited-file-modtime)) 2065 (set-visited-file-modtime))
2066 ;; prevent loss of data if saving part of the buffer in visited file
2056 (or writing-whole-file 2067 (or writing-whole-file
2057 (not writing-same-file) 2068 (not writing-same-file)
2058 (set-buffer-modified-p t)) 2069 (progn
2070 (sit-for 2)
2071 (message "Warning: you have saved only part of the buffer!")
2072 (set-buffer-modified-p t)))
2059 (if q-flag 2073 (if q-flag
2060 (if (< viper-expert-level 2) 2074 (if (< viper-expert-level 2)
2061 (save-buffers-kill-emacs) 2075 (save-buffers-kill-emacs)
diff --git a/lisp/emulation/viper-init.el b/lisp/emulation/viper-init.el
index af9fb31ccc1..27217d83d15 100644
--- a/lisp/emulation/viper-init.el
+++ b/lisp/emulation/viper-init.el
@@ -30,6 +30,9 @@
30(defvar viper-current-state) 30(defvar viper-current-state)
31(defvar viper-version) 31(defvar viper-version)
32(defvar viper-expert-level) 32(defvar viper-expert-level)
33(defvar current-input-method)
34(defvar default-input-method)
35(defvar describe-current-input-method-function)
33;; end pacifier 36;; end pacifier
34 37
35 38
@@ -302,6 +305,7 @@ Use `M-x viper-set-expert-level' to change this.")
302 (or current-input-method default-input-method)) 305 (or current-input-method default-input-method))
303 ""))) 306 "")))
304 )) 307 ))
308
305;; viper hook to run on input-method deactivation 309;; viper hook to run on input-method deactivation
306(defun viper-inactivate-input-method-action () 310(defun viper-inactivate-input-method-action ()
307 (if (null viper-mule-hook-flag) 311 (if (null viper-mule-hook-flag)
@@ -367,14 +371,7 @@ it better fits your working style."
367 371
368;; Replace mode and changing text 372;; Replace mode and changing text
369 373
370;; Viper's own after/before change functions, which get viper-add-hook'ed to 374;; Hack used to pass global states around for short period of time
371;; Emacs's
372(viper-deflocalvar viper-after-change-functions nil "")
373(viper-deflocalvar viper-before-change-functions nil "")
374(viper-deflocalvar viper-post-command-hooks nil "")
375(viper-deflocalvar viper-pre-command-hooks nil "")
376
377;; Can be used to pass global states around for short period of time
378(viper-deflocalvar viper-intermediate-command nil "") 375(viper-deflocalvar viper-intermediate-command nil "")
379 376
380;; This is used to pass the right Vi command key sequence to 377;; This is used to pass the right Vi command key sequence to
@@ -542,7 +539,9 @@ programs and LaTeX documents."
542 :group 'viper) 539 :group 'viper)
543 540
544(defcustom viper-shift-width 8 541(defcustom viper-shift-width 8
545 "*The shiftwidth variable." 542 "*The value of the shiftwidth.
543This determines the number of columns by which the Ctl-t moves the cursor in
544the Insert state."
546 :type 'integer 545 :type 'integer
547 :group 'viper) 546 :group 'viper)
548 547
@@ -791,15 +790,6 @@ Related buffers can be cycled through via :R and :P commands."
791 790
792;;; Face-saving tricks 791;;; Face-saving tricks
793 792
794;;(defcustom viper-replace-overlay-pixmap "gray3"
795;; "Pixmap to use for search face on non-color displays."
796;; :type 'string
797;; :group 'viper)
798;;(defcustom viper-search-face-pixmap "gray3"
799;; "Pixmap to use for search face on non-color displays."
800;; :type 'string
801;; :group 'viper)
802
803(defun viper-hide-face (face) 793(defun viper-hide-face (face)
804 (if (and (viper-has-face-support-p) viper-emacs-p) 794 (if (and (viper-has-face-support-p) viper-emacs-p)
805 (add-to-list 'facemenu-unlisted-faces face))) 795 (add-to-list 'facemenu-unlisted-faces face)))
@@ -810,21 +800,6 @@ Related buffers can be cycled through via :R and :P commands."
810 :prefix "viper-" 800 :prefix "viper-"
811 :group 'viper) 801 :group 'viper)
812 802
813;;(defvar viper-search-face
814;; (if (viper-has-face-support-p)
815;; (progn
816;; (make-face 'viper-search-face)
817;; (or (face-differs-from-default-p 'viper-search-face)
818;; ;; face wasn't set in .viper or .Xdefaults
819;; (if (viper-can-use-colors "Black" "khaki")
820;; (progn
821;; (set-face-background 'viper-search-face "khaki")
822;; (set-face-foreground 'viper-search-face "Black"))
823;; (set-face-underline-p 'viper-search-face t)
824;; (viper-set-face-pixmap 'viper-search-face
825;; viper-search-face-pixmap)))
826;; 'viper-search-face))
827;; "*Face used to flash out the search pattern.")
828 803
829(defface viper-search-face 804(defface viper-search-face
830 '((((class color)) (:foreground "Black" :background "khaki")) 805 '((((class color)) (:foreground "Black" :background "khaki"))
@@ -839,22 +814,6 @@ to customize the actual face object `viper-search-face'
839this variable represents.") 814this variable represents.")
840(viper-hide-face 'viper-search-face) 815(viper-hide-face 'viper-search-face)
841 816
842;;(defvar viper-replace-overlay-face
843;; (if (viper-has-face-support-p)
844;; (progn
845;; (make-face 'viper-replace-overlay-face)
846;; (or (face-differs-from-default-p 'viper-replace-overlay-face)
847;; (progn
848;; (if (viper-can-use-colors "darkseagreen2" "Black")
849;; (progn
850;; (set-face-background
851;; 'viper-replace-overlay-face "darkseagreen2")
852;; (set-face-foreground 'viper-replace-overlay-face "Black")))
853;; (set-face-underline-p 'viper-replace-overlay-face t)
854;; (viper-set-face-pixmap
855;; 'viper-replace-overlay-face viper-replace-overlay-pixmap)))
856;; 'viper-replace-overlay-face))
857;; "*Face for highlighting replace regions on a window display.")
858 817
859(defface viper-replace-overlay-face 818(defface viper-replace-overlay-face
860 '((((class color)) (:foreground "Black" :background "darkseagreen2")) 819 '((((class color)) (:foreground "Black" :background "darkseagreen2"))
@@ -869,31 +828,6 @@ to customize the actual face object `viper-replace-overlay-face'
869this variable represents.") 828this variable represents.")
870(viper-hide-face 'viper-replace-overlay-face) 829(viper-hide-face 'viper-replace-overlay-face)
871 830
872;;(defvar viper-minibuffer-emacs-face
873;; (if (viper-has-face-support-p)
874;; (progn
875;; (make-face 'viper-minibuffer-emacs-face)
876;; (or (face-differs-from-default-p 'viper-minibuffer-emacs-face)
877;; ;; face wasn't set in .viper or .Xdefaults
878;; (if viper-vi-style-in-minibuffer
879;; ;; emacs state is an exception in the minibuffer
880;; (if (viper-can-use-colors "darkseagreen2" "Black")
881;; (progn
882;; (set-face-background
883;; 'viper-minibuffer-emacs-face "darkseagreen2")
884;; (set-face-foreground
885;; 'viper-minibuffer-emacs-face "Black"))
886;; (copy-face 'modeline 'viper-minibuffer-emacs-face))
887;; ;; emacs state is the main state in the minibuffer
888;; (if (viper-can-use-colors "Black" "pink")
889;; (progn
890;; (set-face-background 'viper-minibuffer-emacs-face "pink")
891;; (set-face-foreground
892;; 'viper-minibuffer-emacs-face "Black"))
893;; (copy-face 'italic 'viper-minibuffer-emacs-face))
894;; ))
895;; 'viper-minibuffer-emacs-face))
896;; "Face used in the Minibuffer when it is in Emacs state.")
897 831
898(defface viper-minibuffer-emacs-face 832(defface viper-minibuffer-emacs-face
899 '((((class color)) (:foreground "Black" :background "darkseagreen2")) 833 '((((class color)) (:foreground "Black" :background "darkseagreen2"))
@@ -908,29 +842,6 @@ to customize the actual face object `viper-minibuffer-emacs-face'
908this variable represents.") 842this variable represents.")
909(viper-hide-face 'viper-minibuffer-emacs-face) 843(viper-hide-face 'viper-minibuffer-emacs-face)
910 844
911;;(defvar viper-minibuffer-insert-face
912;; (if (viper-has-face-support-p)
913;; (progn
914;; (make-face 'viper-minibuffer-insert-face)
915;; (or (face-differs-from-default-p 'viper-minibuffer-insert-face)
916;; (if viper-vi-style-in-minibuffer
917;; (if (viper-can-use-colors "Black" "pink")
918;; (progn
919;; (set-face-background 'viper-minibuffer-insert-face "pink")
920;; (set-face-foreground
921;; 'viper-minibuffer-insert-face "Black"))
922;; (copy-face 'italic 'viper-minibuffer-insert-face))
923;; ;; If Insert state is an exception
924;; (if (viper-can-use-colors "darkseagreen2" "Black")
925;; (progn
926;; (set-face-background
927;; 'viper-minibuffer-insert-face "darkseagreen2")
928;; (set-face-foreground
929;; 'viper-minibuffer-insert-face "Black"))
930;; (copy-face 'modeline 'viper-minibuffer-insert-face))
931;; (viper-italicize-face 'viper-minibuffer-insert-face)))
932;; 'viper-minibuffer-insert-face))
933;; "Face used in the Minibuffer when it is in Insert state.")
934 845
935(defface viper-minibuffer-insert-face 846(defface viper-minibuffer-insert-face
936 '((((class color)) (:foreground "Black" :background "pink")) 847 '((((class color)) (:foreground "Black" :background "pink"))
@@ -945,21 +856,6 @@ to customize the actual face object `viper-minibuffer-insert-face'
945this variable represents.") 856this variable represents.")
946(viper-hide-face 'viper-minibuffer-insert-face) 857(viper-hide-face 'viper-minibuffer-insert-face)
947 858
948;;(defvar viper-minibuffer-vi-face
949;; (if (viper-has-face-support-p)
950;; (progn
951;; (make-face 'viper-minibuffer-vi-face)
952;; (or (face-differs-from-default-p 'viper-minibuffer-vi-face)
953;; (if viper-vi-style-in-minibuffer
954;; (if (viper-can-use-colors "Black" "grey")
955;; (progn
956;; (set-face-background 'viper-minibuffer-vi-face "grey")
957;; (set-face-foreground 'viper-minibuffer-vi-face "Black"))
958;; (copy-face 'bold 'viper-minibuffer-vi-face))
959;; (copy-face 'bold 'viper-minibuffer-vi-face)
960;; (invert-face 'viper-minibuffer-vi-face)))
961;; 'viper-minibuffer-vi-face))
962;; "Face used in the Minibuffer when it is in Vi state.")
963 859
964(defface viper-minibuffer-vi-face 860(defface viper-minibuffer-vi-face
965 '((((class color)) (:foreground "DarkGreen" :background "grey")) 861 '((((class color)) (:foreground "DarkGreen" :background "grey"))
@@ -1006,9 +902,9 @@ Should be set in `~/.viper' file."
1006(viper-deflocalvar viper-minibuffer-overlay nil) 902(viper-deflocalvar viper-minibuffer-overlay nil)
1007 903
1008;; Hook, specific to Viper, which is run just *before* exiting the minibuffer. 904;; Hook, specific to Viper, which is run just *before* exiting the minibuffer.
1009;; Beginning with Emacs 19.26, the standard `minibuffer-exit-hook' is run 905;; This is needed because beginning with Emacs 19.26, the standard
1010;; *after* exiting the minibuffer 906;; `minibuffer-exit-hook' is run *after* exiting the minibuffer
1011(defvar viper-minibuffer-exit-hook '(viper-minibuffer-trim-tail)) 907(defvar viper-minibuffer-exit-hook nil)
1012 908
1013 909
1014;; Mode line 910;; Mode line
diff --git a/lisp/emulation/viper-keym.el b/lisp/emulation/viper-keym.el
index 8cdef6f27fe..c0e7f980acc 100644
--- a/lisp/emulation/viper-keym.el
+++ b/lisp/emulation/viper-keym.el
@@ -530,7 +530,7 @@ Arguments: (major-mode viper-state keymap)"
530 ;; Normalization usually doesn't help here, since one needs to 530 ;; Normalization usually doesn't help here, since one needs to
531 ;; normalize in the actual buffer where changes to the keymap are 531 ;; normalize in the actual buffer where changes to the keymap are
532 ;; to take place. However, it doesn't hurt, and it helps whenever this 532 ;; to take place. However, it doesn't hurt, and it helps whenever this
533 ;; function is actually called from within the right buffer. 533 ;; function is actually called from within the affected buffer.
534 (viper-normalize-minor-mode-map-alist) 534 (viper-normalize-minor-mode-map-alist)
535 535
536 (viper-set-mode-vars-for viper-current-state))) 536 (viper-set-mode-vars-for viper-current-state)))
diff --git a/lisp/emulation/viper-util.el b/lisp/emulation/viper-util.el
index 7f8a4a4a2e4..6cad4511d28 100644
--- a/lisp/emulation/viper-util.el
+++ b/lisp/emulation/viper-util.el
@@ -110,32 +110,12 @@
110 (cdr (assoc 'cursor-color (frame-parameters))) 110 (cdr (assoc 'cursor-color (frame-parameters)))
111 (color-instance-name (frame-property (selected-frame) 'cursor-color)))) 111 (color-instance-name (frame-property (selected-frame) 'cursor-color))))
112 112
113;;(defun viper-set-face-pixmap (face pixmap)
114;; "Set face pixmap on a monochrome display."
115;; (if (and (viper-window-display-p) (not (viper-color-display-p)))
116;; (condition-case nil
117;; (set-face-background-pixmap face pixmap)
118;; (error
119;; (message "Pixmap not found for %S: %s" (face-name face) pixmap)
120;; (sit-for 1)))))
121 113
122
123;; OS/2 114;; OS/2
124(cond ((eq (viper-device-type) 'pm) 115(cond ((eq (viper-device-type) 'pm)
125 (fset 'viper-color-defined-p 116 (fset 'viper-color-defined-p
126 (function (lambda (color) (assoc color pm-color-alist)))))) 117 (function (lambda (color) (assoc color pm-color-alist))))))
127 118
128;; needed to smooth out the difference between Emacs and XEmacs
129;;(defsubst viper-italicize-face (face)
130;; (if viper-xemacs-p
131;; (make-face-italic face)
132;; (make-face-italic face nil 'noerror)))
133
134;; test if display is color and the colors are defined
135;;(defsubst viper-can-use-colors (&rest colors)
136;; (if (viper-color-display-p)
137;; (not (memq nil (mapcar 'viper-color-defined-p colors)))
138;; ))
139 119
140;; cursor colors 120;; cursor colors
141(defun viper-change-cursor-color (new-color) 121(defun viper-change-cursor-color (new-color)
@@ -620,13 +600,69 @@ to write a custom function, similar to `viper-ex-nontrivial-find-file-unix'."
620 (let ((buf (find-file-noselect (substitute-in-file-name custom-file)))) 600 (let ((buf (find-file-noselect (substitute-in-file-name custom-file))))
621 (save-excursion 601 (save-excursion
622 (set-buffer buf) 602 (set-buffer buf)
623 (goto-char (point-min)) 603 (let (buffer-read-only)
624 (if pattern (delete-matching-lines pattern)) 604 (goto-char (point-min))
625 (goto-char (point-max)) 605 (if pattern (delete-matching-lines pattern))
626 (if string (insert string)) 606 (goto-char (point-max))
627 (save-buffer)) 607 (if string (insert string))
608 (save-buffer)))
628 (kill-buffer buf) 609 (kill-buffer buf)
629 )) 610 ))
611
612
613;; define remote file test
614(or (fboundp 'viper-file-remote-p) ; user supplied his own function: use it
615 (defun viper-file-remote-p (file-name)
616 (car (cond ((featurep 'efs-auto) (efs-ftp-path file-name))
617 ((fboundp 'file-remote-p) (file-remote-p file-name))
618 (t (require 'ange-ftp)
619 ;; Can happen only in Emacs, since XEmacs has file-remote-p
620 (ange-ftp-ftp-name file-name))))))
621
622
623
624;; This is a simple-minded check for whether a file is under version control.
625;; If file,v exists but file doesn't, this file is considered to be not checked
626;; in and not checked out for the purpose of patching (since patch won't be
627;; able to read such a file anyway).
628;; FILE is a string representing file name
629;;(defun viper-file-under-version-control (file)
630;; (let* ((filedir (file-name-directory file))
631;; (file-nondir (file-name-nondirectory file))
632;; (trial (concat file-nondir ",v"))
633;; (full-trial (concat filedir trial))
634;; (full-rcs-trial (concat filedir "RCS/" trial)))
635;; (and (stringp file)
636;; (file-exists-p file)
637;; (or
638;; (and
639;; (file-exists-p full-trial)
640;; ;; in FAT FS, `file,v' and `file' may turn out to be the same!
641;; ;; don't be fooled by this!
642;; (not (equal (file-attributes file)
643;; (file-attributes full-trial))))
644;; ;; check if a version is in RCS/ directory
645;; (file-exists-p full-rcs-trial)))
646;; ))
647
648
649(defsubst viper-file-checked-in-p (file)
650 (and (vc-backend file)
651 (not (vc-locking-user file))))
652;; checkout if visited file is checked in
653(defun viper-maybe-checkout (buf)
654 (let ((file (expand-file-name (buffer-file-name buf)))
655 (checkout-function (key-binding "\C-x\C-q")))
656 (if (and (viper-file-checked-in-p file)
657 (or (beep 1) t)
658 (y-or-n-p
659 (format
660 "File %s is checked in. Check it out? "
661 (viper-abbreviate-file-name file))))
662 (with-current-buffer buf
663 (command-execute checkout-function)))))
664
665
630 666
631 667
632;;; Overlays 668;;; Overlays
@@ -737,7 +773,8 @@ to write a custom function, similar to `viper-ex-nontrivial-find-file-unix'."
737 773
738 774
739(defsubst viper-is-in-minibuffer () 775(defsubst viper-is-in-minibuffer ()
740 (string-match "\*Minibuf-" (buffer-name))) 776 (save-match-data
777 (string-match "\*Minibuf-" (buffer-name))))
741 778
742 779
743 780
@@ -814,50 +851,6 @@ to write a custom function, similar to `viper-ex-nontrivial-find-file-unix'."
814 (cond (viper-xemacs-p (events-to-keys events)) 851 (cond (viper-xemacs-p (events-to-keys events))
815 (t events))) 852 (t events)))
816 853
817
818;; This is here because Emacs changed the way local hooks work.
819;;
820;;Add to the value of HOOK the function FUNCTION.
821;;FUNCTION is not added if already present.
822;;FUNCTION is added (if necessary) at the beginning of the hook list
823;;unless the optional argument APPEND is non-nil, in which case
824;;FUNCTION is added at the end.
825;;
826;;HOOK should be a symbol, and FUNCTION may be any valid function. If
827;;HOOK is void, it is first set to nil. If HOOK's value is a single
828;;function, it is changed to a list of functions."
829(defun viper-add-hook (hook function &optional append)
830 (if (not (boundp hook)) (set hook nil))
831 ;; If the hook value is a single function, turn it into a list.
832 (let ((old (symbol-value hook)))
833 (if (or (not (listp old)) (eq (car old) 'lambda))
834 (setq old (list old)))
835 (if (member function old)
836 nil
837 (set hook (if append
838 (append old (list function)) ; don't nconc
839 (cons function old))))))
840
841;; This is here because of Emacs's changes in the semantics of add/remove-hooks
842;; and due to the bugs they introduced.
843;;
844;; Remove from the value of HOOK the function FUNCTION.
845;; HOOK should be a symbol, and FUNCTION may be any valid function. If
846;; FUNCTION isn't the value of HOOK, or, if FUNCTION doesn't appear in the
847;; list of hooks to run in HOOK, then nothing is done. See `viper-add-hook'."
848(defun viper-remove-hook (hook function)
849 (if (or (not (boundp hook)) ;unbound symbol, or
850 (null (symbol-value hook)) ;value is nil, or
851 (null function)) ;function is nil, then
852 nil ;Do nothing.
853 (let ((hook-value (symbol-value hook)))
854 (if (consp hook-value)
855 ;; don't side-effect the list
856 (setq hook-value (delete function (copy-sequence hook-value)))
857 (if (equal hook-value function)
858 (setq hook-value nil)))
859 (set hook hook-value))))
860
861 854
862;; it is suggested that an event must be copied before it is assigned to 855;; it is suggested that an event must be copied before it is assigned to
863;; last-command-event in XEmacs 856;; last-command-event in XEmacs
diff --git a/lisp/emulation/viper.el b/lisp/emulation/viper.el
index 91feb773a24..9bc98b865a4 100644
--- a/lisp/emulation/viper.el
+++ b/lisp/emulation/viper.el
@@ -6,9 +6,9 @@
6;; Keywords: emulations 6;; Keywords: emulations
7;; Author: Michael Kifer <kifer@cs.sunysb.edu> 7;; Author: Michael Kifer <kifer@cs.sunysb.edu>
8 8
9;; Copyright (C) 1994, 1995, 1996, 1997 Free Software Foundation, Inc. 9;; Copyright (C) 1994, 1995, 1996, 1997, 1998 Free Software Foundation, Inc.
10 10
11(defconst viper-version "3.004 (Polyglot) of November 11, 1997" 11(defconst viper-version "3.02 (Polyglot) of March 7, 1998"
12 "The current version of Viper") 12 "The current version of Viper")
13 13
14;; This file is part of GNU Emacs. 14;; This file is part of GNU Emacs.
@@ -304,7 +304,8 @@
304(defvar mark-even-if-inactive) 304(defvar mark-even-if-inactive)
305(defvar quail-mode) 305(defvar quail-mode)
306(defvar viper-expert-level) 306(defvar viper-expert-level)
307(defvar viper-expert-level) 307(defvar viper-mode-string)
308(defvar viper-major-mode-modifier-list)
308 309
309;; loading happens only in non-interactive compilation 310;; loading happens only in non-interactive compilation
310;; in order to spare non-viperized emacs from being viperized 311;; in order to spare non-viperized emacs from being viperized
@@ -369,17 +370,123 @@ widget."
369 :tag "Set Viper Mode on Loading" 370 :tag "Set Viper Mode on Loading"
370 :group 'viper-misc) 371 :group 'viper-misc)
371 372
372(defcustom viper-non-vi-major-modes 373(defcustom viper-vi-state-mode-list
373 '(custom-mode dired-mode efs-mode internal-ange-ftp-mode tar-mode 374 '(fundamental-mode
374 mh-folder-mode gnus-group-mode gnus-summary-mode Info-mode 375 makefile-mode
375 Buffer-menu-mode view-mode vm-mode vm-summary-mode) 376 help-mode
376 "*A list of major modes that should never come up in Vi command mode. 377
377Viper automatically augments this list with some obvious modes, such as 378 awk-mode
378`dired-mode', `tar-mode', etc. So, don't put a mode on this list, unless 379 m4-mode
379it comes up in a wrong Viper state." 380
381 html-mode html-helper-mode
382 emacs-lisp-mode lisp-mode lisp-interaction-mode
383
384 java-mode cc-mode c-mode c++-mode
385 fortran-mode f90-mode
386 basic-mode
387 bat-mode
388 asm-mode
389 prolog-mode
390
391 text-mode indented-text-mode
392 tex-mode latex-mode bibtex-mode
393
394 completion-list-mode
395 compilation-mode
396
397 perl-mode
398 javascript-mode
399 tcl-mode
400 python-mode
401
402 sh-mode ksh-mode csh-mode
403
404 gnus-article-mode
405 mh-show-mode
406 )
407 "Major modes that require Vi command state."
380 :type '(repeat symbol) 408 :type '(repeat symbol)
381 :group 'viper-misc) 409 :group 'viper-misc)
382 410
411(defcustom viper-emacs-state-mode-list
412 '(custom-mode
413
414 dired-mode
415 efs-mode
416 tar-mode
417
418 mh-folder-mode
419 gnus-group-mode
420 gnus-summary-mode
421
422 Info-mode
423 Buffer-menu-mode
424
425 view-mode
426 vm-mode
427 vm-summary-mode)
428 "*A list of major modes that should come up in Emacs state.
429Normally, Viper would bring buffers up in Emacs state, unless the corresponding
430major mode has been placed on `viper-vi-state-mode-list' or
431`viper-insert-state-mode-list'. So, don't place a new mode on this list, unless
432it is coming up in a wrong Viper state."
433 :type '(repeat symbol)
434 :group 'viper-misc)
435
436(defcustom viper-insert-state-mode-list
437 '(internal-ange-ftp-mode comint-mode shell-mode)
438 "*A list of major modes that should come up in Vi Insert state."
439 :type '(repeat symbol)
440 :group 'viper-misc)
441
442
443;; used to set viper-major-mode-modifier-list in defcustom
444(defun viper-apply-major-mode-modifiers (&optional symbol value)
445 (if symbol
446 (set symbol value))
447 (mapcar (function
448 (lambda (triple)
449 (viper-modify-major-mode
450 (nth 0 triple) (nth 1 triple) (eval (nth 2 triple)))))
451 viper-major-mode-modifier-list))
452
453(defcustom viper-major-mode-modifier-list
454 '((help-mode emacs-state viper-slash-and-colon-map)
455 (comint-mode insert-state viper-comint-mode-modifier-map)
456 (comint-mode vi-state viper-comint-mode-modifier-map)
457 (shell-mode insert-state viper-comint-mode-modifier-map)
458 (shell-mode vi-state viper-comint-mode-modifier-map)
459 (ange-ftp-shell-mode insert-state viper-comint-mode-modifier-map)
460 (ange-ftp-shell-mode vi-state viper-comint-mode-modifier-map)
461 (internal-ange-ftp-mode insert-state viper-comint-mode-modifier-map)
462 (internal-ange-ftp-mode vi-state viper-comint-mode-modifier-map)
463 (dired-mode emacs-state viper-dired-modifier-map)
464 (tar-mode emacs-state viper-slash-and-colon-map)
465 (mh-folder-mode emacs-state viper-slash-and-colon-map)
466 (gnus-group-mode emacs-state viper-slash-and-colon-map)
467 (gnus-summary-mode emacs-state viper-slash-and-colon-map)
468 (Info-mode emacs-state viper-slash-and-colon-map)
469 (Buffer-menu-mode emacs-state viper-slash-and-colon-map)
470 )
471 "List specifying how to modify the various major modes to enable some Viperisms.
472The list has the structure: ((mode viper-state keymap) (mode viper-state
473keymap) ...). If `mode' is on the list, the `kemap' will be made active (on the
474minor-mode-map-alist) in the specified viper state.
475If you change this list, have to restart emacs for the change to take effect.
476However, if you did the change through the customization widget, then emacs
477needs to be restarted only if you deleted a triple mode-state-keymap from the
478list. No need to restart emacs in case of insertion or modification of an
479existing triple."
480 :type '(repeat
481 (list symbol
482 (choice (const emacs-state)
483 (const vi-state)
484 (const insert-state))
485 symbol))
486 :set 'viper-apply-major-mode-modifiers
487 :group 'viper-misc)
488
489
383 490
384 491
385 492
@@ -472,7 +579,8 @@ This startup message appears whenever you load Viper, unless you type `y' now."
472 )) 579 ))
473 (viper-set-expert-level 'dont-change-unless))) 580 (viper-set-expert-level 'dont-change-unless)))
474 581
475 (or (memq major-mode viper-non-vi-major-modes) ; don't switch to Vi 582 (or (memq major-mode viper-emacs-state-mode-list) ; don't switch to Vi
583 (memq major-mode viper-insert-state-mode-list) ; don't switch
476 (viper-change-state-to-vi))))) 584 (viper-change-state-to-vi)))))
477 585
478 586
@@ -517,8 +625,6 @@ remains buffer-local."
517 625
518 ;; restore non-viper vars 626 ;; restore non-viper vars
519 (setq-default 627 (setq-default
520 default-major-mode
521 (viper-standard-value 'default-major-mode viper-saved-non-viper-variables)
522 next-line-add-newlines 628 next-line-add-newlines
523 (viper-standard-value 629 (viper-standard-value
524 'next-line-add-newlines viper-saved-non-viper-variables) 630 'next-line-add-newlines viper-saved-non-viper-variables)
@@ -614,6 +720,7 @@ remains buffer-local."
614 (mapatoms 'viper-remove-hooks) 720 (mapatoms 'viper-remove-hooks)
615 (remove-hook 'comint-mode-hook 'viper-comint-mode-hook) 721 (remove-hook 'comint-mode-hook 'viper-comint-mode-hook)
616 (remove-hook 'minibuffer-setup-hook 'viper-minibuffer-setup-sentinel) 722 (remove-hook 'minibuffer-setup-hook 'viper-minibuffer-setup-sentinel)
723 (remove-hook 'change-major-mode-hook 'viper-major-mode-change-sentinel)
617 724
618 ;; unbind Viper mouse bindings 725 ;; unbind Viper mouse bindings
619 (viper-unbind-mouse-search-key) 726 (viper-unbind-mouse-search-key)
@@ -626,94 +733,65 @@ remains buffer-local."
626 ) ; end viper-go-away 733 ) ; end viper-go-away
627 734
628 735
736;; list of buffers that just changed their major mode
737;; used in a hack that triggers vi command mode whenever needed
738(defvar viper-new-major-mode-buffer-list nil)
739
740;; set appropriate Viper state in buffers that changed major mode
741(defun set-viper-state-in-major-mode ()
742 (mapcar
743 (function
744 (lambda (buf)
745 (if (viper-buffer-live-p buf)
746 (with-current-buffer buf
747 (cond ((and (memq major-mode viper-vi-state-mode-list)
748 (eq viper-current-state 'emacs-state))
749 (viper-mode))
750 ((memq major-mode viper-emacs-state-mode-list)
751 ;; not checking (eq viper-current-state 'emacs-state)
752 ;; because viper-current-state could have gotten it by
753 ;; default. we need viper-change-state-to-emacs here to have
754 ;; the keymaps take effect.
755 (viper-change-state-to-emacs))
756 ((and (memq major-mode viper-insert-state-mode-list)
757 (not (eq viper-current-state 'insert-state)))
758 (viper-change-state-to-insert))
759 )) ; with-current-buffer
760 ))) ; function
761 viper-new-major-mode-buffer-list)
762 ;; clear the list of bufs that changed major mode
763 (setq viper-new-major-mode-buffer-list nil)
764 ;; change the global value of hook
765 (remove-hook 'viper-post-command-hooks 'set-viper-state-in-major-mode))
766
767;; sets up post-command-hook to turn viper-mode, if the current mode is
768;; fundamental
769(defun viper-major-mode-change-sentinel ()
770 (save-match-data
771 (or (string-match "\*Minibuf-" (buffer-name))
772 (setq viper-new-major-mode-buffer-list
773 (cons (current-buffer) viper-new-major-mode-buffer-list))))
774 ;; change the global value of hook
775 (add-hook 'viper-post-command-hooks 'set-viper-state-in-major-mode t))
776
629 777
630 778
631;; This sets major mode hooks to make them come up in vi-state. 779;; This sets major mode hooks to make them come up in vi-state.
632(defun viper-set-hooks () 780(defun viper-set-hooks ()
633
634 ;; It is of course a misnomer to call viper-mode a `major mode'. 781 ;; It is of course a misnomer to call viper-mode a `major mode'.
635 ;; However, this has the effect that if the user didn't specify the 782 ;; However, this has the effect that if the user didn't specify the
636 ;; default mode, new buffers that fall back on the default will come up 783 ;; default mode, new buffers that fall back on the default will come up
637 ;; in Fundamental Mode and Vi state. 784 ;; in Fundamental Mode and Vi state.
638 (setq default-major-mode 'viper-mode) 785 (if (eq default-major-mode 'fundamental-mode)
639 786 (setq default-major-mode 'viper-mode))
640 ;; The following major modes should come up in vi-state
641 (defadvice fundamental-mode (after viper-fundamental-mode-ad activate)
642 "Run `viper-change-state-to-vi' on entry."
643 (viper-change-state-to-vi))
644
645 (defvar makefile-mode-hook)
646 (add-hook 'makefile-mode-hook 'viper-mode)
647
648 ;; Help mode is now for viewing only
649 (defvar help-mode-hook)
650 (add-hook 'help-mode-hook 'viper-change-state-to-emacs)
651 (viper-modify-major-mode 'help-mode 'emacs-state viper-slash-and-colon-map)
652
653 (defvar awk-mode-hook)
654 (add-hook 'awk-mode-hook 'viper-mode)
655 787
656 (defvar html-mode-hook) 788 (add-hook 'change-major-mode-hook 'viper-major-mode-change-sentinel)
657 (add-hook 'html-mode-hook 'viper-mode) 789 (add-hook 'find-file-hooks 'set-viper-state-in-major-mode)
658 (defvar html-helper-mode-hook)
659 (add-hook 'html-helper-mode-hook 'viper-mode)
660 790
661 (defvar java-mode-hook) 791 ;; keep this because many modes we don't know about use this hook
662 (add-hook 'java-mode-hook 'viper-mode)
663
664 (defvar javascript-mode-hook)
665 (add-hook 'javascript-mode-hook 'viper-mode)
666
667 (defvar emacs-lisp-mode-hook)
668 (add-hook 'emacs-lisp-mode-hook 'viper-mode)
669 (defvar lisp-mode-hook)
670 (add-hook 'lisp-mode-hook 'viper-mode)
671 (defvar lisp-interaction-mode-hook)
672 (add-hook 'lisp-interaction-mode-hook 'viper-mode)
673
674 (defvar bibtex-mode-hook)
675 (add-hook 'bibtex-mode-hook 'viper-mode)
676
677 (defvar cc-mode-hook)
678 (add-hook 'cc-mode-hook 'viper-mode)
679
680 (defvar c-mode-hook)
681 (add-hook 'c-mode-hook 'viper-mode)
682
683 (defvar c++-mode-hook)
684 (add-hook 'c++-mode-hook 'viper-mode)
685
686 (defvar fortran-mode-hook)
687 (add-hook 'fortran-mode-hook 'viper-mode)
688 (defvar f90-mode-hook)
689 (add-hook 'f90-mode-hook 'viper-mode)
690
691 (defvar basic-mode-hook)
692 (add-hook 'basic-mode-hook 'viper-mode)
693 (defvar bat-mode-hook)
694 (add-hook 'bat-mode-hook 'viper-mode)
695
696 (defvar asm-mode-hook)
697 (add-hook 'asm-mode-hook 'viper-mode)
698
699 (defvar prolog-mode-hook)
700 (add-hook 'prolog-mode-hook 'viper-mode)
701
702 (defvar text-mode-hook) 792 (defvar text-mode-hook)
703 (add-hook 'text-mode-hook 'viper-mode) 793 (add-hook 'text-mode-hook 'viper-mode)
704 794
705 (add-hook 'completion-list-mode-hook 'viper-mode)
706 (add-hook 'compilation-mode-hook 'viper-mode)
707
708 (defvar perl-mode-hook)
709 (add-hook 'perl-mode-hook 'viper-mode)
710
711 (defvar tcl-mode-hook)
712 (add-hook 'tcl-mode-hook 'viper-mode)
713
714 (defvar python-mode-hook)
715 (add-hook 'python-mode-hook 'viper-mode)
716
717 (defvar emerge-startup-hook) 795 (defvar emerge-startup-hook)
718 (add-hook 'emerge-startup-hook 'viper-change-state-to-emacs) 796 (add-hook 'emerge-startup-hook 'viper-change-state-to-emacs)
719 797
@@ -747,92 +825,18 @@ remains buffer-local."
747 (viper-change-state-to-emacs))) 825 (viper-change-state-to-emacs)))
748 826
749 ;; Emacs shell, ange-ftp, and comint-based modes 827 ;; Emacs shell, ange-ftp, and comint-based modes
750 (defvar comint-mode-hook) 828 (add-hook 'comint-mode-hook 'viper-comint-mode-hook) ; comint
751 (viper-modify-major-mode
752 'comint-mode 'insert-state viper-comint-mode-modifier-map)
753 (viper-modify-major-mode
754 'comint-mode 'vi-state viper-comint-mode-modifier-map)
755 (viper-modify-major-mode
756 'shell-mode 'insert-state viper-comint-mode-modifier-map)
757 (viper-modify-major-mode
758 'shell-mode 'vi-state viper-comint-mode-modifier-map)
759 ;; ange-ftp in XEmacs
760 (viper-modify-major-mode
761 'ange-ftp-shell-mode 'insert-state viper-comint-mode-modifier-map)
762 (viper-modify-major-mode
763 'ange-ftp-shell-mode 'vi-state viper-comint-mode-modifier-map)
764 ;; ange-ftp in Emacs
765 (viper-modify-major-mode
766 'internal-ange-ftp-mode 'insert-state viper-comint-mode-modifier-map)
767 (viper-modify-major-mode
768 'internal-ange-ftp-mode 'vi-state viper-comint-mode-modifier-map)
769 ;; set hook
770 (add-hook 'comint-mode-hook 'viper-comint-mode-hook)
771
772 ;; Shell scripts
773 (defvar sh-mode-hook)
774 (add-hook 'sh-mode-hook 'viper-mode)
775 (defvar ksh-mode-hook)
776 (add-hook 'ksh-mode-hook 'viper-mode)
777
778 ;; Dired
779 (viper-modify-major-mode 'dired-mode 'emacs-state viper-dired-modifier-map)
780 (viper-set-emacs-state-searchstyle-macros nil 'dired-mode)
781 (add-hook 'dired-mode-hook 'viper-change-state-to-emacs)
782
783 ;; Tar
784 (viper-modify-major-mode 'tar-mode 'emacs-state viper-slash-and-colon-map)
785 (viper-set-emacs-state-searchstyle-macros nil 'tar-mode)
786
787 ;; MH-E
788 (viper-modify-major-mode
789 'mh-folder-mode 'emacs-state viper-slash-and-colon-map)
790 (viper-set-emacs-state-searchstyle-macros nil 'mh-folder-mode)
791 ;; changing state to emacs is needed so the preceding will take hold
792 (add-hook 'mh-folder-mode-hook 'viper-change-state-to-emacs)
793 (add-hook 'mh-show-mode-hook 'viper-mode)
794
795 ;; Gnus
796 (viper-modify-major-mode
797 'gnus-group-mode 'emacs-state viper-slash-and-colon-map)
798 (viper-set-emacs-state-searchstyle-macros nil 'gnus-group-mode)
799 (viper-modify-major-mode
800 'gnus-summary-mode 'emacs-state viper-slash-and-colon-map)
801 (viper-set-emacs-state-searchstyle-macros nil 'gnus-summary-mode)
802 ;; changing state to emacs is needed so the preceding will take hold
803 (add-hook 'gnus-group-mode-hook 'viper-change-state-to-emacs)
804 (add-hook 'gnus-summary-mode-hook 'viper-change-state-to-emacs)
805 (add-hook 'gnus-article-mode-hook 'viper-mode)
806
807 ;; Info
808 (viper-modify-major-mode 'Info-mode 'emacs-state viper-slash-and-colon-map)
809 (viper-set-emacs-state-searchstyle-macros nil 'Info-mode)
810 ;; Switching to emacs is needed so the above will take hold
811 (defadvice Info-mode (after viper-Info-ad activate)
812 "Switch to emacs mode."
813 (viper-change-state-to-emacs))
814 829
815 ;; Buffer menu 830 (viper-set-emacs-state-searchstyle-macros nil 'dired-mode) ; dired
816 (viper-modify-major-mode 831 (viper-set-emacs-state-searchstyle-macros nil 'tar-mode) ; tar
817 'Buffer-menu-mode 'emacs-state viper-slash-and-colon-map) 832 (viper-set-emacs-state-searchstyle-macros nil 'mh-folder-mode) ; mhe
818 (viper-set-emacs-state-searchstyle-macros nil 'Buffer-menu-mode) 833 (viper-set-emacs-state-searchstyle-macros nil 'gnus-group-mode) ; gnus
819 ;; Switching to emacs is needed so the above will take hold 834 (viper-set-emacs-state-searchstyle-macros nil 'gnus-summary-mode)
820 (defadvice Buffer-menu-mode (after viper-Buffer-menu-ad activate) 835 (viper-set-emacs-state-searchstyle-macros nil 'Info-mode) ; info
821 "Switch to emacs mode." 836 (viper-set-emacs-state-searchstyle-macros nil 'Buffer-menu-mode) ;buffer-menu
822 (viper-change-state-to-emacs))
823 837
824 ;; View mode 838 ;; Modify major modes according to viper-major-mode-modifier-list
825 (defvar view-mode-hook) 839 (viper-apply-major-mode-modifiers)
826 (defvar view-hook)
827 (add-hook 'view-hook 'viper-change-state-to-emacs)
828 (add-hook 'view-mode-hook 'viper-change-state-to-emacs)
829
830 ;; For VM users.
831 ;; Put summary and other VM buffers in Emacs state.
832 (defvar vm-mode-hooks)
833 (defvar vm-summary-mode-hooks)
834 (add-hook 'vm-mode-hooks 'viper-change-state-to-emacs)
835 (add-hook 'vm-summary-mode-hooks 'viper-change-state-to-emacs)
836 840
837 ;; For RMAIL users. 841 ;; For RMAIL users.
838 ;; Put buf in Emacs state after edit. 842 ;; Put buf in Emacs state after edit.
@@ -968,12 +972,6 @@ remains buffer-local."
968 (read-key-sequence "Describe key briefly: "))))) 972 (read-key-sequence "Describe key briefly: ")))))
969 973
970 974
971 ;; This is now done in viper-minibuffer-exit-hook
972 ;;;; Advice for use in find-file and read-file-name commands.
973 ;;(defadvice exit-minibuffer (before viper-exit-minibuffer-advice activate)
974 ;; "Run `viper-minibuffer-exit-hook' just before exiting the minibuffer."
975 ;; (run-hooks 'viper-minibuffer-exit-hook))
976
977 (defadvice find-file (before viper-add-suffix-advice activate) 975 (defadvice find-file (before viper-add-suffix-advice activate)
978 "Use `read-file-name' for reading arguments." 976 "Use `read-file-name' for reading arguments."
979 (interactive (cons (read-file-name "Find file: " nil default-directory) 977 (interactive (cons (read-file-name "Find file: " nil default-directory)
@@ -1029,7 +1027,8 @@ remains buffer-local."
1029 (defadvice read-file-name (around viper-suffix-advice activate) 1027 (defadvice read-file-name (around viper-suffix-advice activate)
1030 "Tell `exit-minibuffer' to run `viper-file-add-suffix' as a hook." 1028 "Tell `exit-minibuffer' to run `viper-file-add-suffix' as a hook."
1031 (let ((viper-minibuffer-exit-hook 1029 (let ((viper-minibuffer-exit-hook
1032 (append viper-minibuffer-exit-hook '(viper-file-add-suffix)))) 1030 (append viper-minibuffer-exit-hook
1031 '(viper-minibuffer-trim-tail viper-file-add-suffix))))
1033 ad-do-it)) 1032 ad-do-it))
1034 1033
1035 (defadvice start-kbd-macro (after viper-kbd-advice activate) 1034 (defadvice start-kbd-macro (after viper-kbd-advice activate)
@@ -1081,7 +1080,7 @@ These two lines must come in the order given.
1081 1080
1082 ;; If viper-mode is t, then just continue. Viper will kick in. 1081 ;; If viper-mode is t, then just continue. Viper will kick in.
1083 ((eq viper-mode t)) 1082 ((eq viper-mode t))
1084 ;; Otherwise, it was asking mode and Viper was not loaded through .emacs 1083 ;; Otherwise, it was asking Viper was not loaded through .emacs
1085 ;; In this case, it was either through M-x viper-mode or via something 1084 ;; In this case, it was either through M-x viper-mode or via something
1086 ;; else, like the custom widget. If Viper was loaded through 1085 ;; else, like the custom widget. If Viper was loaded through
1087 ;; M-x viper-mode, then viper will kick in anyway. 1086 ;; M-x viper-mode, then viper will kick in anyway.
@@ -1109,7 +1108,6 @@ These two lines must come in the order given.
1109(if (null viper-saved-non-viper-variables) 1108(if (null viper-saved-non-viper-variables)
1110 (setq viper-saved-non-viper-variables 1109 (setq viper-saved-non-viper-variables
1111 (list 1110 (list
1112 (cons 'default-major-mode (list default-major-mode))
1113 (cons 'next-line-add-newlines (list next-line-add-newlines)) 1111 (cons 'next-line-add-newlines (list next-line-add-newlines))
1114 (cons 'require-final-newline (list require-final-newline)) 1112 (cons 'require-final-newline (list require-final-newline))
1115 (cons 'scroll-step (list scroll-step)) 1113 (cons 'scroll-step (list scroll-step))
@@ -1198,6 +1196,7 @@ These two lines must come in the order given.
1198 (viper-harness-minor-mode "russian") 1196 (viper-harness-minor-mode "russian")
1199 (viper-harness-minor-mode "view-less") 1197 (viper-harness-minor-mode "view-less")
1200 (viper-harness-minor-mode "view") 1198 (viper-harness-minor-mode "view")
1199 (viper-harness-minor-mode "reftex")
1201 )) 1200 ))
1202 1201
1203 1202
@@ -1251,7 +1250,9 @@ These two lines must come in the order given.
1251 (viper-change-state-to-emacs) 1250 (viper-change-state-to-emacs)
1252 (setq-default minor-mode-map-alist minor-mode-map-alist) 1251 (setq-default minor-mode-map-alist minor-mode-map-alist)
1253 )) 1252 ))
1254 1253
1254(if (and viper-mode (memq major-mode viper-vi-state-mode-list))
1255 (viper-mode))
1255 1256
1256 1257
1257(run-hooks 'viper-load-hook) ; the last chance to change something 1258(run-hooks 'viper-load-hook) ; the last chance to change something