(provide 'ediff-mult)
(defgroup ediff-mult nil
"Multi-file and multi-buffer processing in Ediff"
:prefix "ediff-"
:group 'ediff)
(eval-when-compile
(let ((load-path (cons (expand-file-name ".") load-path)))
(or (featurep 'ediff-init)
(load "ediff-init.el" nil nil 'nosuffix))
(or (featurep 'ediff-util)
(load "ediff-util.el" nil nil 'nosuffix))
))
(require 'ediff-init)
(require 'ediff-util)
(ediff-defvar-local ediff-meta-buffer nil "")
(ediff-defvar-local ediff-parent-meta-buffer nil "")
(defvar ediff-registry-buffer nil)
(defconst ediff-meta-buffer-message "This is an Ediff Session Group Panel: %s
Useful commands:
button2, v, or RET over session record: start that Ediff session
M:\tin sessions invoked from here, brings back this group panel
R:\tdisplay the registry of active Ediff sessions
h:\tmark session for hiding (toggle)
x:\thide marked sessions; with prefix arg: unhide
m:\tmark session for a non-hiding operation (toggle)
uh/um:\tunmark all sessions marked for hiding/operation
n,SPC:\tnext session
p,DEL:\tprevious session
E:\tbrowse Ediff on-line manual
T:\ttoggle truncation of long file names
q:\tquit this session group
")
(ediff-defvar-local ediff-meta-buffer-map nil
"The keymap for the meta buffer.")
(defvar ediff-dir-diffs-buffer-map (make-sparse-keymap)
"The keymap to be installed in the buffer showing differences between
directories.")
(ediff-defvar-local ediff-meta-action-function nil "")
(ediff-defvar-local ediff-meta-redraw-function nil "")
(ediff-defvar-local ediff-session-action-function nil "")
(ediff-defvar-local ediff-metajob-name nil "")
(ediff-defvar-local ediff-meta-diff-buffer nil "")
(defvar ediff-filtering-regexp-history nil "")
(ediff-defvar-local ediff-meta-list nil "")
(ediff-defvar-local ediff-meta-session-number nil "")
(ediff-defvar-local ediff-dir-difference-list nil "")
(ediff-defvar-local ediff-dir-diffs-buffer nil "")
(defvar ediff-session-registry nil)
(defcustom ediff-meta-truncate-filenames t
"*If non-nil, truncate long file names in the session group buffers.
This can be toggled with `ediff-toggle-filename-truncation'."
:type 'hook
:group 'ediff-mult)
(defcustom ediff-registry-setup-hook nil
"*Hooks run just after the registry control panel is set up."
:type 'hook
:group 'ediff-mult)
(defcustom ediff-before-session-group-setup-hooks nil
"*Hooks to run before Ediff arranges the window for group-level operations.
It is used by commands such as ediff-directories.
This hook can be used to save the previous window config, which can be restored
on ediff-quit, ediff-suspend, or ediff-quit-session-group-hook."
:type 'hook
:group 'ediff-hook)
(defcustom ediff-after-session-group-setup-hook nil
"*Hooks run just after a meta-buffer controlling a session group, such as
ediff-directories, is run."
:type 'hook
:group 'ediff-mult)
(defcustom ediff-quit-session-group-hook nil
"*Hooks run just before exiting a session group."
:type 'hook
:group 'ediff-mult)
(defcustom ediff-show-registry-hook nil
"*Hooks run just after the registry buffer is shown."
:type 'hook
:group 'ediff-mult)
(defcustom ediff-show-session-group-hook '(delete-other-windows)
"*Hooks run just after a session group buffer is shown."
:type 'hook
:group 'ediff-mult)
(defcustom ediff-meta-buffer-keymap-setup-hook nil
"*Hooks run just after setting up the ediff-meta-buffer-map.
This keymap controls key bindings in the meta buffer and is a local variable.
This means that you can set different bindings for different kinds of meta
buffers."
:type 'hook
:group 'ediff-mult)
(ediff-defvar-local ediff-meta-patchbufer nil "")
(defsubst ediff-get-group-buffer (meta-list)
(nth 0 (car meta-list)))
(defsubst ediff-get-group-regexp (meta-list)
(nth 1 (car meta-list)))
(defsubst ediff-get-group-objA (meta-list)
(nth 2 (car meta-list)))
(defsubst ediff-get-group-objB (meta-list)
(nth 3 (car meta-list)))
(defsubst ediff-get-group-objC (meta-list)
(nth 4 (car meta-list)))
(defsubst ediff-get-group-merge-autostore-dir (meta-list)
(nth 5 (car meta-list)))
(defsubst ediff-get-session-buffer (elt)
(nth 0 elt))
(defsubst ediff-get-session-status (elt)
(nth 1 elt))
(defsubst ediff-set-session-status (session-info new-status)
(setcar (cdr session-info) new-status))
(defsubst ediff-get-session-objA (elt)
(nth 2 elt))
(defsubst ediff-get-session-objB (elt)
(nth 3 elt))
(defsubst ediff-get-session-objC (elt)
(nth 4 elt))
(defsubst ediff-get-session-objA-name (elt)
(car (nth 2 elt)))
(defsubst ediff-get-session-objB-name (elt)
(car (nth 3 elt)))
(defsubst ediff-get-session-objC-name (elt)
(car (nth 4 elt)))
(defsubst ediff-get-file-eqstatus (elt)
(nth 1 elt))
(defsubst ediff-set-file-eqstatus (elt value)
(setcar (cdr elt) value))
(defun ediff-get-session-activity-marker (session)
(let ((session-buf (ediff-get-session-buffer session)))
(cond ((null session-buf) nil) ((ediff-buffer-live-p session-buf) ?+) (t ?-))))
(defun ediff-meta-session-p (session-info)
(and (stringp (ediff-get-session-objA-name session-info))
(file-directory-p (ediff-get-session-objA-name session-info))
(stringp (ediff-get-session-objB-name session-info))
(file-directory-p (ediff-get-session-objB-name session-info))
(if (stringp (ediff-get-session-objC-name session-info))
(file-directory-p (ediff-get-session-objC-name session-info)) t)))
(defun ediff-setup-meta-map()
(setq ediff-meta-buffer-map (make-sparse-keymap))
(suppress-keymap ediff-meta-buffer-map)
(define-key ediff-meta-buffer-map "q" 'ediff-quit-meta-buffer)
(define-key ediff-meta-buffer-map "T" 'ediff-toggle-filename-truncation)
(define-key ediff-meta-buffer-map "R" 'ediff-show-registry)
(define-key ediff-meta-buffer-map "E" 'ediff-documentation)
(define-key ediff-meta-buffer-map "v" ediff-meta-action-function)
(define-key ediff-meta-buffer-map "\C-m" ediff-meta-action-function)
(define-key ediff-meta-buffer-map " " 'ediff-next-meta-item)
(define-key ediff-meta-buffer-map "n" 'ediff-next-meta-item)
(define-key ediff-meta-buffer-map "\C-?" 'ediff-previous-meta-item)
(define-key ediff-meta-buffer-map "p" '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)
(progn
(define-key ediff-meta-buffer-map "=" nil)
(define-key ediff-meta-buffer-map "==" 'ediff-meta-mark-equal-files)
(define-key ediff-meta-buffer-map "=m" 'ediff-meta-mark-equal-files)
(define-key ediff-meta-buffer-map "=h" '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
(define-key ediff-meta-buffer-map [mouse-2] ediff-meta-action-function)
(define-key ediff-meta-buffer-map [button2] ediff-meta-action-function))
(use-local-map ediff-meta-buffer-map)
(run-hooks 'ediff-meta-buffer-keymap-setup-hook))
(defun ediff-meta-mode ()
"This mode controls all operations on Ediff session groups.
It is entered through one of the following commands:
`ediff-directories'
`edirs'
`ediff-directories3'
`edirs3'
`ediff-merge-directories'
`edirs-merge'
`ediff-merge-directories-with-ancestor'
`edirs-merge-with-ancestor'
`ediff-directory-revisions'
`edir-revisions'
`ediff-merge-directory-revisions'
`edir-merge-revisions'
`ediff-merge-directory-revisions-with-ancestor'
`edir-merge-revisions-with-ancestor'
Commands:
\\{ediff-meta-buffer-map}"
(kill-all-local-variables)
(setq major-mode 'ediff-meta-mode)
(setq mode-name "MetaEdiff"))
(suppress-keymap ediff-dir-diffs-buffer-map)
(define-key ediff-dir-diffs-buffer-map "q" 'ediff-bury-dir-diffs-buffer)
(define-key ediff-dir-diffs-buffer-map " " 'next-line)
(define-key ediff-dir-diffs-buffer-map "n" 'next-line)
(define-key ediff-dir-diffs-buffer-map "\C-?" 'previous-line)
(define-key ediff-dir-diffs-buffer-map "p" 'previous-line)
(define-key ediff-dir-diffs-buffer-map [delete] 'previous-line)
(define-key ediff-dir-diffs-buffer-map [backspace] 'previous-line)
(defun ediff-next-meta-item (count)
"Move to the next item in Ediff registry or session group buffer.
Moves in circular fashion. With numeric prefix arg, skip this many items."
(interactive "p")
(or count (setq count 1))
(let (overl)
(while (< 0 count)
(setq count (1- count))
(ediff-next-meta-item1)
(setq overl (ediff-get-meta-overlay-at-pos (point)))
(while (and overl (ediff-overlay-get overl 'invisible))
(ediff-next-meta-item1)
(setq overl (ediff-get-meta-overlay-at-pos (point)))))))
(defun ediff-next-meta-item1 ()
(let (pos)
(setq pos (ediff-next-meta-overlay-start (point)))
(if pos (goto-char pos))
(if (eq ediff-metajob-name 'ediff-registry)
(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)))))
(defun ediff-previous-meta-item (count)
"Move to the previous item in Ediff registry or session group buffer.
Moves in circular fashion. With numeric prefix arg, skip this many items."
(interactive "p")
(or count (setq count 1))
(let (overl)
(while (< 0 count)
(setq count (1- count))
(ediff-previous-meta-item1)
(setq overl (ediff-get-meta-overlay-at-pos (point)))
(while (and overl (ediff-overlay-get overl 'invisible))
(ediff-previous-meta-item1)
(setq overl (ediff-get-meta-overlay-at-pos (point)))))))
(defun ediff-previous-meta-item1 ()
(let (pos)
(setq pos (ediff-previous-meta-overlay-start (point)))
(if pos (goto-char pos))
(if (eq ediff-metajob-name 'ediff-registry)
(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)))
))
(defsubst ediff-add-slash-if-directory (dir file)
(if (file-directory-p (concat dir file))
(file-name-as-directory file)
file))
(defun ediff-toggle-filename-truncation ()
"Toggle truncation of long file names in session group buffers.
Set `ediff-meta-truncate-filenames' variable if you want to change the default
behavior."
(interactive)
(setq ediff-meta-truncate-filenames (not ediff-meta-truncate-filenames))
(ediff-update-meta-buffer (current-buffer) 'must-redraw))
(defun ediff-intersect-directories (jobname
diff-var regexp dir1 dir2
&optional
dir3 merge-autostore-dir comparison-func)
(setq comparison-func (or comparison-func 'string=))
(let (lis1 lis2 lis3 common auxdir1 auxdir2 auxdir3 difflist)
(setq auxdir1 (file-name-as-directory dir1)
lis1 (directory-files auxdir1 nil regexp)
lis1 (delete "." lis1)
lis1 (delete ".." lis1)
lis1 (mapcar
(lambda (elt)
(ediff-add-slash-if-directory auxdir1 elt))
lis1)
auxdir2 (file-name-as-directory dir2)
lis2 (mapcar
(lambda (elt)
(ediff-add-slash-if-directory auxdir2 elt))
(directory-files auxdir2 nil regexp)))
(if (stringp dir3)
(setq auxdir3 (file-name-as-directory dir3)
lis3 (mapcar
(lambda (elt)
(ediff-add-slash-if-directory auxdir3 elt))
(directory-files auxdir3 nil regexp))))
(if (ediff-nonempty-string-p merge-autostore-dir)
(setq merge-autostore-dir
(file-name-as-directory merge-autostore-dir)))
(setq common (ediff-intersection lis1 lis2 comparison-func))
(if (and lis3 (ediff-comparison-metajob3 jobname))
(setq common (ediff-intersection common lis3 comparison-func)))
(setq common (sort (ediff-copy-list common) 'string-lessp))
(setq difflist (ediff-set-difference
(ediff-union (ediff-union lis1 lis2 comparison-func)
lis3
comparison-func)
common
comparison-func)
difflist (delete "." difflist)
difflist (sort (ediff-copy-list (delete ".." difflist))
'string-lessp))
(setq difflist (mapcar (lambda (elt) (cons elt 1)) difflist))
(mapcar (lambda (elt)
(if (member (car elt) lis1)
(setcdr elt (* (cdr elt) 2)))
(if (member (car elt) lis2)
(setcdr elt (* (cdr elt) 3)))
(if (member (car elt) lis3)
(setcdr elt (* (cdr elt) 5)))
)
difflist)
(setq difflist (cons (list regexp auxdir1 auxdir2 auxdir3) difflist))
(set diff-var difflist)
(cons (list regexp auxdir1 auxdir2 auxdir3 merge-autostore-dir)
(mapcar
(lambda (elt)
(list (concat auxdir1 elt)
(concat auxdir2 elt)
(if lis3
(progn
(setq elt (ediff-add-slash-if-directory auxdir3 elt))
(if (file-exists-p (concat auxdir3 elt))
(concat auxdir3 elt))))))
common))
))
(defun ediff-get-directory-files-under-revision (jobname
regexp dir1
&optional merge-autostore-dir)
(let (lis1 elt common auxdir1)
(setq auxdir1 (file-name-as-directory dir1)
lis1 (directory-files auxdir1 nil regexp))
(if (ediff-nonempty-string-p merge-autostore-dir)
(setq merge-autostore-dir
(file-name-as-directory merge-autostore-dir)))
(while lis1
(setq elt (car lis1)
lis1 (cdr lis1))
(cond ((file-directory-p (concat auxdir1 elt))
(setq common
(cons (ediff-add-slash-if-directory auxdir1 elt) common)))
((and (featurep 'vc-hooks) (vc-backend (concat auxdir1 elt)))
(setq common (cons elt common)))
((file-exists-p (concat auxdir1 elt ",v"))
(setq common (cons elt common)))
((file-exists-p (concat auxdir1 "RCS/" elt ",v"))
(setq common (cons elt common)))
) )
(setq common (delete "./" common)
common (delete "../" common)
common (delete "RCS" common)
common (delete "CVS" common)
)
(setq common (sort (ediff-copy-list common) 'string-lessp))
(cons (list regexp auxdir1 nil nil merge-autostore-dir)
(mapcar (lambda (elt) (list (concat auxdir1 elt) nil nil))
common))
))
(defun ediff-prepare-meta-buffer (action-func meta-list
meta-buffer-name redraw-function
jobname &optional startup-hooks)
(let* ((meta-buffer-name
(ediff-unique-buffer-name meta-buffer-name "*"))
(meta-buffer (get-buffer-create meta-buffer-name)))
(ediff-with-current-buffer meta-buffer
(ediff-meta-mode)
(setq ediff-meta-action-function action-func
ediff-meta-redraw-function redraw-function
ediff-metajob-name jobname
ediff-meta-buffer meta-buffer)
(ediff-setup-meta-map)
(if (eq ediff-metajob-name 'ediff-registry)
(progn
(setq ediff-registry-buffer meta-buffer
ediff-meta-list meta-list)
(define-key
ediff-meta-buffer-map "M" 'ediff-show-meta-buff-from-registry))
(setq ediff-meta-list
(cons (cons meta-buffer (car meta-list))
(mapcar
(lambda (elt)
(cons nil
(cons nil
(mapcar (lambda (obj) (list obj nil))
elt))))
(cdr meta-list)))))
(or (eq meta-buffer ediff-registry-buffer)
(setq ediff-session-registry
(cons meta-buffer ediff-session-registry)))
(funcall redraw-function ediff-meta-list)
(setq buffer-read-only t)
(set-buffer-modified-p nil)
(run-hooks 'startup-hooks)
(if (eq action-func 'ediff-filegroup-action)
(progn
(setq ediff-dir-difference-list
(cons (cons meta-buffer (car ediff-dir-difference-list))
(cdr ediff-dir-difference-list)))
(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-at-pos)
(define-key ediff-meta-buffer-map "x" 'ediff-hide-marked-sessions)
(define-key
ediff-meta-buffer-map "m" 'ediff-mark-for-operation-at-pos)
(define-key ediff-meta-buffer-map "u" nil)
(define-key
ediff-meta-buffer-map "um" 'ediff-unmark-all-for-operation)
(define-key
ediff-meta-buffer-map "uh" 'ediff-unmark-all-for-hiding)
(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 "^" 'ediff-up-meta-hierarchy)
(define-key ediff-meta-buffer-map "D" 'ediff-show-dir-diffs)))
(if (eq ediff-metajob-name 'ediff-registry)
(run-hooks 'ediff-registry-setup-hook)
(run-hooks 'ediff-after-session-group-setup-hook))
) meta-buffer))
(defun ediff-insert-session-activity-marker-in-meta-buffer (session)
(insert
(cond ((ediff-get-session-activity-marker session))
(t " "))))
(defun ediff-insert-session-status-in-meta-buffer (session)
(insert
(cond ((ediff-get-session-status session)) (t " "))))
(defun ediff-replace-session-activity-marker-in-meta-buffer (point new-marker)
(let* ((overl (ediff-get-meta-overlay-at-pos point))
(session-info (ediff-overlay-get overl 'ediff-meta-info))
(activity-marker (ediff-get-session-activity-marker session-info))
buffer-read-only)
(or new-marker activity-marker (setq new-marker ?\ ))
(goto-char (ediff-overlay-start overl))
(if (eq (char-after (point)) new-marker)
() (insert new-marker)
(delete-char 1)
(set-buffer-modified-p nil))))
(defun ediff-replace-session-status-in-meta-buffer (point new-status)
(let* ((overl (ediff-get-meta-overlay-at-pos point))
(session-info (ediff-overlay-get overl 'ediff-meta-info))
(status (ediff-get-session-status session-info))
buffer-read-only)
(setq new-status (or new-status status ?\ ))
(goto-char (ediff-overlay-start overl))
(forward-char 1) (if (eq (char-after (point)) new-status)
() (insert new-status)
(delete-char 1)
(set-buffer-modified-p nil))))
(defun ediff-insert-session-info-in-meta-buffer (session-info sessionNum)
(let ((f1 (ediff-get-session-objA session-info))
(f2 (ediff-get-session-objB session-info))
(f3 (ediff-get-session-objC session-info))
(pt (point))
(hidden (eq (ediff-get-session-status session-info) ?I)))
(ediff-insert-session-activity-marker-in-meta-buffer session-info)
(ediff-insert-session-status-in-meta-buffer session-info)
(insert " Session " (int-to-string sessionNum) ":\n")
(ediff-meta-insert-file-info1 f1)
(ediff-meta-insert-file-info1 f2)
(ediff-meta-insert-file-info1 f3)
(ediff-set-meta-overlay pt (point) session-info sessionNum hidden)))
(defun ediff-redraw-directory-group-buffer (meta-list)
(let ((meta-buf (ediff-get-group-buffer meta-list))
(empty t)
(sessionNum 0)
regexp elt merge-autostore-dir
point tmp-list buffer-read-only)
(ediff-with-current-buffer meta-buf
(setq point (point))
(erase-buffer)
(if ediff-emacs-p
(mapcar 'delete-overlay (overlays-in 1 1))
(map-extents 'delete-extent))
(insert (format ediff-meta-buffer-message
(ediff-abbrev-jobname ediff-metajob-name)))
(setq regexp (ediff-get-group-regexp meta-list)
merge-autostore-dir
(ediff-get-group-merge-autostore-dir meta-list))
(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
" ^:\tshow parent session group\n")
(or (ediff-one-filegroup-metajob)
(insert
" D:\tshow differences among directories\n"
" ==:\tfor each session, show which files are identical\n"
" =h:\tlike ==, but also marks those sessions for hiding\n"
" =m:\tlike ==, but also marks those sessions for operation\n\n"))
(insert "\n")
(if (and (stringp regexp) (> (length regexp) 0))
(insert
(format "*** Filter-through regular expression: %s\n" regexp)))
(ediff-insert-dirs-in-meta-buffer meta-list)
(if (and ediff-autostore-merges (ediff-merge-metajob)
(ediff-nonempty-string-p merge-autostore-dir))
(insert (format
"\nMerge results are automatically stored in:\n\t%s\n"
merge-autostore-dir)))
(insert "\n
Size Last modified Name
----------------------------------------------
")
(setq meta-list (cdr meta-list)
tmp-list meta-list)
(while (and tmp-list empty)
(if (and (car tmp-list)
(not (eq (ediff-get-session-status (car tmp-list)) ?I)))
(setq empty nil))
(setq tmp-list (cdr tmp-list)))
(if empty
(insert
" ****** ****** This session group has no members\n"))
(while meta-list
(setq elt (car meta-list)
meta-list (cdr meta-list)
sessionNum (1+ sessionNum))
(if (eq (ediff-get-session-status elt) ?I)
()
(ediff-insert-session-info-in-meta-buffer elt sessionNum)))
(set-buffer-modified-p nil)
(goto-char point)
meta-buf)))
(defun ediff-update-markers-in-dir-meta-buffer (meta-list)
(let ((meta-buf (ediff-get-group-buffer meta-list))
session-info point overl buffer-read-only)
(ediff-with-current-buffer meta-buf
(setq point (point))
(goto-char (point-min))
(ediff-next-meta-item1)
(while (not (bobp))
(setq session-info (ediff-get-meta-info meta-buf (point) 'no-error)
overl (ediff-get-meta-overlay-at-pos (point)))
(if session-info
(progn
(cond ((eq (ediff-get-session-status session-info) ?I)
(if overl (ediff-overlay-put overl 'invisible t)))
((and (eq (ediff-get-session-status session-info) ?H)
overl (ediff-overlay-get overl 'invisible))
(ediff-overlay-put overl 'invisible nil))
(t (ediff-replace-session-activity-marker-in-meta-buffer
(point)
(ediff-get-session-activity-marker session-info))
(ediff-replace-session-status-in-meta-buffer
(point)
(ediff-get-session-status session-info))))))
(ediff-next-meta-item1) ) (set-buffer-modified-p nil)
(goto-char point))
meta-buf))
(defun ediff-update-session-marker-in-dir-meta-buffer (session-num)
(let (buffer-meta-overlays session-info overl buffer-read-only)
(setq overl
(if ediff-xemacs-p
(map-extents
(lambda (ext maparg)
(if (and
(ediff-overlay-get ext 'ediff-meta-info)
(eq (ediff-overlay-get ext 'ediff-meta-session-number)
session-num))
ext)))
(setq buffer-meta-overlays (overlay-lists)
buffer-meta-overlays (append (car buffer-meta-overlays)
(cdr buffer-meta-overlays)))
(car
(delq nil
(mapcar
(lambda (overl)
(if (and
(ediff-overlay-get overl 'ediff-meta-info)
(eq (ediff-overlay-get
overl 'ediff-meta-session-number)
session-num))
overl))
buffer-meta-overlays)))))
(or overl
(error
"Bug in ediff-update-session-marker-in-dir-meta-buffer: no overlay with given number %S"
session-num))
(setq session-info (ediff-overlay-get overl 'ediff-meta-info))
(goto-char (ediff-overlay-start overl))
(ediff-replace-session-activity-marker-in-meta-buffer
(point)
(ediff-get-session-activity-marker session-info))
(ediff-replace-session-status-in-meta-buffer
(point)
(ediff-get-session-status session-info)))
(ediff-next-meta-item1))
(defun ediff-problematic-session-p (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))
(or (not (stringp f3)) (file-directory-p f3))
(ediff-ancestor-metajob))
'ancestor-is-dir)
(t nil))))
(defun ediff-meta-insert-file-info1 (fileinfo)
(let ((fname (car fileinfo))
(feq (ediff-get-file-eqstatus fileinfo))
(max-filename-width (if ediff-meta-truncate-filenames
(- (window-width) 41)
500))
file-modtime file-size)
(cond ((not (stringp fname)) (setq file-size -2)) ((ediff-listable-file fname)
(if (file-exists-p fname)
(setq file-size (ediff-file-size fname)
file-modtime (ediff-file-modtime fname))
(setq file-size -2))) ( t (setq file-size -1))) (if (stringp fname)
(insert
(format
"%s %s %-20s %s\n"
(if feq "=" " ") (format "%10s" (cond ((= file-size -1) "--")
((< file-size -1) "--")
(t file-size)))
(cond ((= file-size -1) "*remote file*")
((< file-size -1) "*file doesn't exist*")
(t (ediff-format-date (decode-time file-modtime))))
(if (and (not (stringp fname)) (< file-size -1))
"-------" (ediff-truncate-string-left
(ediff-abbreviate-file-name fname)
max-filename-width)))))))
(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.")
(defsubst ediff-fill-leading-zero (num)
(if (< num 10)
(format "0%d" num)
(number-to-string num)))
(defun ediff-format-date (time)
(format "%s %2d %4d %s:%s:%s"
(cdr (assoc (nth 4 time) ediff-months)) (nth 3 time) (nth 5 time) (ediff-fill-leading-zero (nth 2 time)) (ediff-fill-leading-zero (nth 1 time)) (ediff-fill-leading-zero (nth 0 time)) ))
(defun ediff-insert-dirs-in-meta-buffer (meta-list)
(let* ((dir1 (ediff-abbreviate-file-name (ediff-get-group-objA meta-list)))
(dir2 (ediff-get-group-objB meta-list))
(dir2 (if (stringp dir2) (ediff-abbreviate-file-name dir2)))
(dir3 (ediff-get-group-objC meta-list))
(dir3 (if (stringp dir3) (ediff-abbreviate-file-name dir3))))
(insert "*** Directory A: " dir1 "\n")
(if dir2 (insert "*** Directory B: " dir2 "\n"))
(if dir3 (insert "*** Directory C: " dir3 "\n"))
(insert "\n")))
(defun ediff-draw-dir-diffs (diff-list)
(if (null diff-list) (error "Lost difference info on these directories"))
(let* ((buf-name (ediff-unique-buffer-name
"*Ediff File Group Differences" "*"))
(regexp (ediff-get-group-regexp diff-list))
(dir1 (ediff-abbreviate-file-name (ediff-get-group-objA diff-list)))
(dir2 (ediff-abbreviate-file-name (ediff-get-group-objB diff-list)))
(dir3 (ediff-get-group-objC diff-list))
(dir3 (if (stringp dir3) (ediff-abbreviate-file-name dir3)))
(meta-buf (ediff-get-group-buffer diff-list))
(underline (make-string 26 ?-))
file code
buffer-read-only)
(setq diff-list (cdr diff-list))
(setq ediff-dir-diffs-buffer (get-buffer-create buf-name))
(ediff-with-current-buffer ediff-dir-diffs-buffer
(use-local-map ediff-dir-diffs-buffer-map)
(erase-buffer)
(setq ediff-meta-buffer meta-buf)
(insert "\t\t*** Directory Differences ***\n")
(insert "
Useful commands:
`q': hide this buffer
n,SPC: next line
p,DEL: previous line\n\n")
(if (and (stringp regexp) (> (length regexp) 0))
(insert
(format "\n*** Filter-through regular expression: %s\n" regexp)))
(insert "\n")
(insert (format "\n%-27s%-26s"
(ediff-truncate-string-left
(ediff-abbreviate-file-name
(file-name-as-directory dir1))
25)
(ediff-truncate-string-left
(ediff-abbreviate-file-name
(file-name-as-directory dir2))
25)))
(if dir3
(insert (format " %-25s\n"
(ediff-truncate-string-left
(ediff-abbreviate-file-name
(file-name-as-directory dir3))
25)))
(insert "\n"))
(insert (format "%s%s" underline underline))
(if (stringp dir3)
(insert (format "%s\n\n" underline))
(insert "\n\n"))
(if (null diff-list)
(insert "\n\t*** No differences ***\n"))
(while diff-list
(setq file (car (car diff-list))
code (cdr (car diff-list))
diff-list (cdr diff-list))
(if (= (mod code 2) 0) (insert (format "%-27s"
(ediff-truncate-string-left
(ediff-abbreviate-file-name
(if (file-directory-p (concat dir1 file))
(file-name-as-directory file)
file))
24)))
(insert (format "%-27s" "---")))
(if (= (mod code 3) 0) (insert (format "%-26s"
(ediff-truncate-string-left
(ediff-abbreviate-file-name
(if (file-directory-p (concat dir2 file))
(file-name-as-directory file)
file))
24)))
(insert (format "%-26s" "---")))
(if (stringp dir3)
(if (= (mod code 5) 0) (insert (format " %-25s"
(ediff-truncate-string-left
(ediff-abbreviate-file-name
(if (file-directory-p (concat dir3 file))
(file-name-as-directory file)
file))
24)))
(insert (format " %-25s" "---"))))
(insert "\n"))
(setq buffer-read-only t)
(set-buffer-modified-p nil)) ))
(defun ediff-bury-dir-diffs-buffer ()
"Bury the directory difference buffer. Display the meta buffer instead."
(interactive)
(let ((buf ediff-meta-buffer)
wind)
(bury-buffer)
(if (setq wind (ediff-get-visible-buffer-window buf))
(select-window wind)
(set-window-buffer (selected-window) buf))))
(defun ediff-show-dir-diffs ()
"Display differences among the directories involved in session group."
(interactive)
(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))
(let ((buf ediff-dir-diffs-buffer))
(other-window 1)
(set-window-buffer (selected-window) buf)
(goto-char (point-min))))
(defun ediff-up-meta-hierarchy ()
"Go to the parent session group buffer."
(interactive)
(if (ediff-buffer-live-p ediff-parent-meta-buffer)
(ediff-show-meta-buffer
ediff-parent-meta-buffer ediff-meta-session-number)
(error "This session group has no parent")))
(defun ediff-redraw-registry-buffer (&optional ignore)
(ediff-with-current-buffer ediff-registry-buffer
(let ((point (point))
elt bufAname bufBname bufCname cur-diff total-diffs pt
job-name meta-list registry-list buffer-read-only)
(erase-buffer)
(if ediff-emacs-p
(mapcar 'delete-overlay (overlays-in 1 1))
(map-extents 'delete-extent))
(insert "This is a registry of all active Ediff sessions.
Useful commands:
button2, `v', RET over a session record: switch to that session
M over a session record: display the associated session group
R in any Ediff session: display session registry
n,SPC: next session
p,DEL: previous session
E: browse Ediff on-line manual
q: bury registry
\t\tActive Ediff Sessions:
\t\t----------------------
")
(mapcar (lambda (elt)
(if (not (ediff-buffer-live-p elt))
(setq ediff-session-registry
(delq elt ediff-session-registry))))
ediff-session-registry)
(if (null ediff-session-registry)
(insert " ******* No active Ediff sessions *******\n"))
(setq registry-list ediff-session-registry)
(while registry-list
(setq elt (car registry-list)
registry-list (cdr registry-list))
(if (ediff-buffer-live-p elt)
(if (ediff-with-current-buffer elt
(setq job-name ediff-metajob-name
meta-list ediff-meta-list)
(and ediff-metajob-name
(not (eq ediff-metajob-name 'ediff-registry))))
(progn
(setq pt (point))
(insert (format " *group*\t%s: %s\n"
(buffer-name elt)
(ediff-abbrev-jobname job-name)))
(insert (format "\t\t %s %s %s\n"
(ediff-abbreviate-file-name
(ediff-get-group-objA meta-list))
(ediff-abbreviate-file-name
(if (stringp
(ediff-get-group-objB meta-list))
(ediff-get-group-objB meta-list)
""))
(ediff-abbreviate-file-name
(if (stringp
(ediff-get-group-objC meta-list))
(ediff-get-group-objC meta-list)
""))))
(ediff-set-meta-overlay pt (point) elt))
(progn
(ediff-with-current-buffer elt
(setq bufAname (if (ediff-buffer-live-p ediff-buffer-A)
(buffer-name ediff-buffer-A)
"!!!killed buffer!!!")
bufBname (if (ediff-buffer-live-p ediff-buffer-B)
(buffer-name ediff-buffer-B)
"!!!killed buffer!!!")
bufCname (cond ((not (ediff-3way-job))
"")
((ediff-buffer-live-p ediff-buffer-C)
(buffer-name ediff-buffer-C))
(t "!!!killed buffer!!!")))
(setq total-diffs (format "%-4d" ediff-number-of-differences)
cur-diff
(cond ((= ediff-current-difference -1) " _")
((= ediff-current-difference
ediff-number-of-differences)
" $")
(t (format
"%4d" (1+ ediff-current-difference))))
job-name ediff-job-name))
(setq pt (point))
(insert cur-diff "/" total-diffs "\t"
(buffer-name elt)
(format ": %s" (ediff-abbrev-jobname job-name)))
(insert
"\n\t\t " bufAname " " bufBname " " bufCname "\n")
(ediff-set-meta-overlay pt (point) elt))))
) (set-buffer-modified-p nil)
(goto-char point)
)))
(defun ediff-set-meta-overlay (b e prop &optional session-number hidden)
(let (overl)
(setq overl (ediff-make-overlay b e))
(if ediff-emacs-p
(ediff-overlay-put overl 'mouse-face 'highlight)
(ediff-overlay-put overl 'highlight t))
(ediff-overlay-put overl 'ediff-meta-info prop)
(ediff-overlay-put overl 'invisible hidden)
(if (numberp session-number)
(ediff-overlay-put overl 'ediff-meta-session-number session-number))))
(defun ediff-mark-for-hiding-at-pos (unmark)
"Mark session for hiding. With prefix arg, unmark."
(interactive "P")
(let* ((pos (ediff-event-point last-command-event))
(meta-buf (ediff-event-buffer last-command-event))
(info (ediff-get-meta-info meta-buf pos))
(session-number (ediff-get-session-number-at-pos pos)))
(ediff-mark-session-for-hiding info unmark)
(ediff-next-meta-item 1)
(save-excursion
(ediff-update-meta-buffer meta-buf nil session-number))
))
(defun ediff-mark-session-for-hiding (info unmark)
(let ((session-buf (ediff-get-session-buffer info))
ignore)
(cond ((eq unmark 'mark) (setq unmark nil))
((eq (ediff-get-session-status info) ?H) (setq unmark t))
(unmark (setq ignore t)))
(cond (ignore)
(unmark (ediff-set-session-status info nil))
(t (ediff-set-session-status info ?H))))
unmark)
(defun ediff-mark-for-operation-at-pos (unmark)
"Mark session for a group operation. With prefix arg, unmark."
(interactive "P")
(let* ((pos (ediff-event-point last-command-event))
(meta-buf (ediff-event-buffer last-command-event))
(info (ediff-get-meta-info meta-buf pos))
(session-number (ediff-get-session-number-at-pos pos)))
(ediff-mark-session-for-operation info unmark)
(ediff-next-meta-item 1)
(save-excursion
(ediff-update-meta-buffer meta-buf nil session-number))
))
(defun ediff-mark-session-for-operation (info unmark)
(let (ignore)
(cond ((eq unmark 'mark) (setq unmark nil))
((eq (ediff-get-session-status info) ?*) (setq unmark t))
(unmark (setq ignore t)))
(cond (ignore)
(unmark (ediff-set-session-status info nil))
(t (ediff-set-session-status info ?*))))
unmark)
(defun ediff-hide-marked-sessions (unhide)
"Hide marked sessions. With prefix arg, unhide."
(interactive "P")
(let ((grp-buf (ediff-get-group-buffer ediff-meta-list))
(meta-list (cdr ediff-meta-list))
(from (if unhide ?I ?H))
(to (if unhide ?H ?I))
(numMarked 0)
active-sessions-exist session-buf elt)
(while meta-list
(setq elt (car 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))
(if (and (eq to ?I) (buffer-live-p session-buf))
(setq active-sessions-exist t)
(ediff-set-session-status elt to)))))
(if (> numMarked 0)
(ediff-update-meta-buffer grp-buf 'must-redraw)
(beep)
(if unhide
(message "Nothing to reveal...")
(message "Nothing to hide...")))
(if active-sessions-exist
(message "Note: Ediff didn't hide active sessions!"))
))
(defun ediff-operate-on-marked-sessions (operation)
(let ((grp-buf (ediff-get-group-buffer ediff-meta-list))
(meta-list (cdr ediff-meta-list))
(marksym ?*)
(numMarked 0)
(sessionNum 0)
(diff-buffer ediff-meta-diff-buffer)
session-buf elt)
(while meta-list
(setq elt (car meta-list)
meta-list (cdr meta-list)
sessionNum (1+ sessionNum))
(cond ((eq (ediff-get-session-status elt) marksym)
(save-excursion
(setq numMarked (1+ numMarked))
(funcall operation elt sessionNum)))
((and (ediff-meta-session-p elt)
(ediff-buffer-live-p
(setq session-buf (ediff-get-session-buffer elt))))
(setq numMarked
(+ numMarked
(ediff-with-current-buffer session-buf
(setq ediff-meta-diff-buffer diff-buffer)
(ediff-operate-on-marked-sessions operation)))))))
(ediff-update-meta-buffer grp-buf 'must-redraw) numMarked
))
(defun ediff-append-custom-diff (session sessionNum)
(or (ediff-collect-diffs-metajob)
(error "Hmm, I'd hate to do it to you ..."))
(let ((session-buf (ediff-get-session-buffer session))
(meta-diff-buff ediff-meta-diff-buffer)
(metajob ediff-metajob-name)
tmp-buf custom-diff-buf)
(if (ediff-buffer-live-p session-buf)
(ediff-with-current-buffer session-buf
(if (eq ediff-control-buffer session-buf) (progn
(ediff-compute-custom-diffs-maybe)
(setq custom-diff-buf ediff-custom-diff-buffer)))))
(or (ediff-buffer-live-p meta-diff-buff)
(error "Ediff: something wrong--no multiple diffs buffer"))
(cond ((ediff-buffer-live-p custom-diff-buf)
(save-excursion
(set-buffer meta-diff-buff)
(goto-char (point-max))
(insert-buffer custom-diff-buf)
(insert "\n")))
((memq metajob '(ediff-directories
ediff-merge-directories
ediff-merge-directories-with-ancestor))
(save-excursion
(set-buffer (setq tmp-buf (get-buffer-create ediff-tmp-buffer)))
(erase-buffer)
(shell-command
(format "%s %s %s %s"
ediff-custom-diff-program ediff-custom-diff-options
(ediff-get-session-objA-name session)
(ediff-get-session-objB-name session))
t))
(save-excursion
(set-buffer meta-diff-buff)
(goto-char (point-max))
(insert-buffer tmp-buf)
(insert "\n")))
(t
(error "Can't make context diff for Session %d" sessionNum )))
))
(defun ediff-collect-custom-diffs ()
"Collect custom diffs of marked sessions in buffer `*Ediff Multifile Diffs*'.
This operation is defined only for `ediff-directories' and
`ediff-directory-revisions', since its intent is to produce
multifile patches. For `ediff-directory-revisions', we insist that
all marked sessions must be active."
(interactive)
(or (ediff-buffer-live-p ediff-meta-diff-buffer)
(setq ediff-meta-diff-buffer
(get-buffer-create
(ediff-unique-buffer-name "*Ediff Multifile Diffs" "*"))))
(ediff-with-current-buffer ediff-meta-diff-buffer
(erase-buffer))
(if (> (ediff-operate-on-marked-sessions 'ediff-append-custom-diff) 0)
(progn
(display-buffer ediff-meta-diff-buffer 'not-this-window)
(ediff-with-current-buffer ediff-meta-diff-buffer
(set-buffer-modified-p nil)
(setq buffer-read-only t)))
(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-with-current-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"))))
(defun ediff-filegroup-action ()
"Execute appropriate action for the selected 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))
(session-buf (ediff-get-session-buffer info))
(session-number (ediff-get-session-number-at-pos pos meta-buf))
merge-autostore-dir file1 file2 file3 regexp)
(setq file1 (ediff-get-session-objA-name info)
file2 (ediff-get-session-objB-name info)
file3 (ediff-get-session-objC-name info))
(if (memq (ediff-get-session-status info) '(?I))
(progn
(beep)
(if (y-or-n-p "This session is marked as hidden, unmark? ")
(progn
(ediff-set-session-status info nil)
(ediff-update-meta-buffer meta-buf nil session-number))
(error "Aborted"))))
(ediff-with-current-buffer meta-buf
(setq merge-autostore-dir
(ediff-get-group-merge-autostore-dir ediff-meta-list))
(goto-char pos) (cond ((ediff-meta-session-p info)
(if (ediff-buffer-live-p session-buf)
(ediff-show-meta-buffer session-buf)
(setq regexp (read-string "Filter through regular expression: "
nil 'ediff-filtering-regexp-history))
(ediff-directories-internal
file1 file2 file3 regexp
ediff-session-action-function
ediff-metajob-name
`(list (lambda ()
(setq ediff-parent-meta-buffer
(quote ,ediff-meta-buffer)
ediff-meta-session-number
,session-number)
(setcar (quote ,info) ediff-meta-buffer))))))
((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: "
nil 'ediff-filtering-regexp-history))
(ediff-directory-revisions-internal
file1 regexp
ediff-session-action-function ediff-metajob-name
`(list (lambda ()
(setq ediff-parent-meta-buffer
(quote ,ediff-meta-buffer)
ediff-meta-session-number
,session-number)
(setcar (quote ,info) ediff-meta-buffer))))))
((ediff-buffer-live-p session-buf)
(ediff-with-current-buffer session-buf
(setq ediff-mouse-pixel-position (mouse-pixel-position))
(ediff-recenter 'no-rehighlight)))
((ediff-problematic-session-p info)
(beep)
(if (y-or-n-p
"This session has no ancestor. Merge without the ancestor? ")
(ediff-merge-files
file1 file2
`(list (lambda ()
(add-hook
'ediff-after-quit-hook-internal
(lambda ()
(if (ediff-buffer-live-p ,(current-buffer))
(ediff-show-meta-buffer
,(current-buffer) ,session-number)))
nil 'local)
(setq ediff-meta-buffer ,(current-buffer)
ediff-meta-session-number
,session-number)
(setq ediff-merge-store-file
,(if (ediff-nonempty-string-p
merge-autostore-dir)
(concat
merge-autostore-dir
ediff-merge-filename-prefix
(file-name-nondirectory file1))
))
(setcar
(quote ,info) ediff-control-buffer))))
(error "Aborted")))
((ediff-one-filegroup-metajob) (funcall ediff-session-action-function
file1
`(list (lambda ()
(add-hook
'ediff-after-quit-hook-internal
(lambda ()
(if (ediff-buffer-live-p
,(current-buffer))
(ediff-show-meta-buffer
,(current-buffer)
,session-number)))
nil 'local)
(setq ediff-meta-buffer ,(current-buffer)
ediff-meta-session-number
,session-number)
(setq ediff-merge-store-file
,(if (ediff-nonempty-string-p
merge-autostore-dir)
(concat
merge-autostore-dir
ediff-merge-filename-prefix
(file-name-nondirectory file1))) )
(setcar
(quote ,info) ediff-control-buffer)))))
((not (ediff-metajob3)) (funcall ediff-session-action-function
file1 file2
`(list (lambda ()
(add-hook
'ediff-after-quit-hook-internal
(lambda ()
(if (ediff-buffer-live-p
,(current-buffer))
(ediff-show-meta-buffer
,(current-buffer)
,session-number)))
nil 'local)
(setq ediff-meta-buffer ,(current-buffer)
ediff-meta-session-number
,session-number)
(setq ediff-merge-store-file
,(if (ediff-nonempty-string-p
merge-autostore-dir)
(concat
merge-autostore-dir
ediff-merge-filename-prefix
(file-name-nondirectory file1))) )
(setcar
(quote ,info) ediff-control-buffer)))))
((ediff-metajob3) (funcall ediff-session-action-function
file1 file2 file3
`(list (lambda ()
(add-hook
'ediff-after-quit-hook-internal
(lambda ()
(if (ediff-buffer-live-p
,(current-buffer))
(ediff-show-meta-buffer
,(current-buffer)
,session-number)))
nil 'local)
(setq ediff-merge-store-file
,(if (ediff-nonempty-string-p
merge-autostore-dir)
(concat
merge-autostore-dir
ediff-merge-filename-prefix
(file-name-nondirectory file1))) )
(setq ediff-meta-buffer , (current-buffer)
ediff-meta-session-number
,session-number)
(setcar
(quote ,info) ediff-control-buffer)))))
) ) ))
(defun ediff-registry-action ()
"Switch to a selected session."
(interactive)
(let* ((pos (ediff-event-point last-command-event))
(buf (ediff-event-buffer last-command-event))
(ctl-buf (ediff-get-meta-info buf pos)))
(if (ediff-buffer-live-p ctl-buf)
(if (ediff-with-current-buffer ctl-buf
(eq (key-binding "q") 'ediff-quit-meta-buffer))
(ediff-show-meta-buffer ctl-buf t)
(ediff-with-current-buffer ctl-buf
(setq ediff-mouse-pixel-position (mouse-pixel-position))
(ediff-recenter 'no-rehighlight)))
(beep)
(message "You've selected a stale session --- try again")
(ediff-update-registry))
(ediff-with-current-buffer buf
(goto-char pos))
))
(defun ediff-show-meta-buffer (&optional meta-buf session-number)
"Show the session group buffer."
(interactive)
(run-hooks 'ediff-before-directory-setup-hooks)
(let (wind frame silent)
(if meta-buf (setq silent t))
(setq meta-buf (or meta-buf ediff-meta-buffer))
(cond ((not (bufferp meta-buf))
(error "This Ediff session is not part of a session group"))
((not (ediff-buffer-live-p meta-buf))
(error
"Can't find this session's group panel -- session itself is ok")))
(cond ((numberp session-number)
(ediff-update-meta-buffer meta-buf nil session-number))
(session-number)
(t (ediff-cleanup-meta-buffer meta-buf)))
(ediff-with-current-buffer meta-buf
(save-excursion
(cond ((setq wind (ediff-get-visible-buffer-window meta-buf))
(or silent
(message
"Already showing the group panel for this session"))
(set-window-buffer wind meta-buf)
(select-window wind))
((window-live-p (setq wind ediff-window-C)) (set-window-buffer ediff-window-C meta-buf)
(select-window wind))
((window-live-p (setq wind ediff-window-A))
(set-window-buffer ediff-window-A meta-buf)
(select-window wind))
((window-live-p (setq wind ediff-window-B))
(set-window-buffer ediff-window-B meta-buf)
(select-window wind))
((and
(setq wind
(ediff-get-visible-buffer-window ediff-registry-buffer))
(ediff-window-display-p))
(select-window wind)
(other-window 1)
(set-window-buffer (selected-window) meta-buf))
(t (ediff-skip-unsuitable-frames 'ok-unsplittable)
(set-window-buffer (selected-window) meta-buf)))
))
(if (and (ediff-window-display-p)
(window-live-p
(setq wind (ediff-get-visible-buffer-window meta-buf))))
(progn
(setq frame (window-frame wind))
(raise-frame frame)
(ediff-reset-mouse frame)))
(run-hooks 'ediff-show-session-group-hook)
))
(defun ediff-show-current-session-meta-buffer ()
(interactive)
(ediff-show-meta-buffer nil ediff-meta-session-number))
(defun ediff-show-meta-buff-from-registry ()
"Display the session group buffer for a selected session group."
(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))
(meta-or-session-buf info))
(ediff-with-current-buffer meta-or-session-buf
(ediff-show-meta-buffer nil t))))
(defun ediff-show-registry ()
"Display Ediff's registry."
(interactive)
(ediff-update-registry)
(if (not (ediff-buffer-live-p ediff-registry-buffer))
(error "No active Ediff sessions or corrupted session registry"))
(let (wind frame)
(ediff-with-current-buffer ediff-registry-buffer
(save-excursion
(cond ((setq wind
(ediff-get-visible-buffer-window ediff-registry-buffer))
(message "Already showing the registry")
(set-window-buffer wind ediff-registry-buffer)
(select-window wind))
((window-live-p ediff-window-C)
(set-window-buffer ediff-window-C ediff-registry-buffer)
(select-window ediff-window-C))
((window-live-p ediff-window-A)
(set-window-buffer ediff-window-A ediff-registry-buffer)
(select-window ediff-window-A))
((window-live-p ediff-window-B)
(set-window-buffer ediff-window-B ediff-registry-buffer)
(select-window ediff-window-B))
((and (setq wind
(ediff-get-visible-buffer-window ediff-meta-buffer))
(ediff-window-display-p))
(select-window wind)
(other-window 1)
(set-window-buffer (selected-window) ediff-registry-buffer))
(t (ediff-skip-unsuitable-frames 'ok-unsplittable)
(set-window-buffer (selected-window) ediff-registry-buffer)))
))
(if (ediff-window-display-p)
(progn
(setq frame
(window-frame
(ediff-get-visible-buffer-window ediff-registry-buffer)))
(raise-frame frame)
(ediff-reset-mouse frame)))
(run-hooks 'ediff-show-registry-hook)
))
(defalias 'eregistry 'ediff-show-registry)
(defun ediff-update-meta-buffer (meta-buf &optional must-redraw session-number)
(if (ediff-buffer-live-p meta-buf)
(ediff-with-current-buffer meta-buf
(let (overl)
(cond (must-redraw (funcall ediff-meta-redraw-function ediff-meta-list))
((numberp session-number) (ediff-update-session-marker-in-dir-meta-buffer
session-number))
(t (ediff-update-markers-in-dir-meta-buffer ediff-meta-list)))
(setq overl (ediff-get-meta-overlay-at-pos (point)))
(while (and overl (ediff-overlay-get overl 'invisible))
(ediff-next-meta-item1)
(setq overl (ediff-get-meta-overlay-at-pos (point))))
))))
(defun ediff-update-registry ()
(ediff-with-current-buffer (current-buffer)
(if (ediff-buffer-live-p ediff-registry-buffer)
(ediff-redraw-registry-buffer)
(ediff-prepare-meta-buffer
'ediff-registry-action
ediff-session-registry
"*Ediff Registry"
'ediff-redraw-registry-buffer
'ediff-registry))
))
(defun ediff-cleanup-meta-buffer (meta-buffer)
(if (ediff-buffer-live-p meta-buffer)
(ediff-with-current-buffer meta-buffer
(ediff-update-meta-buffer meta-buffer)
(if (ediff-buffer-live-p ediff-parent-meta-buffer)
(ediff-update-meta-buffer
ediff-parent-meta-buffer nil ediff-meta-session-number)))))
(defun ediff-safe-to-quit (meta-buffer)
(if (ediff-buffer-live-p meta-buffer)
(let ((lis ediff-meta-list)
(cont t)
buffer-read-only)
(ediff-with-current-buffer meta-buffer
(setq lis (cdr lis)) (while (and cont lis)
(if (ediff-buffer-live-p
(ediff-get-group-buffer lis)) (setq cont nil))
(setq lis (cdr lis)))
cont))))
(defun ediff-quit-meta-buffer ()
"If the group has no active session, delete the meta buffer.
If no session is in progress, ask to confirm before deleting meta buffer.
Otherwise, bury the meta buffer.
If this is a session registry buffer then just bury it."
(interactive)
(let* ((buf (current-buffer))
(dir-diffs-buffer ediff-dir-diffs-buffer)
(meta-diff-buffer ediff-meta-diff-buffer)
(session-number ediff-meta-session-number)
(parent-buf ediff-parent-meta-buffer)
(dont-show-registry (eq buf ediff-registry-buffer)))
(if dont-show-registry
(bury-buffer)
(cond ((and (ediff-safe-to-quit buf)
(y-or-n-p "Quit this session group? "))
(run-hooks 'ediff-quit-session-group-hook)
(message "")
(ediff-dispose-of-meta-buffer buf))
((ediff-safe-to-quit buf)
(bury-buffer))
(t
(error
"This session group has active sessions---cannot exit")))
(ediff-update-meta-buffer parent-buf nil session-number)
(ediff-kill-buffer-carefully dir-diffs-buffer)
(ediff-kill-buffer-carefully meta-diff-buffer)
(if (ediff-buffer-live-p parent-buf)
(progn
(setq dont-show-registry t)
(ediff-show-meta-buffer parent-buf session-number)))
)
(or dont-show-registry
(ediff-show-registry))))
(defun ediff-dispose-of-meta-buffer (buf)
(setq ediff-session-registry (delq buf ediff-session-registry))
(ediff-with-current-buffer buf
(if (ediff-buffer-live-p ediff-dir-diffs-buffer)
(kill-buffer ediff-dir-diffs-buffer)))
(kill-buffer buf))
(defun ediff-get-meta-info (buf point &optional noerror)
(let (result olist tmp)
(if (and point (ediff-buffer-live-p buf))
(ediff-with-current-buffer buf
(if ediff-xemacs-p
(setq result
(if (setq tmp (extent-at point buf 'ediff-meta-info))
(ediff-overlay-get tmp 'ediff-meta-info)))
(setq olist (overlays-at point))
(setq olist
(mapcar (lambda (elt)
(unless (overlay-get elt 'invisible)
(overlay-get elt 'ediff-meta-info)))
olist))
(while (and olist (null (car olist)))
(setq olist (cdr olist)))
(setq result (car olist)))))
(if result
result
(if noerror
nil
(ediff-update-registry)
(error "No session info in this line")))))
(defun ediff-get-meta-overlay-at-pos (point)
(if ediff-xemacs-p
(extent-at point (current-buffer) 'ediff-meta-info)
(let* ((overl-list (overlays-at point))
(overl (car overl-list)))
(while (and overl (null (overlay-get overl 'ediff-meta-info)))
(setq overl-list (cdr overl-list)
overl (car overl-list)))
overl)))
(defsubst ediff-get-session-number-at-pos (point &optional meta-buffer)
(setq meta-buffer (if (ediff-buffer-live-p meta-buffer)
meta-buffer
(current-buffer)))
(ediff-with-current-buffer meta-buffer
(ediff-overlay-get
(ediff-get-meta-overlay-at-pos point) 'ediff-meta-session-number)))
(defun ediff-next-meta-overlay-start (point)
(if (eobp)
(goto-char (point-min))
(let ((overl (ediff-get-meta-overlay-at-pos point)))
(if ediff-xemacs-p
(progn
(if overl
(setq overl (next-extent overl))
(setq overl (next-extent (current-buffer))))
(if overl
(extent-start-position overl)
(point-max)))
(if overl
(overlay-end overl)
(next-overlay-change point))))
))
(defun ediff-previous-meta-overlay-start (point)
(if (bobp)
(goto-char (point-max))
(let ((overl (ediff-get-meta-overlay-at-pos point)))
(if ediff-xemacs-p
(progn
(if overl
(setq overl (previous-extent overl))
(setq overl (previous-extent (current-buffer))))
(if overl
(extent-start-position overl)
(point-min)))
(if overl (setq point (overlay-start overl)))
(if (not (bobp))
(setq point (1- point)))
(setq point (previous-overlay-change point))
(or (car (overlays-at point))
(setq point (point-min)))
point))))
(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))
(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) (null session-buf) (error
"Patch has been already applied to this file--cannot be repeated!"))
(ediff-with-current-buffer meta-patchbuf
(save-restriction
(widen)
(narrow-to-region beg-marker end-marker)
(ediff-patch-file-internal meta-patchbuf file startup-hooks)))))
(defun ediff-unmark-all-for-operation ()
"Unmark all sessions marked for operation."
(interactive)
(let ((list (cdr ediff-meta-list))
elt)
(while (setq elt (car list))
(ediff-mark-session-for-operation elt 'unmark)
(setq list (cdr list))))
(ediff-update-meta-buffer (current-buffer) 'must-redraw))
(defun ediff-unmark-all-for-hiding ()
"Unmark all sessions marked for hiding."
(interactive)
(let ((list (cdr ediff-meta-list))
elt)
(while (setq elt (car list))
(ediff-mark-session-for-hiding elt 'unmark)
(setq list (cdr list))))
(ediff-update-meta-buffer (current-buffer) 'must-redraw))
(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))
marked1 marked2 marked3
fileinfo1 fileinfo2 fileinfo3 elt)
(message "Comparing files ...")
(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)
(setq marked1 t
marked2 t
marked3 t)
(or (ediff-mark-if-equal fileinfo1 fileinfo2)
(setq marked1 nil))
(if (ediff-metajob3)
(progn
(or (ediff-mark-if-equal fileinfo1 fileinfo3)
(setq marked2 nil))
(or (ediff-mark-if-equal fileinfo2 fileinfo3)
(setq marked3 nil))))
(if (and marked1 marked2 marked3)
(cond ((eq last-command-char ?h)
(ediff-mark-session-for-hiding elt 'mark))
((eq last-command-char ?m)
(ediff-mark-session-for-operation elt 'mark))
))
(setq list (cdr list)))
(message "Comparing files ... Done"))
(ediff-update-meta-buffer (current-buffer) 'must-redraw))
(defun ediff-mark-if-equal (fileinfo1 fileinfo2)
(let ((f1 (car fileinfo1))
(f2 (car fileinfo2)))
(cond ((file-directory-p f1) nil)
((file-directory-p f2) nil)
((ediff-same-file-contents f1 f2)
(ediff-set-file-eqstatus fileinfo1 t)
(ediff-set-file-eqstatus fileinfo2 t)
t))
))