mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-01-11 16:08:13 +00:00
Code Issues Releases Activity

*** empty log message ***

Browse Source
This commit is contained in:
Michael Kifer 1996-06-22 01:54:34 +00:00
parent fce30d79b4
commit bbe6126cba
14 changed files with 6819 additions and 2700 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

102
lisp/ediff-diff.el
View File

@ -1,6 +1,6 @@
;;; ediff-diff.el --- diff-related utilities
;; Copyright (C) 1994, 1995 Free Software Foundation, Inc.
;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.sunysb.edu>
@ -28,7 +28,8 @@
(defvar ediff-shell
(cond ((eq system-type 'emx) "cmd") ; OS/2
((eq system-type 'ms-dos) shell-file-name) ; no standard name on MS-DOS
((memq system-type '(ms-dos windows-nt windows-95))
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
@ -63,7 +64,7 @@ Must produce output compatible with Unix's diff3 program.")
(defvar ediff-diff3-options ""
"*Options to pass to `ediff-diff3-program'.")
(defvar ediff-diff3-ok-lines-regexp
"^\\([1-3]:\\|====\\| \\|.*Warning *:\\|.*No newline\\|.*missing newline\\)"
"^\\([1-3]:\\|====\\| \\|.*Warning *:\\|.*No newline\\|.*missing newline\\|^\C-m$\\)"
"*Regexp that matches normal output lines from `ediff-diff3-program'.
Lines that do not match are assumed to be error messages.")
@ -71,18 +72,6 @@ Lines that do not match are assumed to be error messages.")
;; the status can be =diff(A), =diff(B), or =diff(A+B)
(ediff-defvar-local ediff-diff-status "" "")
;; Support for patch
(defvar ediff-patch-program "patch"
"*Name of the program that applies patches.")
(defvar ediff-patch-options ""
"*Options to pass to ediff-patch-program.")
;; The buffer of the patch file.
(defvar ediff-patch-buf nil)
;; The buffer where patch would display its diagnostics.
(defvar ediff-patch-diagnostics nil)
;;; Fine differences
@ -99,13 +88,13 @@ Use `setq-default' if setting it in .emacs")
This variable can be set either in .emacs or toggled interactively.
Use `setq-default' if setting it in .emacs")
(ediff-defvar-local ediff-auto-refine-limit 700
"Auto-refine only those regions that are smaller than this number of bytes.")
(ediff-defvar-local ediff-auto-refine-limit 1400
"*Auto-refine only the regions of this size \(in bytes\) or less.")
;;; General
(defvar ediff-diff-ok-lines-regexp
"^\\([0-9,]+[acd][0-9,]+$\\|[<>] \\|---\\|.*Warning *:\\|.*No newline\\|.*missing newline\\)"
"^\\([0-9,]+[acd][0-9,]+$\\|[<>] \\|---\\|.*Warning *:\\|.*No +newline\\|.*missing +newline\\|^\C-m$\\)"
"Regexp that matches normal output lines from `ediff-diff-program'.
This is mostly lifted from Emerge, except that Ediff also considers
warnings and `Missing newline'-type messages to be normal output.
@ -138,19 +127,47 @@ one optional arguments, diff-number to refine.")
;;; ;; When xemacs implements minibufferless frames, this won't be necessary
;;; (if ediff-xemacs-p (setq synchronize-minibuffers t))
;; create, if it doesn't exist
(or (ediff-buffer-live-p ediff-diff-buffer)
(setq ediff-diff-buffer
(get-buffer-create (ediff-unique-buffer-name "*ediff-diff" "*"))))
(message "Computing differences ...")
(ediff-exec-process ediff-diff-program ediff-diff-buffer 'synchronize
ediff-diff-options file-A file-B)
(ediff-make-diff2-buffer ediff-diff-buffer file-A file-B)
(ediff-prepare-error-list ediff-diff-ok-lines-regexp ediff-diff-buffer)
;;(message "Computing differences ... done")
(ediff-convert-diffs-to-overlays
(ediff-extract-diffs
ediff-diff-buffer ediff-word-mode ediff-narrow-bounds)))
;; fill in DIFF-BUFFER with the output from the diff program run on FILE1 and
;; FILE2
;; Return the length of that buffer.
(defun ediff-make-diff2-buffer (diff-buffer file1 file2)
(cond ((< (ediff-file-size file1) 0)
(message "Can't diff remote files: %s"
(ediff-abbreviate-file-name file1))
(sit-for 2)
;; 1 is an error exit code
1)
((< (ediff-file-size file2) 0)
(message "Can't diff remote file: %s"
(ediff-abbreviate-file-name file2))
(sit-for 2)
(message "")
;; 1 is an error exit code
1)
(t (message "Computing differences between %s and %s ..."
(file-name-nondirectory file1)
(file-name-nondirectory file2))
;; this erases the diff buffer automatically
(ediff-exec-process ediff-diff-program
diff-buffer
'synchronize
ediff-diff-options file1 file2)
;;(message "Computing differences ... done")
(message "")
(ediff-eval-in-buffer diff-buffer
(buffer-size)))))
;; If file-A/B/C is nil, do 2-way comparison with the non-nil buffers
;; This function works for diff3 and diff2 jobs
@ -500,7 +517,7 @@ one optional arguments, diff-number to refine.")
(or n (setq n ediff-current-difference))
(if (< ediff-number-of-differences 1)
(error "Sorry, it is not my job to munch identical variants..."))
(error ediff-NO-DIFFERENCES))
(if ediff-word-mode
(setq flag 'skip
@ -524,7 +541,8 @@ one optional arguments, diff-number to refine.")
(cond ((and (eq flag 'noforce) (ediff-get-fine-diff-vector n 'A))
;; don't compute fine diffs if diff vector exists
(if (ediff-no-fine-diffs-p n)
(ediff-message-if-verbose
;;(ediff-message-if-verbose
(message
"Only white-space differences in region %d" (1+ n))))
;; If one of the regions is empty (or 2 in 3way comparison)
;; then don't refine.
@ -548,16 +566,19 @@ one optional arguments, diff-number to refine.")
(empty-B 'B)
(empty-C 'C)))
)
;; if all regions happen to be whitespace, indicate this
;; if all regions happen to be whitespace
(if (and whitespace-A whitespace-B whitespace-C)
;; mark as space only
(ediff-mark-diff-as-space-only n t)
;; if some regions are white and others don't, then mark as
;; non-white-space-only
(ediff-mark-diff-as-space-only n nil)))
;; don't compute fine diffs for this region
((eq flag 'skip)
(or (ediff-get-fine-diff-vector n 'A)
(memq ediff-auto-refine '(off nix))
(ediff-message-if-verbose
"Region %d exceeds auto-refine limit. `%s' force-refines"
"Region %d exceeds auto-refine limit. Type `%s' to refine"
(1+ n)
(substitute-command-keys
"\\[ediff-make-or-kill-fine-diffs]")
@ -605,20 +626,20 @@ one optional arguments, diff-number to refine.")
((and ediff-3way-job whitespace-B)
(ediff-setup-fine-diff-regions file-A nil file-C n))
((and ediff-3way-job
(or whitespace-C
(and ediff-merge-job
(ediff-looks-like-combined-merge n))))
;; In merge-jobs, whitespace-C is t, since
;; ediff-empty-diff-region-p returns t in this case
whitespace-C)
(ediff-setup-fine-diff-regions file-A file-B nil n))
(t
(ediff-setup-fine-diff-regions file-A file-B file-C n)))
(setq cumulative-fine-diff-length
(+ (length (ediff-get-fine-diff-vector n 'A))
(length (ediff-get-fine-diff-vector n 'B))
(if file-C
(length
(ediff-get-fine-diff-vector n 'C))
0)))
(length (ediff-get-fine-diff-vector n 'B))
;; in merge jobs, the merge buffer is never refined
(if (and file-C (not ediff-merge-job))
(length (ediff-get-fine-diff-vector n 'C))
0)))
(cond ((or
;; all regions are white space
@ -632,7 +653,7 @@ one optional arguments, diff-number to refine.")
(ediff-message-if-verbose
"Only white-space differences in region %d" (1+ n)))
((eq cumulative-fine-diff-length 0)
(ediff-mark-diff-as-space-only n nil)
(ediff-mark-diff-as-space-only n t)
(ediff-message-if-verbose
"Only white-space differences in region %d %s"
(1+ n)
@ -847,7 +868,7 @@ one optional arguments, diff-number to refine.")
;; leave point after matched line
(beginning-of-line 2)
(let ((agreement (buffer-substring (match-beginning 1) (match-end 1))))
;; if the A and B files are the same and not 3way-comparison,
;; if the files A and B are the same and not 3way-comparison,
;; ignore the difference
(if (or three-way-comp (not (string-equal agreement "3")))
(let* ((a-begin (car (ediff-get-diff3-group "1")))
@ -1164,6 +1185,11 @@ argument to `skip-chars-forward'."
(point))))
;;; Local Variables:
;;; eval: (put 'ediff-defvar-local 'lisp-indent-hook 'defun)
;;; eval: (put 'ediff-eval-in-buffer 'lisp-indent-hook 1)
;;; End:
(provide 'ediff-diff)

113
lisp/ediff-hook.el
View File

@ -1,6 +1,6 @@
;;; ediff-hook.el --- setup for Ediff's menus and autoloads
;; Copyright (C) 1995 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.sunysb.edu>
@ -25,10 +25,6 @@
;;; These must be placed in menu-bar.el in Emacs
;;
;; (define-key menu-bar-tools-menu [ediff-doc]
;; '("Ediff Manual..." . ediff-documentation))
;; (define-key menu-bar-tools-menu [eregistry]
;; '("List Ediff Sessions..." . ediff-show-registry))
;; (define-key menu-bar-tools-menu [epatch]
;; '("Apply Patch" . menu-bar-epatch-menu))
;; (define-key menu-bar-tools-menu [ediff-merge]
@ -36,6 +32,11 @@
;; (define-key menu-bar-tools-menu [ediff]
;; '("Compare" . menu-bar-ediff-menu))
;; Compiler pacifier
(defvar ediff-menu)
(defvar ediff-merge-menu)
(defvar epatch-menu)
;; end pacifier
(defun ediff-xemacs-init-menus ()
(if (featurep 'menubar)
@ -46,12 +47,6 @@
'("Tools") ediff-merge-menu "OO-Browser...")
(add-submenu
'("Tools") epatch-menu "OO-Browser...")
(add-menu-button
'("Tools")
["List Ediff Sessions..." ediff-show-registry t] "OO-Browser...")
(add-menu-button
'("Tools")
["Ediff Manual..." ediff-documentation t] "OO-Browser...")
(add-menu-button
'("Tools")
["-------" nil nil] "OO-Browser...")
@ -78,6 +73,9 @@
"---"
["Regions Word-by-word..." ediff-regions-wordwise t]
["Regions Line-by-line..." ediff-regions-linewise t]
"---"
["List Ediff Sessions..." ediff-show-registry t]
["Ediff Manual..." ediff-documentation t]
))
(defvar ediff-merge-menu
'("Merge"
@ -97,11 +95,17 @@
["Directory Revisions..." ediff-merge-directory-revisions t]
["Directory Revisions with Ancestor..."
ediff-merge-directory-revisions-with-ancestor t]
"---"
["List Ediff Sessions..." ediff-show-registry t]
["Ediff Manual..." ediff-documentation t]
))
(defvar epatch-menu
'("Apply Patch"
["To a file..." ediff-patch-file t]
["To a buffer..." ediff-patch-buffer t]
"---"
["List Ediff Sessions..." ediff-show-registry t]
["Ediff Manual..." ediff-documentation t]
))
;; put these menus before Object-Oriented-Browser in Tools menu
@ -122,6 +126,11 @@
(fset 'menu-bar-ediff-menu (symbol-value 'menu-bar-ediff-menu))
;; define ediff-menu
(define-key menu-bar-ediff-menu [ediff-doc]
'("Ediff Manual..." . ediff-documentation))
(define-key menu-bar-ediff-menu [eregistry]
'("List Ediff Sessions..." . ediff-show-registry))
(define-key menu-bar-ediff-menu [separator-ediff-manual] '("--"))
(define-key menu-bar-ediff-menu [window]
'("This Window and Next Window" . compare-windows))
(define-key menu-bar-ediff-menu [ediff-windows-linewise]
@ -154,6 +163,12 @@
'("Two Files..." . ediff-files))
;; define merge menu
(define-key menu-bar-ediff-merge-menu [ediff-doc2]
'("Ediff Manual..." . ediff-documentation))
(define-key menu-bar-ediff-merge-menu [eregistry2]
'("List Ediff Sessions..." . ediff-show-registry))
(define-key
menu-bar-ediff-merge-menu [separator-ediff-merge-manual] '("--"))
(define-key
menu-bar-ediff-merge-menu [ediff-merge-dir-revisions-with-ancestor]
'("Directory Revisions with Ancestor..."
@ -187,6 +202,11 @@
'("Files..." . ediff-merge-files))
;; define epatch menu
(define-key menu-bar-epatch-menu [ediff-doc3]
'("Ediff Manual..." . ediff-documentation))
(define-key menu-bar-epatch-menu [eregistry3]
'("List Ediff Sessions..." . ediff-show-registry))
(define-key menu-bar-epatch-menu [separator-epatch] '("--"))
(define-key menu-bar-epatch-menu [ediff-patch-buffer]
'("To a Buffer..." . ediff-patch-buffer))
(define-key menu-bar-epatch-menu [ediff-patch-file]
@ -202,84 +222,93 @@
(autoload 'ediff "ediff" "Compare two files" t)
(autoload 'ediff-files "ediff" "Compare two files" t)
(autoload 'ediff-buffers "ediff" "Compare two bufers" t)
(autoload 'ebuffers "ediff" "Compare two bufers" t)
(autoload 'ediff3 "ediff" "Compare three files" t)
(autoload 'ediff-files3 "ediff" "Compare three files" t)
(autoload 'ediff-buffers3 "ediff" "Compare three bufers" t)
(autoload 'ebuffers3 "ediff" "Compare three bufers" t)
(autoload 'ediff-revision "ediff" "Compare versions of a file" t)
;; compare regions and windows
(autoload 'ediff-windows-wordwise
"ediff" "Compare two windows word-by-word" t)
"ediff" "Compare two windows word-by-word." t)
(autoload 'ediff-regions-wordwise
"ediff" "Compare two regions word-by-word" t)
"ediff" "Compare two regions word-by-word." t)
(autoload 'ediff-windows-linewise
"ediff" "Compare two windows line-by-line" t)
"ediff" "Compare two windows line-by-line." t)
(autoload 'ediff-regions-linewise
"ediff" "Compare two regions line-by-line" t)
"ediff" "Compare two regions line-by-line." t)
;; patch
(autoload 'ediff-patch-file "ediff" "Patch a file" t)
(autoload 'epatch "ediff" "Patch a file" t)
(autoload 'ediff-patch-buffer "ediff" "Patch a buffer")
(autoload 'epatch-buffer "ediff" "Patch a buffer" t)
(autoload 'ediff-patch-file "ediff" "Patch a file." t)
(autoload 'epatch "ediff" "Patch a file." t)
(autoload 'ediff-patch-buffer "ediff" "Patch a buffer.")
(autoload 'epatch-buffer "ediff" "Patch a buffer." t)
;; merge
(autoload 'ediff-merge "ediff" "Merge two files" t)
(autoload 'ediff-merge-files "ediff" "Merge two files" t)
(autoload 'ediff-merge "ediff" "Merge two files." t)
(autoload 'ediff-merge-files "ediff" "Merge two files." t)
(autoload 'ediff-merge-files-with-ancestor
"ediff" "Merge two files using a third file as an ancestor" t)
(autoload 'ediff-merge-buffers "ediff" "Merge two buffers" t)
"ediff" "Merge two files using a third file as an ancestor." t)
(autoload 'ediff-merge-buffers "ediff" "Merge two buffers." t)
(autoload 'ediff-merge-buffers-with-ancestor
"ediff" "Merge two buffers using a third buffer as an ancestor" t)
"ediff" "Merge two buffers using a third buffer as an ancestor." t)
(autoload 'ediff-merge-revisions "ediff" "Merge two versions of a file" t)
(autoload 'ediff-merge-revisions "ediff" "Merge two versions of a file." t)
(autoload 'ediff-merge-revisions-with-ancestor
"ediff" "Merge two versions of a file" t)
"ediff" "Merge two versions of a file." t)
;; compare directories
(autoload 'edirs "ediff" "Compare files in two directories" t)
(autoload 'ediff-directories "ediff" "Compare files in two directories" t)
(autoload 'edirs3 "ediff" "Compare files in three directories" t)
(autoload 'ediff-directories3 "ediff" "Compare files in three directories" t)
(autoload 'edirs "ediff" "Compare files in two directories." t)
(autoload 'ediff-directories "ediff" "Compare files in two directories." t)
(autoload 'edirs3 "ediff" "Compare files in three directories." t)
(autoload
'ediff-directories3 "ediff" "Compare files in three directories." t)
(autoload 'edir-revisions
"ediff" "Compare two versions of a file" t)
"ediff" "Compare two versions of a file." t)
(autoload 'ediff-directory-revisions
"ediff" "Compare two versions of a file" t)
"ediff" "Compare two versions of a file." t)
;; merge directories
(autoload 'edirs-merge "ediff" "Merge files in two directories" t)
(autoload 'edirs-merge "ediff" "Merge files in two directories." t)
(autoload 'ediff-merge-directories
"ediff" "Merge files in two directories" t)
"ediff" "Merge files in two directories." t)
(autoload 'edirs-merge-with-ancestor
"ediff"
"Merge files in two directories using files in a third dir as ancestors" t)
"Merge files in two directories using files in a third dir as ancestors."
t)
(autoload 'ediff-merge-directories-with-ancestor
"ediff"
"Merge files in two directories using files in a third dir as ancestors" t)
"Merge files in two directories using files in a third dir as ancestors."
t)
(autoload 'edir-merge-revisions
"ediff" "Merge versions of files in a directory" t)
"ediff" "Merge versions of files in a directory." t)
(autoload 'ediff-merge-directory-revisions
"ediff" "Merge versions of files in a directory" t)
"ediff" "Merge versions of files in a directory." t)
(autoload 'ediff-merge-directory-revisions-with-ancestor
"ediff"
"Merge versions of files in a directory using other versions as ancestors"
"Merge versions of files in a directory using other versions as ancestors."
t)
(autoload 'edir-merge-revisions-with-ancestor
"ediff"
"Merge versions of files in a directory using other versions as ancestors"
"Merge versions of files in a directory using other versions as ancestors."
t)
;; misc
(autoload 'ediff-show-registry
"ediff-meta"
"Display the registry of active Ediff sessions"
"Display the registry of active Ediff sessions."
t)
(autoload 'ediff-documentation
"ediff"
"Display Ediff's manual."
t)
(autoload 'ediff-version
"ediff"
"Show Ediff's version and last modification date"
"Show Ediff's version and last modification date."
t)
) ; if purify-flag

130
lisp/ediff-init.el
View File

@ -1,6 +1,6 @@
;;; ediff-init.el --- Macros, variables, and defsubsts used by Ediff
;; Copyright (C) 1994, 1995 Free Software Foundation, Inc.
;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.sunysb.edu>
@ -23,15 +23,33 @@
;;; Code:
;; Start compiler pacifier
(defvar ediff-metajob-name)
(defvar ediff-meta-buffer)
(defvar pm-color-alist)
(defvar ediff-grab-mouse)
(defvar ediff-mouse-pixel-position)
(defvar ediff-mouse-pixel-threshold)
(defvar ediff-whitespace)
(defvar ediff-multiframe)
;; end pacifier
;; Is it XEmacs?
(defconst ediff-xemacs-p (string-match "XEmacs" emacs-version))
;; Is it Emacs?
(defconst ediff-emacs-p (not ediff-xemacs-p))
(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
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))))
;; in XEmacs: device-type is tty on tty and stream in batch.
(defun ediff-window-display-p ()
(and (ediff-device-type) (not (memq (ediff-device-type) '(tty pc stream)))))
@ -45,6 +63,35 @@
(ediff-emacs-p (memq (ediff-device-type) '(pc)))
(ediff-xemacs-p (memq (ediff-device-type) '(tty pc)))))
;; Defines SYMBOL as an advertised local variable.
;; Performs a defvar, then executes `make-variable-buffer-local' on
;; the variable. Also sets the `permanent-local' property,
;; so that `kill-all-local-variables' (called by major-mode setting
;; commands) won't destroy Ediff control variables.
;;
;; Plagiarised from `emerge-defvar-local' for XEmacs.
(defmacro ediff-defvar-local (var value doc)
(` (progn
(defvar (, var) (, value) (, doc))
(make-variable-buffer-local '(, var))
(put '(, var) 'permanent-local t))))
;; Variables that control each Ediff session---local to the control buffer.
;; Mode variables
;; The buffer in which the A variant is stored.
(ediff-defvar-local ediff-buffer-A nil "")
;; The buffer in which the B variant is stored.
(ediff-defvar-local ediff-buffer-B nil "")
;; The buffer in which the C variant is stored.
(ediff-defvar-local ediff-buffer-C nil "")
;; Ancestor buffer
(ediff-defvar-local ediff-ancestor-buffer nil "")
;; The control buffer of ediff.
(ediff-defvar-local ediff-control-buffer nil "")
;;; Macros
(defmacro ediff-odd-p (arg)
@ -130,20 +177,6 @@
(` (ediff-get-fine-diff-vector-from-diff-record
(ediff-get-difference (, n) (, buf-type)))))
;; Defines SYMBOL as an advertised local variable.
;; Performs a defvar, then executes `make-variable-buffer-local' on
;; the variable. Also sets the `permanent-local' property,
;; so that `kill-all-local-variables' (called by major-mode setting
;; commands) won't destroy Ediff control variables.
;;
;; Plagiarised from `emerge-defvar-local' for XEmacs.
(defmacro ediff-defvar-local (var value doc)
(` (progn
(defvar (, var) (, value) (, doc))
(make-variable-buffer-local '(, var))
(put '(, var) 'permanent-local t))))
;; Macro to switch to BUFFER, evaluate FORMS, returns to original buffer.
;; Differs from `save-excursion' in that it doesn't save the point and mark.
;; This is essentially `emerge-eval-in-buffer' with the test for live buffers."
@ -229,9 +262,14 @@
'(ediff-directory-revisions
ediff-merge-directory-revisions
ediff-merge-directory-revisions-with-ancestor)))
;; metajob involving only one directory
(defsubst ediff-dir1-metajob (&optional metajob)
(defsubst ediff-patch-metajob (&optional metajob)
(memq (or metajob ediff-metajob-name)
'(ediff-multifile-patch)))
;; metajob involving only one group of files, such as multipatch or directory
;; revision
(defsubst ediff-one-filegroup-metajob (&optional metajob)
(or (ediff-revision-metajob metajob)
(ediff-patch-metajob metajob)
;; add more here
))
(defsubst ediff-collect-diffs-metajob (&optional metajob)
@ -431,7 +469,10 @@ the value of this variable and the variables `ediff-help-message-*' in
(defconst ediff-KILLED-VITAL-BUFFER
"You have killed a vital Ediff buffer---you must leave Ediff now!")
(defconst ediff-NO-DIFFERENCES
"Sorry, it is not my job to munch identical variants...")
"Sorry, comparison of identical variants is not what I am made for...")
(defconst ediff-BAD-DIFF-NUMBER
;; %S stands for this-command, %d - diff number, %d - max diff
"%S: Bad diff region number, %d. Valid numbers are 1 to %d")
;; Selective browsing
@ -511,12 +552,6 @@ highlighted using ASCII flags.
This variable can be set either in .emacs or toggled interactively.
Use `setq-default' if setting it in .emacs")
(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
that Ediff doesn't know about.")
;; this indicates that diff regions are word-size, so fine diffs are
;; permanently nixed; used in ediff-windows-wordwise and ediff-regions-wordwise
(ediff-defvar-local ediff-word-mode nil "")
@ -560,22 +595,6 @@ ediff-toggle-hilit. Use `setq-default' to set it.")
;; unhighlighted, `off' -- turned off \(on a dumb terminal only\).
(ediff-defvar-local ediff-highlighting-style nil "")
;; Variables that control each Ediff session. They are local to the
;; control buffer.
;; Mode variables
;; The buffer in which the A variant is stored.
(ediff-defvar-local ediff-buffer-A nil "")
;; The buffer in which the B variant is stored.
(ediff-defvar-local ediff-buffer-B nil "")
;; The buffer in which the C variant is stored.
(ediff-defvar-local ediff-buffer-C nil "")
;; Ancestor buffer
(ediff-defvar-local ediff-ancestor-buffer nil "")
;; The control buffer of ediff.
(ediff-defvar-local ediff-control-buffer nil "")
;; The suffix of the control buffer name.
(ediff-defvar-local ediff-control-buffer-suffix nil "")
@ -797,18 +816,18 @@ appropriate symbol: `rcs', `pcl-cvs', or `generic-sc' if you so desire.")
(let ((is-current (ediff-overlay-get extent 'ediff))
(face (ediff-overlay-get extent 'face))
(diff-num (ediff-overlay-get extent 'ediff-diff-num))
face-help help-msg)
face-help)
;; This happens only for refinement overlays
(setq face-help (and face (get face 'ediff-help-echo)))
(setq help-msg
(cond ((and is-current diff-num) ; current diff region
(format "Difference region %S -- current" (1+ diff-num)))
(face-help) ; refinement of current diff region
(diff-num ; non-current
(format "Difference region %S -- non-current" (1+ diff-num)))
(t ""))))) ; none
(cond ((and is-current diff-num) ; current diff region
(format "Difference region %S -- current" (1+ diff-num)))
(face-help) ; refinement of current diff region
(diff-num ; non-current
(format "Difference region %S -- non-current" (1+ diff-num)))
(t "")) ; none
))
(defun ediff-set-face (ground face color)
"Set face foreground/background."
@ -1353,7 +1372,7 @@ More precisely, a regexp to match any one such character.")
(defun ediff-overlay-buffer (overl)
(if ediff-emacs-p
(overlay-buffer overl)
(and (extent-live-p overl) (extent-buffer overl))))
(and (extent-live-p overl) (extent-object overl))))
;; like overlay-get in Emacs. In XEmacs, returns nil if the extent is
;; dead. Otherwise, like extent-property
@ -1482,6 +1501,19 @@ More precisely, a regexp to match any one such character.")
(if ediff-verbose-p
(apply 'message string args)))
(defun ediff-file-attributes (filename attr-number)
(let ((handler (find-file-name-handler filename 'find-file-noselect)))
(if (and handler (string-match "ange-ftp" (format "%S" handler)))
-1
(nth attr-number (file-attributes filename)))))
(defsubst ediff-file-size (filename)
(ediff-file-attributes filename 7))
(defsubst ediff-file-modtime (filename)
(ediff-file-attributes filename 5))
(provide 'ediff-init)

10
lisp/ediff-merg.el
View File

@ -1,6 +1,6 @@
;;; ediff-merg.el --- merging utilities
;; Copyright (C) 1994, 1995 Free Software Foundation, Inc.
;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.sunysb.edu>
@ -25,6 +25,7 @@
(require 'ediff-init)
(defvar ediff-default-variant 'combined
"*The variant to be used as a default for buffer C in merging.
Valid values are the symbols `default-A', `default-B', and `combined'.")
@ -114,9 +115,10 @@ skiped over. Nil means show all regions.")
(defun ediff-do-merge (diff-num &optional remerging)
(if (< diff-num 0) (setq diff-num 0))
(let ((n diff-num)
(default-state-of-merge (format "%S" ediff-default-variant))
;;(default-state-of-merge (format "%S" ediff-default-variant))
do-not-copy state-of-merge)
(while (< n ediff-number-of-differences)
(setq do-not-copy nil) ; reset after each cycle
(if (= (mod n 10) 0)
(message "%s buffers A & B into C ... region %d of %d"
(if remerging "Re-merging" "Merging")
@ -130,9 +132,9 @@ skiped over. Nil means show all regions.")
(reg-B (ediff-get-region-contents n 'B ediff-control-buffer))
(reg-C (ediff-get-region-contents n 'C ediff-control-buffer)))
;;; was edited since first set by default
;; if region was edited since it was first set by default
(if (or (and (string= state-of-merge "default-A")
(not (string= reg-A reg-C)))
(not (string= reg-A reg-C)))
;; was edited since first set by default
(and (string= state-of-merge "default-B")
(not (string= reg-B reg-C)))

438
lisp/ediff-mult.el
View File

@ -1,6 +1,6 @@
;;; ediff-mult.el --- support for multi-file/multi-buffer processing in Ediff
;; Copyright (C) 1995 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1996 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.sunysb.edu>
@ -23,9 +23,8 @@
;;; Commentary:
;; Users are strongly encouraged to add functionality to this file.
;; In particular, epatch needs to be enhanced to work with multi-file
;; patches. The present file contains all the infrastructure needed for that.
;; Users are encouraged to add functionality to this file.
;; The present file contains all the infrastructure needed for that.
;;
;; Generally, to to implement a new multisession capability within Ediff,
;; you need to tell it
@ -37,22 +36,36 @@
;; In all likelihood, ediff-redraw-directory-group-buffer can be used
;; directly or after a small modification.
;; 2. What action to take when the user clicks button 2 or types v,e, or
;; RET. See ediff-dir-action.
;; RET. See ediff-filegroup-action.
;; 3. Provide a list of pairs or triples of file names (or buffers,
;; depending on the particular Ediff operation you want to invoke)
;; in the following format:
;; ((obj1 obj2 [optional obj3]) (...) ...)
;; (descriptor (obj1 obj2 obj3) (...) ...)
;; Actually, the format of this list is pretty much up to the
;; developer. The only thing is that it must be a list of lists.
;; developer. The only thing is that it must be a list of lists,
;; and the first list must describe the meta session, and subsequent
;; elements must describe individual sessions.
;; This descriptor must be a list of two, three, or four elements (nil
;; or string). The function ediff-redraw-registry-buffer displays the
;; second through last of these in the registry buffer.
;; Also, keep in mind that the function ediff-prepare-meta-buffer
;; (which see) prepends nil in front of each list (i.e., the above list
;; will become ((nil obj1 obj2 ...) (nil ...) ...).
;; (which see) prepends the session group buffer to the descriptor and
;; nil in front of each subsequent list (i.e., the above list
;; will become
;; ((meta-buf descriptor) (nil obj1 obj2 obj3) (nil ...) ...)
;; Ediff expects that your function (in 2 above) will arrange to
;; replace this prepended nil (via setcar) with the actual ediff
;; control buffer associated with an appropriate Ediff session.
;; This is arranged through internal startup hooks that can be passed
;; to any of Ediff major entries (such as ediff-files, epatch, etc.).
;; See how this is done in ediff-dir-action.
;; See how this is done in ediff-filegroup-action.
;;
;; Session descriptions are of the form (obj1 obj2 obj3), which
;; describe objects relevant to the session. Usually they are names of
;; files, but sometimes they may be other things. For instance, obj3 is
;; nil for jobs that involve only two files. For patch jobs, obj2 and
;; obj3 are markers that specify the patch corresponding to the file
;; (whose name is obj1).
;; 4. Write a function that makes a call to ediff-prepare-meta-buffer
;; passing all this info.
;; You may be able to use ediff-directories-internal as a template.
@ -64,13 +77,7 @@
;; ediff-merge-directories-with-ancestor all use
;; ediff-directories-internal.
;;
;; In case of multifile patching, the easiest thing is to first apply the patch
;; and then find out which files were patched (using the algorithm utilized by
;; Unix patch and by parsing the patch file). The procedure ediff-patch-file
;; works for single-file patches only. However, it can deal with remote and
;; compressed files. Check out ediff-patch-file for details.
;;
;; Another useful addition here could be session groups selected by patterns
;; A useful addition here could be session groups selected by patterns
;; (which are different in each directory). For instance, one may want to
;; compare files of the form abc{something}.c to files old{something}.d
;; which may be in the same or different directories. Or, one may want to
@ -79,7 +86,7 @@
;; Implementing this requires writing an collating function, which should pair
;; up appropriate files. It will also require a generalization of the functions
;; that do the layout of the meta- and differences buffers and of
;; ediff-dir-action.
;; ediff-filegroup-action.
;;; Code:
@ -95,11 +102,11 @@
Useful commands:
button2, `v', RET over a session line: start that Ediff session
`M' in any session invoked from here: bring back this buffer
`M':\tin any session invoked from here, brings back this group panel
`R':\tdisplay the registry of active Ediff sessions
`h':\tmark session for hiding; with prefix arg--unmark
`h':\tmark session for hiding (toggle)
`x':\thide marked sessions; with prefix arg--unhide hidden sessions
`m':\tmark session for non-hiding operation; with prefix arg--unmark
`m':\tmark session for a non-hiding operation (toggle)
SPC:\tnext session
DEL:\tprevious session
`E':\tbrowse Ediff on-line manual
@ -113,12 +120,12 @@ Useful commands:
directories.")
;; Variable specifying the action to take when the use invokes ediff in the
;; meta buffer. This is usually ediff-registry-action or ediff-dir-action
;; meta buffer. This is usually ediff-registry-action or ediff-filegroup-action
(ediff-defvar-local ediff-meta-action-function nil "")
;; Tells ediff-update-meta-buffer how to redraw it
(ediff-defvar-local ediff-meta-redraw-function nil "")
;; Tells ediff-dir-action and similar procedures how to invoke Ediff for the
;; sessions in a given session group
;; Tells ediff-filegroup-action and similar procedures how to invoke Ediff for
;; the sessions in a given session group
(ediff-defvar-local ediff-session-action-function nil "")
(ediff-defvar-local ediff-metajob-name nil "")
@ -130,7 +137,7 @@ directories.")
(defvar ediff-filtering-regexp-history nil "")
;; This has the form ((ctl-buf file1 file2) (stl-buf file1 file2) ...)
;; If ctl-buf is nil, the file-pare wasn't processed yet. If it is
;; If ctl-buf is nil, the file-pair wasn't processed yet. If it is
;; killed-buffer object, the file pair has been processed. If it is a live
;; buffer, this means ediff is still working on the pair
(ediff-defvar-local ediff-meta-list nil "")
@ -153,30 +160,48 @@ ediff-directories, is run.")
(defvar ediff-show-session-group-hook nil
"*Hooks run just after a session group buffer is shown.")
;;; API
;; buffer holding the multi-file patch. local to the meta buffer
(ediff-defvar-local ediff-meta-patchbufer nil "")
;;; API for ediff-meta-list
;; group buffer/regexp
(defun ediff-get-group-buffer (meta-list)
(nth 0 (car meta-list)))
(defun ediff-get-group-regexp (meta-list)
(nth 1 (car meta-list)))
;; group objects
(defun ediff-get-group-objA (meta-list)
(nth 2 (car meta-list)))
(defun ediff-get-group-objB (meta-list)
(nth 3 (car meta-list)))
(defun ediff-get-group-objC (meta-list)
(nth 4 (car meta-list)))
;; session buffer
(defun ediff-get-session-buffer (elt)
(nth 0 elt))
(defun ediff-get-session-status (elt)
(nth 1 elt))
(defun ediff-set-session-status (session-info new-status)
(setcar (cdr session-info) new-status))
;; session objects
(defun ediff-get-session-objA (elt)
(nth 2 elt))
(defun ediff-get-session-objB (elt)
(nth 3 elt))
(defun ediff-get-session-objC (elt)
(nth 4 elt))
(defun ediff-set-session-status (session-info new-status)
(setcar (cdr session-info) new-status))
(defun ediff-get-session-objA-name (elt)
(car (nth 2 elt)))
(defun ediff-get-session-objB-name (elt)
(car (nth 3 elt)))
(defun ediff-get-session-objC-name (elt)
(car (nth 4 elt)))
;; equality indicators
(defsubst ediff-get-file-eqstatus (elt)
(nth 1 elt))
(defsubst ediff-set-file-eqstatus (elt value)
(setcar (cdr elt) value))
;; set up the keymap in the meta buffer
(defun ediff-setup-meta-map()
@ -191,6 +216,8 @@ ediff-directories, is run.")
(define-key ediff-meta-buffer-map "\C-?" 'ediff-previous-meta-item)
(define-key ediff-meta-buffer-map [delete] 'ediff-previous-meta-item)
(define-key ediff-meta-buffer-map [backspace] 'ediff-previous-meta-item)
(or (ediff-one-filegroup-metajob)
(define-key ediff-meta-buffer-map "=" 'ediff-meta-mark-equal-files))
(if ediff-no-emacs-help-in-control-buffer
(define-key ediff-meta-buffer-map "\C-h" 'ediff-previous-meta-item))
(if ediff-emacs-p
@ -253,7 +280,8 @@ Moves in circular fashion. With numeric prefix arg, skip this many items."
(if pos (goto-char pos))
(if (eq ediff-metajob-name 'ediff-registry)
(if (search-forward "*Ediff" nil t)
(if (and (ediff-get-meta-info (current-buffer) pos 'noerror)
(search-forward "*Ediff" nil t))
(skip-chars-backward "a-zA-Z*"))
(if (> (skip-chars-forward "-+?H* \t0-9") 0)
(backward-char 1)))))
@ -278,10 +306,12 @@ Moves in circular fashion. With numeric prefix arg, skip this many items."
(if pos (goto-char pos))
(if (eq ediff-metajob-name 'ediff-registry)
(if (search-forward "*Ediff" nil t)
(if (and (ediff-get-meta-info (current-buffer) pos 'noerror)
(search-forward "*Ediff" nil t))
(skip-chars-backward "a-zA-Z*"))
(if (> (skip-chars-forward "-+?H* \t0-9") 0)
(backward-char 1)))))
(backward-char 1)))
))
@ -470,15 +500,26 @@ Moves in circular fashion. With numeric prefix arg, skip this many items."
(define-key
ediff-meta-buffer-map "M" 'ediff-show-meta-buff-from-registry))
;; initialize the meta list -- don't do this for registry we prepend
;; '(nil nil) nil to all elts of meta-list, except the first. The
;; '(nil nil) to all elts of meta-list, except the first. The
;; first nil will later be replaced by the session buffer. The second
;; is reserved for session status.
;; (car ediff-meta-list) gets cons'ed with the session group buffer.
;; Also, session objA/B/C are turned into lists (obj eq-indicator)
;; For now, the eq-indicator is used only for 2 and 3-file jobs.
(setq ediff-meta-list
(cons (cons meta-buffer (car meta-list))
(mapcar (function
(lambda (elt)
(cons nil (cons nil elt))))
(cons nil
(cons nil
;; convert each obj to (obj nil),
;; where nil may later be replaced
;; by =, if this file equals some
;; other file in the same session
(mapcar (function
(lambda (obj)
(list obj nil)))
elt)))))
(cdr meta-list)))))
(or (eq meta-buffer ediff-registry-buffer)
@ -496,22 +537,25 @@ Moves in circular fashion. With numeric prefix arg, skip this many items."
;; arrange for showing directory contents differences
;; must be after run startup-hooks, since ediff-dir-difference-list is
;; set inside these hooks
(if (eq action-func 'ediff-dir-action)
(if (eq action-func 'ediff-filegroup-action)
(progn
;; put meta buffer in (car ediff-dir-difference-list)
(setq ediff-dir-difference-list
(cons (cons meta-buffer (car ediff-dir-difference-list))
(cdr ediff-dir-difference-list)))
(or (ediff-dir1-metajob jobname)
(or (ediff-one-filegroup-metajob jobname)
(ediff-draw-dir-diffs ediff-dir-difference-list))
(define-key ediff-meta-buffer-map "h" 'ediff-mark-for-hiding)
(define-key
ediff-meta-buffer-map "x" 'ediff-hide-marked-sessions)
(define-key ediff-meta-buffer-map "m" 'ediff-mark-for-operation)
(if (ediff-collect-diffs-metajob jobname)
(define-key
ediff-meta-buffer-map "P" 'ediff-collect-custom-diffs))
(cond ((ediff-collect-diffs-metajob jobname)
(define-key
ediff-meta-buffer-map "P" 'ediff-collect-custom-diffs))
((ediff-patch-metajob jobname)
(define-key
ediff-meta-buffer-map "P" 'ediff-meta-show-patch)))
(define-key ediff-meta-buffer-map "u" 'ediff-up-meta-hierarchy)
(define-key ediff-meta-buffer-map "D" 'ediff-show-dir-diffs)))
@ -539,18 +583,24 @@ Moves in circular fashion. With numeric prefix arg, skip this many items."
(setq regexp (ediff-get-group-regexp meta-list))
(if (ediff-collect-diffs-metajob)
(insert
" `P':\tcollect custom diffs of all marked sessions\n"))
(cond ((ediff-collect-diffs-metajob)
(insert
" `P':\tcollect custom diffs of all marked sessions\n"))
((ediff-patch-metajob)
(insert
" `P':\tshow patch appropriately for the context (session or group)\n")))
(insert
" `u':\tshow parent session group
`D':\tdisplay differences among the contents of directories\n\n")
" `u':\tshow parent session group\n")
(or (ediff-one-filegroup-metajob)
(insert
" `D':\tshow differences among directories\n"
" `=':\tmark identical files in each session\n\n"))
(if (and (stringp regexp) (> (length regexp) 0))
(insert (format "Filter-through regular expression: %s\n" regexp)))
(insert "\n
Size Name
Size Last modified Name
-----------------------------------------------------------------------
")
@ -569,12 +619,7 @@ Moves in circular fashion. With numeric prefix arg, skip this many items."
" ****** ****** This session group has no members\n"))
;; now organize file names like this:
;; preferred format:
;; use-mark sizeA dateA sizeB dateB filename
;; I don't have time to mess up with calculating last modtimes
;; (XEmacs has no decode-time function), so
;; the actual format is:
;; use-mark Size filename
;; make sure directories are displayed with a trailing slash.
;; If one is a directory and another isn't, indicate this with a `?'
(while meta-list
@ -609,9 +654,9 @@ Moves in circular fashion. With numeric prefix arg, skip this many items."
;; At present, problematic sessions occur only in -with-ancestor comparisons
;; when the ancestor is a directory rather than a file.
(defun ediff-problematic-session-p (session)
(let ((f1 (ediff-get-session-objA session))
(f2 (ediff-get-session-objB session))
(f3 (ediff-get-session-objC session)))
(let ((f1 (ediff-get-session-objA-name session))
(f2 (ediff-get-session-objB-name session))
(f3 (ediff-get-session-objC-name session)))
(cond ((and (stringp f1) (not (file-directory-p f1))
(stringp f2) (not (file-directory-p f2))
(stringp f3) (file-directory-p f3)
@ -620,19 +665,53 @@ Moves in circular fashion. With numeric prefix arg, skip this many items."
'ancestor-is-dir)
(t nil))))
(defun ediff-meta-insert-file-info (file)
(if (stringp file)
(insert
(format
" %10d %s\n"
(nth 7 (file-attributes file))
;; dir names in meta lists have no trailing `/' so insert it
(cond ((file-directory-p file)
(file-name-as-directory (ediff-abbreviate-file-name file)))
(t (ediff-abbreviate-file-name file)))))
))
(defun ediff-meta-insert-file-info (fileinfo)
(let ((file-size -1)
(fname (car fileinfo))
(feq (ediff-get-file-eqstatus fileinfo))
(file-modtime "*file doesn't exist*"))
(if (and (stringp fname) (file-exists-p fname))
(setq file-size (ediff-file-size fname)
file-modtime (ediff-file-modtime fname)))
(if (stringp fname)
(insert
(format
"%s %s %-20s %s\n"
(if feq "=" " ") ; equality indicator
(format "%10s" (if (< file-size 0)
"remote"
file-size))
(if (< file-size 0)
"file"
(ediff-format-date (decode-time file-modtime)))
;; dir names in meta lists have no trailing `/' so insert it
(cond ((file-directory-p fname)
(file-name-as-directory (ediff-abbreviate-file-name fname)))
(t (ediff-abbreviate-file-name fname)))))
)))
(defconst ediff-months '((1 . "Jan") (2 . "Feb") (3 . "Mar") (4 . "Apr")
(5 . "May") (6 . "Jun") (7 . "Jul") (8 . "Aug")
(9 . "Sep") (10 . "Oct") (11 . "Nov") (12 . "Dec"))
"Months' associative array.")
;; TIME is like the output of decode-time
(defun ediff-format-date (time)
(format "%s %2d %4d %s:%s:%s"
(cdr (assoc (nth 4 time) ediff-months)) ; month
(nth 3 time) ; day
(nth 5 time) ; year
(ediff-fill-leading-zero (nth 2 time)) ; hour
(ediff-fill-leading-zero (nth 1 time)) ; min
(ediff-fill-leading-zero (nth 0 time)) ; sec
))
;; returns 2char string
(defsubst ediff-fill-leading-zero (num)
(if (< num 10)
(format "0%d" num)
(number-to-string num)))
(defun ediff-draw-dir-diffs (diff-list)
(if (null diff-list) (error "Lost difference info on these directories"))
@ -740,7 +819,7 @@ Useful commands:
(defun ediff-show-dir-diffs ()
"Display differences among the directories involved in session group."
(interactive)
(if (ediff-dir1-metajob)
(if (ediff-one-filegroup-metajob)
(error "This command is inapplicable in the present context"))
(or (ediff-buffer-live-p ediff-dir-diffs-buffer)
(ediff-draw-dir-diffs ediff-dir-difference-list))
@ -810,9 +889,15 @@ Useful commands:
(ediff-abbreviate-file-name
(ediff-get-group-objA meta-list))
(ediff-abbreviate-file-name
(or (ediff-get-group-objB meta-list) ""))
(if (stringp
(ediff-get-group-objB meta-list))
(ediff-get-group-objB meta-list)
""))
(ediff-abbreviate-file-name
(or (ediff-get-group-objC meta-list) ""))))
(if (stringp
(ediff-get-group-objC meta-list))
(ediff-get-group-objC meta-list)
""))))
(ediff-set-meta-overlay pt (point) elt))
(progn
(ediff-eval-in-buffer elt
@ -867,11 +952,15 @@ Useful commands:
(info (ediff-get-meta-info meta-buf pos))
(session-buf (ediff-get-session-buffer info)))
(if (eq (ediff-get-session-status info) ?H)
(setq unmark t))
(if unmark
(ediff-set-session-status info nil)
(if (ediff-buffer-live-p session-buf)
(error "Can't hide active session, %s" (buffer-name session-buf)))
(ediff-set-session-status info ?H))
(or unmark
(ediff-next-meta-item 1))
(ediff-update-meta-buffer meta-buf)
))
@ -883,9 +972,13 @@ Useful commands:
;; ediff-get-meta-info gives error if meta-buf or pos are invalid
(info (ediff-get-meta-info meta-buf pos)))
(if (eq (ediff-get-session-status info) ?*)
(setq unmark t))
(if unmark
(ediff-set-session-status info nil)
(ediff-set-session-status info ?*))
(or unmark
(ediff-next-meta-item 1))
(ediff-update-meta-buffer meta-buf)
))
@ -897,20 +990,27 @@ Useful commands:
(from (if unhide ?I ?H))
(to (if unhide ?H ?I))
(numMarked 0)
elt)
active-sessions-exist session-buf elt)
(while meta-list
(setq elt (car meta-list)
meta-list (cdr meta-list))
meta-list (cdr meta-list)
session-buf (ediff-get-session-buffer elt))
(if (eq (ediff-get-session-status elt) from)
(progn
(setq numMarked (1+ numMarked))
(ediff-set-session-status elt to))))
(if (and (eq to ?I) (buffer-live-p session-buf))
;; shouldn't hide active sessions
(setq active-sessions-exist t)
(ediff-set-session-status elt to)))))
(if (> numMarked 0)
(ediff-update-meta-buffer grp-buf)
(beep)
(if unhide
(message "Nothing to reveal...")
(message "Nothing to hide...")))
(if active-sessions-exist
(message "Note: didn't hide active sessions!"))
))
;; Apply OPERATION to marked sessions. Operation expects one argument of type
@ -968,8 +1068,8 @@ Useful commands:
(shell-command
(format "%s %s %s %s"
ediff-custom-diff-program ediff-custom-diff-options
(ediff-get-session-objA session)
(ediff-get-session-objB session))
(ediff-get-session-objA-name session)
(ediff-get-session-objB-name session))
t))
(save-excursion
(set-buffer meta-diff-buff)
@ -999,9 +1099,31 @@ all marked sessions must be active."
(beep)
(message "No marked sessions found")))
(defun ediff-meta-show-patch ()
"Show the multi-file patch associated with this group session."
(interactive)
(let* ((pos (ediff-event-point last-command-event))
(meta-buf (ediff-event-buffer last-command-event))
(info (ediff-get-meta-info meta-buf pos 'noerror))
(patchbuffer ediff-meta-patchbufer))
(if (ediff-buffer-live-p patchbuffer)
(ediff-eval-in-buffer patchbuffer
(save-restriction
(if (not info)
(widen)
(narrow-to-region
(ediff-get-session-objB-name info)
(ediff-get-session-objC-name info)))
(set-buffer (get-buffer-create ediff-tmp-buffer))
(erase-buffer)
(insert-buffer patchbuffer)
(display-buffer ediff-tmp-buffer 'not-this-window)
))
(error "The patch buffer wasn't found"))))
;; This function executes in meta buffer. It knows where event happened.
(defun ediff-dir-action ()
(defun ediff-filegroup-action ()
"Execute appropriate action for the selected session."
(interactive)
(let* ((pos (ediff-event-point last-command-event))
@ -1011,13 +1133,13 @@ all marked sessions must be active."
session-buf file1 file2 file3 regexp)
(setq session-buf (ediff-get-session-buffer info)
file1 (ediff-get-session-objA info)
file2 (ediff-get-session-objB info)
file3 (ediff-get-session-objC info))
file1 (ediff-get-session-objA-name info)
file2 (ediff-get-session-objB-name info)
file3 (ediff-get-session-objC-name info))
;; make sure we don't start on hidden sessions
;; ?H means marked for hiding. ?I means invalid (hidden).
(if (memq (ediff-get-session-status info) '(?H ?I))
(if (memq (ediff-get-session-status info) '(?I))
(progn
(beep)
(if (y-or-n-p "This session is marked as hidden, unmark? ")
@ -1052,7 +1174,9 @@ all marked sessions must be active."
(setcar (quote (, info)) ediff-meta-buffer)))))))
;; Do ediff-revision on a subdirectory
((and (ediff-dir1-metajob) (file-directory-p file1))
((and (ediff-one-filegroup-metajob)
(ediff-revision-metajob)
(file-directory-p file1))
(if (ediff-buffer-live-p session-buf)
(ediff-show-meta-buffer session-buf)
(setq regexp (read-string "Filter through regular expression: "
@ -1070,7 +1194,7 @@ all marked sessions must be active."
;; From here on---only individual session handlers
;; handle an individual session with live control buffer
;; handle an individual session with a live control buffer
((ediff-buffer-live-p session-buf)
(ediff-eval-in-buffer session-buf
(setq ediff-mouse-pixel-position (mouse-pixel-position))
@ -1082,17 +1206,17 @@ all marked sessions must be active."
"This session's ancestor is a directory, merge without the ancestor? ")
(ediff-merge-files
file1 file2
;; arrange startup hooks
;; provide startup hooks
(` (list (lambda ()
(setq ediff-meta-buffer (, (current-buffer)))
;; see below for the explanation of what this does
(setcar
(quote (, info)) ediff-control-buffer)))))
(error "Aborted")))
((ediff-dir1-metajob) ; needs 1 file arg
((ediff-one-filegroup-metajob) ; needs 1 file arg
(funcall ediff-session-action-function
file1
;; arrange startup hooks
;; provide startup hooks
(` (list (lambda ()
(setq ediff-meta-buffer (, (current-buffer)))
;; see below for explanation of what this does
@ -1101,7 +1225,7 @@ all marked sessions must be active."
((not (ediff-metajob3)) ; need 2 file args
(funcall ediff-session-action-function
file1 file2
;; arrange startup hooks
;; provide startup hooks
(` (list (lambda ()
(setq ediff-meta-buffer (, (current-buffer)))
;; this makes ediff-startup pass the value of
@ -1321,14 +1445,13 @@ If this is a session registry buffer then just bury it."
(ediff-cleanup-meta-buffer buf)
(cond ((and (ediff-safe-to-quit buf)
(y-or-n-p "Quit this session group? "))
(message "")
(ediff-dispose-of-meta-buffer buf))
((ediff-safe-to-quit buf)
(bury-buffer))
(t
(bury-buffer)
(beep)
(message
"Session group suspended, not deleted (has active sessions)")))
(error
"This session group has active sessions---cannot exit")))
(ediff-cleanup-meta-buffer parent-buf)
(ediff-kill-buffer-carefully dir-diffs-buffer)
(ediff-kill-buffer-carefully meta-diff-buffer)
@ -1378,40 +1501,117 @@ If this is a session registry buffer then just bury it."
;; return location of the next meta overlay after point
(defun ediff-next-meta-overlay-start (point)
(let (overl)
(if ediff-xemacs-p
(progn
(setq overl (extent-at point (current-buffer) 'ediff-meta-info))
(if overl
(setq overl (next-extent overl))
(setq overl (next-extent (current-buffer))))
(if overl
(extent-start-position overl)
(point-max)))
(if (= point (point-max)) (setq point (point-min)))
(setq overl (car (overlays-at point)))
(if (and overl (overlay-get overl 'ediff-meta-info))
(overlay-end overl)
(next-overlay-change point)))))
(if (eobp)
(goto-char (point-min))
(let (overl)
(if ediff-xemacs-p
(progn
(setq overl (extent-at point (current-buffer) 'ediff-meta-info))
(if overl
(setq overl (next-extent overl))
(setq overl (next-extent (current-buffer))))
(if overl
(extent-start-position overl)
(point-max)))
(setq overl (car (overlays-at point)))
(if (and overl (overlay-get overl 'ediff-meta-info))
;; note: end of current overlay is the beginning of the next one
(overlay-end overl)
(next-overlay-change point))))
))
(defun ediff-previous-meta-overlay-start (point)
(let (overl)
(if ediff-xemacs-p
(progn
(setq overl (extent-at point (current-buffer) 'ediff-meta-info))
(if overl
(setq overl (previous-extent overl))
(setq overl (previous-extent (current-buffer))))
(if overl
(extent-start-position overl)
(point-max)))
;;(if (bobp) (setq point (point-max)))
(setq overl (car (overlays-at point)))
(setq point (if (and overl (overlay-get overl 'ediff-meta-info))
(previous-overlay-change (overlay-start overl))
(previous-overlay-change point)))
(if (= point (point-min)) (point-max) point)
)))
(if (bobp)
(goto-char (point-max))
(let (overl)
(if ediff-xemacs-p
(progn
(setq overl (extent-at point (current-buffer) 'ediff-meta-info))
(if overl
(setq overl (previous-extent overl))
(setq overl (previous-extent (current-buffer))))
(if overl
(extent-start-position overl)
(point-min)))
(setq overl (car (overlays-at point)))
(if (and overl (overlay-get overl 'ediff-meta-info))
(setq point (overlay-start overl)))
;; to get to the beginning of prev overlay
(if (not (bobp))
;; trickery 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.
(defun ediff-patch-file-form-meta (file &optional startup-hooks)
(let* ((pos (ediff-event-point last-command-event))
(meta-buf (ediff-event-buffer last-command-event))
;; ediff-get-meta-info gives error if meta-buf or pos are invalid
(info (ediff-get-meta-info meta-buf pos))
(meta-patchbuf ediff-meta-patchbufer)
session-buf beg-marker end-marker)
(if (or (file-directory-p file) (string-match "/dev/null" file))
(error "`%s' is not an ordinary file" (file-name-as-directory file)))
(setq session-buf (ediff-get-session-buffer info)
beg-marker (ediff-get-session-objB-name info)
end-marker (ediff-get-session-objC-name info))
(or (ediff-buffer-live-p session-buf) ; either an active patch session
(null session-buf) ; or it is a virgin session
(error
"Patch has been already applied to this file--cannot be repeated!"))
(ediff-eval-in-buffer meta-patchbuf
(save-restriction
(widen)
(narrow-to-region beg-marker end-marker)
(ediff-patch-file-internal meta-patchbuf file startup-hooks)))))
(defun ediff-meta-mark-equal-files ()
"Run though the session list and mark identical files.
This is used only for sessions that involve 2 or 3 files at the same time."
(interactive)
(let ((list (cdr ediff-meta-list))
fileinfo1 fileinfo2 fileinfo3 elt)
(while (setq elt (car list))
(setq fileinfo1 (ediff-get-session-objA elt)
fileinfo2 (ediff-get-session-objB elt)
fileinfo3 (ediff-get-session-objC elt))
(ediff-set-file-eqstatus fileinfo1 nil)
(ediff-set-file-eqstatus fileinfo2 nil)
(ediff-set-file-eqstatus fileinfo3 nil)
(ediff-mark-if-equal fileinfo1 fileinfo2)
(if (ediff-metajob3)
(progn
(ediff-mark-if-equal fileinfo1 fileinfo3)
(ediff-mark-if-equal fileinfo2 fileinfo3)))
(setq list (cdr list))))
(ediff-update-meta-buffer (current-buffer)))
;; mark files 1 and 2 as equal, if they are.
(defun ediff-mark-if-equal (fileinfo1 fileinfo2)
(get-buffer-create ediff-tmp-buffer)
(or (file-directory-p (car fileinfo1))
(file-directory-p (car fileinfo2))
(if (= (ediff-make-diff2-buffer
ediff-tmp-buffer (car fileinfo1) (car fileinfo2))
0)
(progn
(ediff-set-file-eqstatus fileinfo1 t)
(ediff-set-file-eqstatus fileinfo2 t)))))
;;; Local Variables:

275
lisp/ediff-util.el
View File

@ -1,6 +1,6 @@
;;; ediff-util.el --- the core commands and utilities of ediff
;; Copyright (C) 1994, 1995 Free Software Foundation, Inc.
;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.sunysb.edu>
@ -26,6 +26,11 @@
(require 'ediff-init)
(require 'ediff-mult)
;; Pacify compiler and avoid the need in checking for boundp
(defvar ediff-patch-diagnostics nil)
(defvar ediff-patchbufer nil)
;; end pacifier
;;; Functions
@ -35,9 +40,11 @@ This mode is entered through one of the following commands:
`ediff'
`ediff-files'
`ediff-buffers'
`ebuffers'
`ediff3'
`ediff-files3'
`ediff-buffers3'
`ebuffers3'
`ediff-merge'
`ediff-merge-files'
`ediff-merge-files-with-ancestor'
@ -176,6 +183,8 @@ to invocation.")
(define-key ediff-mode-map "wa" 'ediff-save-buffer)
(define-key ediff-mode-map "wb" 'ediff-save-buffer)
(define-key ediff-mode-map "wd" 'ediff-save-buffer)
(if (fboundp 'ediff-show-patch-diagnostics)
(define-key ediff-mode-map "P" 'ediff-show-patch-diagnostics))
(if ediff-3way-job
(progn
(define-key ediff-mode-map "wc" 'ediff-save-buffer)
@ -242,7 +251,7 @@ to invocation.")
(make-local-hook 'pre-command-hook)
(if (ediff-window-display-p)
(add-hook 'pre-command-hook 'ediff-spy-after-mouse))
(add-hook 'pre-command-hook 'ediff-spy-after-mouse nil t))
(setq ediff-mouse-pixel-position (mouse-pixel-position))
;; adjust for merge jobs
@ -273,7 +282,7 @@ to invocation.")
(insert-buffer buf)
(funcall (ediff-eval-in-buffer buf major-mode))
;; after Stig@hackvan.com
(add-hook 'local-write-file-hooks 'ediff-set-merge-mode)
(add-hook 'local-write-file-hooks 'ediff-set-merge-mode nil t)
)))
(setq buffer-read-only nil
ediff-buffer-A buffer-A
@ -740,8 +749,7 @@ Reestablish the default three-window display."
(if (and (ediff-buffer-live-p ediff-buffer-A)
(ediff-buffer-live-p ediff-buffer-B)
(or (not ediff-3way-job)
(ediff-buffer-live-p ediff-buffer-C))
)
(ediff-buffer-live-p ediff-buffer-C)))
(progn
(or no-rehighlight
(ediff-select-difference ediff-current-difference))
@ -1170,7 +1178,8 @@ This is especially useful when comparing buffers side-by-side."
(defun ediff-toggle-multiframe ()
"Switch from the multiframe display to single-frame display and back.
This is primarily for debugging, but one can use it for fun, too."
For a permanent change, set the variable `ediff-window-setup-function',
which see."
(interactive)
(ediff-barf-if-not-control-buffer)
(or (ediff-window-display-p)
@ -1381,7 +1390,7 @@ the width of the A/B/C windows."
;;BEG, END show the region to be positioned.
;;JOB-NAME holds ediff-job-name. Ediff-windows job positions regions
;;JOB-NAME holds ediff-job-name. The ediff-windows job positions regions
;;differently.
(defun ediff-position-region (beg end pos job-name)
(if (> end (point-max))
@ -1449,33 +1458,43 @@ the width of the A/B/C windows."
)))
;; region size coefficient is a coefficient by which to adjust scrolling
;; up/down of the window displaying buffer of type BUFTYPE.
;; The purpose of this coefficient is to make the windows scroll in sync, so
;; that it won't happen that one diff region is scrolled off while the other is
;; still seen.
;;
;; If the difference region is invalid, the coefficient is 1
(defun ediff-get-region-size-coefficient (buf-type op &optional n ctl-buf)
(ediff-eval-in-buffer (or ctl-buf ediff-control-buffer)
(let* ((func (cond ((eq op 'scroll-down) 'ediff-get-lines-to-region-start)
((eq op 'scroll-up) 'ediff-get-lines-to-region-end)
(t '(lambda (a b c) 0))))
(max-lines (max (funcall func 'A n ctl-buf)
(funcall func 'B n ctl-buf)
(if (ediff-buffer-live-p ediff-buffer-C)
(funcall func 'C n ctl-buf)
0))))
;; this covers the horizontal coefficient as well:
;; if max-lines = 0 then coef = 1
(if (> max-lines 0)
(/ (+ (funcall func buf-type n ctl-buf) 0.0)
(+ max-lines 0.0))
1)
)))
(if (ediff-valid-difference-p n)
(let* ((func (cond ((eq op 'scroll-down)
'ediff-get-lines-to-region-start)
((eq op 'scroll-up)
'ediff-get-lines-to-region-end)
(t '(lambda (a b c) 0))))
(max-lines (max (funcall func 'A n ctl-buf)
(funcall func 'B n ctl-buf)
(if (ediff-buffer-live-p ediff-buffer-C)
(funcall func 'C n ctl-buf)
0))))
;; this covers the horizontal coefficient as well:
;; if max-lines = 0 then coef = 1
(if (> max-lines 0)
(/ (+ (funcall func buf-type n ctl-buf) 0.0)
(+ max-lines 0.0))
1))
1)))
(defun ediff-next-difference (&optional arg)
"Advance to the next difference.
With a prefix argument, go back that many differences."
(interactive "P")
With a prefix argument, go forward that many differences."
(interactive "p")
(ediff-barf-if-not-control-buffer)
(if (< ediff-current-difference ediff-number-of-differences)
(let ((n (min ediff-number-of-differences
(+ ediff-current-difference (if arg arg 1))))
(+ ediff-current-difference arg)))
regexp-skip)
(or (>= n ediff-number-of-differences)
@ -1508,10 +1527,10 @@ With a prefix argument, go back that many differences."
(defun ediff-previous-difference (&optional arg)
"Go to the previous difference.
With a prefix argument, go back that many differences."
(interactive "P")
(interactive "p")
(ediff-barf-if-not-control-buffer)
(if (> ediff-current-difference -1)
(let ((n (max -1 (- ediff-current-difference (if arg arg 1))))
(let ((n (max -1 (- ediff-current-difference arg)))
regexp-skip)
(or (< n 0)
@ -1541,29 +1560,89 @@ With a prefix argument, go back that many differences."
(ediff-visible-region)
(error "At beginning of the difference list")))
;; The diff number is as perceived by the user (i.e., 1+ the internal
;; representation)
(defun ediff-jump-to-difference (difference-number)
"Go to the difference specified as a prefix argument."
"Go to the difference specified as a prefix argument.
If the prefix is negative, count differences from the end."
(interactive "p")
(ediff-barf-if-not-control-buffer)
(setq difference-number (1- difference-number))
(setq difference-number
(cond ((< difference-number 0)
(+ ediff-number-of-differences difference-number))
((> difference-number 0) (1- difference-number))
(t -1)))
;; -1 is allowed by ediff-unselect-and-select-difference --- it is the
;; position before the first one.
(if (and (>= difference-number -1)
(< difference-number (1+ ediff-number-of-differences)))
(<= difference-number ediff-number-of-differences))
(ediff-unselect-and-select-difference difference-number)
(error "Bad difference number, %d. Valid numbers are 1 to %d"
(1+ difference-number) ediff-number-of-differences)))
(error ediff-BAD-DIFF-NUMBER
this-command (1+ difference-number) ediff-number-of-differences)))
(defun ediff-jump-to-difference-at-point ()
(defun ediff-jump-to-difference-at-point (arg)
"Go to difference closest to the point in buffer A, B, or C.
The type of buffer depends on last command character \(a, b, or c\) that
invoked this command."
(interactive)
The buffer depends on last command character \(a, b, or c\) that invoked this
command. For instance, if the command was `ga' then the point value in buffer A
is used.
With a prefix argument, synchronize all files around the current point position
in the specified buffer."
(interactive "P")
(ediff-barf-if-not-control-buffer)
(let ((buf-type (ediff-char-to-buftype last-command-char)))
(ediff-jump-to-difference (ediff-diff-at-point buf-type))))
(let* ((buf-type (ediff-char-to-buftype last-command-char))
(buffer (ediff-get-buffer buf-type))
(pt (ediff-eval-in-buffer buffer (point)))
(diff-no (ediff-diff-at-point buf-type nil (if arg 'after)))
(past-last-diff (< ediff-number-of-differences diff-no))
(beg (if past-last-diff
(ediff-eval-in-buffer buffer (point-max))
(ediff-get-diff-posn buf-type 'beg (1- diff-no))))
ctl-wind wind-A wind-B wind-C
shift)
(if past-last-diff
(ediff-jump-to-difference -1)
(ediff-jump-to-difference diff-no))
(setq ctl-wind (selected-window)
wind-A ediff-window-A
wind-B ediff-window-B
wind-C ediff-window-C)
(if arg
(progn
(ediff-eval-in-buffer buffer
(setq shift (- beg pt)))
(select-window wind-A)
(if past-last-diff (goto-char (point-max)))
(condition-case nil
(backward-char shift) ; noerror, if beginning of buffer
(error))
(recenter)
(select-window wind-B)
(if past-last-diff (goto-char (point-max)))
(condition-case nil
(backward-char shift) ; noerror, if beginning of buffer
(error))
(recenter)
(if (window-live-p wind-C)
(progn
(select-window wind-C)
(if past-last-diff (goto-char (point-max)))
(condition-case nil
(backward-char shift) ; noerror, if beginning of buffer
(error))
(recenter)
))
(select-window ctl-wind)
))
))
;; find region most related to the current point position (or POS, if given)
(defun ediff-diff-at-point (buf-type &optional pos)
;; returns diff number as seen by the user (i.e., 1+ the internal
;; representation)
;; The optional argument WHICH-DIFF can be `after' or `before'. If `after',
;; find the diff after the point. If `before', find the diff before the
;; point. If the point is inside a diff, return that diff.
(defun ediff-diff-at-point (buf-type &optional pos which-diff)
(let ((buffer (ediff-get-buffer buf-type))
(ctl-buffer ediff-control-buffer)
(max-dif-num (1- ediff-number-of-differences))
@ -1584,10 +1663,18 @@ invoked this command."
end (ediff-get-diff-posn buf-type 'end diff-no ctl-buffer))
)
(if (< (abs (- pos prev-end))
(abs (- pos beg)))
diff-no
(1+ diff-no)) ; jump-to-diff works with diff nums higher by 1
;; boost diff-no by 1, if past the last diff region
(if (and (memq which-diff '(after before))
(> pos beg) (= diff-no max-dif-num))
(setq diff-no (1+ diff-no)))
(cond ((eq which-diff 'after) (1+ diff-no))
((eq which-diff 'before) diff-no)
((< (abs (count-lines pos (max 1 prev-end)))
(abs (count-lines pos (max 1 beg))))
diff-no) ; choose prev difference
(t
(1+ diff-no))) ; choose next difference
)))
@ -1607,8 +1694,9 @@ determine the source and the target buffers instead of the command keys."
(interactive "P")
(ediff-barf-if-not-control-buffer)
(or keys (setq keys (this-command-keys)))
(if (numberp arg)
(ediff-jump-to-difference arg))
(if (eq arg '-) (setq arg -1)) ; translate neg arg to -1
(if (numberp arg) (ediff-jump-to-difference arg))
(let* ((key1 (aref keys 0))
(key2 (aref keys 1))
(char1 (if (and ediff-xemacs-p (eventp key1)) (event-key key1) key1))
@ -1866,7 +1954,7 @@ a regular expression typed in by the user."
msg-connective alt-msg-connective alt-connective)
(cond
((or (and (eq ediff-skip-diff-region-function
'ediff-focus-on-regexp-matches-function)
ediff-focus-on-regexp-matches-function)
(eq last-command-char ?f))
(and (eq ediff-skip-diff-region-function
ediff-hide-regexp-matches-function)
@ -2063,13 +2151,13 @@ If it is t, they will be preserved unconditionally. A prefix argument,
temporarily reverses the meaning of this variable."
(interactive "P")
(ediff-barf-if-not-control-buffer)
(if (prog1
(y-or-n-p
(format "Quit this Ediff session%s? "
(if (ediff-buffer-live-p ediff-meta-buffer)
" & show containing session group" "")))
(message ""))
(ediff-really-quit reverse-default-keep-variants)))
(if (y-or-n-p (format "Quit this Ediff session%s? "
(if (ediff-buffer-live-p ediff-meta-buffer)
" & show containing session group" "")))
(progn
(message "")
(ediff-really-quit reverse-default-keep-variants))
(message "")))
;; Perform the quit operations.
@ -2258,7 +2346,7 @@ buffer in another session as well."
(buf-A-wind (ediff-get-visible-buffer-window buf-A))
(buf-B-wind (ediff-get-visible-buffer-window buf-B))
(buf-C-wind (ediff-get-visible-buffer-window buf-C))
(buf-patch ediff-patch-buf)
(buf-patch ediff-patchbufer)
(buf-patch-diag ediff-patch-diagnostics)
(buf-err ediff-error-buffer)
(buf-diff ediff-diff-buffer)
@ -2316,7 +2404,8 @@ Hit \\[ediff-recenter] to reset the windows afterward."
(ediff-barf-if-not-control-buffer)
(save-excursion
(ediff-skip-unsuitable-frames))
(with-output-to-temp-buffer " *ediff-info*"
(with-output-to-temp-buffer ediff-msg-buffer
(raise-frame (selected-frame))
(princ (ediff-version))
(princ "\n\n")
(ediff-eval-in-buffer ediff-buffer-A
@ -2525,13 +2614,14 @@ Hit \\[ediff-recenter] to reset the windows afterward."
(let (f)
(setq f (expand-file-name
(read-file-name
(format "%s%s: "
(format "%s%s "
prompt
(if default-file
(concat " (default " default-file ")")
""))
(cond (default-file
(concat " (default " default-file "):"))
;;((string-match "[?:!,;][ \t]*$" prompt) "")
(t (concat " (default " default-dir "):"))))
default-dir
default-file
(or default-file default-dir)
t ; must match, no-confirm
(if default-file (file-name-directory default-file))
)
@ -2601,9 +2691,7 @@ Hit \\[ediff-recenter] to reset the windows afterward."
;; file on disk, and attempt to remedy the situation if not.
;; Signal an error if we can't make them the same, or the user doesn't want
;; to do what is necessary to make them the same.
;; If file has file handlers (indicated by the optional arg), then we
;; offer to revert instead of saving. This is one difference with Emerge.
;; Another is that we always offer to revert obsolete files, whether they
;; Also, Ediff always offers to revert obsolete buffers, whether they
;; are modified or not.
(defun ediff-verify-file-buffer (&optional file-magic)
;; First check if the file has been modified since the buffer visited it.
@ -2611,21 +2699,19 @@ 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. %s file %s? "
(if file-magic "Revert" "Save")
(format "Buffer out of sync with visited file. Save file %s? "
buffer-file-name))
(if (not file-magic)
(condition-case nil
(save-buffer)
;; for some reason, file-name-handlers append instead of
;; replacing, so we have to erase first.
(erase-buffer)
(revert-buffer t t))
(error "Buffer out of sync for file %s" buffer-file-name))
(error
(beep)
(message "Couldn't save %s" buffer-file-name)))
(error "Buffer is out of sync for file %s" buffer-file-name))
;; If buffer is not obsolete and is not modified, do nothing
nil)
;; If buffer is obsolete, offer to revert
(if (yes-or-no-p
(format "Buffer out of sync with visited file. Revert file %s? "
(format "Buffer is out of sync with visited file. REVERT file %s? "
buffer-file-name))
(progn
(if file-magic
@ -2776,16 +2862,17 @@ Without an argument, it saves customized diff argument, if available
))
;; Returns positions of difference sectors in the BUF-TYPE buffer.
;; BUF-TYPE should be a symbol -- `A', `B', or `C'.
;; POS is either `beg' or `end'--it specifies whether you want the position at
;; the beginning of a difference or at the end.
;;
;; The optional argument N says which difference (default:
;; `ediff-current-difference'). N is the internal difference number (1- what
;; the user sees). The optional argument CONTROL-BUF says
;; which control buffer is in effect in case it is not the current
;; buffer.
(defun ediff-get-diff-posn (buf-type pos &optional n control-buf)
"Returns positions of difference sectors in the BUF-TYPE buffer.
BUF-TYPE should be a symbol--either `A' or `B'.
POS is either `beg' or `end'--it specifies whether you want the position at the
beginning of a difference or at the end.
The optional argument N says which difference \(default:
`ediff-current-difference'\). The optional argument CONTROL-BUF says
which control buffer is in effect in case it is not the current
buffer."
(let (diff-overlay)
(or control-buf
(setq control-buf (current-buffer)))
@ -2794,8 +2881,8 @@ buffer."
(or n (setq n ediff-current-difference))
(if (or (< n 0) (>= n ediff-number-of-differences))
(if (> ediff-number-of-differences 0)
(error "Bad difference number, %d. Valid numbers are 1 to %d"
(1+ n) ediff-number-of-differences)
(error ediff-BAD-DIFF-NUMBER
this-command (1+ n) ediff-number-of-differences)
(error ediff-NO-DIFFERENCES)))
(setq diff-overlay (ediff-get-diff-overlay n buf-type)))
(if (not (ediff-buffer-live-p (ediff-overlay-buffer diff-overlay)))
@ -2957,16 +3044,18 @@ Checks if overlay's buffer exists."
(setq overl
(if ediff-xemacs-p
(make-extent beg end buff)
;; don't advance front, but advance rear
;; advance front and rear of the overlay
(make-overlay beg end buff nil 'rear-advance)))
(if ediff-emacs-p
(ediff-overlay-put overl 'evaporate nil) ; don't detach
(ediff-overlay-put overl 'detachable nil) ; don't detach
;; don't advance front, but advance rear
(ediff-overlay-put overl 'start-open nil)
(ediff-overlay-put overl 'end-open nil))
;; never detach
(ediff-overlay-put
overl (if ediff-emacs-p 'evaporate 'detachable) nil)
;; make vip-minibuffer-overlay open-ended
;; In emacs, it is made open ended at creation time
(if ediff-xemacs-p
(progn
(ediff-overlay-put overl 'start-open nil)
(ediff-overlay-put overl 'end-open nil)))
(ediff-overlay-put overl 'ediff-diff-num 0)
overl))))
@ -3265,8 +3354,8 @@ Mail anyway? (y or n) ")
(remove-hook post-hook 'ediff-calc-command-time)
(setq ediff-command-begin-time '(0 0 0))
(message "Ediff profiling disabled"))
(add-hook pre-hook 'ediff-save-time t)
(add-hook post-hook 'ediff-calc-command-time)
(add-hook pre-hook 'ediff-save-time t t)
(add-hook post-hook 'ediff-calc-command-time nil t)
(message "Ediff profiling enabled"))))
(defun ediff-print-diff-vector (diff-vector-var)

16
lisp/ediff-vers.el
View File

@ -1,6 +1,6 @@
;;; ediff-vers.el --- version control interface to Ediff
;;; Copyright (C) 1994, 1995 Free Software Foundation, Inc.
;;; Copyright (C) 1995, 1996 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.sunysb.edu>
@ -23,6 +23,20 @@
;;; Code:
;; Compiler pacifier
(defvar rcs-default-co-switches)
(defvar sc-mode)
(defvar cvs-shell)
(defvar cvs-program)
(defvar cvs-cookie-handle)
(eval-when-compile
(load "pcl-cvs" 'noerror)
(load "rcs" 'noerror)
(load "generic-sc" 'noerror)
(load "vc" 'noerror))
;; end pacifier
;; VC.el support
(defun vc-ediff-internal (rev1 rev2 &optional startup-hooks)

237
lisp/ediff-wind.el
View File

@ -1,6 +1,6 @@
;;; ediff-wind.el --- window manipulation utilities
;; Copyright (C) 1994, 1995 Free Software Foundation, Inc.
;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.sunysb.edu>
@ -25,6 +25,18 @@
(require 'ediff-init)
;; Compiler pacifier
(defvar icon-title-format)
(defvar top-toolbar-height)
(defvar bottom-toolbar-height)
(defvar left-toolbar-height)
(defvar right-toolbar-height)
(defvar left-toolbar-width)
(defvar right-toolbar-width)
(defvar default-menubar)
(defvar frame-icon-title-format)
;; end pacifier
(defvar ediff-window-setup-function (if (ediff-window-display-p)
'ediff-setup-windows-multiframe
@ -93,7 +105,6 @@ In this case, Ediff will use those frames to display these buffers.")
'(vertical-scroll-bars . nil) ; Emacs only
'(scrollbar-width . 0) ; XEmacs only
'(menu-bar-lines . 0) ; Emacs only
'(visibility . nil) ; doesn't work for XEmacs yet
;; don't lower and auto-raise
'(auto-lower . nil)
'(auto-raise . t)
@ -395,13 +406,15 @@ into icons, regardless of the window manager.")
(defun ediff-setup-windows-multiframe-merge (buf-A buf-B buf-C control-buf)
;;; Algorithm:
;;; If A and B are in the same frame but C's frame is different--- use one
;;; frame for A and B and use a separate frame for C.
;;; If C's frame is non-existent, then: if the first suitable
;;; non-dedicated frame is different from A&B's, then use it for C.
;;; Otherwise, put A,B, and C in one frame.
;;; If buffers A, B, C are is separate frames, use them to display these
;;; buffers.
;;; 1. Never use frames that have dedicated windows in them---it is bad to
;;; destroy dedicated windows.
;;; 2. If A and B are in the same frame but C's frame is different--- use one
;;; frame for A and B and use a separate frame for C.
;;; 3. If C's frame is non-existent, then: if the first suitable
;;; non-dedicated frame is different from A&B's, then use it for C.
;;; Otherwise, put A,B, and C in one frame.
;;; 4. If buffers A, B, C are is separate frames, use them to display these
;;; buffers.
;; Skip dedicated or iconified frames.
;; Unsplittable frames are taken care of later.
@ -423,13 +436,22 @@ into icons, regardless of the window manager.")
(orig-wind (selected-window))
(orig-frame (selected-frame))
(use-same-frame (or force-one-frame
;; A and C must be in one frame
(eq frame-A (or frame-C orig-frame))
;; B and C must be in one frame
(eq frame-B (or frame-C orig-frame))
;; A or B is not visible
(not (frame-live-p frame-A))
(not (frame-live-p frame-B))
;; A or B is not suitable for display
(not (ediff-window-ok-for-display wind-A))
(not (ediff-window-ok-for-display wind-B))
;; A and B in the same frame, and no good frame
;; for C
(and (eq frame-A frame-B)
(not (frame-live-p frame-C)))
))
;; use-same-frame-for-AB implies wind A and B are ok for display
(use-same-frame-for-AB (and (not use-same-frame)
(eq frame-A frame-B)))
(merge-window-share (ediff-eval-in-buffer control-buf
@ -440,37 +462,42 @@ into icons, regardless of the window manager.")
;; buf-A on its own
(if (and (window-live-p wind-A)
(null use-same-frame)
(null use-same-frame) ; implies wind-A is suitable
(null use-same-frame-for-AB))
(progn
(progn ; bug A on its own
;; buffer buf-A is seen in live wind-A
(select-window wind-A)
(delete-other-windows)
(switch-to-buffer buf-A)
(setq wind-A (selected-window))
(setq done-A t)))
;; buf-B on its own
(if (and (window-live-p wind-B) (null use-same-frame)) ; buf B on its own
(progn
(if (and (window-live-p wind-B)
(null use-same-frame) ; implies wind-B is suitable
(null use-same-frame-for-AB))
(progn ; buf B on its own
;; buffer buf-B is seen in live wind-B
(select-window wind-B)
(delete-other-windows)
(switch-to-buffer buf-B)
(setq wind-B (selected-window))
(setq done-B t)))
;; buf-C on its own
(if (and (window-live-p wind-C) (null use-same-frame)) ; buf C on its own
(if (and (window-live-p wind-C)
(ediff-window-ok-for-display wind-C)
(null use-same-frame)) ; buf C on its own
(progn
;; buffer buf-C is seen in live wind-C
(select-window wind-C)
(delete-other-windows)
(switch-to-buffer buf-C)
(setq wind-C (selected-window))
(setq done-C t)))
(if use-same-frame-for-AB
(if (and use-same-frame-for-AB ; implies wind A and B are suitable
(window-live-p wind-A))
(progn
(select-frame frame-A)
(switch-to-buffer buf-A)
;; wind-A must already be displaying buf-A
(select-window wind-A)
(delete-other-windows)
(setq wind-A (selected-window))
@ -484,31 +511,15 @@ into icons, regardless of the window manager.")
done-B t)))
(if use-same-frame
(let ((curr-frame (selected-frame))
(window-min-height 1))
(let ((window-min-height 1))
;; avoid dedicated and non-splittable windows
(ediff-skip-unsuitable-frames)
(or (eq curr-frame (selected-frame))
(setq wind-A nil
wind-B nil
wind-C nil
orig-wind (selected-window)))
;; set the right frame
(cond (wind-A (select-window wind-A))
(wind-B (select-window wind-B))
(wind-C (select-window wind-C))
(t (select-window orig-wind)))
(delete-other-windows)
(setq merge-window-lines
(max 2 (round (* (window-height) merge-window-share))))
(switch-to-buffer buf-A)
(setq wind-A (selected-window))
;; XEmacs used to have a lot of trouble with display
;; It did't set things right unless we told it to catch breath
;;(if ediff-xemacs-p (sit-for 0))
(split-window-vertically
(max 2 (- (window-height) merge-window-lines)))
(if (eq (selected-window) wind-A)
@ -529,23 +540,32 @@ into icons, regardless of the window manager.")
done-C t)
))
(or done-A ; Buf A to be set in its own frame
(progn ; It was not set up yet as it wasn't visible
(or done-A ; Buf A to be set in its own frame,
;;; or it was set before because use-same-frame = 1
(progn
;; Buf-A was not set up yet as it wasn't visible,
;; and use-same-frame = nil, use-same-frame-for-AB = nil
(select-window orig-wind)
(delete-other-windows)
(switch-to-buffer buf-A)
(setq wind-A (selected-window))
))
(or done-B ; Buf B to be set in its own frame
(progn ; It was not set up yet as it wasn't visible
(or done-B ; Buf B to be set in its own frame,
;;; or it was set before because use-same-frame = 1
(progn
;; Buf-B was not set up yet as it wasn't visible
;; and use-same-frame = nil, use-same-frame-for-AB = nil
(select-window orig-wind)
(delete-other-windows)
(switch-to-buffer buf-B)
(setq wind-B (selected-window))
))
(or done-C ; Buf C to be set in its own frame.
(progn ; It was not set up yet as it wasn't visible
(or done-C ; Buf C to be set in its own frame,
;;; or it was set before because use-same-frame = 1
(progn
;; Buf-C was not set up yet as it wasn't visible
;; and use-same-frame = nil
(select-window orig-wind)
(delete-other-windows)
(switch-to-buffer buf-C)
@ -602,9 +622,12 @@ into icons, regardless of the window manager.")
(orig-wind (selected-window))
(use-same-frame (or force-one-frame
(eq frame-A frame-B)
(not (ediff-window-ok-for-display wind-A))
(not (ediff-window-ok-for-display wind-B))
(if three-way-comparison
(or (eq frame-A frame-C)
(eq frame-B frame-C)
(not (ediff-window-ok-for-display wind-C))
(not (frame-live-p frame-A))
(not (frame-live-p frame-B))
(not (frame-live-p frame-C))))
@ -628,53 +651,36 @@ into icons, regardless of the window manager.")
(if (and (window-live-p wind-A) (null use-same-frame)) ; buf-A on its own
(progn
(select-window wind-A)
;; buffer buf-A is seen in live wind-A
(select-window wind-A) ; must be displaying buf-A
(delete-other-windows)
(switch-to-buffer buf-A)
(setq wind-A (selected-window))
(setq done-A t)))
(if (and (window-live-p wind-B) (null use-same-frame)) ; buf B on its own
(progn
(select-window wind-B)
;; buffer buf-B is seen in live wind-B
(select-window wind-B) ; must be displaying buf-B
(delete-other-windows)
(switch-to-buffer buf-B)
(setq wind-B (selected-window))
(setq done-B t)))
(if (and (window-live-p wind-C) (null use-same-frame)) ; buf C on its own
(progn
(select-window wind-C)
;; buffer buf-C is seen in live wind-C
(select-window wind-C) ; must be displaying buf-C
(delete-other-windows)
(switch-to-buffer buf-C)
(setq wind-C (selected-window))
(setq done-C t)))
(if use-same-frame
(let ((curr-frame (selected-frame))
;; this affects 3way setups only
wind-width-or-height)
(let (wind-width-or-height) ; this affects 3way setups only
;; avoid dedicated and non-splittable windows
(ediff-skip-unsuitable-frames)
(or (eq curr-frame (selected-frame))
(setq wind-A nil
wind-B nil
wind-C nil
orig-wind (selected-window)))
;; set the right frame
(cond (wind-A (select-window wind-A))
(wind-B (select-window wind-B))
(wind-C (select-window wind-C))
(t (select-window orig-wind)))
(delete-other-windows)
(switch-to-buffer buf-A)
(setq wind-A (selected-window))
;; XEmacs used to have a lot of trouble with display
;; It didn't set things right unless we told it to catch breath
;;(if ediff-xemacs-p (sit-for 0))
(if three-way-comparison
(setq wind-width-or-height
(/
@ -702,14 +708,20 @@ into icons, regardless of the window manager.")
))
(or done-A ; Buf A to be set in its own frame
(progn ; It was not set up yet as it wasn't visible
;;; or it was set before because use-same-frame = 1
(progn
;; Buf-A was not set up yet as it wasn't visible,
;; and use-same-frame = nil
(select-window orig-wind)
(delete-other-windows)
(switch-to-buffer buf-A)
(setq wind-A (selected-window))
))
(or done-B ; Buf B to be set in its own frame
(progn ; It was not set up yet as it wasn't visible
;;; or it was set before because use-same-frame = 1
(progn
;; Buf-B was not set up yet as it wasn't visible,
;; and use-same-frame = nil
(select-window orig-wind)
(delete-other-windows)
(switch-to-buffer buf-B)
@ -718,7 +730,10 @@ into icons, regardless of the window manager.")
(if three-way-comparison
(or done-C ; Buf C to be set in its own frame
(progn ; It was not set up yet as it wasn't visible
;;; or it was set before because use-same-frame = 1
(progn
;; Buf-C was not set up yet as it wasn't visible,
;; and use-same-frame = nil
(select-window orig-wind)
(delete-other-windows)
(switch-to-buffer buf-C)
@ -734,8 +749,8 @@ into icons, regardless of the window manager.")
designated-minibuffer-frame
(window-frame (minibuffer-window frame-A))))
;; It is unlikely that we'll implement ediff-windows that would compare
;; 3 windows at once. So, we don't use buffer C here.
;; It is unlikely that we'll implement a version of ediff-windows that
;; would compare 3 windows at once. So, we don't use buffer C here.
(if ediff-windows-job
(progn
(set-window-start wind-A wind-A-start)
@ -744,14 +759,14 @@ into icons, regardless of the window manager.")
(ediff-setup-control-frame control-buf designated-minibuffer-frame)
))
;; skip unsplittable and dedicated windows
;; skip unsplittable frames and frames that have dedicated windows.
;; create a new splittable frame if none is found
(defun ediff-skip-unsuitable-frames (&optional ok-unsplittable)
(if (ediff-window-display-p)
(let (last-window)
(while (and (not (eq (selected-window) last-window))
(or
(window-dedicated-p (selected-window))
(ediff-frame-has-dedicated-windows (selected-frame))
(ediff-frame-iconified-p (selected-frame))
(< (frame-height (selected-frame))
(* 3 window-min-height))
@ -765,14 +780,41 @@ into icons, regardless of the window manager.")
(if (eq (selected-window) last-window)
;; fed up, no appropriate frame
(progn
;;(redraw-display)
(select-frame (make-frame '((unsplittable)))))))))
(defun ediff-frame-has-dedicated-windows (frame)
(let ((cur-fr (selected-frame))
ans)
(select-frame frame)
(walk-windows
(function (lambda (wind)
(if (window-dedicated-p wind)
(setq ans t))))
'ignore-minibuffer
frame)
(select-frame cur-fr)
ans))
;; window is ok, if it is only one window on the frame, not counting the
;; minibuffer, or none of the frame's windows is dedicated.
;; The idea is that it is bad to destroy dedicated windows while creating an
;; ediff window setup
(defun ediff-window-ok-for-display (wind)
(and
(window-live-p wind)
(or
;; only one window
(eq wind (next-window wind 'ignore-minibuffer (window-frame wind)))
;; none is dedicated
(not (ediff-frame-has-dedicated-windows (window-frame wind)))
)))
;; Prepare or refresh control frame
(defun ediff-setup-control-frame (ctl-buffer designated-minibuffer-frame)
(let ((window-min-height 1)
ctl-frame-iconified-p dont-iconify-ctl-frame deiconify-ctl-frame
ctl-frame old-ctl-frame lines user-grabbed-mouse
ctl-frame old-ctl-frame lines
;; user-grabbed-mouse
fheight fwidth adjusted-parameters)
(ediff-eval-in-buffer ctl-buffer
@ -813,7 +855,6 @@ into icons, regardless of the window manager.")
fheight lines
fwidth (+ (ediff-help-message-line-length) 2)
adjusted-parameters (append (list
'(visibility . t)
;; possibly change surrogate minibuffer
(cons 'minibuffer
(minibuffer-window
@ -851,6 +892,7 @@ into icons, regardless of the window manager.")
(goto-char (point-min))
(modify-frame-parameters ctl-frame adjusted-parameters)
(make-frame-visible ctl-frame)
;; This works around a bug in 19.25 and earlier. There, if frame gets
;; iconified, the current buffer changes to that of the frame that
@ -865,11 +907,9 @@ into icons, regardless of the window manager.")
((or deiconify-ctl-frame (not ctl-frame-iconified-p))
(raise-frame ctl-frame)))
(if ediff-xemacs-p
(set-window-buffer-dedicated (selected-window) ctl-buffer)
(set-window-dedicated-p (selected-window) t))
(set-window-dedicated-p (selected-window) t)
;; resynch so the cursor will move to control frame
;; synchronize so the cursor will move to control frame
;; per RMS suggestion
(if (ediff-window-display-p)
(let ((count 7))
@ -886,8 +926,8 @@ into icons, regardless of the window manager.")
(if ediff-xemacs-p
(ediff-eval-in-buffer ctl-buffer
(make-local-variable 'select-frame-hook)
(add-hook 'select-frame-hook 'ediff-xemacs-select-frame-hook)
(make-local-hook 'select-frame-hook)
(add-hook 'select-frame-hook 'ediff-xemacs-select-frame-hook nil t)
))
(ediff-eval-in-buffer ctl-buffer
@ -1021,7 +1061,7 @@ It assumes that it is called from within the control buffer."
(setq mode-line-format
(list (if (ediff-narrow-control-frame-p) " " "-- ")
mode-line-buffer-identification
" Howdy!"))
" Quick Help"))
;; control buffer id
(setq mode-line-buffer-identification
(if (ediff-narrow-control-frame-p)
@ -1072,15 +1112,16 @@ It assumes that it is called from within the control buffer."
(defun ediff-refresh-control-frame ()
(setq frame-title-format (ediff-make-narrow-control-buffer-id)
frame-icon-title-format (ediff-make-narrow-control-buffer-id) ; XEmacs
icon-title-format (ediff-make-narrow-control-buffer-id)) ; Emacs
;; the emacs part will be modified once the 'name and 'title
;; frame parameters are separated
(if ediff-emacs-p
;; set frame/icon titles for Emacs
(modify-frame-parameters
ediff-control-frame
(list (cons 'name (ediff-make-narrow-control-buffer-id))))
(list (cons 'title (ediff-make-base-title))
(cons 'icon-name (ediff-make-narrow-control-buffer-id))
))
;; set frame/icon titles for XEmacs
(setq frame-title-format (ediff-make-base-title)
frame-icon-title-format (ediff-make-narrow-control-buffer-id))
;; force an update of the frame title
(modify-frame-parameters ediff-control-frame '(()))))
@ -1089,9 +1130,7 @@ It assumes that it is called from within the control buffer."
(concat
(if skip-name
" "
(concat
(cdr (assoc 'name ediff-control-frame-parameters))
ediff-control-buffer-suffix))
(ediff-make-base-title))
(cond ((< ediff-current-difference 0)
(format " _/%d" ediff-number-of-differences))
((>= ediff-current-difference ediff-number-of-differences)
@ -1100,6 +1139,11 @@ It assumes that it is called from within the control buffer."
(format " %d/%d"
(1+ ediff-current-difference)
ediff-number-of-differences)))))
(defun ediff-make-base-title ()
(concat
(cdr (assoc 'name ediff-control-frame-parameters))
ediff-control-buffer-suffix))
(defun ediff-make-wide-control-buffer-id ()
(cond ((< ediff-current-difference 0)
@ -1122,8 +1166,8 @@ It assumes that it is called from within the control buffer."
(get-buffer-window buff t)
(get-buffer-window buff 'visible))))
;;; Functions to decide when to redraw windows
;;; Functions to decide when to redraw windows
(defun ediff-keep-window-config (control-buf)
(and (eq control-buf (current-buffer))
@ -1152,6 +1196,11 @@ It assumes that it is called from within the control buffer."
ediff-wide-display-p)))))))
;;; Local Variables:
;;; eval: (put 'ediff-defvar-local 'lisp-indent-hook 'defun)
;;; eval: (put 'ediff-eval-in-buffer 'lisp-indent-hook 1)
;;; End:
(provide 'ediff-wind)

340
lisp/ediff.el
View File

@ -1,13 +1,14 @@
;;; ediff.el --- a comprehensive visual interface to diff & patch
;; Copyright (C) 1994, 1995 Free Software Foundation, Inc.
;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.sunysb.edu>
;; Created: February 2, 1994
;; Keywords: comparing, merging, patching, version control.
(defconst ediff-version "2.54" "The current version of Ediff")
(defconst ediff-date "February 14, 1996" "Date of last update")
(defconst ediff-version "2.61" "The current version of Ediff")
(defconst ediff-date "June 10, 1996" "Date of last update")
;; This file is part of GNU Emacs.
@ -29,7 +30,7 @@
;;; Commentary:
;; Never read that diff output again!
;; Apply patch selectively, like a pro!
;; Apply patch interactively!
;; Merge with ease!
;; This package provides a convenient way of simultaneous browsing through
@ -58,7 +59,7 @@
;; files with their older versions. Ediff can also work with remote and
;; compressed files. Details are given below.
;; Finally, Ediff supports directory-level comparison and merging operations.
;; Finally, Ediff supports directory-level comparison, merging and patching.
;; See the on-line manual for details.
;; This package builds upon the ideas borrowed from emerge.el and several
@ -106,8 +107,15 @@
;;; Code:
(require 'ediff-init)
;; ediff-mult is always required, because of the registry stuff
(require 'ediff-mult)
(eval-when-compile
(load "dired")
(load-file "./ediff-ptch.el")
(load-file "./ediff-vers.el")
(load "pcl-cvs" 'noerror))
(defvar ediff-use-last-dir nil
"*If t, Ediff uses previous directory as default when reading file name.")
@ -119,148 +127,14 @@
"Last directory used by an Ediff command for file-C.")
(defvar ediff-last-dir-ancestor nil
"Last directory used by an Ediff command for the ancestor file.")
(defvar ediff-last-dir-patch nil
"Last directory used by an Ediff command for file to patch.")
;;; Patching
;; Some defvars to reduce the number of compiler warnings
(defvar cvs-cookie-handle)
(defvar ediff-last-dir-patch)
(defvar ediff-patch-default-directory)
;; end of compiler pacifier
(defvar ediff-backup-extension
(if (memq system-type '(vax-vms axp-vms emx ms-dos windows-nt windows-95))
"_orig" ".orig")
"Default backup extension for the patch program.")
;;;###autoload
(defun ediff-patch-file (source-filename &optional startup-hooks job-name)
"Run Ediff by patching SOURCE-FILENAME."
;; This now returns the control buffer
(interactive
(list (ediff-read-file-name
"File to patch"
(if ediff-use-last-dir
ediff-last-dir-patch
default-directory)
(ediff-get-default-file-name))))
(setq source-filename (expand-file-name source-filename))
(ediff-get-patch-buffer
(if (eq job-name 'ediff-patch-buffer)
(ediff-eval-in-buffer (get-file-buffer source-filename)
default-directory)
(file-name-directory source-filename)))
(let* ((backup-extension
;; if the user specified a -b option, extract the backup
;; extension from there; else use ediff-backup-extension
(substring ediff-patch-options
(if (string-match "-b[ \t]+" ediff-patch-options)
(match-end 0) 0)
(if (string-match "-b[ \t]+[^ \t]+" ediff-patch-options)
(match-end 0) 0)))
(shell-file-name ediff-shell)
;; ediff-find-file may use a temp file to do the patch
;; so, we save source-filename and true-source-filename as a var
;; that initially is source-filename but may be changed to a temp
;; file for the purpose of patching.
(true-source-filename source-filename)
(target-filename source-filename)
target-buf buf-to-patch file-name-magic-p ctl-buf backup-style)
;; if the user didn't specify a backup extension, use
;; ediff-backup-extension
(if (string= backup-extension "")
(setq backup-extension ediff-backup-extension))
(if (string-match "-V" ediff-patch-options)
(error
"Ediff doesn't take the -V option in `ediff-patch-options'--sorry"))
;; Make a temp file, if source-filename has a magic file handler (or if
;; it is handled via auto-mode-alist and similar magic).
;; Check if there is a buffer visiting source-filename and if they are in
;; sync; arrange for the deletion of temp file.
(ediff-find-file 'true-source-filename 'buf-to-patch
'ediff-last-dir-patch 'startup-hooks)
;; Check if source file name has triggered black magic, such as file name
;; handlers or auto mode alist, and make a note of it.
;; true-source-filename should be either the original name or a
;; temporary file where we put the after-product of the file handler.
(setq file-name-magic-p (not (equal (file-truename true-source-filename)
(file-truename source-filename))))
;; Checkout orig file, if necessary, so that the patched file could be
;; checked back in.
(if (ediff-file-checked-in-p (buffer-file-name buf-to-patch))
(ediff-toggle-read-only buf-to-patch))
(ediff-eval-in-buffer ediff-patch-diagnostics
(message "Applying patch ... ")
;; fix environment for gnu patch, so it won't make numbered extensions
(setq backup-style (getenv "VERSION_CONTROL"))
(setenv "VERSION_CONTROL" nil)
;; always pass patch the -f option, so it won't ask any questions
(shell-command-on-region
(point-min) (point-max)
(format "%s -f %s -b %s %s"
ediff-patch-program ediff-patch-options
backup-extension
(expand-file-name true-source-filename))
t)
;; restore environment for gnu patch
(setenv "VERSION_CONTROL" backup-style))
;;(message "Applying patch ... done")(sit-for 0)
(switch-to-buffer ediff-patch-diagnostics)
(sit-for 0) ; synchronize - let the user see diagnostics
(or (file-exists-p (concat true-source-filename backup-extension))
(error "Patch failed or didn't modify the original file"))
;; If black magic is involved, apply patch to a temp copy of the
;; file. Otherwise, apply patch to the orig copy. If patch is applied
;; to temp copy, we name the result old-name_patched for local files
;; and temp-copy_patched for remote files. The orig file name isn't
;; changed, and the temp copy of the original is later deleted.
;; Without magic, the original file is renamed (usually into
;; old-name_orig) and the result of patching will have the same name as
;; the original.
(if (not file-name-magic-p)
(ediff-eval-in-buffer buf-to-patch
(set-visited-file-name (concat source-filename backup-extension))
(set-buffer-modified-p nil))
;; Black magic in effect.
;; If orig file was remote, put the patched file in the temp directory.
;; If orig file is local, put the patched file in the directory of
;; the orig file.
(setq target-filename
(concat
(if (ediff-file-remote-p (file-truename source-filename))
true-source-filename
source-filename)
"_patched"))
(rename-file true-source-filename target-filename t)
;; arrange that the temp copy of orig will be deleted
(rename-file (concat true-source-filename backup-extension)
true-source-filename t))
;; make orig buffer read-only
(setq startup-hooks
(cons 'ediff-set-read-only-in-buf-A startup-hooks))
;; set up a buf for the patched file
(setq target-buf (find-file-noselect target-filename))
(setq ctl-buf
(ediff-buffers-internal
buf-to-patch target-buf nil
startup-hooks (or job-name 'ediff-patch-file)))
(bury-buffer ediff-patch-diagnostics)
(message "Patch diagnostics are available in buffer %s"
(buffer-name ediff-patch-diagnostics))
ctl-buf))
;; Used as a startup hook to set `_orig' patch file read-only.
(defun ediff-set-read-only-in-buf-A ()
(ediff-eval-in-buffer ediff-buffer-A
@ -278,11 +152,6 @@
(file-name-nondirectory (buffer-file-name (current-buffer))))
))
;;;###autoload
(defalias 'epatch 'ediff-patch-file)
;;;###autoload
(defalias 'epatch-buffer 'ediff-patch-buffer)
;;; Compare files/buffers
;;;###autoload
@ -465,9 +334,12 @@
(save-window-excursion (other-window 1))
(ediff-other-buffer bf))
t))))
(or job-name (setq job-name 'ediff-buffers))
(ediff-buffers-internal buffer-A buffer-B nil startup-hooks job-name))
;;;###autoload
(defalias 'ebuffers 'ediff-buffers)
;;;###autoload
(defun ediff-buffers3 (buffer-A buffer-B buffer-C
@ -492,9 +364,11 @@
(ediff-other-buffer (list bf bff)))
t)
)))
(or job-name (setq job-name 'ediff-buffers3))
(ediff-buffers-internal buffer-A buffer-B buffer-C startup-hooks job-name))
;;;###autoload
(defalias 'ebuffers3 'ediff-buffers3)
@ -559,18 +433,18 @@
(defun ediff-directories (dir1 dir2 regexp)
"Run Ediff on a pair of directories, DIR1 and DIR2, comparing files that have
the same name in both. The third argument, REGEXP, is a regular expression that
further filters the file names."
can be used to filter out certain file names."
(interactive
(let ((dir-A (ediff-get-default-directory-name))
f)
(list (setq f (ediff-read-file-name "Directory A to compare" dir-A nil))
(ediff-read-file-name "Directory B to compare"
(list (setq f (ediff-read-file-name "Directory A to compare:" dir-A nil))
(ediff-read-file-name "Directory B to compare:"
(if ediff-use-last-dir
ediff-last-dir-B
(ediff-strip-last-dir f))
nil)
(read-string "Filter through regular expression: "
nil ediff-filtering-regexp-history)
nil 'ediff-filtering-regexp-history)
)))
(ediff-directories-internal
dir1 dir2 nil regexp 'ediff-files 'ediff-directories
@ -588,9 +462,9 @@ names. Only the files that are under revision control are taken into account."
(interactive
(let ((dir-A (ediff-get-default-directory-name)))
(list (ediff-read-file-name
"Directory to compare with revision" dir-A nil)
"Directory to compare with revision:" dir-A nil)
(read-string "Filter through regular expression: "
nil ediff-filtering-regexp-history)
nil 'ediff-filtering-regexp-history)
)))
(ediff-directory-revisions-internal
dir1 regexp 'ediff-revision 'ediff-directory-revisions
@ -604,23 +478,23 @@ names. Only the files that are under revision control are taken into account."
(defun ediff-directories3 (dir1 dir2 dir3 regexp)
"Run Ediff on three directories, DIR1, DIR2, and DIR3, comparing files that
have the same name in all three. The last argument, REGEXP, is a regular
expression that further filters the file names."
expression that can be used to filter out certain file names."
(interactive
(let ((dir-A (ediff-get-default-directory-name))
f)
(list (setq f (ediff-read-file-name "Directory A to compare" dir-A nil))
(setq f (ediff-read-file-name "Directory B to compare"
(list (setq f (ediff-read-file-name "Directory A to compare:" dir-A nil))
(setq f (ediff-read-file-name "Directory B to compare:"
(if ediff-use-last-dir
ediff-last-dir-B
(ediff-strip-last-dir f))
nil))
(ediff-read-file-name "Directory C to compare"
(ediff-read-file-name "Directory C to compare:"
(if ediff-use-last-dir
ediff-last-dir-C
(ediff-strip-last-dir f))
nil)
(read-string "Filter through regular expression: "
nil ediff-filtering-regexp-history)
nil 'ediff-filtering-regexp-history)
)))
(ediff-directories-internal
dir1 dir2 dir3 regexp 'ediff-files3 'ediff-directories3
@ -633,18 +507,18 @@ expression that further filters the file names."
(defun ediff-merge-directories (dir1 dir2 regexp)
"Run Ediff on a pair of directories, DIR1 and DIR2, merging files that have
the same name in both. The third argument, REGEXP, is a regular expression that
further filters the file names."
can be used to filter out certain file names."
(interactive
(let ((dir-A (ediff-get-default-directory-name))
f)
(list (setq f (ediff-read-file-name "Directory A to merge" dir-A nil))
(ediff-read-file-name "Directory B to merge"
(list (setq f (ediff-read-file-name "Directory A to merge:" dir-A nil))
(ediff-read-file-name "Directory B to merge:"
(if ediff-use-last-dir
ediff-last-dir-B
(ediff-strip-last-dir f))
nil)
(read-string "Filter through regular expression: "
nil ediff-filtering-regexp-history)
nil 'ediff-filtering-regexp-history)
)))
(ediff-directories-internal
dir1 dir2 nil regexp 'ediff-merge-files 'ediff-merge-directories
@ -654,29 +528,31 @@ further filters the file names."
(defalias 'edirs-merge 'ediff-merge-directories)
;;;###autoload
(defun ediff-merge-directories-with-ancestor (dir1 dir2 dir3 regexp)
"Run Ediff on a pair of directories, DIR1 and DIR2, merging files that have
the same name in both. The third argument, REGEXP, is a regular expression that
further filters the file names."
(defun ediff-merge-directories-with-ancestor (dir1 dir2 ancestor-dir regexp)
"Merge files in directories DIR1 and DIR2 using files in ANCESTOR-DIR as ancestors.
Ediff merges files that have identical names in DIR1, DIR2. If a pair of files
in DIR1 and DIR2 doesn't have an ancestor in ANCESTOR-DIR, Ediff will merge
without ancestor. The fourth argument, REGEXP, is a regular expression that
can be used to filter out certain file names."
(interactive
(let ((dir-A (ediff-get-default-directory-name))
f)
(list (setq f (ediff-read-file-name "Directory A to merge" dir-A nil))
(setq f (ediff-read-file-name "Directory B to merge"
(list (setq f (ediff-read-file-name "Directory A to merge:" dir-A nil))
(setq f (ediff-read-file-name "Directory B to merge:"
(if ediff-use-last-dir
ediff-last-dir-B
(ediff-strip-last-dir f))
nil))
(ediff-read-file-name "Ancestor directory: "
(ediff-read-file-name "Ancestor directory:"
(if ediff-use-last-dir
ediff-last-dir-C
(ediff-strip-last-dir f))
nil)
(read-string "Filter through regular expression: "
nil ediff-filtering-regexp-history)
nil 'ediff-filtering-regexp-history)
)))
(ediff-directories-internal
dir1 dir2 dir3 regexp
dir1 dir2 ancestor-dir regexp
'ediff-merge-files-with-ancestor 'ediff-merge-directories-with-ancestor
))
@ -688,9 +564,9 @@ names. Only the files that are under revision control are taken into account."
(interactive
(let ((dir-A (ediff-get-default-directory-name)))
(list (ediff-read-file-name
"Directory to merge with revisions" dir-A nil)
"Directory to merge with revisions:" dir-A nil)
(read-string "Filter through regular expression: "
nil ediff-filtering-regexp-history)
nil 'ediff-filtering-regexp-history)
)))
(ediff-directory-revisions-internal
dir1 regexp 'ediff-merge-revisions 'ediff-merge-directory-revisions
@ -707,9 +583,9 @@ names. Only the files that are under revision control are taken into account."
(interactive
(let ((dir-A (ediff-get-default-directory-name)))
(list (ediff-read-file-name
"Directory to merge with revisions and ancestors" dir-A nil)
"Directory to merge with revisions and ancestors:" dir-A nil)
(read-string "Filter through regular expression: "
nil ediff-filtering-regexp-history)
nil 'ediff-filtering-regexp-history)
)))
(ediff-directory-revisions-internal
dir1 regexp 'ediff-merge-revisions-with-ancestor
@ -726,8 +602,8 @@ names. Only the files that are under revision control are taken into account."
;; Run ediff-action (ediff-files, ediff-merge, ediff-merge-with-ancestors)
;; on a pair of directories (three directories, in case of ancestor).
;; The third argument, REGEXP, is a regular expression that further filters the
;; file names.
;; The third argument, REGEXP, is a regular expression that can be used to
;; filter out certain file names.
;; JOBNAME is the symbol indicating the meta-job to be performed.
(defun ediff-directories-internal (dir1 dir2 dir3 regexp
action jobname
@ -763,7 +639,7 @@ names. Only the files that are under revision control are taken into account."
(setq ediff-dir-difference-list (quote (, diffs)))))
startup-hooks))
(setq meta-buf (ediff-prepare-meta-buffer
'ediff-dir-action
'ediff-filegroup-action
file-list
"*Ediff Session Group Panel"
'ediff-redraw-directory-group-buffer
@ -787,7 +663,7 @@ names. Only the files that are under revision control are taken into account."
))
startup-hooks))
(setq meta-buf (ediff-prepare-meta-buffer
'ediff-dir-action
'ediff-filegroup-action
file-list
"*Ediff Session Group Panel"
'ediff-redraw-directory-group-buffer
@ -1225,68 +1101,48 @@ file and then run `run-ediff-from-cvs-buffer'."
;;; Apply patch
;;;###autoload
(defun ediff-patch-buffer (buffer-name &optional startup-hooks)
(defun ediff-patch-file ()
"Run Ediff by patching SOURCE-FILENAME."
;; This now returns the control buffer
(interactive)
(let (source-dir source-file patch-buf)
(require 'ediff-ptch)
(setq patch-buf (ediff-get-patch-buffer))
(setq source-dir (cond (ediff-use-last-dir ediff-last-dir-patch)
((and (not ediff-patch-default-directory)
(buffer-file-name patch-buf))
(file-name-directory
(expand-file-name
(buffer-file-name patch-buf))))
(t default-directory)))
(setq source-file
;; the default is the directory, not the visited file name
(ediff-read-file-name "Which file to patch? " source-dir source-dir))
(ediff-dispatch-file-patching-job patch-buf source-file)))
;;;###autoload
(defun ediff-patch-buffer ()
"Run Ediff by patching BUFFER-NAME."
(interactive "bBuffer to patch: ")
(interactive)
(let (patch-buf)
(require 'ediff-ptch)
(setq patch-buf (ediff-get-patch-buffer))
(ediff-patch-buffer-internal
patch-buf
(read-buffer "Which buffer to patch? "
(cond ((eq patch-buf (current-buffer))
(window-buffer (other-window 1)))
(t (current-buffer)))
'must-match))))
(let* ((buf-to-patch (get-buffer buffer-name))
(file-name-ok (if buf-to-patch (buffer-file-name buf-to-patch)))
(buf-mod-status (buffer-modified-p buf-to-patch))
default-dir file-name ctl-buf)
(if file-name-ok
(setq file-name file-name-ok)
(ediff-eval-in-buffer buffer-name
(setq default-dir default-directory)
(setq file-name (ediff-make-temp-file buffer-name))
(set-visited-file-name file-name)
(setq buffer-auto-save-file-name nil) ; don't create auto-save file
(rename-buffer buffer-name) ; don't confuse the user with new buf name
(set-buffer-modified-p nil)
(set-visited-file-modtime) ; sync buffer and temp file
(setq default-directory default-dir)
))
(setq ctl-buf
(ediff-patch-file file-name startup-hooks 'ediff-patch-buffer))
(if file-name-ok
()
(ediff-eval-in-buffer ctl-buf
(delete-file (buffer-file-name ediff-buffer-A))
(delete-file (buffer-file-name ediff-buffer-B))
(ediff-eval-in-buffer ediff-buffer-A
(if default-dir (setq default-directory default-dir))
(set-visited-file-name nil)
(rename-buffer buffer-name)
(set-buffer-modified-p buf-mod-status))
(ediff-eval-in-buffer ediff-buffer-B
(setq buffer-auto-save-file-name nil) ; don't create auto-save file
(if default-dir (setq default-directory default-dir))
(set-visited-file-name nil)
(rename-buffer (ediff-unique-buffer-name
(concat buffer-name "_patched") ""))
(set-buffer-modified-p t))))
))
;;;###autoload
(defalias 'epatch 'ediff-patch-file)
;;;###autoload
(defalias 'epatch-buffer 'ediff-patch-buffer)
(defun ediff-get-patch-buffer (dir)
"Obtain patch buffer. If patch is already in a buffer---use it.
Else, read patch file into a new buffer."
(if (y-or-n-p "Is the patch file already in a buffer? ")
(setq ediff-patch-buf
(get-buffer (read-buffer "Patch buffer name: " nil t))) ;must match
(setq ediff-patch-buf
(find-file-noselect (read-file-name "Patch file name: " dir))))
(setq ediff-patch-diagnostics
(get-buffer-create "*ediff patch diagnostics*"))
(ediff-eval-in-buffer ediff-patch-diagnostics
(insert-buffer ediff-patch-buf)))
;;; Versions Control functions
@ -1343,7 +1199,7 @@ When called interactively, displays the version."
;;;###autoload
(defun ediff-documentation ()
"Jump to Ediff's Info file."
"Display Ediff's manual."
(interactive)
(let ((ctl-window ediff-control-window)
(ctl-buf ediff-control-buffer))
@ -1355,7 +1211,7 @@ When called interactively, displays the version."
(info (if ediff-xemacs-p "ediff.info" "ediff"))
(message "Type `i' to search for a specific topic"))
(error (beep 1)
(with-output-to-temp-buffer " *ediff-info*"
(with-output-to-temp-buffer ediff-msg-buffer
(princ (format "
The Info file for Ediff does not seem to be installed.

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

File diff suppressed because it is too large Load Diff

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

@ -844,7 +844,7 @@ there."
macro)))
(defun vip-char-array-p (array)
(eval (cons 'and (mapcar 'numberp array))))
(eval (cons 'and (mapcar 'vip-characterp array))))
(defun vip-macro-to-events (macro-body)
(vconcat (mapcar 'vip-key-to-emacs-key macro-body)))

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

@ -192,8 +192,8 @@ On single or double click, returns the word as determined by
(let ((click-word "")
(click-pos (vip-mouse-click-posn click))
(click-buf (vip-mouse-click-window-buffer click)))
(or (numberp count) (setq count 1))
(or (numberp click-count) (setq click-count 1))
(or (natnump count) (setq count 1))
(or (natnump click-count) (setq click-count 1))
(save-excursion
(save-window-excursion
@ -220,9 +220,9 @@ See `vip-surrounding-word' for the definition of a word in this case."
(select-frame vip-frame-of-focus))
;; turn arg into a number
(cond ((numberp arg) nil)
(cond ((integerp arg) nil)
;; prefix arg is a list when one hits C-u then command
((and (listp arg) (numberp (car arg)))
((and (listp arg) (integerp (car arg)))
(setq arg (car arg)))
(t (setq arg 1)))

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

@ -184,6 +184,10 @@ that Viper doesn't know about.")
(fset 'vip-color-defined-p (symbol-function 'x-color-defined-p))
)))
(fset 'vip-characterp
(symbol-function
(if vip-xemacs-p 'characterp 'integerp)))
(defsubst vip-color-display-p ()
(if vip-emacs-p
(x-display-color-p)
@ -395,6 +399,143 @@ that Viper doesn't know about.")
(setq temp (cdr temp)))
(nconc lis1 lis2)))
;;; Support for :e and file globbing
(defun vip-ex-nontrivial-find-file-unix (filespec)
"Glob the file spec and visit all files matching the spec.
This function is designed to work under Unix. It may also work under VMS.
Users who prefer other types of shells should write their own version of this
function and set the variable `ex-nontrivial-find-file-function'
appropriately."
(let ((gshell
(cond (ex-unix-type-shell shell-file-name)
((memq system-type '(vax-vms axp-vms)) "*dcl*") ; VAX VMS
(t "sh"))) ; probably Unix anyway
(gshell-options
;; using cond in anticipation of further additions
(cond (ex-unix-type-shell-options)
))
(command (cond (vip-ms-style-os-p (format "\"ls -1 %s\"" filespec))
(t (format "ls -1 %s" filespec))))
file-list)
(save-excursion
(set-buffer (setq tmp-buf (get-buffer-create vip-ex-tmp-buf-name)))
(erase-buffer)
(setq status
(if gshell-options
(call-process gshell nil t nil
gshell-options
"-c"
command)
(call-process gshell nil t nil
"-c"
command)))
(goto-char (point-min))
;; Issue an error, if no match.
(if (> status 0)
(save-excursion
(skip-chars-forward " \t\n\j")
(if (looking-at "ls:")
(vip-forward-Word 1))
(error "%s: %s"
(if (stringp gshell)
gshell
"shell")
(buffer-substring (point) (vip-line-pos 'end)))
))
(goto-char (point-min))
(setq file-list (vip-get-filenames-from-buffer 'one-per-line)))
(mapcar 'find-file file-list)
))
(defun vip-ex-nontrivial-find-file-ms (filespec)
"Glob the file spec and visit all files matching the spec.
This function is designed to work under MS type systems, such as NT, W95, and
DOS. It may also work under OS/2.
The users of Unix-type shells should be able to use
`vip-ex-nontrivial-find-file-unix', making it into the value of the variable
`ex-nontrivial-find-file-function'. If this doesn't work, the user may have
to write a custom function, similar to `vip-ex-nontrivial-find-file-unix'."
(save-excursion
(set-buffer (setq tmp-buf (get-buffer-create vip-ex-tmp-buf-name)))
(erase-buffer)
(insert filespec)
(goto-char (point-min))
(mapcar 'find-file
(vip-glob-ms-windows-files (vip-get-filenames-from-buffer)))
))
;; Interpret the stuff in the buffer as a list of file names
;; return a list of file names listed in the buffer beginning at point
;; If optional arg is supplied, assume each filename is listed on a separate
;; line
(defun vip-get-filenames-from-buffer (one-per-line)
(let ((skip-chars (if one-per-line "\t\n" " \t\n"))
result fname delim)
(skip-chars-forward skip-chars)
(while (not (eobp))
(if (cond ((looking-at "\"")
(setq delim ?\")
(re-search-forward "[^\"]+" nil t)) ; noerror
((looking-at "'")
(setq delim ?')
(re-search-forward "[^']+" nil t)) ; noerror
(t
(re-search-forward
(concat "[^" skip-chars "]+") nil t))) ;noerror
(setq fname
(buffer-substring (match-beginning 0) (match-end 0))))
(if delim
(forward-char 1))
(skip-chars-forward " \t\n")
(setq result (cons fname result)))
result))
;; convert MS-DOS wildcards to regexp
(defun vip-wildcard-to-regexp (wcard)
(save-excursion
(set-buffer (setq tmp-buf (get-buffer-create vip-ex-tmp-buf-name)))
(erase-buffer)
(insert wcard)
(goto-char (point-min))
(while (not (eobp))
(skip-chars-forward "^*?.\\\\")
(cond ((eq (char-after (point)) ?*) (insert ".")(forward-char 1))
((eq (char-after (point)) ?.) (insert "\\")(forward-char 1))
((eq (char-after (point)) ?\\) (insert "\\")(forward-char 1))
((eq (char-after (point)) ??) (delete-char 1)(insert ".")))
)
(buffer-string)
))
;; glob windows files
;; LIST is expected to be in reverse order
(defun vip-glob-ms-windows-files (list)
(let ((tmp list)
(case-fold-search t)
tmp2)
(while tmp
(setq tmp2 (cons (directory-files
;; the directory part
(or (file-name-directory (car tmp))
"")
t ; return full names
;; the regexp part: globs the file names
(concat "^"
(vip-wildcard-to-regexp
(file-name-nondirectory (car tmp)))
"$"))
tmp2))
(setq tmp (cdr tmp)))
(reverse (apply 'append tmp2))))
@ -825,18 +966,18 @@ that Viper doesn't know about.")
;; 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 (numberp event) (<= ?A event) (<= event ?Z))
(cond ((and (vip-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 (numberp event) (< ?\C-? event) (<= event 255))
((and (vip-characterp event) (< ?\C-? event) (<= event 255))
(setq mod '(meta)
event (- event ?\C-? 1)))
(t (event-basic-type event)))
)))
(if (numberp basis)
(if (vip-characterp basis)
(setq basis
(if (= basis ?\C-?)
(list 'control '\?) ; taking care of an emacs bug
@ -884,16 +1025,23 @@ that Viper doesn't know about.")
;; characters, will return a string. Otherwise, will return a string
;; representing a vector of converted events. If the input was a Viper macro,
;; will return a string that represents this macro as a vector.
(defun vip-array-to-string (event-seq &optional representation)
(let (temp)
(defun vip-array-to-string (event-seq)
(let (temp temp2)
(cond ((stringp event-seq) event-seq)
((vip-event-vector-p event-seq)
(setq temp (mapcar 'vip-event-key event-seq))
(if (vip-char-symbol-sequence-p temp)
(mapconcat 'symbol-name temp "")
(prin1-to-string (vconcat temp))))
(cond ((vip-char-symbol-sequence-p temp)
(mapconcat 'symbol-name temp ""))
((and (vip-char-array-p
(setq temp2 (mapcar 'vip-key-to-character temp))))
(mapconcat 'char-to-string temp2 ""))
(t (prin1-to-string (vconcat temp)))))
((vip-char-symbol-sequence-p event-seq)
(mapconcat 'symbol-name event-seq ""))
((and (vectorp event-seq)
(vip-char-array-p
(setq temp (mapcar 'vip-key-to-character event-seq))))
(mapconcat 'char-to-string temp ""))
(t (prin1-to-string event-seq)))))
(defun vip-key-press-events-to-chars (events)
@ -919,6 +1067,21 @@ that Viper doesn't know about.")
(vip-read-event))))
char))
;; key is supposed to be in viper's representation, e.g., (control l), a
;; character, etc.
(defun vip-key-to-character (key)
(cond ((eq key 'space) ?\ )
((eq key 'delete) ?\C-?)
((eq key 'backspace) ?\C-h)
((and (symbolp key)
(= 1 (length (symbol-name key))))
(string-to-char (symbol-name key)))
((and (listp key)
(eq (car key) 'control)
(symbol-name (nth 1 key))
(= 1 (length (symbol-name (nth 1 key)))))
(read (format "?\\C-%s" (symbol-name (nth 1 key)))))
(t key)))
(defun vip-setup-master-buffer (&rest other-files-or-buffers)

158
lisp/emulation/viper.el
View File

@ -8,7 +8,7 @@
;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc.
(defconst viper-version "2.86 of March 14, 1996"
(defconst viper-version "2.90 of June 19, 1996"
"The current version of Viper")
;; This file is part of GNU Emacs.
@ -820,8 +820,12 @@ These buffers can be cycled through via :R and :P commands.")
(defvar vip-always t
"t means, arrange that vi-state will be a default.")
(defvar vip-custom-file-name (cond ((memq system-type '(vax-vms axp-vms))
"sys$login:.vip")
(defvar vip-ms-style-os-p (memq system-type '(ms-dos windows-nt windows-95))
"Tells is Emacs is running under an MS-style OS: ms-dos, window-nt, W95.")
(defvar vip-vms-os-p (memq system-type '(vax-vms axp-vms))
"Tells if Emacs is running under VMS.")
(defvar vip-custom-file-name (cond (vip-vms-os-p "sys$login:.vip")
((memq system-type '(emx ms-dos))
"/_vip")
((memq system-type '(windows-nt windows-95))
@ -831,6 +835,7 @@ These buffers can be cycled through via :R and :P commands.")
"Viper customisation file.
This variable must be set _before_ loading Viper.")
(defvar vip-spell-function 'ispell-region
"Spell function used by #s<move> command to spell.")
@ -1257,19 +1262,17 @@ Technically speaking, Viper is a Vi emulation package for GNU Emacs 19 and
XEmacs 19. It supports virtually all of Vi and Ex functionality, extending
and improving upon much of it.
1. Viper supports Vi at several levels. Level 1 is the closest to
Vi, level 5 provides the most flexibility to depart from many Vi
conventions.
1. Viper supports Vi at several levels. Level 1 is the closest to Vi,
level 5 provides the most flexibility to depart from many Vi conventions.
You will be asked to specify your user level in a following screen.
If you select user level 1 then the keys ^X, ^C, ^Z, and ^G will
behave as in VI, to smooth transition to Viper for the beginners.
However, to use Emacs productively, you are advised to reach user
level 3 or higher.
If you select user level 1 then the keys ^X, ^C, ^Z, and ^G will behave
as in VI, to smooth transition to Viper for the beginners. However, to
use Emacs productively, you are advised to reach user level 3 or higher.
If your user level is 2 or higher, ^X and ^C will invoke Emacs
functions,as usual in Emacs; ^Z will toggle vi/emacs modes, and
functions,as usual in Emacs; ^Z will toggle vi/emacs modes, and
^G will be the usual Emacs's keyboard-quit (something like ^C in VI).
2. Vi exit functions (e.g., :wq, ZZ) work on INDIVIDUAL files -- they
@ -1280,9 +1283,8 @@ and improving upon much of it.
6. Emacs Meta functions are invoked by typing `_' or `\\ ESC'.
On a window system, the best way is to use the Meta-key.
7. Try \\[keyboard-quit] and \\[abort-recursive-edit] repeatedly,
if something funny happens. This would abort the current editing
command.
7. Try \\[keyboard-quit] and \\[abort-recursive-edit] repeatedly,if
something funny happens. This would abort the current editing command.
You can get more information on Viper by:
@ -1298,8 +1300,11 @@ This startup message appears whenever you load Viper, unless you type `y' now."
'vip-inhibit-startup-message
"Viper startup message inhibited"
vip-custom-file-name t))
(kill-buffer (current-buffer))))
(message " ")
;;(kill-buffer (current-buffer))
(message
"The last message is in buffer `Viper Startup Message'")
(sit-for 4)
))
(vip-set-expert-level 'dont-change-unless)))
(vip-change-state-to-vi))))
@ -1791,8 +1796,8 @@ behaves as in Emacs, any number of multiple escapes is allowed."
(defun vip-prefix-arg-value (event com)
(let (value)
;; read while number
(while (and (numberp event) (>= event ?0) (<= event ?9))
(setq value (+ (* (if (numberp value) value 0) 10) (- event ?0)))
(while (and (vip-characterp event) (>= event ?0) (<= event ?9))
(setq value (+ (* (if (vip-characterp value) value 0) 10) (- event ?0)))
(setq event (vip-read-event-convert-to-char)))
(setq prefix-arg value)
@ -1901,11 +1906,11 @@ behaves as in Emacs, any number of multiple escapes is allowed."
last-command-char
(cond ((null arg) nil)
((consp arg) (car arg))
((numberp arg) arg)
((integerp arg) arg)
(t (error vip-InvalidCommandArgument)))
(cond ((null arg) nil)
((consp arg) (cdr arg))
((numberp arg) nil)
((integerp arg) nil)
(t (error vip-InvalidCommandArgument))))
(quit (setq vip-use-register nil)
(signal 'quit nil)))
@ -3559,15 +3564,16 @@ called from vip-repeat, the char last used is used. This behaviour is
controlled by the sign of prefix numeric value."
(interactive "P")
(let ((val (vip-p-val arg))
(com (vip-getcom arg)))
(com (vip-getcom arg))
(cmd-representation (nth 5 vip-d-com)))
(if (> val 0)
;; this means that the function was called interactively
(setq vip-f-char (read-char)
vip-f-forward t
vip-f-offset nil)
;; vip-repeat --- set vip-F-char from command-keys
(setq vip-F-char (if (stringp (nth 5 vip-d-com))
(vip-seq-last-elt (nth 5 vip-d-com))
(setq vip-F-char (if (stringp cmd-representation)
(vip-seq-last-elt cmd-representation)
vip-F-char)
vip-f-char vip-F-char)
(setq val (- val)))
@ -3584,15 +3590,16 @@ controlled by the sign of prefix numeric value."
"Go up to char ARG forward on line."
(interactive "P")
(let ((val (vip-p-val arg))
(com (vip-getcom arg)))
(com (vip-getcom arg))
(cmd-representation (nth 5 vip-d-com)))
(if (> val 0)
;; this means that the function was called interactively
(setq vip-f-char (read-char)
vip-f-forward t
vip-f-offset t)
;; vip-repeat --- set vip-F-char from command-keys
(setq vip-F-char (if (stringp (nth 5 vip-d-com))
(vip-seq-last-elt (nth 5 vip-d-com))
(setq vip-F-char (if (stringp cmd-representation)
(vip-seq-last-elt cmd-representation)
vip-F-char)
vip-f-char vip-F-char)
(setq val (- val)))
@ -3609,15 +3616,16 @@ controlled by the sign of prefix numeric value."
"Find char ARG on line backward."
(interactive "P")
(let ((val (vip-p-val arg))
(com (vip-getcom arg)))
(com (vip-getcom arg))
(cmd-representation (nth 5 vip-d-com)))
(if (> val 0)
;; this means that the function was called interactively
(setq vip-f-char (read-char)
vip-f-forward nil
vip-f-offset nil)
;; vip-repeat --- set vip-F-char from command-keys
(setq vip-F-char (if (stringp (nth 5 vip-d-com))
(vip-seq-last-elt (nth 5 vip-d-com))
(setq vip-F-char (if (stringp cmd-representation)
(vip-seq-last-elt cmd-representation)
vip-F-char)
vip-f-char vip-F-char)
(setq val (- val)))
@ -3634,15 +3642,16 @@ controlled by the sign of prefix numeric value."
"Go up to char ARG backward on line."
(interactive "P")
(let ((val (vip-p-val arg))
(com (vip-getcom arg)))
(com (vip-getcom arg))
(cmd-representation (nth 5 vip-d-com)))
(if (> val 0)
;; this means that the function was called interactively
(setq vip-f-char (read-char)
vip-f-forward nil
vip-f-offset t)
;; vip-repeat --- set vip-F-char from command-keys
(setq vip-F-char (if (stringp (nth 5 vip-d-com))
(vip-seq-last-elt (nth 5 vip-d-com))
(setq vip-F-char (if (stringp cmd-representation)
(vip-seq-last-elt cmd-representation)
vip-F-char)
vip-f-char vip-F-char)
(setq val (- val)))
@ -3776,8 +3785,9 @@ controlled by the sign of prefix numeric value."
(defun vip-paren-match (arg)
"Go to the matching parenthesis."
(interactive "P")
(let ((com (vip-getcom arg)))
(if (numberp arg)
(let ((com (vip-getcom arg))
anchor-point)
(if (integerp arg)
(if (or (> arg 99) (< arg 1))
(error "Prefix must be between 1 and 99")
(goto-char
@ -3785,20 +3795,33 @@ controlled by the sign of prefix numeric value."
(* (/ (point-max) 100) arg)
(/ (* (point-max) arg) 100)))
(back-to-indentation))
(let (lim)
(let (beg-lim end-lim)
(if (and (eolp) (not (bolp))) (forward-char -1))
(if (not (looking-at "[][(){}]"))
(setq anchor-point (point)))
(save-excursion
(beginning-of-line)
(setq beg-lim (point))
(end-of-line)
(setq lim (point)))
(if (re-search-forward "[][(){}]" lim t)
(backward-char)
(error "No matching character on line")))
(setq end-lim (point)))
(cond ((re-search-forward "[][(){}]" end-lim t)
(backward-char) )
((re-search-backward "[][(){}]" beg-lim t))
(t
(error "No matching character on line"))))
(cond ((looking-at "[\(\[{]")
(if com (vip-move-marker-locally 'vip-com-point (point)))
(forward-sexp 1)
(if com
(vip-execute-com 'vip-paren-match nil com)
(backward-char)))
(anchor-point
(if com
(progn
(vip-move-marker-locally 'vip-com-point anchor-point)
(forward-char 1)
(vip-execute-com 'vip-paren-match nil com)
)))
((looking-at "[])}]")
(forward-char)
(if com (vip-move-marker-locally 'vip-com-point (point)))
@ -4531,7 +4554,7 @@ cursor move past the beginning of line."
(vip-change-state-to-replace t))
(kill-region (vip-replace-start)
(vip-replace-end))
(vip-restore-cursor-color)
(vip-hide-replace-overlay)
(vip-change-state-to-insert))
(error ;; make sure that the overlay doesn't stay.
;; go back to the original point
@ -4916,7 +4939,7 @@ sensitive for VI-style look-and-feel."
(interactive)
(if (not (numberp vip-expert-level)) (setq vip-expert-level 0))
(if (not (natnump vip-expert-level)) (setq vip-expert-level 0))
(save-window-excursion
(delete-other-windows)
@ -5310,7 +5333,7 @@ Mail anyway (y or n)? ")
(setq
unread-command-events
(append
(cond ((numberp arg) (list (character-to-event arg)))
(cond ((vip-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
@ -5323,7 +5346,7 @@ Mail anyway (y or n)? ")
(defun vip-eventify-list-xemacs (lis)
(mapcar
(function (lambda (elt)
(cond ((numberp elt) (character-to-event elt))
(cond ((vip-characterp elt) (character-to-event elt))
((eventp elt) elt)
(t (error
"vip-eventify-list-xemacs: can't convert to event, %S"
@ -5377,42 +5400,45 @@ Mail anyway (y or n)? ")
"Run `vip-change-state-to-vi' on entry."
(vip-change-state-to-vi))
(defvar makefile-mode-hook nil)
(defvar makefile-mode-hook)
(add-hook 'makefile-mode-hook 'viper-mode)
(defvar help-mode-hook nil)
(defvar help-mode-hook)
(add-hook 'help-mode-hook 'viper-mode)
(defvar awk-mode-hook nil)
(defvar awk-mode-hook)
(add-hook 'awk-mode-hook 'viper-mode)
(defvar html-mode-hook nil)
(defvar html-mode-hook)
(add-hook 'html-mode-hook 'viper-mode)
(defvar html-helper-mode-hook nil)
(defvar html-helper-mode-hook)
(add-hook 'html-helper-mode-hook 'viper-mode)
(defvar emacs-lisp-mode-hook nil)
(defvar emacs-lisp-mode-hook)
(add-hook 'emacs-lisp-mode-hook 'viper-mode)
(defvar lisp-mode-hook nil)
(defvar lisp-mode-hook)
(add-hook 'lisp-mode-hook 'viper-mode)
(defvar bibtex-mode-hook nil)
(defvar bibtex-mode-hook)
(add-hook 'bibtex-mode-hook 'viper-mode)
(defvar cc-mode-hook nil)
(defvar cc-mode-hook)
(add-hook 'cc-mode-hook 'viper-mode)
(defvar c-mode-hook nil)
(defvar c-mode-hook)
(add-hook 'c-mode-hook 'viper-mode)
(defvar c++-mode-hook nil)
(defvar c++-mode-hook)
(add-hook 'c++-mode-hook 'viper-mode)
(defvar lisp-interaction-mode-hook nil)
(defvar lisp-interaction-mode-hook)
(add-hook 'lisp-interaction-mode-hook 'viper-mode)
(defvar fortran-mode-hook)
(add-hook 'fortran-mode-hook 'vip-mode)
(defvar text-mode-hook nil)
(defvar text-mode-hook)
(add-hook 'text-mode-hook 'viper-mode)
(add-hook 'completion-list-mode-hook 'viper-mode)
@ -5421,7 +5447,7 @@ Mail anyway (y or n)? ")
(add-hook 'perl-mode-hook 'viper-mode)
(add-hook 'tcl-mode-hook 'viper-mode)
(defvar emerge-startup-hook nil)
(defvar emerge-startup-hook)
(add-hook 'emerge-startup-hook 'vip-change-state-to-emacs)
;; Run vip-change-state-to-vi after quitting emerge.
(vip-eval-after-load
@ -5455,14 +5481,14 @@ Mail anyway (y or n)? ")
(vip-change-state-to-vi)))
;; Emacs shell, ange-ftp, and comint-based modes
(defvar comint-mode-hook nil)
(defvar comint-mode-hook)
(add-hook 'comint-mode-hook 'vip-change-state-to-insert)
(add-hook 'comint-mode-hook 'vip-comint-mode-hook)
;; Shell scripts
(defvar sh-mode-hook nil)
(defvar sh-mode-hook)
(add-hook 'sh-mode-hook 'viper-mode)
(defvar ksh-mode-hook nil)
(defvar ksh-mode-hook)
(add-hook 'ksh-mode-hook 'viper-mode)
;; Dired
@ -5471,22 +5497,18 @@ Mail anyway (y or n)? ")
(if vip-emacs-p
(progn
(defvar view-mode-hook nil
"View hook. Run after view mode.")
(defvar view-mode-hook)
(add-hook 'view-mode-hook 'vip-change-state-to-emacs))
(defadvice view-minor-mode (after vip-view-ad activate)
"Switch to Emacs state in View mode."
(vip-change-state-to-emacs))
(defvar view-hook nil
"View hook. Run after view mode.")
(defvar view-hook)
(add-hook 'view-hook 'vip-change-state-to-emacs))
;; For VM users.
;; Put summary and other VM buffers in Emacs state.
(defvar vm-mode-hooks nil
"This hook is run after vm is started.")
(defvar vm-summary-mode-hooks nil
"This hook is run after vm switches to summary mode.")
(defvar vm-mode-hooks)
(defvar vm-summary-mode-hooks)
(add-hook 'vm-mode-hooks 'vip-change-state-to-emacs)
(add-hook 'vm-summary-mode-hooks 'vip-change-state-to-emacs)