mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-01-22 18:35:09 +00:00
Code Issues Releases Activity

new version

Browse Source
This commit is contained in:
Michael Kifer 1998-05-04 22:42:59 +00:00
parent 38cf95df42
commit 2eb4bdca8a
12 changed files with 559 additions and 975 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
lisp/ediff-diff.el
View File

@ -1110,7 +1110,7 @@ one optional arguments, diff-number to refine.")
(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.

405
lisp/ediff-init.el
View File

@ -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 @@ that Ediff doesn't know about.")
(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 @@ See the documentation string of `ediff-focus-on-regexp-matches' for details.")
: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 @@ meaning of this variable."
: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 @@ appropriate symbol: `rcs', `pcl-cvs', or `generic-sc' if you so desire."
(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 @@ appropriate symbol: `rcs', `pcl-cvs', or `generic-sc' if you so desire."
(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 @@ this variable represents.")
;;(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 @@ this variable represents.")
(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 @@ this variable represents.")
(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 @@ this variable represents.")
(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 @@ widget to customize the actual face object `ediff-fine-diff-face-A'
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 @@ widget to customize the actual face object `ediff-fine-diff-face-B'
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 @@ widget to customize the actual face object `ediff-fine-diff-face-C'
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 @@ widget to customize the actual face object `ediff-fine-diff-face-Ancestor'
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 @@ widget to customize the actual face object `ediff-even-diff-face-A'
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 @@ widget to customize the actual face object `ediff-even-diff-face-B'
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 @@ widget to customize the actual face object `ediff-even-diff-face-C'
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 @@ widget to customize the actual face object `ediff-even-diff-face-Ancestor'
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 @@ this variable represents.")
(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 @@ widget to customize the actual face object `ediff-odd-diff-face-A'
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 @@ widget to customize the actual face object `ediff-odd-diff-face-B'
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 @@ widget to customize the actual face object `ediff-odd-diff-face-C'
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 @@ widget to customize the actual face object `ediff-odd-diff-face-Ancestor'
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 @@ This property can be toggled interactively."
"*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)

90
lisp/ediff-util.el
View File

@ -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 @@ of the current buffer."
;; 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 @@ of the current buffer."
;; 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)))
;; ))
(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-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))))
(defun ediff-swap-buffers ()
"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."
(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 @@ the width of the A/B/C windows."
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 @@ Hit \\[ediff-recenter] to reset the windows afterward."
(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)))

2
lisp/ediff-vers.el
View File

@ -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))

3
lisp/ediff-wind.el
View File

@ -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 @@ into icons, regardless of the window manager."
;; 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)

4
lisp/ediff.el
View File

@ -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.

196
lisp/emulation/viper-cmd.el
View File

@ -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 @@ as a Meta key and any number of multiple escapes is allowed."
;; 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 @@ as a Meta key and any number of multiple escapes is allowed."
;; 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 @@ as a Meta key and any number of multiple escapes is allowed."
(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 @@ as a Meta key and any number of multiple escapes is allowed."
(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 @@ as a Meta key and any number of multiple escapes is allowed."
(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 @@ as a Meta key and any number of multiple escapes is allowed."
(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 @@ problems."
(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 @@ problems."
;; 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 @@ problems."
(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 @@ On reaching beginning of line, stop and signal error."
(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 @@ controlled by the sign of prefix numeric value."
(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 @@ controlled by the sign of prefix numeric value."
(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 @@ controlled by the sign of prefix numeric value."
(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 @@ Null string will repeat previous search."
((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 @@ Null string will repeat previous search."
(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

206
lisp/emulation/viper-ex.el
View File

@ -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 @@ reversed."
"\\|" "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 @@ reversed."
(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 @@ reversed."
(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 @@ reversed."
(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 @@ reversed."
(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 @@ reversed."
((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 @@ reversed."
(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 @@ reversed."
(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 @@ reversed."
(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 @@ Please contact your system administrator. "
(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 @@ Please contact your system administrator. "
(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 @@ Please contact your system administrator. "
(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)

126
lisp/emulation/viper-init.el
View File

@ -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 @@ Use `M-x viper-set-expert-level' to change this.")
(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 @@ it better fits your working style."
;; 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 @@ programs and LaTeX documents."
: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 @@ Related buffers can be cycled through via :R and :P commands."
;;; 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 @@ Related buffers can be cycled through via :R and :P commands."
: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 @@ to customize the actual face object `viper-search-face'
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 @@ to customize the actual face object `viper-replace-overlay-face'
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 @@ to customize the actual face object `viper-minibuffer-emacs-face'
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 @@ to customize the actual face object `viper-minibuffer-insert-face'
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 @@ Should be set in `~/.viper' file."
(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

2
lisp/emulation/viper-keym.el
View File

@ -530,7 +530,7 @@ Arguments: (major-mode viper-state keymap)"
;; 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)))

133
lisp/emulation/viper-util.el
View File

@ -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 @@ to write a custom function, similar to `viper-ex-nontrivial-find-file-unix'."
(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 @@ to write a custom function, similar to `viper-ex-nontrivial-find-file-unix'."
(defsubst viper-is-in-minibuffer ()
(string-match "\*Minibuf-" (buffer-name)))
(save-match-data
(string-match "\*Minibuf-" (buffer-name))))
@ -814,50 +851,6 @@ to write a custom function, similar to `viper-ex-nontrivial-find-file-unix'."
(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

365
lisp/emulation/viper.el
View File

@ -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 @@ widget."
: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 @@ This startup message appears whenever you load Viper, unless you type `y' now."
))
(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 @@ remains buffer-local."
;; 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 @@ remains buffer-local."
(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 @@ remains buffer-local."
) ; 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)
(if (eq default-major-mode 'fundamental-mode)
(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))
(add-hook 'change-major-mode-hook 'viper-major-mode-change-sentinel)
(add-hook 'find-file-hooks 'set-viper-state-in-major-mode)
(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)
(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)
(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 @@ remains buffer-local."
(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)
(add-hook 'comint-mode-hook 'viper-comint-mode-hook) ; comint
;; Tar
(viper-modify-major-mode 'tar-mode 'emacs-state viper-slash-and-colon-map)
(viper-set-emacs-state-searchstyle-macros nil 'tar-mode)
;; 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 @@ remains buffer-local."
(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 @@ remains buffer-local."
(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 @@ These two lines must come in the order given.
;; 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 @@ These two lines must come in the order given.
(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 @@ These two lines must come in the order given.
(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 @@ These two lines must come in the order given.
(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