Mercurial > emacs
changeset 21940:f7e788ea680b
new version
| author | Michael Kifer <kifer@cs.stonybrook.edu> |
|---|---|
| date | Mon, 04 May 1998 22:42:59 +0000 |
| parents | e9014d2166a4 |
| children | 1baa3e876ad0 |
| files | lisp/ediff-diff.el lisp/ediff-init.el lisp/ediff-util.el lisp/ediff-vers.el lisp/ediff-wind.el lisp/ediff.el lisp/emulation/viper-cmd.el lisp/emulation/viper-ex.el lisp/emulation/viper-init.el lisp/emulation/viper-keym.el lisp/emulation/viper-util.el lisp/emulation/viper.el |
| diffstat | 12 files changed, 559 insertions(+), 975 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/ediff-diff.el Mon May 04 22:33:38 1998 +0000 +++ b/lisp/ediff-diff.el Mon May 04 22:42:59 1998 +0000 @@ -1110,7 +1110,7 @@ (set-process-sentinel proc 'ediff-process-sentinel) (set-process-filter proc 'ediff-process-filter) ))) - (set-match-data data)))) + (store-match-data data)))) ;; This is shell-command-filter from simple.el in FSF Emacs. ;; Copied here because XEmacs doesn't have it.
--- a/lisp/ediff-init.el Mon May 04 22:33:38 1998 +0000 +++ b/lisp/ediff-init.el Mon May 04 22:42:59 1998 +0000 @@ -32,6 +32,7 @@ (defvar ediff-mouse-pixel-threshold) (defvar ediff-whitespace) (defvar ediff-multiframe) +(defvar ediff-use-toolbar-p) (and noninteractive (eval-when-compile @@ -59,15 +60,22 @@ (and (ediff-device-type) (not (memq (ediff-device-type) '(tty pc stream))))) ;; test if supports faces -;; ediff-force-faces is for those devices that support faces, but we don't know -;; this yet (defun ediff-has-face-support-p () (cond ((ediff-window-display-p)) (ediff-force-faces) (ediff-emacs-p (memq (ediff-device-type) '(pc))) (ediff-xemacs-p (memq (ediff-device-type) '(tty pc))))) - +(defun ediff-has-toolbar-support-p () + (and ediff-xemacs-p + (featurep 'toolbar) + (console-on-window-system-p))) + +(defun ediff-use-toolbar-p () + (and (ediff-has-toolbar-support-p) ;Can it do it ? + (boundp 'ediff-use-toolbar-p) + ediff-use-toolbar-p)) ;Does the user want it ? + ;; Defines SYMBOL as an advertised local variable. ;; Performs a defvar, then executes `make-variable-buffer-local' on ;; the variable. Also sets the `permanent-local' property, @@ -526,13 +534,14 @@ :group 'ediff) -(ediff-defvar-local ediff-use-faces t +(ediff-defvar-local ediff-use-faces nil "") +(defcustom ediff-use-faces t "If t, differences are highlighted using faces, if device supports faces. If nil, differences are highlighted using ASCII flags, ediff-before-flag and ediff-after-flag. On a non-window system, differences are always -highlighted using ASCII flags. -This variable can be set either in .emacs or toggled interactively. -Use `setq-default' if setting it in .emacs") +highlighted using ASCII flags." + :type 'boolean + :group 'ediff-highlighting) ;; this indicates that diff regions are word-size, so fine diffs are ;; permanently nixed; used in ediff-windows-wordwise and ediff-regions-wordwise @@ -569,10 +578,13 @@ :type 'boolean :group 'ediff) -(ediff-defvar-local ediff-highlight-all-diffs t +(ediff-defvar-local ediff-highlight-all-diffs nil "") +(defcustom ediff-highlight-all-diffs t "If nil, only the selected differences are highlighted. -This variable can be set either in .emacs or toggled interactively, using -ediff-toggle-hilit. Use `setq-default' to set it.") +Otherwise, all difference regions are highlighted, but the selected region is +shown in brighter colors." + :type 'boolean + :group 'ediff-highlighting) ;; A var local to each control panel buffer. Indicates highlighting style ;; in effect for this buffer: `face', `ascii', nil -- temporarily @@ -819,35 +831,6 @@ (t "")) ; none )) -;;(defun ediff-set-face (ground face color) -;; "Set face foreground/background." -;; (if (ediff-has-face-support-p) -;; (if (ediff-valid-color-p color) -;; (if (eq ground 'foreground) -;; (set-face-foreground face color) -;; (set-face-background face color)) -;; (cond ((memq face -;; '(ediff-current-diff-face-A -;; ediff-current-diff-face-B -;; ediff-current-diff-face-C -;; ediff-current-diff-face-Ancestor)) -;; (copy-face 'highlight face)) -;; ((memq face -;; '(ediff-fine-diff-face-A -;; ediff-fine-diff-face-B -;; ediff-fine-diff-face-C -;; ediff-fine-diff-face-Ancestor)) -;; (copy-face 'secondary-selection face) -;; (set-face-underline-p face t)) -;; ((memq face -;; '(ediff-even-diff-face-A -;; ediff-odd-diff-face-A -;; ediff-even-diff-face-B ediff-odd-diff-face-B -;; ediff-even-diff-face-C ediff-odd-diff-face-C -;; ediff-even-diff-face-Ancestor -;; ediff-odd-diff-face-Ancestor)) -;; (copy-face 'secondary-selection face)))) -;; )) (defun ediff-set-face-pixmap (face pixmap) "Set face pixmap on a monochrome display." @@ -863,23 +846,6 @@ (add-to-list 'facemenu-unlisted-faces face))) -;;(defvar ediff-current-diff-face-A -;; (if (ediff-has-face-support-p) -;; (progn -;; (make-face 'ediff-current-diff-face-A) -;; (or (face-differs-from-default-p 'ediff-current-diff-face-A) -;; (cond ((ediff-color-display-p) -;; (ediff-set-face -;; 'foreground 'ediff-current-diff-face-A "firebrick") -;; (ediff-set-face -;; 'background 'ediff-current-diff-face-A "pale green")) -;; (t -;; (if ediff-xemacs-p -;; (copy-face 'modeline 'ediff-current-diff-face-A) -;; (copy-face 'highlight 'ediff-current-diff-face-A)) -;; ))) -;; 'ediff-current-diff-face-A)) -;; "Face for highlighting the selected difference in buffer A.") (defface ediff-current-diff-face-A '((((class color)) (:foreground "firebrick" :background "pale green")) @@ -903,24 +869,6 @@ -;;(defvar ediff-current-diff-face-B -;; (if (ediff-has-face-support-p) -;; (progn -;; (make-face 'ediff-current-diff-face-B) -;; (or (face-differs-from-default-p 'ediff-current-diff-face-B) -;; (cond ((ediff-color-display-p) -;; (ediff-set-face -;; 'foreground 'ediff-current-diff-face-B "DarkOrchid") -;; (ediff-set-face -;; 'background 'ediff-current-diff-face-B "Yellow")) -;; (t -;; (if ediff-xemacs-p -;; (copy-face 'modeline 'ediff-current-diff-face-B) -;; (copy-face 'highlight 'ediff-current-diff-face-B)) -;; ))) -;; 'ediff-current-diff-face-B)) -;; "Face for highlighting the selected difference in buffer B.") - (defface ediff-current-diff-face-B '((((class color)) (:foreground "DarkOrchid" :background "Yellow")) (t (:inverse-video t))) @@ -941,23 +889,6 @@ (not (ediff-color-display-p))) (copy-face 'modeline 'ediff-current-diff-face-B)) -;;(defvar ediff-current-diff-face-C -;; (if (ediff-has-face-support-p) -;; (progn -;; (make-face 'ediff-current-diff-face-C) -;; (or (face-differs-from-default-p 'ediff-current-diff-face-C) -;; (cond ((ediff-color-display-p) -;; (ediff-set-face -;; 'foreground 'ediff-current-diff-face-C "Navy") -;; (ediff-set-face -;; 'background 'ediff-current-diff-face-C "Pink")) -;; (t -;; (if ediff-xemacs-p -;; (copy-face 'modeline 'ediff-current-diff-face-C) -;; (copy-face 'highlight 'ediff-current-diff-face-C)) -;; ))) -;; 'ediff-current-diff-face-C)) -;; "Face for highlighting the selected difference in buffer C.") (defface ediff-current-diff-face-C '((((class color)) (:foreground "Navy" :background "Pink")) @@ -979,15 +910,6 @@ (not (ediff-color-display-p))) (copy-face 'modeline 'ediff-current-diff-face-C)) -;;(defvar ediff-current-diff-face-Ancestor -;; (if (ediff-has-face-support-p) -;; (progn -;; (make-face 'ediff-current-diff-face-Ancestor) -;; (or (face-differs-from-default-p 'ediff-current-diff-face-Ancestor) -;; (copy-face -;; 'ediff-current-diff-face-C 'ediff-current-diff-face-Ancestor)) -;; 'ediff-current-diff-face-Ancestor)) -;; "Face for highlighting the selected difference in the ancestor buffer.") (defface ediff-current-diff-face-Ancestor '((((class color)) (:foreground "Black" :background "VioletRed")) @@ -1009,31 +931,6 @@ (not (ediff-color-display-p))) (copy-face 'modeline 'ediff-current-diff-face-Ancestor)) -;;(defvar ediff-fine-diff-pixmap "gray3" -;; "Pixmap to use for highlighting fine differences.") -;;(defvar ediff-odd-diff-pixmap "gray1" -;; "Pixmap to use for highlighting odd differences.") -;;(defvar ediff-even-diff-pixmap "Stipple" -;; "Pixmap to use for highlighting even differences.") - -;;(defvar ediff-fine-diff-face-A -;; (if (ediff-has-face-support-p) -;; (progn -;; (make-face 'ediff-fine-diff-face-A) -;; (or (face-differs-from-default-p 'ediff-fine-diff-face-A) -;; (cond ((ediff-color-display-p) -;; (ediff-set-face 'foreground 'ediff-fine-diff-face-A -;; "Navy") -;; (ediff-set-face 'background 'ediff-fine-diff-face-A -;; "sky blue")) -;; (t -;; (set-face-underline-p 'ediff-fine-diff-face-A t) -;; (ediff-set-face-pixmap 'ediff-fine-diff-face-A -;; ediff-fine-diff-pixmap) -;; ))) -;; 'ediff-fine-diff-face-A)) -;; "Face for highlighting the refinement of the selected diff in buffer A.") - (defface ediff-fine-diff-face-A '((((class color)) (:foreground "Navy" :background "sky blue")) @@ -1049,29 +946,6 @@ this variable represents.") (ediff-hide-face 'ediff-fine-diff-face-A) -;;;; Until custom.el for XEmacs starts supporting :stipple we do this. -;;;; This means that some user customization may be trashed. -;;(if (and ediff-xemacs-p -;; (ediff-has-face-support-p) -;; (not (ediff-color-display-p))) -;; (ediff-set-face-pixmap 'ediff-fine-diff-face-A "gray3")) - -;;(defvar ediff-fine-diff-face-B -;; (if (ediff-has-face-support-p) -;; (progn -;; (make-face 'ediff-fine-diff-face-B) -;; (or (face-differs-from-default-p 'ediff-fine-diff-face-B) -;; (cond ((ediff-color-display-p) -;; (ediff-set-face 'foreground 'ediff-fine-diff-face-B "Black") -;; (ediff-set-face 'background 'ediff-fine-diff-face-B "cyan")) -;; (t -;; (set-face-underline-p 'ediff-fine-diff-face-B t) -;; (ediff-set-face-pixmap 'ediff-fine-diff-face-B -;; ediff-fine-diff-pixmap) -;; ))) -;; 'ediff-fine-diff-face-B)) -;; "Face for highlighting the refinement of the selected diff in buffer B.") - (defface ediff-fine-diff-face-B '((((class color)) (:foreground "Black" :background "cyan")) (t (:underline t :stipple "gray3"))) @@ -1086,30 +960,6 @@ this variable represents.") (ediff-hide-face 'ediff-fine-diff-face-B) -;;;; Until custom.el for XEmacs starts supporting :stipple we do this. -;;;; This means that some user customization may be trashed. -;;(if (and ediff-xemacs-p -;; (ediff-has-face-support-p) -;; (not (ediff-color-display-p))) -;; (ediff-set-face-pixmap 'ediff-fine-diff-face-B "gray3")) - -;;(defvar ediff-fine-diff-face-C -;; (if (ediff-has-face-support-p) -;; (progn -;; (make-face 'ediff-fine-diff-face-C) -;; (or (face-differs-from-default-p 'ediff-fine-diff-face-C) -;; (cond ((ediff-color-display-p) -;; (ediff-set-face 'foreground 'ediff-fine-diff-face-C "black") -;; (ediff-set-face -;; 'background 'ediff-fine-diff-face-C "Turquoise")) -;; (t -;; (set-face-underline-p 'ediff-fine-diff-face-C t) -;; (ediff-set-face-pixmap 'ediff-fine-diff-face-C -;; ediff-fine-diff-pixmap) -;; ))) -;; 'ediff-fine-diff-face-C)) -;; "Face for highlighting the refinement of the selected diff in buffer C.") - (defface ediff-fine-diff-face-C '((((class color)) (:foreground "Black" :background "Turquoise")) (t (:underline t :stipple "gray3"))) @@ -1124,29 +974,6 @@ this variable represents.") (ediff-hide-face 'ediff-fine-diff-face-C) -;;;; Until custom.el for XEmacs starts supporting :stipple we do this. -;;;; This means that some user customization may be trashed. -;;(if (and ediff-xemacs-p -;; (ediff-has-face-support-p) -;; (not (ediff-color-display-p))) -;; (ediff-set-face-pixmap 'ediff-fine-diff-face-C "gray3")) - -;;(defvar ediff-fine-diff-face-Ancestor -;; (if (ediff-has-face-support-p) -;; (progn -;; (make-face 'ediff-fine-diff-face-Ancestor) -;; (ediff-hide-face 'ediff-fine-diff-face-Ancestor) -;; (or (face-differs-from-default-p 'ediff-fine-diff-face-Ancestor) -;; (progn -;; (copy-face -;; 'ediff-fine-diff-face-C 'ediff-fine-diff-face-Ancestor) -;; (ediff-set-face-pixmap 'ediff-fine-diff-face-Ancestor -;; ediff-fine-diff-pixmap)) -;; ))) -;; "Face highlighting refinements of the selected diff in ancestor buffer. -;;Presently, this is not used, as difference regions are not refined in the -;;ancestor buffer.") - (defface ediff-fine-diff-face-Ancestor '((((class color)) (:foreground "Black" :background "Green")) (t (:underline t :stipple "gray3"))) @@ -1163,31 +990,6 @@ this variable represents.") (ediff-hide-face 'ediff-fine-diff-face-Ancestor) -;;;; Until custom.el for XEmacs starts supporting :stipple we do this. -;;;; This means that some user customization may be trashed. -;;(if (and ediff-xemacs-p -;; (ediff-has-face-support-p) -;; (not (ediff-color-display-p))) -;; (ediff-set-face-pixmap 'ediff-fine-diff-face-Ancestor "gray3")) - -;;(defvar ediff-even-diff-face-A -;; (if (ediff-has-face-support-p) -;; (progn -;; (make-face 'ediff-even-diff-face-A) -;; (or (face-differs-from-default-p 'ediff-even-diff-face-A) -;; (cond ((ediff-color-display-p) -;; (ediff-set-face -;; 'foreground 'ediff-even-diff-face-A "black") -;; (ediff-set-face -;; 'background 'ediff-even-diff-face-A "light grey")) -;; (t -;; (copy-face 'italic 'ediff-even-diff-face-A) -;; (ediff-set-face-pixmap 'ediff-even-diff-face-A -;; ediff-even-diff-pixmap) -;; ))) -;; 'ediff-even-diff-face-A)) -;; "Face used for highlighting even-numbered differences in buffer A.") - (defface ediff-even-diff-face-A '((((class color)) (:foreground "Black" :background "light grey")) (t (:italic t :stipple "Stipple"))) @@ -1202,31 +1004,6 @@ this variable represents.") (ediff-hide-face 'ediff-even-diff-face-A) -;;;; Until custom.el for XEmacs starts supporting :stipple we do this. -;;;; This means that some user customization may be trashed. -;;(if (and ediff-xemacs-p -;; (ediff-has-face-support-p) -;; (not (ediff-color-display-p))) -;; (ediff-set-face-pixmap 'ediff-even-diff-face-A "Stipple")) - -;;(defvar ediff-even-diff-face-B -;; (if (ediff-has-face-support-p) -;; (progn -;; (make-face 'ediff-even-diff-face-B) -;; (or (face-differs-from-default-p 'ediff-even-diff-face-B) -;; (cond ((ediff-color-display-p) -;; (ediff-set-face -;; 'foreground 'ediff-even-diff-face-B "White") -;; (ediff-set-face -;; 'background 'ediff-even-diff-face-B "Gray")) -;; (t -;; (copy-face 'italic 'ediff-even-diff-face-B) -;; (ediff-set-face-pixmap 'ediff-even-diff-face-B -;; ediff-even-diff-pixmap) -;; ))) -;; 'ediff-even-diff-face-B)) -;; "Face used for highlighting even-numbered differences in buffer B.") - (defface ediff-even-diff-face-B '((((class color)) (:foreground "White" :background "Grey")) (t (:italic t :stipple "Stipple"))) @@ -1241,26 +1018,6 @@ this variable represents.") (ediff-hide-face 'ediff-even-diff-face-B) -;;;; Until custom.el for XEmacs starts supporting :stipple we do this. -;;;; This means that some user customization may be trashed. -;;(if (and ediff-xemacs-p -;; (ediff-has-face-support-p) -;; (not (ediff-color-display-p))) -;; (ediff-set-face-pixmap 'ediff-even-diff-face-B "Stipple")) - -;;(defvar ediff-even-diff-face-C -;; (if (ediff-has-face-support-p) -;; (progn -;; (make-face 'ediff-even-diff-face-C) -;; (ediff-hide-face 'ediff-even-diff-face-C) -;; (or (face-differs-from-default-p 'ediff-even-diff-face-C) -;; (progn -;; (copy-face 'ediff-even-diff-face-A 'ediff-even-diff-face-C) -;; (ediff-set-face-pixmap 'ediff-even-diff-face-C -;; ediff-even-diff-pixmap))) -;; 'ediff-even-diff-face-C)) -;; "Face used for highlighting even-numbered differences in buffer C.") - (defface ediff-even-diff-face-C '((((class color)) (:foreground "Black" :background "light grey")) (t (:italic t :stipple "Stipple"))) @@ -1275,27 +1032,6 @@ this variable represents.") (ediff-hide-face 'ediff-even-diff-face-C) -;;;; Until custom.el for XEmacs starts supporting :stipple we do this. -;;;; This means that some user customization may be trashed. -;;(if (and ediff-xemacs-p -;; (ediff-has-face-support-p) -;; (not (ediff-color-display-p))) -;; (ediff-set-face-pixmap 'ediff-even-diff-face-C "Stipple")) - -;;(defvar ediff-even-diff-face-Ancestor -;; (if (ediff-has-face-support-p) -;; (progn -;; (make-face 'ediff-even-diff-face-Ancestor) -;; (ediff-hide-face 'ediff-even-diff-face-Ancestor) -;; (or (face-differs-from-default-p 'ediff-even-diff-face-Ancestor) -;; (progn -;; (copy-face -;; 'ediff-even-diff-face-C 'ediff-even-diff-face-Ancestor) -;; (ediff-set-face-pixmap 'ediff-even-diff-face-Ancestor -;; ediff-even-diff-pixmap))) -;; 'ediff-even-diff-face-Ancestor)) -;; "Face highlighting even-numbered differences in the ancestor buffer.") - (defface ediff-even-diff-face-Ancestor '((((class color)) (:foreground "White" :background "Grey")) (t (:italic t :stipple "Stipple"))) @@ -1310,13 +1046,6 @@ this variable represents.") (ediff-hide-face 'ediff-even-diff-face-Ancestor) -;;;; Until custom.el for XEmacs starts supporting :stipple we do this. -;;;; This means that some user customization may be trashed. -;;(if (and ediff-xemacs-p -;; (ediff-has-face-support-p) -;; (not (ediff-color-display-p))) -;; (ediff-set-face-pixmap 'ediff-even-diff-face-Ancestor "Stipple")) - ;; Association between buffer types and even-diff-face symbols (defconst ediff-even-diff-face-alist '((A . ediff-even-diff-face-A) @@ -1324,24 +1053,6 @@ (C . ediff-even-diff-face-C) (Ancestor . ediff-even-diff-face-Ancestor))) -;;(defvar ediff-odd-diff-face-A -;; (if (ediff-has-face-support-p) -;; (progn -;; (make-face 'ediff-odd-diff-face-A) -;; (or (face-differs-from-default-p 'ediff-odd-diff-face-A) -;; (cond ((ediff-color-display-p) -;; (ediff-set-face -;; 'foreground 'ediff-odd-diff-face-A "White") -;; (ediff-set-face -;; 'background 'ediff-odd-diff-face-A "Gray")) -;; (t -;; (copy-face 'italic 'ediff-odd-diff-face-A) -;; (ediff-set-face-pixmap 'ediff-odd-diff-face-A -;; ediff-odd-diff-pixmap) -;; ))) -;; 'ediff-odd-diff-face-A)) -;; "Face used for highlighting odd-numbered differences in buffer A.") - (defface ediff-odd-diff-face-A '((((class color)) (:foreground "White" :background "Grey")) (t (:italic t :stipple "gray1"))) @@ -1356,31 +1067,6 @@ this variable represents.") (ediff-hide-face 'ediff-odd-diff-face-A) -;;;; Until custom.el for XEmacs starts supporting :stipple we do this. -;;;; This means that some user customization may be trashed. -;;(if (and ediff-xemacs-p -;; (ediff-has-face-support-p) -;; (not (ediff-color-display-p))) -;; (ediff-set-face-pixmap 'ediff-odd-diff-face-A "gray1")) - -;;(defvar ediff-odd-diff-face-B -;; (if (ediff-has-face-support-p) -;; (progn -;; (make-face 'ediff-odd-diff-face-B) -;; (ediff-hide-face 'ediff-odd-diff-face-B) -;; (or (face-differs-from-default-p 'ediff-odd-diff-face-B) -;; (cond ((ediff-color-display-p) -;; (ediff-set-face -;; 'foreground 'ediff-odd-diff-face-B "Black") -;; (ediff-set-face -;; 'background 'ediff-odd-diff-face-B "light grey")) -;; (t -;; (copy-face 'italic 'ediff-odd-diff-face-B) -;; (ediff-set-face-pixmap 'ediff-odd-diff-face-B -;; ediff-odd-diff-pixmap) -;; ))) -;; 'ediff-odd-diff-face-B)) -;; "Face used for highlighting odd-numbered differences in buffer B.") (defface ediff-odd-diff-face-B '((((class color)) (:foreground "Black" :background "light grey")) @@ -1396,25 +1082,6 @@ this variable represents.") (ediff-hide-face 'ediff-odd-diff-face-B) -;;;; Until custom.el for XEmacs starts supporting :stipple we do this. -;;;; This means that some user customization may be trashed. -;;(if (and ediff-xemacs-p -;; (ediff-has-face-support-p) -;; (not (ediff-color-display-p))) -;; (ediff-set-face-pixmap 'ediff-odd-diff-face-B "gray1")) - -;;(defvar ediff-odd-diff-face-C -;; (if (ediff-has-face-support-p) -;; (progn -;; (make-face 'ediff-odd-diff-face-C) -;; (or (face-differs-from-default-p 'ediff-odd-diff-face-C) -;; (progn -;; (copy-face 'ediff-odd-diff-face-A 'ediff-odd-diff-face-C) -;; (ediff-set-face-pixmap 'ediff-odd-diff-face-C -;; ediff-odd-diff-pixmap))) -;; 'ediff-odd-diff-face-C)) -;; "Face used for highlighting odd-numbered differences in buffer C.") - (defface ediff-odd-diff-face-C '((((class color)) (:foreground "White" :background "Grey")) (t (:italic t :stipple "gray1"))) @@ -1429,25 +1096,6 @@ this variable represents.") (ediff-hide-face 'ediff-odd-diff-face-C) -;;;; Until custom.el for XEmacs starts supporting :stipple we do this. -;;;; This means that some user customization may be trashed. -;;(if (and ediff-xemacs-p -;; (ediff-has-face-support-p) -;; (not (ediff-color-display-p))) -;; (ediff-set-face-pixmap 'ediff-odd-diff-face-C "gray1")) - -;;(defvar ediff-odd-diff-face-Ancestor -;; (if (ediff-has-face-support-p) -;; (progn -;; (make-face 'ediff-odd-diff-face-Ancestor) -;; (or (face-differs-from-default-p 'ediff-odd-diff-face-Ancestor) -;; (progn -;; (copy-face 'ediff-odd-diff-face-C 'ediff-odd-diff-face-Ancestor) -;; (ediff-set-face-pixmap 'ediff-odd-diff-face-Ancestor -;; ediff-odd-diff-pixmap))) -;; 'ediff-odd-diff-face-Ancestor)) -;; "Face used for highlighting even-numbered differences in the ancestor buffer.") - (defface ediff-odd-diff-face-Ancestor '((((class color)) (:foreground "Black" :background "light grey")) (t (:italic t :stipple "gray1"))) @@ -1462,13 +1110,6 @@ this variable represents.") (ediff-hide-face 'ediff-odd-diff-face-Ancestor) -;;;; Until custom.el for XEmacs starts supporting :stipple we do this. -;;;; This means that some user customization may be trashed. -;;(if (and ediff-xemacs-p -;; (ediff-has-face-support-p) -;; (not (ediff-color-display-p))) -;; (ediff-set-face-pixmap 'ediff-odd-diff-face-Ancestor "gray1")) - ;; Association between buffer types and odd-diff-face symbols (defconst ediff-odd-diff-face-alist '((A . ediff-odd-diff-face-A) @@ -1548,7 +1189,7 @@ "*Save the results of merge jobs automatically. Nil means don't save automatically. t means always save. Anything but nil or t means save automatically only if the merge job is part of a group of jobs, such -as `ediff-merge-directories' or `ediff-merge-directory-revisions'." +as `ediff-merge-directory' or `ediff-merge-directory-revisions'." :type '(choice (const nil) (const t) (const group-jobs-only)) :group 'ediff-merge) (make-variable-buffer-local 'ediff-autostore-merges)
--- a/lisp/ediff-util.el Mon May 04 22:33:38 1998 +0000 +++ b/lisp/ediff-util.el Mon May 04 22:42:59 1998 +0000 @@ -52,10 +52,12 @@ (or (featurep 'ediff) (load "ediff.el" nil nil 'nosuffix)) (or (featurep 'ediff-tbar) + ediff-emacs-p (load "ediff-tbar.el" 'noerror nil 'nosuffix)) )) ;; end pacifier + (require 'ediff-init) (require 'ediff-help) (require 'ediff-mult) @@ -63,14 +65,8 @@ (require 'ediff-diff) (require 'ediff-merg) - -;; be careful with ediff-tbar (if ediff-xemacs-p - (condition-case nil - (require 'ediff-tbar) - (error - (defun ediff-use-toolbar-p () nil))) - (defun ediff-use-toolbar-p () nil)) + (require 'ediff-tbar)) ;;; Functions @@ -1053,7 +1049,7 @@ ;; checkout if visited file is checked in (defun ediff-maybe-checkout (buf) - (let ((file (buffer-file-name buf)) + (let ((file (expand-file-name (buffer-file-name buf))) (checkout-function (key-binding "\C-x\C-q"))) (if (and (ediff-file-checked-in-p file) (or (beep 1) t) @@ -1070,31 +1066,42 @@ ;; in and not checked out for the purpose of patching (since patch won't be ;; able to read such a file anyway). ;; FILE is a string representing file name -(defun ediff-file-under-version-control (file) - (let* ((filedir (file-name-directory file)) - (file-nondir (file-name-nondirectory file)) - (trial (concat file-nondir ",v")) - (full-trial (concat filedir trial)) - (full-rcs-trial (concat filedir "RCS/" trial))) - (and (stringp file) - (file-exists-p file) - (or - (and - (file-exists-p full-trial) - ;; in FAT FS, `file,v' and `file' may turn out to be the same! - ;; don't be fooled by this! - (not (equal (file-attributes file) - (file-attributes full-trial)))) - ;; check if a version is in RCS/ directory - (file-exists-p full-rcs-trial))) - )) +;;(defun ediff-file-under-version-control (file) +;; (let* ((filedir (file-name-directory file)) +;; (file-nondir (file-name-nondirectory file)) +;; (trial (concat file-nondir ",v")) +;; (full-trial (concat filedir trial)) +;; (full-rcs-trial (concat filedir "RCS/" trial))) +;; (and (stringp file) +;; (file-exists-p file) +;; (or +;; (and +;; (file-exists-p full-trial) +;; ;; in FAT FS, `file,v' and `file' may turn out to be the same! +;; ;; don't be fooled by this! +;; (not (equal (file-attributes file) +;; (file-attributes full-trial)))) +;; ;; check if a version is in RCS/ directory +;; (file-exists-p full-rcs-trial))) +;; )) -(defun ediff-file-checked-out-p (file) - (and (ediff-file-under-version-control file) - (file-writable-p file))) -(defun ediff-file-checked-in-p (file) - (and (ediff-file-under-version-control file) - (not (file-writable-p file)))) + +(defsubst ediff-file-checked-out-p (file) + (or (not (featurep 'vc-hooks)) + (and (vc-backend file) + (vc-locking-user file)))) +(defsubst ediff-file-checked-in-p (file) + (and (featurep 'vc-hooks) + (vc-backend file) + (not (vc-locking-user file)))) + +(defun ediff-file-compressed-p (file) + (condition-case nil + (require 'jka-compr) + (error)) + (if (featurep 'jka-compr) + (string-match (jka-compr-build-file-regexp) file))) + (defun ediff-swap-buffers () "Rotate the display of buffers A, B, and C." @@ -1312,7 +1319,7 @@ (set-specifier bottom-toolbar-visible-p (list frame t)) (set-specifier bottom-toolbar-height (list frame ediff-toolbar-height))) - (ediff-xemacs-p + ((ediff-has-toolbar-support-p) (set-specifier bottom-toolbar-height (list frame 0))) )) )) @@ -1572,18 +1579,19 @@ lines )))) -;; get number of lines from window end to region start -(defun ediff-get-lines-to-region-start (buf-type &optional n ctl-buf) - (or n (setq n ediff-current-difference)) +;; Calculate the number of lines from window end to the start of diff region +(defun ediff-get-lines-to-region-start (buf-type &optional diff-num ctl-buf) + (or diff-num (setq diff-num ediff-current-difference)) (or ctl-buf (setq ctl-buf ediff-control-buffer)) (ediff-with-current-buffer ctl-buf (let* ((buf (ediff-get-buffer buf-type)) (wind (eval (ediff-get-symbol-from-alist buf-type ediff-window-alist))) - (end (window-end wind)) - (beg (ediff-get-diff-posn buf-type 'beg))) + (end (or (window-end wind) (window-end wind t))) + (beg (ediff-get-diff-posn buf-type 'beg diff-num))) (ediff-with-current-buffer buf - (if (< beg end) (count-lines beg end) 0)) + (if (< beg end) + (count-lines (max beg (point-min)) (min end (point-max))) 0)) ))) @@ -2974,10 +2982,6 @@ (error "Buffer out of sync for file %s" buffer-file-name)))) -(defun ediff-file-compressed-p (file) - (require 'jka-compr) - (string-match (jka-compr-build-file-regexp) file)) - (defun ediff-filename-magic-p (file) (or (ediff-file-compressed-p file) (ediff-file-remote-p file)))
--- a/lisp/ediff-vers.el Mon May 04 22:33:38 1998 +0000 +++ b/lisp/ediff-vers.el Mon May 04 22:42:59 1998 +0000 @@ -338,7 +338,7 @@ (tmp-file (cvs-retrieve-revision-to-tmpfile fileinfo)) (default-directory - (file-name-as-directory (cvs-fileinfo->dir fileinfo))) + (file-name-as-directory (cvs-fileinfo->dir fileinfo))) ancestor-file) (or (memq type '(MERGED CONFLICT MODIFIED))
--- a/lisp/ediff-wind.el Mon May 04 22:33:38 1998 +0000 +++ b/lisp/ediff-wind.el Mon May 04 22:42:59 1998 +0000 @@ -46,6 +46,7 @@ (or (featurep 'ediff-help) (load "ediff-help.el" nil nil 'nosuffix)) (or (featurep 'ediff-tbar) + ediff-emacs-p (load "ediff-tbar.el" 'noerror nil 'nosuffix)) )) ;; end pacifier @@ -932,7 +933,7 @@ ;; In XEmacs, buffer menubar needs to be killed before frame parameters ;; are changed. - (if ediff-xemacs-p + (if (ediff-has-toolbar-support-p) (progn (set-specifier top-toolbar-height (list ctl-frame 2)) (sit-for 0)
--- a/lisp/ediff.el Mon May 04 22:33:38 1998 +0000 +++ b/lisp/ediff.el Mon May 04 22:42:59 1998 +0000 @@ -6,8 +6,8 @@ ;; Created: February 2, 1994 ;; Keywords: comparing, merging, patching, version control. -(defconst ediff-version "2.69" "The current version of Ediff") -(defconst ediff-date "October 10, 1997" "Date of last update") +(defconst ediff-version "2.70.1" "The current version of Ediff") +(defconst ediff-date "March 7, 1998" "Date of last update") ;; This file is part of GNU Emacs.
--- a/lisp/emulation/viper-cmd.el Mon May 04 22:33:38 1998 +0000 +++ b/lisp/emulation/viper-cmd.el Mon May 04 22:42:59 1998 +0000 @@ -144,17 +144,11 @@ ;; Runs viper-after-change-functions inside after-change-functions (defun viper-after-change-sentinel (beg end len) - (let ((list viper-after-change-functions)) - (while list - (funcall (car list) beg end len) - (setq list (cdr list))))) + (run-hook-with-args 'viper-after-change-functions beg end len)) ;; Runs viper-before-change-functions inside before-change-functions (defun viper-before-change-sentinel (beg end) - (let ((list viper-before-change-functions)) - (while list - (funcall (car list) beg end) - (setq list (cdr list))))) + (run-hook-with-args 'viper-before-change-functions beg end)) (defsubst viper-post-command-sentinel () (run-hooks 'viper-post-command-hooks)) @@ -264,15 +258,21 @@ ;; We remove then add viper-post/pre-command-sentinel since it is very ;; desirable that viper-pre-command-sentinel is the last hook and ;; viper-post-command-sentinel is the first hook. + + (make-local-hook 'viper-after-change-functions) + (make-local-hook 'viper-before-change-functions) + (make-local-hook 'viper-post-command-hooks) + (make-local-hook 'viper-pre-command-hooks) + (remove-hook 'post-command-hook 'viper-post-command-sentinel) (add-hook 'post-command-hook 'viper-post-command-sentinel) (remove-hook 'pre-command-hook 'viper-pre-command-sentinel) (add-hook 'pre-command-hook 'viper-pre-command-sentinel t) ;; These hooks will be added back if switching to insert/replace mode - (viper-remove-hook 'viper-post-command-hooks - 'viper-insert-state-post-command-sentinel) - (viper-remove-hook 'viper-pre-command-hooks - 'viper-insert-state-pre-command-sentinel) + (remove-hook 'viper-post-command-hooks + 'viper-insert-state-post-command-sentinel 'local) + (remove-hook 'viper-pre-command-hooks + 'viper-insert-state-pre-command-sentinel 'local) (setq viper-intermediate-command nil) (cond ((eq new-state 'vi-state) (cond ((member viper-current-state '(insert-state replace-state)) @@ -314,10 +314,10 @@ (viper-move-marker-locally 'viper-insert-point (point))) (viper-move-marker-locally 'viper-last-posn-while-in-insert-state (point)) - (viper-add-hook 'viper-post-command-hooks - 'viper-insert-state-post-command-sentinel t) - (viper-add-hook 'viper-pre-command-hooks - 'viper-insert-state-pre-command-sentinel t)) + (add-hook 'viper-post-command-hooks + 'viper-insert-state-post-command-sentinel t 'local) + (add-hook 'viper-pre-command-hooks + 'viper-insert-state-pre-command-sentinel t 'local)) ) ; outermost cond ;; Nothing needs to be done to switch to emacs mode! Just set some @@ -958,23 +958,25 @@ ;; Compute numeric prefix arg value. ;; Invoked by EVENT. COM is the command part obtained so far. -(defun viper-prefix-arg-value (event com) +(defun viper-prefix-arg-value (event-char com) (let ((viper-intermediate-command 'viper-digit-argument) value func) ;; read while number - (while (and (viper-characterp event) (>= event ?0) (<= event ?9)) - (setq value (+ (* (if (integerp value) value 0) 10) (- event ?0))) - (setq event (viper-read-event-convert-to-char))) + (while (and (viper-characterp event-char) + (>= event-char ?0) (<= event-char ?9)) + (setq value (+ (* (if (integerp value) value 0) 10) (- event-char ?0))) + (setq event-char (viper-read-event-convert-to-char))) (setq prefix-arg value) (if com (setq prefix-arg (cons prefix-arg com))) - (while (eq event ?U) + (while (eq event-char ?U) (viper-describe-arg prefix-arg) - (setq event (viper-read-event-convert-to-char))) + (setq event-char (viper-read-event-convert-to-char))) (if (or com (and (not (eq viper-current-state 'vi-state)) ;; make sure it is a Vi command - (viper-characterp event) (viper-vi-command-p event) + (viper-characterp event-char) + (viper-vi-command-p event-char) )) ;; If appears to be one of the vi commands, ;; then execute it with funcall and clear prefix-arg in order to not @@ -986,21 +988,21 @@ ;; etc., i.e., the user typed, say, d2. In this case, `com' would be ;; `d', `w', etc. If viper-digit-argument was invoked by ;; viper-escape-to-vi (which is indicated by the fact that the - ;; current state is not vi-state), then `event' represents the vi - ;; command to be executed (e.g., `d', `w', etc). Again, + ;; current state is not vi-state), then `event-char' represents the + ;; vi command to be executed (e.g., `d', `w', etc). Again, ;; last-command-char must make emacs believe that this is the command ;; we typed. - (cond ((eq event 'return) (setq event ?\C-m)) - ((eq event 'delete) (setq event ?\C-?)) - ((eq event 'backspace) (setq event ?\C-h)) - ((eq event 'space) (setq event ?\ ))) - (setq last-command-char (or com event)) + (cond ((eq event-char 'return) (setq event-char ?\C-m)) + ((eq event-char 'delete) (setq event-char ?\C-?)) + ((eq event-char 'backspace) (setq event-char ?\C-h)) + ((eq event-char 'space) (setq event-char ?\ ))) + (setq last-command-char (or com event-char)) (setq func (viper-exec-form-in-vi - (` (key-binding (char-to-string (, event)))))) + (` (key-binding (char-to-string (, event-char)))))) (funcall func prefix-arg) (setq prefix-arg nil)) ;; some other command -- let emacs do it in its own way - (viper-set-unread-command-events event)) + (viper-set-unread-command-events event-char)) )) @@ -1239,6 +1241,7 @@ (setq viper-use-register nil))) (setq last-command (if (eq last-command 'd-command) 'kill-region nil)) + (message "Deleted %d characters" (abs (- (point) viper-com-point))) (kill-region viper-com-point (point)) (setq this-command 'd-command) (if viper-ex-style-motion @@ -1261,10 +1264,12 @@ (setq viper-use-register nil))) (setq last-command (if (eq last-command 'D-command) 'kill-region nil)) + (message "Deleted %d lines" (count-lines (point) viper-com-point)) (kill-region (mark t) (point)) (if (eq m-com 'viper-line) (setq this-command 'D-command))) (back-to-indentation)) +;; save region (defun viper-exec-yank (m-com com) (or (and (markerp viper-com-point) (marker-position viper-com-point)) (set-marker viper-com-point (point) (current-buffer))) @@ -1281,8 +1286,10 @@ (setq viper-use-register nil))) (setq last-command nil) (copy-region-as-kill viper-com-point (point)) + (message "Saved %d characters" (abs (- (point) viper-com-point))) (goto-char viper-com-point)) +;; save lines (defun viper-exec-Yank (m-com com) (save-excursion (set-mark viper-com-point) @@ -1299,7 +1306,8 @@ (error viper-InvalidRegister viper-use-register))) (setq viper-use-register nil))) (setq last-command nil) - (copy-region-as-kill (mark t) (point))) + (copy-region-as-kill (mark t) (point)) + (message "Saved %d lines" (count-lines (mark t) (point)))) (viper-deactivate-mark) (goto-char viper-com-point)) @@ -2110,22 +2118,23 @@ (setq viper-began-as-replace t viper-sitting-in-replace t viper-replace-chars-to-delete 0) - (viper-add-hook - 'viper-after-change-functions 'viper-replace-mode-spy-after t) - (viper-add-hook - 'viper-before-change-functions 'viper-replace-mode-spy-before t) + (add-hook + 'viper-after-change-functions 'viper-replace-mode-spy-after t 'local) + (add-hook + 'viper-before-change-functions 'viper-replace-mode-spy-before t 'local) ;; this will get added repeatedly, but no harm (add-hook 'after-change-functions 'viper-after-change-sentinel t) (add-hook 'before-change-functions 'viper-before-change-sentinel t) - (viper-move-marker-locally 'viper-last-posn-in-replace-region - (viper-replace-start)) - (viper-add-hook - 'viper-post-command-hooks 'viper-replace-state-post-command-sentinel t) - (viper-add-hook - 'viper-pre-command-hooks 'viper-replace-state-pre-command-sentinel t) + (viper-move-marker-locally + 'viper-last-posn-in-replace-region (viper-replace-start)) + (add-hook + 'viper-post-command-hooks 'viper-replace-state-post-command-sentinel + t 'local) + (add-hook + 'viper-pre-command-hooks 'viper-replace-state-pre-command-sentinel t 'local) ;; guard against a smartie who switched from R-replace to normal replace - (viper-remove-hook - 'viper-post-command-hooks 'viper-R-state-post-command-sentinel) + (remove-hook + 'viper-post-command-hooks 'viper-R-state-post-command-sentinel 'local) (if overwrite-mode (overwrite-mode nil)) ) @@ -2210,14 +2219,14 @@ ;; the overlay and current point is before the end of the overlay. ;; Don't delete anything if current point is past the end of the overlay. (defun viper-finish-change () - (viper-remove-hook - 'viper-after-change-functions 'viper-replace-mode-spy-after) - (viper-remove-hook - 'viper-before-change-functions 'viper-replace-mode-spy-before) - (viper-remove-hook - 'viper-post-command-hooks 'viper-replace-state-post-command-sentinel) - (viper-remove-hook - 'viper-pre-command-hooks 'viper-replace-state-pre-command-sentinel) + (remove-hook + 'viper-after-change-functions 'viper-replace-mode-spy-after 'local) + (remove-hook + 'viper-before-change-functions 'viper-replace-mode-spy-before 'local) + (remove-hook + 'viper-post-command-hooks 'viper-replace-state-post-command-sentinel 'local) + (remove-hook + 'viper-pre-command-hooks 'viper-replace-state-pre-command-sentinel 'local) (viper-restore-cursor-color-after-replace) (setq viper-sitting-in-replace nil) ; just in case we'll need to know it (save-excursion @@ -2246,22 +2255,22 @@ (setq kill-ring-yank-pointer kill-ring)) (defun viper-finish-R-mode () - (viper-remove-hook - 'viper-post-command-hooks 'viper-R-state-post-command-sentinel) - (viper-remove-hook - 'viper-pre-command-hooks 'viper-replace-state-pre-command-sentinel) + (remove-hook + 'viper-post-command-hooks 'viper-R-state-post-command-sentinel 'local) + (remove-hook + 'viper-pre-command-hooks 'viper-replace-state-pre-command-sentinel 'local) (viper-downgrade-to-insert)) (defun viper-start-R-mode () ;; Leave arg as 1, not t: XEmacs insists that it must be a pos number (overwrite-mode 1) - (viper-add-hook - 'viper-post-command-hooks 'viper-R-state-post-command-sentinel t) - (viper-add-hook - 'viper-pre-command-hooks 'viper-replace-state-pre-command-sentinel t) + (add-hook + 'viper-post-command-hooks 'viper-R-state-post-command-sentinel t 'local) + (add-hook + 'viper-pre-command-hooks 'viper-replace-state-pre-command-sentinel t 'local) ;; guard against a smartie who switched from R-replace to normal replace - (viper-remove-hook - 'viper-post-command-hooks 'viper-replace-state-post-command-sentinel) + (remove-hook + 'viper-post-command-hooks 'viper-replace-state-post-command-sentinel 'local) ) @@ -2907,21 +2916,37 @@ (cmd (if (eq viper-intermediate-command 'viper-repeat) (nth 5 viper-d-com) (viper-array-to-string (this-command-keys)))) - point) + point region-beg region-end) (save-excursion (save-restriction - (if (> arg 0) - (narrow-to-region - ;; forward search begins here - (if (eolp) (error "Command `%s': At end of line" cmd) (point)) - ;; forward search ends here - (progn (end-of-line) (point))) - (narrow-to-region - ;; backward search begins from here - (if (bolp) - (error "Command `%s': At beginning of line" cmd) (point)) - ;; backward search ends here - (progn (beginning-of-line) (point)))) + (if (> arg 0) ; forward + (progn + (setq region-beg (point)) + (if viper-allow-multiline-replace-regions + (viper-forward-paragraph 1) + (end-of-line)) + (setq region-end (point))) + (setq region-end (point)) + (if viper-allow-multiline-replace-regions + (viper-backward-paragraph 1) + (beginning-of-line)) + (setq region-beg (point))) + (if (or (and (< arg 0) + (< (- region-end region-beg) + (if viper-allow-multiline-replace-regions + 2 1)) + (bolp)) + (and (> arg 0) + (< (- region-end region-beg) + (if viper-allow-multiline-replace-regions + 3 2)) + (eolp))) + (error "Command `%s': At %s of %s" + cmd + (if (> arg 0) "end" "beginning") + (if viper-allow-multiline-replace-regions + "paragraph" "line"))) + (narrow-to-region region-beg region-end) ;; if arg > 0, point is forwarded before search. (if (> arg 0) (goto-char (1+ (point-min))) (goto-char (point-max))) @@ -3242,7 +3267,7 @@ (if viper-parse-sexp-ignore-comments "" "NOT ")))) -;; sentence ,paragraph and heading +;; sentence, paragraph and heading (defun viper-forward-sentence (arg) "Forward sentence." @@ -3272,7 +3297,9 @@ (or (eq last-command this-command) (push-mark nil t)) (let ((val (viper-p-val arg)) - (com (viper-getCom arg))) + ;; if you want d} operate on whole lines, change viper-getcom to + ;; viper-getCom below + (com (viper-getcom arg))) (if com (viper-move-marker-locally 'viper-com-point (point))) (forward-paragraph val) (if com @@ -3286,7 +3313,9 @@ (or (eq last-command this-command) (push-mark nil t)) (let ((val (viper-p-val arg)) - (com (viper-getCom arg))) + ;; if you want d{ operate on whole lines, change viper-getcom to + ;; viper-getCom below + (com (viper-getcom arg))) (if com (viper-move-marker-locally 'viper-com-point (point))) (backward-paragraph val) (if com @@ -3768,7 +3797,8 @@ ((viper-valid-register viper-use-register) (get-register (downcase viper-use-register))) (t (error viper-InvalidRegister viper-use-register))) - (current-kill 0)))) + (current-kill 0))) + sv-point) (if (null text) (if viper-use-register (let ((reg viper-use-register)) @@ -3787,7 +3817,11 @@ (set-marker (viper-mark-marker) (point) (current-buffer)) (viper-set-destructive-command (list 'viper-put-back val nil viper-use-register nil nil)) - (viper-loop val (viper-yank text))) + (setq sv-point (point)) + (viper-loop val (viper-yank text)) + (message "Inserted %d character(s), %d line(s)" + (abs (- (point) sv-point)) + (abs (count-lines (point) sv-point)))) ;; Vi puts cursor on the last char when the yanked text doesn't contain a ;; newline; it leaves the cursor at the beginning when the text contains ;; a newline
--- a/lisp/emulation/viper-ex.el Mon May 04 22:33:38 1998 +0000 +++ b/lisp/emulation/viper-ex.el Mon May 04 22:42:59 1998 +0000 @@ -1,6 +1,6 @@ ;;; viper-ex.el --- functions implementing the Ex commands for Viper -;; Copyright (C) 1994, 1995, 1996, 1997 Free Software Foundation, Inc. +;; Copyright (C) 1994, 1995, 1996, 1997, 1998 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. @@ -457,7 +457,9 @@ "\\|" "jo.*" "\\|" "^[ \t]*ta.*" "\\|" "^[ \t]*una.*" - "\\|" "^[ \t]*su.*" + ;; don't jump up in :s command + "\\|" "^[ \t]*\\([`'][a-z]\\|[.,%]\\)*[ \t]*su.*" + "\\|" "^[ \t]*\\([`'][a-z]\\|[.,%]\\)*[ \t]*s[^a-z].*" "\\|" "['`][a-z][ \t]*" ;; r! assumes that the next one is a shell command "\\|" "\\(r\\|re\\|rea\\|read\\)[ \t]*!" @@ -631,40 +633,53 @@ (set-buffer viper-ex-work-buf) (skip-chars-forward " \t") (if (looking-at "!") + ;; this is probably a variant command r! (progn (setq ex-g-variant (not ex-g-variant) ex-g-flag (not ex-g-flag)) (forward-char 1) (skip-chars-forward " \t"))) (let ((c (following-char))) - (if (string-match "[0-9A-Za-z]" (format "%c" c)) - (error - "Global regexp must be inside matching non-alphanumeric chars")) + (cond ((string-match "[0-9A-Za-z]" (format "%c" c)) + (error + "Global regexp must be inside matching non-alphanumeric chars")) + ((= c ??) (error "`?' is not an allowed pattern delimiter here"))) (if (looking-at "[^\\\\\n]") (progn (forward-char 1) (set-mark (point)) (let ((cont t)) - (while (and (not (eolp)) cont) + ;; the use of eobp instead of eolp permits the use of newlines in + ;; pat2 in s/pat1/pat2/ + (while (and (not (eobp)) cont) (if (not (re-search-forward (format "[^%c]*%c" c c) nil t)) (if (member ex-token '("global" "vglobal")) - (error - "Missing closing delimiter for global regexp") + (error "Missing closing delimiter for global regexp") (goto-char (point-max)))) (if (not (viper-looking-back (format "[^\\\\]\\(\\\\\\\\\\)*\\\\%c" c))) - (setq cont nil)))) + (setq cont nil) + ;; we are at an escaped delimiter: unescape it and continue + (delete-backward-char 2) + (insert c) + (if (eolp) + ;; if at eol, exit loop and go to next line + ;; later, delim will be inserted at the end + (progn + (setq cont nil) + (forward-char)))) + )) (setq ex-token (if (= (mark t) (point)) "" (buffer-substring (1- (point)) (mark t)))) (backward-char 1) - ;; if the user doesn't specify the final pattern delimiter, we're + ;; if the user didn't insert the final pattern delimiter, we're ;; at newline now. In this case, insert the initial delimiter ;; specified in variable c - (if (looking-at "\n") + (if (eolp) (progn - (insert c) - (backward-char 1))) + (insert c) + (backward-char 1))) ) (setq ex-token nil)) c))) @@ -707,8 +722,8 @@ (cond ((null ex-addresses) (setq ex-addresses (if whole-flag - (cons (point-max) (cons (point-min) nil)) - (cons (point) (cons (point) nil))))) + (list (point-max) (point-min)) + (list (point) (point))))) ((null (cdr ex-addresses)) (setq ex-addresses (cons (car ex-addresses) ex-addresses))))) @@ -871,7 +886,7 @@ (char (buffer-substring (match-beginning 0) (match-end 0)))) (if (viper-looking-back (concat "\\\\" char)) (replace-match char) - (set-match-data data) + (store-match-data data) (if (string= char "%") (replace-match cf) (replace-match pf))))) @@ -1009,8 +1024,10 @@ (while cont (setq viper-keep-reading-filename nil val (read-file-name (concat prompt str) nil default-directory)) - (if (string-match " " val) - (setq val (concat "\\\"" val "\\\""))) + (setq val (expand-file-name val)) + (if (and (string-match " " val) + (ex-cmd-accepts-multiple-files-p ex-token)) + (setq val (concat "\"" val "\""))) (setq str (concat str (if (equal val "") "" " ") val (if (equal val "") "" " "))) @@ -1237,27 +1254,27 @@ ((string= ex-file "") (error viper-NoFileSpecified))) - (let (msg do-edit) - (if buffer-file-name - (cond ((buffer-modified-p) - (setq msg - (format "Buffer %s is modified. Discard changes? " - (buffer-name)) - do-edit t)) - ((not (verify-visited-file-modtime (current-buffer))) - (setq msg - (format "File %s changed on disk. Reread from disk? " - buffer-file-name) - do-edit t)) - (t (setq do-edit nil)))) - - (if do-edit - (if (yes-or-no-p msg) - (progn - (set-buffer-modified-p nil) - (kill-buffer (current-buffer))) - (message "Buffer %s was left intact" (buffer-name)))) - ) ; let +;;; (let (msg do-edit) +;;; (if buffer-file-name +;;; (cond ((buffer-modified-p) +;;; (setq msg +;;; (format "Buffer %s is modified. Discard changes? " +;;; (buffer-name)) +;;; do-edit t)) +;;; ((not (verify-visited-file-modtime (current-buffer))) +;;; (setq msg +;;; (format "File %s changed on disk. Reread from disk? " +;;; buffer-file-name) +;;; do-edit t)) +;;; (t (setq do-edit nil)))) +;;; +;;; (if do-edit +;;; (if (yes-or-no-p msg) +;;; (progn +;;; (set-buffer-modified-p nil) +;;; (kill-buffer (current-buffer))) +;;; (message "Buffer %s was left intact" (buffer-name)))) +;;; ) ; let (if (null (setq file (get-file-buffer ex-file))) (progn @@ -1279,7 +1296,7 @@ (ex-fixup-history viper-last-ex-prompt ex-file)) ;; Find-file FILESPEC if it appears to specify a single file. -;; Otherwise, assume that FILES{EC is a wildcard. +;; Otherwise, assume that FILESPEC is a wildcard. ;; In this case, split it into substrings separated by newlines. ;; Each line is assumed to be a file name. find-file's each file thus obtained. (defun ex-find-file (filespec) @@ -1652,7 +1669,7 @@ (ask-if-save t) (auto-cmd-label "; don't touch or else...") (delete-turn-on-auto-fill-pattern - "([ \t]*add-hook[ \t]+'viper-insert-state-hooks[ \t]+'turn-on-auto-fill.*)") + "([ \t]*add-hook[ \t]+'viper-insert-state-hook[ \t]+'turn-on-auto-fill.*)") actual-lisp-cmd lisp-cmd-del-pattern val2 orig-var) (setq orig-var var) @@ -1770,7 +1787,7 @@ (if (> val2 0) (viper-save-string-in-file (concat - "(add-hook 'viper-insert-state-hooks 'turn-on-auto-fill) " + "(add-hook 'viper-insert-state-hook 'turn-on-auto-fill) " auto-cmd-label) viper-custom-file-name delete-turn-on-auto-fill-pattern) @@ -1902,8 +1919,12 @@ (point-marker)))) (goto-char (min (point) (mark t))) (while (< (point) limit) - (end-of-line) - (setq eol-mark (point-marker)) + (save-excursion + (end-of-line) + ;; This move allows the use of newline as the last character in + ;; the substitution pattern + (viper-forward-char-carefully) + (setq eol-mark (point-marker))) (beginning-of-line) (if opt-g (progn @@ -1927,8 +1948,10 @@ (if (not (stringp repl)) (error "Can't perform Ex substitution: No previous replacement pattern")) (replace-match repl t))) - (end-of-line) - (viper-forward-char-carefully)))))) + ;;(end-of-line) + ;;(viper-forward-char-carefully) + (goto-char eol-mark) + ))))) (if matched-pos (goto-char matched-pos)) (beginning-of-line) (if opt-c (message "done")))) @@ -1994,68 +2017,59 @@ (setq file-exists (file-exists-p ex-file) writing-same-file (string= ex-file (buffer-file-name))) + ;; do actual writing (if (and writing-whole-file writing-same-file) + ;; saving whole buffer in visited file (if (not (buffer-modified-p)) (message "(No changes need to be saved)") + (viper-maybe-checkout (current-buffer)) (save-buffer) (save-restriction (widen) (ex-write-info file-exists ex-file (point-min) (point-max)) )) - ;; writing some other file or portion of the current file - (cond ((and file-exists - (not writing-same-file) - (not (yes-or-no-p - (format "File %s exists. Overwrite? " ex-file)))) - (error "Quit")) - ((and writing-whole-file (not ex-append)) - (unwind-protect - (progn - (set-visited-file-name ex-file) - (set-buffer-modified-p t) - (save-buffer)) - ;; restore the buffer file name - (set-visited-file-name orig-buf-file-name) - (set-buffer-modified-p buff-changed-p) - ;; If the buffer wasn't visiting a file, restore buffer name. - ;; Name could've been changed by packages such as uniquify. - (or orig-buf-file-name - (progn - (unlock-buffer) - (rename-buffer orig-buf-name)))) - (save-restriction - (widen) - (ex-write-info - file-exists ex-file (point-min) (point-max)))) - (t ; writing a region - (unwind-protect - (save-excursion - (viper-enlarge-region beg end) - (setq region (buffer-substring (point) (mark t))) - ;; create temp buffer for the region - (setq temp-buf (get-buffer-create " *ex-write*")) - (set-buffer temp-buf) - (set-visited-file-name ex-file 'noquerry) - (erase-buffer) - (if (and file-exists ex-append) - (insert-file-contents ex-file)) - (goto-char (point-max)) - (insert region) - (save-buffer) - (ex-write-info - file-exists ex-file (point-min) (point-max)) - )) - (set-buffer temp-buf) - (set-buffer-modified-p nil) - (kill-buffer temp-buf)) - )) - (set-buffer orig-buf) - ;; this prevents the loss of data if writing part of the buffer + ;; writing to non-visited file and it already exists + (if (and file-exists (not writing-same-file) + (not (yes-or-no-p + (format "File %s exists. Overwrite? " ex-file)))) + (error "Quit")) + ;; writing a region or whole buffer to non-visited file + (unwind-protect + (save-excursion + (viper-enlarge-region beg end) + (setq region (buffer-substring (point) (mark t))) + ;; create temp buffer for the region + (setq temp-buf (get-buffer-create " *ex-write*")) + (set-buffer temp-buf) + (set-visited-file-name ex-file 'noquerry) + (erase-buffer) + (if (and file-exists ex-append) + (insert-file-contents ex-file)) + (goto-char (point-max)) + (insert region) + ;; ask user + (viper-maybe-checkout (current-buffer)) + (save-buffer) + (ex-write-info + file-exists ex-file (point-min) (point-max)) + ) + ;; this must be under unwind-protect so that + ;; temp-buf will be deleted in case of an error + (set-buffer temp-buf) + (set-buffer-modified-p nil) + (kill-buffer temp-buf) + ;; buffer/region has been written, now take care of details + (set-buffer orig-buf))) + ;; set the right file modification time (if (and (buffer-file-name) writing-same-file) (set-visited-file-modtime)) + ;; prevent loss of data if saving part of the buffer in visited file (or writing-whole-file (not writing-same-file) - (set-buffer-modified-p t)) + (progn + (sit-for 2) + (message "Warning: you have saved only part of the buffer!") + (set-buffer-modified-p t))) (if q-flag (if (< viper-expert-level 2) (save-buffers-kill-emacs)
--- a/lisp/emulation/viper-init.el Mon May 04 22:33:38 1998 +0000 +++ b/lisp/emulation/viper-init.el Mon May 04 22:42:59 1998 +0000 @@ -30,6 +30,9 @@ (defvar viper-current-state) (defvar viper-version) (defvar viper-expert-level) +(defvar current-input-method) +(defvar default-input-method) +(defvar describe-current-input-method-function) ;; end pacifier @@ -302,6 +305,7 @@ (or current-input-method default-input-method)) ""))) )) + ;; viper hook to run on input-method deactivation (defun viper-inactivate-input-method-action () (if (null viper-mule-hook-flag) @@ -367,14 +371,7 @@ ;; Replace mode and changing text -;; Viper's own after/before change functions, which get viper-add-hook'ed to -;; Emacs's -(viper-deflocalvar viper-after-change-functions nil "") -(viper-deflocalvar viper-before-change-functions nil "") -(viper-deflocalvar viper-post-command-hooks nil "") -(viper-deflocalvar viper-pre-command-hooks nil "") - -;; Can be used to pass global states around for short period of time +;; Hack used to pass global states around for short period of time (viper-deflocalvar viper-intermediate-command nil "") ;; This is used to pass the right Vi command key sequence to @@ -542,7 +539,9 @@ :group 'viper) (defcustom viper-shift-width 8 - "*The shiftwidth variable." + "*The value of the shiftwidth. +This determines the number of columns by which the Ctl-t moves the cursor in +the Insert state." :type 'integer :group 'viper) @@ -791,15 +790,6 @@ ;;; Face-saving tricks -;;(defcustom viper-replace-overlay-pixmap "gray3" -;; "Pixmap to use for search face on non-color displays." -;; :type 'string -;; :group 'viper) -;;(defcustom viper-search-face-pixmap "gray3" -;; "Pixmap to use for search face on non-color displays." -;; :type 'string -;; :group 'viper) - (defun viper-hide-face (face) (if (and (viper-has-face-support-p) viper-emacs-p) (add-to-list 'facemenu-unlisted-faces face))) @@ -810,21 +800,6 @@ :prefix "viper-" :group 'viper) -;;(defvar viper-search-face -;; (if (viper-has-face-support-p) -;; (progn -;; (make-face 'viper-search-face) -;; (or (face-differs-from-default-p 'viper-search-face) -;; ;; face wasn't set in .viper or .Xdefaults -;; (if (viper-can-use-colors "Black" "khaki") -;; (progn -;; (set-face-background 'viper-search-face "khaki") -;; (set-face-foreground 'viper-search-face "Black")) -;; (set-face-underline-p 'viper-search-face t) -;; (viper-set-face-pixmap 'viper-search-face -;; viper-search-face-pixmap))) -;; 'viper-search-face)) -;; "*Face used to flash out the search pattern.") (defface viper-search-face '((((class color)) (:foreground "Black" :background "khaki")) @@ -839,22 +814,6 @@ this variable represents.") (viper-hide-face 'viper-search-face) -;;(defvar viper-replace-overlay-face -;; (if (viper-has-face-support-p) -;; (progn -;; (make-face 'viper-replace-overlay-face) -;; (or (face-differs-from-default-p 'viper-replace-overlay-face) -;; (progn -;; (if (viper-can-use-colors "darkseagreen2" "Black") -;; (progn -;; (set-face-background -;; 'viper-replace-overlay-face "darkseagreen2") -;; (set-face-foreground 'viper-replace-overlay-face "Black"))) -;; (set-face-underline-p 'viper-replace-overlay-face t) -;; (viper-set-face-pixmap -;; 'viper-replace-overlay-face viper-replace-overlay-pixmap))) -;; 'viper-replace-overlay-face)) -;; "*Face for highlighting replace regions on a window display.") (defface viper-replace-overlay-face '((((class color)) (:foreground "Black" :background "darkseagreen2")) @@ -869,31 +828,6 @@ this variable represents.") (viper-hide-face 'viper-replace-overlay-face) -;;(defvar viper-minibuffer-emacs-face -;; (if (viper-has-face-support-p) -;; (progn -;; (make-face 'viper-minibuffer-emacs-face) -;; (or (face-differs-from-default-p 'viper-minibuffer-emacs-face) -;; ;; face wasn't set in .viper or .Xdefaults -;; (if viper-vi-style-in-minibuffer -;; ;; emacs state is an exception in the minibuffer -;; (if (viper-can-use-colors "darkseagreen2" "Black") -;; (progn -;; (set-face-background -;; 'viper-minibuffer-emacs-face "darkseagreen2") -;; (set-face-foreground -;; 'viper-minibuffer-emacs-face "Black")) -;; (copy-face 'modeline 'viper-minibuffer-emacs-face)) -;; ;; emacs state is the main state in the minibuffer -;; (if (viper-can-use-colors "Black" "pink") -;; (progn -;; (set-face-background 'viper-minibuffer-emacs-face "pink") -;; (set-face-foreground -;; 'viper-minibuffer-emacs-face "Black")) -;; (copy-face 'italic 'viper-minibuffer-emacs-face)) -;; )) -;; 'viper-minibuffer-emacs-face)) -;; "Face used in the Minibuffer when it is in Emacs state.") (defface viper-minibuffer-emacs-face '((((class color)) (:foreground "Black" :background "darkseagreen2")) @@ -908,29 +842,6 @@ this variable represents.") (viper-hide-face 'viper-minibuffer-emacs-face) -;;(defvar viper-minibuffer-insert-face -;; (if (viper-has-face-support-p) -;; (progn -;; (make-face 'viper-minibuffer-insert-face) -;; (or (face-differs-from-default-p 'viper-minibuffer-insert-face) -;; (if viper-vi-style-in-minibuffer -;; (if (viper-can-use-colors "Black" "pink") -;; (progn -;; (set-face-background 'viper-minibuffer-insert-face "pink") -;; (set-face-foreground -;; 'viper-minibuffer-insert-face "Black")) -;; (copy-face 'italic 'viper-minibuffer-insert-face)) -;; ;; If Insert state is an exception -;; (if (viper-can-use-colors "darkseagreen2" "Black") -;; (progn -;; (set-face-background -;; 'viper-minibuffer-insert-face "darkseagreen2") -;; (set-face-foreground -;; 'viper-minibuffer-insert-face "Black")) -;; (copy-face 'modeline 'viper-minibuffer-insert-face)) -;; (viper-italicize-face 'viper-minibuffer-insert-face))) -;; 'viper-minibuffer-insert-face)) -;; "Face used in the Minibuffer when it is in Insert state.") (defface viper-minibuffer-insert-face '((((class color)) (:foreground "Black" :background "pink")) @@ -945,21 +856,6 @@ this variable represents.") (viper-hide-face 'viper-minibuffer-insert-face) -;;(defvar viper-minibuffer-vi-face -;; (if (viper-has-face-support-p) -;; (progn -;; (make-face 'viper-minibuffer-vi-face) -;; (or (face-differs-from-default-p 'viper-minibuffer-vi-face) -;; (if viper-vi-style-in-minibuffer -;; (if (viper-can-use-colors "Black" "grey") -;; (progn -;; (set-face-background 'viper-minibuffer-vi-face "grey") -;; (set-face-foreground 'viper-minibuffer-vi-face "Black")) -;; (copy-face 'bold 'viper-minibuffer-vi-face)) -;; (copy-face 'bold 'viper-minibuffer-vi-face) -;; (invert-face 'viper-minibuffer-vi-face))) -;; 'viper-minibuffer-vi-face)) -;; "Face used in the Minibuffer when it is in Vi state.") (defface viper-minibuffer-vi-face '((((class color)) (:foreground "DarkGreen" :background "grey")) @@ -1006,9 +902,9 @@ (viper-deflocalvar viper-minibuffer-overlay nil) ;; Hook, specific to Viper, which is run just *before* exiting the minibuffer. -;; Beginning with Emacs 19.26, the standard `minibuffer-exit-hook' is run -;; *after* exiting the minibuffer -(defvar viper-minibuffer-exit-hook '(viper-minibuffer-trim-tail)) +;; This is needed because beginning with Emacs 19.26, the standard +;; `minibuffer-exit-hook' is run *after* exiting the minibuffer +(defvar viper-minibuffer-exit-hook nil) ;; Mode line
--- a/lisp/emulation/viper-keym.el Mon May 04 22:33:38 1998 +0000 +++ b/lisp/emulation/viper-keym.el Mon May 04 22:42:59 1998 +0000 @@ -530,7 +530,7 @@ ;; Normalization usually doesn't help here, since one needs to ;; normalize in the actual buffer where changes to the keymap are ;; to take place. However, it doesn't hurt, and it helps whenever this - ;; function is actually called from within the right buffer. + ;; function is actually called from within the affected buffer. (viper-normalize-minor-mode-map-alist) (viper-set-mode-vars-for viper-current-state)))
--- a/lisp/emulation/viper-util.el Mon May 04 22:33:38 1998 +0000 +++ b/lisp/emulation/viper-util.el Mon May 04 22:42:59 1998 +0000 @@ -110,32 +110,12 @@ (cdr (assoc 'cursor-color (frame-parameters))) (color-instance-name (frame-property (selected-frame) 'cursor-color)))) -;;(defun viper-set-face-pixmap (face pixmap) -;; "Set face pixmap on a monochrome display." -;; (if (and (viper-window-display-p) (not (viper-color-display-p))) -;; (condition-case nil -;; (set-face-background-pixmap face pixmap) -;; (error -;; (message "Pixmap not found for %S: %s" (face-name face) pixmap) -;; (sit-for 1))))) - ;; OS/2 (cond ((eq (viper-device-type) 'pm) (fset 'viper-color-defined-p (function (lambda (color) (assoc color pm-color-alist)))))) -;; needed to smooth out the difference between Emacs and XEmacs -;;(defsubst viper-italicize-face (face) -;; (if viper-xemacs-p -;; (make-face-italic face) -;; (make-face-italic face nil 'noerror))) - -;; test if display is color and the colors are defined -;;(defsubst viper-can-use-colors (&rest colors) -;; (if (viper-color-display-p) -;; (not (memq nil (mapcar 'viper-color-defined-p colors))) -;; )) ;; cursor colors (defun viper-change-cursor-color (new-color) @@ -620,13 +600,69 @@ (let ((buf (find-file-noselect (substitute-in-file-name custom-file)))) (save-excursion (set-buffer buf) - (goto-char (point-min)) - (if pattern (delete-matching-lines pattern)) - (goto-char (point-max)) - (if string (insert string)) - (save-buffer)) + (let (buffer-read-only) + (goto-char (point-min)) + (if pattern (delete-matching-lines pattern)) + (goto-char (point-max)) + (if string (insert string)) + (save-buffer))) (kill-buffer buf) )) + + +;; define remote file test +(or (fboundp 'viper-file-remote-p) ; user supplied his own function: use it + (defun viper-file-remote-p (file-name) + (car (cond ((featurep 'efs-auto) (efs-ftp-path file-name)) + ((fboundp 'file-remote-p) (file-remote-p file-name)) + (t (require 'ange-ftp) + ;; Can happen only in Emacs, since XEmacs has file-remote-p + (ange-ftp-ftp-name file-name)))))) + + + +;; This is a simple-minded check for whether a file is under version control. +;; If file,v exists but file doesn't, this file is considered to be not checked +;; in and not checked out for the purpose of patching (since patch won't be +;; able to read such a file anyway). +;; FILE is a string representing file name +;;(defun viper-file-under-version-control (file) +;; (let* ((filedir (file-name-directory file)) +;; (file-nondir (file-name-nondirectory file)) +;; (trial (concat file-nondir ",v")) +;; (full-trial (concat filedir trial)) +;; (full-rcs-trial (concat filedir "RCS/" trial))) +;; (and (stringp file) +;; (file-exists-p file) +;; (or +;; (and +;; (file-exists-p full-trial) +;; ;; in FAT FS, `file,v' and `file' may turn out to be the same! +;; ;; don't be fooled by this! +;; (not (equal (file-attributes file) +;; (file-attributes full-trial)))) +;; ;; check if a version is in RCS/ directory +;; (file-exists-p full-rcs-trial))) +;; )) + + +(defsubst viper-file-checked-in-p (file) + (and (vc-backend file) + (not (vc-locking-user file)))) +;; checkout if visited file is checked in +(defun viper-maybe-checkout (buf) + (let ((file (expand-file-name (buffer-file-name buf))) + (checkout-function (key-binding "\C-x\C-q"))) + (if (and (viper-file-checked-in-p file) + (or (beep 1) t) + (y-or-n-p + (format + "File %s is checked in. Check it out? " + (viper-abbreviate-file-name file)))) + (with-current-buffer buf + (command-execute checkout-function))))) + + ;;; Overlays @@ -737,7 +773,8 @@ (defsubst viper-is-in-minibuffer () - (string-match "\*Minibuf-" (buffer-name))) + (save-match-data + (string-match "\*Minibuf-" (buffer-name)))) @@ -814,50 +851,6 @@ (cond (viper-xemacs-p (events-to-keys events)) (t events))) - -;; This is here because Emacs changed the way local hooks work. -;; -;;Add to the value of HOOK the function FUNCTION. -;;FUNCTION is not added if already present. -;;FUNCTION is added (if necessary) at the beginning of the hook list -;;unless the optional argument APPEND is non-nil, in which case -;;FUNCTION is added at the end. -;; -;;HOOK should be a symbol, and FUNCTION may be any valid function. If -;;HOOK is void, it is first set to nil. If HOOK's value is a single -;;function, it is changed to a list of functions." -(defun viper-add-hook (hook function &optional append) - (if (not (boundp hook)) (set hook nil)) - ;; If the hook value is a single function, turn it into a list. - (let ((old (symbol-value hook))) - (if (or (not (listp old)) (eq (car old) 'lambda)) - (setq old (list old))) - (if (member function old) - nil - (set hook (if append - (append old (list function)) ; don't nconc - (cons function old)))))) - -;; This is here because of Emacs's changes in the semantics of add/remove-hooks -;; and due to the bugs they introduced. -;; -;; Remove from the value of HOOK the function FUNCTION. -;; HOOK should be a symbol, and FUNCTION may be any valid function. If -;; FUNCTION isn't the value of HOOK, or, if FUNCTION doesn't appear in the -;; list of hooks to run in HOOK, then nothing is done. See `viper-add-hook'." -(defun viper-remove-hook (hook function) - (if (or (not (boundp hook)) ;unbound symbol, or - (null (symbol-value hook)) ;value is nil, or - (null function)) ;function is nil, then - nil ;Do nothing. - (let ((hook-value (symbol-value hook))) - (if (consp hook-value) - ;; don't side-effect the list - (setq hook-value (delete function (copy-sequence hook-value))) - (if (equal hook-value function) - (setq hook-value nil))) - (set hook hook-value)))) - ;; it is suggested that an event must be copied before it is assigned to ;; last-command-event in XEmacs
--- a/lisp/emulation/viper.el Mon May 04 22:33:38 1998 +0000 +++ b/lisp/emulation/viper.el Mon May 04 22:42:59 1998 +0000 @@ -6,9 +6,9 @@ ;; Keywords: emulations ;; Author: Michael Kifer <kifer@cs.sunysb.edu> -;; Copyright (C) 1994, 1995, 1996, 1997 Free Software Foundation, Inc. +;; Copyright (C) 1994, 1995, 1996, 1997, 1998 Free Software Foundation, Inc. -(defconst viper-version "3.004 (Polyglot) of November 11, 1997" +(defconst viper-version "3.02 (Polyglot) of March 7, 1998" "The current version of Viper") ;; This file is part of GNU Emacs. @@ -304,7 +304,8 @@ (defvar mark-even-if-inactive) (defvar quail-mode) (defvar viper-expert-level) -(defvar viper-expert-level) +(defvar viper-mode-string) +(defvar viper-major-mode-modifier-list) ;; loading happens only in non-interactive compilation ;; in order to spare non-viperized emacs from being viperized @@ -369,17 +370,123 @@ :tag "Set Viper Mode on Loading" :group 'viper-misc) -(defcustom viper-non-vi-major-modes - '(custom-mode dired-mode efs-mode internal-ange-ftp-mode tar-mode - mh-folder-mode gnus-group-mode gnus-summary-mode Info-mode - Buffer-menu-mode view-mode vm-mode vm-summary-mode) - "*A list of major modes that should never come up in Vi command mode. -Viper automatically augments this list with some obvious modes, such as -`dired-mode', `tar-mode', etc. So, don't put a mode on this list, unless -it comes up in a wrong Viper state." +(defcustom viper-vi-state-mode-list + '(fundamental-mode + makefile-mode + help-mode + + awk-mode + m4-mode + + html-mode html-helper-mode + emacs-lisp-mode lisp-mode lisp-interaction-mode + + java-mode cc-mode c-mode c++-mode + fortran-mode f90-mode + basic-mode + bat-mode + asm-mode + prolog-mode + + text-mode indented-text-mode + tex-mode latex-mode bibtex-mode + + completion-list-mode + compilation-mode + + perl-mode + javascript-mode + tcl-mode + python-mode + + sh-mode ksh-mode csh-mode + + gnus-article-mode + mh-show-mode + ) + "Major modes that require Vi command state." :type '(repeat symbol) :group 'viper-misc) +(defcustom viper-emacs-state-mode-list + '(custom-mode + + dired-mode + efs-mode + tar-mode + + mh-folder-mode + gnus-group-mode + gnus-summary-mode + + Info-mode + Buffer-menu-mode + + view-mode + vm-mode + vm-summary-mode) + "*A list of major modes that should come up in Emacs state. +Normally, Viper would bring buffers up in Emacs state, unless the corresponding +major mode has been placed on `viper-vi-state-mode-list' or +`viper-insert-state-mode-list'. So, don't place a new mode on this list, unless +it is coming up in a wrong Viper state." + :type '(repeat symbol) + :group 'viper-misc) + +(defcustom viper-insert-state-mode-list + '(internal-ange-ftp-mode comint-mode shell-mode) + "*A list of major modes that should come up in Vi Insert state." + :type '(repeat symbol) + :group 'viper-misc) + + +;; used to set viper-major-mode-modifier-list in defcustom +(defun viper-apply-major-mode-modifiers (&optional symbol value) + (if symbol + (set symbol value)) + (mapcar (function + (lambda (triple) + (viper-modify-major-mode + (nth 0 triple) (nth 1 triple) (eval (nth 2 triple))))) + viper-major-mode-modifier-list)) + +(defcustom viper-major-mode-modifier-list + '((help-mode emacs-state viper-slash-and-colon-map) + (comint-mode insert-state viper-comint-mode-modifier-map) + (comint-mode vi-state viper-comint-mode-modifier-map) + (shell-mode insert-state viper-comint-mode-modifier-map) + (shell-mode vi-state viper-comint-mode-modifier-map) + (ange-ftp-shell-mode insert-state viper-comint-mode-modifier-map) + (ange-ftp-shell-mode vi-state viper-comint-mode-modifier-map) + (internal-ange-ftp-mode insert-state viper-comint-mode-modifier-map) + (internal-ange-ftp-mode vi-state viper-comint-mode-modifier-map) + (dired-mode emacs-state viper-dired-modifier-map) + (tar-mode emacs-state viper-slash-and-colon-map) + (mh-folder-mode emacs-state viper-slash-and-colon-map) + (gnus-group-mode emacs-state viper-slash-and-colon-map) + (gnus-summary-mode emacs-state viper-slash-and-colon-map) + (Info-mode emacs-state viper-slash-and-colon-map) + (Buffer-menu-mode emacs-state viper-slash-and-colon-map) + ) + "List specifying how to modify the various major modes to enable some Viperisms. +The list has the structure: ((mode viper-state keymap) (mode viper-state +keymap) ...). If `mode' is on the list, the `kemap' will be made active (on the +minor-mode-map-alist) in the specified viper state. +If you change this list, have to restart emacs for the change to take effect. +However, if you did the change through the customization widget, then emacs +needs to be restarted only if you deleted a triple mode-state-keymap from the +list. No need to restart emacs in case of insertion or modification of an +existing triple." + :type '(repeat + (list symbol + (choice (const emacs-state) + (const vi-state) + (const insert-state)) + symbol)) + :set 'viper-apply-major-mode-modifiers + :group 'viper-misc) + + @@ -472,7 +579,8 @@ )) (viper-set-expert-level 'dont-change-unless))) - (or (memq major-mode viper-non-vi-major-modes) ; don't switch to Vi + (or (memq major-mode viper-emacs-state-mode-list) ; don't switch to Vi + (memq major-mode viper-insert-state-mode-list) ; don't switch (viper-change-state-to-vi))))) @@ -517,8 +625,6 @@ ;; restore non-viper vars (setq-default - default-major-mode - (viper-standard-value 'default-major-mode viper-saved-non-viper-variables) next-line-add-newlines (viper-standard-value 'next-line-add-newlines viper-saved-non-viper-variables) @@ -614,6 +720,7 @@ (mapatoms 'viper-remove-hooks) (remove-hook 'comint-mode-hook 'viper-comint-mode-hook) (remove-hook 'minibuffer-setup-hook 'viper-minibuffer-setup-sentinel) + (remove-hook 'change-major-mode-hook 'viper-major-mode-change-sentinel) ;; unbind Viper mouse bindings (viper-unbind-mouse-search-key) @@ -626,94 +733,65 @@ ) ; end viper-go-away +;; list of buffers that just changed their major mode +;; used in a hack that triggers vi command mode whenever needed +(defvar viper-new-major-mode-buffer-list nil) + +;; set appropriate Viper state in buffers that changed major mode +(defun set-viper-state-in-major-mode () + (mapcar + (function + (lambda (buf) + (if (viper-buffer-live-p buf) + (with-current-buffer buf + (cond ((and (memq major-mode viper-vi-state-mode-list) + (eq viper-current-state 'emacs-state)) + (viper-mode)) + ((memq major-mode viper-emacs-state-mode-list) + ;; not checking (eq viper-current-state 'emacs-state) + ;; because viper-current-state could have gotten it by + ;; default. we need viper-change-state-to-emacs here to have + ;; the keymaps take effect. + (viper-change-state-to-emacs)) + ((and (memq major-mode viper-insert-state-mode-list) + (not (eq viper-current-state 'insert-state))) + (viper-change-state-to-insert)) + )) ; with-current-buffer + ))) ; function + viper-new-major-mode-buffer-list) + ;; clear the list of bufs that changed major mode + (setq viper-new-major-mode-buffer-list nil) + ;; change the global value of hook + (remove-hook 'viper-post-command-hooks 'set-viper-state-in-major-mode)) + +;; sets up post-command-hook to turn viper-mode, if the current mode is +;; fundamental +(defun viper-major-mode-change-sentinel () + (save-match-data + (or (string-match "\*Minibuf-" (buffer-name)) + (setq viper-new-major-mode-buffer-list + (cons (current-buffer) viper-new-major-mode-buffer-list)))) + ;; change the global value of hook + (add-hook 'viper-post-command-hooks 'set-viper-state-in-major-mode t)) + ;; This sets major mode hooks to make them come up in vi-state. (defun viper-set-hooks () - ;; It is of course a misnomer to call viper-mode a `major mode'. ;; However, this has the effect that if the user didn't specify the ;; default mode, new buffers that fall back on the default will come up ;; in Fundamental Mode and Vi state. - (setq default-major-mode 'viper-mode) - - ;; The following major modes should come up in vi-state - (defadvice fundamental-mode (after viper-fundamental-mode-ad activate) - "Run `viper-change-state-to-vi' on entry." - (viper-change-state-to-vi)) - - (defvar makefile-mode-hook) - (add-hook 'makefile-mode-hook 'viper-mode) - - ;; Help mode is now for viewing only - (defvar help-mode-hook) - (add-hook 'help-mode-hook 'viper-change-state-to-emacs) - (viper-modify-major-mode 'help-mode 'emacs-state viper-slash-and-colon-map) - - (defvar awk-mode-hook) - (add-hook 'awk-mode-hook 'viper-mode) - - (defvar html-mode-hook) - (add-hook 'html-mode-hook 'viper-mode) - (defvar html-helper-mode-hook) - (add-hook 'html-helper-mode-hook 'viper-mode) - - (defvar java-mode-hook) - (add-hook 'java-mode-hook 'viper-mode) - - (defvar javascript-mode-hook) - (add-hook 'javascript-mode-hook 'viper-mode) + (if (eq default-major-mode 'fundamental-mode) + (setq default-major-mode 'viper-mode)) - (defvar emacs-lisp-mode-hook) - (add-hook 'emacs-lisp-mode-hook 'viper-mode) - (defvar lisp-mode-hook) - (add-hook 'lisp-mode-hook 'viper-mode) - (defvar lisp-interaction-mode-hook) - (add-hook 'lisp-interaction-mode-hook 'viper-mode) - - (defvar bibtex-mode-hook) - (add-hook 'bibtex-mode-hook 'viper-mode) - - (defvar cc-mode-hook) - (add-hook 'cc-mode-hook 'viper-mode) - - (defvar c-mode-hook) - (add-hook 'c-mode-hook 'viper-mode) - - (defvar c++-mode-hook) - (add-hook 'c++-mode-hook 'viper-mode) + (add-hook 'change-major-mode-hook 'viper-major-mode-change-sentinel) + (add-hook 'find-file-hooks 'set-viper-state-in-major-mode) - (defvar fortran-mode-hook) - (add-hook 'fortran-mode-hook 'viper-mode) - (defvar f90-mode-hook) - (add-hook 'f90-mode-hook 'viper-mode) - - (defvar basic-mode-hook) - (add-hook 'basic-mode-hook 'viper-mode) - (defvar bat-mode-hook) - (add-hook 'bat-mode-hook 'viper-mode) - - (defvar asm-mode-hook) - (add-hook 'asm-mode-hook 'viper-mode) - - (defvar prolog-mode-hook) - (add-hook 'prolog-mode-hook 'viper-mode) - + ;; keep this because many modes we don't know about use this hook (defvar text-mode-hook) (add-hook 'text-mode-hook 'viper-mode) - (add-hook 'completion-list-mode-hook 'viper-mode) - (add-hook 'compilation-mode-hook 'viper-mode) - - (defvar perl-mode-hook) - (add-hook 'perl-mode-hook 'viper-mode) - - (defvar tcl-mode-hook) - (add-hook 'tcl-mode-hook 'viper-mode) - - (defvar python-mode-hook) - (add-hook 'python-mode-hook 'viper-mode) - (defvar emerge-startup-hook) (add-hook 'emerge-startup-hook 'viper-change-state-to-emacs) @@ -747,92 +825,18 @@ (viper-change-state-to-emacs))) ;; Emacs shell, ange-ftp, and comint-based modes - (defvar comint-mode-hook) - (viper-modify-major-mode - 'comint-mode 'insert-state viper-comint-mode-modifier-map) - (viper-modify-major-mode - 'comint-mode 'vi-state viper-comint-mode-modifier-map) - (viper-modify-major-mode - 'shell-mode 'insert-state viper-comint-mode-modifier-map) - (viper-modify-major-mode - 'shell-mode 'vi-state viper-comint-mode-modifier-map) - ;; ange-ftp in XEmacs - (viper-modify-major-mode - 'ange-ftp-shell-mode 'insert-state viper-comint-mode-modifier-map) - (viper-modify-major-mode - 'ange-ftp-shell-mode 'vi-state viper-comint-mode-modifier-map) - ;; ange-ftp in Emacs - (viper-modify-major-mode - 'internal-ange-ftp-mode 'insert-state viper-comint-mode-modifier-map) - (viper-modify-major-mode - 'internal-ange-ftp-mode 'vi-state viper-comint-mode-modifier-map) - ;; set hook - (add-hook 'comint-mode-hook 'viper-comint-mode-hook) - - ;; Shell scripts - (defvar sh-mode-hook) - (add-hook 'sh-mode-hook 'viper-mode) - (defvar ksh-mode-hook) - (add-hook 'ksh-mode-hook 'viper-mode) - - ;; Dired - (viper-modify-major-mode 'dired-mode 'emacs-state viper-dired-modifier-map) - (viper-set-emacs-state-searchstyle-macros nil 'dired-mode) - (add-hook 'dired-mode-hook 'viper-change-state-to-emacs) - - ;; Tar - (viper-modify-major-mode 'tar-mode 'emacs-state viper-slash-and-colon-map) - (viper-set-emacs-state-searchstyle-macros nil 'tar-mode) + (add-hook 'comint-mode-hook 'viper-comint-mode-hook) ; comint - ;; MH-E - (viper-modify-major-mode - 'mh-folder-mode 'emacs-state viper-slash-and-colon-map) - (viper-set-emacs-state-searchstyle-macros nil 'mh-folder-mode) - ;; changing state to emacs is needed so the preceding will take hold - (add-hook 'mh-folder-mode-hook 'viper-change-state-to-emacs) - (add-hook 'mh-show-mode-hook 'viper-mode) - - ;; Gnus - (viper-modify-major-mode - 'gnus-group-mode 'emacs-state viper-slash-and-colon-map) - (viper-set-emacs-state-searchstyle-macros nil 'gnus-group-mode) - (viper-modify-major-mode - 'gnus-summary-mode 'emacs-state viper-slash-and-colon-map) + (viper-set-emacs-state-searchstyle-macros nil 'dired-mode) ; dired + (viper-set-emacs-state-searchstyle-macros nil 'tar-mode) ; tar + (viper-set-emacs-state-searchstyle-macros nil 'mh-folder-mode) ; mhe + (viper-set-emacs-state-searchstyle-macros nil 'gnus-group-mode) ; gnus (viper-set-emacs-state-searchstyle-macros nil 'gnus-summary-mode) - ;; changing state to emacs is needed so the preceding will take hold - (add-hook 'gnus-group-mode-hook 'viper-change-state-to-emacs) - (add-hook 'gnus-summary-mode-hook 'viper-change-state-to-emacs) - (add-hook 'gnus-article-mode-hook 'viper-mode) + (viper-set-emacs-state-searchstyle-macros nil 'Info-mode) ; info + (viper-set-emacs-state-searchstyle-macros nil 'Buffer-menu-mode) ;buffer-menu - ;; Info - (viper-modify-major-mode 'Info-mode 'emacs-state viper-slash-and-colon-map) - (viper-set-emacs-state-searchstyle-macros nil 'Info-mode) - ;; Switching to emacs is needed so the above will take hold - (defadvice Info-mode (after viper-Info-ad activate) - "Switch to emacs mode." - (viper-change-state-to-emacs)) - - ;; Buffer menu - (viper-modify-major-mode - 'Buffer-menu-mode 'emacs-state viper-slash-and-colon-map) - (viper-set-emacs-state-searchstyle-macros nil 'Buffer-menu-mode) - ;; Switching to emacs is needed so the above will take hold - (defadvice Buffer-menu-mode (after viper-Buffer-menu-ad activate) - "Switch to emacs mode." - (viper-change-state-to-emacs)) - - ;; View mode - (defvar view-mode-hook) - (defvar view-hook) - (add-hook 'view-hook 'viper-change-state-to-emacs) - (add-hook 'view-mode-hook 'viper-change-state-to-emacs) - - ;; For VM users. - ;; Put summary and other VM buffers in Emacs state. - (defvar vm-mode-hooks) - (defvar vm-summary-mode-hooks) - (add-hook 'vm-mode-hooks 'viper-change-state-to-emacs) - (add-hook 'vm-summary-mode-hooks 'viper-change-state-to-emacs) + ;; Modify major modes according to viper-major-mode-modifier-list + (viper-apply-major-mode-modifiers) ;; For RMAIL users. ;; Put buf in Emacs state after edit. @@ -968,12 +972,6 @@ (read-key-sequence "Describe key briefly: "))))) - ;; This is now done in viper-minibuffer-exit-hook - ;;;; Advice for use in find-file and read-file-name commands. - ;;(defadvice exit-minibuffer (before viper-exit-minibuffer-advice activate) - ;; "Run `viper-minibuffer-exit-hook' just before exiting the minibuffer." - ;; (run-hooks 'viper-minibuffer-exit-hook)) - (defadvice find-file (before viper-add-suffix-advice activate) "Use `read-file-name' for reading arguments." (interactive (cons (read-file-name "Find file: " nil default-directory) @@ -1029,7 +1027,8 @@ (defadvice read-file-name (around viper-suffix-advice activate) "Tell `exit-minibuffer' to run `viper-file-add-suffix' as a hook." (let ((viper-minibuffer-exit-hook - (append viper-minibuffer-exit-hook '(viper-file-add-suffix)))) + (append viper-minibuffer-exit-hook + '(viper-minibuffer-trim-tail viper-file-add-suffix)))) ad-do-it)) (defadvice start-kbd-macro (after viper-kbd-advice activate) @@ -1081,7 +1080,7 @@ ;; If viper-mode is t, then just continue. Viper will kick in. ((eq viper-mode t)) - ;; Otherwise, it was asking mode and Viper was not loaded through .emacs + ;; Otherwise, it was asking Viper was not loaded through .emacs ;; In this case, it was either through M-x viper-mode or via something ;; else, like the custom widget. If Viper was loaded through ;; M-x viper-mode, then viper will kick in anyway. @@ -1109,7 +1108,6 @@ (if (null viper-saved-non-viper-variables) (setq viper-saved-non-viper-variables (list - (cons 'default-major-mode (list default-major-mode)) (cons 'next-line-add-newlines (list next-line-add-newlines)) (cons 'require-final-newline (list require-final-newline)) (cons 'scroll-step (list scroll-step)) @@ -1198,6 +1196,7 @@ (viper-harness-minor-mode "russian") (viper-harness-minor-mode "view-less") (viper-harness-minor-mode "view") + (viper-harness-minor-mode "reftex") )) @@ -1251,7 +1250,9 @@ (viper-change-state-to-emacs) (setq-default minor-mode-map-alist minor-mode-map-alist) )) - + +(if (and viper-mode (memq major-mode viper-vi-state-mode-list)) + (viper-mode)) (run-hooks 'viper-load-hook) ; the last chance to change something