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

update dvc

Browse Source
This commit is contained in:
Kai Tetzlaff 2010-09-12 22:16:14 +02:00
parent 0c9e5fe4b8
commit ec24bef5a4
14 changed files with 2155 additions and 471 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
dvc/lisp/dvc-core.el
View File

@ -554,10 +554,11 @@ used to get more info about the process.")
(defun dvc-build-dvc-command (dvc list-args) (defun dvc-build-dvc-command (dvc list-args)
"Build a shell command to run DVC with args LIST-ARGS. "Build a shell command to run DVC with args LIST-ARGS.
DVC can be one of 'baz, 'xhg, ..." DVC can be one of 'baz, 'xhg, ..."
(let ((executable (executable-find (dvc-variable dvc "executable")))) (let* ((name (dvc-variable dvc "executable"))
(executable (executable-find name)))
;; 'executable-find' allows leading ~ ;; 'executable-find' allows leading ~
(if (not executable) (if (not executable)
(error "executable for %s not found" (symbol-name dvc))) (error "executable %s for %s not found" name (symbol-name dvc)))
(mapconcat 'shell-quote-argument (mapconcat 'shell-quote-argument
(cons executable (cons executable
(remq nil list-args)) (remq nil list-args))

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

@ -54,7 +54,7 @@
;; is options, cdr is the command and arguments. Options are always ;; is options, cdr is the command and arguments. Options are always
;; specified as pairs of keyword and value, and without the leading ;; specified as pairs of keyword and value, and without the leading
;; "--". If an option has no value, use ""; see ;; "--". If an option has no value, use ""; see
;; xmtn-automate-local-changes for an example. ;; xmtn--status-inventory-sync in xmtn-dvc for an example.
;; ;;
;; `xmtn-automate-new-command' returns a command handle. You use this ;; `xmtn-automate-new-command' returns a command handle. You use this
;; handle to check the error code of the command and obtain its ;; handle to check the error code of the command and obtain its
@ -74,6 +74,9 @@
(require 'xmtn-run) (require 'xmtn-run)
(require 'xmtn-compat)) (require 'xmtn-compat))
(defconst xmtn-automate-arguments (list "--rcfile" (locate-library "xmtn-hooks.lua"))
"Arguments and options for 'mtn automate stdio' sessions.")
(defun xmtn-automate-command-buffer (command) (defun xmtn-automate-command-buffer (command)
(xmtn-automate--command-handle-buffer command)) (xmtn-automate--command-handle-buffer command))
@ -92,7 +95,10 @@
(goto-char (point-max)) (goto-char (point-max))
(newline) (newline)
(insert (format "command: %s" (xmtn-automate--command-handle-command handle))) (insert (format "command: %s" (xmtn-automate--command-handle-command handle)))
(error "mtn error %s" (xmtn-automate--command-handle-error-code handle)))) (error "mtn error %s" (xmtn-automate--command-handle-error-code handle)))
(if (xmtn-automate--command-handle-warnings handle)
(display-buffer (format dvc-error-buffer 'xmtn) t))
)
nil) nil)
(defvar xmtn-automate--*sessions* '() (defvar xmtn-automate--*sessions* '()
@ -132,7 +138,7 @@ workspace root."
(xmtn-automate-command-wait-until-finished command-handle) (xmtn-automate-command-wait-until-finished command-handle)
(xmtn-automate--command-output-as-string command-handle))) (xmtn-automate--command-output-as-string command-handle)))
(defun xmtn-automate-simple-command-output-insert-into-buffer (defun xmtn-automate-command-output-buffer
(root buffer command) (root buffer command)
"Send COMMAND to session for ROOT, insert result into BUFFER." "Send COMMAND to session for ROOT, insert result into BUFFER."
(let* ((session (xmtn-automate-cache-session root)) (let* ((session (xmtn-automate-cache-session root))
@ -217,7 +223,8 @@ Signals an error if output contains zero lines or more than one line."
(buffer) (buffer)
(write-marker) (write-marker)
(finished-p nil) (finished-p nil)
(error-code nil)) (error-code nil)
(warnings nil))
(defun* xmtn-automate--initialize-session (session &key root name) (defun* xmtn-automate--initialize-session (session &key root name)
(xmtn--assert-optional (equal root (file-name-as-directory root)) t) (xmtn--assert-optional (equal root (file-name-as-directory root)) t)
@ -281,9 +288,11 @@ Signals an error if output contains zero lines or more than one line."
"Kill session for ROOT." "Kill session for ROOT."
(interactive) (interactive)
(let ((temp (assoc (dvc-uniquify-file-name root) xmtn-automate--*sessions*))) (let ((temp (assoc (dvc-uniquify-file-name root) xmtn-automate--*sessions*)))
;; session may have already been killed
(when temp
(xmtn-automate--close-session (cdr temp)) (xmtn-automate--close-session (cdr temp))
(setq xmtn-automate--*sessions* (setq xmtn-automate--*sessions*
(delete temp xmtn-automate--*sessions* )))) (delete temp xmtn-automate--*sessions* )))))
(defun xmtn-kill-all-sessions () (defun xmtn-kill-all-sessions ()
"Kill all xmtn-automate sessions." "Kill all xmtn-automate sessions."
@ -305,7 +314,7 @@ Signals an error if output contains zero lines or more than one line."
(default-directory root)) (default-directory root))
(let ((process (let ((process
(apply 'start-process name buffer xmtn-executable (apply 'start-process name buffer xmtn-executable
"automate" "stdio" xmtn-additional-arguments))) "automate" "stdio" xmtn-automate-arguments)))
(ecase (process-status process) (ecase (process-status process)
(run (run
;; If the process started ok, it outputs the stdio ;; If the process started ok, it outputs the stdio
@ -472,11 +481,14 @@ Return non-nil if some text copied."
(?m (?m
(xmtn-automate--command-handle-buffer command)) (xmtn-automate--command-handle-buffer command))
((?e ?w ?p ?t) ((?e ?w ?p ?t)
(if (equal ?w (xmtn-automate--decoder-state-stream state))
(setf (xmtn-automate--command-handle-warnings command) t))
;; probably ought to do something else with p and t, but ;; probably ought to do something else with p and t, but
;; this is good enough for now. ;; this is good enough for now.
(get-buffer-create (format dvc-error-buffer 'xmtn))))) (get-buffer-create (format dvc-error-buffer 'xmtn)))))
(write-marker (write-marker
(xmtn-automate--command-handle-write-marker command))) (xmtn-automate--command-handle-write-marker command)))
(with-current-buffer session-buffer (with-current-buffer session-buffer
(let* ((end (min (+ (xmtn-automate--decoder-state-read-marker state) (let* ((end (min (+ (xmtn-automate--decoder-state-read-marker state)
(xmtn-automate--decoder-state-remaining-chars state)) (xmtn-automate--decoder-state-remaining-chars state))
@ -535,16 +547,19 @@ Return non-nil if some text copied."
(if (= (xmtn-automate--decoder-state-read-marker state) write-marker) (if (= (xmtn-automate--decoder-state-read-marker state) write-marker)
(setq tag 'exit-loop) (setq tag 'exit-loop)
(setq tag 'again))) (setq tag 'again)))
(again (again
(cond (cond
((> (xmtn-automate--decoder-state-remaining-chars state) 0) ((> (xmtn-automate--decoder-state-remaining-chars state) 0)
;; copy more output from the current packet (if (= ?l (xmtn-automate--decoder-state-stream state))
;; got the rest of the last packet; process in t branch next loop
(setf (xmtn-automate--decoder-state-remaining-chars state) 0)
(if (xmtn-automate--process-new-output--copy session) (if (xmtn-automate--process-new-output--copy session)
(setq tag 'again) (setq tag 'again)
(setq tag 'check-for-more))) (setq tag 'check-for-more))))
(t (t
;; new packet ;; new packet, or final packet
(goto-char (xmtn-automate--decoder-state-read-marker state)) (goto-char (xmtn-automate--decoder-state-read-marker state))
;; A packet has the structure: ;; A packet has the structure:
;; <command number>:<stream>:<size>:<output> ;; <command number>:<stream>:<size>:<output>
@ -555,21 +570,21 @@ Return non-nil if some text copied."
;; p progress ;; p progress
;; t ticker ;; t ticker
;; l last ;; l last
;;
;; If size is large, we may not have all of the output in new-string
(cond (cond
((looking-at "\\([0-9]+\\):\\([mewptl]\\):\\([0-9]+\\):") ((looking-at "\\([0-9]+\\):\\([mewptl]\\):\\([0-9]+\\):")
(let ((command-number (parse-integer (match-string 1))) (let ((stream (aref (match-string 2) 0))
(stream (aref (match-string 2) 0))
(size (parse-integer (match-string 3)))) (size (parse-integer (match-string 3))))
(setf (xmtn-automate--decoder-state-read-marker state) (match-end 0)) (setf (xmtn-automate--decoder-state-remaining-chars state) size)
(setf (xmtn-automate--decoder-state-stream state) stream) (setf (xmtn-automate--decoder-state-stream state) stream)
(ecase stream (ecase stream
((?m ?e ?w ?t ?p) ((?m ?e ?w ?t ?p)
(setf (xmtn-automate--decoder-state-remaining-chars state) size) (setf (xmtn-automate--decoder-state-read-marker state) (match-end 0))
(setq tag 'again) ) (setq tag 'again) )
(?l (?l
(if (> (+ size (match-end 0)) (point-max))
;; do not have the error code yet
(setq tag 'exit-loop)
(setf (xmtn-automate--decoder-state-read-marker state) (+ size (match-end 0))) (setf (xmtn-automate--decoder-state-read-marker state) (+ size (match-end 0)))
(setf (xmtn-automate--command-handle-error-code command) (setf (xmtn-automate--command-handle-error-code command)
(parse-integer (parse-integer
@ -581,20 +596,24 @@ Return non-nil if some text copied."
(pop (xmtn-automate--session-remaining-command-handles session))) (pop (xmtn-automate--session-remaining-command-handles session)))
(if (xmtn-automate--session-closed-p session) (if (xmtn-automate--session-closed-p session)
(setq tag 'exit-loop) (setq tag 'exit-loop)
(setq tag 'check-for-more)) (setq tag 'check-for-more)))
) )
))) )))
(t (t
;; Not a packet. Most likely we are at the end of the ;; Not a packet yet, or garbage in the stream from some
;; buffer, and there is more output coming soon. FIXME: ;; Lua hook. Most likely we are at the end of the
;; this means the loop logic screwed up. ;; buffer, don't have a complete header, and there is
(if (= (point) (point-max)) ;; more output coming soon. A packet header has at least
;; 6 bytes; allowing 4 digits per integer takes that to
;; 12.
(if (> 12 (- (point-max) (point)))
(setq tag 'exit-loop) (setq tag 'exit-loop)
(error "Unexpected output from mtn at '%s':%d:'%s'" (error "Unexpected output from mtn at '%s':%d:'%s'"
(current-buffer) (current-buffer)
(point) (point)
(buffer-substring (point) (line-end-position))))))))) (buffer-substring (point) (min (point-max) (+ (point) 100))))
))))))
(exit-loop (return)))))) (exit-loop (return))))))
nil) nil)
@ -652,11 +671,13 @@ Each element of the list is a list; key, signature, name, value, trust."
accu)) accu))
(defun xmtn--heads (root branch) (defun xmtn--heads (root branch)
;; apparently stdio automate doesn't default arguments properly; (xmtn-automate-simple-command-output-lines
;; this fails if branch is not passed to mtn. root
(xmtn-automate-simple-command-output-lines root (list "heads" (cons
(list "ignore-suspend-certs" "")
(list "heads"
(or branch (or branch
(xmtn--tree-default-branch root))))) (xmtn--tree-default-branch root))))))
(defun xmtn--tree-default-branch (root) (defun xmtn--tree-default-branch (root)
(xmtn-automate-simple-command-output-line root `("get_option" "branch"))) (xmtn-automate-simple-command-output-line root `("get_option" "branch")))
@ -677,24 +698,6 @@ Each element of the list is a list; key, signature, name, value, trust."
(assert (null (funcall next-stanza))) (assert (null (funcall next-stanza)))
result)))) result))))
(defun xmtn-automate-local-changes (work)
"Summary of status for WORK; 'ok if no changes, 'need-commit if changes."
(let ((default-directory work)
(msg "checking %s for local changes ..."))
(message msg work)
(let ((result (xmtn-automate-simple-command-output-string
default-directory
(list (list "no-unchanged" "" "no-ignored" "")
"inventory"))))
(message (concat msg " done") work)
(if (> (length result) 0)
'need-commit
'ok))))
(provide 'xmtn-automate) (provide 'xmtn-automate)
;;; xmtn-automate.el ends here ;;; xmtn-automate.el ends here

15
dvc/lisp/xmtn-base.el
View File

@ -1,6 +1,6 @@
;;; xmtn-base.el --- Basic definitions for accessing monotone ;;; xmtn-base.el --- Basic definitions for accessing monotone
;; Copyright (C) 2009 Stephen Leake ;; Copyright (C) 2009, 2010 Stephen Leake
;; Copyright (C) 2006, 2007, 2009 Christian M. Ohler ;; Copyright (C) 2006, 2007, 2009 Christian M. Ohler
;; Author: Christian M. Ohler ;; Author: Christian M. Ohler
@ -35,11 +35,7 @@
(require 'cl)) (require 'cl))
(defvar xmtn-executable "mtn" (defvar xmtn-executable "mtn"
"*The monotone executable command. "*The monotone executable command.")
After changing the value of this variable, be sure to run
`xmtn-check-command-version' to clear xmtn's command version
cache.")
(defvar xmtn-additional-arguments '() (defvar xmtn-additional-arguments '()
"*Additional arguments to pass to monotone. "*Additional arguments to pass to monotone.
@ -59,15 +55,16 @@ A list of strings.")
(save-match-data (save-match-data
(string-match "\\`[0-9a-f]\\{40\\}\\'" thing)))) (string-match "\\`[0-9a-f]\\{40\\}\\'" thing))))
(defun xmtn--filter-non-dir (dir) (defun xmtn--filter-non-ws (dir)
"Return list of all directories in DIR, excluding '.', '..'." "Return list of all mtn workspaces in DIR."
(let ((default-directory dir) (let ((default-directory dir)
(subdirs (directory-files dir))) (subdirs (directory-files dir)))
(setq subdirs (setq subdirs
(mapcar (lambda (filename) (mapcar (lambda (filename)
(if (and (file-directory-p filename) (if (and (file-directory-p filename)
(not (string= "." filename)) (not (string= "." filename))
(not (string= ".." filename))) (not (string= ".." filename))
(file-directory-p (concat filename "/_MTN")))
filename)) filename))
subdirs)) subdirs))
(delq nil subdirs))) (delq nil subdirs)))

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

@ -20,7 +20,7 @@
;; the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, ;; the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor,
;; Boston, MA 02110-1301 USA. ;; Boston, MA 02110-1301 USA.
(eval-and-compile (eval-when-compile
;; these have macros we use ;; these have macros we use
(require 'cl) (require 'cl)
(require 'dvc-utils) (require 'dvc-utils)
@ -29,7 +29,7 @@
(require 'xmtn-ids) (require 'xmtn-ids)
(require 'xmtn-run)) (require 'xmtn-run))
(eval-when-compile (eval-and-compile
;; these have functions we use ;; these have functions we use
(require 'dired)) (require 'dired))
@ -103,8 +103,8 @@
(defstruct (xmtn-conflicts-conflict (defstruct (xmtn-conflicts-conflict
(:copier nil)) (:copier nil))
;; not worth splitting this into a type hierarchy; differences are ;; not worth splitting this into a type hierarchy; differences are
;; minor some fields are nil for some conflict types ;; minor. Some fields are nil for some conflict types.
;; single file conflicts only set left_resolution ;; Single file conflicts only set left_resolution
conflict_type ;; 'content | 'duplicate_name | 'orphaned_node conflict_type ;; 'content | 'duplicate_name | 'orphaned_node
ancestor_name ancestor_name
@ -278,6 +278,16 @@ header."
;; right_type "added directory" ;; right_type "added directory"
;; right_name "utils" ;; right_name "utils"
;; ;;
;; conflict duplicate_name
;; left_type "added file"
;; left_name "build/x86_gnu_windows_release/gds_mms_test.gpr"
;; left_file_id [8d5d8fd099442bfb5d636d6435c241c8cd83f4f9]
;; right_type "renamed file"
;; ancestor_name "build/x86_gnu_windows_release/gds_test.gpr"
;; ancestor_file_id [e2eb7393d9cda23a467622744a392adde63fc850]
;; right_name "build/x86_gnu_windows_release/gds_mms_test.gpr"
;; right_file_id [cec70e80402418bb95dcdeb6abe1356084ff5ece]
;;
;; optional left and right resolutions: ;; optional left and right resolutions:
;; resolved_keep{_left | _right} ;; resolved_keep{_left | _right}
;; resolved_drop{_left | _right} ;; resolved_drop{_left | _right}
@ -286,24 +296,39 @@ header."
(let ((conflict (make-xmtn-conflicts-conflict))) (let ((conflict (make-xmtn-conflicts-conflict)))
(setf (xmtn-conflicts-conflict-conflict_type conflict) 'duplicate_name) (setf (xmtn-conflicts-conflict-conflict_type conflict) 'duplicate_name)
(xmtn-basic-io-check-line "left_type" (setf (xmtn-conflicts-conflict-left_type conflict) (cadar value))) (xmtn-basic-io-check-line "left_type" (setf (xmtn-conflicts-conflict-left_type conflict) (cadar value)))
(xmtn-basic-io-check-line "left_name" (setf (xmtn-conflicts-conflict-left_name conflict) (cadar value)))
(xmtn-basic-io-parse-line
(cond (cond
((string= "left_file_id" symbol) ((string= "added file" (xmtn-conflicts-conflict-left_type conflict))
(setf (xmtn-conflicts-conflict-left_file_id conflict) (cadar value)) (xmtn-basic-io-check-line "left_name" (setf (xmtn-conflicts-conflict-left_name conflict) (cadar value)))
(xmtn-basic-io-check-line "right_type" (xmtn-basic-io-check-line "left_file_id" (setf (xmtn-conflicts-conflict-left_file_id conflict) (cadar value))))
(setf (xmtn-conflicts-conflict-right_type conflict) (cadar value)))
(xmtn-basic-io-check-line "right_name" ((string= "added directory" (xmtn-conflicts-conflict-left_type conflict))
(setf (xmtn-conflicts-conflict-right_name conflict) (cadar value))) (xmtn-basic-io-check-line "left_name" (setf (xmtn-conflicts-conflict-left_name conflict) (cadar value))))
(xmtn-basic-io-check-line "right_file_id"
(setf (xmtn-conflicts-conflict-right_file_id conflict) (cadar value)))) ((string= "renamed file" (xmtn-conflicts-conflict-left_type conflict))
(xmtn-basic-io-check-line "ancestor_name" (setf (xmtn-conflicts-conflict-ancestor_name conflict) (cadar value)))
(xmtn-basic-io-check-line "ancestor_file_id" (setf (xmtn-conflicts-conflict-ancestor_file_id conflict) (cadar value)))
(xmtn-basic-io-check-line "left_name" (setf (xmtn-conflicts-conflict-left_name conflict) (cadar value)))
(xmtn-basic-io-check-line "left_file_id" (setf (xmtn-conflicts-conflict-left_file_id conflict) (cadar value))))
((string= "right_type" symbol)
(setf (xmtn-conflicts-conflict-right_type conflict) (cadar value))
(xmtn-basic-io-check-line "right_name"
(setf (xmtn-conflicts-conflict-right_name conflict) (cadar value))))
(t (t
(error "found %s" symbol)))) (error "unsupported left_type %s" (xmtn-conflicts-conflict-left_type conflict))))
(xmtn-basic-io-check-line "right_type" (setf (xmtn-conflicts-conflict-right_type conflict) (cadar value)))
(cond
((string= "added file" (xmtn-conflicts-conflict-right_type conflict))
(xmtn-basic-io-check-line "right_name" (setf (xmtn-conflicts-conflict-right_name conflict) (cadar value)))
(xmtn-basic-io-check-line "right_file_id" (setf (xmtn-conflicts-conflict-right_file_id conflict) (cadar value))))
((string= "added directory" (xmtn-conflicts-conflict-right_type conflict))
(xmtn-basic-io-check-line "right_name" (setf (xmtn-conflicts-conflict-right_name conflict) (cadar value))))
((string= "renamed file" (xmtn-conflicts-conflict-right_type conflict))
(xmtn-basic-io-check-line "ancestor_name" (setf (xmtn-conflicts-conflict-ancestor_name conflict) (cadar value)))
(xmtn-basic-io-check-line "ancestor_file_id" (setf (xmtn-conflicts-conflict-ancestor_file_id conflict) (cadar value)))
(xmtn-basic-io-check-line "right_name" (setf (xmtn-conflicts-conflict-right_name conflict) (cadar value)))
(xmtn-basic-io-check-line "right_file_id" (setf (xmtn-conflicts-conflict-right_file_id conflict) (cadar value))))
(t
(error "unsupported right_type %s" (xmtn-conflicts-conflict-right_type conflict))))
;; look for a left resolution ;; look for a left resolution
(case (xmtn-basic-io--peek) (case (xmtn-basic-io--peek)
@ -531,14 +556,39 @@ header."
(insert ?\n) (insert ?\n)
(xmtn-basic-io-write-sym "conflict" "duplicate_name") (xmtn-basic-io-write-sym "conflict" "duplicate_name")
(xmtn-basic-io-write-str "left_type" (xmtn-conflicts-conflict-left_type conflict)) (xmtn-basic-io-write-str "left_type" (xmtn-conflicts-conflict-left_type conflict))
(cond
((string= "added file" (xmtn-conflicts-conflict-left_type conflict))
(xmtn-basic-io-write-str "left_name" (xmtn-conflicts-conflict-left_name conflict)) (xmtn-basic-io-write-str "left_name" (xmtn-conflicts-conflict-left_name conflict))
(if (xmtn-conflicts-conflict-left_file_id conflict)
(xmtn-basic-io-write-id "left_file_id" (xmtn-conflicts-conflict-left_file_id conflict))) (xmtn-basic-io-write-id "left_file_id" (xmtn-conflicts-conflict-left_file_id conflict)))
((string= "added directory" (xmtn-conflicts-conflict-left_type conflict))
(xmtn-basic-io-write-str "left_name" (xmtn-conflicts-conflict-left_name conflict)))
((string= "renamed file" (xmtn-conflicts-conflict-left_type conflict))
(xmtn-basic-io-write-str "ancestor_name" (xmtn-conflicts-conflict-ancestor_name conflict))
(xmtn-basic-io-write-id "ancestor_file_id" (xmtn-conflicts-conflict-ancestor_file_id conflict))
(xmtn-basic-io-write-str "left_name" (xmtn-conflicts-conflict-left_name conflict))
(xmtn-basic-io-write-id "left_file_id" (xmtn-conflicts-conflict-left_file_id conflict)))
(t
(error "unsupported left_type %s" (xmtn-conflicts-conflict-left_type conflict))))
(xmtn-basic-io-write-str "right_type" (xmtn-conflicts-conflict-right_type conflict)) (xmtn-basic-io-write-str "right_type" (xmtn-conflicts-conflict-right_type conflict))
(cond
((string= "added file" (xmtn-conflicts-conflict-right_type conflict))
(xmtn-basic-io-write-str "right_name" (xmtn-conflicts-conflict-right_name conflict)) (xmtn-basic-io-write-str "right_name" (xmtn-conflicts-conflict-right_name conflict))
(if (xmtn-conflicts-conflict-right_file_id conflict)
(xmtn-basic-io-write-id "right_file_id" (xmtn-conflicts-conflict-right_file_id conflict))) (xmtn-basic-io-write-id "right_file_id" (xmtn-conflicts-conflict-right_file_id conflict)))
((string= "added directory" (xmtn-conflicts-conflict-right_type conflict))
(xmtn-basic-io-write-str "right_name" (xmtn-conflicts-conflict-right_name conflict)))
((string= "renamed file" (xmtn-conflicts-conflict-right_type conflict))
(xmtn-basic-io-write-str "ancestor_name" (xmtn-conflicts-conflict-ancestor_name conflict))
(xmtn-basic-io-write-id "ancestor_file_id" (xmtn-conflicts-conflict-ancestor_file_id conflict))
(xmtn-basic-io-write-str "right_name" (xmtn-conflicts-conflict-right_name conflict))
(xmtn-basic-io-write-id "right_file_id" (xmtn-conflicts-conflict-right_file_id conflict)))
(t
(error "unsupported right_type %s" (xmtn-conflicts-conflict-right_type conflict))))
(if (xmtn-conflicts-conflict-left_resolution conflict) (if (xmtn-conflicts-conflict-left_resolution conflict)
(ecase (car (xmtn-conflicts-conflict-left_resolution conflict)) (ecase (car (xmtn-conflicts-conflict-left_resolution conflict))
(resolved_keep (resolved_keep
@ -987,6 +1037,17 @@ header."
;; if no file_id, it's a directory; can't drop if not empty ;; if no file_id, it's a directory; can't drop if not empty
(xmtn-conflicts-conflict-right_file_id conflict)))) (xmtn-conflicts-conflict-right_file_id conflict))))
(defun xmtn-conflicts-left-label ()
"Return 'left: ' or '' as appropriate for current conflict."
(let* ((conflict (ewoc-data (ewoc-locate xmtn-conflicts-ewoc)))
(type (xmtn-conflicts-conflict-conflict_type conflict)))
;; duplicate_name is the only conflict type that needs a right
;; resolution, and thus a 'left' label
(if (equal type 'duplicate_name)
"left: "
"")))
(defvar xmtn-conflicts-resolve-map (defvar xmtn-conflicts-resolve-map
(let ((map (make-sparse-keymap "resolution"))) (let ((map (make-sparse-keymap "resolution")))
(define-key map [?c] '(menu-item "c) clear resolution" (define-key map [?c] '(menu-item "c) clear resolution"
@ -995,55 +1056,55 @@ header."
;; Don't need 'left' or 'right' in menu, since only one is ;; Don't need 'left' or 'right' in menu, since only one is
;; visible; then this works better for single file conflicts. ;; visible; then this works better for single file conflicts.
(define-key map [?b] '(menu-item "b) drop" (define-key map [?b] '(menu-item "b) right: drop"
xmtn-conflicts-resolve-drop_right xmtn-conflicts-resolve-drop_right
:visible (xmtn-conflicts-resolve-drop_rightp))) :visible (xmtn-conflicts-resolve-drop_rightp)))
(define-key map [?a] '(menu-item "a) rename" (define-key map [?a] '(menu-item "a) right: rename"
(lambda () (lambda ()
(interactive) (interactive)
(xmtn-conflicts-resolve-rename 'right)) (xmtn-conflicts-resolve-rename 'right))
:visible (xmtn-conflicts-resolve-rename_rightp))) :visible (xmtn-conflicts-resolve-rename_rightp)))
(define-key map [?9] '(menu-item "9) right file" (define-key map [?9] '(menu-item "9) right: right file"
(lambda () (lambda ()
(interactive) (interactive)
(xmtn-conflicts-resolve-user 'right 'right)) (xmtn-conflicts-resolve-user 'right 'right))
:visible (xmtn-conflicts-resolve-user_rightp))) :visible (xmtn-conflicts-resolve-user_rightp)))
(define-key map [?8] '(menu-item "8) left file" (define-key map [?8] '(menu-item "8) right: left file"
(lambda () (lambda ()
(interactive) (interactive)
(xmtn-conflicts-resolve-user 'right 'left)) (xmtn-conflicts-resolve-user 'right 'left))
:visible (xmtn-conflicts-resolve-user_rightp))) :visible (xmtn-conflicts-resolve-user_rightp)))
(define-key map [?7] '(menu-item "7) keep" (define-key map [?7] '(menu-item "7) right: keep"
xmtn-conflicts-resolve-keep_right xmtn-conflicts-resolve-keep_right
:visible (xmtn-conflicts-resolve-keep_rightp))) :visible (xmtn-conflicts-resolve-keep_rightp)))
(define-key map [?6] '(menu-item "6) ediff" (define-key map [?6] '(menu-item "6) right: ediff"
(lambda () (lambda ()
(interactive) (interactive)
(xmtn-conflicts-resolve-ediff 'right)) (xmtn-conflicts-resolve-ediff 'right))
:visible (xmtn-conflicts-resolve-user_rightp))) :visible (xmtn-conflicts-resolve-user_rightp)))
(define-key map [?5] '(menu-item "5) right file" (define-key map [?5] '(menu-item (concat "5) " (xmtn-conflicts-left-label) "right file")
(lambda () (lambda ()
(interactive) (interactive)
(xmtn-conflicts-resolve-user 'left 'right)) (xmtn-conflicts-resolve-user 'left 'right))
:visible (xmtn-conflicts-resolve-user_leftp))) :visible (xmtn-conflicts-resolve-user_leftp)))
(define-key map [?4] '(menu-item "4) left file" (define-key map [?4] '(menu-item (concat "4) " (xmtn-conflicts-left-label) "left file")
(lambda () (lambda ()
(interactive) (interactive)
(xmtn-conflicts-resolve-user 'left 'left)) (xmtn-conflicts-resolve-user 'left 'left))
:visible (xmtn-conflicts-resolve-user_leftp))) :visible (xmtn-conflicts-resolve-user_leftp)))
(define-key map [?3] '(menu-item "3) drop" (define-key map [?3] '(menu-item (concat "3) " (xmtn-conflicts-left-label) "drop")
xmtn-conflicts-resolve-drop_left xmtn-conflicts-resolve-drop_left
:visible (xmtn-conflicts-resolve-drop_leftp))) :visible (xmtn-conflicts-resolve-drop_leftp)))
(define-key map [?2] '(menu-item "2) rename" (define-key map [?2] '(menu-item (concat "2) " (xmtn-conflicts-left-label) "rename")
(lambda () (lambda ()
(interactive) (interactive)
(xmtn-conflicts-resolve-rename 'left)) (xmtn-conflicts-resolve-rename 'left))
:visible (xmtn-conflicts-resolve-rename_leftp))) :visible (xmtn-conflicts-resolve-rename_leftp)))
(define-key map [?1] '(menu-item "1) keep" (define-key map [?1] '(menu-item (concat "1) " (xmtn-conflicts-left-label) "keep")
xmtn-conflicts-resolve-keep_left xmtn-conflicts-resolve-keep_left
:visible (xmtn-conflicts-resolve-keep_leftp))) :visible (xmtn-conflicts-resolve-keep_leftp)))
(define-key map [?0] '(menu-item "0) ediff" (define-key map [?0] '(menu-item (concat "0) " (xmtn-conflicts-left-label) "ediff")
(lambda () (lambda ()
(interactive) (interactive)
(xmtn-conflicts-resolve-ediff 'left)) (xmtn-conflicts-resolve-ediff 'left))
@ -1147,10 +1208,6 @@ non-nil, show log-edit buffer in other frame."
;; Arrange for `revert-buffer' to do the right thing ;; Arrange for `revert-buffer' to do the right thing
(set (make-local-variable 'after-insert-file-functions) '(xmtn-conflicts-after-insert-file)) (set (make-local-variable 'after-insert-file-functions) '(xmtn-conflicts-after-insert-file))
;; don't do normal clean up stuff
(set (make-local-variable 'before-save-hook) nil)
(set (make-local-variable 'write-file-functions) nil)
(dvc-install-buffer-menu) (dvc-install-buffer-menu)
(setq buffer-read-only t) (setq buffer-read-only t)
(buffer-disable-undo) (buffer-disable-undo)

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

@ -583,12 +583,10 @@ otherwise newer."
(rename-source (rename-source
(setq more-status (setq more-status new-path))
(concat "to " new-path)))
(rename-target (rename-target
(setq more-status (setq more-status old-path))
(concat "from " old-path)))
(modified (modified
(if (and (equal status '(known)) (if (and (equal status '(known))
@ -724,13 +722,7 @@ otherwise newer."
(dvc-save-some-buffers root) (dvc-save-some-buffers root)
(lexical-let* ((status-buffer status-buffer)) (lexical-let* ((status-buffer status-buffer))
(xmtn--run-command-async (xmtn--run-command-async
root `("automate" "inventory" root (list "automate" "inventory" "--no-unchanged" "--no-ignored")
,@(and (xmtn--have-no-ignore)
(not dvc-status-display-known)
'("--no-unchanged"))
,@(and (xmtn--have-no-ignore)
(not dvc-status-display-ignored)
'("--no-ignored")))
:finished (lambda (output error status arguments) :finished (lambda (output error status arguments)
(dvc-status-inventory-done status-buffer) (dvc-status-inventory-done status-buffer)
(with-current-buffer status-buffer (with-current-buffer status-buffer
@ -769,6 +761,75 @@ otherwise newer."
arguments) arguments)
(current-buffer) error))))))) (current-buffer) error)))))))
(defun xmtn--status-inventory-sync (root)
"Create a status buffer for ROOT; return (buffer status), where status is 'ok or 'need-commit."
(let*
((orig-buffer (current-buffer))
(msg (concat "running inventory for " root " ..."))
(base-revision (xmtn--get-base-revision-hash-id-or-null root))
(branch (xmtn--tree-default-branch root))
(head-revisions (xmtn--heads root branch))
(head-count (length head-revisions))
(output-buffer (generate-new-buffer " *xmtn-inventory*"))
status
(dvc-switch-to-buffer-first nil)
(status-buffer
(dvc-status-prepare-buffer
'xmtn
root
;; base-revision
(if base-revision (format "%s" base-revision) "none")
;; branch
(format "%s" branch)
;; header-more
(lambda ()
(concat
(case head-count
(0 " branch is empty\n")
(1 " branch is merged\n")
(t (dvc-face-add (format " branch has %s heads; need merge\n" head-count) 'dvc-conflict)))
(if (member base-revision head-revisions)
" base revision is a head revision\n"
(dvc-face-add " base revision is not a head revision; need update\n" 'dvc-conflict))))
;; refresh
'xmtn-dvc-status)))
(dvc-save-some-buffers root)
(message msg)
(xmtn-automate-command-output-buffer
root output-buffer
(list (list "no-unchanged" "" "no-ignored" "")
"inventory"))
(with-current-buffer output-buffer
(setq status
(if (> (point-max) (point-min))
'need-commit
'ok)))
(dvc-status-inventory-done status-buffer)
(with-current-buffer status-buffer
(let ((excluded-files (dvc-default-excluded-files)))
(xmtn-basic-io-with-stanza-parser
(parser output-buffer)
(xmtn--parse-inventory
parser
(lambda (path status changes old-path new-path
old-type new-type fs-type)
(xmtn--status-process-entry dvc-fileinfo-ewoc
path status
changes
old-path new-path
old-type new-type
fs-type
excluded-files))))
(when (not (ewoc-locate dvc-fileinfo-ewoc))
(ewoc-enter-last dvc-fileinfo-ewoc
(make-dvc-fileinfo-message
:text (concat " no changes in workspace")))
(ewoc-refresh dvc-fileinfo-ewoc))))
(kill-buffer output-buffer)
(set-buffer orig-buffer)
(message (concat msg " done"))
(list status-buffer status)))
;;;###autoload ;;;###autoload
(defun xmtn-dvc-status () (defun xmtn-dvc-status ()
"Display status of monotone tree at `default-directory'." "Display status of monotone tree at `default-directory'."
@ -876,19 +937,8 @@ otherwise newer."
(let ((default-directory root)) (let ((default-directory root))
(mapcan (lambda (file-name) (mapcan (lambda (file-name)
(if (or (file-symlink-p file-name) (if (or (file-symlink-p file-name)
(xmtn--have-no-ignore)
(not (file-directory-p file-name))) (not (file-directory-p file-name)))
(list (xmtn--perl-regexp-for-file-name file-name)) (list (xmtn--perl-regexp-for-file-name file-name))))
;; If mtn automate inventory doesn't support
;; --no-ignore, it also recurses into unknown
;; directories, so we need to ignore files in
;; this directory as well as the directory
;; itself.
(setq file-name (directory-file-name file-name))
(list
(xmtn--perl-regexp-for-file-name file-name)
(xmtn--perl-regexp-for-files-in-directory file-name))))
normalized-file-names)) normalized-file-names))
t)))) t))))
@ -1117,6 +1167,8 @@ finished."
(progn (progn
"--resolve-conflicts-file=_MTN/conflicts"))) "--resolve-conflicts-file=_MTN/conflicts")))
(cmd (list "propagate" other local-branch resolve-conflicts (cmd (list "propagate" other local-branch resolve-conflicts
;; may be resurrecting a suspended branch; doesn't hurt otherwise.
"--ignore-suspend-certs"
(xmtn-dvc-log-message))) (xmtn-dvc-log-message)))
(prompt (prompt
(if resolve-conflicts (if resolve-conflicts
@ -1431,18 +1483,24 @@ finished."
(defun xmtn--insert-file-contents (root content-hash-id buffer) (defun xmtn--insert-file-contents (root content-hash-id buffer)
(check-type content-hash-id xmtn--hash-id) (check-type content-hash-id xmtn--hash-id)
(xmtn-automate-simple-command-output-insert-into-buffer (xmtn-automate-command-output-buffer
root buffer `("get_file" ,content-hash-id))) root buffer `("get_file" ,content-hash-id)))
(defun xmtn--insert-file-contents-by-name (root backend-id normalized-file-name buffer) (defun xmtn--insert-file-contents-by-name (root backend-id normalized-file-name buffer)
(let* ((resolved-id (xmtn--resolve-backend-id root backend-id)) (let* ((resolved-id (xmtn--resolve-backend-id root backend-id))
(hash-id (case (car resolved-id) (hash-id (case (car resolved-id)
(local-tree nil) (local-tree nil)
(revision (cadr resolved-id)))) (revision (cadr resolved-id)))))
(cmd (if hash-id (case (car backend-id)
((local-tree last-revision)
;; file may have been renamed but not committed
(setq normalized-file-name (xmtn--get-rename-in-workspace-to root normalized-file-name)))
(t nil))
(let ((cmd (if hash-id
(cons (list "revision" hash-id) (list "get_file_of" normalized-file-name)) (cons (list "revision" hash-id) (list "get_file_of" normalized-file-name))
(list "get_file_of" normalized-file-name)))) (list "get_file_of" normalized-file-name))))
(xmtn-automate-simple-command-output-insert-into-buffer root buffer cmd))) (xmtn-automate-command-output-buffer root buffer cmd))))
(defun xmtn--same-tree-p (a b) (defun xmtn--same-tree-p (a b)
(equal (file-truename a) (file-truename b))) (equal (file-truename a) (file-truename b)))

40
dvc/lisp/xmtn-hooks.lua Normal file
View File

@ -0,0 +1,40 @@
-- xmtn-hooks.lua --- mtn Lua hook functions used in all xmtn automate
-- stdio sessions
--
-- Copyright (C) 2010 Stephen Leake
--
-- Author: Stephen Leake
-- Keywords: tools
--
-- This file is free software; you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation; either version 2 of the License, or
-- (at your option) any later version.
--
-- This file is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-- GNU General Public License for more details.
--
-- You should have received a copy of the GNU General Public License
-- along with this file; see the file COPYING. If not, write to
-- the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor,
-- Boston, MA 02110-1301 USA.
function get_mtn_command(host)
-- Return a mtn command line for the remote host.
--
-- If the remote host is a Windows machine (ie file: on a Windows
-- machine), we need the Cygwin mtn executable, since the Win32
-- executable does not support file: or ssh:.
--
-- But we have no way to tell what the remote machine is. So we let
-- the lisp code figure that out from user options, and it provides
-- the mtn command to this hook by defining the XMTN_SYNC_MTN
-- environment variable.
return os.getenv("XMTN_SYNC_MTN");
end
-- end of file

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

@ -20,34 +20,38 @@
;; the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, ;; the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor,
;; Boston, MA 02110-1301 USA. ;; Boston, MA 02110-1301 USA.
(eval-and-compile (eval-when-compile
;; these have macros we use ;; these have macros we use
(require 'xmtn-ids)) (require 'xmtn-ids))
(eval-when-compile (eval-and-compile
;; these have functions we use ;; these have functions we use
(require 'xmtn-base) (require 'xmtn-base)
(require 'xmtn-conflicts)) (require 'xmtn-conflicts)
(require 'xmtn-revlist))
(defvar xmtn-status-root "" (defvar xmtn-status-root ""
"Buffer-local variable holding root directory.") "Buffer-local variable holding multi-workspace root directory.")
(make-variable-buffer-local 'xmtn-status-root) (make-variable-buffer-local 'xmtn-status-root)
(put 'xmtn-status-root 'permanent-local t) (put 'xmtn-status-root 'permanent-local t)
(defvar xmtn-status-ewoc nil (defvar xmtn-status-ewoc nil
"Buffer-local ewoc for displaying propagations. "Buffer-local ewoc for displaying multi-workspace status.
All xmtn-status functions operate on this ewoc. All xmtn-status functions operate on this ewoc.
The elements must all be of class xmtn-status-data.") The elements must all be of class xmtn-status-data.")
(make-variable-buffer-local 'xmtn-status-ewoc) (make-variable-buffer-local 'xmtn-status-ewoc)
(put 'xmtn-status-ewoc 'permanent-local t) (put 'xmtn-status-ewoc 'permanent-local t)
(defstruct (xmtn-status-data (:copier nil)) (defstruct (xmtn-status-data (:copier nil))
work ; directory name relative to xmtn-status-root work ; workspace directory name relative to xmtn-status-root
branch ; branch name (assumed never changes) branch ; branch name (all workspaces have same branch; assumed never changes)
need-refresh ; nil | t : if an async process was started that invalidates state data 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-rev ; nil | mtn rev string : current head revision, nil if multiple heads
conflicts-buffer ; *xmtn-conflicts* buffer for merge conflicts-buffer ; *xmtn-conflicts* buffer for merge
heads ; 'need-scan | 'at-head | 'need-update | 'need-merge) status-buffer ; *xmtn-status* buffer for commit
heads ; 'need-scan | 'at-head | 'need-update | 'need-merge
(update-review
'pending) ; 'pending | 'need-review | 'done
(local-changes (local-changes
'need-scan) ; 'need-scan | 'need-commit | 'ok 'need-scan) ; 'need-scan | 'need-commit | 'ok
(conflicts (conflicts
@ -75,8 +79,8 @@ The elements must all be of class xmtn-status-data.")
(insert (dvc-face-add " need refresh\n" 'dvc-conflict)) (insert (dvc-face-add " need refresh\n" 'dvc-conflict))
(ecase (xmtn-status-data-local-changes data) (ecase (xmtn-status-data-local-changes data)
(need-scan (insert " from local changes unknown\n")) (need-scan (insert " local changes unknown\n"))
(need-commit (insert (dvc-face-add " need dvc-status\n" 'dvc-header))) (need-commit (insert (dvc-face-add " need commit\n" 'dvc-header)))
(ok nil)) (ok nil))
(ecase (xmtn-status-data-conflicts data) (ecase (xmtn-status-data-conflicts data)
@ -92,10 +96,16 @@ The elements must all be of class xmtn-status-data.")
(ecase (xmtn-status-data-heads data) (ecase (xmtn-status-data-heads data)
(at-head nil) (at-head nil)
(need-update (insert (dvc-face-add " need update\n" 'dvc-conflict))) (need-update
(insert (dvc-face-add " need update\n" 'dvc-conflict)))
(need-merge (need-merge
(insert (dvc-face-add " need merge\n" 'dvc-conflict))) (insert (dvc-face-add " need merge\n" 'dvc-conflict))))
)))
(ecase (xmtn-status-data-update-review data)
(pending nil)
(need-review (insert " need update review\n"))
(done nil))
))
(defun xmtn-status-kill-conflicts-buffer (data) (defun xmtn-status-kill-conflicts-buffer (data)
(if (buffer-live-p (xmtn-status-data-conflicts-buffer data)) (if (buffer-live-p (xmtn-status-data-conflicts-buffer data))
@ -103,6 +113,10 @@ The elements must all be of class xmtn-status-data.")
(with-current-buffer buffer (save-buffer)) (with-current-buffer buffer (save-buffer))
(kill-buffer buffer)))) (kill-buffer buffer))))
(defun xmtn-status-kill-status-buffer (data)
(if (buffer-live-p (xmtn-status-data-status-buffer data))
(kill-buffer (xmtn-status-data-status-buffer data))))
(defun xmtn-status-save-conflicts-buffer (data) (defun xmtn-status-save-conflicts-buffer (data)
(if (buffer-live-p (xmtn-status-data-conflicts-buffer data)) (if (buffer-live-p (xmtn-status-data-conflicts-buffer data))
(with-current-buffer (xmtn-status-data-conflicts-buffer data) (save-buffer)))) (with-current-buffer (xmtn-status-data-conflicts-buffer data) (save-buffer))))
@ -111,6 +125,7 @@ The elements must all be of class xmtn-status-data.")
"Clean DATA workspace." "Clean DATA workspace."
(xmtn-automate-kill-session (xmtn-status-work data)) (xmtn-automate-kill-session (xmtn-status-work data))
(xmtn-status-kill-conflicts-buffer data) (xmtn-status-kill-conflicts-buffer data)
(xmtn-status-kill-status-buffer data)
(xmtn-conflicts-clean (xmtn-status-work data))) (xmtn-conflicts-clean (xmtn-status-work data)))
(defun xmtn-status-clean () (defun xmtn-status-clean ()
@ -158,6 +173,7 @@ The elements must all be of class xmtn-status-data.")
(let* ((elem (ewoc-locate xmtn-status-ewoc)) (let* ((elem (ewoc-locate xmtn-status-ewoc))
(data (ewoc-data elem))) (data (ewoc-data elem)))
(xmtn-status-need-refresh elem data) (xmtn-status-need-refresh elem data)
(setf (xmtn-status-data-update-review data) 'need-review)
(let ((default-directory (xmtn-status-work data))) (let ((default-directory (xmtn-status-work data)))
(xmtn-dvc-update)) (xmtn-dvc-update))
(xmtn-status-refresh-one data nil) (xmtn-status-refresh-one data nil)
@ -186,13 +202,13 @@ The elements must all be of class xmtn-status-data.")
'(need-resolve need-review-resolve-internal))))) '(need-resolve need-review-resolve-internal)))))
(defun xmtn-status-status () (defun xmtn-status-status ()
"Run xmtn-status on current workspace." "Show status buffer for current workspace."
(interactive) (interactive)
(let* ((elem (ewoc-locate xmtn-status-ewoc)) (let* ((elem (ewoc-locate xmtn-status-ewoc))
(data (ewoc-data elem))) (data (ewoc-data elem)))
(xmtn-status-need-refresh elem data) (xmtn-status-need-refresh elem data)
(setf (xmtn-status-data-local-changes data) 'ok) (setf (xmtn-status-data-local-changes data) 'ok)
(xmtn-status (xmtn-status-work data)) (pop-to-buffer (xmtn-status-data-status-buffer data))
;; IMPROVEME: create a log-edit buffer now, since we have both a ;; IMPROVEME: create a log-edit buffer now, since we have both a
;; status and conflict buffer, and that confuses dvc-log-edit ;; status and conflict buffer, and that confuses dvc-log-edit
)) ))
@ -203,11 +219,6 @@ The elements must all be of class xmtn-status-data.")
(let* ((elem (ewoc-locate xmtn-status-ewoc)) (let* ((elem (ewoc-locate xmtn-status-ewoc))
(data (ewoc-data elem))) (data (ewoc-data elem)))
(setf (xmtn-status-data-local-changes data) 'ok) (setf (xmtn-status-data-local-changes data) 'ok)
(if (buffer-live-p (xmtn-status-data-conflicts-buffer data))
;; creating the log-edit buffer requires a single status/diff/conflicts buffer
(kill-buffer (xmtn-status-data-conflicts-buffer data)))
(ewoc-invalidate xmtn-status-ewoc elem))) (ewoc-invalidate xmtn-status-ewoc elem)))
(defun xmtn-status-statusp () (defun xmtn-status-statusp ()
@ -217,22 +228,23 @@ The elements must all be of class xmtn-status-data.")
(member (xmtn-status-data-local-changes data) (member (xmtn-status-data-local-changes data)
'(need-scan need-commit))))) '(need-scan need-commit)))))
(defun xmtn-status-missing () (defun xmtn-status-review-update ()
"Run xmtn-missing on current workspace." "Review last update for current workspace."
(interactive) (interactive)
(let* ((elem (ewoc-locate xmtn-status-ewoc)) (let* ((elem (ewoc-locate xmtn-status-ewoc))
(data (ewoc-data elem))) (data (ewoc-data elem)))
(xmtn-status-need-refresh elem data) (xmtn-status-need-refresh elem data)
(xmtn-missing nil (xmtn-status-work data)))) (setf (xmtn-status-data-update-review data) 'done)
(xmtn-review-update (xmtn-status-work data))))
(defun xmtn-status-missingp () (defun xmtn-status-review-updatep ()
"Non-nil if xmtn-missing is appropriate for current workspace." "Non-nil if xmtn-status-review-update is appropriate for current workspace."
(let* ((data (ewoc-data (ewoc-locate xmtn-status-ewoc)))) (let* ((data (ewoc-data (ewoc-locate xmtn-status-ewoc))))
(and (not (xmtn-status-data-need-refresh data)) (and (not (xmtn-status-data-need-refresh data))
(eq 'need-update (xmtn-status-data-heads data))))) (eq 'need-review (xmtn-status-data-update-review data)))))
(defun xmtn-status-merge () (defun xmtn-status-merge ()
"Run dvc-merge on current workspace." "Run merge on current workspace."
(interactive) (interactive)
(let* ((elem (ewoc-locate xmtn-status-ewoc)) (let* ((elem (ewoc-locate xmtn-status-ewoc))
(data (ewoc-data elem)) (data (ewoc-data elem))
@ -243,7 +255,7 @@ The elements must all be of class xmtn-status-data.")
(ewoc-invalidate xmtn-status-ewoc elem))) (ewoc-invalidate xmtn-status-ewoc elem)))
(defun xmtn-status-heads () (defun xmtn-status-heads ()
"Run xmtn-heads on current workspace." "Show heads for current workspace."
(interactive) (interactive)
(let* ((elem (ewoc-locate xmtn-status-ewoc)) (let* ((elem (ewoc-locate xmtn-status-ewoc))
(data (ewoc-data elem)) (data (ewoc-data elem))
@ -268,22 +280,22 @@ The elements must all be of class xmtn-status-data.")
(define-key map [?i] '(menu-item "i) ignore local changes" (define-key map [?i] '(menu-item "i) ignore local changes"
xmtn-status-status-ok xmtn-status-status-ok
:visible (xmtn-status-statusp))) :visible (xmtn-status-statusp)))
(define-key map [?5] '(menu-item "5) update" (define-key map [?5] '(menu-item "5) review update"
xmtn-status-review-update
:visible (xmtn-status-review-updatep)))
(define-key map [?4] '(menu-item "4) update"
xmtn-status-update xmtn-status-update
:visible (xmtn-status-updatep))) :visible (xmtn-status-updatep)))
(define-key map [?4] '(menu-item "4) merge" (define-key map [?3] '(menu-item "3) merge"
xmtn-status-merge xmtn-status-merge
:visible (xmtn-status-headsp))) :visible (xmtn-status-headsp)))
(define-key map [?3] '(menu-item "3) show heads" (define-key map [?2] '(menu-item "2) show heads"
xmtn-status-heads xmtn-status-heads
:visible (xmtn-status-headsp))) :visible (xmtn-status-headsp)))
(define-key map [?2] '(menu-item "2) resolve conflicts" (define-key map [?1] '(menu-item "1) resolve conflicts"
xmtn-status-resolve-conflicts xmtn-status-resolve-conflicts
:visible (xmtn-status-resolve-conflictsp))) :visible (xmtn-status-resolve-conflictsp)))
(define-key map [?1] '(menu-item "1) show missing" (define-key map [?0] '(menu-item "0) commit"
xmtn-status-missing
:visible (xmtn-status-missingp)))
(define-key map [?0] '(menu-item "0) status"
xmtn-status-status xmtn-status-status
:visible (xmtn-status-statusp))) :visible (xmtn-status-statusp)))
map) map)
@ -319,8 +331,6 @@ The elements must all be of class xmtn-status-data.")
(defun xmtn-status-conflicts (data) (defun xmtn-status-conflicts (data)
"Return value for xmtn-status-data-conflicts for DATA." "Return value for xmtn-status-data-conflicts for DATA."
;; Can't check for "current heads", since there could be more than
;; 2, so just recreate conflicts
(let* ((work (xmtn-status-work data)) (let* ((work (xmtn-status-work data))
(default-directory work)) (default-directory work))
@ -379,11 +389,24 @@ The elements must all be of class xmtn-status-data.")
(message "") (message "")
(if refresh-local-changes (if refresh-local-changes
(setf (xmtn-status-data-local-changes data) 'need-scan)) (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))))
(case (xmtn-status-data-local-changes data) (case (xmtn-status-data-local-changes data)
(need-scan (need-scan
(setf (xmtn-status-data-local-changes data) (xmtn-automate-local-changes work))) (if (buffer-live-p (xmtn-status-data-status-buffer data))
(with-current-buffer (xmtn-status-data-status-buffer data)
(xmtn-dvc-status)
(setf (xmtn-status-data-local-changes data)
(if (not (ewoc-locate dvc-fileinfo-ewoc))
'ok
'need-commit)))
(let ((result (xmtn--status-inventory-sync (xmtn-status-work data))))
(setf (xmtn-status-data-status-buffer data) (car result)
(xmtn-status-data-local-changes data) (cadr result))) ))
(t nil)) (t nil))
(case (xmtn-status-data-conflicts data) (case (xmtn-status-data-conflicts data)
@ -398,7 +421,7 @@ The elements must all be of class xmtn-status-data.")
t) t)
(defun xmtn-status-refresh () (defun xmtn-status-refresh ()
"Refresh status of each ewoc element. With prefix arg, reset local changes status to `unknown'." "Refresh status of each ewoc element. With prefix arg, re-scan for local changes."
(interactive) (interactive)
(ewoc-map 'xmtn-status-refresh-one xmtn-status-ewoc current-prefix-arg) (ewoc-map 'xmtn-status-refresh-one xmtn-status-ewoc current-prefix-arg)
(message "done")) (message "done"))
@ -407,9 +430,9 @@ The elements must all be of class xmtn-status-data.")
(defun xmtn-update-multiple (dir &optional workspaces) (defun xmtn-update-multiple (dir &optional workspaces)
"Update all projects under DIR." "Update all projects under DIR."
(interactive "DUpdate all in (root directory): ") (interactive "DUpdate all in (root directory): ")
(let ((root (file-name-as-directory (substitute-in-file-name dir)))) (let ((root (file-name-as-directory (expand-file-name (substitute-in-file-name dir)))))
(if (not workspaces) (setq workspaces (xmtn--filter-non-dir root))) (if (not workspaces) (setq workspaces (xmtn--filter-non-ws root)))
(dolist (workspace workspaces) (dolist (workspace workspaces)
(let ((default-directory (concat root workspace))) (let ((default-directory (concat root workspace)))
@ -421,8 +444,8 @@ The elements must all be of class xmtn-status-data.")
"Show actions to update all projects under DIR." "Show actions to update all projects under DIR."
(interactive "DStatus for all (root directory): \ni\nP") (interactive "DStatus for all (root directory): \ni\nP")
(pop-to-buffer (get-buffer-create "*xmtn-multi-status*")) (pop-to-buffer (get-buffer-create "*xmtn-multi-status*"))
(setq default-directory (file-name-as-directory (substitute-in-file-name dir))) (setq default-directory (file-name-as-directory (expand-file-name (substitute-in-file-name dir))))
(if (not workspaces) (setq workspaces (xmtn--filter-non-dir default-directory))) (if (not workspaces) (setq workspaces (xmtn--filter-non-ws default-directory)))
(setq xmtn-status-root (file-name-as-directory default-directory)) (setq xmtn-status-root (file-name-as-directory default-directory))
(setq xmtn-status-ewoc (ewoc-create 'xmtn-status-printer)) (setq xmtn-status-ewoc (ewoc-create 'xmtn-status-printer))
(let ((inhibit-read-only t)) (delete-region (point-min) (point-max))) (let ((inhibit-read-only t)) (delete-region (point-min) (point-max)))
@ -461,6 +484,29 @@ The elements must all be of class xmtn-status-data.")
(xmtn-status-refresh) (xmtn-status-refresh)
(xmtn-status-next)) (xmtn-status-next))
;;;###autoload
(defun xmtn-status-one-1 (root name head-rev 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))
(setq xmtn-status-root root)
(setq xmtn-status-ewoc (ewoc-create 'xmtn-status-printer))
(let ((inhibit-read-only t)) (delete-region (point-min) (point-max)))
(ewoc-set-hf xmtn-status-ewoc (format "Root : %s\n" xmtn-status-root) "")
(ewoc-enter-last xmtn-status-ewoc
(make-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
:conflicts-buffer nil
:status-buffer status-buffer
:heads heads
:local-changes local-changes
:conflicts 'need-scan))
(xmtn-multiple-status-mode)
(xmtn-status-refresh))
(provide 'xmtn-multi-status) (provide 'xmtn-multi-status)
;; end of file ;; end of file

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

@ -1,6 +1,6 @@
;;; xmtn-propagate.el --- manage multiple propagations for DVC backend for monotone ;;; xmtn-propagate.el --- manage multiple propagations for DVC backend for monotone
;; Copyright (C) 2009, 2010 Stephen Leake ;; Copyright (C) 2009 - 2010 Stephen Leake
;; Author: Stephen Leake ;; Author: Stephen Leake
;; Keywords: tools ;; Keywords: tools
@ -20,12 +20,13 @@
;; the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, ;; the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor,
;; Boston, MA 02110-1301 USA. ;; Boston, MA 02110-1301 USA.
(eval-and-compile (eval-when-compile
;; these have macros we use ;; these have macros we use
(require 'xmtn-ids)) (require 'xmtn-ids))
(eval-when-compile (eval-and-compile
;; these have functions we use ;; these have functions we use
(require 'xmtn-automate)
(require 'xmtn-base) (require 'xmtn-base)
(require 'xmtn-conflicts)) (require 'xmtn-conflicts))
@ -49,7 +50,8 @@ The elements must all be of class xmtn-propagate-data.")
(defstruct (xmtn-propagate-data (:copier nil)) (defstruct (xmtn-propagate-data (:copier nil))
from-work ; directory name relative to xmtn-propagate-from-root from-work ; directory name relative to xmtn-propagate-from-root
to-work ; directory name relative to xmtn-propagate-to-root to-work ; directory name relative to xmtn-propagate-to-root
from-name ; display name, in buffer and menus ; from-work is often the same as to-work
from-name ; display name, in buffer and menus; usually root dir name
to-name ; to-name ;
from-branch ; branch name (assumed never changes) from-branch ; branch name (assumed never changes)
to-branch ; to-branch ;
@ -57,6 +59,8 @@ The elements must all be of class xmtn-propagate-data.")
from-head-rev ; nil | mtn rev string; current head revision; nil if multiple heads from-head-rev ; nil | mtn rev string; current head revision; nil if multiple heads
to-head-rev ; to-head-rev ;
conflicts-buffer ; *xmtn-conflicts* buffer for this propagation 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
propagate-needed ; nil | t propagate-needed ; nil | t
from-heads ; 'at-head | 'need-update | 'need-merge) from-heads ; 'at-head | 'need-update | 'need-merge)
to-heads ; to-heads ;
@ -66,6 +70,7 @@ The elements must all be of class xmtn-propagate-data.")
'need-scan) ; 'need-scan) ;
(conflicts (conflicts
'need-scan) ; 'need-scan | 'need-resolve | 'need-review-resolve-internal | 'ok 'need-scan) ; 'need-scan | 'need-resolve | 'need-review-resolve-internal | 'ok
; for propagate
) )
(defun xmtn-propagate-from-work (data) (defun xmtn-propagate-from-work (data)
@ -162,11 +167,44 @@ The elements must all be of class xmtn-propagate-data.")
(if (buffer-live-p (xmtn-propagate-data-conflicts-buffer data)) (if (buffer-live-p (xmtn-propagate-data-conflicts-buffer data))
(with-current-buffer (xmtn-propagate-data-conflicts-buffer data) (save-buffer)))) (with-current-buffer (xmtn-propagate-data-conflicts-buffer data) (save-buffer))))
(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))) ))
(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))) ))
(defun xmtn-propagate-kill-status-buffers (data)
(if (buffer-live-p (xmtn-propagate-data-from-status-buffer data))
(kill-buffer (xmtn-propagate-data-from-status-buffer 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) (defun xmtn-propagate-clean-1 (data)
"Clean DATA workspace" "Clean DATA workspace"
(xmtn-automate-kill-session (xmtn-propagate-from-work data)) (xmtn-automate-kill-session (xmtn-propagate-from-work data))
(xmtn-automate-kill-session (xmtn-propagate-to-work data)) (xmtn-automate-kill-session (xmtn-propagate-to-work data))
(xmtn-propagate-kill-conflicts-buffer data) (xmtn-propagate-kill-conflicts-buffer data)
(xmtn-propagate-kill-status-buffers data)
(xmtn-conflicts-clean (xmtn-propagate-to-work data))) (xmtn-conflicts-clean (xmtn-propagate-to-work data)))
(defun xmtn-propagate-clean () (defun xmtn-propagate-clean ()
@ -211,8 +249,36 @@ The elements must all be of class xmtn-propagate-data.")
(eq 'need-scan (xmtn-propagate-data-from-local-changes data)) (eq 'need-scan (xmtn-propagate-data-from-local-changes data))
(eq 'need-scan (xmtn-propagate-data-to-local-changes data))))) (eq 'need-scan (xmtn-propagate-data-to-local-changes data)))))
(defun xmtn-propagate-commit-to ()
"Show commit buffer for `to' workspace, so it can be committed, updated, or merged."
(interactive)
(let* ((elem (ewoc-locate xmtn-propagate-ewoc))
(data (ewoc-data elem)))
(xmtn-propagate-need-refresh elem data)
(pop-to-buffer (xmtn-propagate-data-to-status-buffer data))))
(defun xmtn-propagate-commit-top ()
"Non-nil if commit is appropriate for current `to' workspace."
(let* ((data (ewoc-data (ewoc-locate xmtn-propagate-ewoc))))
(and (not (xmtn-propagate-data-need-refresh data))
(eq (xmtn-propagate-data-to-local-changes data) 'need-commit))))
(defun xmtn-propagate-commit-from ()
"Show commit buffer for `from' workspace, so it can be committed, updated, or merged."
(interactive)
(let* ((elem (ewoc-locate xmtn-propagate-ewoc))
(data (ewoc-data elem)))
(xmtn-propagate-need-refresh elem data)
(pop-to-buffer (xmtn-propagate-data-from-status-buffer data))))
(defun xmtn-propagate-commit-fromp ()
"Non-nil if commit 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-local-changes data) 'need-commit))))
(defun xmtn-propagate-update-to () (defun xmtn-propagate-update-to ()
"Update current workspace." "Update current `to' workspace."
(interactive) (interactive)
(let* ((elem (ewoc-locate xmtn-propagate-ewoc)) (let* ((elem (ewoc-locate xmtn-propagate-ewoc))
(data (ewoc-data elem))) (data (ewoc-data elem)))
@ -223,17 +289,12 @@ The elements must all be of class xmtn-propagate-data.")
(xmtn-propagate-refresh-one data nil) (xmtn-propagate-refresh-one data nil)
(ewoc-invalidate xmtn-propagate-ewoc elem))) (ewoc-invalidate xmtn-propagate-ewoc elem)))
(defun xmtn-propagate-update-from () (defun xmtn-propagate-update-top ()
"Update current workspace." "Non-nil if update is appropriate for current `to' workspace."
(interactive) (let* ((data (ewoc-data (ewoc-locate xmtn-propagate-ewoc))))
(let* ((elem (ewoc-locate xmtn-propagate-ewoc)) (and (not (xmtn-propagate-data-need-refresh data))
(data (ewoc-data elem))) (eq (xmtn-propagate-data-to-heads data)
(xmtn-propagate-need-refresh elem data) 'need-update))))
(xmtn--update (xmtn-propagate-from-work data)
(xmtn-propagate-data-from-head-rev data)
nil t)
(xmtn-propagate-refresh-one data nil)
(ewoc-invalidate xmtn-propagate-ewoc elem)))
(defun xmtn-propagate-propagate () (defun xmtn-propagate-propagate ()
"Propagate current workspace." "Propagate current workspace."
@ -282,22 +343,7 @@ The elements must all be of class xmtn-propagate-data.")
(member (xmtn-propagate-data-conflicts data) (member (xmtn-propagate-data-conflicts data)
'(need-resolve need-review-resolve-internal))))) '(need-resolve need-review-resolve-internal)))))
(defun xmtn-propagate-status-to () (defun xmtn-propagate-local-changes-to-ok ()
"Run xmtn-status on current `to' workspace."
(interactive)
(let* ((elem (ewoc-locate xmtn-propagate-ewoc))
(data (ewoc-data elem)))
(xmtn-propagate-need-refresh elem data)
;; can't create log-edit buffer with both conflicts and status
;; buffer open, and we'll be killing this as part of the refresh
;; anyway.
(xmtn-propagate-kill-conflicts-buffer data)
(setf (xmtn-propagate-data-to-local-changes data) 'ok)
(xmtn-status (xmtn-propagate-to-work data))))
(defun xmtn-propagate-status-to-ok ()
"Ignore local changes in current `to' workspace." "Ignore local changes in current `to' workspace."
(interactive) (interactive)
(let* ((elem (ewoc-locate xmtn-propagate-ewoc)) (let* ((elem (ewoc-locate xmtn-propagate-ewoc))
@ -305,23 +351,14 @@ The elements must all be of class xmtn-propagate-data.")
(setf (xmtn-propagate-data-to-local-changes data) 'ok) (setf (xmtn-propagate-data-to-local-changes data) 'ok)
(ewoc-invalidate xmtn-propagate-ewoc elem))) (ewoc-invalidate xmtn-propagate-ewoc elem)))
(defun xmtn-propagate-status-top () (defun xmtn-propagate-local-changes-top ()
"Non-nil if xmtn-status is appropriate for current `to' workspace." "Non-nil if local-changes-to-ok is appropriate for current `to' workspace."
(let* ((data (ewoc-data (ewoc-locate xmtn-propagate-ewoc)))) (let* ((data (ewoc-data (ewoc-locate xmtn-propagate-ewoc))))
(and (not (xmtn-propagate-data-need-refresh data)) (and (not (xmtn-propagate-data-need-refresh data))
(member (xmtn-propagate-data-to-local-changes data) (member (xmtn-propagate-data-to-local-changes data)
'(need-scan need-commit))))) '(need-scan need-commit)))))
(defun xmtn-propagate-status-from () (defun xmtn-propagate-local-changes-from-ok ()
"Run xmtn-status on current `from' workspace."
(interactive)
(let* ((elem (ewoc-locate xmtn-propagate-ewoc))
(data (ewoc-data elem)))
(xmtn-propagate-need-refresh elem data)
(setf (xmtn-propagate-data-from-local-changes data) 'ok)
(xmtn-status (xmtn-propagate-from-work data))))
(defun xmtn-propagate-status-from-ok ()
"Ignore local changes in current `from' workspace." "Ignore local changes in current `from' workspace."
(interactive) (interactive)
(let* ((elem (ewoc-locate xmtn-propagate-ewoc)) (let* ((elem (ewoc-locate xmtn-propagate-ewoc))
@ -329,70 +366,63 @@ The elements must all be of class xmtn-propagate-data.")
(setf (xmtn-propagate-data-from-local-changes data) 'ok) (setf (xmtn-propagate-data-from-local-changes data) 'ok)
(ewoc-invalidate xmtn-propagate-ewoc elem))) (ewoc-invalidate xmtn-propagate-ewoc elem)))
(defun xmtn-propagate-status-fromp () (defun xmtn-propagate-local-changes-fromp ()
"Non-nil if xmtn-status is appropriate for current `from' workspace." "Non-nil if local-changes-from-ok is appropriate for current `from' workspace."
(let* ((data (ewoc-data (ewoc-locate xmtn-propagate-ewoc)))) (let* ((data (ewoc-data (ewoc-locate xmtn-propagate-ewoc))))
(and (not (xmtn-propagate-data-need-refresh data)) (and (not (xmtn-propagate-data-need-refresh data))
(member (xmtn-propagate-data-from-local-changes data) (member (xmtn-propagate-data-from-local-changes data)
'(need-scan need-commit))))) '(need-scan need-commit)))))
(defun xmtn-propagate-missing-to () (defun xmtn-propagate-status-to ()
"Run xmtn-missing on current `to' workspace." "Show status buffer for `to' workspace, so it can be committed, updated, or merged."
(interactive) (interactive)
(let* ((elem (ewoc-locate xmtn-propagate-ewoc)) (let* ((elem (ewoc-locate xmtn-propagate-ewoc))
(data (ewoc-data elem))) (data (ewoc-data elem)))
(xmtn-propagate-need-refresh elem data) (xmtn-propagate-need-refresh elem data)
(xmtn-missing nil (xmtn-propagate-to-work 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-status-buffer data)
(xmtn-propagate-data-to-heads data)
(xmtn-propagate-data-to-local-changes data))
(defun xmtn-propagate-missing-top () ;; Assume the user completely handles the local changes in the
"Non-nil if xmtn-missing is appropriate for current `to' workspace." ;; status buffer, so they are now ok
(setf (xmtn-propagate-data-to-local-changes data) 'ok)))
(defun xmtn-propagate-status-top ()
"Non-nil if xmtn-status is appropriate for current `to' workspace."
(let* ((data (ewoc-data (ewoc-locate xmtn-propagate-ewoc)))) (let* ((data (ewoc-data (ewoc-locate xmtn-propagate-ewoc))))
(and (not (xmtn-propagate-data-need-refresh data)) (and (not (xmtn-propagate-data-need-refresh data))
(eq 'need-update (xmtn-propagate-data-to-heads data))))) (or
(member (xmtn-propagate-data-to-heads data)
'(need-update need-merge))
(eq (xmtn-propagate-data-to-local-changes data) 'need-commit)))))
(defun xmtn-propagate-missing-from () (defun xmtn-propagate-status-from ()
"Run xmtn-missing on current `from' workspace." "Show status buffer for `from' workspace, so it can be committed, updated, or merged."
(interactive) (interactive)
(let* ((elem (ewoc-locate xmtn-propagate-ewoc)) (let* ((elem (ewoc-locate xmtn-propagate-ewoc))
(data (ewoc-data elem))) (data (ewoc-data elem)))
(xmtn-propagate-need-refresh elem data) (xmtn-propagate-need-refresh elem data)
(xmtn-missing nil (xmtn-propagate-from-work 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-status-buffer data)
(xmtn-propagate-data-from-heads data)
(xmtn-propagate-data-from-local-changes data))
(setf (xmtn-propagate-data-from-local-changes data) 'ok)))
(defun xmtn-propagate-missing-fromp () (defun xmtn-propagate-status-fromp ()
"Non-nil if xmtn-missing is appropriate for current `from' workspace." "Non-nil if xmtn-status-one is appropriate for current `from' workspace."
(let* ((data (ewoc-data (ewoc-locate xmtn-propagate-ewoc)))) (let* ((data (ewoc-data (ewoc-locate xmtn-propagate-ewoc))))
(and (not (xmtn-propagate-data-need-refresh data)) (and (not (xmtn-propagate-data-need-refresh data))
(eq 'need-update (xmtn-propagate-data-from-heads data))))) (or
(member (xmtn-propagate-data-from-heads data)
(defun xmtn-propagate-heads-to () '(need-update need-merge))
"Run xmtn-heads on current `to' workspace." (eq (xmtn-propagate-data-from-local-changes data) 'need-commit)))))
(interactive)
(let* ((elem (ewoc-locate xmtn-propagate-ewoc))
(data (ewoc-data elem))
(default-directory (xmtn-propagate-to-work data)))
(xmtn-propagate-need-refresh elem data)
(xmtn-view-heads-revlist)))
(defun xmtn-propagate-heads-top ()
"Non-nil if xmtn-heads is appropriate for current `to' workspace."
(let* ((data (ewoc-data (ewoc-locate xmtn-propagate-ewoc))))
(and (not (xmtn-propagate-data-need-refresh data))
(eq 'need-merge (xmtn-propagate-data-to-heads data)))))
(defun xmtn-propagate-heads-from ()
"Run xmtn-heads on current `from' workspace."
(interactive)
(let* ((elem (ewoc-locate xmtn-propagate-ewoc))
(data (ewoc-data elem))
(default-directory (xmtn-propagate-from-work data)))
(xmtn-propagate-need-refresh elem data)
(xmtn-view-heads-revlist)))
(defun xmtn-propagate-heads-fromp ()
"Non-nil if xmtn-heads is appropriate for current `from' workspace."
(let* ((data (ewoc-data (ewoc-locate xmtn-propagate-ewoc))))
(and (not (xmtn-propagate-data-need-refresh data))
(eq 'need-merge (xmtn-propagate-data-from-heads data)))))
(defvar xmtn-propagate-actions-map (defvar xmtn-propagate-actions-map
(let ((map (make-sparse-keymap "actions"))) (let ((map (make-sparse-keymap "actions")))
@ -402,42 +432,33 @@ The elements must all be of class xmtn-propagate-data.")
(define-key map [?g] '(menu-item "g) refresh" (define-key map [?g] '(menu-item "g) refresh"
xmtn-propagate-do-refresh-one xmtn-propagate-do-refresh-one
:visible (xmtn-propagate-refreshp))) :visible (xmtn-propagate-refreshp)))
(define-key map [?b] '(menu-item "b) propagate" (define-key map [?8] '(menu-item (concat "8) 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 [?5] '(menu-item "5) propagate"
xmtn-propagate-propagate xmtn-propagate-propagate
:visible (xmtn-propagate-propagatep))) :visible (xmtn-propagate-propagatep)))
(define-key map [?a] '(menu-item "a) resolve conflicts" (define-key map [?4] '(menu-item "4) resolve conflicts"
xmtn-propagate-resolve-conflicts xmtn-propagate-resolve-conflicts
:visible (xmtn-propagate-resolve-conflictsp))) :visible (xmtn-propagate-resolve-conflictsp)))
(define-key map [?9] '(menu-item (concat "9) ignore local changes " (xmtn-propagate-to-name)) (define-key map [?3] '(menu-item (concat "3) ignore local changes " (xmtn-propagate-to-name))
xmtn-propagate-status-to-ok xmtn-propagate-local-changes-to-ok
:visible (xmtn-propagate-status-top))) :visible (xmtn-propagate-local-changes-top)))
(define-key map [?8] '(menu-item (concat "8) ignore local changes " (xmtn-propagate-from-name)) (define-key map [?2] '(menu-item (concat "2) ignore local changes " (xmtn-propagate-from-name))
xmtn-propagate-status-from-ok xmtn-propagate-local-changes-from-ok
:visible (xmtn-propagate-status-fromp))) :visible (xmtn-propagate-local-changes-fromp)))
(define-key map [?7] '(menu-item (concat "7) show missing " (xmtn-propagate-to-name)) (define-key map [?1] '(menu-item (concat "1) status " (xmtn-propagate-to-name))
xmtn-propagate-missing-to
:visible (xmtn-propagate-missing-top)))
(define-key map [?6] '(menu-item (concat "6) show missing " (xmtn-propagate-from-name))
xmtn-propagate-missing-from
:visible (xmtn-propagate-missing-fromp)))
(define-key map [?5] '(menu-item (concat "5) update " (xmtn-propagate-to-name))
xmtn-propagate-update-to
:visible (xmtn-propagate-missing-top)))
(define-key map [?4] '(menu-item (concat "4) update " (xmtn-propagate-from-name))
xmtn-propagate-update-from
:visible (xmtn-propagate-missing-fromp)))
(define-key map [?3] '(menu-item (concat "3) commit " (xmtn-propagate-to-name))
xmtn-propagate-status-to xmtn-propagate-status-to
:visible (xmtn-propagate-status-top))) :visible (xmtn-propagate-status-top)))
(define-key map [?2] '(menu-item (concat "2) commit " (xmtn-propagate-from-name)) (define-key map [?0] '(menu-item (concat "0) status " (xmtn-propagate-from-name))
xmtn-propagate-status-from xmtn-propagate-status-from
:visible (xmtn-propagate-status-fromp))) :visible (xmtn-propagate-status-fromp)))
(define-key map [?1] '(menu-item (concat "1) show heads " (xmtn-propagate-to-name))
xmtn-propagate-heads-to
:visible (xmtn-propagate-heads-top)))
(define-key map [?0] '(menu-item (concat "0) show heads " (xmtn-propagate-from-name))
xmtn-propagate-heads-from
:visible (xmtn-propagate-heads-fromp)))
map) map)
"Keyboard menu keymap used to manage propagates.") "Keyboard menu keymap used to manage propagates.")
@ -572,11 +593,6 @@ The elements must all be of class xmtn-propagate-data.")
(dvc-trace "xmtn-propagate-refresh-one: %s" from-work) (dvc-trace "xmtn-propagate-refresh-one: %s" from-work)
(if refresh-local-changes
(progn
(setf (xmtn-propagate-data-from-local-changes data) 'need-scan)
(setf (xmtn-propagate-data-to-local-changes data) 'need-scan)))
(let ((heads (xmtn--heads from-work (xmtn-propagate-data-from-branch data))) (let ((heads (xmtn--heads from-work (xmtn-propagate-data-from-branch data)))
(from-base-rev (xmtn--get-base-revision-hash-id-or-null from-work))) (from-base-rev (xmtn--get-base-revision-hash-id-or-null from-work)))
(case (length heads) (case (length heads)
@ -604,19 +620,24 @@ The elements must all be of class xmtn-propagate-data.")
(setf (xmtn-propagate-data-propagate-needed data) (setf (xmtn-propagate-data-propagate-needed data)
(xmtn-propagate-needed data)) (xmtn-propagate-needed data))
(if refresh-local-changes
(progn
(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 (if (or refresh-local-changes
(xmtn-propagate-data-propagate-needed data)) (xmtn-propagate-data-propagate-needed data))
;; these checks are slow, so don't do them if they probably are not needed. ;; these checks are slow, so don't do them if they probably are not needed.
(progn (progn
(ecase (xmtn-propagate-data-from-local-changes data) (ecase (xmtn-propagate-data-from-local-changes data)
((need-scan need-commit) (need-scan
(setf (xmtn-propagate-data-from-local-changes data) (xmtn-automate-local-changes from-work))) (xmtn-propagate-create-from-status-buffer data))
(ok nil)) (t nil))
(ecase (xmtn-propagate-data-to-local-changes data) (ecase (xmtn-propagate-data-to-local-changes data)
((need-scan need-commit) (need-scan
(setf (xmtn-propagate-data-to-local-changes data) (xmtn-automate-local-changes to-work))) (xmtn-propagate-create-to-status-buffer data))
(ok nil)))) (t nil))))
(if (xmtn-propagate-data-propagate-needed data) (if (xmtn-propagate-data-propagate-needed data)
(progn (progn
@ -641,7 +662,7 @@ The elements must all be of class xmtn-propagate-data.")
(interactive) (interactive)
(ewoc-map 'xmtn-propagate-refresh-one xmtn-propagate-ewoc current-prefix-arg) (ewoc-map 'xmtn-propagate-refresh-one xmtn-propagate-ewoc current-prefix-arg)
;; leaves point at (point-min) ;; leaves point at (point-min)
(xmtn-propagate-next t) (xmtn-propagate-next nil t)
(message "done")) (message "done"))
(defun xmtn-propagate-make-data (from-workspace to-workspace from-name to-name) (defun xmtn-propagate-make-data (from-workspace to-workspace from-name to-name)
@ -668,16 +689,16 @@ to TO-DIR. WORKSPACES (default nil) is a list of workspaces
common to from-dir and to-dir; if nil, the directories are common to from-dir and to-dir; if nil, the directories are
scanned and all common ones found are used." scanned and all common ones found are used."
(interactive "DPropagate all from (root directory): \nDto (root directory): ") (interactive "DPropagate all from (root directory): \nDto (root directory): ")
(setq from-dir (substitute-in-file-name from-dir))
(setq to-dir (substitute-in-file-name to-dir))
(let ((from-workspaces (or workspaces
(xmtn--filter-non-dir from-dir)))
(to-workspaces (or workspaces
(xmtn--filter-non-dir to-dir))))
(pop-to-buffer (get-buffer-create "*xmtn-propagate*")) (pop-to-buffer (get-buffer-create "*xmtn-propagate*"))
(setq xmtn-propagate-from-root (file-name-as-directory from-dir)) ;; xmtn-propagate-*-root are buffer-local. Note that we don't care
(setq xmtn-propagate-to-root (file-name-as-directory to-dir)) ;; what 'default-directory' is for xmtn-propagate buffer.
(setq xmtn-propagate-from-root (file-name-as-directory (expand-file-name (substitute-in-file-name from-dir))))
(setq xmtn-propagate-to-root (file-name-as-directory (expand-file-name (substitute-in-file-name to-dir))))
(let ((from-workspaces (or workspaces
(xmtn--filter-non-ws xmtn-propagate-from-root)))
(to-workspaces (or workspaces
(xmtn--filter-non-ws xmtn-propagate-to-root))))
(setq xmtn-propagate-ewoc (ewoc-create 'xmtn-propagate-printer)) (setq xmtn-propagate-ewoc (ewoc-create 'xmtn-propagate-printer))
(let ((inhibit-read-only t)) (delete-region (point-min) (point-max))) (let ((inhibit-read-only t)) (delete-region (point-min) (point-max)))
(ewoc-set-hf (ewoc-set-hf
@ -701,14 +722,12 @@ scanned and all common ones found are used."
(defun xmtn-propagate-one (from-work to-work) (defun xmtn-propagate-one (from-work to-work)
"Show all actions needed to propagate FROM-WORK to TO-WORK." "Show all actions needed to propagate FROM-WORK to TO-WORK."
(interactive "DPropagate all from (workspace): \nDto (workspace): ") (interactive "DPropagate all from (workspace): \nDto (workspace): ")
(setq from-work (substitute-in-file-name from-work)) (setq from-work (file-name-as-directory (expand-file-name (substitute-in-file-name from-work))))
(setq to-work (substitute-in-file-name to-work)) (setq to-work (file-name-as-directory (expand-file-name (substitute-in-file-name to-work))))
(let ((default-directory to-work))
(pop-to-buffer (get-buffer-create "*xmtn-propagate*")) (pop-to-buffer (get-buffer-create "*xmtn-propagate*"))
;; default-directory is wrong if buffer is reused
(setq default-directory to-work) (setq default-directory to-work)
(setq xmtn-propagate-from-root (expand-file-name (concat (file-name-as-directory from-work) "../"))) (setq xmtn-propagate-from-root (expand-file-name (concat from-work "../")))
(setq xmtn-propagate-to-root (expand-file-name (concat (file-name-as-directory to-work) "../"))) (setq xmtn-propagate-to-root (expand-file-name (concat to-work "../")))
(setq xmtn-propagate-ewoc (ewoc-create 'xmtn-propagate-printer)) (setq xmtn-propagate-ewoc (ewoc-create 'xmtn-propagate-printer))
(let ((inhibit-read-only t)) (delete-region (point-min) (point-max))) (let ((inhibit-read-only t)) (delete-region (point-min) (point-max)))
(ewoc-set-hf (ewoc-set-hf
@ -723,7 +742,7 @@ scanned and all common ones found are used."
(file-name-nondirectory (directory-file-name to-work)) (file-name-nondirectory (directory-file-name to-work))
(file-name-nondirectory (directory-file-name from-work)) (file-name-nondirectory (directory-file-name from-work))
(file-name-nondirectory (directory-file-name to-work))) (file-name-nondirectory (directory-file-name to-work)))
(xmtn-propagate-mode))) (xmtn-propagate-mode))
(provide 'xmtn-propagate) (provide 'xmtn-propagate)

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

@ -1,6 +1,6 @@
;;; xmtn-revlist.el --- Interactive display of revision histories for monotone ;;; xmtn-revlist.el --- Interactive display of revision histories for monotone
;; Copyright (C) 2008, 2009 Stephen Leake ;; Copyright (C) 2008 - 2010 Stephen Leake
;; Copyright (C) 2006, 2007 Christian M. Ohler ;; Copyright (C) 2006, 2007 Christian M. Ohler
;; Author: Christian M. Ohler ;; Author: Christian M. Ohler
@ -341,6 +341,33 @@ arg; root. Result is of the form:
'() '()
difference))) difference)))
(defun xmtn--revlist--review-update-info (root)
(let* ((branch (xmtn--tree-default-branch root))
(last-update
(xmtn-automate-simple-command-output-line
root
(list "select" "u:")))
(base-revision-hash-id (xmtn--get-base-revision-hash-id root))
(difference
;; FIXME: replace with automate log
(xmtn-automate-simple-command-output-lines
root
(list "ancestry_difference" base-revision-hash-id last-update))))
(list
branch
`(,(format "Tree %s" root)
,(format "Branch %s" branch)
,(format "Base %s" base-revision-hash-id)
nil
,(case (length difference)
(0 "No revisions in last update")
(1 "1 revision in last update:")
(t (format
"%s revisions in last update:"
(length difference)))))
'()
difference)))
(defun xmtn-revlist-show-conflicts () (defun xmtn-revlist-show-conflicts ()
"If point is on a revision that has two parents, show conflicts "If point is on a revision that has two parents, show conflicts
from the merge." from the merge."
@ -447,6 +474,17 @@ from the merge."
nil dvc-log-last-n)) nil dvc-log-last-n))
nil) nil)
;;;###autoload
(defun xmtn-review-update (root)
"Review revisions in last update of ROOT workspace."
(interactive "D")
(xmtn--setup-revlist
root
'xmtn--revlist--review-update-info
nil ;; first-line-only-p
dvc-log-last-n)
nil)
;;;###autoload ;;;###autoload
(defun xmtn-view-heads-revlist () (defun xmtn-view-heads-revlist ()
"Display a revlist buffer showing the heads of the current branch." "Display a revlist buffer showing the heads of the current branch."

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

@ -112,21 +112,27 @@ Signals an error if more (or fewer) than one line is output."
(first lines))) (first lines)))
(defconst xmtn--minimum-required-command-version '(0 46)) (defconst xmtn--minimum-required-command-version '(0 46))
;; see also xmtn-sync.el xmtn-sync-required-command-version
(defconst xmtn--required-automate-format-version "2") (defconst xmtn--required-automate-format-version "2")
(defun xmtn--have-no-ignore () (defvar xmtn--*cached-command-version* nil
"Non-nil if mtn automate inventory supports --no-ignore, --no-unknown, --no-unchanged options." ;; compare with (xmtn-version-<= required)
(>= (xmtn-dvc-automate-version) 7.0)) "(MAJOR MINOR REVISION VERSION-STRING).")
(defvar xmtn--*cached-command-version* nil)
(defvar xmtn--*command-version-cached-for-executable* nil) (defvar xmtn--*command-version-cached-for-executable* nil)
(defun xmtn-version-<= (required)
"Nonnil if REQUIRED (list of major, minor) is <= cached version."
(version-list-<= required (butlast (xmtn--cached-command-version) 2)))
(defun xmtn--clear-command-version-cache () (defun xmtn--clear-command-version-cache ()
(setq xmtn--*command-version-cached-for-executable* nil (setq xmtn--*command-version-cached-for-executable* nil
;; This is redundant but neater. ;; This is redundant but neater.
xmtn--*cached-command-version* nil)) xmtn--*cached-command-version* nil))
(defun xmtn--cached-command-version () (defun xmtn--cached-command-version ()
"Return mtn version as a list (MAJOR MINOR REVISION VERSION-STRING).
Sets cache if not already set."
(if (equal xmtn--*command-version-cached-for-executable* xmtn-executable) (if (equal xmtn--*command-version-cached-for-executable* xmtn-executable)
xmtn--*cached-command-version* xmtn--*cached-command-version*
(let ((executable xmtn-executable)) (let ((executable xmtn-executable))
@ -164,12 +170,9 @@ id."
(list major minor revision string))))) (list major minor revision string)))))
(defun xmtn--check-cached-command-version () (defun xmtn--check-cached-command-version ()
(let ((minimum-version xmtn--minimum-required-command-version)) (let ((minimum-version xmtn--minimum-required-command-version)
(destructuring-bind (major minor revision string) (string (nth 3 (xmtn--cached-command-version))))
(xmtn--cached-command-version) (unless (xmtn-version-<= xmtn--minimum-required-command-version)
(unless (or (> major (car minimum-version))
(and (= major (car minimum-version))
(>= minor (cadr minimum-version))))
;; Clear cache now since the user is somewhat likely to ;; Clear cache now since the user is somewhat likely to
;; upgrade mtn (or change the value of `xmtn-executable') ;; upgrade mtn (or change the value of `xmtn-executable')
;; after this message. ;; after this message.
@ -178,113 +181,8 @@ id."
" (%s is %s)") " (%s is %s)")
(car minimum-version) (cadr minimum-version) (car minimum-version) (cadr minimum-version)
xmtn-executable string))) xmtn-executable string)))
nil))
;;;###autoload
(defun xmtn-check-command-version ()
"Check and display the version identifier of the mtn command.
This command resets xmtn's command version cache."
(interactive)
(xmtn--clear-command-version-cache)
(destructuring-bind (major minor revision version-string)
(xmtn--cached-command-version)
(let* ((latest (xmtn--latest-mtn-release))
(latest-major (first latest))
(latest-minor (second latest)))
(if (eval `(xmtn--version-case
((and (= ,latest-major latest-minor)
(mainline> latest-major latest-minor))
t)
(t
nil)))
(message "%s (xmtn considers this version newer than %s.%s)"
version-string major minor)
(message "%s" version-string))))
nil) nil)
(defun xmtn--make-version-check-form (version-var condition)
;; The expression (mainline> X Y) matches all command versions
;; strictly newer than X.Y, and, if X.Y is the latest version
;; according to (xmtn--latest-mtn-release), command versions that
;; report version X.Y with a revision ID different from what
;; (xmtn--latest-mtn-release) returns. This is a kludge to attempt
;; to distinguish the latest mtn release from the current
;; bleeding-edge ("mainline") version. (Bleeding-edge mtn versions
;; always report a version equal to the last release, while they
;; generally have syntax and semantics that match the upcoming
;; release; i.e., their syntax and semantics don't match the version
;; number they report.)
(case condition
((t) `t)
((nil) `nil)
(t
(let ((operator (car condition))
(arguments (cdr condition)))
(ecase operator
((< <= > >= = /= mainline>)
(let ((target-version arguments))
(assert (eql (length arguments) 2))
(ecase operator
((=)
`(and (= (car ,version-var) ,(car target-version))
(= (cadr ,version-var) ,(cadr target-version))))
((< >)
`(or (,operator (car ,version-var) ,(car target-version))
(and
(= (car ,version-var) ,(car target-version))
(,operator (cadr ,version-var) ,(cadr target-version)))))
((mainline>)
`(or (> (car ,version-var) ,(car target-version))
(and (= (car ,version-var) ,(car target-version))
(or (> (cadr ,version-var) ,(cadr target-version))
(and (= (cadr ,version-var) ,(cadr target-version))
(let ((-latest- (xmtn--latest-mtn-release)))
(and (= (car -latest-) ,(car target-version))
(= (cadr -latest-)
,(cadr target-version))
(not (equal (caddr ,version-var)
(caddr -latest-))))))))))
((/= <= >=)
(let ((negated-operator (ecase operator
(/= '=)
(<= '>)
(>= '<))))
`(not ,(xmtn--make-version-check-form version-var
`(,negated-operator
,@arguments))))))))
((not)
(assert (eql (length arguments) 1))
`(not ,(xmtn--make-version-check-form version-var (first arguments))))
((and or)
`(,operator
,@(loop for subform in arguments
collect
(xmtn--make-version-check-form version-var subform)))))))))
(defun xmtn--signal-unsupported-version (version supported-conditions)
(error "Operation only implemented for monotone versions matching %S"
;; This message is probably not very helpful to users who
;; don't know xmtn's internals.
`(or ,@supported-conditions)))
(defmacro* xmtn--version-case (&body clauses)
(let ((version (gensym)))
`(let ((,version (xmtn--cached-command-version)))
(cond ,@(loop for (condition . body) in clauses
collect `(,(xmtn--make-version-check-form version
condition)
,@body))
(t (xmtn--signal-unsupported-version
,version
',(loop for (condition . nil) in clauses
collect condition)))))))
(defun xmtn--latest-mtn-release ()
;; Version number and revision id of the latest mtn release at the
;; time of this xmtn release.
'(0 35 "f92dd754bf5c1e6eddc9c462b8d68691cfeb7f8b"))
(provide 'xmtn-run) (provide 'xmtn-run)
;;; xmtn-run.el ends here ;;; xmtn-run.el ends here

175
dvc/lisp/xmtn-sync.el Normal file
View File

@ -0,0 +1,175 @@
;;; xmtn-sync.el --- database sync handling for DVC backend for monotone
;;
;; Copyright (C) 2010 Stephen Leake
;;
;; Author: Stephen Leake
;; Keywords: tools
;;
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2 of the License, or
;; (at your option) any later version.
;;
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this file; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor,
;; Boston, MA 02110-1301 USA.
(eval-when-compile
;; these have macros we use
)
(eval-and-compile
;; these have functions we use
(require 'xmtn-automate)
)
;;; User variables
(defvar xmtn-sync-branch-file "~/.dvc/branches"
"File associating branch name with workspace root")
(defvar xmtn-sync-executable
(cond
((equal system-type 'windows-nt)
;; Native MinGW does not support file: or ssh: - assume Cygwin is
;; installed, but not first in path
"c:/bin/mtn")
(t
;; Unix or Cygwin; assume mtn is in path
"mtn"))
"Executable for running sync command on local db; overrides xmtn-executable.")
(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'.")
;;; Internal variables
(defconst xmtn-sync-required-command-version '(0 46)
"Minimum mtn version for automate sync; overrides xmtn--minimum-required-command-version.")
(defconst xmtn-sync-remote-exec-default "mtn"
"Default executable command to run on remote host for file: or ssh:; see `xmtn-sync-remote-exec-alist'.")
;; loaded from xmtn-sync-config
(defvar xmtn-sync-branch-alist nil
"Alist associating branch name with workspace root")
(defvar xmtn-sync-remote-exec-alist
(list
(list "file://" xmtn-sync-executable))
"Alist of host and remote command. Overrides `xmtn-sync-remote-exec-default'.")
;; buffer-local
(defvar xmtn-sync-local-db nil
"Absolute path to local database.")
(make-variable-buffer-local 'xmtn-sync-local-db)
(defvar xmtn-sync-remote-db nil
"Absolute path to remote database.")
(make-variable-buffer-local 'xmtn-sync-remote-db)
(defstruct (xmtn-sync-branch
(:copier nil))
;; ewoc element; data for a branch that was received
name)
(defun xmtn-sync-set-hf ()
"Set ewoc header and footer."
(ewoc-set-hf
xmtn-sync-ewoc
(concat
(format " local database : %s\n" xmtn-sync-local-db)
(format "remote database : %s\n" xmtn-sync-remote-db)
)
""))
(defun xmtn-sync-printer (branch)
"Print an ewoc element; BRANCH must be of type xmtn-sync-branch."
(insert "branch: ")
(insert (xmtn-sync-branch-name branch))
(insert "\n")
)
(defvar xmtn-sync-ewoc nil
"Buffer-local ewoc for displaying sync.
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)
(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))
(work (assoc branch xmtn-sync-branch-alist)))
(if (not work)
(progn
(setq work (read-directory-name (format "workspace root for %s: " branch)))
(push (list branch work) xmtn-sync-branch-alist)))
(xmtn-status-one work)))
(defvar xmtn-sync-ewoc-map
(let ((map (make-sparse-keymap)))
(define-key map [?0] '(menu-item "0) status"
'xmtn-sync-status))
map)
"Keyboard menu keymap for xmtn-sync-ewoc.")
(defvar xmtn-sync-mode-map
(let ((map (make-sparse-keymap)))
(define-key map [?q] 'dvc-buffer-quit)
(define-key map "\M-d" xmtn-sync-ewoc-map)
map)
"Keymap used in `xmtn-sync-mode'.")
(easy-menu-define xmtn-sync-mode-menu xmtn-sync-mode-map
"`xmtn-sync' menu"
`("Xmtn-sync"
["Do the right thing" xmtn-sync-ewoc-map t]
["Quit" dvc-buffer-quit t]
))
;; derive from nil causes no keymap to be used, but still have self-insert keys
;; derive from fundamental-mode causes self-insert keys
(define-derived-mode xmtn-sync-mode fundamental-mode "xmtn-sync"
"Major mode to specify conflict resolutions."
(setq dvc-buffer-current-active-dvc 'xmtn)
(setq buffer-read-only nil)
(setq xmtn-sync-ewoc (ewoc-create 'xmtn-sync-printer))
(setq dvc-buffer-refresh-function nil)
(dvc-install-buffer-menu)
(setq buffer-read-only t)
(buffer-disable-undo)
(set-buffer-modified-p nil))
;;;###autoload
(defun xmtn-sync-sync (local-db remote-host remote-db)
"Sync LOCAL-DB with REMOTE-HOST REMOTE-DB, display sent and received branches.
Remote-db should include branch pattern in URI syntax."
(interactive "flocal db: \nMremote-host: \nMremote-db: ")
(pop-to-buffer (get-buffer-create "*xmtn-sync*"))
(let ((xmtn-executable xmtn-sync-executable)
(xmtn--minimum-required-command-version xmtn-sync-required-command-version))
;; pass remote command to mtn via Lua hook get_mtn_command; see
;; xmtn-hooks.lua
(setenv "XMTN_SYNC_MTN"
(or (cadr (assoc remote-host xmtn-sync-remote-exec-alist))
xmtn-sync-remote-exec-default))
(xmtn-automate-command-output-buffer
default-directory ; root
(current-buffer) ; output-buffer
(list (list
"ticker" "count"
"db" local-db
) ;; options
"sync" (concat remote-host remote-db)) ;; command, args
)))
(provide 'xmtn-sync)
;; end of file

7
dvc/texinfo/Makefile.in
View File

@ -34,7 +34,7 @@ ii = install-info
install: uninstall info install: uninstall info
$(MKDIR_P) -m 0755 $(info_dir) $(MKDIR_P) -m 0755 $(info_dir)
@for i in dvc.info* ; do \ @for i in dvc.info* dvc-intro.info* ; do \
echo Installing $$i ; \ echo Installing $$i ; \
$(INSTALL_DATA) $$i $(info_dir) ; \ $(INSTALL_DATA) $$i $(info_dir) ; \
done done
@ -48,13 +48,16 @@ install: uninstall info
uninstall: uninstall:
rm -f $(info_dir)/dvc.info* rm -f $(info_dir)/dvc.info*
info: dvc.info info: dvc.info dvc-intro.info
alldeps = $(srcdir)/dvc.texinfo dvc-version.texinfo alldeps = $(srcdir)/dvc.texinfo dvc-version.texinfo
dvc.info: $(alldeps) dvc.info: $(alldeps)
$(MAKEINFO) $(srcdir)/dvc.texinfo $(MAKEINFO) $(srcdir)/dvc.texinfo
dvc-intro.info: $(alldeps)
$(MAKEINFO) $(srcdir)/dvc-intro.texinfo
dvc.html: $(alldeps) dvc.html: $(alldeps)
$(MAKEINFO) --html --no-split $(srcdir)/dvc.texinfo $(MAKEINFO) --html --no-split $(srcdir)/dvc.texinfo

940
dvc/texinfo/dvc-intro.texinfo Normal file
View File

@ -0,0 +1,940 @@
\input texinfo
@c Author : Stephen Leake <stephen_leake@stephe-leake.org>
@c Web : http://www.stephe-leake.org/
@setfilename dvc-intro.info
@settitle DVC: Introduction to the GNU Emacs interface to
distributed version control systems.
@setchapternewpage off
@node Top
@top DVC Intro
@smallexample
@group
Copyright (C) 2007, 2008, 2009, 2010 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;
with no Invariant Sections, with no Front-Cover Texts, and with no
Back-Cover Texts. A copy of the license is included in the section
entitled ``GNU Free Documentation License''.
@end group
@end smallexample
@menu
* Overview::
* Installing::
* Invoking::
* Status Display::
* Key bindings::
* Previewing updates::
* Merging::
* mtn command line::
* Common Errors and Solutions::
* GNU Free Documentation License::
@detailmenu
--- The Detailed Node Listing ---
Overview
* Basic DVC::
* Compare to CVS::
Invoking
* xmtn-status-one::
* xmtn-propagate-one::
Key bindings
* status buffer keys::
* Ediff keys::
* Log edit keys::
* DVC log keys::
* DVC diff keys::
* mtn conflicts keys::
Common Errors and Solutions
* Attach blocked by unversioned path::
* Revision id does not match conflict file::
@end detailmenu
@end menu
@node Overview
@chapter Overview
DVC is a common interface to several extremely powerful and flexible
version control systems, such as Gnu arch, monotone, bzr, and others
(known as 'backends' to DVC).
DVC provides the same (or at least similar) user interface for each
backend, making it easier to use multiple backends in related
projects. It also automates some tasks, and provides guidance to the
user as to what needs to be done.
DVC is not included with the standard Gnu emacs distribution. It is
provided in source form via a bzr repository (see @ref{Installing}).
If you are not already familiar with version control systems, please
read @ref{Basic DVC}.
One of the most important features of the DVC user interface is that
it identifies what files in a project need attention of some sort; you
have changed them in your working directory, or someone else has
changed them in the repository, or they've been deleted or are new,
etc. DVC presents a list of all such files, and makes it easy to see
what needs to be done for each file.
When committing files, ediff is used to allow reviewing the changes,
so an appropriate change comment can be written.
DVC replaces the command-line interface to the backends for the most
common operations, but it is still necessary to use the command line
at times. Creating a repository, starting a project in a repository,
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.
@menu
* Basic DVC::
* Compare to CVS::
@end menu
@node Basic DVC
@section Basic DVC
Here we give a brief introduction to general concepts of distributed
version control systems, focusing on the concepts that are needed to
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.
Let's start with some definitions:
@table @dfn
@item workspace
Each user has a workspace, containing a copy of the files she is
working on. This is typically a directory tree. In the root directory
of the tree there is typically a directory containing backend control
files, used only by the backend.
@item database
The database stores copies of all files in the workspace (and typically
more than one workspace), together with all of the change history and
other meta-information. The database is never edited directly; only
the backends modify it.
@item local database
A database on the user's machine. This database is used to
control all workspaces on the user's machine.
@item remote database
A database on a remote machine. This may be another user's local
database, or a central database set up specifically for sharing files.
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.
@item branch
A label for distinct trees of revisions. There are two main uses for
branches; parallel development on a single project, and completely
separate projects. Branches of a single project are typically merged
back together (this is called ``propagating''), while completely
separate projects are not.
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
@ref{Merging}).
@item merge
The process of combining multiple heads of a branch into one
head. This can encounter conflicts that require user resolution; see
@ref{Merging}.
@item propagate
One branch can be ``propagated'' to another. This is a form of
merging; it merges all the changes from one branch into another,
starting from their common ancestor (which is usually the previous
propagate between the two branches).
This is how changes in a development branch are promoted to the main
branch.
Since propagating is a form of merging, it can encounter all of the
same conflicts that merging can.
@item *dvc-status* buffer
A main user interface buffer. It shows all files in the workspace that
need attention. Single keystrokes invoke various operations.
@xref{Status Display}, for more details.
The name of the buffer is not literally @dfn{*dvc-status*}; instead,
@dfn{dvc} is replaced by the backend name; @dfn{xmtn} for monotone,
@dfn{bzr} for bzr, etc. But in this document, we will use the name
@dfn{*dvc-status*}.
@item *dvc-diff* buffer
Another main user interface buffer. It shows the files involved in a
particular revision, together with the diffs of the changes. Single
keystrokes invoke various operations.
@end table
Users edit files in their workspace, then use DVC to synchronize the
workspace with the local database. Later, they use the command line to
synchronize their local database with a remote database. This allows
each user to make changes locally but still under change control,
without affecting other users until they each choose to synchronize.
@node Compare to CVS
@section Compare to CVS
Since many people are familiar with the CVS version control system, we
compare that with DVC, and monotone in particular.
In CVS, each file is committed separately; in DVC, all files in a
workspace are committed together. This makes sure that all changes
that are related are committed together.
This means the commit log message mentions all files that have
changes; it is a much longer message, but there are fewer of them, and
the message can more easily describe changes that affect more than one
file.
In CVS, you must always have access to the remote server. In DVC, you
work with a local database, then separately sync that database with a
remote server. Thus DVC is useful when not on a network; monotone can
even sync via USB disk rather than a network connection.
This means there are two steps to syncing a workspace with the central
server, which can be annoying. On the other hand, the sync process
syncs all projects in the database at once; with monotone, it lets you
know what projects have changes.
Otherwise the primary Emacs interface to CVS and DVC are very similar,
although DVC has many secondary interfaces that CVS does not have.
@node Installing
@chapter Installing
Install bzr; see @url{http://bazaar.canonical.com/en/}.
Retrieve the DCV source; see
@url{https://gna.org/projects/dvc#options} for general information.
In a bash shell:
@example
cd ~
bzr get http://bzr.xsteve.at/dvc/
cd ~/dvc
autoconf
./configure
make
@end example
In your @file{.emacs}, add @code{(load-file (expand-file-name "~/dvc/dvc-load.el"))}
@node Invoking
@chapter Invoking
Before invoking DVC, you may want to ensure that the local database is
synchronized with the central database, via a backend-specific
command line.
You typically invoke DVC with the Emacs command @command{dvc-status}
or @command{dvc-diff}. This prompts for a workspace; it should be the
top level directory in your working directory tree.
You can also create shortcuts in text files to invoke dvc:
@example
(dvc-status (expand-file-name "~/dvc"))
(dvc-diff nil (expand-file-name "~/dvc"))
@end example
These can be executed with @key{C-x C-e}, and are a handy way of
keeping track of several workspaces.
@command{dvc-status} or @command{dvc-diff} run the corresponding
backend command, comparing the workspace against the local database,
and presenting the information in the @dfn{*dvc-status*} or
@dfn{*dvc-diff*} buffer.
For monotone, there are higher-level starting points:
@table @command
@item xmtn-status-one
Summarizes the status of one workspace.
@item xmtn-status-multiple
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
@item xmtn-propagate-multiple
Supervises propagating several workspaces
@end table
@menu
* xmtn-status-one::
* xmtn-propagate-one::
@end menu
@node xmtn-status-one
@section xmtn-status-one
Summarizes the status of one workspace, in a @dfn{xmtn-multi-status}
buffer. The branch name is shown, followed by possible appropriate
actions. As each action is performed, it is replaced by the next
action, until there are none left.
Similarly, @command{xmtn-status-multiple} shows the status of all
workspaces immediately under a root directory.
Actions are invoked with @key{M-d}.
The possible actions are:
@table @dfn
@item need-refresh
Shown while the backend is computing, or the user is performing
operations in an associated @dfn{*xmtn-multi-status*} buffer.
@item commit
Open an @dfn{*xmtn-status*} buffer to commit changes.
@item resolve conflicts
Open an @dfn{*xmtn-conflicts*} buffer to resolve conflicts; see @ref{Merging}.
@item show heads
Open an @dfn{*xmtn-revlist*} buffer to show the current head revisions.
@item merge
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 ignore local changes
Don't show @dfn{commit}.
@item refresh
Recompute the @dfn{*xmtn-multi-status*} display.
@item clean/delete
Delete conflicts and conflict resolution files, and delete
the workspace from the display.
@end table
@node xmtn-propagate-one
@section xmtn-propagate-one
@command{xmtn-propagate-one} supervises the process of propagating
from one workspace to another, in an @dfn{xmtn-propagate} buffer.
The display shows one source and destination branch pair, and possible
appropriate actions. As each action is performed, it is replaced by
the next action, until there are none left.
Similarly, @command{xmtn-propagate-multiple} supervises the
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.
Actions are invoked with @key{M-d}.
The possible actions are:
@table @command
@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
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.
@item ignore local changes ``from''
@item ignore local changes ``to''
Don't show @dfn{local changes unknown}; assume the workspace is
committed. Useful when you know that any local changes won't interfere
with the propagate.
@item resolve conflicts
Open an @dfn{*xmtn-conflicts*} buffer in the destination workspace to
resolve propagate conflicts; see @ref{Merging}.
@item propagate
Propagate the branch pair, using the conflict resolutions.
@item refresh
Recompute the display. If prefixed with @key{C-u}, force examining
workspaces for local changes.
@item clean/delete
Delete conflicts and conflict resolution files, and delete
the workspace from the display.
@end table
@node Status Display
@chapter Status Display
After invoking @command{dvc-status}, you are presented with the
@dfn{*dvc-status*} buffer.
The detailed format differs depending on the backend. This
presentation is close to the bzr and mtn formats.
The buffer contains a header, such as:
@example
Status for c:/Projects/GDS/common/main/:
base revision : e946839c833b15e6bf12bd1536764e1106c41924
branch : common.main
branch is merged
base revision is a head revision
@end example
The last two lines are important; either may have ``not'' in it.
If the branch is not merged, it must be merged before an update can be
done; see @ref{Merging}. However, commits can be done when the branch
is not merged; this allows saving work before attempting the merge.
If the base revision is not a head revision, there are updates that
need to be applied to the workspace. The updates may be reviewed first
using @key{M m}; they may be applied using @key{M u}.
In the main body of the buffer, there is one line for each file in the
workspace that needs attention. For example:
@example
* modified hardware/gds-hardware-pmrd_wrapper.adb
unknown build/ip1k110_quartus/serv_req_info.txt
E modified hardware/test/test_hardware-one_harness.adb
@end example
Each line has three fields:
@table @dfn
@item Mark
Either blank (not marked), '*' (marked), or 'E' (excluded). Most
commands can apply to a group of marked files, but some cannot (they
warn if a group is marked).
Excluded files are under configuration management, but are excluded
from commits. This is used for files that each user modifies, such as
development test drivers.
@item Status
A phrase indicating the status of the file; see the table below.
@item File name
Gives the file name of the working file, with a path relative to the
root directory.
@end table
In addition, some files will have extra status information that
appears on the next line, indented.
The following table defines each status phrase, and gives the set of
actions that can be taken for each. The action shown is from the DVC
menu; the equivalent key is also given.
Other actions (such as commit) apply to all files; they are discussed
later.
@table @samp
@c the list of status phrases is in
@c /Gnu/dvc/lisp/dvc-fileinfo.el dvc-fileinfo-status-image
@c keep this list in the same order
@item Added
Working file has been added, but not committed.
@table @samp
@item @key{r} Delete
Remove the file from the workspace, do not commit it.
Do this if you've changed your mind.
@end table
@item Conflict
A conflict was detected while merging.
The same lines have been edited differently by different people.
This status does not appear with the monotone back-end.
@table @samp
@item @key{<enter>} Edit the file.
Either resolve the conflict
manually, or use @code{M-x smerge-ediff}. Execute @code{M-x
dvc-resolve} when finished to inform the back-end that the
conflict is resolved.
@item @key{U} Revert
Delete the working copy, replace it with the database copy. Do
this if you decide the changes are not correct.
@end table
@item Deleted
Working file has been marked for deletion, but not committed.
@table @samp
@item @key{a} Add
Undo the removal.
@end table
@item Ignored
Working file is ignored by the back-end. Files with this status
are not typically shown - ignored files are ignored by DVC as well.
They can be enabled by setting @code{dvc-status-display-ignored} to
nil.
@table @samp
@item @key{# e}
Edit the back-end ignore file.
@end table
@item Known
Working file is known to the back-end, and unchanged. Files with
this status are not typically shown. They can be enabled by setting
@code{dvc-status-display-known} to nil. There are no appropriate
actions.
@item Missing
A previously known file has been deleted from the workspace, but
not marked for deletion.
@table @samp
@key{U} Revert
Restore the file to the workspace from the database.
@item @key{r} Delete
Mark the file for deletion.
@end table
@item Modified
A changed file in the workspace.
@table @samp
@item @key{e} ediff
Review differences and collect a change comment.
@item @key{U} Revert
Delete the working copy, replace it with the database copy. Do
this if you decide your changes are not correct.
@end table
@item Rename-source
Working file has been marked as renamed but not committed. No
appropriate actions.
@item Rename-target
Working file has been marked as renamed but not committed. No
appropriate actions.
@item Unknown
Working file is unknown.
@table @samp
@item @key{a} Add
The file is a new source file; add it to the current revision. This will
change the status to 'Added'.
@item @key{i} Ignore
The file is an output file of some sort (ie object file, test output).
Ignore it in all future DVC sessions.
@item @key{I} Ignore extension in dir
Ignore all files with this extension in this directory.
@item @key{M-I} Ignore extension
Ignore all files with this extension in all directories.
@item @key{r} Delete
The file is a scratch file, or was created by mistake. Remove it from
the workspace.
@end table
@end table
Changes are committed all at once; the set of changes to the entire
workspace is called a ``revision''. @key{c} opens the
@code{*dvc-log-edit*} buffer, where you can write a change comment.
Then @key{C-c C-c} commits all changes.
The key @key{M-d} invokes a function called ``Do the Right Thing''. If
there is only a single choice (or an extremely common choice) in the
table above, it does that action. Otherwise, it presents a short list
of the actions, in the message buffer, reminding the user of the
appropriate options. Note that @key{M-d} means meta-d (alt-d on most
PC keyboards))
@node Key bindings
@chapter Key bindings
Here is a summary of the most useful key bindings in the various
buffers associated with DVC.
@menu
* status buffer keys::
* Ediff keys::
* Log edit keys::
* DVC log keys::
* DVC diff keys::
* mtn conflicts keys::
@end menu
@node status buffer keys
@section status buffer keys
In a @code{*dvc-status*} buffer:
@table @key
@item M-d
Do the right thing for the current file.
@item c
Open a @code{*dvc-log-edit*} buffer to accumulate comments for a
commit.
@item M m
Show missing revisions; changes that will be applied by update.
@item M M
Merge current heads; see @ref{Merging}.
@item M u
Update to the current head.
@item R
Rename a missing to an unknown file. The two files must be marked
first, and they must be the only files marked.
@item t
Create an entry in the @code{*dvc-log-edit*} for the current diff.
@end table
@node Ediff keys
@section Ediff keys
In an Ediff control buffer (the small window with Ediff in the title bar):
@table @key
@item a
Copy from buffer A to buffer B.
@item b
Copy from buffer B to buffer A.
@item n
Move to next diff.
@item p
Move to previous diff.
@item q
Quit Ediff.
@item t
Create an entry in the @code{*dvc-log-edit*} for the current diff.
@item $$
Focus on conflicts in a merge.
@item ?
Show the help summary for Ediff. @key{?} hides it again.
@end table
@node Log edit keys
@section log edit keys
In the @code{*dvc-log-edit*} buffer:
@table @key
@item C-c C-c
Commit. Note that this is the only way to actually commit.
@end table
@node DVC log keys
@section DVC log keys
In a @code{*xmtn-log*} buffer:
@table @key
@item n
move to the next revision
@item p
move to the previous revision
@item =
show a diff of the changes in a single revision
@item C-=
show a diff between the revision and the workspace
@end table
@node DVC diff keys
@section DVC diff keys
In a @code{*dvc-diff*} buffer:
@table @key
@item e
show ediff for current file
@item j
jump between file list and diff hunks
@item n
move to the next diff hunk
@item p
move to the previous diff hunk
@end table
@node mtn conflicts keys
@section mtn conflicts keys
In a @code{*xmtn-conflicts*} buffer:
@table @key
@item C
Delete conflicts file and any resolution files.
@item c
Clear the current resolution, so you can specify a different one.
@item n
Move to the next conflict.
@item N
Move to the next unresolved conflict.
@item p
Move to the previous conflict.
@item P
Move to the previous unresolved conflict.
@item q
Quit the @code{*xmtn-conflicts*} buffer. The conflicts file and
associated resolution files are saved.
@item r
Specify a resolution for the current conflict. This prompts with a
choice of resolutions appropriate for the current conflict; select the
appropriate resolution by number. See @ref{Merging}, for information
on the possible resolutions.
@item M-d
Same as @key{r}
@end table
@node Previewing updates
@chapter Previewing updates
To preview updates before applying them to your workspace, use the
@code{dvc-missing} command; it's on the status buffer menu at
@code{DVC | Merge/Update | show missing}.
@code{dvc-missing} can also be invoked via the Emacs command line
(@key{M-x}); that prompts for a local tree.
Invoking @code{dvc-missing} brings up an @code{*dvc-log*} window,
showing revisions that are in your local database but not yet applied
to the workspace.
The revisions are listed oldest first.
You can view the changes made in a single revision, or from that
revision to the current workspace.
See @xref{Log edit keys}, for key bindings.
@key{=} and @key{C-=} bring up a @code{*dvc-diff*} buffer for the
revision selected. The diffs are shown in Gnu diff format; all files
in one @code{*dvc-diff*} buffer. There is a list of the files at the
top of the buffer. See @xref{DVC diff keys}, for key bindings.
Note that you can also review updates after they have been
applied. This is often more useful, because you can edit the workspace
file to fix problems caused by the update, or just to see the final
state after all revisions have been applied.
@node Merging
@chapter Merging
Monotone allows multiple people to each commit to their local
database. Then when the databases are synced, there are multiple heads
for the branch; one head for each developer that commited since the
last sync.
These multiple heads must be merged before a local workspace can be
updated to the head of the branch; there must be only one head to
update to. The monotone command line allows updating to one head of an
unmerged branch, but DVC does not support this.
When the changes in the different heads are to different files, or to
different parts of the same file, monotone can perform the merge
itself. However, when there are changes to the same parts of one file,
it needs help; this is called a content conflict.
An @code{*xmtn-conflicts*} buffer shows all conflicts in a merge or
propagate. You can work thru the list one a time, using @key{M-d}
to specify conflict resolutions. The list is saved in a file, so you
can come back to it later.
The conflicts that monotone knows how to resolve internally have
resolutions of @code{resolved-internal}; the others have no
resolutions.
The conflicts file and associated resolution files are stored in the
monotone bookkeeping area. They must be deleted when you are done with
them; use @key{C C} for that.
@key{M-d} prompts with a list of appropriate resolutions for the
current conflict; select the appropriate resolution by number. The
possible resolutions are:
@table @asis
@item right: drop
@itemx left: drop
Resolve one side of a duplicate name conflict by dropping it.
@itemx drop
Resolve an orphaned node conflict by dropping it.
@item right: rename
@itemx left: rename
Resolve one side of a duplicate name conflict by specifying a new name.
@item rename
Resolve an orphaned node conflict by specifying a new name.
@item right: right file
@itemx right: left file
@itemx left: right file
@itemx left: left file
Resolve one side of a duplicate name conflict by specifying a file.
The other side must be dropped or renamed.
@itemx left file
Resolve a content conflict by specifying a file. The file defaults to
the current workspace file.
@item right: keep
@itemx left: keep
Resolve one side of a duplicate name conflict by keeping it as is.
The other side must be dropped or renamed.
@item right: ediff
@itemx left: ediff
Resolve one side of a duplicate name conflict by ediff. This brings up
an ediff merge of the two files, and saves the result in the
resolution file area.
The other side must be dropped or renamed.
@item ediff
Resolve a content conflict via ediff. This brings up an ediff merge of
the two files, and saves the result in the resolution file area.
@end table
See @xref{mtn conflicts keys}, for a summary of key bindings.
@node mtn command line
@chapter mtn command line
Sometimes, especially over NFS, the Emacs DVC interface can be
painfully slow, and it is appropriate to use the mtn command line
instead.
Other times, the mtn command line is just simpler.
So we list the most useful mtn commands here. See the monotone command
line help or manual for more information.
@table @code
@item status
@code{mtn status}
@item commit
@code{mtn commit --message="<message>"}
@code{mtn commit --message-file=_MTN/log}
@item rename
@code{mtn rename <file> <new-file>}
@item update
@code{mtn update --move-conflicting-paths}
@end table
@node Common Errors and Solutions
@chapter Common Errors and Solutions
@menu
* Attach blocked by unversioned path::
* Revision id does not match conflict file::
@end menu
@node Attach blocked by unversioned path
@section Attach blocked by unversioned path
Problem: When attempting to update a directory, this warning appears:
@example
$ mtn update
...
mtn: warning: attach node 2147486644 blocked by unversioned path '<file path>'
mtn: misuse: 1 workspace conflict
@end example
Explanation: "Unversioned path" means the indicated file is not in the
current revision, however the file already exists on the disk. The
revision you are updating to contains the file, but it can't be
updated because it would overwrite the unknown file on the disk
Solution: Delete the indicated files from the disk and retry the
update, or specify the @command{--move-conflicting-paths} option.
@node Revision id does not match conflict file
@section Revision id does not match conflict file
Problem: When attempting to propagate from one branch to another, this message appears:
@example
$ mtn: propagating common.main -> common.work_user
mtn: [left] 48b675060af47a02bc6f773bd63647726f96cbd5
mtn: [right] 94ffd0b529dfb44c3ab122fe6c514b5f2e857104
mtn: misuse: left revision id does not match conflict file
@end example
Explanation: It means you have some conflict files left over from a
previous propagation or merge.
Solution: In a buffer showing the ``from'' workspace, run: M-x
xmtn-conflicts-clean. Repeat in the ``to'' workspace, then propagate
again.
@node GNU Free Documentation License, , Common Errors and Solutions, Top
@appendix GNU Free Documentation License
@include fdl.texinfo
@bye

409
dvc/texinfo/fdl.texinfo Normal file
View File

@ -0,0 +1,409 @@
@c This file is derived from the GNU file fdl.texi, by deleting the
@c addendum "How to use this License for your documents" and by deleting
@c the @node and @appendixsec commands. The later need to be in the main
@c texinfo file for the Emacs automatic menu-building commands to work.
@cindex FDL, GNU Free Documentation License
@center Version 1.2, November 2002
@display
Copyright @copyright{} 2000,2001,2002 Free Software Foundation, Inc.
51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
@end display
@enumerate 0
@item
PREAMBLE
The purpose of this License is to make a manual, textbook, or other
functional and useful document @dfn{free} in the sense of freedom: to
assure everyone the effective freedom to copy and redistribute it,
with or without modifying it, either commercially or noncommercially.
Secondarily, this License preserves for the author and publisher a way
to get credit for their work, while not being considered responsible
for modifications made by others.
This License is a kind of ``copyleft'', which means that derivative
works of the document must themselves be free in the same sense. It
complements the GNU General Public License, which is a copyleft
license designed for free software.
We have designed this License in order to use it for manuals for free
software, because free software needs free documentation: a free
program should come with manuals providing the same freedoms that the
software does. But this License is not limited to software manuals;
it can be used for any textual work, regardless of subject matter or
whether it is published as a printed book. We recommend this License
principally for works whose purpose is instruction or reference.
@item
APPLICABILITY AND DEFINITIONS
This License applies to any manual or other work, in any medium, that
contains a notice placed by the copyright holder saying it can be
distributed under the terms of this License. Such a notice grants a
world-wide, royalty-free license, unlimited in duration, to use that
work under the conditions stated herein. The ``Document'', below,
refers to any such manual or work. Any member of the public is a
licensee, and is addressed as ``you''. You accept the license if you
copy, modify or distribute the work in a way requiring permission
under copyright law.
A ``Modified Version'' of the Document means any work containing the
Document or a portion of it, either copied verbatim, or with
modifications and/or translated into another language.
A ``Secondary Section'' is a named appendix or a front-matter section
of the Document that deals exclusively with the relationship of the
publishers or authors of the Document to the Document's overall
subject (or to related matters) and contains nothing that could fall
directly within that overall subject. (Thus, if the Document is in
part a textbook of mathematics, a Secondary Section may not explain
any mathematics.) The relationship could be a matter of historical
connection with the subject or with related matters, or of legal,
commercial, philosophical, ethical or political position regarding
them.
The ``Invariant Sections'' are certain Secondary Sections whose titles
are designated, as being those of Invariant Sections, in the notice
that says that the Document is released under this License. If a
section does not fit the above definition of Secondary then it is not
allowed to be designated as Invariant. The Document may contain zero
Invariant Sections. If the Document does not identify any Invariant
Sections then there are none.
The ``Cover Texts'' are certain short passages of text that are listed,
as Front-Cover Texts or Back-Cover Texts, in the notice that says that
the Document is released under this License. A Front-Cover Text may
be at most 5 words, and a Back-Cover Text may be at most 25 words.
A ``Transparent'' copy of the Document means a machine-readable copy,
represented in a format whose specification is available to the
general public, that is suitable for revising the document
straightforwardly with generic text editors or (for images composed of
pixels) generic paint programs or (for drawings) some widely available
drawing editor, and that is suitable for input to text formatters or
for automatic translation to a variety of formats suitable for input
to text formatters. A copy made in an otherwise Transparent file
format whose markup, or absence of markup, has been arranged to thwart
or discourage subsequent modification by readers is not Transparent.
An image format is not Transparent if used for any substantial amount
of text. A copy that is not ``Transparent'' is called ``Opaque''.
Examples of suitable formats for Transparent copies include plain
@sc{ascii} without markup, Texinfo input format, La@TeX{} input
format, @acronym{SGML} or @acronym{XML} using a publicly available
@acronym{DTD}, and standard-conforming simple @acronym{HTML},
PostScript or @acronym{PDF} designed for human modification. Examples
of transparent image formats include @acronym{PNG}, @acronym{XCF} and
@acronym{JPG}. Opaque formats include proprietary formats that can be
read and edited only by proprietary word processors, @acronym{SGML} or
@acronym{XML} for which the @acronym{DTD} and/or processing tools are
not generally available, and the machine-generated @acronym{HTML},
PostScript or @acronym{PDF} produced by some word processors for
output purposes only.
The ``Title Page'' means, for a printed book, the title page itself,
plus such following pages as are needed to hold, legibly, the material
this License requires to appear in the title page. For works in
formats which do not have any title page as such, ``Title Page'' means
the text near the most prominent appearance of the work's title,
preceding the beginning of the body of the text.
A section ``Entitled XYZ'' means a named subunit of the Document whose
title either is precisely XYZ or contains XYZ in parentheses following
text that translates XYZ in another language. (Here XYZ stands for a
specific section name mentioned below, such as ``Acknowledgements'',
``Dedications'', ``Endorsements'', or ``History''.) To ``Preserve the Title''
of such a section when you modify the Document means that it remains a
section ``Entitled XYZ'' according to this definition.
The Document may include Warranty Disclaimers next to the notice which
states that this License applies to the Document. These Warranty
Disclaimers are considered to be included by reference in this
License, but only as regards disclaiming warranties: any other
implication that these Warranty Disclaimers may have is void and has
no effect on the meaning of this License.
@item
VERBATIM COPYING
You may copy and distribute the Document in any medium, either
commercially or noncommercially, provided that this License, the
copyright notices, and the license notice saying this License applies
to the Document are reproduced in all copies, and that you add no other
conditions whatsoever to those of this License. You may not use
technical measures to obstruct or control the reading or further
copying of the copies you make or distribute. However, you may accept
compensation in exchange for copies. If you distribute a large enough
number of copies you must also follow the conditions in section 3.
You may also lend copies, under the same conditions stated above, and
you may publicly display copies.
@item
COPYING IN QUANTITY
If you publish printed copies (or copies in media that commonly have
printed covers) of the Document, numbering more than 100, and the
Document's license notice requires Cover Texts, you must enclose the
copies in covers that carry, clearly and legibly, all these Cover
Texts: Front-Cover Texts on the front cover, and Back-Cover Texts on
the back cover. Both covers must also clearly and legibly identify
you as the publisher of these copies. The front cover must present
the full title with all words of the title equally prominent and
visible. You may add other material on the covers in addition.
Copying with changes limited to the covers, as long as they preserve
the title of the Document and satisfy these conditions, can be treated
as verbatim copying in other respects.
If the required texts for either cover are too voluminous to fit
legibly, you should put the first ones listed (as many as fit
reasonably) on the actual cover, and continue the rest onto adjacent
pages.
If you publish or distribute Opaque copies of the Document numbering
more than 100, you must either include a machine-readable Transparent
copy along with each Opaque copy, or state in or with each Opaque copy
a computer-network location from which the general network-using
public has access to download using public-standard network protocols
a complete Transparent copy of the Document, free of added material.
If you use the latter option, you must take reasonably prudent steps,
when you begin distribution of Opaque copies in quantity, to ensure
that this Transparent copy will remain thus accessible at the stated
location until at least one year after the last time you distribute an
Opaque copy (directly or through your agents or retailers) of that
edition to the public.
It is requested, but not required, that you contact the authors of the
Document well before redistributing any large number of copies, to give
them a chance to provide you with an updated version of the Document.
@item
MODIFICATIONS
You may copy and distribute a Modified Version of the Document under
the conditions of sections 2 and 3 above, provided that you release
the Modified Version under precisely this License, with the Modified
Version filling the role of the Document, thus licensing distribution
and modification of the Modified Version to whoever possesses a copy
of it. In addition, you must do these things in the Modified Version:
@enumerate A
@item
Use in the Title Page (and on the covers, if any) a title distinct
from that of the Document, and from those of previous versions
(which should, if there were any, be listed in the History section
of the Document). You may use the same title as a previous version
if the original publisher of that version gives permission.
@item
List on the Title Page, as authors, one or more persons or entities
responsible for authorship of the modifications in the Modified
Version, together with at least five of the principal authors of the
Document (all of its principal authors, if it has fewer than five),
unless they release you from this requirement.
@item
State on the Title page the name of the publisher of the
Modified Version, as the publisher.
@item
Preserve all the copyright notices of the Document.
@item
Add an appropriate copyright notice for your modifications
adjacent to the other copyright notices.
@item
Include, immediately after the copyright notices, a license notice
giving the public permission to use the Modified Version under the
terms of this License, in the form shown in the Addendum below.
@item
Preserve in that license notice the full lists of Invariant Sections
and required Cover Texts given in the Document's license notice.
@item
Include an unaltered copy of this License.
@item
Preserve the section Entitled ``History'', Preserve its Title, and add
to it an item stating at least the title, year, new authors, and
publisher of the Modified Version as given on the Title Page. If
there is no section Entitled ``History'' in the Document, create one
stating the title, year, authors, and publisher of the Document as
given on its Title Page, then add an item describing the Modified
Version as stated in the previous sentence.
@item
Preserve the network location, if any, given in the Document for
public access to a Transparent copy of the Document, and likewise
the network locations given in the Document for previous versions
it was based on. These may be placed in the ``History'' section.
You may omit a network location for a work that was published at
least four years before the Document itself, or if the original
publisher of the version it refers to gives permission.
@item
For any section Entitled ``Acknowledgements'' or ``Dedications'', Preserve
the Title of the section, and preserve in the section all the
substance and tone of each of the contributor acknowledgements and/or
dedications given therein.
@item
Preserve all the Invariant Sections of the Document,
unaltered in their text and in their titles. Section numbers
or the equivalent are not considered part of the section titles.
@item
Delete any section Entitled ``Endorsements''. Such a section
may not be included in the Modified Version.
@item
Do not retitle any existing section to be Entitled ``Endorsements'' or
to conflict in title with any Invariant Section.
@item
Preserve any Warranty Disclaimers.
@end enumerate
If the Modified Version includes new front-matter sections or
appendices that qualify as Secondary Sections and contain no material
copied from the Document, you may at your option designate some or all
of these sections as invariant. To do this, add their titles to the
list of Invariant Sections in the Modified Version's license notice.
These titles must be distinct from any other section titles.
You may add a section Entitled ``Endorsements'', provided it contains
nothing but endorsements of your Modified Version by various
parties---for example, statements of peer review or that the text has
been approved by an organization as the authoritative definition of a
standard.
You may add a passage of up to five words as a Front-Cover Text, and a
passage of up to 25 words as a Back-Cover Text, to the end of the list
of Cover Texts in the Modified Version. Only one passage of
Front-Cover Text and one of Back-Cover Text may be added by (or
through arrangements made by) any one entity. If the Document already
includes a cover text for the same cover, previously added by you or
by arrangement made by the same entity you are acting on behalf of,
you may not add another; but you may replace the old one, on explicit
permission from the previous publisher that added the old one.
The author(s) and publisher(s) of the Document do not by this License
give permission to use their names for publicity for or to assert or
imply endorsement of any Modified Version.
@item
COMBINING DOCUMENTS
You may combine the Document with other documents released under this
License, under the terms defined in section 4 above for modified
versions, provided that you include in the combination all of the
Invariant Sections of all of the original documents, unmodified, and
list them all as Invariant Sections of your combined work in its
license notice, and that you preserve all their Warranty Disclaimers.
The combined work need only contain one copy of this License, and
multiple identical Invariant Sections may be replaced with a single
copy. If there are multiple Invariant Sections with the same name but
different contents, make the title of each such section unique by
adding at the end of it, in parentheses, the name of the original
author or publisher of that section if known, or else a unique number.
Make the same adjustment to the section titles in the list of
Invariant Sections in the license notice of the combined work.
In the combination, you must combine any sections Entitled ``History''
in the various original documents, forming one section Entitled
``History''; likewise combine any sections Entitled ``Acknowledgements'',
and any sections Entitled ``Dedications''. You must delete all
sections Entitled ``Endorsements.''
@item
COLLECTIONS OF DOCUMENTS
You may make a collection consisting of the Document and other documents
released under this License, and replace the individual copies of this
License in the various documents with a single copy that is included in
the collection, provided that you follow the rules of this License for
verbatim copying of each of the documents in all other respects.
You may extract a single document from such a collection, and distribute
it individually under this License, provided you insert a copy of this
License into the extracted document, and follow this License in all
other respects regarding verbatim copying of that document.
@item
AGGREGATION WITH INDEPENDENT WORKS
A compilation of the Document or its derivatives with other separate
and independent documents or works, in or on a volume of a storage or
distribution medium, is called an ``aggregate'' if the copyright
resulting from the compilation is not used to limit the legal rights
of the compilation's users beyond what the individual works permit.
When the Document is included in an aggregate, this License does not
apply to the other works in the aggregate which are not themselves
derivative works of the Document.
If the Cover Text requirement of section 3 is applicable to these
copies of the Document, then if the Document is less than one half of
the entire aggregate, the Document's Cover Texts may be placed on
covers that bracket the Document within the aggregate, or the
electronic equivalent of covers if the Document is in electronic form.
Otherwise they must appear on printed covers that bracket the whole
aggregate.
@item
TRANSLATION
Translation is considered a kind of modification, so you may
distribute translations of the Document under the terms of section 4.
Replacing Invariant Sections with translations requires special
permission from their copyright holders, but you may include
translations of some or all Invariant Sections in addition to the
original versions of these Invariant Sections. You may include a
translation of this License, and all the license notices in the
Document, and any Warranty Disclaimers, provided that you also include
the original English version of this License and the original versions
of those notices and disclaimers. In case of a disagreement between
the translation and the original version of this License or a notice
or disclaimer, the original version will prevail.
If a section in the Document is Entitled ``Acknowledgements'',
``Dedications'', or ``History'', the requirement (section 4) to Preserve
its Title (section 1) will typically require changing the actual
title.
@item
TERMINATION
You may not copy, modify, sublicense, or distribute the Document except
as expressly provided for under this License. Any other attempt to
copy, modify, sublicense or distribute the Document is void, and will
automatically terminate your rights under this License. However,
parties who have received copies, or rights, from you under this
License will not have their licenses terminated so long as such
parties remain in full compliance.
@item
FUTURE REVISIONS OF THIS LICENSE
The Free Software Foundation may publish new, revised versions
of the GNU Free Documentation License from time to time. Such new
versions will be similar in spirit to the present version, but may
differ in detail to address new problems or concerns. See
@uref{http://www.gnu.org/copyleft/}.
Each version of the License is given a distinguishing version number.
If the Document specifies that a particular numbered version of this
License ``or any later version'' applies to it, you have the option of
following the terms and conditions either of that specified version or
of any later version that has been published (not as a draft) by the
Free Software Foundation. If the Document does not specify a version
number of this License, you may choose any version ever published (not
as a draft) by the Free Software Foundation.
@end enumerate