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

2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>

Browse Source 
* viper-init.el (viper-cond-compile-for-xemacs-or-emacs):
	new macro that replaces viper-emacs-p and viper-xemacs-p in many
	cases. Used to reduce the number of warnings.

	* viper-cmd.el: use viper-cond-compile-for-xemacs-or-emacs.
	(viper-standard-value): moved here from viper.el.
	(viper-set-unread-command-events): moved to viper-util.el
	(viper-check-minibuffer-overlay): make sure
	viper-minibuffer-overlay is moved to cover the entire input field.

	* viper-util.el:  use viper-cond-compile-for-xemacs-or-emacs.
	(viper-read-key-sequence, viper-set-unread-command-events,
	viper-char-symbol-sequence-p, viper-char-array-p): moved here.

	* viper-ex.el: use viper-cond-compile-for-xemacs-or-emacs.

	* viper-keym.el: use viper-cond-compile-for-xemacs-or-emacs.

	* viper-mous.el: use viper-cond-compile-for-xemacs-or-emacs.

	* viper-macs.el (viper-char-array-p, viper-char-symbol-sequence-p,
	viper-event-vector-p): moved to viper-util.el

	* viper.el (viper-standard-value): moved to viper-cmd.el.
	Use viper-cond-compile-for-xemacs-or-emacs.

	* ediff-help.el: use ediff-cond-compile-for-xemacs-or-emacs.

	* ediff-hook.el: use ediff-cond-compile-for-xemacs-or-emacs.

	* ediff-init.el (ediff-cond-compile-for-xemacs-or-emacs): new
	macro designed to be used in many places where ediff-emacs-p or
	ediff-xemacs-p was previously used. Reduces the number of
	warnings.
	Use ediff-cond-compile-for-xemacs-or-emacs in many places in lieue
	of ediff-xemacs-p.
	(ediff-make-current-diff-overlay, ediff-highlight-diff-in-one-buffer,
	ediff-convert-fine-diffs-to-overlays, ediff-empty-diff-region-p,
	ediff-whitespace-diff-region-p, ediff-get-region-contents):
	moved to ediff-util.el.
	(ediff-event-key): moved here.

	* ediff-merge.el: got rid of unreferenced variables.

	* ediff-mult.el: use ediff-cond-compile-for-xemacs-or-emacs.

	* ediff-util.el: use ediff-cond-compile-for-xemacs-or-emacs.
	(ediff-cleanup-mess): improved the way windows are set up after
	quitting ediff.
	(ediff-janitor): use ediff-dispose-of-variant-according-to-user.
	(ediff-dispose-of-variant-according-to-user): new function
	designed to be smarter and also understands indirect buffers.
	(ediff-highlight-diff-in-one-buffer,
	ediff-unhighlight-diff-in-one-buffer,
	ediff-unhighlight-diffs-totally-in-one-buffer,
	ediff-highlight-diff, ediff-highlight-diff,
	ediff-unhighlight-diff, ediff-unhighlight-diffs-totally,
	ediff-empty-diff-region-p, ediff-whitespace-diff-region-p,
	ediff-get-region-contents, ediff-make-current-diff-overlay):
	moved here.
	(ediff-format-bindings-of): new function by Hannu Koivisto
	<azure@iki.fi>.
	(ediff-setup): make sure the merge buffer is always widened and
	modifiable.
	(ediff-write-merge-buffer-and-maybe-kill): refuse to write the
	result of a merge into a file visited by another buffer.
	(ediff-arrange-autosave-in-merge-jobs): check if the merge file
	is visited by another buffer and ask to save/delete that buffer.
	(ediff-verify-file-merge-buffer): new function to do the above.

	* ediff-vers.el: load ediff-init.el at compile time.

	* ediff-wind.el: use ediff-cond-compile-for-xemacs-or-emacs.

	* ediff.el (ediff-windows, ediff-regions-wordwise,
	ediff-regions-linewise): use indirect buffers to improve
	robustness and make it possible to compare regions of the same
	buffer (even overlapping regions).
	(ediff-clone-buffer-for-region-comparison,
	ediff-clone-buffer-for-window-comparison): new functions.
	(ediff-files-internal): refuse to compare identical files.
	(ediff-regions-internal): get rid of the warning about comparing
	regions of the same buffer.

	* ediff-diff.el (ediff-convert-fine-diffs-to-overlays): moved here.
	Plus the following fixes courtesy of Dave Love:
	Doc fixes.
	(ediff-word-1): Use word class and move - to the
	front per regexp documentation.
	(ediff-wordify): Bind forward-word-function outside loop.
	(ediff-copy-to-buffer): Use insert-buffer-substring rather than
	consing buffer contents.
	(ediff-goto-word): Move syntax table setting outside loop.
This commit is contained in:
Michael Kifer 2002-01-08 04:36:01 +00:00
parent fbb70ad9e6
commit 50a07e1856
22 changed files with 1556 additions and 1105 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

96
lisp/ChangeLog
View File

@ -1,3 +1,99 @@
2002-01-07 Michael Kifer <kifer@cs.stonybrook.edu>
* viper-init.el (viper-cond-compile-for-xemacs-or-emacs):
new macro that replaces viper-emacs-p and viper-xemacs-p in many
cases. Used to reduce the number of warnings.
* viper-cmd.el: use viper-cond-compile-for-xemacs-or-emacs.
(viper-standard-value): moved here from viper.el.
(viper-set-unread-command-events): moved to viper-util.el
(viper-check-minibuffer-overlay): make sure
viper-minibuffer-overlay is moved to cover the entire input field.
* viper-util.el: use viper-cond-compile-for-xemacs-or-emacs.
(viper-read-key-sequence, viper-set-unread-command-events,
viper-char-symbol-sequence-p, viper-char-array-p): moved here.
* viper-ex.el: use viper-cond-compile-for-xemacs-or-emacs.
* viper-keym.el: use viper-cond-compile-for-xemacs-or-emacs.
* viper-mous.el: use viper-cond-compile-for-xemacs-or-emacs.
* viper-macs.el (viper-char-array-p, viper-char-symbol-sequence-p,
viper-event-vector-p): moved to viper-util.el
* viper.el (viper-standard-value): moved to viper-cmd.el.
Use viper-cond-compile-for-xemacs-or-emacs.
* ediff-help.el: use ediff-cond-compile-for-xemacs-or-emacs.
* ediff-hook.el: use ediff-cond-compile-for-xemacs-or-emacs.
* ediff-init.el (ediff-cond-compile-for-xemacs-or-emacs): new
macro designed to be used in many places where ediff-emacs-p or
ediff-xemacs-p was previously used. Reduces the number of
warnings.
Use ediff-cond-compile-for-xemacs-or-emacs in many places in lieue
of ediff-xemacs-p.
(ediff-make-current-diff-overlay, ediff-highlight-diff-in-one-buffer,
ediff-convert-fine-diffs-to-overlays, ediff-empty-diff-region-p,
ediff-whitespace-diff-region-p, ediff-get-region-contents):
moved to ediff-util.el.
(ediff-event-key): moved here.
* ediff-merge.el: got rid of unreferenced variables.
* ediff-mult.el: use ediff-cond-compile-for-xemacs-or-emacs.
* ediff-util.el: use ediff-cond-compile-for-xemacs-or-emacs.
(ediff-cleanup-mess): improved the way windows are set up after
quitting ediff.
(ediff-janitor): use ediff-dispose-of-variant-according-to-user.
(ediff-dispose-of-variant-according-to-user): new function
designed to be smarter and also understands indirect buffers.
(ediff-highlight-diff-in-one-buffer,
ediff-unhighlight-diff-in-one-buffer,
ediff-unhighlight-diffs-totally-in-one-buffer,
ediff-highlight-diff, ediff-highlight-diff,
ediff-unhighlight-diff, ediff-unhighlight-diffs-totally,
ediff-empty-diff-region-p, ediff-whitespace-diff-region-p,
ediff-get-region-contents, ediff-make-current-diff-overlay):
moved here.
(ediff-format-bindings-of): new function by Hannu Koivisto
<azure@iki.fi>.
(ediff-setup): make sure the merge buffer is always widened and
modifiable.
(ediff-write-merge-buffer-and-maybe-kill): refuse to write the
result of a merge into a file visited by another buffer.
(ediff-arrange-autosave-in-merge-jobs): check if the merge file
is visited by another buffer and ask to save/delete that buffer.
(ediff-verify-file-merge-buffer): new function to do the above.
* ediff-vers.el: load ediff-init.el at compile time.
* ediff-wind.el: use ediff-cond-compile-for-xemacs-or-emacs.
* ediff.el (ediff-windows, ediff-regions-wordwise,
ediff-regions-linewise): use indirect buffers to improve
robustness and make it possible to compare regions of the same
buffer (even overlapping regions).
(ediff-clone-buffer-for-region-comparison,
ediff-clone-buffer-for-window-comparison): new functions.
(ediff-files-internal): refuse to compare identical files.
(ediff-regions-internal): get rid of the warning about comparing
regions of the same buffer.
* ediff-diff.el (ediff-convert-fine-diffs-to-overlays): moved here.
Plus the following fixes courtesy of Dave Love:
Doc fixes.
(ediff-word-1): Use word class and move - to the
front per regexp documentation.
(ediff-wordify): Bind forward-word-function outside loop.
(ediff-copy-to-buffer): Use insert-buffer-substring rather than
consing buffer contents.
(ediff-goto-word): Move syntax table setting outside loop.
2002-01-07 Richard M. Stallman <rms@gnu.org>
* dired.el (dired-copy-filename-as-kill): Call kill-append

127
lisp/ediff-diff.el
View File

@ -1,8 +1,8 @@
;;; ediff-diff.el --- diff-related utilities
;; Copyright (C) 1994, 1995, 1996, 1997 Free Software Foundation, Inc.
;; Copyright (C) 1994, 95, 96, 97, 98, 99, 2000, 01, 02 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.sunysb.edu>
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; This file is part of GNU Emacs.
@ -29,6 +29,7 @@
;; compiler pacifier
(defvar ediff-default-variant)
(defvar null-device)
(eval-when-compile
(let ((load-path (cons (expand-file-name ".") load-path)))
@ -83,13 +84,13 @@ Must produce output compatible with Unix's diff3 program."
;; make sure that mandatory options are added even if the user changes
;; ediff-diff-options or ediff-diff3-options in the customization widget
(defun ediff-reset-diff-options (symb val)
(let* ((diff-program
(if (eq symb 'ediff-diff-options)
(let* ((diff-program
(if (eq symb 'ediff-diff-options)
ediff-diff-program
ediff-diff3-program))
(mandatory-option (ediff-diff-mandatory-option diff-program))
(spacer (if (string-equal mandatory-option "") "" " ")))
(set symb
(set symb
(if (string-match mandatory-option val)
val
(concat mandatory-option spacer val)))
@ -102,11 +103,12 @@ Must produce output compatible with Unix's diff3 program."
shell-file-name) ; no standard name on MS-DOS
((memq system-type '(vax-vms axp-vms)) "*dcl*") ; VMS
(t "sh")) ; UNIX
"*The shell used to run diff and patch. If user's .profile or
.cshrc files are set up correctly, any shell will do. However, some people
set $prompt or other things incorrectly, which leads to undesirable output
messages. These may cause Ediff to fail. In such a case, set ediff-shell
to a shell that you are not using or, better, fix your shell's startup file."
"*The shell used to run diff and patch.
If user's .profile or .cshrc files are set up correctly, any shell
will do. However, some people set $prompt or other things
incorrectly, which leads to undesirable output messages. These may
cause Ediff to fail. In such a case, set `ediff-shell' to a shell that
you are not using or, better, fix your shell's startup file."
:type 'string
:group 'ediff-diff)
@ -119,13 +121,13 @@ It must return code 0, if its arguments are identical files."
(defcustom ediff-cmp-options nil
"*Options to pass to `ediff-cmp-program'.
If GNU diff is used as `ediff-cmp-program', then the most useful options
are `-I RE', to ignore changes whose lines all match the regexp RE."
are `-I REGEXP', to ignore changes whose lines match the REGEXP."
:type '(repeat string)
:group 'ediff-diff)
(defcustom ediff-diff-options ""
"*Options to pass to `ediff-diff-program'.
If diff\(1\) is used as `ediff-diff-program', then the most useful options are
If Unix diff is used as `ediff-diff-program', then the most useful options are
`-w', to ignore space, and `-i', to ignore case of letters.
At present, the option `-c' is not allowed."
:set 'ediff-reset-diff-options
@ -146,7 +148,7 @@ This output is not used by Ediff internally."
(defvar ediff-match-diff3-line "^====\\(.?\\)\C-m?$"
"Pattern to match lines produced by diff3 that describe differences.")
(defcustom ediff-diff3-options ""
(defcustom ediff-diff3-options ""
"*Options to pass to `ediff-diff3-program'."
:set 'ediff-reset-diff-options
:type 'string
@ -163,7 +165,7 @@ Lines that do not match are assumed to be error messages."
(ediff-defvar-local ediff-diff-status "" "")
;;; Fine differences
;;; Fine differences
(ediff-defvar-local ediff-auto-refine (if (ediff-has-face-support-p) 'on 'nix)
"If `on', Ediff auto-highlights fine diffs for the current diff region.
@ -183,7 +185,7 @@ Use `setq-default' if setting it in .emacs")
;;; General
(defvar ediff-diff-ok-lines-regexp
(defvar ediff-diff-ok-lines-regexp
(concat
"^\\("
"[0-9,]+[acd][0-9,]+\C-m?$"
@ -348,7 +350,7 @@ one optional arguments, diff-number to refine.")
(ediff-skip-unsuitable-frames)
(switch-to-buffer error-buf)
(ediff-kill-buffer-carefully ctl-buf)
(error "Errors in diff output. Diff output is in %S" diff-buff))))
(error "Errors in diff output. Diff output is in %S" diff-buff))))
;; BOUNDS specifies visibility bounds to use.
;; WORD-MODE tells whether we are in the word-mode or not.
@ -374,7 +376,7 @@ one optional arguments, diff-number to refine.")
(setq shift-A
(ediff-overlay-start
(ediff-get-value-according-to-buffer-type 'A bounds))
shift-B
shift-B
(ediff-overlay-start
(ediff-get-value-according-to-buffer-type 'B bounds))))
@ -430,7 +432,7 @@ one optional arguments, diff-number to refine.")
;; compute main diff vector
(if word-mode
;; make diff-list contain word numbers
(setq diff-list
(setq diff-list
(nconc diff-list
(list
(if (ediff-buffer-live-p C-buffer)
@ -474,7 +476,7 @@ one optional arguments, diff-number to refine.")
(forward-line (- c-end c-begin))
(setq c-end-pt (point)
c-prev c-end)))
(setq diff-list
(setq diff-list
(nconc
diff-list
(list
@ -495,7 +497,7 @@ one optional arguments, diff-number to refine.")
nil nil ; dummy ancestor
nil nil ; dummy state of diff & merge
nil ; dummy state of ancestor
)))
)))
)))
))) ; end ediff-with-current-buffer
@ -538,7 +540,7 @@ one optional arguments, diff-number to refine.")
(ediff-get-value-according-to-buffer-type
buf-type ediff-narrow-bounds)))
(limit (ediff-overlay-end
(ediff-get-value-according-to-buffer-type
(ediff-get-value-according-to-buffer-type
buf-type ediff-narrow-bounds)))
diff-overlay-list list-element total-diffs
begin end pt-saved overlay state-of-diff)
@ -615,7 +617,7 @@ one optional arguments, diff-number to refine.")
;; if `flag' is 'noforce then make fine-diffs only if this region's fine
;; diffs have not been computed before.
;; if `flag' is 'skip then don't compute fine diffs for this region.
(defun ediff-make-fine-diffs (&optional n flag)
(defun ediff-make-fine-diffs (&optional n flag)
(or n (setq n ediff-current-difference))
(if (< ediff-number-of-differences 1)
@ -651,13 +653,13 @@ one optional arguments, diff-number to refine.")
(if ediff-3way-comparison-job
(ediff-message-if-verbose
"Region %d is empty in all buffers but %S"
(1+ n)
(1+ n)
(cond ((not empty-A) 'A)
((not empty-B) 'B)
((not empty-C) 'C)))
(ediff-message-if-verbose
"Region %d in buffer %S is empty"
(1+ n)
(1+ n)
(cond (empty-A 'A)
(empty-B 'B)
(empty-C 'C)))
@ -772,7 +774,7 @@ one optional arguments, diff-number to refine.")
"in buffers A & C")
(whitespace-C (ediff-mark-diff-as-space-only n 'C)
"in buffers A & B"))))
(t
(t
(ediff-mark-diff-as-space-only n nil)))
)
) ; end cond
@ -812,7 +814,7 @@ one optional arguments, diff-number to refine.")
(defun ediff-set-fine-diff-properties-in-one-buffer (buf-type
n &optional default)
(let ((fine-diff-vector (ediff-get-fine-diff-vector n buf-type))
(face (if default
(face (if default
'default
(face-name
(ediff-get-symbol-from-alist
@ -896,11 +898,19 @@ delimiter regions"))
) ; while
;; convert the list of difference information into a vector
;; for fast access
(ediff-set-fine-diff-vector
(ediff-set-fine-diff-vector
region-num buf-type (vconcat diff-overlay-list))
)))
(defsubst ediff-convert-fine-diffs-to-overlays (diff-list region-num)
(ediff-set-fine-overlays-in-one-buffer 'A diff-list region-num)
(ediff-set-fine-overlays-in-one-buffer 'B diff-list region-num)
(if ediff-3way-job
(ediff-set-fine-overlays-in-one-buffer 'C diff-list region-num)
))
;; Stolen from emerge.el
(defun ediff-get-diff3-group (file)
;; This save-excursion allows ediff-get-diff3-group to be called for the
@ -958,10 +968,10 @@ delimiter regions"))
(setq shift-A
(ediff-overlay-start
(ediff-get-value-according-to-buffer-type 'A bounds))
shift-B
shift-B
(ediff-overlay-start
(ediff-get-value-according-to-buffer-type 'B bounds))
shift-C
shift-C
(if three-way-comp
(ediff-overlay-start
(ediff-get-value-according-to-buffer-type 'C bounds)))))
@ -1026,7 +1036,7 @@ delimiter regions"))
;; compute main diff vector
(if word-mode
;; make diff-list contain word numbers
(setq diff-list
(setq diff-list
(nconc diff-list
(list (vector
(- a-begin a-prev) (- a-end a-begin)
@ -1066,7 +1076,7 @@ delimiter regions"))
(forward-line (- c-or-anc-end c-or-anc-begin))
(setq anc-end-pt (point)
anc-prev c-or-anc-end)))
(setq diff-list
(setq diff-list
(nconc
diff-list
;; if comparing with ancestor, then there also is a
@ -1200,7 +1210,7 @@ delimiter regions"))
(delete-process process))))
;;; Word functions used to refine the current diff
;;; Word functions used to refine the current diff
(defvar ediff-forward-word-function 'ediff-forward-word
"*Function to call to move to the next word.
@ -1210,10 +1220,11 @@ Used for splitting difference regions into individual words.")
"*Characters constituting white space.
These characters are ignored when differing regions are split into words.")
(defvar ediff-word-1 "a-zA-Z---_"
(defvar ediff-word-1
(ediff-cond-compile-for-xemacs-or-emacs "a-zA-Z---_" "-[:word:]_")
"*Characters that constitute words of type 1.
More precisely, [ediff-word-1] is a regexp that matches type 1 words.
See `ediff-forward-word' for more details.")
See `ediff-forward-word' for more details.")
(defvar ediff-word-2 "0-9.,"
"*Characters that constitute words of type 2.
@ -1229,7 +1240,7 @@ See `ediff-forward-word' for more details.")
(concat "^" ediff-word-1 ediff-word-2 ediff-word-3 ediff-whitespace)
"*Characters that constitute words of type 4.
More precisely, [ediff-word-4] is a regexp that matches type 4 words.
See `ediff-forward-word' for more details.")
See `ediff-forward-word' for more details.")
;; Split region along word boundaries. Each word will be on its own line.
;; Output to buffer out-buffer.
@ -1249,7 +1260,14 @@ arguments to `skip-chars-forward'."
(defun ediff-wordify (beg end in-buffer out-buffer &optional control-buf)
(let (inbuf-syntax-tbl sv-point diff-string)
(let ((forward-word-function
;; eval in control buf to let user create local versions for
;; different invocations
(if control-buf
(ediff-with-current-buffer control-buf
ediff-forward-word-function)
ediff-forward-word-function))
inbuf-syntax-tbl sv-point diff-string)
(save-excursion
(set-buffer in-buffer)
(setq inbuf-syntax-tbl
@ -1271,29 +1289,18 @@ arguments to `skip-chars-forward'."
(delete-region (point-min) (point))
(while (not (eobp))
;; eval in control buf to let user create local versions for
;; different invocations
(if control-buf
(funcall
(ediff-with-current-buffer control-buf
ediff-forward-word-function))
(funcall ediff-forward-word-function))
(funcall forward-word-function)
(setq sv-point (point))
(skip-chars-forward ediff-whitespace)
(delete-region sv-point (point))
(insert "\n")))))
;; copy string from BEG END from IN-BUF to OUT-BUF
;; copy string specified as BEG END from IN-BUF to OUT-BUF
(defun ediff-copy-to-buffer (beg end in-buffer out-buffer)
(let (string)
(save-excursion
(set-buffer in-buffer)
(setq string (buffer-substring beg end))
(set-buffer out-buffer)
(erase-buffer)
(insert string)
(goto-char (point-min)))))
(with-current-buffer out-buffer
(erase-buffer)
(insert-buffer-substring in-buffer beg end)
(goto-char (point-min))))
;; goto word #n starting at current position in buffer `buf'
@ -1305,18 +1312,18 @@ arguments to `skip-chars-forward'."
(syntax-tbl ediff-syntax-table))
(ediff-with-current-buffer buf
(skip-chars-forward ediff-whitespace)
(while (> n 1)
(ediff-with-syntax-table syntax-tbl
(funcall fwd-word-fun))
(skip-chars-forward ediff-whitespace)
(setq n (1- n)))
(ediff-with-syntax-table syntax-tbl
(while (> n 1)
(funcall fwd-word-fun)
(skip-chars-forward ediff-whitespace)
(setq n (1- n))))
(if (and flag (> n 0))
(funcall fwd-word-fun))
(point))))
(defun ediff-same-file-contents (f1 f2)
"T if F1 and F2 have identical contents."
(let ((res
"Return t if F1 and F2 have identical contents."
(let ((res
(apply 'call-process ediff-cmp-program nil nil nil
(append ediff-cmp-options (list f1 f2)))))
(and (numberp res) (eq res 0))))

19
lisp/ediff-help.el
View File

@ -1,8 +1,8 @@
;;; ediff-help.el --- Code related to the contents of Ediff help buffers
;; Copyright (C) 1996, 1997 Free Software Foundation, Inc.
;; Copyright (C) 1996, 97, 98, 99, 2000, 01, 02 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.sunysb.edu>
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; This file is part of GNU Emacs.
@ -190,12 +190,15 @@ the value of this variable and the variables `ediff-help-message-*' in
(let ((pos (ediff-event-point last-command-event))
overl cmd)
(if ediff-xemacs-p
(setq overl (extent-at pos (current-buffer) 'ediff-help-info)
cmd (ediff-overlay-get overl 'ediff-help-info))
(setq cmd (car (mapcar (lambda (elt)
(overlay-get elt 'ediff-help-info))
(overlays-at pos)))))
(ediff-cond-compile-for-xemacs-or-emacs
;; xemacs
(setq overl (extent-at pos (current-buffer) 'ediff-help-info)
cmd (ediff-overlay-get overl 'ediff-help-info))
;; emacs
(setq cmd (car (mapcar (lambda (elt)
(overlay-get elt 'ediff-help-info))
(overlays-at pos))))
)
(if (not (stringp cmd))
(error "Hmm... I don't see an Ediff command around here..."))

193
lisp/ediff-hook.el
View File

@ -1,8 +1,8 @@
;;; ediff-hook.el --- setup for Ediff's menus and autoloads
;; Copyright (C) 1995, 1996, 1997 Free Software Foundation, Inc.
;; Copyright (C) 1995, 96, 97, 98, 99, 2000, 01, 02 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.sunysb.edu>
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; This file is part of GNU Emacs.
@ -46,104 +46,114 @@
;; allow menus to be set up without ediff-wind.el being loaded
;;;###autoload
(defvar ediff-window-setup-function)
;; This is used to avoid compilation warnings. When emacs/xemacs forms can
;; generate compile time warnings, we use this macro.
;; In this case, the macro will expand into the form that is appropriate to the
;; compiler at hand.
;; Suggested by rms.
(defmacro ediff-cond-compile-for-xemacs-or-emacs (xemacs-form emacs-form)
(if (string-match "XEmacs" emacs-version)
xemacs-form emacs-form))
;; Note we wrap this in a progn so that we pick up the whole def
;; for auto-autoload. That way we do not load ediff-hook.el when defining
;; the menus.
;;;###autoload
(progn
(defun ediff-xemacs-init-menus ()
(if (featurep 'menubar)
(progn
(add-submenu
'("Tools") ediff-menu "OO-Browser...")
(add-submenu
'("Tools") ediff-merge-menu "OO-Browser...")
(add-submenu
'("Tools") epatch-menu "OO-Browser...")
(add-submenu
'("Tools") ediff-misc-menu "OO-Browser...")
(add-menu-button
'("Tools") "-------" "OO-Browser...")
))))
(ediff-cond-compile-for-xemacs-or-emacs
;; xemacs form
(defun ediff-xemacs-init-menus ()
(if (featurep 'menubar)
(progn
(add-submenu
'("Tools") ediff-menu "OO-Browser...")
(add-submenu
'("Tools") ediff-merge-menu "OO-Browser...")
(add-submenu
'("Tools") epatch-menu "OO-Browser...")
(add-submenu
'("Tools") ediff-misc-menu "OO-Browser...")
(add-menu-button
'("Tools") "-------" "OO-Browser...")
)))
nil ; emacs form
))
;; explicit string-match is needed: ediff-xemacs-p is not defined at build time
;;;###autoload
(cond ((string-match "XEmacs" emacs-version)
(defvar ediff-menu
'("Compare"
["Two Files..." ediff-files t]
["Two Buffers..." ediff-buffers t]
["Three Files..." ediff-files3 t]
["Three Buffers..." ediff-buffers3 t]
"---"
["Two Directories..." ediff-directories t]
["Three Directories..." ediff-directories3 t]
"---"
["File with Revision..." ediff-revision t]
["Directory Revisions..." ediff-directory-revisions t]
"---"
["Windows Word-by-word..." ediff-windows-wordwise t]
["Windows Line-by-line..." ediff-windows-linewise t]
"---"
["Regions Word-by-word..." ediff-regions-wordwise t]
["Regions Line-by-line..." ediff-regions-linewise t]
))
(defvar ediff-merge-menu
'("Merge"
["Files..." ediff-merge-files t]
["Files with Ancestor..." ediff-merge-files-with-ancestor t]
["Buffers..." ediff-merge-buffers t]
["Buffers with Ancestor..."
ediff-merge-buffers-with-ancestor t]
"---"
["Directories..." ediff-merge-directories t]
["Directories with Ancestor..."
ediff-merge-directories-with-ancestor t]
"---"
["Revisions..." ediff-merge-revisions t]
["Revisions with Ancestor..."
ediff-merge-revisions-with-ancestor t]
["Directory Revisions..." ediff-merge-directory-revisions t]
["Directory Revisions with Ancestor..."
ediff-merge-directory-revisions-with-ancestor t]
))
(defvar epatch-menu
'("Apply Patch"
["To a file..." ediff-patch-file t]
["To a buffer..." ediff-patch-buffer t]
))
(defvar ediff-misc-menu
'("Ediff Miscellanea"
["Ediff Manual..." ediff-documentation t]
["Customize Ediff..." ediff-customize t]
["List Ediff Sessions..." ediff-show-registry t]
["Use separate frame for Ediff control buffer..."
ediff-toggle-multiframe
:style toggle
:selected (if (and (featurep 'ediff-util)
(boundp 'ediff-window-setup-function))
(eq ediff-window-setup-function
'ediff-setup-windows-multiframe))]
["Use a toolbar with Ediff control buffer"
ediff-toggle-use-toolbar
:style toggle
:selected (if (featurep 'ediff-tbar)
(ediff-use-toolbar-p))]
))
;; put these menus before Object-Oriented-Browser in Tools menu
;;; (add-hook 'before-init-hook 'ediff-xemacs-init-menus)
;;; (if (not purify-flag)
;;; (ediff-xemacs-init-menus))
;;; )
(if (and (featurep 'menubar) (not (featurep 'infodock))
(not (featurep 'ediff-hook)))
(ediff-cond-compile-for-xemacs-or-emacs
(progn
(defvar ediff-menu
'("Compare"
["Two Files..." ediff-files t]
["Two Buffers..." ediff-buffers t]
["Three Files..." ediff-files3 t]
["Three Buffers..." ediff-buffers3 t]
"---"
["Two Directories..." ediff-directories t]
["Three Directories..." ediff-directories3 t]
"---"
["File with Revision..." ediff-revision t]
["Directory Revisions..." ediff-directory-revisions t]
"---"
["Windows Word-by-word..." ediff-windows-wordwise t]
["Windows Line-by-line..." ediff-windows-linewise t]
"---"
["Regions Word-by-word..." ediff-regions-wordwise t]
["Regions Line-by-line..." ediff-regions-linewise t]
))
(defvar ediff-merge-menu
'("Merge"
["Files..." ediff-merge-files t]
["Files with Ancestor..." ediff-merge-files-with-ancestor t]
["Buffers..." ediff-merge-buffers t]
["Buffers with Ancestor..."
ediff-merge-buffers-with-ancestor t]
"---"
["Directories..." ediff-merge-directories t]
["Directories with Ancestor..."
ediff-merge-directories-with-ancestor t]
"---"
["Revisions..." ediff-merge-revisions t]
["Revisions with Ancestor..."
ediff-merge-revisions-with-ancestor t]
["Directory Revisions..." ediff-merge-directory-revisions t]
["Directory Revisions with Ancestor..."
ediff-merge-directory-revisions-with-ancestor t]
))
(defvar epatch-menu
'("Apply Patch"
["To a file..." ediff-patch-file t]
["To a buffer..." ediff-patch-buffer t]
))
(defvar ediff-misc-menu
'("Ediff Miscellanea"
["Ediff Manual..." ediff-documentation t]
["Customize Ediff..." ediff-customize t]
["List Ediff Sessions..." ediff-show-registry t]
["Use separate frame for Ediff control buffer..."
ediff-toggle-multiframe
:style toggle
:selected (if (and (featurep 'ediff-util)
(boundp 'ediff-window-setup-function))
(eq ediff-window-setup-function
'ediff-setup-windows-multiframe))]
["Use a toolbar with Ediff control buffer"
ediff-toggle-use-toolbar
:style toggle
:selected (if (featurep 'ediff-tbar)
(ediff-use-toolbar-p))]
))
;; put these menus before Object-Oriented-Browser in Tools menu
(if (and (featurep 'menubar) (not (featurep 'infodock))
(not (featurep 'ediff-hook)))
(ediff-xemacs-init-menus)))
;; Emacs--only if menu-bar is loaded
((featurep 'menu-bar)
;; Emacs--only if menu-bar is loaded
(if (featurep 'menu-bar)
(progn
;; initialize menu bar keymaps
(defvar menu-bar-ediff-misc-menu
(make-sparse-keymap "Ediff Miscellanea"))
@ -240,7 +250,8 @@
'("Ediff Manual..." . ediff-documentation))
)
) ; cond
) ; emacs case
) ; ediff-cond-compile-for-xemacs-or-emacs
;; arrange for autoloads
(if purify-flag

431
lisp/ediff-init.el
View File

@ -1,8 +1,8 @@
;;; ediff-init.el --- Macros, variables, and defsubsts used by Ediff
;; Copyright (C) 1994, 1995, 1996, 1997, 2000 Free Software Foundation, Inc.
;; Copyright (C) 1994, 95, 96, 97, 98, 99, 2000, 01, 02 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.sunysb.edu>
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; This file is part of GNU Emacs.
@ -35,6 +35,7 @@
(defvar ediff-whitespace)
(defvar ediff-multiframe)
(defvar ediff-use-toolbar-p)
(defvar mswindowsx-bitmap-file-path)
(and noninteractive
(eval-when-compile
@ -46,6 +47,15 @@
;; Is it Emacs?
(defconst ediff-emacs-p (not ediff-xemacs-p))
;; This is used to avoid compilation warnings. When emacs/xemacs forms can
;; generate compile time warnings, we use this macro.
;; In this case, the macro will expand into the form that is appropriate to the
;; compiler at hand.
;; Suggested by rms.
(defmacro ediff-cond-compile-for-xemacs-or-emacs (xemacs-form emacs-form)
(if (string-match "XEmacs" emacs-version)
xemacs-form emacs-form))
(defvar ediff-force-faces nil
"If t, Ediff will think that it is running on a display that supports faces.
This is provided as a temporary relief for users of face-capable displays
@ -53,9 +63,10 @@ that Ediff doesn't know about.")
;; Are we running as a window application or on a TTY?
(defsubst ediff-device-type ()
(if ediff-emacs-p
window-system
(device-type (selected-device))))
(ediff-cond-compile-for-xemacs-or-emacs
(device-type (selected-device)) ; xemacs form
window-system ; emacs form
))
;; in XEmacs: device-type is tty on tty and stream in batch.
(defun ediff-window-display-p ()
@ -69,10 +80,12 @@ that Ediff doesn't know about.")
(ediff-emacs-p (memq (ediff-device-type) '(pc)))
(ediff-xemacs-p (memq (ediff-device-type) '(tty pc)))))
;; toolbar support for emacs hasn't been implemented in ediff
(defun ediff-has-toolbar-support-p ()
(and ediff-xemacs-p
(featurep 'toolbar)
(console-on-window-system-p)))
(ediff-cond-compile-for-xemacs-or-emacs
(and (featurep 'toolbar) (console-on-window-system-p)) ; xemacs form
nil ; emacs form
))
(defun ediff-use-toolbar-p ()
(and (ediff-has-toolbar-support-p) ;Can it do it ?
@ -108,6 +121,10 @@ that Ediff doesn't know about.")
;; The Ediff control buffer
(ediff-defvar-local ediff-control-buffer nil "")
(ediff-defvar-local ediff-temp-indirect-buffer nil
"If t, the buffer is a temporary indirect buffer.
It needs to be killed when we quit the session.")
;; Association between buff-type and ediff-buffer-*
(defconst ediff-buffer-alist
@ -731,16 +748,18 @@ to temp files when Ediff needs to find fine differences."
:group 'ediff)
(if ediff-xemacs-p
(progn
(fset 'ediff-read-event (symbol-function 'next-command-event))
(fset 'ediff-overlayp (symbol-function 'extentp))
(fset 'ediff-make-overlay (symbol-function 'make-extent))
(fset 'ediff-delete-overlay (symbol-function 'delete-extent)))
(fset 'ediff-read-event (symbol-function 'read-event))
(fset 'ediff-overlayp (symbol-function 'overlayp))
(fset 'ediff-make-overlay (symbol-function 'make-overlay))
(fset 'ediff-delete-overlay (symbol-function 'delete-overlay)))
(ediff-cond-compile-for-xemacs-or-emacs
(progn ; xemacs
(fset 'ediff-read-event (symbol-function 'next-command-event))
(fset 'ediff-overlayp (symbol-function 'extentp))
(fset 'ediff-make-overlay (symbol-function 'make-extent))
(fset 'ediff-delete-overlay (symbol-function 'delete-extent)))
(progn ; emacs
(fset 'ediff-read-event (symbol-function 'read-event))
(fset 'ediff-overlayp (symbol-function 'overlayp))
(fset 'ediff-make-overlay (symbol-function 'make-overlay))
(fset 'ediff-delete-overlay (symbol-function 'delete-overlay)))
)
;; Check the current version against the major and minor version numbers
;; using op: cur-vers op major.minor If emacs-major-version or
@ -772,41 +791,43 @@ to temp files when Ediff needs to find fine differences."
(defun ediff-color-display-p ()
(condition-case nil
(if ediff-emacs-p
(if (fboundp 'display-color-p)
(display-color-p)
(x-display-color-p))
(eq (device-class (selected-device)) 'color))
(error
nil)))
(ediff-cond-compile-for-xemacs-or-emacs
(eq (device-class (selected-device)) 'color) ; xemacs form
(if (fboundp 'display-color-p) ; emacs form
(display-color-p)
(x-display-color-p))
)
(error nil)))
(if (ediff-has-face-support-p)
(if ediff-xemacs-p
(progn
(fset 'ediff-valid-color-p (symbol-function 'valid-color-name-p))
(fset 'ediff-get-face (symbol-function 'get-face)))
(fset 'ediff-valid-color-p (symbol-function
(if (fboundp 'color-defined-p)
'color-defined-p
'x-color-defined-p)))
(fset 'ediff-get-face (symbol-function 'internal-get-face))))
(ediff-cond-compile-for-xemacs-or-emacs
(progn ; xemacs
(defalias 'ediff-valid-color-p 'valid-color-name-p)
(defalias 'ediff-get-face 'get-face))
(progn ; emacs
(defalias 'ediff-valid-color-p (if (fboundp 'color-defined-p)
'color-defined-p
'x-color-defined-p))
(defalias 'ediff-get-face 'internal-get-face))
))
(if (ediff-window-display-p)
(if ediff-xemacs-p
(progn
(fset 'ediff-display-pixel-width
(symbol-function 'device-pixel-width))
(fset 'ediff-display-pixel-height
(symbol-function 'device-pixel-height)))
(fset 'ediff-display-pixel-width (symbol-function
(if (fboundp 'display-pixel-width)
'display-pixel-width
'x-display-pixel-width)))
(fset 'ediff-display-pixel-height (symbol-function
(if (fboundp 'display-pixel-height)
'display-pixel-height
'x-display-pixel-height)))))
(ediff-cond-compile-for-xemacs-or-emacs
(progn ; xemacs
(fset 'ediff-display-pixel-width (symbol-function 'device-pixel-width))
(fset 'ediff-display-pixel-height
(symbol-function 'device-pixel-height)))
(progn ; emacs
(fset 'ediff-display-pixel-width
(if (fboundp 'display-pixel-width)
(symbol-function 'display-pixel-width)
(symbol-function 'x-display-pixel-width)))
(fset 'ediff-display-pixel-height
(if (fboundp 'display-pixel-height)
(symbol-function 'display-pixel-height)
(symbol-function 'x-display-pixel-height))))
))
;; A-list of current-diff-overlay symbols associated with buf types
(defconst ediff-current-diff-overlay-alist
@ -823,21 +844,6 @@ to temp files when Ediff needs to find fine differences."
(Ancestor . ediff-current-diff-face-Ancestor)))
(defun ediff-make-current-diff-overlay (type)
(if (ediff-has-face-support-p)
(let ((overlay (ediff-get-symbol-from-alist
type ediff-current-diff-overlay-alist))
(buffer (ediff-get-buffer type))
(face (face-name
(symbol-value
(ediff-get-symbol-from-alist
type ediff-current-diff-face-alist)))))
(set overlay
(ediff-make-bullet-proof-overlay (point-max) (point-max) buffer))
(ediff-set-overlay-face (symbol-value overlay) face)
(ediff-overlay-put (symbol-value overlay) 'ediff ediff-control-buffer))
))
(defun ediff-set-overlay-face (extent face)
(ediff-overlay-put extent 'face face)
(ediff-overlay-put extent 'help-echo 'ediff-region-help-echo))
@ -1194,31 +1200,33 @@ this variable represents.")
(defun ediff-highest-priority (start end buffer)
(let ((pos (max 1 (1- start)))
ovr-list)
(if ediff-xemacs-p
(1+ ediff-shadow-overlay-priority)
(ediff-with-current-buffer buffer
(while (< pos (min (point-max) (1+ end)))
(setq ovr-list (append (overlays-at pos) ovr-list))
(setq pos (next-overlay-change pos)))
(+ 1 ediff-shadow-overlay-priority
(apply 'max
(cons
1
(mapcar
(lambda (ovr)
(if (and ovr
;; exclude ediff overlays from priority
;; calculation, or else priority will keep
;; increasing
(null (ediff-overlay-get ovr 'ediff))
(null (ediff-overlay-get ovr 'ediff-diff-num)))
;; use the overlay priority or 0
(or (ediff-overlay-get ovr 'priority) 0)
0))
ovr-list)
)
))
))))
(ediff-cond-compile-for-xemacs-or-emacs
(1+ ediff-shadow-overlay-priority) ; xemacs form
;; emacs form
(ediff-with-current-buffer buffer
(while (< pos (min (point-max) (1+ end)))
(setq ovr-list (append (overlays-at pos) ovr-list))
(setq pos (next-overlay-change pos)))
(+ 1 ediff-shadow-overlay-priority
(apply 'max
(cons
1
(mapcar
(lambda (ovr)
(if (and ovr
;; exclude ediff overlays from priority
;; calculation, or else priority will keep
;; increasing
(null (ediff-overlay-get ovr 'ediff))
(null (ediff-overlay-get ovr 'ediff-diff-num)))
;; use the overlay priority or 0
(or (ediff-overlay-get ovr 'priority) 0)
0))
ovr-list)
)
)))
) ; ediff-cond-compile-for-xemacs-or-emacs
))
(defvar ediff-toggle-read-only-function nil
@ -1306,8 +1314,6 @@ This default should work without changes."
(ediff-defvar-local ediff-temp-file-C nil "")
;;; In-line functions
;; If file-remote-p is defined (as in XEmacs, use it. Otherwise, check
;; if find-file-name-handler is defined for 'file-local-copy
(defun ediff-file-remote-p (file-name)
@ -1375,93 +1381,6 @@ This default should work without changes."
(ediff-paint-background-regions-in-one-buffer
'Ancestor unhighlight))
(defun ediff-highlight-diff-in-one-buffer (n buf-type)
(if (ediff-buffer-live-p (ediff-get-buffer buf-type))
(let* ((buff (ediff-get-buffer buf-type))
(last (ediff-with-current-buffer buff (point-max)))
(begin (ediff-get-diff-posn buf-type 'beg n))
(end (ediff-get-diff-posn buf-type 'end n))
(xtra (if (equal begin end) 1 0))
(end-hilit (min last (+ end xtra)))
(current-diff-overlay
(symbol-value
(ediff-get-symbol-from-alist
buf-type ediff-current-diff-overlay-alist))))
(if ediff-xemacs-p
(ediff-move-overlay current-diff-overlay begin end-hilit)
(ediff-move-overlay current-diff-overlay begin end-hilit buff))
(ediff-overlay-put current-diff-overlay 'priority
(ediff-highest-priority begin end-hilit buff))
(ediff-overlay-put current-diff-overlay 'ediff-diff-num n)
;; unhighlight the background overlay for diff n so it won't
;; interfere with the current diff overlay
(ediff-set-overlay-face (ediff-get-diff-overlay n buf-type) nil)
)))
(defun ediff-unhighlight-diff-in-one-buffer (buf-type)
(if (ediff-buffer-live-p (ediff-get-buffer buf-type))
(let ((current-diff-overlay
(symbol-value
(ediff-get-symbol-from-alist
buf-type ediff-current-diff-overlay-alist)))
(overlay
(ediff-get-diff-overlay ediff-current-difference buf-type))
)
(ediff-move-overlay current-diff-overlay 1 1)
;; rehighlight the overlay in the background of the
;; current difference region
(ediff-set-overlay-face
overlay
(if (and (ediff-has-face-support-p)
ediff-use-faces ediff-highlight-all-diffs)
(ediff-background-face buf-type ediff-current-difference)))
)))
(defun ediff-unhighlight-diffs-totally-in-one-buffer (buf-type)
(ediff-unselect-and-select-difference -1)
(if (and (ediff-has-face-support-p) ediff-use-faces)
(let* ((inhibit-quit t)
(current-diff-overlay-var
(ediff-get-symbol-from-alist
buf-type ediff-current-diff-overlay-alist))
(current-diff-overlay (symbol-value current-diff-overlay-var)))
(ediff-paint-background-regions 'unhighlight)
(if (ediff-overlayp current-diff-overlay)
(ediff-delete-overlay current-diff-overlay))
(set current-diff-overlay-var nil)
)))
(defsubst ediff-highlight-diff (n)
"Put face on diff N. Invoked for X displays only."
(ediff-highlight-diff-in-one-buffer n 'A)
(ediff-highlight-diff-in-one-buffer n 'B)
(ediff-highlight-diff-in-one-buffer n 'C)
(ediff-highlight-diff-in-one-buffer n 'Ancestor)
)
(defsubst ediff-unhighlight-diff ()
"Remove overlays from buffers A, B, and C."
(ediff-unhighlight-diff-in-one-buffer 'A)
(ediff-unhighlight-diff-in-one-buffer 'B)
(ediff-unhighlight-diff-in-one-buffer 'C)
(ediff-unhighlight-diff-in-one-buffer 'Ancestor)
)
;; delete highlighting overlays, restore faces to their original form
(defsubst ediff-unhighlight-diffs-totally ()
(ediff-unhighlight-diffs-totally-in-one-buffer 'A)
(ediff-unhighlight-diffs-totally-in-one-buffer 'B)
(ediff-unhighlight-diffs-totally-in-one-buffer 'C)
(ediff-unhighlight-diffs-totally-in-one-buffer 'Ancestor)
)
;; arg is a record for a given diff in a difference vector
;; this record is itself a vector
@ -1481,49 +1400,55 @@ This default should work without changes."
(ediff-clear-fine-differences-in-one-buffer n 'C)))
(defsubst ediff-convert-fine-diffs-to-overlays (diff-list region-num)
(ediff-set-fine-overlays-in-one-buffer 'A diff-list region-num)
(ediff-set-fine-overlays-in-one-buffer 'B diff-list region-num)
(if ediff-3way-job
(ediff-set-fine-overlays-in-one-buffer 'C diff-list region-num)
))
(defsubst ediff-mouse-event-p (event)
(if ediff-xemacs-p
(button-event-p event)
(string-match "mouse" (format "%S" (event-basic-type event)))
))
(ediff-cond-compile-for-xemacs-or-emacs
(button-event-p event) ; xemacs form
(string-match "mouse" (format "%S" (event-basic-type event))) ; emacs form
))
(defsubst ediff-key-press-event-p (event)
(if ediff-xemacs-p
(key-press-event-p event)
(or (char-or-string-p event) (symbolp event))))
(ediff-cond-compile-for-xemacs-or-emacs
(key-press-event-p event) ; xemacs form
(or (char-or-string-p event) (symbolp event)) ; emacs form
))
(defun ediff-event-point (event)
(cond ((ediff-mouse-event-p event)
(if ediff-xemacs-p
(event-point event)
(posn-point (event-start event))))
(ediff-cond-compile-for-xemacs-or-emacs
(event-point event) ; xemacs form
(posn-point (event-start event)) ; emacs form
)
)
((ediff-key-press-event-p event)
(point))
(t (error))))
(t (error nil))))
(defun ediff-event-buffer (event)
(cond ((ediff-mouse-event-p event)
(if ediff-xemacs-p
(event-buffer event)
(window-buffer (posn-window (event-start event)))))
(ediff-cond-compile-for-xemacs-or-emacs
(event-buffer event) ; xemacs form
(window-buffer (posn-window (event-start event))) ; emacs form
)
)
((ediff-key-press-event-p event)
(current-buffer))
(t (error))))
(t (error nil))))
(defun ediff-event-key (event-or-key)
(ediff-cond-compile-for-xemacs-or-emacs
(if (eventp event-or-key) (event-key event-or-key) event-or-key) ; xemacs
event-or-key ; emacs form
))
(defsubst ediff-frame-iconified-p (frame)
(if (and (ediff-window-display-p) (frame-live-p frame))
(if ediff-xemacs-p
(frame-iconified-p frame)
(eq (frame-visible-p frame) 'icon))))
(ediff-cond-compile-for-xemacs-or-emacs
(frame-iconified-p frame) ; xemacs form
(eq (frame-visible-p frame) 'icon) ; emacs form
)
))
(defsubst ediff-window-visible-p (wind)
;; under TTY, window-live-p also means window is visible
@ -1533,9 +1458,10 @@ This default should work without changes."
(defsubst ediff-frame-char-width (frame)
(if ediff-xemacs-p
(/ (frame-pixel-width frame) (frame-width frame))
(frame-char-width frame)))
(ediff-cond-compile-for-xemacs-or-emacs
(/ (frame-pixel-width frame) (frame-width frame)) ; xemacs
(frame-char-width frame) ; emacs
))
(defun ediff-reset-mouse (&optional frame do-not-grab-mouse)
(or frame (setq frame (selected-frame)))
@ -1580,23 +1506,29 @@ This default should work without changes."
(t nil))))
(defsubst ediff-frame-char-height (frame)
(if ediff-xemacs-p
(glyph-height ediff-H-glyph (selected-window frame))
(frame-char-height frame)))
(ediff-cond-compile-for-xemacs-or-emacs
(glyph-height ediff-H-glyph (selected-window frame)) ; xemacs cse
(frame-char-height frame) ; emacs case
)
)
;; Some overlay functions
(defsubst ediff-overlay-start (overl)
(if (ediff-overlayp overl)
(if ediff-emacs-p
(overlay-start overl)
(extent-start-position overl))))
(ediff-cond-compile-for-xemacs-or-emacs
(extent-start-position overl) ; xemacs form
(overlay-start overl) ; emacs form
)
))
(defsubst ediff-overlay-end (overl)
(if (ediff-overlayp overl)
(if ediff-emacs-p
(overlay-end overl)
(extent-end-position overl))))
(ediff-cond-compile-for-xemacs-or-emacs
(extent-end-position overl) ; xemacs form
(overlay-end overl) ; emacs form
)
))
(defsubst ediff-empty-overlay-p (overl)
(= (ediff-overlay-start overl) (ediff-overlay-end overl)))
@ -1604,16 +1536,18 @@ This default should work without changes."
;; like overlay-buffer in Emacs. In XEmacs, returns nil if the extent is
;; dead. Otherwise, works like extent-buffer
(defun ediff-overlay-buffer (overl)
(if ediff-emacs-p
(overlay-buffer overl)
(and (extent-live-p overl) (extent-object overl))))
(ediff-cond-compile-for-xemacs-or-emacs
(and (extent-live-p overl) (extent-object overl)) ; xemacs form
(overlay-buffer overl) ; emacs form
))
;; like overlay-get in Emacs. In XEmacs, returns nil if the extent is
;; dead. Otherwise, like extent-property
(defun ediff-overlay-get (overl property)
(if ediff-emacs-p
(overlay-get overl property)
(and (extent-live-p overl) (extent-property overl property))))
(ediff-cond-compile-for-xemacs-or-emacs
(and (extent-live-p overl) (extent-property overl property)) ; xemacs form
(overlay-get overl property) ; emacs form
))
;; These two functions are here because XEmacs refuses to
@ -1623,9 +1557,10 @@ This default should work without changes."
Checks if overlay's buffer exists before actually doing the move."
(let ((buf (and overlay (ediff-overlay-buffer overlay))))
(if (ediff-buffer-live-p buf)
(if ediff-xemacs-p
(set-extent-endpoints overlay beg end)
(move-overlay overlay beg end buffer))
(ediff-cond-compile-for-xemacs-or-emacs
(set-extent-endpoints overlay beg end) ; xemacs form
(move-overlay overlay beg end buffer) ; emacs form
)
;; buffer's dead
(if overlay
(ediff-delete-overlay overlay)))))
@ -1634,46 +1569,25 @@ Checks if overlay's buffer exists before actually doing the move."
"Calls `overlay-put' or `set-extent-property' depending on Emacs version.
Checks if overlay's buffer exists."
(if (ediff-buffer-live-p (ediff-overlay-buffer overlay))
(if ediff-xemacs-p
(set-extent-property overlay prop value)
(overlay-put overlay prop value))
(ediff-cond-compile-for-xemacs-or-emacs
(set-extent-property overlay prop value) ; xemacs form
(overlay-put overlay prop value) ; emacs form
)
(ediff-delete-overlay overlay)))
;; Some diff region tests
;; t if diff region is empty.
;; In case of buffer C, t also if it is not a 3way
;; comparison job (merging jobs return t as well).
(defun ediff-empty-diff-region-p (n buf-type)
(if (eq buf-type 'C)
(or (not ediff-3way-comparison-job)
(= (ediff-get-diff-posn 'C 'beg n)
(ediff-get-diff-posn 'C 'end n)))
(= (ediff-get-diff-posn buf-type 'beg n)
(ediff-get-diff-posn buf-type 'end n))))
;; Test if diff region is white space only.
;; If 2-way job and buf-type = C, then returns t.
(defun ediff-whitespace-diff-region-p (n buf-type)
(or (and (eq buf-type 'C) (not ediff-3way-job))
(ediff-empty-diff-region-p n buf-type)
(let ((beg (ediff-get-diff-posn buf-type 'beg n))
(end (ediff-get-diff-posn buf-type 'end n)))
(ediff-with-current-buffer (ediff-get-buffer buf-type)
(save-excursion
(goto-char beg)
(skip-chars-forward ediff-whitespace)
(>= (point) end))))))
;; temporarily uses DIR to abbreviate file name
;; if DIR is nil, use default-directory
(defun ediff-abbreviate-file-name (file &optional dir)
(cond ((stringp dir)
(let ((directory-abbrev-alist (list (cons dir ""))))
(abbreviate-file-name file)))
(ediff-emacs-p (abbreviate-file-name file))
(t ; XEmacs requires addl argument
(abbreviate-file-name file t))))
(t
(ediff-cond-compile-for-xemacs-or-emacs
;; XEmacs requires addl argument
(abbreviate-file-name file t) ; xemacs form
(abbreviate-file-name file)) ; emacs form
)
))
;; Takes a directory and returns the parent directory.
;; does nothing to `/'. If the ARG is a regular file,
@ -1740,13 +1654,6 @@ Unless optional argument INPLACE is non-nil, return a new string."
))
(defsubst ediff-get-region-contents (n buf-type ctrl-buf &optional start end)
(ediff-with-current-buffer
(ediff-with-current-buffer ctrl-buf (ediff-get-buffer buf-type))
(buffer-substring
(or start (ediff-get-diff-posn buf-type 'beg n ctrl-buf))
(or end (ediff-get-diff-posn buf-type 'end n ctrl-buf)))))
;; If ediff modified mode line, strip the modification
(defsubst ediff-strip-mode-line-format ()
(if (member (car mode-line-format) '(" A: " " B: " " C: " " Ancestor: "))

17
lisp/ediff-merg.el
View File

@ -1,8 +1,8 @@
;;; ediff-merg.el --- merging utilities
;; Copyright (C) 1994, 1995, 1996, 1997 Free Software Foundation, Inc.
;; Copyright (C) 1994, 95, 96, 97, 98, 99, 2000, 01, 02 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.sunysb.edu>
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; This file is part of GNU Emacs.
@ -122,7 +122,7 @@ Buffer B."
(combo-region "")
(err-msg
"ediff-combination-pattern: Invalid format. Please consult the documentation")
diff-region region-delim region-spec)
region-delim region-spec)
(if (< (length pattern-list) 5)
(error err-msg))
@ -133,7 +133,7 @@ Buffer B."
(or (and (stringp region-delim) (memq region-spec '(A B Ancestor)))
(error err-msg))
(condition-case err
(condition-case nil
(setq combo-region
(concat combo-region
region-delim "\n"
@ -221,9 +221,10 @@ Buffer B."
(setq state-of-merge (ediff-get-state-of-merge n))
(if remerging
(let ((reg-A (ediff-get-region-contents n 'A ediff-control-buffer))
(reg-B (ediff-get-region-contents n 'B ediff-control-buffer))
(reg-C (ediff-get-region-contents n 'C ediff-control-buffer)))
;;(let ((reg-A (ediff-get-region-contents n 'A ediff-control-buffer))
;; (reg-B (ediff-get-region-contents n 'B ediff-control-buffer))
;; (reg-C (ediff-get-region-contents n 'C ediff-control-buffer)))
(let ()
;; if region was edited since it was first set by default
(if (or (ediff-merge-changed-from-default-p n)
@ -307,7 +308,7 @@ Combining is done according to the specifications in variable
(interactive "P")
(setq n (if (numberp n) (1- n) ediff-current-difference))
(let (regA regB reg-combined)
(let (reg-combined)
;;(setq regA (ediff-get-region-contents n 'A ediff-control-buffer)
;; regB (ediff-get-region-contents n 'B ediff-control-buffer))
;;(setq reg-combined (ediff-make-combined-diff regA regB))

188
lisp/ediff-mult.el
View File

@ -1,8 +1,8 @@
;;; ediff-mult.el --- support for multi-file/multi-buffer processing in Ediff
;; Copyright (C) 1995, 1996, 1997, 2001 Free Software Foundation, Inc.
;; Copyright (C) 1995, 96, 97, 98, 99, 2000, 01, 02 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.sunysb.edu>
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; This file is part of GNU Emacs.
@ -815,9 +815,10 @@ behavior."
(erase-buffer)
;; delete phony overlays that used to represent sessions before the buff
;; was redrawn
(if ediff-emacs-p
(mapcar 'delete-overlay (overlays-in 1 1))
(map-extents 'delete-extent))
(ediff-cond-compile-for-xemacs-or-emacs
(map-extents 'delete-extent) ; xemacs
(mapcar 'delete-overlay (overlays-in 1 1)) ; emacs
)
(insert (format ediff-meta-buffer-message
(ediff-abbrev-jobname ediff-metajob-name)))
@ -918,30 +919,32 @@ behavior."
(defun ediff-update-session-marker-in-dir-meta-buffer (session-num)
(let (buffer-meta-overlays session-info overl buffer-read-only)
(setq overl
(if ediff-xemacs-p
(map-extents
(lambda (ext maparg)
(if (and
(ediff-overlay-get ext 'ediff-meta-info)
(eq (ediff-overlay-get ext 'ediff-meta-session-number)
session-num))
ext)))
(ediff-cond-compile-for-xemacs-or-emacs
(map-extents ; xemacs
(lambda (ext maparg)
(if (and
(ediff-overlay-get ext 'ediff-meta-info)
(eq (ediff-overlay-get ext 'ediff-meta-session-number)
session-num))
ext)))
;; Emacs doesn't have map-extents, so try harder
;; Splice overlay lists to get all buffer overlays
(setq buffer-meta-overlays (overlay-lists)
buffer-meta-overlays (append (car buffer-meta-overlays)
(cdr buffer-meta-overlays)))
(car
(delq nil
(mapcar
(lambda (overl)
(if (and
(ediff-overlay-get overl 'ediff-meta-info)
(eq (ediff-overlay-get
overl 'ediff-meta-session-number)
session-num))
overl))
buffer-meta-overlays)))))
(progn
(setq buffer-meta-overlays (overlay-lists)
buffer-meta-overlays (append (car buffer-meta-overlays)
(cdr buffer-meta-overlays)))
(car
(delq nil
(mapcar
(lambda (overl)
(if (and
(ediff-overlay-get overl 'ediff-meta-info)
(eq (ediff-overlay-get
overl 'ediff-meta-session-number)
session-num))
overl))
buffer-meta-overlays))))
))
(or overl
(error
"Bug in ediff-update-session-marker-in-dir-meta-buffer: no overlay with given number %S"
@ -1179,9 +1182,10 @@ Useful commands:
(erase-buffer)
;; delete phony overlays that used to represent sessions before the buff
;; was redrawn
(if ediff-emacs-p
(mapcar 'delete-overlay (overlays-in 1 1))
(map-extents 'delete-extent))
(ediff-cond-compile-for-xemacs-or-emacs
(map-extents 'delete-extent) ; xemacs
(mapcar 'delete-overlay (overlays-in 1 1)) ; emacs
)
(insert "This is a registry of all active Ediff sessions.
@ -1507,7 +1511,7 @@ all marked sessions must be active."
;; This function executes in meta buffer. It knows where event happened.
(defun ediff-filegroup-action ()
"Execute appropriate action for the selected session."
"Execute appropriate action for a selected session."
(interactive)
(let* ((pos (ediff-event-point last-command-event))
(meta-buf (ediff-event-buffer last-command-event))
@ -1795,6 +1799,8 @@ all marked sessions must be active."
(setq frame (window-frame wind))
(raise-frame frame)
(ediff-reset-mouse frame)))
(sit-for 0) ; sometimes needed to synch the display and ensure that the
; point ends up after the just completed session
(run-hooks 'ediff-show-session-group-hook)
))
@ -1975,19 +1981,22 @@ If this is a session registry buffer then just bury it."
(let (result olist tmp)
(if (and point (ediff-buffer-live-p buf))
(ediff-with-current-buffer buf
(if ediff-xemacs-p
(setq result
(if (setq tmp (extent-at point buf 'ediff-meta-info))
(ediff-overlay-get tmp 'ediff-meta-info)))
(setq olist (overlays-at point))
(setq olist
(mapcar (lambda (elt)
(unless (overlay-get elt 'invisible)
(overlay-get elt 'ediff-meta-info)))
olist))
(while (and olist (null (car olist)))
(setq olist (cdr olist)))
(setq result (car olist)))))
(ediff-cond-compile-for-xemacs-or-emacs
(setq result ; xemacs
(if (setq tmp (extent-at point buf 'ediff-meta-info))
(ediff-overlay-get tmp 'ediff-meta-info)))
(progn ; emacs
(setq olist (overlays-at point))
(setq olist
(mapcar (lambda (elt)
(unless (overlay-get elt 'invisible)
(overlay-get elt 'ediff-meta-info)))
olist))
(while (and olist (null (car olist)))
(setq olist (cdr olist)))
(setq result (car olist)))
)
))
(if result
result
(if noerror
@ -1997,14 +2006,17 @@ If this is a session registry buffer then just bury it."
(defun ediff-get-meta-overlay-at-pos (point)
(if ediff-xemacs-p
(extent-at point (current-buffer) 'ediff-meta-info)
(let* ((overl-list (overlays-at point))
(overl (car overl-list)))
(while (and overl (null (overlay-get overl 'ediff-meta-info)))
(setq overl-list (cdr overl-list)
overl (car overl-list)))
overl)))
(ediff-cond-compile-for-xemacs-or-emacs
(extent-at point (current-buffer) 'ediff-meta-info) ; xemacs
;; emacs
(let* ((overl-list (overlays-at point))
(overl (car overl-list)))
(while (and overl (null (overlay-get overl 'ediff-meta-info)))
(setq overl-list (cdr overl-list)
overl (car overl-list)))
overl)
)
)
(defsubst ediff-get-session-number-at-pos (point &optional meta-buffer)
(setq meta-buffer (if (ediff-buffer-live-p meta-buffer)
@ -2020,18 +2032,21 @@ If this is a session registry buffer then just bury it."
(if (eobp)
(goto-char (point-min))
(let ((overl (ediff-get-meta-overlay-at-pos point)))
(if ediff-xemacs-p
(progn
(if overl
(setq overl (next-extent overl))
(setq overl (next-extent (current-buffer))))
(if overl
(extent-start-position overl)
(point-max)))
(if overl
;; note: end of current overlay is the beginning of the next one
(overlay-end overl)
(next-overlay-change point))))
(ediff-cond-compile-for-xemacs-or-emacs
(progn ; xemacs
(if overl
(setq overl (next-extent overl))
(setq overl (next-extent (current-buffer))))
(if overl
(extent-start-position overl)
(point-max)))
;; emacs
(if overl
;; note: end of current overlay is the beginning of the next one
(overlay-end overl)
(next-overlay-change point))
)
)
))
@ -2039,27 +2054,30 @@ If this is a session registry buffer then just bury it."
(if (bobp)
(goto-char (point-max))
(let ((overl (ediff-get-meta-overlay-at-pos point)))
(if ediff-xemacs-p
(progn
(if overl
(setq overl (previous-extent overl))
(setq overl (previous-extent (current-buffer))))
(if overl
(extent-start-position overl)
(point-min)))
(if overl (setq point (overlay-start overl)))
;; to get to the beginning of prev overlay
(if (not (bobp))
;; trick to overcome an emacs bug--doesn't always find previous
;; overlay change correctly
(setq point (1- point)))
(setq point (previous-overlay-change point))
;; If we are not over an overlay after subtracting 1, it means we are
;; in the description area preceding session records. In this case,
;; goto the top of the registry buffer.
(or (car (overlays-at point))
(setq point (point-min)))
point))))
(ediff-cond-compile-for-xemacs-or-emacs
(progn
(if overl
(setq overl (previous-extent overl))
(setq overl (previous-extent (current-buffer))))
(if overl
(extent-start-position overl)
(point-min)))
(progn
(if overl (setq point (overlay-start overl)))
;; to get to the beginning of prev overlay
(if (not (bobp))
;; trick to overcome an emacs bug--doesn't always find previous
;; overlay change correctly
(setq point (1- point)))
(setq point (previous-overlay-change point))
;; If we are not over an overlay after subtracting 1, it means we are
;; in the description area preceding session records. In this case,
;; goto the top of the registry buffer.
(or (car (overlays-at point))
(setq point (point-min)))
point)
)
)))
;; this is the action invoked when the user selects a patch from the meta
;; buffer.

4
lisp/ediff-ptch.el
View File

@ -1,8 +1,8 @@
;;; ediff-ptch.el --- Ediff's patch support
;; Copyright (C) 1996, 1997 Free Software Foundation, Inc.
;; Copyright (C) 1996, 97, 98, 99, 2000, 01, 02 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.sunysb.edu>
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; This file is part of GNU Emacs.

434
lisp/ediff-util.el
View File

@ -1,8 +1,8 @@
;;; ediff-util.el --- the core commands and utilities of ediff
;; Copyright (C) 1994, 95, 96, 97, 98, 99, 2000, 01 Free Software Foundation, Inc.
;; Copyright (C) 1994, 95, 96, 97, 98, 99, 2000, 01, 02 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.sunysb.edu>
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; This file is part of GNU Emacs.
@ -296,6 +296,11 @@ to invocation.")
(make-local-variable 'ediff-window-setup-function)
(make-local-variable 'ediff-keep-variants)
(ediff-cond-compile-for-xemacs-or-emacs
(make-local-hook 'ediff-after-quit-hook-internal) ; xemacs form
nil ; emacs form
)
;; unwrap set up parameters passed as argument
(while setup-parameters
(set (car (car setup-parameters)) (cdr (car setup-parameters)))
@ -317,8 +322,10 @@ to invocation.")
(if (string-match "buffer" (symbol-name ediff-job-name))
(setq ediff-keep-variants t))
(if ediff-xemacs-p
(make-local-hook 'pre-command-hook))
(ediff-cond-compile-for-xemacs-or-emacs
(make-local-hook 'pre-command-hook) ; xemacs form
nil ; emacs form
)
(if (ediff-window-display-p)
(add-hook 'pre-command-hook 'ediff-spy-after-mouse nil 'local))
@ -351,6 +358,7 @@ to invocation.")
(set-buffer buffer-C)
(insert-buffer buf)
(funcall (ediff-with-current-buffer buf major-mode))
(widen) ; merge buffer is always widened
(add-hook 'local-write-file-hooks 'ediff-set-merge-mode nil t)
)))
(setq buffer-read-only nil
@ -451,6 +459,10 @@ to invocation.")
(if ediff-3way-job
(ediff-with-current-buffer ediff-buffer-C
(ediff-nuke-selective-display)
;; the merge bufer should never be narrowed
;; (it can happen if it is on rmail-mode or similar)
(if (ediff-with-current-buffer control-buffer ediff-merge-job)
(widen))
(run-hooks 'ediff-prepare-buffer-hook)
;; add control-buffer to the list of sessions
(or (memq control-buffer ediff-this-buffer-ediff-sessions)
@ -458,7 +470,8 @@ to invocation.")
(cons control-buffer
ediff-this-buffer-ediff-sessions)))
(if ediff-make-buffers-readonly-at-startup
(setq buffer-read-only t))
(setq buffer-read-only t)
(setq buffer-read-only nil))
))
(if (ediff-buffer-live-p ediff-ancestor-buffer)
@ -472,7 +485,7 @@ to invocation.")
ediff-this-buffer-ediff-sessions)))
))
;; must come after setting up ediff-narrow-bounds AND after
;; the following must be after setting up ediff-narrow-bounds AND after
;; nuking selective display
(funcall ediff-setup-diff-regions-function file-A file-B file-C)
(setq ediff-number-of-differences (length ediff-difference-vector-A))
@ -575,6 +588,7 @@ to invocation.")
(if (stringp ediff-merge-store-file)
(progn
;; save before leaving ctl buffer
(ediff-verify-file-merge-buffer ediff-merge-store-file)
(setq merge-buffer-file ediff-merge-store-file)
(ediff-with-current-buffer ediff-buffer-C
(set-visited-file-name merge-buffer-file))))
@ -1326,9 +1340,13 @@ To change the default, set the variable `ediff-use-toolbar-p', which see."
;; will not re-appear after our cleanup here. Is there a way
;; to do "push" and "pop" toolbars ? --marcpa
(if (ediff-use-toolbar-p)
(progn
(set-specifier bottom-toolbar (list (selected-frame) nil))
(set-specifier bottom-toolbar-visible-p (list (selected-frame) nil)))))
(ediff-cond-compile-for-xemacs-or-emacs
(progn ; xemacs
(set-specifier bottom-toolbar (list (selected-frame) nil))
(set-specifier bottom-toolbar-visible-p (list (selected-frame) nil)))
nil ; emacs
)
))
;; If wants to use toolbar, make it.
;; If not, zero the toolbar for XEmacs.
@ -1338,15 +1356,24 @@ To change the default, set the variable `ediff-use-toolbar-p', which see."
(progn
(setq frame (or frame (selected-frame)))
(cond ((ediff-use-toolbar-p) ; this checks for XEmacs
(set-specifier
bottom-toolbar
(list frame (if (ediff-3way-comparison-job)
ediff-toolbar-3way ediff-toolbar)))
(set-specifier bottom-toolbar-visible-p (list frame t))
(set-specifier bottom-toolbar-height
(list frame ediff-toolbar-height)))
(ediff-cond-compile-for-xemacs-or-emacs
(progn ; xemacs
(set-specifier
bottom-toolbar
(list frame (if (ediff-3way-comparison-job)
ediff-toolbar-3way ediff-toolbar)))
(set-specifier bottom-toolbar-visible-p (list frame t))
(set-specifier bottom-toolbar-height
(list frame ediff-toolbar-height)))
nil ; emacs
)
)
((ediff-has-toolbar-support-p)
(set-specifier bottom-toolbar-height (list frame 0)))
(ediff-cond-compile-for-xemacs-or-emacs
(set-specifier bottom-toolbar-height (list frame 0)) ; xemacs
nil ; emacs
)
)
))
))
@ -1907,8 +1934,8 @@ determine the source and the target buffers instead of the command keys."
(let* ((key1 (aref keys 0))
(key2 (aref keys 1))
(char1 (if (and ediff-xemacs-p (eventp key1)) (event-key key1) key1))
(char2 (if (and ediff-xemacs-p (eventp key1)) (event-key key2) key2))
(char1 (ediff-event-key key1))
(char2 (ediff-event-key key2))
ediff-verbose-p)
(ediff-copy-diff ediff-current-difference
(ediff-char-to-buftype char1)
@ -2380,7 +2407,7 @@ temporarily reverses the meaning of this variable."
(ediff-delete-temp-files)
;; Restore visibility range. This affects only ediff-*-regions/windows.
;; Restore the visibility range. This affects only ediff-*-regions/windows.
;; Since for other job names ediff-visible-region sets
;; ediff-visible-bounds to ediff-wide-bounds, the settings below are
;; ignored for such jobs.
@ -2462,11 +2489,12 @@ temporarily reverses the meaning of this variable."
(run-hooks 'ediff-cleanup-hook)
;; now kill buffers A/B/C, if requested
(let ((ediff-keep-variants ediff-keep-variants))
(if reverse-default-keep-variants
(setq ediff-keep-variants (not ediff-keep-variants)))
(or ediff-keep-variants (ediff-janitor 'ask)))
(ediff-janitor
'ask
;; reverse-default-keep-variants is t if the user quits with a prefix arg
(if reverse-default-keep-variants
(not ediff-keep-variants)
ediff-keep-variants))
;; one hook here is ediff-cleanup-mess, which kills the control buffer and
;; other auxiliary buffers. we made it into a hook to let the users do their
@ -2548,9 +2576,7 @@ temporarily reverses the meaning of this variable."
(ediff-kill-buffer-carefully ctl-buf)
(if (frame-live-p main-frame)
(progn
(select-frame main-frame)
(delete-other-windows)))
(select-frame main-frame))
;; display only if not visible
(condition-case nil
@ -2560,7 +2586,8 @@ temporarily reverses the meaning of this variable."
(condition-case nil
(or (ediff-get-visible-buffer-window buff-A)
(progn
(if (ediff-get-visible-buffer-window buff-B)
(if (and (ediff-get-visible-buffer-window buff-B)
(ediff-buffer-live-p buff-A))
(funcall ediff-split-window-function))
(switch-to-buffer buff-A)))
(error))
@ -2568,8 +2595,9 @@ temporarily reverses the meaning of this variable."
(condition-case nil
(or (ediff-get-visible-buffer-window buff-C)
(progn
(if (or (ediff-get-visible-buffer-window buff-A)
(ediff-get-visible-buffer-window buff-B))
(if (and (or (ediff-get-visible-buffer-window buff-A)
(ediff-get-visible-buffer-window buff-B))
(ediff-buffer-live-p buff-C))
(funcall ediff-split-window-function))
(switch-to-buffer buff-C)
(balance-windows)))
@ -2577,36 +2605,52 @@ temporarily reverses the meaning of this variable."
(message "")
))
(defun ediff-janitor (&optional ask)
(defun ediff-janitor (ask keep-variants)
"Kill buffers A, B, and, possibly, C, if these buffers aren't modified.
In merge jobs, buffer C is never deleted.
However, the side effect of cleaning up may be that you cannot compare the same
buffer in two separate Ediff sessions: quitting one of them will delete this
buffer in another session as well."
(or (not (ediff-buffer-live-p ediff-buffer-A))
(buffer-modified-p ediff-buffer-A)
(and ask
(not (y-or-n-p (format "Kill buffer A [%s]? "
(buffer-name ediff-buffer-A)))))
(ediff-kill-buffer-carefully ediff-buffer-A))
(or (not (ediff-buffer-live-p ediff-buffer-B))
(buffer-modified-p ediff-buffer-B)
(and ask
(not (y-or-n-p (format "Kill buffer B [%s]? "
(buffer-name ediff-buffer-B)))))
(ediff-kill-buffer-carefully ediff-buffer-B))
In merge jobs, buffer C is not deleted here, but rather according to
ediff-quit-merge-hook.
A side effect of cleaning up may be that you should be careful when comparing
the same buffer in two separate Ediff sessions: quitting one of them might
delete this buffer in another session as well."
(ediff-dispose-of-variant-according-to-user
ediff-buffer-A 'A ask keep-variants)
(ediff-dispose-of-variant-according-to-user
ediff-buffer-B 'B ask keep-variants)
(if ediff-merge-job ; don't del buf C if merging--del ancestor buf instead
(or (not (ediff-buffer-live-p ediff-ancestor-buffer))
(buffer-modified-p ediff-ancestor-buffer)
(and ask
(not (y-or-n-p (format "Kill the ancestor buffer [%s]? "
(buffer-name ediff-ancestor-buffer)))))
(ediff-kill-buffer-carefully ediff-ancestor-buffer))
(or (not (ediff-buffer-live-p ediff-buffer-C))
(buffer-modified-p ediff-buffer-C)
(and ask (not (y-or-n-p (format "Kill buffer C [%s]? "
(buffer-name ediff-buffer-C)))))
(ediff-kill-buffer-carefully ediff-buffer-C))))
(ediff-dispose-of-variant-according-to-user
ediff-ancestor-buffer 'Ancestor ask keep-variants)
(ediff-dispose-of-variant-according-to-user
ediff-buffer-C 'C ask keep-variants)
))
;; Kill the variant buffer, according to user directives (ask, kill
;; unconditionaly, keep)
;; BUFF is the buffer, BUFF-TYPE is either 'A, or 'B, 'C, 'Ancestor
(defun ediff-dispose-of-variant-according-to-user (buff bufftype ask keep-variants)
;; if this is indirect buffer, kill it and substitute with direct buf
(if (ediff-with-current-buffer buff ediff-temp-indirect-buffer)
(let ((wind (ediff-get-visible-buffer-window buff))
(base (buffer-base-buffer buff))
(modified-p (buffer-modified-p buff)))
(if (and (window-live-p wind) (ediff-buffer-live-p base))
(set-window-buffer wind base))
;; Kill indirect buffer even if it is modified, because the base buffer
;; is still there. Note that if the base buffer is dead then so will be
;; the indirect buffer
(ediff-with-current-buffer buff
(set-buffer-modified-p nil))
(ediff-kill-buffer-carefully buff)
(ediff-with-current-buffer base
(set-buffer-modified-p modified-p)))
;; otherwise, ask or use the value of keep-variants
(or (not (ediff-buffer-live-p buff))
keep-variants
(buffer-modified-p buff)
(and ask
(not (y-or-n-p (format "Kill buffer %S [%s]? "
bufftype (buffer-name buff)))))
(ediff-kill-buffer-carefully buff))
))
(defun ediff-maybe-save-and-delete-merge (&optional save-and-continue)
"Default hook to run on quitting a merge job.
@ -2625,7 +2669,7 @@ only if this merge job is part of a group, i.e., was invoked from within
(ediff-autostore-merges ; fake ediff-autostore-merges, if necessary
(if save-and-continue t ediff-autostore-merges)))
(if ediff-autostore-merges
(cond ((stringp ediff-merge-store-file)
(cond ((stringp merge-store-file)
;; store, ask to delete
(ediff-write-merge-buffer-and-maybe-kill
ediff-buffer-C merge-store-file 'show-file save-and-continue))
@ -2647,20 +2691,36 @@ only if this merge job is part of a group, i.e., was invoked from within
(defun ediff-write-merge-buffer-and-maybe-kill (buf file
&optional
show-file save-and-continue)
(ediff-with-current-buffer buf
(if (or (not (file-exists-p file))
(y-or-n-p (format "File %s exists, overwrite? " file)))
(progn
(write-region (point-min) (point-max) file)
(if show-file
(progn
(message "Merge buffer saved in: %s" file)
(set-buffer-modified-p nil)
(sit-for 3)))
(if (and
(not save-and-continue)
(y-or-n-p "Merge buffer saved. Now kill the buffer? "))
(ediff-kill-buffer-carefully buf))))))
(if (not (eq (find-buffer-visiting file) buf))
(let ((warn-message
(format "Another buffer is visiting file %s. Too dangerous to save the merge buffer"
file)))
(beep)
(message warn-message)
(with-output-to-temp-buffer ediff-msg-buffer
(princ "\n\n")
(princ warn-message)
(princ "\n\n")
)
(sit-for 2))
(ediff-with-current-buffer buf
(if (or (not (file-exists-p file))
(y-or-n-p (format "File %s exists, overwrite? " file)))
(progn
;;(write-region (point-min) (point-max) file)
(ediff-with-current-buffer buf
(set-visited-file-name file)
(save-buffer))
(if show-file
(progn
(message "Merge buffer saved in: %s" file)
(set-buffer-modified-p nil)
(sit-for 3)))
(if (and
(not save-and-continue)
(y-or-n-p "Merge buffer saved. Now kill the buffer? "))
(ediff-kill-buffer-carefully buf)))))
))
;; The default way of suspending Ediff.
;; Buries Ediff buffers, kills all windows.
@ -2926,13 +2986,102 @@ Hit \\[ediff-recenter] to reset the windows afterward."
)))
(defun ediff-highlight-diff-in-one-buffer (n buf-type)
(if (ediff-buffer-live-p (ediff-get-buffer buf-type))
(let* ((buff (ediff-get-buffer buf-type))
(last (ediff-with-current-buffer buff (point-max)))
(begin (ediff-get-diff-posn buf-type 'beg n))
(end (ediff-get-diff-posn buf-type 'end n))
(xtra (if (equal begin end) 1 0))
(end-hilit (min last (+ end xtra)))
(current-diff-overlay
(symbol-value
(ediff-get-symbol-from-alist
buf-type ediff-current-diff-overlay-alist))))
(if ediff-xemacs-p
(ediff-move-overlay current-diff-overlay begin end-hilit)
(ediff-move-overlay current-diff-overlay begin end-hilit buff))
(ediff-overlay-put current-diff-overlay 'priority
(ediff-highest-priority begin end-hilit buff))
(ediff-overlay-put current-diff-overlay 'ediff-diff-num n)
;; unhighlight the background overlay for diff n so it won't
;; interfere with the current diff overlay
(ediff-set-overlay-face (ediff-get-diff-overlay n buf-type) nil)
)))
(defun ediff-unhighlight-diff-in-one-buffer (buf-type)
(if (ediff-buffer-live-p (ediff-get-buffer buf-type))
(let ((current-diff-overlay
(symbol-value
(ediff-get-symbol-from-alist
buf-type ediff-current-diff-overlay-alist)))
(overlay
(ediff-get-diff-overlay ediff-current-difference buf-type))
)
(ediff-move-overlay current-diff-overlay 1 1)
;; rehighlight the overlay in the background of the
;; current difference region
(ediff-set-overlay-face
overlay
(if (and (ediff-has-face-support-p)
ediff-use-faces ediff-highlight-all-diffs)
(ediff-background-face buf-type ediff-current-difference)))
)))
(defun ediff-unhighlight-diffs-totally-in-one-buffer (buf-type)
(ediff-unselect-and-select-difference -1)
(if (and (ediff-has-face-support-p) ediff-use-faces)
(let* ((inhibit-quit t)
(current-diff-overlay-var
(ediff-get-symbol-from-alist
buf-type ediff-current-diff-overlay-alist))
(current-diff-overlay (symbol-value current-diff-overlay-var)))
(ediff-paint-background-regions 'unhighlight)
(if (ediff-overlayp current-diff-overlay)
(ediff-delete-overlay current-diff-overlay))
(set current-diff-overlay-var nil)
)))
(defsubst ediff-highlight-diff (n)
"Put face on diff N. Invoked for X displays only."
(ediff-highlight-diff-in-one-buffer n 'A)
(ediff-highlight-diff-in-one-buffer n 'B)
(ediff-highlight-diff-in-one-buffer n 'C)
(ediff-highlight-diff-in-one-buffer n 'Ancestor)
)
(defsubst ediff-unhighlight-diff ()
"Remove overlays from buffers A, B, and C."
(ediff-unhighlight-diff-in-one-buffer 'A)
(ediff-unhighlight-diff-in-one-buffer 'B)
(ediff-unhighlight-diff-in-one-buffer 'C)
(ediff-unhighlight-diff-in-one-buffer 'Ancestor)
)
;; delete highlighting overlays, restore faces to their original form
(defsubst ediff-unhighlight-diffs-totally ()
(ediff-unhighlight-diffs-totally-in-one-buffer 'A)
(ediff-unhighlight-diffs-totally-in-one-buffer 'B)
(ediff-unhighlight-diffs-totally-in-one-buffer 'C)
(ediff-unhighlight-diffs-totally-in-one-buffer 'Ancestor)
)
;; This is adapted from a similar function in `emerge.el'.
;; PROMPT should not have a trailing ': ', so that it can be modified
;; according to context.
;; If DEFAULT-FILE is set, it should be used as the default value.
;; If DEFAULT-DIR is non-nil, use it as the default directory.
;; Otherwise, use the value of Emacs' variable `default-directory.'
(defun ediff-read-file-name (prompt default-dir default-file)
(defun ediff-read-file-name (prompt default-dir default-file &optional no-dirs)
;; hack default-dir if it is not set
(setq default-dir
(file-name-as-directory
@ -2963,13 +3112,15 @@ Hit \\[ediff-recenter] to reset the windows afterward."
)
default-dir
))
;; If user enters a directory name, expand the default file in that
;; If user entered a directory name, expand the default file in that
;; directory. This allows the user to enter a directory name for the
;; B-file and diff against the default-file in that directory instead
;; of a DIRED listing!
(if (and (file-directory-p f) default-file)
(setq f (expand-file-name
(file-name-nondirectory default-file) f)))
(if (and no-dirs (file-directory-p f))
(error "File %s is a directory" f))
f))
;; If PREFIX is given, then it is used as a prefix for the temp file
@ -3031,7 +3182,13 @@ Hit \\[ediff-recenter] to reset the windows afterward."
(progn
(if (or (file-exists-p file) (not keep-proposed-name))
(setq file (make-temp-name proposed-name)))
(write-region "" nil file nil 'silent nil 'excl)
;; the with-temp-buffer thing is a workaround for an XEmacs
;; bug: write-region complains that we are trying to visit a
;; file in an indirect buffer, failing to notice that the
;; VISIT flag is unset and that we are actually writing from a
;; string and not from any buffer.
(with-temp-buffer
(write-region "" nil file nil 'silent nil 'excl))
nil)
(file-already-exists t))
;; the file was somehow created by someone else between
@ -3064,7 +3221,8 @@ Hit \\[ediff-recenter] to reset the windows afterward."
(if (buffer-modified-p)
;; If buffer is not obsolete and is modified, offer to save
(if (yes-or-no-p
(format "Buffer out of sync with visited file. Save file %s? "
(format "Buffer %s has been modified. Save it in file %s? "
(buffer-name)
buffer-file-name))
(condition-case nil
(save-buffer)
@ -3076,7 +3234,9 @@ Hit \\[ediff-recenter] to reset the windows afterward."
nil)
;; If buffer is obsolete, offer to revert
(if (yes-or-no-p
(format "Buffer is out of sync with visited file. REVERT file %s? "
(format "File %s was modified since visited by buffer %s. REVERT file %s? "
buffer-file-name
(buffer-name)
buffer-file-name))
(progn
(if file-magic
@ -3084,6 +3244,29 @@ Hit \\[ediff-recenter] to reset the windows afterward."
(revert-buffer t t))
(error "Buffer out of sync for file %s" buffer-file-name))))
;; if there is another buffer visiting the file of the merge buffer, offer to
;; save and delete the buffer; else bark
(defun ediff-verify-file-merge-buffer (file)
(let ((buff (if (stringp file) (find-buffer-visiting file)))
warn-message)
(or (null buff)
(progn
(setq warn-message
(format "Buffer %s is visiting %s. Save and kill the buffer? "
(buffer-name buff) file))
(with-output-to-temp-buffer ediff-msg-buffer
(princ "\n\n")
(princ warn-message)
(princ "\n\n"))
(if (y-or-n-p
(message warn-message))
(with-current-buffer buff
(save-buffer)
(kill-buffer (current-buffer)))
(error "Too dangerous to merge versions of a file visited by another buffer"))))
))
(defun ediff-filename-magic-p (file)
(or (ediff-file-compressed-p file)
@ -3387,6 +3570,40 @@ Ediff Control Panel to restore highlighting."
(ediff-overlay-put curr-overl 'after-string flag))
))
;;; Some diff region tests
;; t if diff region is empty.
;; In case of buffer C, t also if it is not a 3way
;; comparison job (merging jobs return t as well).
(defun ediff-empty-diff-region-p (n buf-type)
(if (eq buf-type 'C)
(or (not ediff-3way-comparison-job)
(= (ediff-get-diff-posn 'C 'beg n)
(ediff-get-diff-posn 'C 'end n)))
(= (ediff-get-diff-posn buf-type 'beg n)
(ediff-get-diff-posn buf-type 'end n))))
;; Test if diff region is white space only.
;; If 2-way job and buf-type = C, then returns t.
(defun ediff-whitespace-diff-region-p (n buf-type)
(or (and (eq buf-type 'C) (not ediff-3way-job))
(ediff-empty-diff-region-p n buf-type)
(let ((beg (ediff-get-diff-posn buf-type 'beg n))
(end (ediff-get-diff-posn buf-type 'end n)))
(ediff-with-current-buffer (ediff-get-buffer buf-type)
(save-excursion
(goto-char beg)
(skip-chars-forward ediff-whitespace)
(>= (point) end))))))
(defsubst ediff-get-region-contents (n buf-type ctrl-buf &optional start end)
(ediff-with-current-buffer
(ediff-with-current-buffer ctrl-buf (ediff-get-buffer buf-type))
(buffer-substring
(or start (ediff-get-diff-posn buf-type 'beg n ctrl-buf))
(or end (ediff-get-diff-posn buf-type 'end n ctrl-buf)))))
;; Returns positions of difference sectors in the BUF-TYPE buffer.
;; BUF-TYPE should be a symbol -- `A', `B', or `C'.
@ -3467,10 +3684,11 @@ Ediff Control Panel to restore highlighting."
(or (number-or-marker-p end)
(setq end (eval end)))
(setq overl
(if ediff-xemacs-p
(make-extent beg end buff)
;; advance front and rear of the overlay
(make-overlay beg end buff nil 'rear-advance)))
(ediff-cond-compile-for-xemacs-or-emacs
(make-extent beg end buff) ; xemacs
;; advance front and rear of the overlay
(make-overlay beg end buff nil 'rear-advance) ; emacs
))
;; never detach
(ediff-overlay-put
@ -3483,6 +3701,22 @@ Ediff Control Panel to restore highlighting."
(ediff-overlay-put overl 'end-open nil)))
(ediff-overlay-put overl 'ediff-diff-num 0)
overl))))
(defun ediff-make-current-diff-overlay (type)
(if (ediff-has-face-support-p)
(let ((overlay (ediff-get-symbol-from-alist
type ediff-current-diff-overlay-alist))
(buffer (ediff-get-buffer type))
(face (face-name
(symbol-value
(ediff-get-symbol-from-alist
type ediff-current-diff-face-alist)))))
(set overlay
(ediff-make-bullet-proof-overlay (point-max) (point-max) buffer))
(ediff-set-overlay-face (symbol-value overlay) face)
(ediff-overlay-put (symbol-value overlay) 'ediff ediff-control-buffer))
))
;; Like other-buffer, but prefers visible buffers and ignores temporary or
@ -3695,7 +3929,7 @@ Mail anyway? (y or n) ")
(set-buffer ctl-buf))
(setq buffer-name (buffer-name))
(require 'reporter)
(reporter-submit-bug-report "kifer@cs.sunysb.edu"
(reporter-submit-bug-report "kifer@cs.stonybrook.edu"
(ediff-version)
varlist
nil
@ -3729,13 +3963,15 @@ Mail anyway? (y or n) ")
(defun ediff-deactivate-mark ()
(if ediff-xemacs-p
(zmacs-deactivate-region)
(deactivate-mark)))
(ediff-cond-compile-for-xemacs-or-emacs
(zmacs-deactivate-region) ; xemacs
(deactivate-mark) ; emacs
))
(defun ediff-activate-mark ()
(if ediff-emacs-p
(setq mark-active t)
(zmacs-activate-region)))
(ediff-cond-compile-for-xemacs-or-emacs
(zmacs-activate-region) ; xemacs
(setq mark-active t) ; emacs
))
(cond ((fboundp 'nuke-selective-display)
;; XEmacs 19.12 has nuke-selective-display
@ -3848,8 +4084,10 @@ Mail anyway? (y or n) ")
(interactive)
(ediff-barf-if-not-control-buffer)
(if ediff-xemacs-p
(make-local-hook 'post-command-hook))
(ediff-cond-compile-for-xemacs-or-emacs
(make-local-hook 'post-command-hook) ; xemacs form
nil ; emacs form
)
(let ((pre-hook 'pre-command-hook)
(post-hook 'post-command-hook))
@ -3910,6 +4148,16 @@ Mail anyway? (y or n) ")
(setq lis (cdr lis)))
lis)
;; Make a readable representation of the invocation sequence for FUNC-DEF.
;; It would either be a key or M-x something.
(defun ediff-format-bindings-of (func-def)
(let ((desc (car (where-is-internal func-def
overriding-local-map
nil nil))))
(if desc
(key-description desc)
(format "M-x %s" func-def))))
;; this uses comparison-func to decide who is a member, and this determines how
;; intersection looks like
(defun ediff-intersection (lis1 lis2 comparison-func)
@ -3945,7 +4193,7 @@ Mail anyway? (y or n) ")
(cdr result)))
(if (fboundp 'copy-sequence)
(defalias 'ediff-copy-list 'copy-sequence)
(fset 'ediff-copy-list (symbol-function 'copy-sequence))
(defun ediff-copy-list (list)
(if (consp list)
;;;(let ((res nil))

30
lisp/ediff-vers.el
View File

@ -1,8 +1,8 @@
;;; ediff-vers.el --- version control interface to Ediff
;;; Copyright (C) 1995, 1996, 1997 Free Software Foundation, Inc.
;;; Copyright (C) 1995, 96, 97, 2002 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.sunysb.edu>
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; This file is part of GNU Emacs.
@ -35,16 +35,20 @@
(and noninteractive
(eval-when-compile
(load "pcl-cvs" 'noerror)
(load "rcs" 'noerror)
;; On 8+3 MS-DOS filesystems, generic-x.el is loaded
;; instead of (the missing) generic-sc.el. Since the
;; version of Emacs which supports MS-DOS doesn't have
;; generic-sc, we simply avoid loading it.
(or (and (fboundp 'msdos-long-file-names)
(not (msdos-long-file-names)))
(load "generic-sc" 'noerror))
(load "vc" 'noerror)))
(let ((load-path (cons (expand-file-name ".") load-path)))
(load "pcl-cvs" 'noerror)
(load "rcs" 'noerror)
;; On 8+3 MS-DOS filesystems, generic-x.el is loaded
;; instead of (the missing) generic-sc.el. Since the
;; version of Emacs which supports MS-DOS doesn't have
;; generic-sc, we simply avoid loading it.
(or (and (fboundp 'msdos-long-file-names)
(not (msdos-long-file-names)))
(load "generic-sc" 'noerror))
;; (load "vc" 'noerror) ; this sometimes causes compiler error
(or (featurep 'ediff-init)
(load "ediff-init.el" nil nil 'nosuffix))
)))
;; end pacifier
;; VC.el support
@ -246,7 +250,7 @@
;; PCL-CVS.el support
;; MK: Check. This function doesn't seem to be used any more by pcvs or pcl-cvs
(defun cvs-run-ediff-on-file-descriptor (tin)
;; This is a replacement for cvs-emerge-mode
;; Runs after cvs-update.

104
lisp/ediff-wind.el
View File

@ -1,8 +1,8 @@
;;; ediff-wind.el --- window manipulation utilities
;; Copyright (C) 1994, 1995, 1996, 1997 Free Software Foundation, Inc.
;; Copyright (C) 1994, 95, 96, 97, 2000, 01, 02 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.sunysb.edu>
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; This file is part of GNU Emacs.
@ -36,6 +36,7 @@
(defvar left-toolbar-width)
(defvar right-toolbar-width)
(defvar default-menubar)
(defvar top-gutter)
(defvar frame-icon-title-format)
(defvar ediff-diff-status)
(defvar ediff-emacs-p)
@ -271,35 +272,39 @@ into icons, regardless of the window manager."
(beep 1))
(message "Please click on Window %d " wind-number))
(ediff-read-event) ; discard event
(setq wind (if ediff-xemacs-p
(event-window event)
(posn-window (event-start event))))
(setq wind (ediff-cond-compile-for-xemacs-or-emacs
(event-window event) ; xemacs
(posn-window (event-start event)) ; emacs
)
)
))
;; Select the lowest window on the frame.
(defun ediff-select-lowest-window ()
(if ediff-xemacs-p
(select-window (frame-lowest-window))
(let* ((lowest-window (selected-window))
(bottom-edge (car (cdr (cdr (cdr (window-edges))))))
(last-window (save-excursion
(other-window -1) (selected-window)))
(window-search t))
(while window-search
(let* ((this-window (next-window))
(next-bottom-edge
(car (cdr (cdr (cdr (window-edges this-window)))))))
(if (< bottom-edge next-bottom-edge)
(progn
(setq bottom-edge next-bottom-edge)
(setq lowest-window this-window)))
(select-window this-window)
(if (eq last-window this-window)
(progn
(select-window lowest-window)
(setq window-search nil))))))))
(ediff-cond-compile-for-xemacs-or-emacs
(select-window (frame-lowest-window)) ; xemacs
;; emacs
(let* ((lowest-window (selected-window))
(bottom-edge (car (cdr (cdr (cdr (window-edges))))))
(last-window (save-excursion
(other-window -1) (selected-window)))
(window-search t))
(while window-search
(let* ((this-window (next-window))
(next-bottom-edge
(car (cdr (cdr (cdr (window-edges this-window)))))))
(if (< bottom-edge next-bottom-edge)
(progn
(setq bottom-edge next-bottom-edge)
(setq lowest-window this-window)))
(select-window this-window)
(if (eq last-window this-window)
(progn
(select-window lowest-window)
(setq window-search nil))))))
))
;;; Common window setup routines
@ -845,7 +850,7 @@ into icons, regardless of the window manager."
(ediff-frame-has-dedicated-windows (selected-frame))
(ediff-frame-iconified-p (selected-frame))
;; skip small windows
(< (window-height (selected-window))
(< (frame-height (selected-frame))
(* 3 window-min-height))
(if ok-unsplittable
nil
@ -896,7 +901,10 @@ into icons, regardless of the window manager."
fheight fwidth adjusted-parameters)
(ediff-with-current-buffer ctl-buffer
(if ediff-xemacs-p (set-buffer-menubar nil))
(ediff-cond-compile-for-xemacs-or-emacs
(set-buffer-menubar nil) ; xemacs
nil ; emacs
)
;;(setq user-grabbed-mouse (ediff-user-grabbed-mouse))
(run-hooks 'ediff-before-setup-control-frame-hook))
@ -908,8 +916,11 @@ into icons, regardless of the window manager."
ediff-control-frame ctl-frame)
;; protect against undefined face-attribute
(condition-case nil
(when (and ediff-emacs-p (face-attribute 'mode-line :box))
(set-face-attribute 'mode-line ctl-frame :box nil))
(ediff-cond-compile-for-xemacs-or-emacs
nil ; xemacs
(when (face-attribute 'mode-line :box)
(set-face-attribute 'mode-line ctl-frame :box nil))
)
(error))
)
@ -955,14 +966,19 @@ into icons, regardless of the window manager."
;; In XEmacs, buffer menubar needs to be killed before frame parameters
;; are changed.
(if (ediff-has-toolbar-support-p)
(progn
(set-specifier top-toolbar-height (list ctl-frame 2))
(sit-for 0)
(set-specifier top-toolbar-height (list ctl-frame 0))
;;(set-specifier bottom-toolbar-height (list ctl-frame 0))
(set-specifier left-toolbar-width (list ctl-frame 0))
(set-specifier right-toolbar-width (list ctl-frame 0))
))
(ediff-cond-compile-for-xemacs-or-emacs
(progn ; xemacs
(set-specifier top-toolbar-height (list ctl-frame 2))
(set-specifier top-gutter (list ctl-frame nil))
(sit-for 0)
(set-specifier top-toolbar-height (list ctl-frame 0))
;;(set-specifier bottom-toolbar-height (list ctl-frame 0))
(set-specifier left-toolbar-width (list ctl-frame 0))
(set-specifier right-toolbar-width (list ctl-frame 0))
)
nil ; emacs
)
)
;; Under OS/2 (emx) we have to call modify frame parameters twice, in order
;; to make sure that at least once we do it for non-iconified frame. If
@ -1018,8 +1034,10 @@ into icons, regardless of the window manager."
(if ediff-xemacs-p
(ediff-with-current-buffer ctl-buffer
(if ediff-xemacs-p
(make-local-hook 'select-frame-hook))
(ediff-cond-compile-for-xemacs-or-emacs
(make-local-hook 'select-frame-hook) ; xemacs
nil ; emacs
)
(add-hook
'select-frame-hook 'ediff-xemacs-select-frame-hook nil 'local)
))
@ -1033,8 +1051,10 @@ into icons, regardless of the window manager."
(ediff-with-current-buffer ctl-buffer
(if (and (ediff-window-display-p) (frame-live-p ediff-control-frame))
(let ((ctl-frame ediff-control-frame))
(if ediff-xemacs-p
(set-buffer-menubar default-menubar))
(ediff-cond-compile-for-xemacs-or-emacs
(set-buffer-menubar default-menubar) ; xemacs
nil ; emacs
)
(setq ediff-control-frame nil)
(delete-frame ctl-frame)
)))

130
lisp/ediff.el
View File

@ -1,13 +1,13 @@
;;; ediff.el --- a comprehensive visual interface to diff & patch
;; Copyright (C) 1994, 95, 96, 97, 98, 99, 2000, 01 Free Software Foundation, Inc.
;; Copyright (C) 1994, 95, 96, 97, 98, 99, 2000, 01, 02 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.sunysb.edu>
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; Created: February 2, 1994
;; Keywords: comparing, merging, patching, tools, unix
(defconst ediff-version "2.76" "The current version of Ediff")
(defconst ediff-date "July 18, 2001" "Date of last update")
(defconst ediff-version "2.76.1" "The current version of Ediff")
(defconst ediff-date "January 4, 2002" "Date of last update")
;; This file is part of GNU Emacs.
@ -172,7 +172,7 @@
(let ((current (dired-get-filename nil 'no-error))
(marked (condition-case nil
(dired-get-marked-files 'no-dir)
(error)))
(error nil)))
aux-list choices result)
(or (integerp fileno) (setq fileno 0))
(if (stringp default)
@ -199,8 +199,10 @@
default-directory))
dir-B f)
(list (setq f (ediff-read-file-name
"File A to compare" dir-A
(ediff-get-default-file-name)))
"File A to compare"
dir-A
(ediff-get-default-file-name)
'no-dirs))
(ediff-read-file-name "File B to compare"
(setq dir-B
(if ediff-use-last-dir
@ -233,8 +235,10 @@
default-directory))
dir-B dir-C f ff)
(list (setq f (ediff-read-file-name
"File A to compare" dir-A
(ediff-get-default-file-name)))
"File A to compare"
dir-A
(ediff-get-default-file-name)
'no-dirs))
(setq ff (ediff-read-file-name "File B to compare"
(setq dir-B
(if ediff-use-last-dir
@ -332,6 +336,11 @@
(defun ediff-files-internal (file-A file-B file-C startup-hooks job-name
&optional merge-buffer-file)
(let (buf-A buf-B buf-C)
(if (string= file-A file-B)
(error "Files A and B are the same"))
(if (stringp file-C)
(or (and (string= file-A file-C) (error "Files A and C are the same"))
(and (string= file-B file-C) (error "Files B and C are the same"))))
(message "Reading file %s ... " file-A)
;;(sit-for 0)
(ediff-find-file 'file-A 'buf-A 'ediff-last-dir-A 'startup-hooks)
@ -828,14 +837,59 @@ If WIND-B is nil, use window next to WIND-A."
(select-window wind-B)
(setq beg-B (window-start)
end-B (window-end))))
(setq buffer-A
(ediff-clone-buffer-for-window-comparison
buffer-A wind-A "-Window1-")
buffer-B
(ediff-clone-buffer-for-window-comparison
buffer-B wind-B "-Window2-"))
(ediff-regions-internal
buffer-A beg-A end-A buffer-B beg-B end-B
startup-hooks job-name word-mode nil)))
;; Suggested by Hannu Koivisto <azure@iki.fi>
(defun ediff-clone-buffer-for-region-comparison (buff-name region-name)
(let ((cloned-buff (ediff-make-indirect-buffer
buff-name
(concat buff-name region-name
(symbol-name (gensym)))))
(wind (ediff-get-visible-buffer-window buff-name)))
(ediff-with-current-buffer cloned-buff
(setq ediff-temp-indirect-buffer t))
(if (window-live-p wind)
(set-window-buffer wind cloned-buff))
(pop-to-buffer cloned-buff)
(message
"Mark a region in buffer %s; then type %s. Use %s to abort."
(buffer-name cloned-buff)
(ediff-format-bindings-of 'exit-recursive-edit)
(ediff-format-bindings-of 'abort-recursive-edit))
(recursive-edit)
cloned-buff))
(defun ediff-clone-buffer-for-window-comparison (buff wind region-name)
(let ((cloned-buff (ediff-make-indirect-buffer
buff
(concat (buffer-name buff)
region-name (symbol-name (gensym))))))
(ediff-with-current-buffer cloned-buff
(setq ediff-temp-indirect-buffer t))
(set-window-buffer wind cloned-buff)
cloned-buff))
(defun ediff-make-indirect-buffer (base-buf indirect-buf-name)
(ediff-cond-compile-for-xemacs-or-emacs
(make-indirect-buffer base-buf indirect-buf-name) ; xemacs
(make-indirect-buffer base-buf indirect-buf-name 'clone) ; emacs
))
;;;###autoload
(defun ediff-regions-wordwise (buffer-A buffer-B &optional startup-hooks)
"Run Ediff on a pair of regions in two different buffers.
Regions \(i.e., point and mark\) are assumed to be set in advance.
"Run Ediff on a pair of regions in specified buffers.
Regions \(i.e., point and mark\) are assumed to be set in advance except
for the second region in the case both regions are from the same buffer.
In such a case the user is asked to interactively establish the second
region.
This function is effective only for relatively small regions, up to 200
lines. For large regions, use `ediff-regions-linewise'."
(interactive
@ -855,7 +909,11 @@ lines. For large regions, use `ediff-regions-linewise'."
(error "Buffer %S doesn't exist" buffer-B))
(let (reg-A-beg reg-A-end reg-B-beg reg-B-end)
(let ((buffer-A
(ediff-clone-buffer-for-region-comparison buffer-A "-Region1-"))
(buffer-B
(ediff-clone-buffer-for-region-comparison buffer-B "-Region2-"))
reg-A-beg reg-A-end reg-B-beg reg-B-end)
(save-excursion
(set-buffer buffer-A)
(setq reg-A-beg (region-beginning)
@ -871,8 +929,11 @@ lines. For large regions, use `ediff-regions-linewise'."
;;;###autoload
(defun ediff-regions-linewise (buffer-A buffer-B &optional startup-hooks)
"Run Ediff on a pair of regions in two different buffers.
Regions \(i.e., point and mark\) are assumed to be set in advance.
"Run Ediff on a pair of regions in specified buffers.
Regions \(i.e., point and mark\) are assumed to be set in advance except
for the second region in the case both regions are from the same buffer.
In such a case the user is asked to interactively establish the second
region.
Each region is enlarged to contain full lines.
This function is effective for large regions, over 100-200
lines. For small regions, use `ediff-regions-wordwise'."
@ -892,7 +953,11 @@ lines. For small regions, use `ediff-regions-wordwise'."
(if (not (ediff-buffer-live-p buffer-B))
(error "Buffer %S doesn't exist" buffer-B))
(let (reg-A-beg reg-A-end reg-B-beg reg-B-end)
(let ((buffer-A
(ediff-clone-buffer-for-region-comparison buffer-A "-Region1-"))
(buffer-B
(ediff-clone-buffer-for-region-comparison buffer-B "-Region2-"))
reg-A-beg reg-A-end reg-B-beg reg-B-end)
(save-excursion
(set-buffer buffer-A)
(setq reg-A-beg (region-beginning)
@ -941,25 +1006,6 @@ lines. For small regions, use `ediff-regions-wordwise'."
(setq beg-B (move-marker (make-marker) beg-B)
end-B (move-marker (make-marker) end-B)))
(if (and (eq buffer-A buffer-B)
(or (and (< beg-A end-B) (<= beg-B beg-A)) ; b-B b-A e-B
(and (< beg-B end-A) (<= end-A end-B)))) ; b-B e-A e-B
(progn
(with-output-to-temp-buffer ediff-msg-buffer
(ediff-with-current-buffer standard-output
(fundamental-mode))
(princ "
You have requested to compare overlapping regions of the same buffer.
In this case, Ediff's highlighting may be confusing---in the same window,
you may see highlighted regions that belong to different regions.
Continue anyway? (y/n) "))
(if (y-or-n-p "Continue anyway? ")
()
(error "%S aborted" job-name))))
;; make file-A
(if word-mode
(ediff-wordify beg-A end-A buffer-A tmp-buffer)
@ -1011,8 +1057,10 @@ Continue anyway? (y/n) "))
default-directory))
dir-B f)
(list (setq f (ediff-read-file-name
"File A to merge" dir-A
(ediff-get-default-file-name)))
"File A to merge"
dir-A
(ediff-get-default-file-name)
'no-dirs))
(ediff-read-file-name "File B to merge"
(setq dir-B
(if ediff-use-last-dir
@ -1053,8 +1101,10 @@ Continue anyway? (y/n) "))
default-directory))
dir-B dir-ancestor f ff)
(list (setq f (ediff-read-file-name
"File A to merge" dir-A
(ediff-get-default-file-name)))
"File A to merge"
dir-A
(ediff-get-default-file-name)
'no-dirs))
(setq ff (ediff-read-file-name "File B to merge"
(setq dir-B
(if ediff-use-last-dir
@ -1221,6 +1271,7 @@ buffer."
(intern (format "ediff-%S-merge-internal" ediff-version-control-package))
rev1 rev2 ancestor-rev startup-hooks merge-buffer-file)))
;; MK: Check. This function doesn't seem to be used any more by pcvs or pcl-cvs
;;;###autoload
(defun run-ediff-from-cvs-buffer (pos)
"Run Ediff-merge on appropriate revisions of the selected file.
@ -1306,7 +1357,8 @@ Uses `vc.el' or `rcs.el' depending on `ediff-version-control-package'."
(if ediff-use-last-dir
ediff-last-dir-A
default-directory)
(ediff-get-default-file-name))))
(ediff-get-default-file-name)
'no-dirs)))
(find-file file)
(if (and (buffer-modified-p)
(y-or-n-p (message "Buffer %s is modified. Save buffer? "

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

@ -1,8 +1,8 @@
;;; viper-cmd.el --- Vi command support for Viper
;; Copyright (C) 1997 Free Software Foundation, Inc.
;; Copyright (C) 1997, 98, 99, 2000, 01, 02 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.sunysb.edu>
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; This file is part of GNU Emacs.
@ -41,6 +41,8 @@
(defvar quail-current-str)
(defvar zmacs-region-stays)
(defvar mark-even-if-inactive)
(defvar init-message)
(defvar initial)
;; loading happens only in non-interactive compilation
;; in order to spare non-viperized emacs from being viperized
@ -145,6 +147,10 @@
;; Where viper saves mark. This mark is resurrected by m^
(defvar viper-saved-mark nil)
;; Contains user settings for vars affected by viper-set-expert-level function.
;; Not a user option.
(defvar viper-saved-user-settings nil)
;;; CODE
@ -298,12 +304,15 @@
;; desirable that viper-pre-command-sentinel is the last hook and
;; viper-post-command-sentinel is the first hook.
(if viper-xemacs-p
(progn
(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)))
(viper-cond-compile-for-xemacs-or-emacs
;; xemacs
(progn
(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))
nil ; emacs
)
(remove-hook 'post-command-hook 'viper-post-command-sentinel)
(add-hook 'post-command-hook 'viper-post-command-sentinel)
@ -744,14 +753,16 @@ Vi's prefix argument will be used. Otherwise, the prefix argument passed to
;; this-command, last-command-char, last-command-event
(setq this-command com)
(if viper-xemacs-p ; XEmacs represents key sequences as vectors
(setq last-command-event
(viper-copy-event (viper-seq-last-elt key))
last-command-char (event-to-character last-command-event))
;; Emacs represents them as sequences (str or vec)
(setq last-command-event
(viper-copy-event (viper-seq-last-elt key))
last-command-char last-command-event))
(viper-cond-compile-for-xemacs-or-emacs
;; XEmacs represents key sequences as vectors
(setq last-command-event
(viper-copy-event (viper-seq-last-elt key))
last-command-char (event-to-character last-command-event))
;; Emacs represents them as sequences (str or vec)
(setq last-command-event
(viper-copy-event (viper-seq-last-elt key))
last-command-char last-command-event)
)
(if (commandp com)
(progn
@ -850,7 +861,7 @@ Vi's prefix argument will be used. Otherwise, the prefix argument passed to
(viper-copy-event (if viper-xemacs-p
(character-to-event ch) ch)))
) ; let
(error)
(error nil)
) ; condition-case
(viper-set-input-method nil)
@ -1766,13 +1777,14 @@ invokes the command before that, etc."
(message " `.' runs %s%s"
(concat "`" (viper-array-to-string keys) "'")
(viper-abbreviate-string
(if viper-xemacs-p
(replace-in-string
(cond ((characterp text) (char-to-string text))
((stringp text) text)
(t ""))
"\n" "^J")
text)
(viper-cond-compile-for-xemacs-or-emacs
(replace-in-string ; xemacs
(cond ((characterp text) (char-to-string text))
((stringp text) text)
(t ""))
"\n" "^J")
text ; emacs
)
max-text-len
" inserting `" "'" " ......."))
))
@ -2059,9 +2071,10 @@ To turn this feature off, set this variable to nil."
(setq cmd
(key-binding (setq key (read-key-sequence nil))))
(cond ((eq cmd 'self-insert-command)
(if viper-xemacs-p
(insert (events-to-keys key))
(insert key)))
(viper-cond-compile-for-xemacs-or-emacs
(insert (events-to-keys key)) ; xemacs
(insert key) ; emacs
))
((memq cmd '(exit-minibuffer viper-exit-minibuffer))
nil)
(t (command-execute cmd)))
@ -2642,7 +2655,7 @@ On reaching beginning of line, stop and signal error."
(let ((pt (point)))
(condition-case nil
(forward-char arg)
(error))
(error nil))
(if (< (point) pt) ; arg was negative
(- (viper-chars-in-region pt (point)))
(viper-chars-in-region pt (point)))))
@ -2656,7 +2669,7 @@ On reaching beginning of line, stop and signal error."
(let ((pt (point)))
(condition-case nil
(backward-char arg)
(error))
(error nil))
(if (> (point) pt) ; arg was negative
(viper-chars-in-region pt (point))
(- (viper-chars-in-region pt (point))))))
@ -3323,9 +3336,11 @@ controlled by the sign of prefix numeric value."
;; (which is called from viper-search-forward/backward/next). If the value of
;; viper-search-scroll-threshold is negative - don't scroll.
(defun viper-adjust-window ()
(let ((win-height (if viper-emacs-p
(1- (window-height)) ; adjust for modeline
(window-displayed-height)))
(let ((win-height (viper-cond-compile-for-xemacs-or-emacs
(window-displayed-height) ; xemacs
;; emacs
(1- (window-height)) ; adjust for modeline
))
(pt (point))
at-top-p at-bottom-p
min-scroll direction)
@ -4575,8 +4590,6 @@ One can use `` and '' to temporarily jump 1 step back."
(t (error viper-InvalidTextmarker reg)))))
;; commands in insertion mode
(defun viper-delete-backward-word (arg)
"Delete previous word."
@ -4587,6 +4600,17 @@ One can use `` and '' to temporarily jump 1 step back."
(delete-region (point) (mark t))
(pop-mark)))
;; Get viper standard value of SYMBOL. If symbol is customized, get its
;; standard value. Otherwise, get the value saved in the alist STORAGE. If
;; STORAGE is nil, use viper-saved-user-settings.
(defun viper-standard-value (symbol &optional storage)
(or (eval (car (get symbol 'customized-value)))
(eval (car (get symbol 'saved-value)))
(nth 1 (assoc symbol (or storage viper-saved-user-settings)))))
(defun viper-set-expert-level (&optional dont-change-unless)
"Sets the expert level for a Viper user.
@ -4913,7 +4937,7 @@ Mail anyway (y or n)? ")
(require 'reporter)
(set-window-configuration window-config)
(reporter-submit-bug-report "kifer@cs.sunysb.edu"
(reporter-submit-bug-report "kifer@cs.stonybrook.edu"
(viper-version)
varlist
nil 'delete-other-windows
@ -4921,54 +4945,6 @@ Mail anyway (y or n)? ")
))
;; Smoothes out the difference between Emacs' unread-command-events
;; and XEmacs unread-command-event. Arg is a character, an event, a list of
;; events or a sequence of keys.
;;
;; Due to the way unread-command-events in Emacs (not XEmacs), a non-event
;; symbol in unread-command-events list may cause Emacs to turn this symbol
;; into an event. Below, we delete nil from event lists, since nil is the most
;; common symbol that might appear in this wrong context.
(defun viper-set-unread-command-events (arg)
(if viper-emacs-p
(setq
unread-command-events
(let ((new-events
(cond ((eventp arg) (list arg))
((listp arg) arg)
((sequencep arg)
(listify-key-sequence arg))
(t (error
"viper-set-unread-command-events: Invalid argument, %S"
arg)))))
(if (not (eventp nil))
(setq new-events (delq nil new-events)))
(append new-events unread-command-events)))
;; XEmacs
(setq
unread-command-events
(append
(cond ((viper-characterp arg) (list (character-to-event arg)))
((eventp arg) (list arg))
((stringp arg) (mapcar 'character-to-event arg))
((vectorp arg) (append arg nil)) ; turn into list
((listp arg) (viper-eventify-list-xemacs arg))
(t (error
"viper-set-unread-command-events: Invalid argument, %S" arg)))
unread-command-events))))
;; list is assumed to be a list of events of characters
(defun viper-eventify-list-xemacs (lis)
(mapcar
(lambda (elt)
(cond ((viper-characterp elt) (character-to-event elt))
((eventp elt) elt)
(t (error
"viper-eventify-list-xemacs: can't convert to event, %S"
elt))))
lis))
;;; viper-cmd.el ends here

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

@ -1,8 +1,8 @@
;;; viper-ex.el --- functions implementing the Ex commands for Viper
;; Copyright (C) 1994, 1995, 1996, 1997, 1998 Free Software Foundation, Inc.
;; Copyright (C) 1994, 95, 96, 97, 98, 2000, 01, 02 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.sunysb.edu>
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; This file is part of GNU Emacs.
@ -39,6 +39,7 @@
(defvar viper-custom-file-name)
(defvar viper-case-fold-search)
(defvar explicit-shell-file-name)
(defvar compile-command)
;; loading happens only in non-interactive compilation
;; in order to spare non-viperized emacs from being viperized
@ -2016,9 +2017,9 @@ Please contact your system administrator. "
(let ((end (car ex-addresses))
(beg (car (cdr ex-addresses)))
(orig-buf (current-buffer))
(orig-buf-file-name (buffer-file-name))
(orig-buf-name (buffer-name))
(buff-changed-p (buffer-modified-p))
;;(orig-buf-file-name (buffer-file-name))
;;(orig-buf-name (buffer-name))
;;(buff-changed-p (buffer-modified-p))
temp-buf writing-same-file region
file-exists writing-whole-file)
(if (> beg end) (error viper-FirstAddrExceedsSecond))
@ -2072,9 +2073,10 @@ Please contact your system administrator. "
;; create temp buffer for the region
(setq temp-buf (get-buffer-create " *ex-write*"))
(set-buffer temp-buf)
(if viper-xemacs-p
(set-visited-file-name ex-file)
(set-visited-file-name ex-file 'noquerry))
(viper-cond-compile-for-xemacs-or-emacs
(set-visited-file-name ex-file) ; xemacs
(set-visited-file-name ex-file 'noquerry) ; emacs
)
(erase-buffer)
(if (and file-exists ex-append)
(insert-file-contents ex-file))

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

@ -1,8 +1,8 @@
;;; viper-init.el --- some common definitions for Viper
;; Copyright (C) 1997 Free Software Foundation, Inc.
;; Copyright (C) 1997, 98, 99, 2000, 01, 02 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.sunysb.edu>
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; This file is part of GNU Emacs.
@ -37,6 +37,9 @@
(defvar current-input-method)
(defvar default-input-method)
(defvar describe-current-input-method-function)
(defvar bar-cursor)
(defvar default-cursor-type)
(defvar cursor-type)
;; end pacifier
@ -50,10 +53,23 @@
;; Is it Emacs?
(defconst viper-emacs-p (not viper-xemacs-p))
;; Tell whether we are running as a window application or on a TTY
;; This is used to avoid compilation warnings. When emacs/xemacs forms can
;; generate compile time warnings, we use this macro.
;; In this case, the macro will expand into the form that is appropriate to the
;; compiler at hand.
;; Suggested by rms.
(defmacro viper-cond-compile-for-xemacs-or-emacs (xemacs-form emacs-form)
(if (string-match "XEmacs" emacs-version)
xemacs-form emacs-form))
(defsubst viper-device-type ()
(if viper-emacs-p
window-system
(device-type (selected-device))))
(viper-cond-compile-for-xemacs-or-emacs
(device-type (selected-device))
window-system
))
;; in XEmacs: device-type is tty on tty and stream in batch.
(defun viper-window-display-p ()
(and (viper-device-type) (not (memq (viper-device-type) '(tty stream pc)))))
@ -434,15 +450,18 @@ color displays. By default, the delimiters are used only on TTYs."
:group 'viper)
;; XEmacs requires glyphs
(if viper-xemacs-p
(progn
(or (glyphp viper-replace-region-end-delimiter)
(setq viper-replace-region-end-delimiter
(make-glyph viper-replace-region-end-delimiter)))
(or (glyphp viper-replace-region-start-delimiter)
(setq viper-replace-region-start-delimiter
(make-glyph viper-replace-region-start-delimiter)))
))
(viper-cond-compile-for-xemacs-or-emacs
(progn ; xemacs
(or (glyphp viper-replace-region-end-delimiter)
(setq viper-replace-region-end-delimiter
(make-glyph viper-replace-region-end-delimiter)))
(or (glyphp viper-replace-region-start-delimiter)
(setq viper-replace-region-start-delimiter
(make-glyph viper-replace-region-start-delimiter)))
)
nil ; emacs
)
;; These are local marker that must be initialized to nil and moved with
@ -978,7 +997,7 @@ Should be set in `~/.viper' file."
(if viper-xemacs-p
(setq bar-cursor nil)
(setq cursor-type default-cursor-type))
(error)))
(error nil)))
(defun viper-set-insert-cursor-type ()
(if viper-xemacs-p

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

@ -1,8 +1,8 @@
;;; viper-keym.el --- Viper keymaps
;; Copyright (C) 1994, 1995, 1996, 1997 Free Software Foundation, Inc.
;; Copyright (C) 1994, 95, 96, 97, 2000, 01, 02 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.sunysb.edu>
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; This file is part of GNU Emacs.
@ -616,11 +616,14 @@ Arguments: (major-mode viper-state keymap)"
(defun viper-add-keymap (mapsrc mapdst)
"Add contents of mapsrc to mapdst. It is assumed that mapsrc is sparse."
(if viper-xemacs-p
(map-keymap (lambda (key binding) (define-key mapdst key binding))
mapsrc)
(mapcar (lambda (p) (define-key mapdst (vector (car p)) (cdr p)))
(cdr mapsrc))))
(viper-cond-compile-for-xemacs-or-emacs
;; xemacs
(map-keymap (lambda (key binding) (define-key mapdst key binding))
mapsrc)
;; emacs
(mapcar (lambda (p) (define-key mapdst (vector (car p)) (cdr p)))
(cdr mapsrc))
))
(defun viper-modify-keymap (map alist)
"Modifies MAP with bindings specified in the ALIST. The alist has the

24
lisp/emulation/viper-macs.el
View File

@ -1,8 +1,8 @@
;;; viper-macs.el --- functions implementing keyboard macros for Viper
;; Copyright (C) 1994, 1995, 1996, 1997 Free Software Foundation, Inc.
;; Copyright (C) 1994, 95, 96, 97, 2000, 01, 02 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.sunysb.edu>
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; This file is part of GNU Emacs.
@ -855,30 +855,10 @@ name from there."
(error "Wrong type macro component, symbol-or-listp, %S" elt)
macro)))
(defun viper-char-array-p (array)
(eval (cons 'and (mapcar 'viper-characterp array))))
(defun viper-macro-to-events (macro-body)
(vconcat (mapcar 'viper-key-to-emacs-key macro-body)))
;; check if vec is a vector of character symbols
(defun viper-char-symbol-sequence-p (vec)
(and
(sequencep vec)
(eval
(cons 'and
(mapcar (lambda (elt)
(and (symbolp elt) (= (length (symbol-name elt)) 1)))
vec)))))
;; Check if vec is a vector of key-press events representing characters
;; XEmacs only
(defun viper-event-vector-p (vec)
(and (vectorp vec)
(eval (cons 'and (mapcar '(lambda (elt) (if (eventp elt) t)) vec)))))
;;; Reading fast key sequences

62
lisp/emulation/viper-mous.el
View File

@ -1,8 +1,8 @@
;;; viper-mous.el --- mouse support for Viper
;; Copyright (C) 1994, 1995, 1996, 1997 Free Software Foundation, Inc.
;; Copyright (C) 1994, 95, 96, 97, 2001, 02 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.sunysb.edu>
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; This file is part of GNU Emacs.
@ -121,9 +121,10 @@ considered related."
;; Returns window where click occurs
(defun viper-mouse-click-window (click)
(let ((win (if viper-xemacs-p
(event-window click)
(posn-window (event-start click)))))
(let ((win (viper-cond-compile-for-xemacs-or-emacs
(event-window click) ; xemacs
(posn-window (event-start click)) ; emacs
)))
(if (window-live-p win)
win
(error "Click was not over a live window"))))
@ -142,9 +143,10 @@ considered related."
;; Returns position of a click
(defsubst viper-mouse-click-posn (click)
(if viper-xemacs-p
(event-point click)
(posn-point (event-start click))))
(viper-cond-compile-for-xemacs-or-emacs
(event-point click) ; xemacs
(posn-point (event-start click)) ; emacs
))
(defun viper-surrounding-word (count click-count)
@ -317,29 +319,33 @@ See `viper-surrounding-word' for the definition of a word in this case."
;; XEmacs has no double-click events. So, we must simulate.
;; So, we have to simulate event-click-count.
(defun viper-event-click-count (click)
(if viper-xemacs-p
(viper-event-click-count-xemacs click)
(event-click-count click)))
(viper-cond-compile-for-xemacs-or-emacs
(viper-event-click-count-xemacs click) ; xemacs
(event-click-count click) ; emacs
))
;; kind of semaphore for updating viper-current-click-count
(defvar viper-counting-clicks-p nil)
(defun viper-event-click-count-xemacs (click)
(let ((time-delta (- (event-timestamp click)
viper-last-click-event-timestamp))
inhibit-quit)
(while viper-counting-clicks-p
(ignore))
(setq viper-counting-clicks-p t)
(if (> time-delta viper-multiclick-timeout)
(setq viper-current-click-count 0))
(discard-input)
(setq viper-current-click-count (1+ viper-current-click-count)
viper-last-click-event-timestamp (event-timestamp click))
(setq viper-counting-clicks-p nil)
(if (viper-sit-for-short viper-multiclick-timeout t)
viper-current-click-count
0)
))
(viper-cond-compile-for-xemacs-or-emacs
(defun viper-event-click-count-xemacs (click)
(let ((time-delta (- (event-timestamp click)
viper-last-click-event-timestamp))
inhibit-quit)
(while viper-counting-clicks-p
(ignore))
(setq viper-counting-clicks-p t)
(if (> time-delta viper-multiclick-timeout)
(setq viper-current-click-count 0))
(discard-input)
(setq viper-current-click-count (1+ viper-current-click-count)
viper-last-click-event-timestamp (event-timestamp click))
(setq viper-counting-clicks-p nil)
(if (viper-sit-for-short viper-multiclick-timeout t)
viper-current-click-count
0)
))
nil ; emacs
)
(defun viper-mouse-click-search-word (click arg)

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

@ -1,8 +1,8 @@
;;; viper-util.el --- Utilities used by viper.el
;; Copyright (C) 1994, 1995, 1996, 1997 Free Software Foundation, Inc.
;; Copyright (C) 1994, 95, 96, 97, 99, 2000, 01, 02 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.sunysb.edu>
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; This file is part of GNU Emacs.
@ -39,6 +39,7 @@
(defvar ex-unix-type-shell-options)
(defvar viper-ex-tmp-buf-name)
(defvar viper-syntax-preference)
(defvar viper-saved-mark)
(require 'cl)
(require 'ring)
@ -66,48 +67,46 @@
;;; XEmacs support
(if viper-xemacs-p
(progn
(fset 'viper-read-event (symbol-function 'next-command-event))
(fset 'viper-make-overlay (symbol-function 'make-extent))
(fset 'viper-overlay-start (symbol-function 'extent-start-position))
(fset 'viper-overlay-end (symbol-function 'extent-end-position))
(fset 'viper-overlay-put (symbol-function 'set-extent-property))
(fset 'viper-overlay-p (symbol-function 'extentp))
(fset 'viper-overlay-get (symbol-function 'extent-property))
(fset 'viper-move-overlay (symbol-function 'set-extent-endpoints))
(fset 'viper-overlay-live-p (symbol-function 'extent-live-p))
(if (viper-window-display-p)
(fset 'viper-iconify (symbol-function 'iconify-frame)))
(cond ((viper-has-face-support-p)
(fset 'viper-get-face (symbol-function 'get-face))
(fset 'viper-color-defined-p
(symbol-function 'valid-color-name-p))
)))
(fset 'viper-read-event (symbol-function 'read-event))
(fset 'viper-make-overlay (symbol-function 'make-overlay))
(fset 'viper-overlay-start (symbol-function 'overlay-start))
(fset 'viper-overlay-end (symbol-function 'overlay-end))
(fset 'viper-overlay-put (symbol-function 'overlay-put))
(fset 'viper-overlay-p (symbol-function 'overlayp))
(fset 'viper-overlay-get (symbol-function 'overlay-get))
(fset 'viper-move-overlay (symbol-function 'move-overlay))
(fset 'viper-overlay-live-p (symbol-function 'overlayp))
(if (viper-window-display-p)
(fset 'viper-iconify (symbol-function 'iconify-or-deiconify-frame)))
(cond ((viper-has-face-support-p)
(fset 'viper-get-face (symbol-function 'internal-get-face))
(fset 'viper-color-defined-p (symbol-function 'x-color-defined-p))
)))
(viper-cond-compile-for-xemacs-or-emacs
(progn ; xemacs
(fset 'viper-overlay-p (symbol-function 'extentp))
(fset 'viper-make-overlay (symbol-function 'make-extent))
(fset 'viper-overlay-live-p (symbol-function 'extent-live-p))
(fset 'viper-move-overlay (symbol-function 'set-extent-endpoints))
(fset 'viper-overlay-start (symbol-function 'extent-start-position))
(fset 'viper-overlay-end (symbol-function 'extent-end-position))
(fset 'viper-overlay-get (symbol-function 'extent-property))
(fset 'viper-overlay-put (symbol-function 'set-extent-property))
(fset 'viper-read-event (symbol-function 'next-command-event))
(fset 'viper-characterp (symbol-function 'characterp))
(fset 'viper-int-to-char (symbol-function 'int-to-char))
(if (viper-window-display-p)
(fset 'viper-iconify (symbol-function 'iconify-frame)))
(cond ((viper-has-face-support-p)
(fset 'viper-get-face (symbol-function 'get-face))
(fset 'viper-color-defined-p (symbol-function 'valid-color-name-p))
)))
(progn ; emacs
(fset 'viper-overlay-p (symbol-function 'overlayp))
(fset 'viper-make-overlay (symbol-function 'make-overlay))
(fset 'viper-overlay-live-p (symbol-function 'overlayp))
(fset 'viper-move-overlay (symbol-function 'move-overlay))
(fset 'viper-overlay-start (symbol-function 'overlay-start))
(fset 'viper-overlay-end (symbol-function 'overlay-end))
(fset 'viper-overlay-get (symbol-function 'overlay-get))
(fset 'viper-overlay-put (symbol-function 'overlay-put))
(fset 'viper-read-event (symbol-function 'read-event))
(fset 'viper-characterp (symbol-function 'integerp))
(fset 'viper-int-to-char (symbol-function 'identity))
(if (viper-window-display-p)
(fset 'viper-iconify (symbol-function 'iconify-or-deiconify-frame)))
(cond ((viper-has-face-support-p)
(fset 'viper-get-face (symbol-function 'internal-get-face))
(fset 'viper-color-defined-p (symbol-function 'x-color-defined-p))
)))
)
(fset 'viper-characterp
(symbol-function
(if viper-xemacs-p 'characterp 'integerp)))
(fset 'viper-int-to-char
(symbol-function
(if viper-xemacs-p 'int-to-char 'identity)))
;; CHAR is supposed to be a char or an integer (positive or negative)
;; LIST is a list of chars, nil, and negative numbers
@ -133,14 +132,17 @@
(t nil)))
(defsubst viper-color-display-p ()
(if viper-emacs-p
(x-display-color-p)
(eq (device-class (selected-device)) 'color)))
(viper-cond-compile-for-xemacs-or-emacs
(eq (device-class (selected-device)) 'color) ; xemacs
(x-display-color-p) ; emacs
))
(defsubst viper-get-cursor-color ()
(if viper-emacs-p
(cdr (assoc 'cursor-color (frame-parameters)))
(color-instance-name (frame-property (selected-frame) 'cursor-color))))
(viper-cond-compile-for-xemacs-or-emacs
;; xemacs
(color-instance-name (frame-property (selected-frame) 'cursor-color))
(cdr (assoc 'cursor-color (frame-parameters))) ; emacs
))
;; OS/2
@ -154,11 +156,12 @@
(if (and (viper-window-display-p) (viper-color-display-p)
(stringp new-color) (viper-color-defined-p new-color)
(not (string= new-color (viper-get-cursor-color))))
(if viper-emacs-p
(modify-frame-parameters
(selected-frame) (list (cons 'cursor-color new-color)))
(set-frame-property
(selected-frame) 'cursor-color (make-color-instance new-color)))
(viper-cond-compile-for-xemacs-or-emacs
(set-frame-property
(selected-frame) 'cursor-color (make-color-instance new-color))
(modify-frame-parameters
(selected-frame) (list (cons 'cursor-color new-color)))
)
))
;; By default, saves current frame cursor color in the
@ -824,14 +827,20 @@
)))
(defun viper-check-minibuffer-overlay ()
(or (viper-overlay-p viper-minibuffer-overlay)
(setq viper-minibuffer-overlay
(if viper-xemacs-p
(viper-make-overlay 1 (1+ (buffer-size)) (current-buffer))
;; make overlay open-ended
(viper-make-overlay
1 (1+ (buffer-size)) (current-buffer) nil 'rear-advance)))
))
(if (viper-overlay-live-p viper-minibuffer-overlay)
(viper-move-overlay
viper-minibuffer-overlay
(if (fboundp 'minibuffer-prompt-end) (minibuffer-prompt-end) 1)
(1+ (buffer-size)))
(setq viper-minibuffer-overlay
(if viper-xemacs-p
(viper-make-overlay 1 (1+ (buffer-size)) (current-buffer))
;; make overlay open-ended
(viper-make-overlay
(if (fboundp 'minibuffer-prompt-end) (minibuffer-prompt-end) 1)
(1+ (buffer-size))
(current-buffer) nil 'rear-advance)))
))
(defsubst viper-is-in-minibuffer ()
@ -843,10 +852,12 @@
;;; XEmacs compatibility
(defun viper-abbreviate-file-name (file)
(if viper-emacs-p
(abbreviate-file-name file)
;; XEmacs requires addl argument
(abbreviate-file-name file t)))
(viper-cond-compile-for-xemacs-or-emacs
;; XEmacs requires addl argument
(abbreviate-file-name file t)
;; emacs
(abbreviate-file-name file)
))
;; Sit for VAL milliseconds. XEmacs doesn't support the millisecond arg
;; in sit-for, so this function smoothes out the differences.
@ -871,9 +882,10 @@
(and (<= pos (point-max)) (<= (point-min) pos))))))
(defsubst viper-mark-marker ()
(if viper-xemacs-p
(mark-marker t)
(mark-marker)))
(viper-cond-compile-for-xemacs-or-emacs
(mark-marker t) ; xemacs
(mark-marker) ; emacs
))
;; like (set-mark-command nil) but doesn't push twice, if (car mark-ring)
;; is the same as (mark t).
@ -886,13 +898,16 @@
;; highlighted due to Viper's pushing marks. So, we deactivate marks, unless
;; the user explicitly wants highlighting, e.g., by hitting '' or ``
(defun viper-deactivate-mark ()
(if viper-xemacs-p
(zmacs-deactivate-region)
(deactivate-mark)))
(viper-cond-compile-for-xemacs-or-emacs
(zmacs-deactivate-region)
(deactivate-mark)
))
(defsubst viper-leave-region-active ()
(if viper-xemacs-p
(setq zmacs-region-stays t)))
(viper-cond-compile-for-xemacs-or-emacs
(setq zmacs-region-stays t)
nil
))
;; Check if arg is a valid character for register
;; TYPE is a list that can contain `letter', `Letter', and `digit'.
@ -911,27 +926,61 @@
(defsubst viper-events-to-keys (events)
(cond (viper-xemacs-p (events-to-keys events))
(t events)))
(viper-cond-compile-for-xemacs-or-emacs
(events-to-keys events) ; xemacs
events ; emacs
))
;; it is suggested that an event must be copied before it is assigned to
;; last-command-event in XEmacs
(defun viper-copy-event (event)
(if viper-xemacs-p
(copy-event event)
event))
(viper-cond-compile-for-xemacs-or-emacs
(copy-event event) ; xemacs
event ; emacs
))
;; Uses different timeouts for ESC-sequences and others
(defsubst viper-fast-keysequence-p ()
(not (viper-sit-for-short
(if (viper-ESC-event-p last-input-event)
viper-ESC-keyseq-timeout
viper-fast-keyseq-timeout)
t)))
;; like read-event, but in XEmacs also try to convert to char, if possible
(defun viper-read-event-convert-to-char ()
(let (event)
(if viper-emacs-p
(read-event)
(setq event (next-command-event))
(or (event-to-character event)
event))
(viper-cond-compile-for-xemacs-or-emacs
(progn
(setq event (next-command-event))
(or (event-to-character event)
event))
(read-event)
)
))
;; Viperized read-key-sequence
(defun viper-read-key-sequence (prompt &optional continue-echo)
(let (inhibit-quit event keyseq)
(setq keyseq (read-key-sequence prompt continue-echo))
(setq event (if viper-xemacs-p
(elt keyseq 0) ; XEmacs returns vector of events
(elt (listify-key-sequence keyseq) 0)))
(if (viper-ESC-event-p event)
(let (unread-command-events)
(viper-set-unread-command-events keyseq)
(if (viper-fast-keysequence-p)
(let ((viper-vi-global-user-minor-mode nil)
(viper-vi-local-user-minor-mode nil)
(viper-replace-minor-mode nil) ; actually unnecessary
(viper-insert-global-user-minor-mode nil)
(viper-insert-local-user-minor-mode nil))
(setq keyseq (read-key-sequence prompt continue-echo)))
(setq keyseq (read-key-sequence prompt continue-echo)))))
keyseq))
;; This function lets function-key-map convert key sequences into logical
;; keys. This does a better job than viper-read-event when it comes to kbd
;; macros, since it enables certain macros to be shared between X and TTY modes
@ -954,44 +1003,45 @@
(defun viper-event-key (event)
(or (and event (eventp event))
(error "viper-event-key: Wrong type argument, eventp, %S" event))
(when (cond (viper-xemacs-p (or (key-press-event-p event)
(mouse-event-p event)))
(t t))
(when (viper-cond-compile-for-xemacs-or-emacs
(or (key-press-event-p event) (mouse-event-p event)) ; xemacs
t ; emacs
)
(let ((mod (event-modifiers event))
basis)
(setq basis
(cond
(viper-xemacs-p
(cond ((key-press-event-p event)
(event-key event))
((button-event-p event)
(concat "mouse-" (prin1-to-string (event-button event))))
(t
(error "viper-event-key: Unknown event, %S" event))))
(t
;; Emacs doesn't handle capital letters correctly, since
;; \S-a isn't considered the same as A (it behaves as
;; plain `a' instead). So we take care of this here
(cond ((and (viper-characterp event) (<= ?A event) (<= event ?Z))
(setq mod nil
event event))
;; Emacs has the oddity whereby characters 128+char
;; represent M-char *if* this appears inside a string.
;; So, we convert them manually to (meta char).
((and (viper-characterp event)
(< ?\C-? event) (<= event 255))
(setq mod '(meta)
event (- event ?\C-? 1)))
((and (null mod) (eq event 'return))
(setq event ?\C-m))
((and (null mod) (eq event 'space))
(setq event ?\ ))
((and (null mod) (eq event 'delete))
(setq event ?\C-?))
((and (null mod) (eq event 'backspace))
(setq event ?\C-h))
(t (event-basic-type event)))
)))
(viper-cond-compile-for-xemacs-or-emacs
;; XEmacs
(cond ((key-press-event-p event)
(event-key event))
((button-event-p event)
(concat "mouse-" (prin1-to-string (event-button event))))
(t
(error "viper-event-key: Unknown event, %S" event)))
;; Emacs doesn't handle capital letters correctly, since
;; \S-a isn't considered the same as A (it behaves as
;; plain `a' instead). So we take care of this here
(cond ((and (viper-characterp event) (<= ?A event) (<= event ?Z))
(setq mod nil
event event))
;; Emacs has the oddity whereby characters 128+char
;; represent M-char *if* this appears inside a string.
;; So, we convert them manually to (meta char).
((and (viper-characterp event)
(< ?\C-? event) (<= event 255))
(setq mod '(meta)
event (- event ?\C-? 1)))
((and (null mod) (eq event 'return))
(setq event ?\C-m))
((and (null mod) (eq event 'space))
(setq event ?\ ))
((and (null mod) (eq event 'delete))
(setq event ?\C-?))
((and (null mod) (eq event 'backspace))
(setq event ?\C-h))
(t (event-basic-type event)))
) ; viper-cond-compile-for-xemacs-or-emacs
)
(if (viper-characterp basis)
(setq basis
(if (viper= basis ?\C-?)
@ -1046,6 +1096,77 @@
))
;; LIS is assumed to be a list of events of characters
(defun viper-eventify-list-xemacs (lis)
(mapcar
(lambda (elt)
(cond ((viper-characterp elt) (character-to-event elt))
((eventp elt) elt)
(t (error
"viper-eventify-list-xemacs: can't convert to event, %S"
elt))))
lis))
;; Smoothes out the difference between Emacs' unread-command-events
;; and XEmacs unread-command-event. Arg is a character, an event, a list of
;; events or a sequence of keys.
;;
;; Due to the way unread-command-events in Emacs (not XEmacs), a non-event
;; symbol in unread-command-events list may cause Emacs to turn this symbol
;; into an event. Below, we delete nil from event lists, since nil is the most
;; common symbol that might appear in this wrong context.
(defun viper-set-unread-command-events (arg)
(if viper-emacs-p
(setq
unread-command-events
(let ((new-events
(cond ((eventp arg) (list arg))
((listp arg) arg)
((sequencep arg)
(listify-key-sequence arg))
(t (error
"viper-set-unread-command-events: Invalid argument, %S"
arg)))))
(if (not (eventp nil))
(setq new-events (delq nil new-events)))
(append new-events unread-command-events)))
;; XEmacs
(setq
unread-command-events
(append
(cond ((viper-characterp arg) (list (character-to-event arg)))
((eventp arg) (list arg))
((stringp arg) (mapcar 'character-to-event arg))
((vectorp arg) (append arg nil)) ; turn into list
((listp arg) (viper-eventify-list-xemacs arg))
(t (error
"viper-set-unread-command-events: Invalid argument, %S" arg)))
unread-command-events))))
;; Check if vec is a vector of key-press events representing characters
;; XEmacs only
(defun viper-event-vector-p (vec)
(and (vectorp vec)
(eval (cons 'and (mapcar '(lambda (elt) (if (eventp elt) t)) vec)))))
;; check if vec is a vector of character symbols
(defun viper-char-symbol-sequence-p (vec)
(and
(sequencep vec)
(eval
(cons 'and
(mapcar (lambda (elt)
(and (symbolp elt) (= (length (symbol-name elt)) 1)))
vec)))))
(defun viper-char-array-p (array)
(eval (cons 'and (mapcar 'viper-characterp array))))
;; Args can be a sequence of events, a string, or a Viper macro. Will try to
;; convert events to keys and, if all keys are regular printable
;; characters, will return a string. Otherwise, will return a string
@ -1071,21 +1192,14 @@
(t (prin1-to-string event-seq)))))
(defun viper-key-press-events-to-chars (events)
(mapconcat (if viper-emacs-p
'char-to-string
(lambda (elt) (char-to-string (event-to-character elt))))
(mapconcat (viper-cond-compile-for-xemacs-or-emacs
(lambda (elt) (char-to-string (event-to-character elt))) ; xemacs
'char-to-string ; emacs
)
events
""))
;; Uses different timeouts for ESC-sequences and others
(defsubst viper-fast-keysequence-p ()
(not (viper-sit-for-short
(if (viper-ESC-event-p last-input-event)
viper-ESC-keyseq-timeout
viper-fast-keyseq-timeout)
t)))
(defun viper-read-char-exclusive ()
(let (char
(echo-keystrokes 1))

37
lisp/emulation/viper.el
View File

@ -3,12 +3,12 @@
;; and a venomous VI PERil.
;; Viper Is also a Package for Emacs Rebels.
;; Copyright (C) 1994, 95, 96, 97, 98, 99, 2000, 01 Free Software Foundation, Inc.
;; Copyright (C) 1994, 95, 96, 97, 98, 99, 2000, 01, 02 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.sunysb.edu>
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; Keywords: emulations
(defconst viper-version "3.11.1 of September 9, 2001"
(defconst viper-version "3.11.2 of January 4, 2002"
"The current version of Viper")
;; This file is part of GNU Emacs.
@ -353,9 +353,6 @@ user decide when to invoke Viper in a major mode."
;; Non-viper variables that need to be saved in case the user decides to
;; de-viperize emacs.
(defvar viper-saved-non-viper-variables nil)
;; Contains user settings for vars affected by viper-set-expert-level function.
;; Not a user option.
(defvar viper-saved-user-settings nil)
(defcustom viper-mode (cond (noninteractive nil)
(t 'ask))
@ -1056,26 +1053,6 @@ remains buffer-local."
) ; end viper-non-hook-settings
;; Viperized read-key-sequence
(defun viper-read-key-sequence (prompt &optional continue-echo)
(let (inhibit-quit event keyseq)
(setq keyseq (read-key-sequence prompt continue-echo))
(setq event (if viper-xemacs-p
(elt keyseq 0) ; XEmacs returns vector of events
(elt (listify-key-sequence keyseq) 0)))
(if (viper-ESC-event-p event)
(let (unread-command-events)
(viper-set-unread-command-events keyseq)
(if (viper-fast-keysequence-p)
(let ((viper-vi-global-user-minor-mode nil)
(viper-vi-local-user-minor-mode nil)
(viper-replace-minor-mode nil) ; actually unnecessary
(viper-insert-global-user-minor-mode nil)
(viper-insert-local-user-minor-mode nil))
(setq keyseq (read-key-sequence prompt continue-echo)))
(setq keyseq (read-key-sequence prompt continue-echo)))))
keyseq))
;; Ask only if this-command/last-command are nil, i.e., when loading
@ -1122,14 +1099,6 @@ These two lines must come in the order given.
;; Get viper standard value of SYMBOL. If symbol is customized, get its
;; standard value. Otherwise, get the value saved in the alist STORAGE. If
;; STORAGE is nil, use viper-saved-user-settings.
(defun viper-standard-value (symbol &optional storage)
(or (eval (car (get symbol 'customized-value)))
(eval (car (get symbol 'saved-value)))
(nth 1 (assoc symbol (or storage viper-saved-user-settings)))))
;; save non-viper vars that Viper might change

48
man/ediff.texi
View File

@ -30,7 +30,7 @@
This file documents Ediff, a comprehensive visual interface to Unix diff
and patch utilities.
Copyright 1995, 1996, 1997, 1998, 1999, 2000, 2001 Free Software Foundation, Inc.
Copyright 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002 Free Software Foundation, Inc.
Permission is granted to copy, distribute and/or modify this document
under the terms of the GNU Free Documentation License, Version 1.1 or
@ -54,16 +54,16 @@ license to the document, as described in section 6 of the license.
@titlepage
@title Ediff User's Manual
@sp 4
@subtitle Ediff version 2.70
@subtitle Ediff version 2.76.1
@sp 1
@subtitle March 1998
@subtitle January 2002
@sp 5
@author Michael Kifer
@page
@vskip 0pt plus 1filll
@noindent
Copyright @copyright{} 1995, 1996, 1997, 1998, 1999, 2000, 2001 Free Software Foundation, Inc.
Copyright @copyright{} 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002 Free Software Foundation, Inc.
Permission is granted to copy, distribute and/or modify this document
under the terms of the GNU Free Documentation License, Version 1.1 or
@ -225,11 +225,16 @@ Compare windows line-by-line.
@item ediff-regions-wordwise
@findex ediff-regions-wordwise
Compare regions word-by-word.
Compare regions word-by-word. The regions can come from the same buffer
and they can even overlap. You will be asked to specify the buffers that
contain the regions, which you want to compare. For each buffer, you will
also be asked to mark the regions to be compared. Pay attention to the
messages that appear in the minibuffer.
@item ediff-regions-linewise
@findex ediff-regions-linewise
Compare regions line-by-line.
Similar to @code{ediff-windows-linewise}, but compares the regions
line-by-line. See @code{ediff-windows-linewise} for more details.
@item ediff-revision
@findex ediff-revision
@ -384,15 +389,14 @@ On a color display, fine differences are highlighted with color; on a
monochrome display, they are underlined. @xref{Highlighting Difference
Regions}, for information on how to customize this.
The functions @code{ediff-windows-wordwise},
The commands @code{ediff-windows-wordwise},
@code{ediff-windows-linewise}, @code{ediff-regions-wordwise} and
@code{ediff-regions-linewise} do comparison on parts of existing Emacs
buffers. Since @code{ediff-windows-wordwise} and
buffers. The commands @code{ediff-windows-wordwise} and
@code{ediff-regions-wordwise} are intended for relatively small segments
of buffers, comparison is done on the basis of words rather than lines.
No refinement is necessary in this case. These commands are recommended
only for relatively small regions (perhaps, up to 100 lines), because
these functions have a relatively slow startup.
of buffers (e.g., up to 100 lines, depending on the speed of your machine),
as they perform comparison on the basis of words rather than lines.
(Word-wise comparison of large chunks of text can be slow.)
To compare large regions, use @code{ediff-regions-linewise}. This
command displays differences much like @code{ediff-files} and
@ -949,6 +953,21 @@ This function can also be invoked from the Menubar. However, in some
cases, the change will take place only after you execute one of the Ediff
commands, such as going to the next difference or redisplaying.
@item ediff-toggle-use-toolbar
@findex ediff-toggle-use-toolbar
Available in XEmacs only. The Ediff toolbar provides quick access to some
of the common Ediff functions. This function toggles the display of the
toolbar. If invoked from the menubar, the function may take sometimes
effect only after you execute an Ediff command, such as going to the next
difference.
@item ediff-use-toolbar-p
@vindex ediff-use-toolbar-p
The use of the toolbar can also be specified via the variable
@code{ediff-use-toolbar-p} (default is @code{t}). This variable can be set
only in @file{.emacs} --- do @strong{not} change it interactively. Use the
function @code{ediff-toggle-use-toolbar} instead.
@item ediff-revert-buffers-then-recompute-diffs
@findex ediff-revert-buffers-then-recompute-diffs
This command reverts the buffers you are comparing and recomputes their
@ -2347,7 +2366,7 @@ control buffer is in its own frame.
@node Credits, Index, Customization, Top
@chapter Credits
Ediff was written by Michael Kifer <kifer@@cs.sunysb.edu>. It was inspired
Ediff was written by Michael Kifer <kifer@@cs.stonybrook.edu>. It was inspired
by emerge.el written by Dale R.@: Worley <drw@@math.mit.edu>. An idea due to
Boris Goldowsky <boris@@cs.rochester.edu> made it possible to highlight
fine differences in Ediff buffers. Alastair Burt <burt@@dfki.uni-kl.de>
@ -2396,7 +2415,6 @@ Karl Heuer (kwzh@@gnu.org),
(jaffe@@chipmunk.cita.utoronto.ca),
David Karr (dkarr@@nmo.gtegsc.com),
Norbert Kiesel (norbert@@i3.informatik.rwth-aachen.de),
Sam Steingold (sds@@goems.com),
Leigh L Klotz (klotz@@adoc.xerox.com),
Fritz Knabe (Fritz.Knabe@@ecrc.de),
Heinz Knutzen (hk@@informatik.uni-kiel.d400.de),
@ -2406,6 +2424,7 @@ Ken Laprade (laprade@@dw3f.ess.harris.com),
Will C Lauer (wcl@@cadre.com),
Richard Levitte (levitte@@e.kth.se),
Mike Long (mike.long@@analog.com),
Dave Love (d.love@@dl.ac.uk),
Martin Maechler (maechler@@stat.math.ethz.ch),
Simon Marshall (simon@@gnu.org),
Paul C. Meuse (pmeuse@@delcomsys.com),
@ -2432,6 +2451,7 @@ Vin Shelton (acs@@xemacs.org),
Scott O. Sherman (Scott.Sherman@@mci.com),
Richard Stallman (rms@@gnu.org),
Richard Stanton (stanton@@haas.berkeley.edu),
Sam Steingold (sds@@goems.com),
Ake Stenhoff (etxaksf@@aom.ericsson.se),
Stig (stig@@hackvan.com),
Peter Stout (Peter_Stout@@cs.cmu.edu),

119
man/viper.texi
View File

@ -20,7 +20,7 @@
@titlepage
@title Viper Is a Package for Emacs Rebels
@subtitle a Vi emulator for Emacs
@subtitle October 2000, Viper Version 3.09
@subtitle January 2002, Viper Version 3.11.2
@author Michael Kifer (Viper)
@author Aamod Sane (VIP 4.4)
@ -33,7 +33,7 @@
@unnumbered Distribution
@noindent
Copyright @copyright{} 1995, 1996, 1997, 2001 Free Software Foundation, Inc.
Copyright @copyright{} 1995, 1996, 1997, 2001, 2002 Free Software Foundation, Inc.
Permission is granted to copy, distribute and/or modify this document
under the terms of the GNU Free Documentation License, Version 1.1 or
@ -58,7 +58,7 @@ license to the document, as described in section 6 of the license.
@unnumbered Viper
We believe that one or more of the following statements are adequate
descriptions:
descriptions of Viper:
@example
Viper Is a Package for Emacs Rebels;
@ -80,7 +80,7 @@ new features of Viper.
Viper, formerly known as VIP-19, was written by Michael Kifer. It is based
on VIP version 3.5 by Masahiko Sato and VIP version 4.4 by Aamod Sane.
Viper tries to be compatible with these packages.
About 15% of the code still comes from those older packages.
Viper is intended to be usable without reading this manual --- the defaults
are set to make Viper as close to Vi as possible. At startup, Viper will
@ -89,19 +89,19 @@ your familiarity with Emacs. It will also tell you the basic GNU Emacs window
management commands to help you start immediately.
Although this manual explains how to customize Viper, some basic
familiarity with Emacs Lisp would be a plus.
familiarity with Emacs Lisp is a plus.
It is recommended that you read the Overview node. The other nodes may
be visited as needed.
Comments and bug reports are welcome.
@code{kifer@@cs.sunysb.edu} is the current address for Viper bug reports.
@code{kifer@@cs.stonybrook.edu} is the current address for Viper bug reports.
Please use the Ex command @kbd{:submitReport} for this purpose.@refill
@end ifinfo
@menu
* Overview:: Must read to get started
* Overview:: Read for a smoother start
* Improvements over Vi:: New features, Improvements
* Customization:: How to customize Viper
* Commands:: Vi and Ex Commands
@ -118,7 +118,7 @@ Please use the Ex command @kbd{:submitReport} for this purpose.@refill
@unnumbered Introduction
We believe that one or more of the following statements are adequate
descriptions:
descriptions of Viper:
@example
Viper Is a Package for Emacs Rebels;
@ -134,8 +134,8 @@ This manual describes Viper, concentrating on the differences from Vi
and on the new features of Viper.
Viper was written by Michael Kifer. It is based on VIP version 3.5 by
Masahiko Sato and VIP version 4.4 by Aamod Sane. Viper tries to be
compatible with these packages.
Masahiko Sato and VIP version 4.4 by Aamod Sane. About 15% of the code
still comes from those older packages.
Viper is intended to be usable out of the box, without reading this manual
--- the defaults are set to make Viper as close to Vi as possible. At
@ -144,7 +144,7 @@ for you, based on your familiarity with Emacs. It will also tell you the
basic GNU Emacs window management commands to help you start immediately.
Although this manual explains how to customize Viper, some basic
familiarity with Emacs Lisp would be a plus.
familiarity with Emacs Lisp is a plus.
It is recommended that you read the chapter Overview. The other chapters
will be useful for customization and advanced usage.
@ -154,7 +154,7 @@ comes with Emacs. This manual can be read as an Info file. Try the command
@kbd{@key{ESC} x info} with vanilla Emacs sometime.
Comments and bug reports are welcome.
@code{kifer@@cs.sunysb.edu} is the current address for Viper bug reports.
@code{kifer@@cs.stonybrook.edu} is the current address for Viper bug reports.
Please use the Ex command @kbd{:submitReport} for this purpose.@refill
@end iftex
@ -179,12 +179,9 @@ enables additional Emacs bindings under Viper. These customizations can be
included in your @file{~/.viper} file and are found at the following URL:
@file{http://www.eecs.umich.edu/~jshawkin/viper-sample}.
Viper was formerly known as VIP-19, which was
a descendant of VIP 3.5 by Masahiko Sato and VIP 4.4 by Aamod Sane.
@menu
* Emacs Preliminaries:: Basic concepts in Emacs.
* Loading Viper:: Loading and Preliminary Configuration.
* Loading Viper:: Loading and Preliminary Configuration.
* States in Viper:: Viper has four states orthogonal to Emacs
modes.
* The Minibuffer:: Command line in Emacs.
@ -339,14 +336,6 @@ version 20.0, Emacsen have an interactive interface, which simplifies the
job of customization significantly.
Viper also uses the file @file{~/.viper} for Viper-specific customization.
If you wish to be in Vi command state whenever this is deemed appropriate
by the author, you can include the following line in your @file{.viper}:
@lisp
(setq viper-always t)
@end lisp
@noindent
(@xref{Vi State}, for the explanation of Vi command state.)
The location of Viper customization file can be changed by setting the
variable @code{viper-custom-file-name} in @file{.emacs} @emph{prior} to loading
Viper.
@ -362,8 +351,8 @@ whenever this makes sense.
@xref{Packages that Change Keymaps}, to find out when forcing Vi command state
on a buffer may be counter-productive.
Even if your @file{.emacs} and @file{.viper} files do not contain any of the
above lines, you can still load Viper and enter Vi command state by typing the
Even if your @file{.emacs} file does not invoke Viper automatically,
you can still load Viper and enter the Vi command state by typing the
following from within Emacs:
@lisp
@ -378,7 +367,7 @@ editing files by using @kbd{:e}, @kbd{:vi}, or @kbd{v} commands.
new commands that, in many cases, are more convenient than @kbd{:e},
@kbd{:vi}, and similar old-style Vi commands.)@refill
Finally, if at some point you would want to get de-Viperize your running
Finally, if at some point you would want to de-Viperize your running
copy of Emacs after Viper has been loaded, the command @kbd{M-x
viper-go-away} will do it for you. The function @code{toggle-viper-mode}
toggles Viperization of Emacs on and off.
@ -476,7 +465,7 @@ Insert state, you cannot do many interesting things, like language
sensitive editing. For the novice user (at Viper level 1), all major mode
bindings are turned off in Vi state as well. This includes the bindings for
key sequences that start with @kbd{C-c}, which practically means that all
major mode bindings are supported. @xref{Customization}, to find out how
major mode bindings are unsupported. @xref{Customization}, to find out how
to allow Emacs keys in Insert state.
@menu
@ -571,7 +560,8 @@ Viper uses @key{ESC} as a switch between Insert and Vi states. Emacs uses
functions are accessible only via that key as @kbd{M-x function-name}.
Therefore, we need to simulate it somehow. In Viper's Vi, Insert, and
Replace states, the meta key is set to be @kbd{C-\}. Thus, to get
@kbd{M-x}, you should type @kbd{C-\ x} (if the keyboard has no Meta key).
@kbd{M-x}, you should type @kbd{C-\ x} (if the keyboard has no Meta key,
which is rare these days).
This works both in the Vi command state and in the Insert and Replace
states. In Vi command state, you can also use @kbd{\ @key{ESC}} as the
meta key.
@ -900,9 +890,9 @@ Unimplemented features include:
@itemize @bullet
@item
@kbd{:ab} and @kbd{:una} are not implemented.
Both @kbd{:map} and @kbd{:ab} are considered obsolete, since Emacs has much
more powerful facilities for defining keyboard macros and abbreviations.
@kbd{:ab} and @kbd{:una} are not implemented, since
@kbd{:ab} is considered obsolete, since Emacs has much
more powerful facilities for defining abbreviations.
@item
@kbd{:set option?} is not implemented. The current
@kbd{:set} can also be used to set Emacs variables.
@ -1202,7 +1192,8 @@ will have to change @code{viper-search-face} to your liking. The easiest
way to do this is to use Emacs customization widget, which is accessible
from the menubar. Viper customization group is located under the
@emph{Emulations} customization group, which in turn is under the
@emph{Editing} group. All Viper faces are grouped together under Viper's
@emph{Editing} group (or simply by typing @kbd{:customize}). All Viper
faces are grouped together under Viper's
@emph{Highlighting} group.
Try it: it is really simple!
@ -1583,28 +1574,30 @@ Customization can be done in 2 ways.
@cindex .viper
Elisp code in a @file{.viper} file in your home directory. Viper
loads @file{.viper} just before it does the binding for mode
hooks. This is the recommended method.
hooks. This is recommended for experts only.
@item
@cindex .emacs
Elisp code in your @file{.emacs} file before and after the @code{(require
'viper)} line. This method is not recommended, unless you know what you are
doing. Only two variables, @code{viper-mode} and
@code{viper-custom-file-name} are supposed to be customized in @file{.emacs},
prior to loading Viper.@refill
@end itemize
@noindent
Most of Viper's behavior can be customized via the interactive Emacs user
interface. Choose "Customize" from the menubar, click on "Editing", then on
"Emulations". The customization widget is self-explanatory. Once you are
satisfied with your changes, save them into a file and then include the
contents of that file in the Viper customization repository, @file{.viper}
(except for @code{viper-mode} and @code{viper-custom-file-name}, which are
supposed to go into @code{.emacs}).
'viper)} line. This method is @emph{not} recommended, unless you know what
you are doing. Only two variables, @code{viper-mode} and
@code{viper-custom-file-name}, are supposed to be customized in @file{.emacs},
prior to loading Viper (i.e., prior to @code{(require 'viper)} command.@refill
@item
@cindex :customize
By executing the @kbd{:customize} Ex command. This takes you to the Emacs
customization widget, which lets you change the values of Viper
customizable variables easily. This method is good for novice and
experts alike. The customization code in the form of Lisp commands will be
placed in @file{~/.emacs} or some other customization file depending on the
version of Emacs that you use. Still, it is recommended to separate
Viper-related customization produced by the Emacs customization widget
and keep in in the @file{.viper} file.
Some advanced customization cannot be accomplished this way, however, and
has to be done in Emacs Lisp. For the common cases, examples are provided
that you can use directly.
has to be done in Emacs Lisp in the @file{.viper} file. For the common
cases, examples are provided that you can use directly.
@end itemize
@menu
* Rudimentary Changes:: Simple constant definitions.
@ -2002,8 +1995,8 @@ so you can just type
@end lisp
@noindent
to bind L1 so it will invoke the Emacs Calendar and to bind L4 so it will
undo changes.
to bind L1 (a key that exists on some SUN workstations) so it will invoke
the Emacs Calendar and to bind L4 so it will undo changes.
However, on a dumb terminal or in an Xterm window, even the standard arrow
keys may
not emit the right signals for Emacs to understand. To let Emacs know about
@ -2144,9 +2137,9 @@ buffer switches to some other Viper state and then back to Emacs state). To
avoid this, one should add @code{viper-change-state-to-emacs} to an
appropriate hook of that major mode. (Check the function
@code{viper-set-hooks} in @file{viper.el} for examples.) However, if you
have set @code{viper-always} to @code{t}, chances are that you won't need to
perform the above procedure, because Viper will take care of most useful
defaults.
did not set @code{viper-always} to @code{nil}, chances are that you won't
need to perform the above procedure, because Viper will take care of most
useful defaults.
Finally, Viper has a facility that lets the user define per-buffer
@ -2224,7 +2217,8 @@ means that bindings set by those modes are generally available with Viper
(unless you explicitly prohibit them by setting
@code{viper-want-emacs-keys-in-vi} and @code{viper-want-emacs-keys-in-insert} to
@code{nil}).
If @code{viper-always} is set to @code{t}, Viper will try to bring each buffer
If @code{viper-always} is set to @code{t} (which is the default), Viper
will try to bring each buffer
in the Viper state that is most appropriate for that buffer.
Usually, this would be the Vi state, but sometimes it could be the Insert
state or the Emacs state.
@ -2611,8 +2605,7 @@ command in @code{~/.viper} after setting @code{viper-mouse-search-key}:
@end lisp
You can also change this setting interactively, through the customization
widget of Emacs (choose option "Customize.Customize Group" from the
menubar).
widget of Emacs (type @kbd{:customize}).
The region that is chosen as a pattern to search for is determined as
follows. If search is invoked via a single click, Viper chooses the region
@ -2727,7 +2720,8 @@ register (a lowercase letter); such macros can then be executed by typing
If, however, you need to use a macro regularly, it must be given a
permanent name and saved. Emacs manual explains how to do this, but
invocation of named Emacs macros is quite different from Vi's. First,
invocation of permanent Emacs macros takes time because of the extra keys.
invocation of permanent Emacs macros takes time because it requires typing
too many keys (to a Vi user's taste, anyway).
Second, binding such macros to function keys, for
fast access, hogs valuable real estate on the keyboard.
@ -2735,8 +2729,9 @@ Vi-style macros are better in that respect, since Vi lets the user overload
the meaning of key sequences: keys typed in fast succession are treated
specially, if this key sequence is bound to a macro.
Viper provides keyboard macros through the usual Ex commands, @kbd{:map} and
@kbd{:map!}. Vi-style macros are much more powerful in Viper than
Viper provides Vi-style keyboard macros through the usual Ex commands,
@kbd{:map} and
@kbd{:map!}. These macros are much more powerful in Viper than
they are in the original Vi and in other emulators. This is because Viper
implements an enhanced vi-style
interface to the powerful Emacs keyboard macro facility.
@ -4481,7 +4476,7 @@ martin@@xemacs.org (Martin Buchholz),
mbutler@@redfernnetworks.com (Malcolm Butler),
mveiga@@dit.upm.es (Marcelino Veiga Tuimil),
paulk@@summit.esg.apertus.com (Paul Keusemann),
pfister@@cs.sunysb.edu (Hanspeter Pfister),
pfister@@cs.stonybrook.edu (Hanspeter Pfister),
phil_brooks@@MENTORG.COM (Phil Brooks),
pogrell@@informatik.hu-berlin.de (Lutz Pogrell),
pradyut@@cs.uchicago.edu (Pradyut Shah),