public/elisp-vcs
2
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

update subrepo elisp-vcs

Browse Source
This commit is contained in:
Kai Tetzlaff 2011-04-24 09:16:02 +02:00
parent 7473bfb2cb
commit b10fbbad5b
17 changed files with 1021 additions and 711 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
dvc/lisp/Makefile.in
View File

@ -53,6 +53,7 @@ install: all
echo Installing $$elc ; \
$(INSTALL_DATA) $$elc "$(lispdir)" ; \
done
$(INSTALL_DATA) xmtn-hooks.lua $(lispdir)
clean:
rm -f *.elc dvc-site.el \

7
dvc/lisp/dvc-buffers.el
View File

@ -1,6 +1,6 @@
;;; dvc-buffers.el --- Buffer management for DVC
;; Copyright (C) 2005-2010 by all contributors
;; Copyright (C) 2005-2011 by all contributors
;; Author: Matthieu Moy <Matthieu.Moy@imag.fr>
;; Contributions from:
@ -178,8 +178,9 @@ See also `dvc-get-buffer'"
(eq mode 'string-multiple))
(generate-new-buffer (format name path))
(let ((default-directory
(or (file-name-directory path)
default-directory)))
(if (file-name-directory path)
(expand-file-name (file-name-directory path))
default-directory)))
(dvc-create-buffer name)))))
(with-current-buffer buffer
(if (featurep 'xemacs)

40
dvc/lisp/dvc-fileinfo.el
View File

@ -1,7 +1,7 @@
;;; dvc-fileinfo.el --- An ewoc structure for displaying file information
;;; for DVC
;; Copyright (C) 2007 - 2010 by all contributors
;; Copyright (C) 2007 - 2011 by all contributors
;; Author: Stephen Leake, <stephen_leake@stephe-leake.org>
@ -553,42 +553,8 @@ in that directory. Then move to previous ewoc entry."
(otherwise
(error "not on a file or directory")))))
(defun dvc-fileinfo-next (&optional no-ding)
"Move to the next ewoc entry. If optional NO-DING, don't ding
if there is no next."
(interactive)
(let* ((current (ewoc-locate dvc-fileinfo-ewoc))
(cur-location (ewoc-location current))
(next (ewoc-next dvc-fileinfo-ewoc current)))
(cond
((> cur-location (point))
;; not exactly at an element; move there
(goto-char cur-location))
(next
(goto-char (ewoc-location next)))
(t
;; at last element
(unless no-ding (ding))))))
(defun dvc-fileinfo-prev (&optional no-ding)
"Move to the previous ewoc entry. If optional NO-DING, don't ding
if there is no prev."
(interactive)
(let* ((current (ewoc-locate dvc-fileinfo-ewoc))
(cur-location (ewoc-location current))
(prev (ewoc-prev dvc-fileinfo-ewoc current)))
(cond
((> (point) cur-location)
(goto-char cur-location))
(prev
(goto-char (ewoc-location prev)))
(t
;; at first element
(unless no-ding (ding))))))
(dvc-make-ewoc-next dvc-fileinfo-next dvc-fileinfo-ewoc)
(dvc-make-ewoc-prev dvc-fileinfo-prev dvc-fileinfo-ewoc)
(defun dvc-fileinfo-find-file (file)
"Return ewoc element for FILE (full path)."

4
dvc/lisp/dvc-log.el
View File

@ -1,6 +1,6 @@
;;; dvc-log.el --- Manipulation of the log before committing
;; Copyright (C) 2005-2008 by all contributors
;; Copyright (C) 2005-2008, 2010 by all contributors
;; Author: Matthieu Moy <Matthieu.Moy@imag.fr>
;; Contributions from:
@ -121,7 +121,7 @@ is reused."
(current-window-configuration))
(let ((start-buffer (current-buffer)))
(dvc-switch-to-buffer
(dvc-get-buffer-create (dvc-current-active-dvc) 'log-edit)
(dvc-get-buffer-create (dvc-current-active-dvc) 'log-edit root)
other-frame)
;; `no-init' is somewhat misleading here. It is set to t in
;; dvc-add-log-entry, and nil in dvc-log-edit. That prevents

9
dvc/lisp/dvc-status.el
View File

@ -1,6 +1,6 @@
;;; dvc-status.el --- A generic status mode for DVC
;; Copyright (C) 2007 - 2009 by all contributors
;; Copyright (C) 2007 - 2009, 2011 by all contributors
;; Author: Stephen Leake, <stephen_leake@stephe-leake.org>
@ -32,12 +32,12 @@
(require 'uniquify)
(defcustom dvc-status-display-known nil
"If non-nil, display files with 'known' status in xmtn-status buffer."
"If non-nil, display files with 'known' status in dvc-status buffer."
:type 'boolean
:group 'dvc)
(defcustom dvc-status-display-ignored nil
"If non-nil, display files with 'ignored' status in xmtn-status buffer."
"If non-nil, display files with 'ignored' status in dvc-status buffer."
:type 'boolean
:group 'dvc)
@ -126,8 +126,7 @@
;; "<back-end>-status-mode", if defined, will be used instead of this
;; one. If so, it should be derived from dvc-status-mode (via
;; `define-derived-mode'), and rely on it for as many features as
;; possible (one can, for example, extend the menu and keymap). See
;; `xmtn-status-mode' in xmtn-dvc.el for a good example.
;; possible (one can, for example, extend the menu and keymap).
;; Remember to add the new mode to uniquify-list-buffers-directory-modes
(define-derived-mode dvc-status-mode fundamental-mode "dvc-status"
"Major mode to display workspace status."

12
dvc/lisp/dvc-unified.el
View File

@ -287,15 +287,23 @@ If DONT-SWITCH is non-nil, just show the diff buffer, don't select it."
buffer file name; nil means entire tree; negative prefix arg
means prompt for tree depending on value of
dvc-read-project-tree-mode), LAST-N entries (default
`dvc-log-last-n'; all if nil, positive prefix value means that
many entries). Use `dvc-changelog' for the full log."
`dvc-log-last-n'; all if nil, prefix value means that
many entries (absolute value)). Use `dvc-changelog' for the full log."
(interactive "i\nP")
<<<<<<< TREE
(let* ((allentries (or (eq last-n nil)
(< (prefix-numeric-value last-n) 0)))
(last-n (prefix-numeric-value last-n))
(path (if (< last-n 0)
nil (buffer-file-name)))
(last-n (if allentries nil last-n))
=======
(let* ((path (if (and last-n (< (prefix-numeric-value last-n) 0))
nil (buffer-file-name)))
(last-n (if last-n
(abs (prefix-numeric-value last-n))
dvc-log-last-n))
>>>>>>> MERGE-SOURCE
(default-directory
(dvc-read-project-tree-maybe "DVC tree root (directory): "
(when path (expand-file-name path))

86
dvc/lisp/xmtn-automate.el
View File

@ -1,6 +1,6 @@
;;; xmtn-automate.el --- Interface to monotone's "automate" functionality
;; Copyright (C) 2008 - 2010 Stephen Leake
;; Copyright (C) 2008 - 2011 Stephen Leake
;; Copyright (C) 2006, 2007 Christian M. Ohler
;; Author: Christian M. Ohler
@ -131,7 +131,7 @@ workspace root."
(buffer-substring-no-properties (point-min) (point-max))
(xmtn-automate--cleanup-command handle))))
(defun xmtn-automate-simple-command-output-string (root command)
(defun xmtn-automate-command-output-string (root command)
"Send COMMAND to session for ROOT. Return result as a string."
(let* ((session (xmtn-automate-cache-session root))
(command-handle (xmtn-automate--new-command session command)))
@ -149,34 +149,37 @@ workspace root."
(xmtn-automate-command-buffer command-handle)))
(xmtn-automate--cleanup-command command-handle)))
(defun xmtn-automate-command-output-lines (handle)
"Return list of lines of output in HANDLE; first line output is
first in list."
(xmtn-automate-command-wait-until-finished handle)
(with-current-buffer (xmtn-automate-command-buffer handle)
(goto-char (point-min))
(let (result)
(while (< (point) (point-max))
(setq result (cons (buffer-substring-no-properties
(point)
(progn (end-of-line) (point)))
result))
(forward-line 1))
(xmtn-automate--cleanup-command handle)
(nreverse result))))
(defun xmtn-automate-command-output-file (root file command)
"Send COMMAND to session for ROOT, store result in FILE."
(let* ((session (xmtn-automate-cache-session root))
(command-handle (xmtn-automate--new-command session command nil nil)))
(xmtn-automate-command-wait-until-finished command-handle)
(with-current-buffer (xmtn-automate-command-buffer command-handle)
(write-region nil nil file))
(xmtn-automate--cleanup-command command-handle)))
(defun xmtn-automate-simple-command-output-lines (root command)
(defun xmtn-automate-command-output-lines (root command)
"Return list of strings containing output of COMMAND, one line per
string."
(let* ((session (xmtn-automate-cache-session root))
(command-handle (xmtn-automate--new-command session command)))
(xmtn-automate-command-output-lines command-handle)))
(handle (xmtn-automate--new-command session command)))
(xmtn-automate-command-wait-until-finished handle)
(with-current-buffer (xmtn-automate-command-buffer handle)
(goto-char (point-max))
(let (result)
(while (= 0 (forward-line -1))
(setq result (cons (buffer-substring-no-properties
(point)
(progn (end-of-line) (point)))
result)))
(xmtn-automate--cleanup-command handle)
result))))
(defun xmtn-automate-simple-command-output-line (root command)
(defun xmtn-automate-command-output-line (root command)
"Return the one line output from mtn automate as a string.
Signals an error if output contains zero lines or more than one line."
(let ((lines (xmtn-automate-simple-command-output-lines root command)))
(let ((lines (xmtn-automate-command-output-lines root command)))
(unless (eql (length lines) 1)
(error "Expected precisely one line of output from mtn automate, got %s: %s %S"
(length lines)
@ -287,12 +290,14 @@ Signals an error if output contains zero lines or more than one line."
(defun xmtn-automate-kill-session (root)
"Kill session for ROOT."
(interactive)
(let ((temp (assoc (dvc-uniquify-file-name root) xmtn-automate--*sessions*)))
(let ((session (assoc (dvc-uniquify-file-name root) xmtn-automate--*sessions*)))
;; session may have already been killed
(when temp
(xmtn-automate--close-session (cdr temp))
(when session
(when (xmtn-automate--session-error-file (cdr session))
(delete-file (xmtn-automate--session-error-file session)))
(xmtn-automate--close-session (cdr session))
(setq xmtn-automate--*sessions*
(delete temp xmtn-automate--*sessions* )))))
(delete session xmtn-automate--*sessions*)))))
(defun xmtn-kill-all-sessions ()
"Kill all xmtn-automate sessions."
@ -671,7 +676,7 @@ Each element of the list is a list; key, signature, name, value, trust."
accu))
(defun xmtn--heads (root branch)
(xmtn-automate-simple-command-output-lines
(xmtn-automate-command-output-lines
root
(cons
(list "ignore-suspend-certs" "")
@ -679,8 +684,33 @@ Each element of the list is a list; key, signature, name, value, trust."
(or branch
(xmtn--tree-default-branch root))))))
(defun xmtn--rev-author (root rev)
"Return first author of REV"
(let (cert-name
result)
(with-temp-buffer
(xmtn-automate-command-output-buffer root (current-buffer) (list "certs" rev))
(goto-char (point-min))
;; key [46ec58576f9e4f34a9eede521422aa5fd299dc50]
;; signature "ok"
;; name "author"
;; value "beth"
;; trust "trusted"
;;
;; ...
(while (not result)
(xmtn-basic-io-skip-line "key")
(xmtn-basic-io-skip-line "signature")
(xmtn-basic-io-check-line "name" (setq cert-name (cadar value)))
(xmtn-basic-io-check-line "value"
(if (string= cert-name "author")
(setq result (cadar value))))
(xmtn-basic-io-skip-line "trust")
(xmtn-basic-io-check-empty)))
result))
(defun xmtn--tree-default-branch (root)
(xmtn-automate-simple-command-output-line root `("get_option" "branch")))
(xmtn-automate-command-output-line root `("get_option" "branch")))
(defun xmtn--get-corresponding-path-raw (root normalized-file-name
source-revision-hash-id

323
dvc/lisp/xmtn-conflicts.el
View File

@ -1,6 +1,6 @@
;;; xmtn-conflicts.el --- conflict resolution for DVC backend for monotone
;; Copyright (C) 2008 - 2010 Stephen Leake
;; Copyright (C) 2008 - 2011 Stephen Leake
;; Author: Stephen Leake
;; Keywords: tools
@ -44,34 +44,38 @@
(defvar xmtn-conflicts-left-work ""
"Buffer-local variable holding left workspace root.")
(make-variable-buffer-local 'xmtn-conflicts-left-work)
(put 'xmtn-conflicts-left-work 'permanent-local t)
(defvar xmtn-conflicts-right-work ""
"Buffer-local variable holding right workspace root.")
(make-variable-buffer-local 'xmtn-conflicts-right-work)
(put 'xmtn-conflicts-right-work 'permanent-local t)
(defvar xmtn-conflicts-left-root ""
(defvar xmtn-conflicts-left-resolution-root ""
"Buffer-local variable holding left resolution root directory
name; relative to workspace root.")
(make-variable-buffer-local 'xmtn-conflicts-left-root)
(make-variable-buffer-local 'xmtn-conflicts-left-resolution-root)
(defvar xmtn-conflicts-right-root ""
(defvar xmtn-conflicts-right-resolution-root ""
"Buffer-local variable holding right resolution root directory
name; relative to workspace root.")
(make-variable-buffer-local 'xmtn-conflicts-right-root)
(make-variable-buffer-local 'xmtn-conflicts-right-resolution-root)
(defvar xmtn-conflicts-left-branch ""
"Buffer-local variable holding left resolution branch.")
"Buffer-local variable holding left branch.")
(make-variable-buffer-local 'xmtn-conflicts-left-branch)
(put 'xmtn-conflicts-left-branch 'permanent-local t)
(defvar xmtn-conflicts-right-branch ""
"Buffer-local variable holding right resolution branch.")
"Buffer-local variable holding right branch.")
(make-variable-buffer-local 'xmtn-conflicts-right-branch)
(put 'xmtn-conflicts-right-branch 'permanent-local t)
(defvar xmtn-conflicts-ancestor-revision ""
(defvar xmtn-conflicts-left-author ""
"Buffer-local variable holding left author.")
(make-variable-buffer-local 'xmtn-conflicts-left-author)
(defvar xmtn-conflicts-right-author ""
"Buffer-local variable holding right branch.")
(make-variable-buffer-local 'xmtn-conflicts-right-author)
(defvar xmtn-conflicts-ancestor-revision nil
"Buffer-local variable holding ancestor revision id.")
(make-variable-buffer-local 'xmtn-conflicts-ancestor-revision)
@ -87,10 +91,6 @@
"Count of resolved-internal conflicts.")
(make-variable-buffer-local 'xmtn-conflicts-resolved-internal-count)
(defvar xmtn-conflicts-output-buffer nil
"Buffer to write basic-io to, when saving a conflicts buffer.")
(make-variable-buffer-local 'xmtn-conflicts-output-buffer)
(defvar xmtn-conflicts-current-conflict-buffer nil
"Global variable for use in ediff quit hook.")
;; xmtn-conflicts-current-conflict-buffer cannot be buffer local,
@ -185,8 +185,8 @@ The elements must all be of type xmtn-conflicts-conflict.")
(make-variable-buffer-local 'xmtn-conflicts-ewoc)
(defun xmtn-conflicts-parse-header ()
"Fill `xmtn-conflicts-left-revision', `xmtn-conflicts-left-root',
`xmtn-conflicts-right-revision', `xmtn-conflicts-right-root'
"Fill `xmtn-conflicts-left-revision', `xmtn-conflicts-left-resolution-root',
`xmtn-conflicts-right-revision', `xmtn-conflicts-right-resolution-root'
`xmtn-conflicts-ancestor-revision' with data from conflict
header."
;; left [9a019f3a364416050a8ff5c05f1e44d67a79e393]
@ -201,15 +201,16 @@ header."
(setq xmtn-conflicts-ancestor-revision (cadar value)))
(xmtn-basic-io-check-empty)
;; xmtn-conflicts-left-branch xmtn-conflicts-right-branch set by xmtn-conflicts-load-opts
;; xmtn-conflicts-left-branch, -right-branch, -left-author,
;; -right-author set by xmtn-conflicts-load-opts
(if (string= xmtn-conflicts-left-branch xmtn-conflicts-right-branch)
(progn
(setq xmtn-conflicts-left-root "_MTN/resolutions/left")
(setq xmtn-conflicts-right-root "_MTN/resolutions/right"))
(setq xmtn-conflicts-left-resolution-root "_MTN/resolutions/left")
(setq xmtn-conflicts-right-resolution-root "_MTN/resolutions/right"))
(progn
(setq xmtn-conflicts-left-root (concat "_MTN/resolutions/" xmtn-conflicts-left-branch))
(setq xmtn-conflicts-right-root (concat "_MTN/resolutions/" xmtn-conflicts-right-branch))))
(setq xmtn-conflicts-left-resolution-root (concat "_MTN/resolutions/" xmtn-conflicts-left-branch))
(setq xmtn-conflicts-right-resolution-root (concat "_MTN/resolutions/" xmtn-conflicts-right-branch))))
(setq xmtn-conflicts-total-count 0)
(setq xmtn-conflicts-resolved-count 0)
(setq xmtn-conflicts-resolved-internal-count 0)
@ -476,7 +477,9 @@ header."
xmtn-conflicts-ewoc
(concat
(format " Left branch : %s\n" xmtn-conflicts-left-branch)
(format " Left author : %s\n" xmtn-conflicts-left-author)
(format " Right branch : %s\n" xmtn-conflicts-right-branch)
(format " Right author : %s\n" xmtn-conflicts-right-author)
(format " Total conflicts : %d\n" xmtn-conflicts-total-count)
(format "Resolved conflicts : %d\n" xmtn-conflicts-resolved-count)
)
@ -491,10 +494,13 @@ header."
(goto-char begin)
(xmtn-conflicts-parse-header)
(if xmtn-conflicts-ancestor-revision
;; if there is no ancestor revision, then left is ancestor of
;; right or vice versa, and there can be no conflicts.
(xmtn-conflicts-parse-conflicts (1- end)); off-by-one somewhere.
;; else no conflicts
)
(let ((inhibit-read-only t)) (delete-region begin (1- end)))
(xmtn-conflicts-load-opts)
(xmtn-conflicts-set-hf)
(set-buffer-modified-p nil)
(point-max))
@ -509,7 +515,7 @@ header."
;; point, and inserts empty header and footer lines.
(goto-char (point-max))
(let ((text-end (point)))
(xmtn-conflicts-mode)
(xmtn-conflicts-mode) ;; kills non-permanent buffer-local variables
(xmtn-conflicts-read (point-min) text-end))
(set-buffer-modified-p nil)
@ -517,10 +523,10 @@ header."
(xmtn-conflicts-next nil t))
(defun xmtn-conflicts-write-header (ewoc-buffer)
"Write EWOC-BUFFER header info in basic-io format to current buffer."
"Write revisions from EWOC-BUFFER header info in basic-io format to current buffer."
(xmtn-basic-io-write-id "left" (with-current-buffer ewoc-buffer xmtn-conflicts-left-revision))
(xmtn-basic-io-write-id "right" (with-current-buffer ewoc-buffer xmtn-conflicts-right-revision))
(if xmtn-conflicts-ancestor-revision
(if (with-current-buffer ewoc-buffer xmtn-conflicts-ancestor-revision)
(xmtn-basic-io-write-id "ancestor" (with-current-buffer ewoc-buffer xmtn-conflicts-ancestor-revision)))
)
@ -672,13 +678,13 @@ header."
(xmtn-basic-io-write-str "resolved_rename_left" (cadr (xmtn-conflicts-conflict-left_resolution conflict))))
))))
(defun xmtn-conflicts-write-conflicts (ewoc)
"Write EWOC elements in basic-io format to xmtn-conflicts-output-buffer."
(defun xmtn-conflicts-write-conflicts (ewoc buffer)
"Write EWOC elements in basic-io format to BUFFER."
(setq xmtn-conflicts-resolved-count 0)
(setq xmtn-conflicts-resolved-internal-count 0)
(ewoc-map
(lambda (conflict)
(with-current-buffer xmtn-conflicts-output-buffer
(with-current-buffer buffer
(ecase (xmtn-conflicts-conflict-conflict_type conflict)
(content
(xmtn-conflicts-write-content conflict))
@ -693,20 +699,16 @@ header."
"Replace region BEGIN END with EWOC-BUFFER ewoc in basic-io format."
(delete-region begin end)
(xmtn-conflicts-write-header ewoc-buffer)
;; ewoc-map sets current-buffer to ewoc-buffer, so we need a
;; reference to the current buffer.
(let ((xmtn-conflicts-output-buffer (current-buffer))
(ewoc (with-current-buffer ewoc-buffer xmtn-conflicts-ewoc)))
(xmtn-conflicts-write-conflicts ewoc)
(with-current-buffer ewoc-buffer (xmtn-conflicts-set-hf))
(let ((ewoc (with-current-buffer ewoc-buffer xmtn-conflicts-ewoc)))
(xmtn-conflicts-write-conflicts ewoc (current-buffer))
;; 'update' not needed for save, but it's nice for the user
(with-current-buffer ewoc-buffer (xmtn-conflicts-update-counts))
))
;; Arrange for xmtn-conflicts-save to be called by save-buffer. We do
;; not automatically convert in insert-file-contents, because we don't
;; want to convert _all_ conflict files (consider the monotone test
;; suite!). Instead, we call xmtn-conflicts-read explicitly from
;; xmtn-conflicts-review, and set after-insert-file-functions to a
;; buffer-local value in xmtn-conflicts-mode.
;; Arrange for xmtn-conflicts-save to be called by save-buffer. We
;; also set after-insert-file-functions to a buffer-local value in
;; xmtn-conflicts-mode.
(add-to-list 'format-alist
'(xmtn-conflicts-format
"Save conflicts in basic-io format."
@ -719,6 +721,7 @@ header."
(defun xmtn-conflicts-update-counts ()
"Update resolved counts."
(interactive)
(setq xmtn-conflicts-resolved-count 0)
(setq xmtn-conflicts-resolved-internal-count 0)
@ -742,7 +745,8 @@ header."
(setq xmtn-conflicts-resolved-count (+ 1 xmtn-conflicts-resolved-count))))
))
xmtn-conflicts-ewoc))
xmtn-conflicts-ewoc)
(xmtn-conflicts-set-hf))
(dvc-make-ewoc-next xmtn-conflicts-next xmtn-conflicts-ewoc)
(dvc-make-ewoc-prev xmtn-conflicts-prev xmtn-conflicts-ewoc)
@ -845,11 +849,11 @@ header."
(xmtn-conflicts-conflict-ancestor_name conflict))))
(file-left (xmtn-conflicts-get-file xmtn-conflicts-left-work
(xmtn-conflicts-conflict-left_file_id conflict)
xmtn-conflicts-left-root
xmtn-conflicts-left-resolution-root
(xmtn-conflicts-conflict-left_name conflict)))
(file-right (xmtn-conflicts-get-file xmtn-conflicts-right-work
(xmtn-conflicts-conflict-right_file_id conflict)
xmtn-conflicts-right-root
xmtn-conflicts-right-resolution-root
(xmtn-conflicts-conflict-right_name conflict)))
(result-file (concat "_MTN/resolutions/result/" (xmtn-conflicts-conflict-right_name conflict))) )
@ -1137,22 +1141,6 @@ non-nil, show log-edit buffer in other frame."
(insert ": ")
))
(defun xmtn-conflicts-do-propagate (&optional cached-branch)
"Perform propagate on revisions in current conflict buffer."
(interactive)
(save-some-buffers t); log buffer
;; save-some-buffers does not save the conflicts buffer, which is the current buffer
(save-buffer)
(xmtn-propagate-from xmtn-conflicts-left-branch cached-branch))
(defun xmtn-conflicts-do-merge ()
"Perform merge on revisions in current conflict buffer."
(interactive)
(save-some-buffers t); log buffer
;; save-some-buffers does not save the conflicts buffer, which is the current buffer
(save-buffer)
(xmtn-dvc-merge-1 default-directory nil))
(defun xmtn-conflicts-ediff-resolution-ws ()
"Ediff current resolution file against workspace."
(interactive)
@ -1177,22 +1165,18 @@ non-nil, show log-edit buffer in other frame."
(define-key map [?q] 'dvc-buffer-quit)
(define-key map [?r] xmtn-conflicts-resolve-map)
(define-key map [?t] 'xmtn-conflicts-add-log-entry)
(define-key map [?u] 'xmtn-conflicts-update-counts)
(define-key map "\M-d" xmtn-conflicts-resolve-map)
(define-key map "MM" 'xmtn-conflicts-do-merge)
(define-key map "MP" 'xmtn-conflicts-do-propagate)
(define-key map "MU" 'dvc-update)
map)
"Keymap used in `xmtn-conflicts-mode'.")
(easy-menu-define xmtn-conflicts-mode-menu xmtn-conflicts-mode-map
"`xmtn-conflicts' menu"
`("Mtn-conflicts"
["Clear resolution" xmtn-conflicts-clear-resolution t]
["Clear resolution" xmtn-conflicts-clear-resolution t]
["Ediff resolution to ws" xmtn-conflicts-ediff-resolution-ws t]
["Propagate" xmtn-conflicts-do-propagate t]
["Merge" xmtn-conflicts-do-merge t]
["Update" dvc-update t]
["Clean" xmtn-conflicts-clean t]
["Add log entry" xmtn-conflicts-add-log-entry t]
["Clean" xmtn-conflicts-clean t]
))
;; derive from nil causes no keymap to be used, but still have self-insert keys
@ -1217,20 +1201,23 @@ non-nil, show log-edit buffer in other frame."
(defconst xmtn-conflicts-opts-file "_MTN/dvc-conflicts-opts")
(defun xmtn-conflicts-save-opts (left-work right-work &optional left-branch right-branch)
"Store LEFT-WORK, RIGHT-WORK in `xmtn-conflicts-opts-file', for
(defun xmtn-conflicts-save-opts (left-work right-work left-branch right-branch left-rev right-rev)
"Store LEFT-*, RIGHT-* in `xmtn-conflicts-opts-file', for
retrieval by `xmtn-conflicts-load-opts'."
;; need correct buffer-local variable names for load-opts
(let ((xmtn-conflicts-left-work left-work)
(xmtn-conflicts-right-work right-work)
(xmtn-conflicts-left-branch (or left-branch
(xmtn--tree-default-branch left-work)))
(xmtn-conflicts-right-branch (or right-branch
(xmtn--tree-default-branch right-work))))
(xmtn-conflicts-left-branch left-branch)
(xmtn-conflicts-right-branch right-branch)
(xmtn-conflicts-left-author (xmtn--rev-author left-work left-rev))
(xmtn-conflicts-right-author (xmtn--rev-author right-work right-rev)))
(dvc-save-state (list 'xmtn-conflicts-left-work
'xmtn-conflicts-left-branch
'xmtn-conflicts-left-author
'xmtn-conflicts-right-work
'xmtn-conflicts-right-branch)
'xmtn-conflicts-right-branch
'xmtn-conflicts-right-author)
(concat (file-name-as-directory right-work) xmtn-conflicts-opts-file))
))
@ -1244,132 +1231,88 @@ root where options file is stored."
;; When reviewing conflicts after a merge is complete, the options file is not present
(message "%s options file not found" opts-file))))
(defun xmtn-conflicts-1 (left-work left-rev right-work right-rev)
(defun xmtn-conflicts-load-file ()
"Load _MTN/conflicts for default-directory."
(dvc-switch-to-buffer-maybe (dvc-get-buffer-create 'xmtn 'conflicts default-directory))
(setq buffer-read-only nil)
(set (make-local-variable 'after-insert-file-functions) '(xmtn-conflicts-after-insert-file))
(insert-file-contents "_MTN/conflicts" t nil nil t))
(defun xmtn-conflicts-1 (left-work left-rev right-work right-rev &optional left-branch right-branch)
"List conflicts between LEFT-REV and RIGHT-REV
revisions (monotone revision specs; if nil, defaults to heads of
respective workspace branches) in LEFT-WORK and RIGHT-WORK
workspaces (strings). Allow specifying resolutions, propagating
to right. Stores conflict file in RIGHT-WORK/_MTN."
(let ((default-directory right-work))
(xmtn-conflicts-save-opts left-work right-work)
(dvc-run-dvc-async
'xmtn
(list "conflicts" "store" left-rev right-rev)
:finished (lambda (output error status arguments)
(xmtn-conflicts-review default-directory))
(xmtn-conflicts-save-opts left-work right-work left-branch right-branch left-rev right-rev)
(xmtn-automate-command-output-file
default-directory
"_MTN/conflicts"
(list "show_conflicts" left-rev right-rev))
(xmtn-conflicts-load-file)))
:error (lambda (output error status arguments)
(pop-to-buffer error))
)))
(defun xmtn-conflicts-review (left-work left-rev right-work right-rev left-branch right-branch show)
"Review conflicts between LEFT-WORK (a directory), rev LEFT-REV,
and RIGHT-WORK, rev RIGHT-REV. If LEFT_WORK/_MTN/conflicts
exists and is current, display it. Otherwise generate a new
RIGHT_WORK/_MTN/conflicts file and display that. Return the
conflicts buffer."
(let ((default-directory right-work)
(dvc-switch-to-buffer-first show))
(if (file-exists-p "_MTN/conflicts")
(progn
(xmtn-conflicts-load-file)
(if (not (and (string-equal xmtn-conflicts-left-revision left-rev)
(string-equal xmtn-conflicts-left-work left-work)
(string-equal xmtn-conflicts-right-revision right-rev)
(string-equal xmtn-conflicts-right-work right-work)))
;; file not current; regenerate
(xmtn-conflicts-1 left-work left-rev right-work right-rev left-branch right-branch)))
(defun xmtn-check-workspace-for-propagate (work cached-branch)
"Check that workspace WORK is ready for propagate.
It must be merged, and should be at the head revision, and have no local changes."
(let* ((default-directory work)
(heads (xmtn--heads default-directory cached-branch))
(base (xmtn--get-base-revision-hash-id-or-null default-directory)))
;; else generate new file
(xmtn-conflicts-1 left-work left-rev right-work right-rev left-branch right-branch)))
(current-buffer))
(message "checking %s for multiple heads, base not head" work)
(defun xmtn-conflicts-status (buffer left-work left-rev right-work right-rev left-branch right-branch)
"Return '(status buffer), where status is one of 'need-resolve
| 'need-review-resolve-internal | 'resolved | 'none for
BUFFER. Regenerate conflicts if not current. Conflicts stored in
RIGHT-WORK."
(if (buffer-live-p buffer)
;; check if buffer still current
(with-current-buffer buffer
(let ((revs-current
(and (string= left-rev xmtn-conflicts-left-revision)
(string= right-rev xmtn-conflicts-right-revision))))
(if revs-current
(progn
(xmtn-conflicts-update-counts)
(save-buffer))
;; else reload or regenerate
(save-excursion
(setq buffer
(xmtn-conflicts-review
left-work left-rev right-work right-rev left-branch right-branch nil))))))
(if (> 1 (length heads))
(error "%s has multiple heads; can't propagate" work))
;; else reload or regenerate
(save-excursion
(setq buffer
(xmtn-conflicts-review
left-work left-rev right-work right-rev left-branch right-branch nil))))
(if (not (string= base (nth 0 heads)))
(error "Aborting due to %s not at head" work))
;; check for local changes
(message "checking %s for local changes" work)
(dvc-run-dvc-sync
'xmtn
(list "status")
:finished (lambda (output error status arguments)
;; we don't get an error status for not up-to-date,
;; so parse the output.
;; FIXME: add option to automate inventory to just return status; can return on first change
;; FIXME: 'patch' may be internationalized.
(set-buffer output)
(goto-char (point-min))
(if (search-forward "patch" (point-max) t)
(if (not (yes-or-no-p (format "%s has local changes; really show conflicts? " work)))
(error "aborting due to local changes"))))
:error (lambda (output error status arguments)
(pop-to-buffer error))))
)
(defun xmtn-check-propagate-needed (left-work right-work)
"Throw error unless branch in workspace LEFT-WORK needs to be propagated to RIGHT-WORK."
;; We assume xmtn-check-workspace-for-propagate has already been run
;; on left-work, right-work, so just check if they have the same
;; base revision, or the target (right) base revision is a
;; descendant of the source.
(message "checking if propagate needed")
(let ((left-base (xmtn--get-base-revision-hash-id-or-null left-work))
(right-base (xmtn--get-base-revision-hash-id-or-null right-work)))
(if (string= left-base right-base)
(error "don't need to propagate")
;; check for right descendant of left
(let ((descendents (xmtn-automate-simple-command-output-lines left-work (list "descendents" left-base))))
(while descendents
(if (string= right-base (car descendents))
(error "don't need to propagate"))
(setq descendents (cdr descendents)))))
))
;;;###autoload
(defun xmtn-conflicts-propagate (left-work right-work)
"List conflicts for a propagate from LEFT-WORK to RIGHT-WORK workspace branch head revisions.
Allow specifying resolutions. LEFT-WORK and RIGHT-WORK are strings giving
workspace directories; prompted if nil. Review is done in RIGHT-WORK
workspace."
(interactive "i\ni")
(setq left-work (dvc-read-project-tree-maybe "Propagate from (workspace directory): " left-work))
(setq right-work (dvc-read-project-tree-maybe "to (workspace directory): " right-work))
(let ((left-branch (xmtn--tree-default-branch left-work))
(right-branch (xmtn--tree-default-branch right-work)))
(xmtn-check-workspace-for-propagate left-work left-branch)
(xmtn-check-workspace-for-propagate right-work right-branch)
(xmtn-check-propagate-needed left-work right-work)
(message "computing conflicts")
(xmtn-conflicts-1 left-work
(car (xmtn--heads left-work left-branch))
right-work
(car (xmtn--heads right-work right-branch)))))
;;;###autoload
(defun xmtn-conflicts-merge ()
"List conflicts between current head revisions."
(interactive)
(let ((default-directory
(dvc-read-project-tree-maybe "Review conflicts in (workspace directory): ")))
(xmtn-conflicts-1 default-directory nil default-directory nil)))
;;;###autoload
(defun xmtn-conflicts-review (&optional workspace)
"Review conflicts for WORKSPACE (a directory; default prompt)."
(interactive)
(let ((default-directory
(dvc-read-project-tree-maybe "Review conflicts for (workspace directory): "
(when workspace (expand-file-name workspace))))
(file-name "_MTN/conflicts"))
(if (not (file-exists-p file-name))
(error "conflicts file not found"))
(let ((conflicts-buffer (dvc-get-buffer-create 'xmtn 'conflicts default-directory)))
(dvc-switch-to-buffer-maybe conflicts-buffer)
(setq buffer-read-only nil)
(xmtn-conflicts-load-opts)
(set (make-local-variable 'after-insert-file-functions) '(xmtn-conflicts-after-insert-file))
(insert-file-contents "_MTN/conflicts" t nil nil t))))
;; compute status
(with-current-buffer buffer
(case xmtn-conflicts-total-count
(0 (list buffer 'none))
(t
(cond
((= xmtn-conflicts-total-count xmtn-conflicts-resolved-count)
(if (> xmtn-conflicts-resolved-internal-count 0)
(list buffer 'need-review-resolve-internal)
(list buffer 'resolved)))
(t
(list buffer 'need-resolve)))))))
;;;###autoload
(defun xmtn-conflicts-clean (&optional workspace)

171
dvc/lisp/xmtn-dvc.el
View File

@ -1,6 +1,6 @@
;;; xmtn-dvc.el --- DVC backend for monotone
;; Copyright (C) 2008 - 2010 Stephen Leake
;; Copyright (C) 2008 - 2011 Stephen Leake
;; Copyright (C) 2006, 2007, 2008 Christian M. Ohler
;; Author: Christian M. Ohler
@ -95,35 +95,17 @@
"_MTN/log"))
(defun xmtn--toposort (root revision-hash-ids)
(xmtn-automate-simple-command-output-lines root
(xmtn-automate-command-output-lines root
`("toposort"
,@revision-hash-ids)))
(add-to-list 'format-alist
'(xmtn--log-file
"This format automatically removes xmtn's log edit hints from
the file before saving."
nil
xmtn--log-file-format-from-fn
xmtn--log-file-format-to-fn
t
nil
nil))
(defun xmtn--log-file-format-from-fn (begin end)
(xmtn--assert-nil))
(defun xmtn--log-file-format-to-fn (begin end buffer)
(dvc-log-flush-commit-file-list))
;;;###autoload
(defun xmtn-dvc-log-edit (root other-frame no-init)
(if no-init
(dvc-dvc-log-edit root other-frame no-init)
(progn
(dvc-dvc-log-edit root other-frame nil)
(setq buffer-file-coding-system 'xmtn--monotone-normal-form) ;; FIXME: move this into dvc-get-buffer-create?
(add-to-list 'buffer-file-format 'xmtn--log-file) ;; FIXME: generalize to dvc--log-file
(setq buffer-file-coding-system 'xmtn--monotone-normal-form)
)))
(defun xmtn-dvc-log-message ()
@ -158,7 +140,6 @@ the file before saving."
(if session (xmtn-automate--close-session session)))
(read-from-minibuffer "branch: " (xmtn--tree-default-branch root)))
(xmtn--tree-default-branch root))))
;; Saving the buffer will automatically delete any log edit hints.
(save-buffer)
(dvc-save-some-buffers root)
@ -230,6 +211,48 @@ the file before saving."
(message "%s... " progress-message))
(set-window-configuration dvc-pre-commit-window-configuration)))
(defun xmtn-show-commit ()
"Show commit command for use on command line"
(interactive)
(let ((excluded-files
(with-current-buffer dvc-partner-buffer
(xmtn--normalize-file-names default-directory (dvc-fileinfo-excluded-files)))))
(save-buffer)
(dvc-save-some-buffers default-directory)
;; check that the first line says something; it should be a summary of the rest
(goto-char (point-min))
(forward-line)
(if (= (point) (1+ (point-min)))
(error "Please put a summary comment on the first line"))
(message
(concat
"mtn commit "
(xmtn-dvc-log-message)
" "
(if excluded-files
(mapconcat (lambda (file) (concat "--exclude=" file)) excluded-files " "))))
(pop-to-buffer "*Messages*")))
;; Add xmtn-show-commit to dvc-log-edit menu
(defvar xmtn-log-edit-mode-map
(let ((map (make-sparse-keymap)))
(define-key map [(control ?c) (control ?s)] 'xmtn-show-commit)
map))
(easy-menu-define xmtn-log-edit-mode-menu xmtn-log-edit-mode-map
"Mtn specific log-edit menu."
`("DVC-Mtn"
["Show commit command" xmtn-show-commit t]
))
(define-derived-mode xmtn-log-edit-mode dvc-log-edit-mode "xmtn-log-edit"
"Add back-end-specific commands for dvc-log-edit.")
(dvc-add-uniquify-directory-mode 'xmtn-log-edit-mode)
;; The term "normalization" here has nothing to do with Unicode
;; normalization.
(defun xmtn--normalize-file-name (root file-name)
@ -356,20 +379,6 @@ the file before saving."
(message "Tree %s has no base revision" root))))
;;;###autoload
(defun xmtn-dvc-search-file-in-diff (file)
(re-search-forward
(let ((quoted-file (regexp-quote file)))
(concat "^\\(\\("
"\\+\\+\\+ " quoted-file
"\\)\\|\\("
;; FIXME: What `dvc-diff-diff-or-list' does doesn't work
;; for this case, since `diff-hunk-next' doesn't recognize
;; mtn's output for this case as a diff hunk.
"# " quoted-file " is binary"
"\\)\\)$"))))
;;;###autoload
(defun xmtn-dvc-diff (&optional rev path dont-switch)
;; If rev is an ancestor of base-rev of path, then rev is from, path
@ -383,7 +392,7 @@ the file before saving."
(if (string= rev-string base)
;; local changes in workspace are 'to'
(xmtn-dvc-delta rev workspace dont-switch)
(let ((descendents (xmtn-automate-simple-command-output-lines path (list "descendents" base)))
(let ((descendents (xmtn-automate-command-output-lines path (list "descendents" base)))
(done nil))
(while descendents
(if (string= rev-string (car descendents))
@ -396,45 +405,14 @@ the file before saving."
;; rev is ancestor of workspace; workspace is 'to'
(xmtn-dvc-delta rev workspace dont-switch))))))
(defvar xmtn-diff-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "CM" 'xmtn-conflicts-merge)
(define-key map "CP" 'xmtn-conflicts-propagate)
(define-key map "CR" 'xmtn-conflicts-review)
(define-key map "CC" 'xmtn-conflicts-clean)
(define-key map "MH" 'xmtn-view-heads-revlist)
(define-key map "MP" 'xmtn-propagate-from)
map))
;; items added here should probably also be added to xmtn-revlist-mode-menu, -map in xmtn-revlist.el
(easy-menu-define xmtn-diff-mode-menu xmtn-diff-mode-map
"Mtn specific diff menu."
`("DVC-Mtn"
["View Heads" xmtn-view-heads-revlist t]
["Show propagate conflicts" xmtn-conflicts-propagate t]
["Review conflicts" xmtn-conflicts-review t]
["Propagate branch" xmtn-propagate-from t]
["Clean conflicts resolutions" xmtn-conflicts-clean t]
))
(define-derived-mode xmtn-diff-mode dvc-diff-mode "xmtn-diff"
"Add back-end-specific commands for dvc-diff.")
(dvc-add-uniquify-directory-mode 'xmtn-diff-mode)
(defun xmtn--rev-to-option (resolved from)
"Return a string contaiing the mtn diff command-line option for RESOLVED-REV.
If FROM is non-nil, RESOLVED-REV is assumed older than workspace;
"Return a string contaiing the mtn diff command-line option for RESOLVED.
If FROM is non-nil, RESOLVED is assumed older than workspace;
otherwise newer."
(ecase (car resolved)
('local-tree
(if from
(progn
;; FIXME: --reverse is not in mtn 0.44; bump overall
;; required version on new mtn release
(let ((xmtn--minimum-required-command-version '(0 45)))
(xmtn--check-cached-command-version)
"--reverse"))
"--reverse"
""))
('revision (concat "--revision=" (cadr resolved)))))
@ -466,32 +444,6 @@ otherwise newer."
;; The call site in `dvc-revlist-diff' needs this return value.
diff-buffer)))
(defvar xmtn-status-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "CM" 'xmtn-conflicts-merge)
(define-key map "CP" 'xmtn-conflicts-propagate)
(define-key map "CR" 'xmtn-conflicts-review)
(define-key map "CC" 'xmtn-conflicts-clean)
(define-key map "MP" 'xmtn-propagate-from)
(define-key map "MH" 'xmtn-view-heads-revlist)
map))
(easy-menu-define xmtn-status-mode-menu xmtn-status-mode-map
"Mtn specific status menu."
`("DVC-Mtn"
["View Heads" xmtn-view-heads-revlist t]
["Show merge conflicts" xmtn-conflicts-merge t]
["Show propagate conflicts" xmtn-conflicts-propagate t]
["Review conflicts" xmtn-conflicts-review t]
["Propagate branch" xmtn-propagate-from t]
["Clean conflicts resolutions" xmtn-conflicts-clean t]
))
(define-derived-mode xmtn-status-mode dvc-status-mode "xmtn-status"
"Add back-end-specific commands for dvc-status.")
(add-to-list 'uniquify-list-buffers-directory-modes 'xmtn-status-mode)
(defun xmtn--remove-content-hashes-from-diff ()
;; Hack: Remove mtn's file content hashes from diff headings since
;; `dvc-diff-diff-or-list' and `dvc-diff-find-file-name' gets
@ -514,16 +466,6 @@ otherwise newer."
(defun xmtn-dvc-command-version ()
(fourth (xmtn--command-version xmtn-executable)))
(defvar xmtn-dvc-automate-version nil
"Cached value of mtn automate interface version.")
(defun xmtn-dvc-automate-version ()
"Return mtn automate version as a number."
(if xmtn-dvc-automate-version
xmtn-dvc-automate-version
(setq xmtn-dvc-automate-version
(string-to-number (xmtn--command-output-line nil '("automate" "interface_version"))))))
(defun xmtn--changes-image (change)
(ecase change
(content "content")
@ -702,7 +644,6 @@ otherwise newer."
(dvc-status-prepare-buffer
'xmtn
root
;; FIXME: just pass header
;; base-revision
(if base-revision (format "%s" base-revision) "none")
;; branch
@ -746,8 +687,7 @@ otherwise newer."
:text (concat " no changes in workspace")))
(ewoc-refresh dvc-fileinfo-ewoc)))))
:error (lambda (output error status arguments)
;; FIXME: need `dvc-status-error-in-process', or change name.
(dvc-diff-error-in-process
(dvc-diff-error-in-process ;; correct for status-mode as well
status-buffer
(format "Error running mtn with arguments %S" arguments)
output error))
@ -929,7 +869,6 @@ otherwise newer."
(1 (format "%s" (first normalized-file-names)))
(t (format "%s files/directories"
(length normalized-file-names))))))
;; FIXME: confirm should be in upper level DVC code.
(when (or (not dvc-confirm-ignore)
(y-or-n-p (format "Ignore %s in monotone tree %s? " msg root)))
(xmtn--add-patterns-to-mtnignore
@ -970,7 +909,7 @@ otherwise newer."
(xmtn--add-files (dvc-tree-root) files))
;; Appears redundant, given that there is `xmtn-dvc-add-files'. But
;; it's part of the DVC API. FIXME.
;; it's part of the DVC API.
;;;###autoload
(defun xmtn-dvc-add (file)
(xmtn--add-files (dvc-tree-root) (list file)))
@ -1156,7 +1095,9 @@ finished."
nil)
(defun xmtn-propagate-from (other &optional cached-branch)
"Propagate from OTHER branch to local tree branch."
"Propagate from OTHER branch to CACHED-BRANCH (default local tree branch).
Conflict resolution taken from `default-directory', which must be
a workspace for CACHED-BRANCH."
(interactive "MPropagate from branch: ")
(let*
((root (dvc-tree-root))
@ -1232,7 +1173,7 @@ finished."
;; mtn progress messages are put to stderr, and there is typically
;; nothing written to stdout from this command, so put both in the
;; same buffer.
;; FIXME: this output is not useful; need to use automation
;; This output is not useful; xmtn-sync, xmtn-sync-review is much better
(xmtn--run-command-async root `("pull" ,other)
:output-buffer name
:error-buffer name
@ -1475,7 +1416,7 @@ finished."
(defun xmtn--file-contents-as-string (root content-hash-id)
(check-type content-hash-id xmtn--hash-id)
(xmtn-automate-simple-command-output-string
(xmtn-automate-command-output-string
root `("get_file" ,content-hash-id)))
<<<<<<< TREE

8
dvc/lisp/xmtn-ids.el
View File

@ -1,6 +1,6 @@
;;; xmtn-ids.el --- Resolver routines for xmtn revision ids
;; Copyright (C) 2008 - 2010 Stephen Leake
;; Copyright (C) 2008 - 2011 Stephen Leake
;; Copyright (C) 2006, 2007 Christian M. Ohler
;; Author: Christian M. Ohler
@ -145,7 +145,7 @@ See file commentary for details."
(defun xmtn--get-parent-revision-hash-id (root hash-id local-branch)
(check-type hash-id xmtn--hash-id)
(let ((parents (xmtn-automate-simple-command-output-lines root `("parents"
(let ((parents (xmtn-automate-command-output-lines root `("parents"
,hash-id))))
(case (length parents)
(0 (error "Revision has no parents: %s" hash-id))
@ -192,7 +192,7 @@ See file commentary for details."
nil)
(defun xmtn--expand-selector (root selector)
(xmtn-automate-simple-command-output-lines root `("select" ,selector)))
(xmtn-automate-command-output-lines root `("select" ,selector)))
(defun xmtn--branch-of (root hash-id)
(let ((certs (xmtn--list-parsed-certs root hash-id))
@ -227,7 +227,7 @@ must be a workspace."
result))
(defun xmtn--get-base-revision-hash-id-or-null (root)
(let ((hash-id (xmtn-automate-simple-command-output-line
(let ((hash-id (xmtn-automate-command-output-line
root `("get_base_revision_id"))))
(when (equal hash-id "") (setq hash-id nil))
(assert (typep hash-id '(or xmtn--hash-id null)))

160
dvc/lisp/xmtn-multi-status.el
View File

@ -1,6 +1,6 @@
;;; xmtn-status.el --- manage actions for multiple projects
;; Copyright (C) 2009 - 2010 Stephen Leake
;; Copyright (C) 2009 - 2011 Stephen Leake
;; Author: Stephen Leake
;; Keywords: tools
@ -44,9 +44,9 @@ The elements must all be of class xmtn-status-data.")
(defstruct (xmtn-status-data (:copier nil))
work ; workspace directory name relative to xmtn-status-root
branch ; branch name (all workspaces have same branch; assumed never changes)
branch ; GDS branch name (all workspaces have same branch; assumed never changes)
need-refresh ; nil | t : if an async process was started that invalidates state data
head-rev ; nil | mtn rev string : current head revision, nil if multiple heads
head-revs ; either current head revision or (left, right) if multiple heads
conflicts-buffer ; *xmtn-conflicts* buffer for merge
status-buffer ; *xmtn-status* buffer for commit
heads ; 'need-scan | 'at-head | 'need-update | 'need-merge
@ -80,7 +80,7 @@ The elements must all be of class xmtn-status-data.")
(insert (dvc-face-add " need refresh\n" 'dvc-conflict))
(ecase (xmtn-status-data-local-changes data)
(need-scan (insert " local changes unknown\n"))
(need-scan (insert " local changes not checked\n"))
(need-commit (insert (dvc-face-add " need commit\n" 'dvc-header)))
(ok nil))
@ -122,12 +122,14 @@ The elements must all be of class xmtn-status-data.")
(if (buffer-live-p (xmtn-status-data-conflicts-buffer data))
(with-current-buffer (xmtn-status-data-conflicts-buffer data) (save-buffer))))
(defun xmtn-status-clean-1 (data)
"Clean DATA workspace."
(defun xmtn-status-clean-1 (data save-conflicts)
"Clean DATA workspace, kill associated automate session.
If SAVE-CONFLICTS non-nil, don't delete conflicts files."
(xmtn-automate-kill-session (xmtn-status-work data))
(xmtn-status-kill-conflicts-buffer data)
(xmtn-status-kill-status-buffer data)
(xmtn-conflicts-clean (xmtn-status-work data)))
(unless save-conflicts
(xmtn-conflicts-clean (xmtn-status-work data))))
(defun xmtn-status-clean ()
"Clean current workspace, delete from ewoc"
@ -135,14 +137,13 @@ The elements must all be of class xmtn-status-data.")
(let* ((elem (ewoc-locate xmtn-status-ewoc))
(data (ewoc-data elem))
(inhibit-read-only t))
(xmtn-status-clean-1 data)
(xmtn-status-clean-1 data nil)
(ewoc-delete xmtn-status-ewoc elem)))
(defun xmtn-status-quit ()
"Clean all remaining workspaces, kill automate sessions, kill buffer."
(defun xmtn-status-clean-all (&optional save-conflicts)
"Clean all remaining workspaces."
(interactive)
(ewoc-map 'xmtn-status-clean-1 xmtn-status-ewoc)
(kill-buffer))
(ewoc-map 'xmtn-status-clean-1 xmtn-status-ewoc save-conflicts))
(defun xmtn-status-cleanp ()
"Non-nil if clean & quit is appropriate for current workspace."
@ -186,13 +187,21 @@ The elements must all be of class xmtn-status-data.")
(and (not (xmtn-status-data-need-refresh data))
(eq 'need-update (xmtn-status-data-heads data)))))
(defun xmtn-status-update-preview ()
"Preview update for current workspace."
(interactive)
(let* ((elem (ewoc-locate xmtn-status-ewoc))
(data (ewoc-data elem))
(default-directory (xmtn-status-work data)))
(xmtn-dvc-missing)))
(defun xmtn-status-resolve-conflicts ()
"Resolve conflicts for current workspace."
(interactive)
(let* ((elem (ewoc-locate xmtn-status-ewoc))
(data (ewoc-data elem)))
(xmtn-status-need-refresh elem data nil)
(setf (xmtn-status-data-conflicts data) 'resolved)
(setf (xmtn-status-data-conflicts data) 'need-scan)
(pop-to-buffer (xmtn-status-data-conflicts-buffer data))))
(defun xmtn-status-resolve-conflictsp ()
@ -229,18 +238,18 @@ The elements must all be of class xmtn-status-data.")
(member (xmtn-status-data-local-changes data)
'(need-scan need-commit)))))
(defun xmtn-status-review-update ()
(defun xmtn-status-update-review ()
"Review last update for current workspace."
(interactive)
(let* ((elem (ewoc-locate xmtn-status-ewoc))
(data (ewoc-data elem)))
;; assume they are adding FIXMEs
;; assume they are adding fixmes
(xmtn-status-need-refresh elem data 'need-scan)
(setf (xmtn-status-data-update-review data) 'done)
(xmtn-review-update (xmtn-status-work data))))
(xmtn-update-review (xmtn-status-work data))))
(defun xmtn-status-review-updatep ()
"Non-nil if xmtn-status-review-update is appropriate for current workspace."
(defun xmtn-status-update-reviewp ()
"Non-nil if xmtn-status-update-review is appropriate for current workspace."
(let* ((data (ewoc-data (ewoc-locate xmtn-status-ewoc))))
(and (not (xmtn-status-data-need-refresh data))
(eq 'need-review (xmtn-status-data-update-review data)))))
@ -252,7 +261,16 @@ The elements must all be of class xmtn-status-data.")
(data (ewoc-data elem))
(default-directory (xmtn-status-work data)))
(xmtn-status-save-conflicts-buffer data)
(xmtn-dvc-merge-1 default-directory nil)
(xmtn--run-command-sync
default-directory
(list
"explicit_merge"
(nth 0 (xmtn-status-data-head-revs data))
(nth 1 (xmtn-status-data-head-revs data))
(xmtn--tree-default-branch default-directory)
(if (file-exists-p "_MTN/conflicts")
"--resolve-conflicts-file=_MTN/conflicts")
(xmtn-dvc-log-message)))
(xmtn-status-refresh-one data nil)
(ewoc-invalidate xmtn-status-ewoc elem)))
@ -271,6 +289,13 @@ The elements must all be of class xmtn-status-data.")
(and (not (xmtn-status-data-need-refresh data))
(eq 'need-merge (xmtn-status-data-heads data)))))
(defun xmtn-status-quit-save ()
"Quit, but save conflicts files for later resume."
(interactive)
(remove-hook 'kill-buffer-hook 'xmtn-status-clean-all t)
(xmtn-status-clean-all t)
(kill-buffer))
(defvar xmtn-status-actions-map
(let ((map (make-sparse-keymap "actions")))
(define-key map [?c] '(menu-item "c) clean/delete"
@ -282,9 +307,12 @@ The elements must all be of class xmtn-status-data.")
(define-key map [?i] '(menu-item "i) ignore local changes"
xmtn-status-status-ok
:visible (xmtn-status-statusp)))
(define-key map [?5] '(menu-item "5) review update"
xmtn-status-review-update
:visible (xmtn-status-review-updatep)))
(define-key map [?6] '(menu-item "6) preview update"
xmtn-status-update-preview
:visible (xmtn-status-updatep)))
(define-key map [?5] '(menu-item "5) update review"
xmtn-status-update-review
:visible (xmtn-status-update-reviewp)))
(define-key map [?4] '(menu-item "4) update"
xmtn-status-update
:visible (xmtn-status-updatep)))
@ -310,12 +338,25 @@ The elements must all be of class xmtn-status-data.")
(let ((map (make-sparse-keymap)))
(define-key map "\M-d" xmtn-status-actions-map)
(define-key map [?g] 'xmtn-status-refresh)
(define-key map [?m] 'xmtn-status-update-preview)
(define-key map [?n] 'xmtn-status-next)
(define-key map [?p] 'xmtn-status-prev)
(define-key map [?q] 'xmtn-status-quit)
(define-key map [?r] 'xmtn-status-update-review)
(define-key map [?s] 'xmtn-status-quit-save)
(define-key map [?q] 'dvc-buffer-quit)
map)
"Keymap used in `xmtn-multiple-status-mode'.")
(easy-menu-define xmtn-multiple-status-mode-menu xmtn-multiple-status-mode-map
"Mtn specific status menu."
`("DVC-Mtn"
["Do the right thing" xmtn-status-actions-map t]
["Quit, clean conflicts" dvc-buffer-quit t]
["Quit, save conflicts" xmtn-status-quit-save t]
["Preview update" xmtn-status-update-preview t]
["Review update" xmtn-status-update-review t]
))
(define-derived-mode xmtn-multiple-status-mode nil "xmtn-multiple-status"
"Major mode to show status of multiple workspaces."
(setq dvc-buffer-current-active-dvc 'xmtn)
@ -326,6 +367,7 @@ The elements must all be of class xmtn-status-data.")
(set (make-local-variable 'write-file-functions) nil)
(dvc-install-buffer-menu)
(add-hook 'kill-buffer-hook 'xmtn-status-clean-all nil t)
(setq buffer-read-only t)
(buffer-disable-undo)
@ -333,35 +375,18 @@ The elements must all be of class xmtn-status-data.")
(defun xmtn-status-conflicts (data)
"Return value for xmtn-status-data-conflicts for DATA."
(let* ((work (xmtn-status-work data))
(default-directory work))
(if (buffer-live-p (xmtn-status-data-conflicts-buffer data))
(kill-buffer (xmtn-status-data-conflicts-buffer data)))
;; create conflicts file
(xmtn-conflicts-clean work)
(xmtn-conflicts-save-opts work work (xmtn-status-data-branch data) (xmtn-status-data-branch data))
(dvc-run-dvc-sync
'xmtn
(list "conflicts" "store")
:error (lambda (output error status arguments)
(pop-to-buffer error)))
;; create conflicts buffer
(setf (xmtn-status-data-conflicts-buffer data)
(save-excursion
(let ((dvc-switch-to-buffer-first nil))
(xmtn-conflicts-review work)
(current-buffer))))
(with-current-buffer (xmtn-status-data-conflicts-buffer data)
(case xmtn-conflicts-total-count
(0 'none)
(t
(if (= xmtn-conflicts-total-count xmtn-conflicts-resolved-internal-count)
'need-review-resolve-internal
'need-resolve))))))
;; only called if need merge; two items in head-revs
(let ((result (xmtn-conflicts-status
(xmtn-status-data-conflicts-buffer data) ; buffer
(xmtn-status-work data) ; left-work
(car (xmtn-status-data-head-revs data)) ; left-rev
(xmtn-status-work data) ; right-work
(cadr (xmtn-status-data-head-revs data)) ; right-rev
(xmtn-status-data-branch data) ; left-branch
(xmtn-status-data-branch data) ; right-branch
)))
(setf (xmtn-status-data-conflicts-buffer data) (car result))
(cadr result)))
(defun xmtn-status-refresh-one (data refresh-local-changes)
"Refresh DATA."
@ -373,29 +398,21 @@ The elements must all be of class xmtn-status-data.")
(base-rev (xmtn--get-base-revision-hash-id-or-null work)))
(case (length heads)
(1
(setf (xmtn-status-data-head-rev data) (nth 0 heads))
(setf (xmtn-status-data-head-revs data) (nth 0 heads))
(setf (xmtn-status-data-conflicts data) 'none)
(if (string= (xmtn-status-data-head-rev data) base-rev)
(if (string= (xmtn-status-data-head-revs data) base-rev)
(setf (xmtn-status-data-heads data) 'at-head)
(setf (xmtn-status-data-heads data) 'need-update)))
(t
(setf (xmtn-status-data-head-rev data) nil)
(setf (xmtn-status-data-heads data) 'need-merge)
(case (xmtn-status-data-conflicts data)
(resolved
;; Assume the resolution was just completed, so don't erase it!
nil)
(t
(setf (xmtn-status-data-conflicts data) 'need-scan))))))
(setf (xmtn-status-data-head-revs data) (list (nth 0 heads) (nth 1 heads)))
(setf (xmtn-status-data-heads data) 'need-merge))))
(message "")
(if refresh-local-changes
(progn
(setf (xmtn-status-data-local-changes data) 'need-scan)
(case (xmtn-status-data-update-review data)
('done (setf (xmtn-status-data-update-review data) 'need-review))
(t nil))))
(setf (xmtn-status-data-update-review data) 'need-review)))
(case (xmtn-status-data-local-changes data)
(need-scan
@ -411,11 +428,14 @@ The elements must all be of class xmtn-status-data.")
(xmtn-status-data-local-changes data) (cadr result))) ))
(t nil))
(case (xmtn-status-data-conflicts data)
(need-scan
(case (xmtn-status-data-heads data)
(need-merge
(setf (xmtn-status-data-conflicts data)
(xmtn-status-conflicts data)))
(t nil))
(t
(xmtn-status-kill-conflicts-buffer data)
(xmtn-conflicts-clean (xmtn-status-work data))
(setf (xmtn-status-data-conflicts data) 'none)))
(setf (xmtn-status-data-need-refresh data) nil))
@ -487,7 +507,7 @@ The elements must all be of class xmtn-status-data.")
(xmtn-status-next))
;;;###autoload
(defun xmtn-status-one-1 (root name head-rev status-buffer heads local-changes)
(defun xmtn-status-one-1 (root name head-revs status-buffer heads local-changes)
"Create an xmtn-multi-status buffer from xmtn-propagate."
(pop-to-buffer (get-buffer-create "*xmtn-multi-status*"))
(setq default-directory (concat root "/" name))
@ -500,7 +520,7 @@ The elements must all be of class xmtn-status-data.")
:work (file-name-nondirectory (directory-file-name default-directory))
:branch (xmtn--tree-default-branch default-directory)
:need-refresh nil
:head-rev head-rev
:head-revs head-revs
:conflicts-buffer nil
:status-buffer status-buffer
:heads heads

249
dvc/lisp/xmtn-propagate.el
View File

@ -1,6 +1,6 @@
;;; xmtn-propagate.el --- manage multiple propagations for DVC backend for monotone
;; Copyright (C) 2009 - 2010 Stephen Leake
;; Copyright (C) 2009 - 2011 Stephen Leake
;; Author: Stephen Leake
;; Keywords: tools
@ -56,8 +56,8 @@ The elements must all be of class xmtn-propagate-data.")
from-branch ; branch name (assumed never changes)
to-branch ;
need-refresh ; nil | t; if an async process was started that invalidates state data
from-head-rev ; nil | mtn rev string; current head revision; nil if multiple heads
to-head-rev ;
from-head-revs ; mtn rev string; current head revision or (left right) if multiple heads
to-head-revs ;
conflicts-buffer ; *xmtn-conflicts* buffer for this propagation
from-status-buffer ; *xmtn-status* buffer for commit in from
to-status-buffer ; *xmtn-status* buffer for commit in to
@ -69,7 +69,7 @@ The elements must all be of class xmtn-propagate-data.")
(to-local-changes
'need-scan) ;
(conflicts
'need-scan) ; 'need-scan | 'need-resolve | 'need-review-resolve-internal | 'ok
'need-scan) ; 'need-scan | 'need-resolve | 'need-review-resolve-internal | 'resolved | 'none
; for propagate
)
@ -105,14 +105,14 @@ The elements must all be of class xmtn-propagate-data.")
(insert (dvc-face-add " need refresh\n" 'dvc-conflict))
(ecase (xmtn-propagate-data-from-local-changes data)
(need-scan (insert " local changes unknown " (xmtn-propagate-data-from-name data) "\n"))
(need-scan (insert " local changes not checked " (xmtn-propagate-data-from-name data) "\n"))
(need-commit
(insert (dvc-face-add (concat " need commit " (xmtn-propagate-data-from-name data) "\n")
'dvc-header)))
(ok nil))
(ecase (xmtn-propagate-data-to-local-changes data)
(need-scan (insert " local changes unknown " (xmtn-propagate-data-to-name data) "\n"))
(need-scan (insert " local changes not checked " (xmtn-propagate-data-to-name data) "\n"))
(need-commit
(insert (dvc-face-add (concat " need commit " (xmtn-propagate-data-to-name data) "\n")
'dvc-header)))
@ -124,7 +124,7 @@ The elements must all be of class xmtn-propagate-data.")
(insert (dvc-face-add (concat " need update " (xmtn-propagate-data-from-name data) "\n")
'dvc-conflict)))
(need-merge
(insert (dvc-face-add (concat " need merge " (xmtn-propagate-data-from-name data) "\n")
(insert (dvc-face-add (concat " need status for merge " (xmtn-propagate-data-from-name data) "\n")
'dvc-conflict))))
(ecase (xmtn-propagate-data-to-heads data)
@ -133,7 +133,7 @@ The elements must all be of class xmtn-propagate-data.")
(insert (dvc-face-add (concat " need update " (xmtn-propagate-data-to-name data) "\n")
'dvc-conflict)))
(need-merge
(insert (dvc-face-add (concat " need merge " (xmtn-propagate-data-to-name data) "\n")
(insert (dvc-face-add (concat " need status for merge " (xmtn-propagate-data-to-name data) "\n")
'dvc-conflict))))
(if (xmtn-propagate-data-propagate-needed data)
@ -148,7 +148,7 @@ The elements must all be of class xmtn-propagate-data.")
(need-review-resolve-internal
(insert (dvc-face-add " need review resolve internal\n" 'dvc-header))
(insert (dvc-face-add " need propagate\n" 'dvc-conflict)))
(ok
((resolved none)
(insert (dvc-face-add " need propagate\n" 'dvc-conflict)))))
(if (eq 'at-head (xmtn-propagate-data-to-heads data))
@ -169,29 +169,15 @@ The elements must all be of class xmtn-propagate-data.")
(defun xmtn-propagate-create-to-status-buffer (data)
"Create to-status buffer for DATA"
(if (buffer-live-p (xmtn-propagate-data-to-status-buffer data))
(with-current-buffer (xmtn-propagate-data-to-status-buffer data)
(xmtn-dvc-status)
(setf (xmtn-propagate-data-to-local-changes data)
(if (not (ewoc-locate dvc-fileinfo-ewoc))
'ok
'need-commit)))
(let ((result (xmtn--status-inventory-sync (xmtn-propagate-to-work data))))
(setf (xmtn-propagate-data-to-status-buffer data) (car result)
(xmtn-propagate-data-to-local-changes data) (cadr result))) ))
(let ((result (xmtn--status-inventory-sync (xmtn-propagate-to-work data))))
(setf (xmtn-propagate-data-to-status-buffer data) (car result)
(xmtn-propagate-data-to-local-changes data) (cadr result))))
(defun xmtn-propagate-create-from-status-buffer (data)
"Create from-status buffer for DATA"
(if (buffer-live-p (xmtn-propagate-data-from-status-buffer data))
(with-current-buffer (xmtn-propagate-data-from-status-buffer data)
(xmtn-dvc-status)
(setf (xmtn-propagate-data-from-local-changes data)
(if (not (ewoc-locate dvc-fileinfo-ewoc))
'ok
'need-commit)))
(let ((result (xmtn--status-inventory-sync (xmtn-propagate-from-work data))))
(setf (xmtn-propagate-data-from-status-buffer data) (car result)
(xmtn-propagate-data-from-local-changes data) (cadr result))) ))
(let ((result (xmtn--status-inventory-sync (xmtn-propagate-from-work data))))
(setf (xmtn-propagate-data-from-status-buffer data) (car result)
(xmtn-propagate-data-from-local-changes data) (cadr result))))
(defun xmtn-propagate-kill-status-buffers (data)
(if (buffer-live-p (xmtn-propagate-data-from-status-buffer data))
@ -199,29 +185,30 @@ The elements must all be of class xmtn-propagate-data.")
(if (buffer-live-p (xmtn-propagate-data-to-status-buffer data))
(kill-buffer (xmtn-propagate-data-to-status-buffer data))))
(defun xmtn-propagate-clean-1 (data)
"Clean DATA workspace"
(defun xmtn-propagate-clean-1 (data save-conflicts)
"Clean DATA workspace, kill associated automate session.
If SAVE-CONFLICTS non-nil, don't delete conflicts files."
(xmtn-automate-kill-session (xmtn-propagate-from-work data))
(xmtn-automate-kill-session (xmtn-propagate-to-work data))
(xmtn-propagate-kill-conflicts-buffer data)
(xmtn-propagate-kill-status-buffers data)
(xmtn-conflicts-clean (xmtn-propagate-to-work data)))
(unless save-conflicts
(xmtn-conflicts-clean (xmtn-propagate-to-work data))))
(defun xmtn-propagate-clean ()
"Clean current workspace, delete from ewoc"
"Clean current workspace, delete from ewoc."
(interactive)
(let* ((elem (ewoc-locate xmtn-propagate-ewoc))
(data (ewoc-data elem)))
(xmtn-propagate-clean-1 data)
(xmtn-propagate-clean-1 data nil)
(let ((inhibit-read-only t))
(ewoc-delete xmtn-propagate-ewoc elem))))
(defun xmtn-propagate-quit ()
"Clean all remaining workspaces, kill automate sessions, kill buffer."
(defun xmtn-propagate-clean-all (&optional save-conflicts)
"Clean all remaining workspaces."
(interactive)
(ewoc-map 'xmtn-propagate-clean-1 xmtn-propagate-ewoc)
(kill-buffer))
(ewoc-map 'xmtn-propagate-clean-1 xmtn-propagate-ewoc save-conflicts))
(defun xmtn-propagate-cleanp ()
"Non-nil if clean is appropriate for current workspace."
@ -256,7 +243,12 @@ The elements must all be of class xmtn-propagate-data.")
(data (ewoc-data elem)))
(xmtn-propagate-need-refresh elem data)
<<<<<<< TREE
<<<<<<< TREE
=======
=======
;; assume the commit is successful
(setf (xmtn-propagate-data-to-local-changes data) 'ok)
>>>>>>> MERGE-SOURCE
(if (not (buffer-live-p (xmtn-propagate-data-to-status-buffer data)))
(xmtn-propagate-create-to-status-buffer data))
>>>>>>> MERGE-SOURCE
@ -275,7 +267,12 @@ The elements must all be of class xmtn-propagate-data.")
(data (ewoc-data elem)))
(xmtn-propagate-need-refresh elem data)
<<<<<<< TREE
<<<<<<< TREE
=======
=======
;; assume the commit is successful
(setf (xmtn-propagate-data-from-local-changes data) 'ok)
>>>>>>> MERGE-SOURCE
(if (not (buffer-live-p (xmtn-propagate-data-from-status-buffer data)))
(xmtn-propagate-create-from-status-buffer data))
>>>>>>> MERGE-SOURCE
@ -294,7 +291,7 @@ The elements must all be of class xmtn-propagate-data.")
(data (ewoc-data elem)))
(xmtn-propagate-need-refresh elem data)
(xmtn--update (xmtn-propagate-to-work data)
(xmtn-propagate-data-to-head-rev data)
(xmtn-propagate-data-to-head-revs data)
nil t)
(xmtn-propagate-refresh-one data nil)
(ewoc-invalidate xmtn-propagate-ewoc elem)))
@ -306,6 +303,25 @@ The elements must all be of class xmtn-propagate-data.")
(eq (xmtn-propagate-data-to-heads data)
'need-update))))
(defun xmtn-propagate-update-from ()
"Update current `from' workspace."
(interactive)
(let* ((elem (ewoc-locate xmtn-propagate-ewoc))
(data (ewoc-data elem)))
(xmtn-propagate-need-refresh elem data)
(xmtn--update (xmtn-propagate-from-work data)
(xmtn-propagate-data-from-head-revs data)
nil t)
(xmtn-propagate-refresh-one data nil)
(ewoc-invalidate xmtn-propagate-ewoc elem)))
(defun xmtn-propagate-update-fromp ()
"Non-nil if update is appropriate for current `from' workspace."
(let* ((data (ewoc-data (ewoc-locate xmtn-propagate-ewoc))))
(and (not (xmtn-propagate-data-need-refresh data))
(eq (xmtn-propagate-data-from-heads data)
'need-update))))
(defun xmtn-propagate-propagate ()
"Propagate current workspace."
(interactive)
@ -315,12 +331,17 @@ The elements must all be of class xmtn-propagate-data.")
(if (not (buffer-live-p (xmtn-propagate-data-conflicts-buffer data)))
;; user deleted conflicts buffer after resolving conflicts; get it back
(setf (xmtn-propagate-data-conflicts-buffer data)
(xmtn-propagate-conflicts-buffer data)))
(xmtn-propagate-conflicts data))
(with-current-buffer (xmtn-propagate-data-conflicts-buffer data)
(let ((xmtn-confirm-operation nil))
(xmtn-conflicts-do-propagate (xmtn-propagate-data-to-branch data))))
(save-some-buffers t); log buffer
;; save-some-buffers does not save the conflicts buffer, which is the current buffer
(save-buffer)
(xmtn-propagate-from
(xmtn-propagate-data-from-branch data) ; = left
(xmtn-propagate-data-to-branch data) ; = right
)))
(xmtn-propagate-refresh-one data nil)
(ewoc-invalidate xmtn-propagate-ewoc elem)))
@ -332,7 +353,7 @@ The elements must all be of class xmtn-propagate-data.")
(eq 'at-head (xmtn-propagate-data-from-heads data))
(eq 'at-head (xmtn-propagate-data-to-heads data))
(member (xmtn-propagate-data-conflicts data)
'(ok need-review-resolve-internal)))))
'(need-review-resolve-internal resolved none)))))
(defun xmtn-propagate-resolve-conflicts ()
"Resolve conflicts for current workspace."
@ -392,7 +413,7 @@ The elements must all be of class xmtn-propagate-data.")
(xmtn-status-one-1
xmtn-propagate-to-root
(xmtn-propagate-data-to-work data)
(xmtn-propagate-data-to-head-rev data)
(xmtn-propagate-data-to-head-revs data)
(xmtn-propagate-data-to-status-buffer data)
(xmtn-propagate-data-to-heads data)
(xmtn-propagate-data-to-local-changes data))
@ -419,7 +440,7 @@ The elements must all be of class xmtn-propagate-data.")
(xmtn-status-one-1
xmtn-propagate-from-root
(xmtn-propagate-data-from-work data)
(xmtn-propagate-data-from-head-rev data)
(xmtn-propagate-data-from-head-revs data)
(xmtn-propagate-data-from-status-buffer data)
(xmtn-propagate-data-from-heads data)
(xmtn-propagate-data-from-local-changes data))
@ -434,6 +455,13 @@ The elements must all be of class xmtn-propagate-data.")
'(need-update need-merge))
(eq (xmtn-propagate-data-from-local-changes data) 'need-commit)))))
(defun xmtn-propagate-quit-save ()
"Quit, but save conflicts files for later resume."
(interactive)
(remove-hook 'kill-buffer-hook 'xmtn-propagate-clean-all t)
(xmtn-propagate-clean-all t)
(kill-buffer))
(defvar xmtn-propagate-actions-map
(let ((map (make-sparse-keymap "actions")))
(define-key map [?c] '(menu-item "c) clean/delete"
@ -442,15 +470,18 @@ The elements must all be of class xmtn-propagate-data.")
(define-key map [?g] '(menu-item "g) refresh"
xmtn-propagate-do-refresh-one
:visible (xmtn-propagate-refreshp)))
(define-key map [?8] '(menu-item (concat "8) update " (xmtn-propagate-to-name))
(define-key map [?9] '(menu-item (concat "9) status " (xmtn-propagate-to-name))
xmtn-propagate-status-to
:visible (xmtn-propagate-status-top)))
(define-key map [?8] '(menu-item (concat "8) status " (xmtn-propagate-from-name))
xmtn-propagate-status-from
:visible (xmtn-propagate-status-fromp)))
(define-key map [?7] '(menu-item (concat "7) update " (xmtn-propagate-to-name))
xmtn-propagate-update-to
:visible (xmtn-propagate-update-top)))
(define-key map [?7] '(menu-item (concat "7) commit " (xmtn-propagate-to-name))
xmtn-propagate-commit-to
:visible (xmtn-propagate-commit-top)))
(define-key map [?6] '(menu-item (concat "6) commit " (xmtn-propagate-from-name))
xmtn-propagate-commit-from
:visible (xmtn-propagate-commit-fromp)))
(define-key map [?6] '(menu-item (concat "6) update " (xmtn-propagate-from-name))
xmtn-propagate-update-from
:visible (xmtn-propagate-update-fromp)))
(define-key map [?5] '(menu-item "5) propagate"
xmtn-propagate-propagate
:visible (xmtn-propagate-propagatep)))
@ -463,12 +494,12 @@ The elements must all be of class xmtn-propagate-data.")
(define-key map [?2] '(menu-item (concat "2) ignore local changes " (xmtn-propagate-from-name))
xmtn-propagate-local-changes-from-ok
:visible (xmtn-propagate-local-changes-fromp)))
(define-key map [?1] '(menu-item (concat "1) status " (xmtn-propagate-to-name))
xmtn-propagate-status-to
:visible (xmtn-propagate-status-top)))
(define-key map [?0] '(menu-item (concat "0) status " (xmtn-propagate-from-name))
xmtn-propagate-status-from
:visible (xmtn-propagate-status-fromp)))
(define-key map [?1] '(menu-item (concat "1) commit " (xmtn-propagate-to-name))
xmtn-propagate-commit-to
:visible (xmtn-propagate-commit-top)))
(define-key map [?0] '(menu-item (concat "0) commit " (xmtn-propagate-from-name))
xmtn-propagate-commit-from
:visible (xmtn-propagate-commit-fromp)))
map)
"Keyboard menu keymap used to manage propagates.")
@ -481,10 +512,19 @@ The elements must all be of class xmtn-propagate-data.")
(define-key map [?g] 'xmtn-propagate-refresh)
(define-key map [?n] 'xmtn-propagate-next)
(define-key map [?p] 'xmtn-propagate-prev)
(define-key map [?q] 'xmtn-propagate-quit)
(define-key map [?s] 'xmtn-propagate-quit-save)
(define-key map [?q] 'dvc-buffer-quit)
map)
"Keymap used in `xmtn-propagate-mode'.")
(easy-menu-define xmtn-propagate-mode-menu xmtn-propagate-mode-map
"Mtn specific status menu."
`("DVC-Mtn"
["Do the right thing" xmtn-status-actions-map t]
["Quit, clean conflicts" dvc-buffer-quit t]
["Quit, save conflicts" xmtn-propagate-quit-save t]
))
(define-derived-mode xmtn-propagate-mode nil "xmtn-propagate"
"Major mode to propagate multiple workspaces."
(setq dvc-buffer-current-active-dvc 'xmtn)
@ -495,6 +535,7 @@ The elements must all be of class xmtn-propagate-data.")
(set (make-local-variable 'write-file-functions) nil)
(dvc-install-buffer-menu)
(add-hook 'kill-buffer-hook 'xmtn-propagate-clean-all nil t)
(setq buffer-read-only t)
(buffer-disable-undo)
(set-buffer-modified-p nil)
@ -505,21 +546,22 @@ The elements must all be of class xmtn-propagate-data.")
"t if DATA needs propagate."
(let ((result t)
(from-work (xmtn-propagate-from-work data))
(from-head-rev (xmtn-propagate-data-from-head-rev data))
(to-head-rev (xmtn-propagate-data-to-head-rev data)))
(from-head-rev (xmtn-propagate-data-from-head-revs data))
(to-head-rev (xmtn-propagate-data-to-head-revs data)))
(if (or (not from-head-rev)
(not to-head-rev))
(if (or (listp from-head-rev)
(listp to-head-rev))
;; multiple heads; can't propagate
(setq result nil)
;; cases:
;; 1) to branched off earlier, and propagate is needed
;; 2) propagate was just done but required no changes; no propagate needed
;;
(if (string= from-head-rev to-head-rev)
;; case 2
(setq result nil)
(let ((descendents (xmtn-automate-simple-command-output-lines from-work (list "descendents" from-head-rev)))
(let ((descendents (xmtn-automate-command-output-lines from-work (list "descendents" from-head-rev)))
done)
(if (not descendents)
;; case 1
@ -533,6 +575,7 @@ The elements must all be of class xmtn-propagate-data.")
result
))
<<<<<<< TREE
(defun xmtn-propagate-conflicts-buffer (data)
"Return a conflicts buffer for FROM-WORK, TO-WORK (absolute paths)."
(let ((from-work (xmtn-propagate-from-work data))
@ -562,39 +605,23 @@ The elements must all be of class xmtn-propagate-data.")
(xmtn-conflicts-review to-work)
(current-buffer)))))))
=======
>>>>>>> MERGE-SOURCE
(defun xmtn-propagate-conflicts (data)
"Return value for xmtn-propagate-data-conflicts for DATA."
(if (not (buffer-live-p (xmtn-propagate-data-conflicts-buffer data)))
;; user may have deleted conflicts buffer after resolving
;; conflicts; don't throw that away.
(setf (xmtn-propagate-data-conflicts-buffer data)
(xmtn-propagate-conflicts-buffer data)))
(let ((revs-current
(with-current-buffer (xmtn-propagate-data-conflicts-buffer data)
(and (string= (xmtn-propagate-data-from-head-rev data) xmtn-conflicts-left-revision)
(string= (xmtn-propagate-data-to-head-rev data) xmtn-conflicts-right-revision)))))
(if revs-current
(with-current-buffer (xmtn-propagate-data-conflicts-buffer data)
(xmtn-conflicts-update-counts)
(save-buffer))
;; else recreate conflicts
(xmtn-propagate-kill-conflicts-buffer data)
(xmtn-conflicts-clean (xmtn-propagate-to-work data))
(setf (xmtn-propagate-data-conflicts-buffer data)
(xmtn-propagate-conflicts-buffer data))
)
(with-current-buffer (xmtn-propagate-data-conflicts-buffer data)
(if (= xmtn-conflicts-total-count xmtn-conflicts-resolved-count)
(if (< 0 xmtn-conflicts-resolved-internal-count)
'need-review-resolve-internal
'ok)
'need-resolve))))
;; Only called if neither side needs merge. See
;; xmtn-propagate-propagate for assignment of 'left' = 'from'.
(let ((result (xmtn-conflicts-status
(xmtn-propagate-data-conflicts-buffer data) ; buffer
(xmtn-propagate-from-work data) ; left-work
(xmtn-propagate-data-from-head-revs data) ; left-rev
(xmtn-propagate-to-work data) ; right-work
(xmtn-propagate-data-to-head-revs data) ; right-rev
(xmtn-propagate-data-from-branch data) ; left-branch
(xmtn-propagate-data-to-branch data) ; right-branch
)))
(setf (xmtn-propagate-data-conflicts-buffer data) (car result))
(cadr result)))
(defun xmtn-propagate-refresh-one (data refresh-local-changes)
"Refresh DATA."
@ -607,24 +634,24 @@ The elements must all be of class xmtn-propagate-data.")
(from-base-rev (xmtn--get-base-revision-hash-id-or-null from-work)))
(case (length heads)
(1
(setf (xmtn-propagate-data-from-head-rev data) (nth 0 heads))
(if (string= (xmtn-propagate-data-from-head-rev data) from-base-rev)
(setf (xmtn-propagate-data-from-head-revs data) (nth 0 heads))
(if (string= (xmtn-propagate-data-from-head-revs data) from-base-rev)
(setf (xmtn-propagate-data-from-heads data) 'at-head)
(setf (xmtn-propagate-data-from-heads data) 'need-update)))
(t
(setf (xmtn-propagate-data-from-head-rev data) nil)
(setf (xmtn-propagate-data-from-head-revs data) (list (nth 0 heads) (nth 1 heads)))
(setf (xmtn-propagate-data-from-heads data) 'need-merge))))
(let ((heads (xmtn--heads to-work (xmtn-propagate-data-to-branch data)))
(to-base-rev (xmtn--get-base-revision-hash-id-or-null to-work)))
(case (length heads)
(1
(setf (xmtn-propagate-data-to-head-rev data) (nth 0 heads))
(if (string= (xmtn-propagate-data-to-head-rev data) to-base-rev)
(setf (xmtn-propagate-data-to-head-revs data) (nth 0 heads))
(if (string= (xmtn-propagate-data-to-head-revs data) to-base-rev)
(setf (xmtn-propagate-data-to-heads data) 'at-head)
(setf (xmtn-propagate-data-to-heads data) 'need-update)))
(t
(setf (xmtn-propagate-data-to-head-rev data) nil)
(setf (xmtn-propagate-data-to-head-revs data) (list (nth 0 heads) (nth 1 heads)))
(setf (xmtn-propagate-data-to-heads data) 'need-merge))))
(setf (xmtn-propagate-data-propagate-needed data)
@ -635,19 +662,15 @@ The elements must all be of class xmtn-propagate-data.")
(setf (xmtn-propagate-data-from-local-changes data) 'need-scan)
(setf (xmtn-propagate-data-to-local-changes data) 'need-scan)))
(if (or refresh-local-changes
(xmtn-propagate-data-propagate-needed data))
;; these checks are slow, so don't do them if they probably are not needed.
(progn
(ecase (xmtn-propagate-data-from-local-changes data)
(need-scan
(xmtn-propagate-create-from-status-buffer data))
(t nil))
(ecase (xmtn-propagate-data-from-local-changes data)
(need-scan
(xmtn-propagate-create-from-status-buffer data))
(t nil))
(ecase (xmtn-propagate-data-to-local-changes data)
(need-scan
(xmtn-propagate-create-to-status-buffer data))
(t nil))))
(ecase (xmtn-propagate-data-to-local-changes data)
(need-scan
(xmtn-propagate-create-to-status-buffer data))
(t nil))
(if (xmtn-propagate-data-propagate-needed data)
(progn

232
dvc/lisp/xmtn-revlist.el
View File

@ -1,6 +1,6 @@
;;; xmtn-revlist.el --- Interactive display of revision histories for monotone
;; Copyright (C) 2008 - 2010 Stephen Leake
;; Copyright (C) 2008 - 2011 Stephen Leake
;; Copyright (C) 2006, 2007 Christian M. Ohler
;; Author: Christian M. Ohler
@ -74,9 +74,7 @@ arg; root. Result is of the form:
authors
dates
changelogs
tags
parent-hash-ids
child-hash-ids)
tags)
;;;###autoload
(defun xmtn-revision-refresh-maybe ()
@ -91,17 +89,9 @@ arg; root. Result is of the form:
(defun xmtn-revision-list-entry-patch-printer (patch)
(let ((entry (dvc-revlist-entry-patch-struct patch)))
(assert (typep entry 'xmtn--revlist-entry))
(insert (format " %s %s%s\n"
(insert (format " %s %s\n"
(if (dvc-revlist-entry-patch-marked patch) "*" " ")
(xmtn--revlist-entry-revision-hash-id entry)
(let ((head-p
(endp (xmtn--revlist-entry-child-hash-ids entry)))
(root-p
(endp (xmtn--revlist-entry-parent-hash-ids entry))))
(cond ((and head-p root-p) " (head, root)")
(head-p " (head)")
(root-p " (root)")
(t "")))))
(xmtn--revlist-entry-revision-hash-id entry)))
(dolist (tag (xmtn--revlist-entry-tags entry))
(insert (format " Tag: %s\n" tag)))
(let ((authors (xmtn--revlist-entry-authors entry))
@ -117,7 +107,7 @@ arg; root. Result is of the form:
(eql (length dates) len)
(eql (length changelogs) len)))
(loop
;; FIXME: Matching the k-th author cert with the k-th date cert
;; Matching the k-th author cert with the k-th date cert
;; and the k-th changelog cert, like we do here, is unlikely to
;; be correct in general. That the relationship between date,
;; message and author of a commit is lost appears to be a
@ -145,9 +135,12 @@ arg; root. Result is of the form:
(insert (format " %s\n" line))))))))))
(defun xmtn--revlist-setup-ewoc (root ewoc header footer revision-hash-ids last-n)
(assert (every (lambda (x) (typep x 'xmtn--hash-id)) revision-hash-ids))
(ewoc-set-hf ewoc header footer)
(ewoc-filter ewoc (lambda (x) nil)) ; Clear it.
;; FIXME: setup should not modify order; this should be a waste of
;; time or wrong. This was here historically; see
;; xmtn--log-generator for comment on why I have not removed it. I
;; have not investigated order problems with other revlists.
(setq revision-hash-ids (xmtn--toposort root revision-hash-ids))
(if last-n
(let ((len (length revision-hash-ids)))
@ -159,8 +152,6 @@ arg; root. Result is of the form:
(1 "Setting up revlist buffer (1 revision)...")
(t (format "Setting up revlist buffer (%s revisions)..."
(length revision-hash-ids))))
;; Maybe also show parents and children? (Could add toggle
;; commands to show/hide these.)
(lexical-let ((rev (aref revision-hash-ids i))
(branches (list))
(authors (list))
@ -189,36 +180,21 @@ arg; root. Result is of the form:
changelogs (nreverse changelogs)
branches (nreverse branches)
tags (nreverse tags))
(let ((parent-hash-ids
(xmtn-automate-simple-command-output-lines root `("parents"
,rev)))
(child-hash-ids
(xmtn-automate-simple-command-output-lines root `("children"
,rev))))
(xmtn--assert-optional (every #'stringp authors))
(xmtn--assert-optional (every #'stringp dates))
(xmtn--assert-optional (every #'stringp changelogs))
(xmtn--assert-optional (every #'stringp branches))
(xmtn--assert-optional (every #'stringp tags))
(xmtn--assert-optional (every #'xmtn--hash-id-p parent-hash-ids))
(xmtn--assert-optional (every #'xmtn--hash-id-p child-hash-ids))
(ewoc-enter-last ewoc
;; Creating a list `(entry-patch
;; ,instance-of-dvc-revlist-entry-patch) seems
;; to be part of DVC's API.
`(entry-patch
,(make-dvc-revlist-entry-patch
:dvc 'xmtn
:rev-id `(xmtn (revision ,rev))
:struct (xmtn--make-revlist-entry
:revision-hash-id rev
:branches branches
:authors authors
:dates dates
:changelogs changelogs
:tags tags
:parent-hash-ids parent-hash-ids
:child-hash-ids child-hash-ids)))))))
(ewoc-enter-last ewoc
;; Creating a list `(entry-patch
;; ,instance-of-dvc-revlist-entry-patch) seems
;; to be part of DVC's API.
`(entry-patch
,(make-dvc-revlist-entry-patch
:dvc 'xmtn
:rev-id `(xmtn (revision ,rev))
:struct (xmtn--make-revlist-entry
:revision-hash-id rev
:branches branches
:authors authors
:dates dates
:changelogs changelogs
:tags tags))))))
nil)
(defun xmtn-revision-st-message (entry)
@ -226,11 +202,21 @@ arg; root. Result is of the form:
(defun xmtn--revlist-refresh ()
(let ((root default-directory))
<<<<<<< TREE
(destructuring-bind (merge-destination-branch
header-lines footer-lines revision-hash-ids)
=======
(destructuring-bind (header-lines footer-lines revs)
>>>>>>> MERGE-SOURCE
(funcall xmtn--revlist-*info-generator-fn* root)
<<<<<<< TREE
(setq xmtn--revlist-*merge-destination-branch* merge-destination-branch)
(let ((ewoc dvc-revlist-cookie))
=======
(let ((ewoc dvc-revlist-cookie)
(count (length revs))
(last-n dvc-revlist-last-n))
>>>>>>> MERGE-SOURCE
(xmtn--revlist-setup-ewoc root ewoc
(with-temp-buffer
(dolist (line header-lines)
@ -238,7 +224,16 @@ arg; root. Result is of the form:
(insert ?\n)
(insert line ?\n)))
(when header-lines (insert ?\n))
(buffer-string))
(insert
(cond
((= 0 count) "No revisions")
((= 1 count) "1 revision:")
((or (null last-n)
(> last-n count))
(format "%d of %d revisions:" count count))
(t (format "%d of %d revisions:" last-n count))))
(insert ?\n)
(buffer-string))
(with-temp-buffer
(when footer-lines (insert ?\n))
(dolist (line footer-lines)
@ -246,7 +241,7 @@ arg; root. Result is of the form:
(insert ?\n)
(insert line ?\n)))
(buffer-string))
revision-hash-ids
revs
dvc-revlist-last-n)
(if (null (ewoc-nth ewoc 0))
(goto-char (point-max))
@ -284,6 +279,7 @@ arg; root. Result is of the form:
;;;###autoload
(defun xmtn-dvc-changelog (&optional path)
<<<<<<< TREE
(xmtn--log-helper (dvc-tree-root) path nil nil))
(defun xmtn--log-helper (root path first-line-only-p last-n)
@ -367,6 +363,41 @@ arg; root. Result is of the form:
(length difference)))))
'()
difference)))
=======
(xmtn--setup-revlist
(dvc-tree-root)
'xmtn--log-generator
path
nil ;; first-line-only-p
nil ;; last-n
))
(defun xmtn--log-generator (root)
(let ((branch (xmtn--tree-default-branch root)))
(let
((header
(list (format "Log for branch %s" branch)))
(options
;; FIXME: this gives most the recent date first, we want
;; that last. See mtn issue 118 for why we can't fix that
;; with more options. The 'toposort' in
;; xmtn--revlist-setup-ewoc puts it in the desired date
;; order. In general, it would be better if revlist-setup
;; did not alter the order.
(if dvc-revlist-last-n
(list "last" (format "%d" dvc-revlist-last-n))))
(command
(if xmtn--revlist-*path*
(list "log" xmtn--revlist-*path*)
(list "log")))
)
;; See xmtn--revlist-*info-generator-fn* for result format
(list header
'() ;; footer
(xmtn-automate-command-output-lines ;; revisions
root
(cons options command))))))
>>>>>>> MERGE-SOURCE
(defun xmtn-revlist-show-conflicts ()
"If point is on a revision that has two parents, show conflicts
@ -396,59 +427,40 @@ from the merge."
(setq right-rev (substring changelog start end)))
((string= (substring changelog 0 5) "merge")
((or
(string= (substring changelog 0 5) "merge")
(string= (substring changelog 0 14) "explicit merge"))
(setq start (+ 4 (string-match "of" changelog)))
(setq end (string-match "'" changelog start))
(setq left-rev (substring changelog start (1- end)))
(setq left-rev (substring changelog start end))
(setq start (+ 5 (string-match "and" changelog start)))
(setq end (string-match "'" changelog start))
(setq right-rev (substring changelog start (1- end))))
(setq right-rev (substring changelog start end)))
(t
(error "not on a two parent revision")))
(xmtn-conflicts-save-opts
(read-file-name "left work: ")
(read-file-name "right work: ")
(xmtn-conflicts-review
default-directory ; left-work
left-rev
default-directory ; right-work
right-rev
left-branch
right-branch)
(dvc-run-dvc-async
'xmtn
(list "conflicts" "store" left-rev right-rev)
:finished (lambda (output error status arguments)
(let ((conflicts-buffer (dvc-get-buffer-create 'xmtn 'conflicts default-directory)))
(pop-to-buffer conflicts-buffer)
(xmtn-conflicts-load-opts)
(set (make-local-variable 'after-insert-file-functions) '(xmtn-conflicts-after-insert-file))
(insert-file-contents "_MTN/conflicts" t)))
:error (lambda (output error status arguments)
(pop-to-buffer error)))))
right-branch
t)))
;;;###autoload
(defvar xmtn-revlist-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "CM" 'xmtn-conflicts-merge)
(define-key map "CP" 'xmtn-conflicts-propagate)
(define-key map "CR" 'xmtn-conflicts-review)
(define-key map "CC" 'xmtn-conflicts-clean)
(define-key map "MH" 'xmtn-view-heads-revlist)
(define-key map "MP" 'xmtn-propagate-from)
(define-key map "MC" 'xmtn-revlist-show-conflicts)
(define-key map "CC" 'xmtn-conflicts-clean)
map))
;; items added here should probably also be added to xmtn-diff-mode-menu, -map in xmtn-dvc.el
(easy-menu-define xmtn-revlist-mode-menu xmtn-revlist-mode-map
"Mtn specific revlist menu."
`("DVC-Mtn"
["View Heads" xmtn-view-heads-revlist t]
["Show merge conflicts before merge" xmtn-conflicts-merge t]
["Show merge conflicts after merge" xmtn-revlist-show-conflicts t]
["Show propagate conflicts" xmtn-conflicts-propagate t]
["Review conflicts" xmtn-conflicts-review t]
["Propagate branch" xmtn-propagate-from t]
["Clean conflicts resolutions" xmtn-conflicts-clean t]
))
@ -463,9 +475,26 @@ from the merge."
(let ((root (dvc-tree-root)))
(xmtn--setup-revlist
root
<<<<<<< TREE
'xmtn--revlist--missing-get-info
;; Passing nil as first-line-only-p is arbitrary here.
;;
=======
(lambda (root)
(let ((revs
(xmtn-automate-command-output-lines
root
(cons (list "from" "h:" "to" "w:") (list "log")))))
(list
(list ;; header
(format "workspace %s" root)
nil ;; blank line
"Revisions that are not in base revision")
'() ;; footer
revs)))
nil ;; path
nil ;; first-line-only-p
>>>>>>> MERGE-SOURCE
;; When the missing revs are due to a propagate, there can be a
;; lot of them, but we only really need to see the revs since the
;; propagate. So dvc-log-last-n is appropriate. We use
@ -475,12 +504,28 @@ from the merge."
nil)
;;;###autoload
(defun xmtn-review-update (root)
(defun xmtn-update-review (root)
"Review revisions in last update of ROOT workspace."
(interactive "D")
(xmtn--setup-revlist
root
<<<<<<< TREE
'xmtn--revlist--review-update-info
=======
(lambda (root)
(let ((revs
(xmtn-automate-command-output-lines
root
(cons (list "from" "w:" "to" "u:") (list "log")))))
(list
(list ;; header
(format "workspace %s" root)
nil ;; blank line
"Revisions in last update")
'() ;; footer
revs)))
nil ;; path
>>>>>>> MERGE-SOURCE
nil ;; first-line-only-p
dvc-log-last-n)
nil)
@ -494,9 +539,9 @@ from the merge."
root
(lambda (root)
(let* ((branch (xmtn--tree-default-branch root))
(head-revision-hash-ids (xmtn--heads root branch))
(head-count (length head-revision-hash-ids)))
(head-revision-hash-ids (xmtn--heads root branch)))
(list
<<<<<<< TREE
branch
(list (format "Tree %s" root)
(format "Branch %s" branch)
@ -505,6 +550,12 @@ from the merge."
(1 "1 head revision:")
(t (format "%s head revisions: " head-count))))
'()
=======
(list ; header
(format "workspace %s" root)
"Head revisions")
'() ; footer
>>>>>>> MERGE-SOURCE
head-revision-hash-ids)))
;; Passing nil as first-line-only-p, last-n is arbitrary here.
nil nil))
@ -566,6 +617,7 @@ to the base revision of the current tree."
(revision-hash-ids (xmtn--expand-selector root selector))
(count (length revision-hash-ids)))
(list
<<<<<<< TREE
branch
(list (format "Tree %s" root)
(format "Default branch %s" branch)
@ -579,6 +631,16 @@ to the base revision of the current tree."
(t (format "%s revisions matching selector: "
count))))
'()
=======
(list ; header
(format "workspace %s" root)
(if (with-syntax-table (standard-syntax-table)
(string-match "\\`\\s *\\'" selector))
"Blank selector"
(format "Selector %s" selector))
"Revisions matching selector")
'() ; footer
>>>>>>> MERGE-SOURCE
revision-hash-ids)))
;; Passing nil as first-line-only-p is arbitrary here.
nil

36
dvc/lisp/xmtn-run.el
View File

@ -1,6 +1,6 @@
;;; xmtn-run.el --- Functions for runnning monotone commands
;; Copyright (C) 2008 - 2010 Stephen Leake
;; Copyright (C) 2008 - 2011 Stephen Leake
;; Copyright (C) 2006, 2007 Christian M. Ohler
;; Author: Christian M. Ohler
@ -43,6 +43,11 @@
(define-coding-system-alias 'xmtn--monotone-normal-form 'utf-8-unix)
(defun xmtn-dvc-prepare-environment (env)
"Prepare the environment to run mtn."
;; DVC expects monotone messages in the C locale
(cons "LC_MESSAGES=C" env))
(defun* xmtn--run-command-sync (root arguments)
(xmtn--check-cached-command-version)
(let ((default-directory (file-truename (or root default-directory))))
@ -71,6 +76,7 @@
,@arguments)
dvc-run-keys)))
<<<<<<< TREE
(defun xmtn--command-output-lines (root arguments)
"Run mtn in ROOT with ARGUMENTS and return its output as a list of strings."
(xmtn--check-cached-command-version)
@ -107,6 +113,9 @@ Signals an error if more (or fewer) than one line is output."
(first lines)))
(defconst xmtn--minimum-required-command-version '(0 46))
=======
(defconst xmtn--minimum-required-command-version '(0 99))
>>>>>>> MERGE-SOURCE
;; see also xmtn-sync.el xmtn-sync-required-command-version
(defconst xmtn--required-automate-format-version "2")
@ -139,10 +148,11 @@ Sets cache if not already set."
(defun xmtn--command-version (executable)
"Return EXECUTABLE's version as a list (MAJOR MINOR REVISION VERSION-STRING).
VERSION-STRING is the string printed by mtn --version (with no
VERSION-STRING is the string printed by `mtn version' (with no
trailing newline). MAJOR and MINOR are integers, a parsed
representation of the version number. REVISION is the revision
id."
<<<<<<< TREE
(let (
;; Cache a fake version number to avoid infinite mutual
;; recursion.
@ -163,6 +173,28 @@ id."
(minor (parse-integer string (match-beginning 2) (match-end 2)))
(revision (match-string 4 string)))
(list major minor revision string)))))
=======
(let ((version-string))
(dvc-run-dvc-sync
'xmtn
'("version")
:finished
(lambda (output error status arguments)
(with-current-buffer output
(setq version-string (buffer-substring-no-properties (point-min) (1- (point-max)))))))
(unless (string-match
(concat "\\`monotone \\([0-9]+\\)\\.\\([0-9]+\\)\\(\\.[0-9]+\\)?\\(dev\\)?"
" (base revision: \\(unknown\\|\\([0-9a-f]\\{40\\}\\)\\))\\'")
version-string)
(error (concat "Version output from monotone version"
" did not match expected pattern: %S")
version-string))
(let ((major (parse-integer version-string (match-beginning 1) (match-end 1)))
(minor (parse-integer version-string (match-beginning 2) (match-end 2)))
(revision (match-string 4 version-string)))
(list major minor revision version-string))))
>>>>>>> MERGE-SOURCE
(defun xmtn--check-cached-command-version ()
(let ((minimum-version xmtn--minimum-required-command-version)

253
dvc/lisp/xmtn-sync.el
View File

@ -1,6 +1,6 @@
;;; xmtn-sync.el --- database sync handling for DVC backend for monotone
;;
;; Copyright (C) 2010 Stephen Leake
;; Copyright (C) 2010, 2011 Stephen Leake
;;
;; Author: Stephen Leake
;; Keywords: tools
@ -47,6 +47,12 @@
(defvar xmtn-sync-config "xmtn-sync-config"
"File to store `xmtn-sync-branch-alist' and `xmtn-sync-remote-exec-alist'; relative to `dvc-config-directory'.")
(defvar xmtn-sync-sort nil
"User-supplied function to sort branches.
Called with a string containing the mtn branch name; return
'(node key) where node is the ewoc node to insert before (nil to
insert at end), key is the sort-key. Sync buffer is current.")
;;; Internal variables
<<<<<<< TREE
(defconst xmtn-sync-required-command-version '(0 46)
@ -119,10 +125,80 @@ All xmtn-sync functions operate on this ewoc.
The elements must all be of type xmtn-sync-sync.")
(make-variable-buffer-local 'xmtn-sync-ewoc)
<<<<<<< TREE
=======
(defstruct (xmtn-sync-branch
(:copier nil))
;; ewoc element; data for a branch that was received
name ;; monotone branch name
rev-alist ;; alist of '(revid (date author changelog)) for received revs
send-count ;; integer count of sent revs
print-mode ;; 'summary | 'brief | 'full | 'started
sort-key ;; for use by xmtn-sync-sort
)
(defun xmtn-sync-print-rev (rev print-mode)
"Print a REV (element of branch rev-alist) according to PRINT-MODE ('brief or 'full)."
(let ((date (nth 0 (cadr rev)))
(author (nth 1 (cadr rev)))
(changelog (nth 2 (cadr rev))))
(insert (dvc-face-add (format "\n %s %s\n" date author) 'dvc-header))
(ecase print-mode
(brief
(insert (substring changelog 0 (string-match "\n" changelog))))
(full
(insert changelog)))))
(defun xmtn-sync-printer (branch)
"Print an ewoc element; BRANCH must be of type xmtn-sync-branch."
;; sometimes mtn will allow a revision with no branch!
(if (xmtn-sync-branch-name branch)
(insert (dvc-face-add (xmtn-sync-branch-name branch) 'dvc-keyword))
(insert (dvc-face-add "<no branch>" 'dvc-keyword)))
(insert (format " rx %d tx %d\n"
(length (xmtn-sync-branch-rev-alist branch))
(xmtn-sync-branch-send-count branch)))
(ecase (xmtn-sync-branch-print-mode branch)
(summary nil)
((brief full)
(loop for rev in (xmtn-sync-branch-rev-alist branch) do
(xmtn-sync-print-rev rev (xmtn-sync-branch-print-mode branch))))
(started
(insert " started\n")))
)
(defun xmtn-sync-brief ()
"Set display mode for current item to brief."
(interactive)
(let* ((elem (ewoc-locate xmtn-sync-ewoc))
(data (ewoc-data elem)))
(setf (xmtn-sync-branch-print-mode data) 'brief)
(ewoc-invalidate xmtn-sync-ewoc elem)))
(defun xmtn-sync-full ()
"Set display mode for current item to full."
(interactive)
(let* ((elem (ewoc-locate xmtn-sync-ewoc))
(data (ewoc-data elem)))
(setf (xmtn-sync-branch-print-mode data) 'full)
(ewoc-invalidate xmtn-sync-ewoc elem)))
(defun xmtn-sync-summary ()
"Set display mode for current item to summary."
(interactive)
(let* ((elem (ewoc-locate xmtn-sync-ewoc))
(data (ewoc-data elem)))
(setf (xmtn-sync-branch-print-mode data) 'summary)
(ewoc-invalidate xmtn-sync-ewoc elem)))
>>>>>>> MERGE-SOURCE
(defun xmtn-sync-status ()
"Start xmtn-status-one for current ewoc element."
(let* ((data (ewoc-data (ewoc-locate xmtn-sync-ewoc)))
(branch (xmtn-sync-branch-name data))
<<<<<<< TREE
(work (assoc branch xmtn-sync-branch-alist)))
(if (not work)
(progn
@ -134,21 +210,105 @@ The elements must all be of type xmtn-sync-sync.")
(let ((map (make-sparse-keymap)))
(define-key map [?0] '(menu-item "0) status"
'xmtn-sync-status))
=======
save-work
(work (or
(cadr (assoc branch xmtn-sync-branch-alist))
(if (functionp xmtn-sync-guess-workspace)
(funcall xmtn-sync-guess-workspace branch))
(prog1
(read-directory-name (format "workspace root for %s: " branch))
(setq save-work t))
)))
(setf (xmtn-sync-branch-print-mode data) 'started) ; indicate we've started work on it
(ewoc-invalidate xmtn-sync-ewoc elem)
(condition-case err
(xmtn-status-one work)
('error
(if (and (not save-work) (functionp xmtn-sync-guess-workspace))
;; xmtn-sync-guess-workspace guessed wrong; prompt and try again
(progn
(setq work (read-directory-name (format "workspace root for %s: " branch)))
(setq save-work t)
(xmtn-status-one work)))))
;; don't save the workspace association until it is validated by xmtn-status-one
(if save-work
(progn
(push (list branch work) xmtn-sync-branch-alist)
(dvc-save-state
(list 'xmtn-sync-branch-alist)
(expand-file-name xmtn-sync-branch-file dvc-config-directory))))))
(defun xmtn-sync-update ()
"Start xmtn-status-on for current ewoc element, do update if possible."
(interactive)
(xmtn-sync-status)
(if (xmtn-status-updatep)
(xmtn-status-update)))
(defun xmtn-sync-clean ()
"Clean and delete current ewoc element."
(interactive)
(let* ((elem (ewoc-locate xmtn-sync-ewoc))
(status-buffer (get-buffer-create "*xmtn-multi-status*"))
(inhibit-read-only t))
(if (buffer-live-p status-buffer)
(kill-buffer status-buffer))
(ewoc-delete xmtn-sync-ewoc elem)))
(dvc-make-ewoc-next xmtn-sync-next xmtn-sync-ewoc)
(dvc-make-ewoc-prev xmtn-sync-prev xmtn-sync-ewoc)
(defvar xmtn-sync-kbd-map
(let ((map (make-sparse-keymap "action")))
;; last defined is first in displayed menu
(define-key map [?c] '(menu-item "c) clean" xmtn-sync-clean))
(define-key map [?f] '(menu-item "f) full" xmtn-sync-full))
(define-key map [?b] '(menu-item "b) brief" xmtn-sync-brief))
(define-key map [?s] '(menu-item "s) status" xmtn-sync-status))
(define-key map [?u] '(menu-item "u) update" xmtn-sync-update))
>>>>>>> MERGE-SOURCE
map)
"Keyboard menu keymap for xmtn-sync-ewoc.")
(defvar xmtn-sync-mode-map
(let ((map (make-sparse-keymap)))
<<<<<<< TREE
(define-key map [?q] 'dvc-buffer-quit)
(define-key map "\M-d" xmtn-sync-ewoc-map)
=======
(define-key map "\M-d" xmtn-sync-kbd-map)
(define-key map [?b] 'xmtn-sync-brief)
(define-key map [?c] 'xmtn-sync-clean)
(define-key map [?f] 'xmtn-sync-full)
(define-key map [?n] 'xmtn-sync-next)
(define-key map [?p] 'xmtn-sync-prev)
(define-key map [?q] 'dvc-buffer-quit)
(define-key map [?s] 'xmtn-sync-status)
(define-key map [?u] 'xmtn-sync-update)
(define-key map [?S] 'xmtn-sync-save)
>>>>>>> MERGE-SOURCE
map)
"Keymap used in `xmtn-sync-mode'.")
(easy-menu-define xmtn-sync-mode-menu xmtn-sync-mode-map
"`xmtn-sync' menu"
`("Xmtn-sync"
<<<<<<< TREE
["Do the right thing" xmtn-sync-ewoc-map t]
["Quit" dvc-buffer-quit t]
=======
;; first item is top in display
["Status" xmtn-sync-status t]
["Update" xmtn-sync-update t]
["Brief display" xmtn-sync-brief t]
["Full display" xmtn-sync-full t]
["Clean/delete" xmtn-sync-clean t]
["Save" xmtn-sync-save t]
["Save and Quit" (lambda () (kill-buffer (current-buffer))) t]
>>>>>>> MERGE-SOURCE
))
;; derive from nil causes no keymap to be used, but still have self-insert keys
@ -160,12 +320,21 @@ The elements must all be of type xmtn-sync-sync.")
(setq xmtn-sync-ewoc (ewoc-create 'xmtn-sync-printer))
(setq dvc-buffer-refresh-function nil)
(dvc-install-buffer-menu)
<<<<<<< TREE
<<<<<<< TREE
(setq buffer-read-only t)
(buffer-disable-undo)
(set-buffer-modified-p nil))
=======
(buffer-disable-undo))
=======
(add-hook 'kill-buffer-hook 'xmtn-sync-save nil t)
(buffer-disable-undo)
(unless xmtn-sync-branch-alist
(let ((branch-file (expand-file-name xmtn-sync-branch-file dvc-config-directory)))
(if (file-exists-p branch-file)
(load branch-file)))))
>>>>>>> MERGE-SOURCE
(defun xmtn-sync-parse-revision-certs (direction)
"Parse certs associated with a revision; return (branch changelog date author)."
@ -226,21 +395,29 @@ The elements must all be of type xmtn-sync-sync.")
xmtn-sync-ewoc)
(if (not old-branch)
(ewoc-enter-last
xmtn-sync-ewoc
(ecase direction
('receive
(make-xmtn-sync-branch
:name branch
:rev-alist (list (list revid (list date author changelog)))
:send-count 0
:print-mode 'summary))
('send
(make-xmtn-sync-branch
:name branch
:rev-alist nil
:send-count 1
:print-mode 'summary)))))))
(let*
((node-key (and (functionp xmtn-sync-sort)
(funcall xmtn-sync-sort branch)))
(data
(ecase direction
('receive
(make-xmtn-sync-branch
:name branch
:rev-alist (list (list revid (list date author changelog)))
:send-count 0
:print-mode 'summary
:sort-key (nth 1 node-key)))
('send
(make-xmtn-sync-branch
:name branch
:rev-alist nil
:send-count 1
:print-mode 'summary
:sort-key (nth 1 node-key))))))
(if (nth 0 node-key)
(ewoc-enter-before xmtn-sync-ewoc (nth 0 node-key) data)
(ewoc-enter-last xmtn-sync-ewoc data))
))))
(defun xmtn-sync-parse-revisions (direction)
"Parse revisions with associated certs."
@ -260,7 +437,6 @@ The elements must all be of type xmtn-sync-sync.")
(defun xmtn-sync-parse-certs (direction)
"Parse certs not associated with revisions."
;; The only case we care about is a new branch created from an existing revision.
(let ((keyword (ecase direction
('receive "receive_cert")
('send "send_cert")))
@ -269,12 +445,14 @@ The elements must all be of type xmtn-sync-sync.")
branch
(date "")
(author "")
(changelog "create branch\n")
(changelog "create or propagate branch\n")
old-branch)
(while (xmtn-basic-io-optional-line keyword (setq cert-label (cadar value)))
(cond
((string= cert-label "branch")
;; This happens when a new branch is created, or a branch is
;; propagated without any conflicts.
(xmtn-basic-io-check-line "value" (setq branch (cadar value)))
(xmtn-basic-io-skip-line "key")
(xmtn-basic-io-check-line "revision" (setq revid (cadar value)))
@ -300,7 +478,8 @@ The elements must all be of type xmtn-sync-sync.")
(while (xmtn-basic-io-optional-skip-line keyword))))
(defun xmtn-sync-parse (begin)
"Parse current buffer starting at BEGIN, fill in `xmtn-sync-ewoc' in current buffer, erase parsed text."
"Parse current buffer starting at BEGIN, fill in `xmtn-sync-ewoc' in current buffer, erase parsed text.
Return non-nil if anything parsed."
(set-syntax-table xmtn-basic-io--*syntax-table*)
(goto-char begin)
@ -358,7 +537,9 @@ The elements must all be of type xmtn-sync-sync.")
(xmtn-sync-parse-revisions 'send)
(xmtn-sync-parse-keys 'send)
(delete-region begin (point))
(let ((result (not (= begin (point)))))
(delete-region begin (point))
result)
)
(defun xmtn-sync-load-file (&optional noerror)
@ -371,10 +552,14 @@ The elements must all be of type xmtn-sync-sync.")
(setq buffer-read-only nil)
(dolist (data stuff) (ewoc-enter-last xmtn-sync-ewoc data))
(setq buffer-read-only t)
<<<<<<< TREE
(set-buffer-modified-p nil))
(unless noerror
(error "%s file not found" save-file)))))
>>>>>>> MERGE-SOURCE
=======
(set-buffer-modified-p nil)))))
>>>>>>> MERGE-SOURCE
;;;###autoload
(defun xmtn-sync-sync (local-db remote-host remote-db)
@ -463,10 +648,6 @@ Remote-db should include branch pattern in URI syntax."
(setq buffer-read-only t)
(set-buffer-modified-p nil)
(xmtn-sync-save)
(unless xmtn-sync-branch-alist
(let ((branch-file (expand-file-name xmtn-sync-branch-file dvc-config-directory)))
(if (file-exists-p branch-file)
(load branch-file))))
))
(defun xmtn-sync-save ()
@ -492,14 +673,18 @@ Remote-db should include branch pattern in URI syntax."
"Display sync results in FILE (defaults to `xmtn-sync-review-file'), appended to content of `xmtn-sync-save-file'.
FILE should be output of 'automate sync'. (external sync handles tickers better)."
(interactive)
;; first load xmtn-sync-save-file
(pop-to-buffer (get-buffer-create "*xmtn-sync*"))
(setq buffer-read-only nil)
(delete-region (point-min) (point-max))
(xmtn-sync-mode)
(xmtn-sync-load-file)
(if (buffer-live-p (get-buffer "*xmtn-sync*"))
(progn
(pop-to-buffer "*xmtn-sync*")
(xmtn-sync-save))
;; else create
(pop-to-buffer (get-buffer-create "*xmtn-sync*"))
(setq buffer-read-only nil)
(delete-region (point-min) (point-max))
(xmtn-sync-mode)
(xmtn-sync-load-file file))
;; now add file
;; now add FILE
(setq file (or file
(expand-file-name xmtn-sync-review-file dvc-config-directory)))
(if (file-exists-p file)
@ -507,8 +692,12 @@ FILE should be output of 'automate sync'. (external sync handles tickers better)
(goto-char (point-min))
(setq buffer-read-only nil)
(insert-file-contents-literally file)
(xmtn-sync-parse (point-min))
;; user may have run several syncs, dumping each output into FILE; loop thru each.
(while (xmtn-sync-parse (point-min)))
(setq buffer-read-only t)
(set-buffer-modified-p nil)
(xmtn-sync-save)
(delete-file file))))
>>>>>>> MERGE-SOURCE

4
dvc/texinfo/Makefile.in
View File

@ -50,7 +50,11 @@ uninstall:
info: dvc.info dvc-intro.info
<<<<<<< TREE
alldeps = $(srcdir)/dvc.texinfo dvc-version.texinfo
=======
alldeps = $(srcdir)/dvc.texinfo dvc-version.texinfo $(srcdir)/dvc-intro.texinfo
>>>>>>> MERGE-SOURCE
dvc.info: $(alldeps)
$(MAKEINFO) $(srcdir)/dvc.texinfo

137
dvc/texinfo/dvc-intro.texinfo
View File

@ -14,7 +14,7 @@ distributed version control systems.
@smallexample
@group
Copyright (C) 2007, 2008, 2009, 2010 Stephen Leake
Copyright (C) 2007 - 2011 Stephen Leake
Permission is granted to copy, distribute and/or modify this document
under the terms of the GNU Free Documentation License, Version 1.2
or any later version published by the Free Software Foundation;
@ -48,6 +48,10 @@ Invoking
* xmtn-status-one::
* xmtn-propagate-one::
<<<<<<< TREE
=======
* xmtn-sync-review::
>>>>>>> MERGE-SOURCE
Key bindings
@ -102,6 +106,9 @@ and managing branches require command line operations.
This manual describes the DVC user interface, and gives examples of
some required command line operations, using the monotone backend.
It also describes some DVC extensions that are specific to the
monotone backend.
@menu
* Basic DVC::
* Compare to CVS::
@ -116,7 +123,7 @@ use DVC, and providing common terminology.
Each backend will have its own documentation, and terminology that
differs from this. The terms here are taken mostly from the monotone
backend, since it has the most readable user manual.
backend.
Let's start with some definitions:
@ -144,9 +151,10 @@ The user interacts with the remote database in order to retrieve other
user's files, or deliver files to them.
@item revision
A set of changes to files that are applied together. Most operations
on the database involve revisions, and all changes to files are part
of a revision.
The state of the entire workspace, usually including the set of
changes to the workspace that transform it from the previous
revision. Most operations on the database involve revisions, and all
changes to files are part of a revision.
@item branch
A label for distinct trees of revisions. There are two main uses for
@ -159,7 +167,7 @@ A database can store any number of branches.
@item heads
The revisions that are the leaves of the history tree on a single
branch. In monotone, there can be any number of heads (see
branch. In monotone, there can be any number of heads on a branch (see
@ref{Merging}).
@item merge
@ -190,7 +198,7 @@ The name of the buffer is not literally @dfn{*dvc-status*}; instead,
@dfn{*dvc-status*}.
@item *dvc-diff* buffer
Another main user interface buffer. It shows the files involved in a
Another main user interface buffer. It shows the files changed in a
particular revision, together with the diffs of the changes. Single
keystrokes invoke various operations.
@ -284,31 +292,40 @@ Similar to @command{xmtn-status-one}, but shows all workspaces
immediately under a root directory.
@item xmtn-propagate-one
Summarizes the status of several workspaces
Supervises propagating one workspace.
@item xmtn-propagate-multiple
Supervises propagating several workspaces
Supervises propagating several workspaces.
<<<<<<< TREE
=======
@item xmtn-sync-sync
Syncs a local database with a remote database, displays branches that
have been transferred.
Syncs the local database with a remote database, then runs
xmtn-sync-review.
@item xmtn-sync-review
Reviews saved output of an external @command{mtn automate sync},
Reviews saved output of a command-line @command{mtn automate sync},
displays branches that have been transferred. This is useful for syncs
<<<<<<< TREE
that take a long time, because external commands display the tickers
much better than DVC does.
The external sync should redirect stdout to @file{~/.dvc/sync.basic_io}.
>>>>>>> MERGE-SOURCE
=======
that take a long time, because the command-line displays progress
tickers.
>>>>>>> MERGE-SOURCE
@end table
@menu
* xmtn-status-one::
* xmtn-propagate-one::
<<<<<<< TREE
=======
* xmtn-sync-review::
>>>>>>> MERGE-SOURCE
@end menu
@node xmtn-status-one
@ -344,9 +361,13 @@ Perform the merge, using the conflict resolutions.
@item update
Update the workspace to the current head revision (must be merged).
@item review update
Open an @dfn{*xmtn-revlist*} buffer to review the revisions in the
most recent update.
@item update preview
Open an @dfn{*xmtn-revlist*} buffer to review the revisions that will
be included in the next update.
@item update review
Open an @dfn{*xmtn-revlist*} buffer to review the revisions that were
included in the most recent update.
@item ignore local changes
Don't show @dfn{commit}.
@ -374,10 +395,6 @@ propagation of all workspaces immediately under two root
directories. This is useful when several related projects branch
together.
Before displaying actions, each branch pair is examined to see if
propagate is necessary. If it is not, the workspace is not examined
for changes (since that can take a long time).
In the list of actions, ``from'' stands for the name of the source
branch, ``to'' the name of the destination branch.
@ -388,18 +405,18 @@ The possible actions are:
@item status ``from''
@itemx status ``to''
Start an @dfn{xmtn-multi-status} buffer for the specified workspace,
to allow commit, update followed by update review, or merge with
to allow commit, update preview, or merge with
conflict resolution.
@itemx update ``to''
Update the specified workspace to the current head revision (must be
merged). This bypasses the @dfn{xmtn-multi-status} buffer, and
therefore does not provide for update review. Useful when you don't
need to review the changes, which is the typical case for propagate.
therefore does not provide for update preview. It does allow for
update review.
@item ignore local changes ``from''
@item ignore local changes ``to''
Don't show @dfn{local changes unknown}; assume the workspace is
Don't show @dfn{need commit}; assume the workspace is
committed. Useful when you know that any local changes won't interfere
with the propagate.
@ -420,6 +437,80 @@ the workspace from the display.
@end table
<<<<<<< TREE
=======
@node xmtn-sync-review
@section xmtn-sync-review
@command{xmtn-sync-review} supervises the process of updating local
workspaces after a command line operation that synchronizes the local
and remote databases.
The command line operation should redirect stdout to
@file{~/.dvc/sync.basic_io}. Most users will want to define shell
functions to invoke common syncs. For example:
@example
mtn --db ~/monotone-dbs/gds.db automate sync --ticker=count "ssh:user@@host/gds.db?*" >> ~/.dvc/sync.basic_io
@end example
The @command{xmtn-sync-review} display shows each branch that was
transferred, with a count of how many revisions were sent and
received.
The user may set the variable @code{xmtn-sync-sort} to a function that
indicates how to order the branches in the display.
Actions on branches are invoked with @key{M-d}.
The possible branch actions are:
@table @command
@item status
Start an @dfn{xmtn-multi-status} buffer for the workspace assoicated
with the specified branch, to allow commit, update preview, update
followed by update review, or merge with conflict resolution.
The user may set the variable @code{xmtn-sync-guess-workspace} to a
function that returns a workspace given a branch. Otherwise, the user
is prompted for the workspace location; the location is cached for
future use.
@item update
Start an @dfn{xmtn-multi-status} buffer for the workspace assoicated
with the specified branch, then perform @command{update} (if
appropriate). This is often convenient when you know the workspace has
no local changes.
@itemx brief
Show the first line of the changelog for each revision received.
@itemx full
Show the complete changelog for each revision received.
@item clean
Delete the branch from the display.
Branches that are not cleaned are cached; they will reappear the next
time @code{xmtn-sync-review} is run.
@end table
In addition, there are global actions:
@table @command
@item next
Move to the next branch
@item prev
Move to the previous branch
@item save-quit
Save the displayed branches, quit.
@item save
Save the displayed branches.
@end table
>>>>>>> MERGE-SOURCE
@node Status Display
@chapter Status Display