update dvc

This commit is contained in:
Kai Tetzlaff 2012-07-29 23:06:41 +02:00
parent 34d25895bf
commit 510d1a196b
27 changed files with 435 additions and 724 deletions

View File

@ -56,6 +56,7 @@ AC_CONFIG_FILES([Makefile lisp/Makefile texinfo/Makefile dvc-load.el lisp/dvc-si
# Common system utilities checking: # Common system utilities checking:
AC_PROG_MAKE_SET AC_PROG_MAKE_SET
AC_PROG_INSTALL AC_PROG_INSTALL
AC_PROG_MKDIR_P
# External programs checking: # External programs checking:
@ -170,6 +171,15 @@ if test "x${HAS_TREE_WIDGET}" = "xno" ; then
AC_MSG_WARN([*** if tree-widget.el is already present on your system]) AC_MSG_WARN([*** if tree-widget.el is already present on your system])
fi fi
AC_MSG_CHECKING([for the date utility flavor])
if date --version 2>/dev/null | grep GNU ; then
DATE_FLAVOR="GNU"
else
DATE_FLAVOR="BSD"
fi
AC_MSG_RESULT([${DATE_FLAVOR}])
AC_SUBST([DATE_FLAVOR])
AC_OUTPUT AC_OUTPUT
# configure.ac ends here # configure.ac ends here

0
dvc/debian/rules Normal file → Executable file
View File

0
dvc/docs/CONTRIBUTORS Normal file → Executable file
View File

0
dvc/install-sh Normal file → Executable file
View File

View File

@ -191,7 +191,7 @@ indicate statuses."
(progn (progn
(newline) (newline)
(insert " ") (insert " ")
(ecase (dvc-fileinfo-file-status fileinfo) (case (dvc-fileinfo-file-status fileinfo)
(rename-source (rename-source
(insert "to ")) (insert "to "))
(rename-target (rename-target
@ -301,7 +301,7 @@ point is not on a file element line. If file status is
(let ((fileinfo (dvc-fileinfo-current-fileinfo))) (let ((fileinfo (dvc-fileinfo-current-fileinfo)))
(etypecase fileinfo (etypecase fileinfo
(dvc-fileinfo-file ; also matches dvc-fileinfo-dir (dvc-fileinfo-file ; also matches dvc-fileinfo-dir
(ecase (dvc-fileinfo-file-status fileinfo) (case (dvc-fileinfo-file-status fileinfo)
(rename-source (rename-source
;; target name is in more-status ;; target name is in more-status
(dvc-fileinfo-file-more-status fileinfo)) (dvc-fileinfo-file-more-status fileinfo))
@ -319,15 +319,11 @@ dvc-fileinfo-current-file only for renamed files."
(let ((fileinfo (dvc-fileinfo-current-fileinfo))) (let ((fileinfo (dvc-fileinfo-current-fileinfo)))
(etypecase fileinfo ; also matches dvc-fileinfo-dir (etypecase fileinfo ; also matches dvc-fileinfo-dir
(dvc-fileinfo-file (dvc-fileinfo-file
(ecase (dvc-fileinfo-file-status fileinfo) (case (dvc-fileinfo-file-status fileinfo)
(rename-target (rename-target
;; source name is in more-status, and it includes the path ;; source name is in more-status, and it includes the path
(dvc-fileinfo-file-more-status fileinfo)) (dvc-fileinfo-file-more-status fileinfo))
(t (t
<<<<<<< TREE
(concat (dvc-fileinfo-file-dir fileinfo)
(dvc-fileinfo-file-file fileinfo)))))
=======
;; see if there is a rename for this file in the ewoc ;; see if there is a rename for this file in the ewoc
(let ((found-data (let ((found-data
(ewoc-collect (ewoc-collect
@ -345,7 +341,6 @@ dvc-fileinfo-current-file only for renamed files."
(dvc-fileinfo-file-more-status (car found-data)) (dvc-fileinfo-file-more-status (car found-data))
(concat (dvc-fileinfo-file-dir fileinfo) (concat (dvc-fileinfo-file-dir fileinfo)
(dvc-fileinfo-file-file fileinfo))))))) (dvc-fileinfo-file-file fileinfo)))))))
>>>>>>> MERGE-SOURCE
(dvc-fileinfo-legacy (dvc-fileinfo-legacy
(cadr (dvc-fileinfo-legacy-data fileinfo)))))) (cadr (dvc-fileinfo-legacy-data fileinfo))))))
@ -392,9 +387,7 @@ marked legacy fileinfos."
;; legacy files ;; legacy files
nil))) nil)))
(defun dvc-fileinfo-mark-dir-1 (fileinfo mark) (defun dvc-fileinfo-mark-dir-1 (fileinfo mark dir-compare)
;; `dir-compare' must be let-bound to the directory being marked.
;; It can't be a normal parameter because this is called via ewoc-map.
;; Note that fileinfo will only be fileinfo-file or fileinfo-dir ;; Note that fileinfo will only be fileinfo-file or fileinfo-dir
(if (string-equal dir-compare (dvc-fileinfo-file-dir fileinfo)) (if (string-equal dir-compare (dvc-fileinfo-file-dir fileinfo))
(let ((file (dvc-fileinfo-path fileinfo))) (let ((file (dvc-fileinfo-path fileinfo)))
@ -419,17 +412,17 @@ marked legacy fileinfos."
(defun dvc-fileinfo-mark-dir (dir mark) (defun dvc-fileinfo-mark-dir (dir mark)
"Set the mark for all files in DIR to MARK, recursively." "Set the mark for all files in DIR to MARK, recursively."
(let ((dir-compare (file-name-as-directory dir))) (ewoc-map (lambda (fileinfo dir-compare)
(ewoc-map (lambda (fileinfo)
(etypecase fileinfo (etypecase fileinfo
(dvc-fileinfo-file ; also matches dvc-fileinfo-dir (dvc-fileinfo-file ; also matches dvc-fileinfo-dir
(dvc-fileinfo-mark-dir-1 fileinfo mark)) (dvc-fileinfo-mark-dir-1 fileinfo mark dir-compare))
(dvc-fileinfo-message nil) (dvc-fileinfo-message nil)
(dvc-fileinfo-legacy (dvc-fileinfo-legacy
(error "dvc-fileinfo-mark-dir not implemented for legacy back-ends")))) (error "dvc-fileinfo-mark-dir not implemented for legacy back-ends"))))
dvc-fileinfo-ewoc))) dvc-fileinfo-ewoc
(file-name-as-directory dir)))
(defun dvc-fileinfo-mark-file-1 (mark) (defun dvc-fileinfo-mark-file-1 (mark)
"Set the mark for file under point to MARK. If a directory, mark all files "Set the mark for file under point to MARK. If a directory, mark all files
@ -733,7 +726,7 @@ fileinfos, just call `dvc-remove-files'."
(let ((elems (or (dvc-fileinfo-marked-elems) (let ((elems (or (dvc-fileinfo-marked-elems)
(list (ewoc-locate dvc-fileinfo-ewoc)))) (list (ewoc-locate dvc-fileinfo-ewoc))))
(inhibit-read-only t) (inhibit-read-only t)
known-files) known-files unknown-files)
(while elems (while elems
(let ((fileinfo (ewoc-data (car elems)))) (let ((fileinfo (ewoc-data (car elems))))
@ -741,8 +734,7 @@ fileinfos, just call `dvc-remove-files'."
(dvc-fileinfo-file (dvc-fileinfo-file
(if (equal 'unknown (dvc-fileinfo-file-status fileinfo)) (if (equal 'unknown (dvc-fileinfo-file-status fileinfo))
(progn (progn
(delete-file (dvc-fileinfo-path fileinfo)) (push (car elems) unknown-files))
(dvc-ewoc-delete dvc-fileinfo-ewoc (car elems)))
;; `add-to-list' gets a stack overflow here ;; `add-to-list' gets a stack overflow here
(setq known-files (cons (car elems) known-files)))) (setq known-files (cons (car elems) known-files))))
@ -772,7 +764,13 @@ fileinfos, just call `dvc-remove-files'."
(dvc-fileinfo-legacy (dvc-fileinfo-legacy
;; Don't have enough info to update this ;; Don't have enough info to update this
nil)))) nil))))
known-files)))))) known-files)))
(when unknown-files
(let ((names (mapcar (lambda (x) (dvc-fileinfo-path (ewoc-data x)))
unknown-files)))
(when (dvc-confirm-file-op "remove unknown" names t)
(mapcar 'delete-file names)
(apply 'ewoc-delete dvc-fileinfo-ewoc unknown-files)))))))
(defun dvc-fileinfo-revert-files () (defun dvc-fileinfo-revert-files ()
"Revert current files." "Revert current files."

View File

@ -140,7 +140,8 @@
(buffer-disable-undo) (buffer-disable-undo)
(set-buffer-modified-p nil)) (set-buffer-modified-p nil))
(add-to-list 'uniquify-list-buffers-directory-modes 'dvc-status-mode) (when (boundp 'uniquify-list-buffers-directory-modes)
(add-to-list 'uniquify-list-buffers-directory-modes 'dvc-status-mode))
(defun dvc-status-prepare-buffer (dvc root base-revision branch header-more refresh) (defun dvc-status-prepare-buffer (dvc root base-revision branch header-more refresh)
"Prepare and return a status buffer. Should be called by <back-end>-dvc-status. "Prepare and return a status buffer. Should be called by <back-end>-dvc-status.

View File

@ -1,6 +1,6 @@
;;; dvc-unified.el --- The unification layer for dvc ;;; dvc-unified.el --- The unification layer for dvc
;; Copyright (C) 2005-2009 by all contributors ;; Copyright (C) 2005-2010 by all contributors
;; Author: Stefan Reichoer, <stefan@xsteve.at> ;; Author: Stefan Reichoer, <stefan@xsteve.at>
@ -78,7 +78,9 @@
;;; Code: ;;; Code:
(require 'dired-x) (condition-case nil
(require 'dired-x)
(error nil))
(require 'ffap) (require 'ffap)
(require 'dvc-register) (require 'dvc-register)
(require 'dvc-core) (require 'dvc-core)
@ -101,7 +103,7 @@ Note: this function is only useful when called interactively."
(working-dir (dvc-uniquify-file-name default-directory)) (working-dir (dvc-uniquify-file-name default-directory))
(dvc)) (dvc))
;; hide backends that don't provide an init function ;; hide backends that don't provide an init function
(mapcar '(lambda (elem) (mapc '(lambda (elem)
(setq supported-variants (delete elem supported-variants))) (setq supported-variants (delete elem supported-variants)))
'("xdarcs" "xmtn" "baz")) '("xdarcs" "xmtn" "baz"))
(add-to-list 'supported-variants "bzr-repo") (add-to-list 'supported-variants "bzr-repo")
@ -291,20 +293,11 @@ dvc-read-project-tree-mode), LAST-N entries (default
`dvc-log-last-n'; all if nil, prefix value means that `dvc-log-last-n'; all if nil, prefix value means that
many entries (absolute value)). Use `dvc-changelog' for the full log." many entries (absolute value)). Use `dvc-changelog' for the full log."
(interactive "i\nP") (interactive "i\nP")
<<<<<<< TREE
(let* ((allentries (or (eq last-n nil)
(< (prefix-numeric-value last-n) 0)))
(last-n (prefix-numeric-value last-n))
(path (if (< last-n 0)
nil (buffer-file-name)))
(last-n (if allentries nil last-n))
=======
(let* ((path (if (and last-n (< (prefix-numeric-value last-n) 0)) (let* ((path (if (and last-n (< (prefix-numeric-value last-n) 0))
nil (buffer-file-name))) nil (buffer-file-name)))
(last-n (if last-n (last-n (if last-n
(abs (prefix-numeric-value last-n)) (abs (prefix-numeric-value last-n))
dvc-log-last-n)) dvc-log-last-n))
>>>>>>> MERGE-SOURCE
(default-directory (default-directory
(dvc-read-project-tree-maybe "DVC tree root (directory): " (dvc-read-project-tree-maybe "DVC tree root (directory): "
(when path (expand-file-name path)) (when path (expand-file-name path))

View File

@ -1029,7 +1029,7 @@ callback afterwards."
(setq summary (buffer-substring-no-properties (setq summary (buffer-substring-no-properties
(point) (point)
(progn (re-search-forward "^\\([^ \t]\\|$\\)") (progn (re-search-forward "^\\([^ \t]\\|$\\)")
(previous-line 1) (forward-line -1)
(end-of-line) (end-of-line)
(point)))) (point))))
(forward-line 1) (forward-line 1)

View File

@ -300,7 +300,7 @@ Returns a list of strings"
(setq list-cmds (cons (buffer-substring-no-properties (point) (setq list-cmds (cons (buffer-substring-no-properties (point)
(line-end-position)) (line-end-position))
list-cmds)) list-cmds))
(previous-line 1)) (forward-line -1))
list-cmds list-cmds
)) ))

View File

@ -1933,7 +1933,7 @@ MODIFIED)."
;; the buffer is "* changeset report" ;; the buffer is "* changeset report"
(save-excursion (save-excursion
(goto-char (point-max)) (goto-char (point-max))
(previous-line 1) (forward-line -1)
(beginning-of-line) (beginning-of-line)
(looking-at "^* changeset report")))) (looking-at "^* changeset report"))))
(if no-changes (if no-changes
@ -9523,7 +9523,7 @@ If on a message field, delete all the files below this message."
"Delete file: " "Delete file: "
nil nil nil nil nil nil
'yes-or-no-p))) 'yes-or-no-p)))
(mapcar 'delete-file files) (mapc 'delete-file files)
(tla-tree-lint default-directory)) (tla-tree-lint default-directory))
(defun tla-tree-lint-regenerate-id (files) (defun tla-tree-lint-regenerate-id (files)
@ -9535,7 +9535,7 @@ If on a message field, delete all the files below this message."
"Not regenerating ID for any file" "Not regenerating ID for any file"
"Regenerate ID for file: " "Regenerate ID for file: "
t))) t)))
(mapcar 'tla-regenerate-id-for-file files) (mapc 'tla-regenerate-id-for-file files)
(tla-tree-lint default-directory)) (tla-tree-lint default-directory))
(defun tla-tree-lint-make-junk (files) (defun tla-tree-lint-make-junk (files)
@ -9571,7 +9571,7 @@ If on a message field, make all the files below this message precious."
(defun tla-tree-lint-put-file-prefix (files prefix) (defun tla-tree-lint-put-file-prefix (files prefix)
"Rename FILES with adding prefix PREFIX. "Rename FILES with adding prefix PREFIX.
Visited buffer associations also updated." Visited buffer associations also updated."
(mapcar (mapc
(lambda (from) (lambda (from)
(let* ((buf (find-buffer-visiting from)) (let* ((buf (find-buffer-visiting from))
(to (concat (to (concat

View File

@ -141,7 +141,9 @@
;;; Code: ;;; Code:
(require 'dired-x) (condition-case nil
(require 'dired-x)
(error nil))
(require 'dvc-core) (require 'dvc-core)
(require 'dvc-diff) (require 'dvc-diff)
(require 'xhg-core) (require 'xhg-core)

View File

@ -47,7 +47,7 @@
;; process must be killed with `xmtn-automate-kill-session'. ;; process must be killed with `xmtn-automate-kill-session'.
;; ;;
;; Once you have a session object, you can use ;; Once you have a session object, you can use
;; `xmtn-automate-new-command' to send commands to monotone. ;; `xmtn-automate--new-command' to send commands to monotone.
;; ;;
;; A COMMAND is a list of strings (the command and its arguments), or ;; A COMMAND is a list of strings (the command and its arguments), or
;; a cons of lists of strings. If car COMMAND is a list, car COMMAND ;; a cons of lists of strings. If car COMMAND is a list, car COMMAND
@ -56,7 +56,7 @@
;; "--". If an option has no value, use ""; see ;; "--". If an option has no value, use ""; see
;; xmtn--status-inventory-sync in xmtn-dvc 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
;; output. Your Emacs Lisp code can also do other computation while ;; output. Your Emacs Lisp code can also do other computation while
;; the monotone command runs. Allowing this kind of parallelism is ;; the monotone command runs. Allowing this kind of parallelism is
@ -74,9 +74,12 @@
(require 'xmtn-run) (require 'xmtn-run)
(require 'xmtn-compat)) (require 'xmtn-compat))
(defconst xmtn-automate-arguments (list "--rcfile" (locate-library "xmtn-hooks.lua")) (defconst xmtn-automate-arguments nil
"Arguments and options for 'mtn automate stdio' sessions.") "Arguments and options for 'mtn automate stdio' sessions.")
(defconst xmtn-sync-session-root "sync"
"Name for unique automate session used for sync commands.")
(defun xmtn-automate-command-buffer (command) (defun xmtn-automate-command-buffer (command)
(xmtn-automate--command-handle-buffer command)) (xmtn-automate--command-handle-buffer command))
@ -86,8 +89,10 @@
(defun xmtn-automate-command-wait-until-finished (handle) (defun xmtn-automate-command-wait-until-finished (handle)
(let ((session (xmtn-automate--command-handle-session handle))) (let ((session (xmtn-automate--command-handle-session handle)))
(while (not (xmtn-automate--command-handle-finished-p handle)) (while (not (xmtn-automate--command-handle-finished-p handle))
;; we use a timeout here to allow debugging, and possible incremental processing ;; We use a timeout here to allow debugging, and incremental
(accept-process-output (xmtn-automate--session-process session) 1.0) ;; processing of tickers. We don't use a process filter, because
;; they are very hard to debug.
(accept-process-output (xmtn-automate--session-process session) 0.01)
(xmtn-automate--process-new-output session)) (xmtn-automate--process-new-output session))
(unless (eql (xmtn-automate--command-handle-error-code handle) 0) (unless (eql (xmtn-automate--command-handle-error-code handle) 0)
(xmtn-automate--cleanup-command handle) (xmtn-automate--cleanup-command handle)
@ -95,6 +100,8 @@
(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)))
(when (xmtn-automate--session-error-file session)
(insert-file-contents (xmtn-automate--session-error-file session)))
(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) (if (xmtn-automate--command-handle-warnings handle)
(display-buffer (format dvc-error-buffer 'xmtn) t)) (display-buffer (format dvc-error-buffer 'xmtn) t))
@ -138,11 +145,11 @@ 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-command-output-buffer (defun xmtn-automate-command-output-buffer (root buffer command &optional display-tickers)
(root buffer command) "Send COMMAND to session for ROOT, insert result into BUFFER.
"Send COMMAND to session for ROOT, insert result into BUFFER." Optionally DISPLAY-TICKERS in mode-line of BUFFER."
(let* ((session (xmtn-automate-cache-session root)) (let* ((session (xmtn-automate-cache-session root))
(command-handle (xmtn-automate--new-command session command))) (command-handle (xmtn-automate--new-command session command display-tickers buffer)))
(xmtn-automate-command-wait-until-finished command-handle) (xmtn-automate-command-wait-until-finished command-handle)
(with-current-buffer buffer (with-current-buffer buffer
(insert-buffer-substring-no-properties (insert-buffer-substring-no-properties
@ -200,7 +207,8 @@ Signals an error if output contains zero lines or more than one line."
;; char position (not marker) of last character read. We use a ;; char position (not marker) of last character read. We use a
;; position, not a marker, because text gets inserted in front of ;; position, not a marker, because text gets inserted in front of
;; the marker, and it moves. ;; the marker, and it moves.
(remaining-chars 0)
(remaining-chars 0) ;; until end of packet
(stream 0); determines output buffer (stream 0); determines output buffer
) )
@ -210,6 +218,7 @@ Signals an error if output contains zero lines or more than one line."
(root) (root)
(name) (name)
(buffer nil) (buffer nil)
(error-file nil)
(process nil) (process nil)
(decoder-state) (decoder-state)
(next-command-number 0) (next-command-number 0)
@ -227,7 +236,11 @@ Signals an error if output contains zero lines or more than one line."
(write-marker) (write-marker)
(finished-p nil) (finished-p nil)
(error-code nil) (error-code nil)
(warnings nil)) (warnings nil)
(tickers nil) ; alist of xmtn-automate--ticker by short name; nil if none active
(display-tickers nil) ; list of long names of tickers to display
(display-buffer nil) ; buffer in which to display tickers
)
(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)
@ -316,12 +329,6 @@ Signals an error if output contains zero lines or more than one line."
(buffer (xmtn-automate--new-buffer session)) (buffer (xmtn-automate--new-buffer session))
(root (xmtn-automate--session-root session))) (root (xmtn-automate--session-root session)))
(let ((process-connection-type nil); use a pipe, not a tty (let ((process-connection-type nil); use a pipe, not a tty
<<<<<<< TREE
(default-directory root))
(let ((process
(apply 'start-process name buffer xmtn-executable
"automate" "stdio" xmtn-automate-arguments)))
=======
(default-directory root) (default-directory root)
;; start-process merges stderr and stdout from the child, ;; start-process merges stderr and stdout from the child,
;; but stderr messages are not packetized, so they confuse ;; but stderr messages are not packetized, so they confuse
@ -349,7 +356,6 @@ Signals an error if output contains zero lines or more than one line."
(append (list xmtn-executable "automate" "stdio") (append (list xmtn-executable "automate" "stdio")
xmtn-automate-arguments)))) xmtn-automate-arguments))))
(let ((process (apply 'start-process name buffer cmd))) (let ((process (apply 'start-process name buffer cmd)))
>>>>>>> MERGE-SOURCE
(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
@ -366,7 +372,10 @@ Signals an error if output contains zero lines or more than one line."
(error "unexpected mtn automate stdio format version %s" (match-string 0))) (error "unexpected mtn automate stdio format version %s" (match-string 0)))
;; Some error. Display the session buffer to show the error ;; Some error. Display the session buffer to show the error
(pop-to-buffer buffer) (pop-to-buffer buffer)
(error "failed to create mtn automate process")))) (let ((inhibit-read-only t))
(when (xmtn-automate--session-error-file session)
(insert-file-contents (xmtn-automate--session-error-file session))))
(error "unexpected header from mtn automate process"))))
((exit signal) ((exit signal)
(pop-to-buffer buffer) (pop-to-buffer buffer)
(error "failed to create mtn automate process"))) (error "failed to create mtn automate process")))
@ -461,8 +470,9 @@ the buffer."
(unless xmtn-automate--*preserve-buffers-for-debugging* (unless xmtn-automate--*preserve-buffers-for-debugging*
(kill-buffer buffer)))))) (kill-buffer buffer))))))
(defun xmtn-automate--new-command (session command) (defun xmtn-automate--new-command (session command &optional display-tickers display-buffer)
"Send COMMAND to SESSION." "Send COMMAND to SESSION. Optionally DISPLAY-TICKERS in DISPLAY-BUFFER mode-line.
DISPLAY-TICKERS is a list of strings; names of tickers to display."
(xmtn-automate--ensure-process session) (xmtn-automate--ensure-process session)
(let* ((command-number (let* ((command-number
(1- (incf (xmtn-automate--session-next-command-number (1- (incf (xmtn-automate--session-next-command-number
@ -493,7 +503,9 @@ the buffer."
:command command :command command
:session-command-number command-number :session-command-number command-number
:buffer buffer :buffer buffer
:write-marker (set-marker (make-marker) (point))))) :write-marker (set-marker (make-marker) (point))
:display-tickers display-tickers
:display-buffer display-buffer)))
(setf (setf
(xmtn-automate--session-remaining-command-handles session) (xmtn-automate--session-remaining-command-handles session)
(nconc (xmtn-automate--session-remaining-command-handles session) (nconc (xmtn-automate--session-remaining-command-handles session)
@ -504,9 +516,69 @@ the buffer."
(unless xmtn-automate--*preserve-buffers-for-debugging* (unless xmtn-automate--*preserve-buffers-for-debugging*
(kill-buffer (xmtn-automate--command-handle-buffer handle)))) (kill-buffer (xmtn-automate--command-handle-buffer handle))))
(defstruct (xmtn-automate--ticker)
(long-name)
(display nil)
(current 0)
(total 0))
(defun xmtn-automate--ticker-process (ticker-string tickers display-tickers)
"Process TICKER-STRING, updating tickers in alist TICKERS.
DISPLAY-TICKERS is list of ticker names to display.
Return updated value of TICKERS."
;; ticker-string is contents of one stdio ticker packet:
;; c:certificates;k:keys;r:revisions; declare short and long names
;; c=0;k=0;r=0; set total values
;; c#7;k#1;r#2; set current values
;; c;k;r; close ticker
(while (< 0 (length ticker-string))
(let* ((tick (substring ticker-string 0 (search ";" ticker-string)))
(name (aref tick 0))
(ticker (cadr (assoc name tickers))))
(if ticker
(cond
((= 1 (length tick))
(setq tickers (assq-delete-all name tickers)))
((= ?= (aref tick 1))
(setf (xmtn-automate--ticker-total ticker) (string-to-number (substring tick 2))))
((= ?# (aref tick 1))
(setf (xmtn-automate--ticker-current ticker) (string-to-number (substring tick 2))))
)
;; else create new ticker
(setq tickers
(add-to-list
'tickers
(list name
(make-xmtn-automate--ticker
:long-name (substring tick 2)
:display (not (null (member (substring tick 2) display-tickers)))
))))
)
(setq ticker-string (substring ticker-string (+ 1 (length tick))))
))
tickers)
(defun xmtn-automate--ticker-mode-line (tickers buffer)
"Display TICKERS alist in BUFFER mode-line-process"
(with-current-buffer buffer
(setq mode-line-process nil)
(loop for item in tickers do
(let ((ticker (cadr item)))
(if (xmtn-automate--ticker-display ticker)
(progn
(setq mode-line-process
(concat mode-line-process
(format " %s %d/%d"
(xmtn-automate--ticker-long-name ticker)
(xmtn-automate--ticker-current ticker)
(xmtn-automate--ticker-total ticker))))
(force-mode-line-update)))))))
(defun xmtn-automate--process-new-output--copy (session) (defun xmtn-automate--process-new-output--copy (session)
"Copy SESSION current packet output to command output or error buffer. "Copy SESSION current packet output to command output or error buffer.
Return non-nil if some text copied." Return non-nil if some text copied."
;; We often get here with only a partial packet; the main channel
;; outputs very large packets.
(let* ((session-buffer (xmtn-automate--session-buffer session)) (let* ((session-buffer (xmtn-automate--session-buffer session))
(state (xmtn-automate--session-decoder-state session)) (state (xmtn-automate--session-decoder-state session))
(command (first (xmtn-automate--session-remaining-command-handles (command (first (xmtn-automate--session-remaining-command-handles
@ -515,10 +587,14 @@ Return non-nil if some text copied."
(ecase (xmtn-automate--decoder-state-stream state) (ecase (xmtn-automate--decoder-state-stream state)
(?m (?m
(xmtn-automate--command-handle-buffer command)) (xmtn-automate--command-handle-buffer command))
((?e ?w ?p ?t) (?t
;; Display ticker in mode line of display buffer for
;; current command.
(xmtn-automate--command-handle-display-buffer command))
((?e ?w ?p)
(if (equal ?w (xmtn-automate--decoder-state-stream state)) (if (equal ?w (xmtn-automate--decoder-state-stream state))
(setf (xmtn-automate--command-handle-warnings command) t)) (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, 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
@ -536,6 +612,28 @@ Return non-nil if some text copied."
(if (not (buffer-live-p output-buffer)) (if (not (buffer-live-p output-buffer))
;; Buffer has already been killed, just discard input. ;; Buffer has already been killed, just discard input.
t t
(ecase (xmtn-automate--decoder-state-stream state)
(?t
;; Display ticker in mode line of display buffer for
;; current command. But only if we have the whole packet
(if (= chars-to-read (xmtn-automate--decoder-state-remaining-chars state))
(progn
(setf (xmtn-automate--command-handle-tickers command)
(xmtn-automate--ticker-process
(buffer-substring-no-properties (xmtn-automate--decoder-state-read-marker state)
end)
(xmtn-automate--command-handle-tickers command)
(xmtn-automate--command-handle-display-tickers command)))
(xmtn-automate--ticker-mode-line
(xmtn-automate--command-handle-tickers command)
output-buffer)
(setf (xmtn-automate--decoder-state-read-marker state) end)
(decf (xmtn-automate--decoder-state-remaining-chars state)
chars-to-read))
;; not a whole packet; no text copied
nil))
((?m ?e ?w ?p)
(with-current-buffer output-buffer (with-current-buffer output-buffer
(save-excursion (save-excursion
(goto-char write-marker) (goto-char write-marker)
@ -545,13 +643,11 @@ Return non-nil if some text copied."
(xmtn-automate--decoder-state-read-marker state) (xmtn-automate--decoder-state-read-marker state)
end)) end))
(set-marker write-marker (point)))) (set-marker write-marker (point))))
;;(xmtn--debug-mark-text-processed session-buffer read-marker end nil)
)
(setf (xmtn-automate--decoder-state-read-marker state) end) (setf (xmtn-automate--decoder-state-read-marker state) end)
(decf (xmtn-automate--decoder-state-remaining-chars state) (decf (xmtn-automate--decoder-state-remaining-chars state)
chars-to-read) chars-to-read)
t) t)))
))))) ))))))
(defun xmtn--debug-mark-text-processed (buffer start end bold-p) (defun xmtn--debug-mark-text-processed (buffer start end bold-p)
(xmtn--assert-optional (< start end) t) (xmtn--assert-optional (< start end) t)
@ -756,6 +852,34 @@ 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--insert-file-contents (root content-hash-id buffer)
(check-type content-hash-id xmtn--hash-id)
(xmtn-automate-command-output-buffer
root buffer `("get_file" ,content-hash-id)))
(defun xmtn--insert-file-contents-by-name (root backend-id normalized-file-name buffer)
(let* ((resolved-id (xmtn--resolve-backend-id root backend-id))
(hash-id (case (car resolved-id)
(local-tree nil)
(revision (cadr resolved-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))
(list "get_file_of" normalized-file-name))))
(xmtn-automate-command-output-buffer root buffer cmd))))
(defun xmtn--get-file-by-id (root file-id save-as)
"Store contents of FILE-ID in file SAVE-AS."
(with-temp-file save-as
(set-buffer-multibyte nil)
(setq buffer-file-coding-system 'binary)
(xmtn--insert-file-contents root file-id (current-buffer))))
(provide 'xmtn-automate) (provide 'xmtn-automate)
;;; xmtn-automate.el ends here ;;; xmtn-automate.el ends here

View File

@ -1,6 +1,6 @@
;;; xmtn-basic-io.el --- A parser for monotone's basic_io output format ;;; xmtn-basic-io.el --- A parser for monotone's basic_io output format
;; Copyright (C) 2008 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
@ -177,8 +177,9 @@ Possible classes are `string', `null-id', `id', `symbol'."
(nreverse accu)))) (nreverse accu))))
stanza)) stanza))
(defun xmtn-basic-io--next-parsed-line-notinline () (defun xmtn-basic-io-skip-stanza ()
(xmtn-basic-io--next-parsed-line)) "Skip to end of stanza at point."
(while (not (memq (xmtn-basic-io--next-parsed-line) '(empty eof)))))
(eval-and-compile (eval-and-compile
(defun xmtn-basic-io--generate-body-for-with-parser-form (parser-fn (defun xmtn-basic-io--generate-body-for-with-parser-form (parser-fn
@ -199,7 +200,7 @@ Possible classes are `string', `null-id', `id', `symbol'."
(eq 'eof (xmtn-basic-io--peek))) (eq 'eof (xmtn-basic-io--peek)))
(defmacro xmtn-basic-io-parse-line (body) (defmacro xmtn-basic-io-parse-line (body)
"Read next basic-io line at point. Error if it is `empty' or "Read basic-io line at point. Error if it is `empty' or
`eof'. Otherwise execute BODY with `symbol' bound to key (a `eof'. Otherwise execute BODY with `symbol' bound to key (a
string), `value' bound to list containing parsed rest of line. string), `value' bound to list containing parsed rest of line.
List is of form ((category value) ...)." List is of form ((category value) ...)."
@ -212,22 +213,37 @@ List is of form ((category value) ...)."
,body)))) ,body))))
(defmacro xmtn-basic-io-optional-line (expected-key body-present) (defmacro xmtn-basic-io-optional-line (expected-key body-present)
"Read next basic-io line at point. If its key is "Read basic-io line at point. If its key is
EXPECTED-KEY (a string), execute BODY-PRESENT with `value' bound EXPECTED-KEY (a string), execute BODY-PRESENT with `value' bound
to list containing parsed rest of line. List is of to list containing parsed rest of line, and return t. List is of
form ((category value) ...). Else reset to parse the same line form ((category value) ...). Else reset to parse the same line
again." again, and return nil."
(declare (indent 1) (debug (sexp body))) (declare (indent 1) (debug (sexp body)))
`(let ((line (xmtn-basic-io--next-parsed-line))) `(let ((line (xmtn-basic-io--next-parsed-line)))
(if (and (not (member line '(empty eof))) (if (and (not (member line '(empty eof)))
(string= (car line) ,expected-key)) (string= (car line) ,expected-key))
(let ((value (cdr line))) (let ((value (cdr line)))
,body-present) ,body-present
(beginning-of-line 0) t)
(beginning-of-line 0) ;; returns nil
)))
(defmacro xmtn-basic-io-optional-line-2 (expected body-present)
"Read basic-io line at point. If its contents equal EXPECTED (a
list of (category value) pairs), execute BODY-PRESENT, and return
t. Else reset to parse the same line again, and return nil."
(declare (indent 1) (debug (sexp body)))
`(let ((line (xmtn-basic-io--next-parsed-line)))
(if (and (not (member line '(empty eof)))
(equal line ,expected))
(progn
,body-present
t)
(beginning-of-line 0) ;; returns nil
))) )))
(defmacro xmtn-basic-io-check-line (expected-key body) (defmacro xmtn-basic-io-check-line (expected-key body)
"Read next basic-io line at point. Error if it is `empty' or "Read basic-io line at point. Error if it is `empty' or
`eof', or if its key is not EXPECTED-KEY (a string). Otherwise `eof', or if its key is not EXPECTED-KEY (a string). Otherwise
execute BODY with `value' bound to list containing parsed rest of execute BODY with `value' bound to list containing parsed rest of
line. List is of form ((category value) ...)." line. List is of form ((category value) ...)."
@ -239,6 +255,26 @@ line. List is of form ((category value) ...)."
(let ((value (cdr line))) (let ((value (cdr line)))
,body)))) ,body))))
(defun xmtn-basic-io-skip-line (expected-key)
"Read basic-io line at point. Error if it is `empty' or
`eof', or if its key is not EXPECTED-KEY (a string). Otherwise
skip do nothing."
(let ((line (xmtn-basic-io--next-parsed-line)))
(if (or (member line '(empty eof))
(not (string= (car line) expected-key)))
(error "expecting \"%s\", found %s" expected-key line))))
(defun xmtn-basic-io-optional-skip-line (expected-key)
"Read basic-io line at point. If its key is EXPECTED-KEY (a
string) return t. Else reset to parse the same line again, and
return nil."
(let ((line (xmtn-basic-io--next-parsed-line)))
(if (and (not (member line '(empty eof)))
(string= (car line) expected-key))
t
(beginning-of-line 0) ;; returns nil
)))
(defun xmtn-basic-io-check-empty () (defun xmtn-basic-io-check-empty ()
"Read next basic-io line at point. Error if it is not `empty' or `eof'." "Read next basic-io line at point. Error if it is not `empty' or `eof'."
(let ((line (xmtn-basic-io--next-parsed-line))) (let ((line (xmtn-basic-io--next-parsed-line)))
@ -282,7 +318,7 @@ and must not be called any more."
;; Use a notinline variant to avoid copying the full parser into ;; Use a notinline variant to avoid copying the full parser into
;; every user of this macro. The performance advantage of this ;; every user of this macro. The performance advantage of this
;; would be small. ;; would be small.
'xmtn-basic-io--next-parsed-line-notinline 'xmtn-basic-io--next-parsed-line
line-parser buffer-form body)) line-parser buffer-form body))
(defmacro* xmtn-basic-io-with-stanza-parser ((stanza-parser buffer-form) (defmacro* xmtn-basic-io-with-stanza-parser ((stanza-parser buffer-form)

View File

@ -23,15 +23,15 @@
(eval-when-compile (eval-when-compile
;; these have macros we use ;; these have macros we use
(require 'cl) (require 'cl)
(require 'dvc-utils) (require 'dvc-utils))
(require 'xmtn-automate)
(require 'xmtn-basic-io)
(require 'xmtn-ids)
(require 'xmtn-run))
(eval-and-compile (eval-and-compile
;; these have functions we use ;; these have functions we use
(require 'dired)) (require 'dired)
(require 'xmtn-automate)
(require 'xmtn-basic-io)
(require 'xmtn-run)
(require 'xmtn-ids))
(defvar xmtn-conflicts-left-revision "" (defvar xmtn-conflicts-left-revision ""
"Buffer-local variable holding left revision id.") "Buffer-local variable holding left revision id.")
@ -536,7 +536,10 @@ header."
(xmtn-basic-io-write-sym "conflict" "content") (xmtn-basic-io-write-sym "conflict" "content")
(xmtn-basic-io-write-str "node_type" "file") (xmtn-basic-io-write-str "node_type" "file")
(xmtn-basic-io-write-str "ancestor_name" (xmtn-conflicts-conflict-ancestor_name conflict)) (xmtn-basic-io-write-str "ancestor_name" (xmtn-conflicts-conflict-ancestor_name conflict))
;; ancestor can be null if this is a new file
(if (xmtn-conflicts-conflict-ancestor_file_id conflict)
(xmtn-basic-io-write-id "ancestor_file_id" (xmtn-conflicts-conflict-ancestor_file_id conflict)) (xmtn-basic-io-write-id "ancestor_file_id" (xmtn-conflicts-conflict-ancestor_file_id conflict))
(xmtn-basic-io-write-id "ancestor_file_id" ""))
(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))
(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))
(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))
@ -1232,9 +1235,9 @@ retrieval by `xmtn-conflicts-load-opts'."
)) ))
(defun xmtn-conflicts-load-opts () (defun xmtn-conflicts-load-opts ()
"Load options saved by "Load options saved by `xmtn-conflicts-save-opts'.
`xmtn-conflicts-save-opts'. `default-directory' must be workspace `default-directory' must be workspace root where options file is
root where options file is stored." stored."
(let ((opts-file (concat default-directory xmtn-conflicts-opts-file))) (let ((opts-file (concat default-directory xmtn-conflicts-opts-file)))
(if (file-exists-p opts-file) (if (file-exists-p opts-file)
(load opts-file) (load opts-file)

View File

@ -33,7 +33,7 @@
;;; docs/xmtn-readme.txt. ;;; docs/xmtn-readme.txt.
(eval-and-compile (eval-and-compile
(require 'cl) (require 'cl) ;; yes, we are using cl at runtime; we're working towards eliminating that.
(require 'dvc-unified) (require 'dvc-unified)
(require 'xmtn-basic-io) (require 'xmtn-basic-io)
(require 'xmtn-base) (require 'xmtn-base)
@ -702,7 +702,8 @@ otherwise newer."
(current-buffer) error))))))) (current-buffer) error)))))))
(defun xmtn--status-inventory-sync (root) (defun xmtn--status-inventory-sync (root)
"Create a status buffer for ROOT; return (buffer status), where status is 'ok or 'need-commit." "Create or reuse a status buffer for ROOT; return `(buffer status)',
where `status' is 'ok or 'need-commit."
(let* (let*
((orig-buffer (current-buffer)) ((orig-buffer (current-buffer))
(msg (concat "running inventory for " root " ...")) (msg (concat "running inventory for " root " ..."))
@ -875,9 +876,7 @@ otherwise newer."
root root
(let ((default-directory root)) (let ((default-directory root))
(mapcan (lambda (file-name) (mapcan (lambda (file-name)
(if (or (file-symlink-p file-name) (list (xmtn--perl-regexp-for-file-name file-name)))
(not (file-directory-p file-name)))
(list (xmtn--perl-regexp-for-file-name file-name))))
normalized-file-names)) normalized-file-names))
t)))) t))))
@ -1016,21 +1015,6 @@ finished."
;;; synchronousness/asynchronousness, progress messages and return ;;; synchronousness/asynchronousness, progress messages and return
;;; value. ;;; value.
(defun xmtn--do-explicit-merge (root left-revision-hash-id right-revision-hash-id
destination-branch-name)
(check-type root string)
(check-type left-revision-hash-id xmtn--hash-id)
(check-type right-revision-hash-id xmtn--hash-id)
(check-type destination-branch-name string)
(xmtn--run-command-that-might-invoke-merger root
`("explicit_merge"
"--"
,left-revision-hash-id
,right-revision-hash-id
,destination-branch-name)
nil)
nil)
(defun xmtn--do-update (root target-revision-hash-id post-update-p) (defun xmtn--do-update (root target-revision-hash-id post-update-p)
(check-type root string) (check-type root string)
(check-type target-revision-hash-id xmtn--hash-id) (check-type target-revision-hash-id xmtn--hash-id)
@ -1253,75 +1237,9 @@ a workspace for CACHED-BRANCH."
(setq buffer-file-coding-system 'binary) (setq buffer-file-coding-system 'binary)
(xmtn--insert-file-contents root file-id (current-buffer)))) (xmtn--insert-file-contents root file-id (current-buffer))))
(defun xmtn--revision-parents (root revision-hash-id)
(xmtn-automate-simple-command-output-lines root
`("parents" ,revision-hash-id)))
(defun xmtn--get-content-changed (root backend-id normalized-file)
(xmtn-match (xmtn--resolve-backend-id root backend-id)
((local-tree $path) (error "Not implemented"))
((revision $revision-hash-id)
(xmtn--with-automate-command-output-basic-io-parser
(parser root `("get_content_changed" ,revision-hash-id
,normalized-file))
(loop for stanza = (funcall parser)
while stanza
collect (xmtn-match stanza
((("content_mark" (id $previous-id)))
previous-id)))))))
(defun xmtn--limit-length (list n) (defun xmtn--limit-length (list n)
(or (null n) (<= (length list) n))) (or (null n) (<= (length list) n)))
(defun xmtn--close-set (fn initial-set last-n)
(let ((new-elements initial-set)
(current-set nil))
(while (and new-elements (xmtn--limit-length current-set last-n))
(let ((temp-elements nil)
(next-elements nil)
(new-element nil))
(while new-elements
(setq new-element (car new-elements))
(setq temp-elements (funcall fn new-element))
(setq current-set (append (set-difference temp-elements current-set :test #'equal) current-set))
(setq next-elements (append temp-elements next-elements))
(setq new-elements (cdr new-elements)))
(setq new-elements next-elements)))
current-set))
(defun xmtn--get-content-changed-closure (root backend-id normalized-file last-n)
(lexical-let ((root root))
(labels ((changed-self-or-ancestors (entry)
(destructuring-bind (hash-id file-name) entry
(check-type file-name string)
;; get-content-changed can return one or two revisions
(loop for next-change-id in (xmtn--get-content-changed
root `(revision ,hash-id)
file-name)
for corresponding-path =
(xmtn--get-corresponding-path-raw root file-name
hash-id next-change-id)
when corresponding-path
collect `(,next-change-id ,corresponding-path))))
(changed-proper-ancestors (entry)
(destructuring-bind (hash-id file-name) entry
(check-type file-name string)
;; revision-parents can return one or two revisions
(loop for parent-id in (xmtn--revision-parents root hash-id)
for path-in-parent =
(xmtn--get-corresponding-path-raw root file-name
hash-id parent-id)
when path-in-parent
append (changed-self-or-ancestors
`(,parent-id ,path-in-parent))))))
(xmtn--close-set
#'changed-proper-ancestors
(xmtn-match (xmtn--resolve-backend-id root backend-id)
((local-tree $path) (error "Not implemented"))
((revision $id) (changed-self-or-ancestors
`(,id ,normalized-file))))
last-n))))
(defun xmtn--get-corresponding-path (root normalized-file-name (defun xmtn--get-corresponding-path (root normalized-file-name
source-revision-backend-id source-revision-backend-id
target-revision-backend-id) target-revision-backend-id)
@ -1419,33 +1337,6 @@ a workspace for CACHED-BRANCH."
(xmtn-automate-command-output-string (xmtn-automate-command-output-string
root `("get_file" ,content-hash-id))) root `("get_file" ,content-hash-id)))
<<<<<<< TREE
(defun xmtn--insert-file-contents (root content-hash-id buffer)
(check-type content-hash-id xmtn--hash-id)
(xmtn-automate-command-output-buffer
root buffer `("get_file" ,content-hash-id)))
(defun xmtn--insert-file-contents-by-name (root backend-id normalized-file-name buffer)
(let* ((resolved-id (xmtn--resolve-backend-id root backend-id))
(hash-id (case (car resolved-id)
(local-tree nil)
(revision (cadr resolved-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))
(list "get_file_of" normalized-file-name))))
(xmtn-automate-command-output-buffer root buffer cmd))))
(defun xmtn--same-tree-p (a b)
(equal (file-truename a) (file-truename b)))
=======
>>>>>>> MERGE-SOURCE
(defstruct (xmtn--revision (:constructor xmtn--make-revision)) (defstruct (xmtn--revision (:constructor xmtn--make-revision))
;; matches data output by 'mtn diff' ;; matches data output by 'mtn diff'
new-manifest-hash-id new-manifest-hash-id

View File

@ -21,20 +21,79 @@
-- 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.
function get_mtn_command(host) function get_netsync_connect_command(uri, args)
-- 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"); local argv = nil
if uri["scheme"] == "ssh" then
argv = { "ssh" }
if uri["user"] then
table.insert(argv, "-l")
table.insert(argv, uri["user"])
end
if uri["port"] then
table.insert(argv, "-p")
table.insert(argv, uri["port"])
end
table.insert(argv, uri["host"])
if xmtn_sync_ssh_exec then
if xmtn_sync_ssh_exec [uri["host"]] then
table.insert(argv, xmtn_sync_ssh_exec [uri["host"]])
else
table.insert(argv, "mtn")
end
else
table.insert(argv, "mtn")
end
if args["debug"] then
table.insert(argv, "--verbose")
else
table.insert(argv, "--quiet")
end
table.insert(argv, "--db")
table.insert(argv, uri["path"])
table.insert(argv, "serve")
table.insert(argv, "--stdio")
table.insert(argv, "--no-transport-auth")
elseif uri["scheme"] == "file" then
if xmtn_sync_file_exec then
argv = { xmtn_sync_file_exec }
else
if string.sub(get_ostype(), 1, 6) == "CYGWIN" then
-- assume Cygwin mtn is not first in path
argv = { "c:/bin/mtn" }
else
-- otherwise assume first mtn in path is correct
argv = { "mtn" }
end
end
if args["debug"] then
table.insert(argv, "--verbose")
else
table.insert(argv, "--quiet")
end
table.insert(argv, "--db")
table.insert(argv, uri["path"])
table.insert(argv, "serve")
table.insert(argv, "--stdio")
table.insert(argv, "--no-transport-auth")
elseif uri["scheme"] == "mtn" then
argv = {}
else
error(uri["scheme"] .. " not supported")
end
return argv
end end
-- end of file -- end of file

View File

@ -416,16 +416,9 @@ If SAVE-CONFLICTS non-nil, don't delete conflicts files."
(case (xmtn-status-data-local-changes data) (case (xmtn-status-data-local-changes data)
(need-scan (need-scan
(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)))) (let ((result (xmtn--status-inventory-sync (xmtn-status-work data))))
(setf (xmtn-status-data-status-buffer data) (car result) (setf (xmtn-status-data-status-buffer data) (car result)
(xmtn-status-data-local-changes data) (cadr result))) )) (xmtn-status-data-local-changes data) (cadr result))) )
(t nil)) (t nil))
(case (xmtn-status-data-heads data) (case (xmtn-status-data-heads data)
@ -491,7 +484,7 @@ If SAVE-CONFLICTS non-nil, don't delete conflicts files."
(interactive "DStatus for (workspace): ") (interactive "DStatus for (workspace): ")
(pop-to-buffer (get-buffer-create "*xmtn-multi-status*")) (pop-to-buffer (get-buffer-create "*xmtn-multi-status*"))
;; allow WORK to be relative, and ensure it is a workspace root ;; allow WORK to be relative, and ensure it is a workspace root
(setq default-directory (xmtn-tree-root (expand-file-name work))) (setq default-directory (xmtn-tree-root (expand-file-name (substitute-in-file-name work))))
(setq xmtn-status-root (expand-file-name (concat (file-name-as-directory default-directory) "../"))) (setq xmtn-status-root (expand-file-name (concat (file-name-as-directory default-directory) "../")))
(setq xmtn-status-ewoc (ewoc-create 'xmtn-status-printer)) (setq xmtn-status-ewoc (ewoc-create 'xmtn-status-printer))
;; FIXME: sometimes, this causes problems for ewoc-set-hf (deletes bad region) ;; FIXME: sometimes, this causes problems for ewoc-set-hf (deletes bad region)

View File

@ -242,16 +242,10 @@ If SAVE-CONFLICTS non-nil, don't delete conflicts files."
(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)
<<<<<<< TREE
<<<<<<< TREE
=======
=======
;; assume the commit is successful ;; assume the commit is successful
(setf (xmtn-propagate-data-to-local-changes data) 'ok) (setf (xmtn-propagate-data-to-local-changes data) 'ok)
>>>>>>> MERGE-SOURCE
(if (not (buffer-live-p (xmtn-propagate-data-to-status-buffer data))) (if (not (buffer-live-p (xmtn-propagate-data-to-status-buffer data)))
(xmtn-propagate-create-to-status-buffer data)) (xmtn-propagate-create-to-status-buffer data))
>>>>>>> MERGE-SOURCE
(pop-to-buffer (xmtn-propagate-data-to-status-buffer data)))) (pop-to-buffer (xmtn-propagate-data-to-status-buffer data))))
(defun xmtn-propagate-commit-top () (defun xmtn-propagate-commit-top ()
@ -266,16 +260,10 @@ If SAVE-CONFLICTS non-nil, don't delete conflicts files."
(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)
<<<<<<< TREE
<<<<<<< TREE
=======
=======
;; assume the commit is successful ;; assume the commit is successful
(setf (xmtn-propagate-data-from-local-changes data) 'ok) (setf (xmtn-propagate-data-from-local-changes data) 'ok)
>>>>>>> MERGE-SOURCE
(if (not (buffer-live-p (xmtn-propagate-data-from-status-buffer data))) (if (not (buffer-live-p (xmtn-propagate-data-from-status-buffer data)))
(xmtn-propagate-create-from-status-buffer data)) (xmtn-propagate-create-from-status-buffer data))
>>>>>>> MERGE-SOURCE
(pop-to-buffer (xmtn-propagate-data-from-status-buffer data)))) (pop-to-buffer (xmtn-propagate-data-from-status-buffer data))))
(defun xmtn-propagate-commit-fromp () (defun xmtn-propagate-commit-fromp ()
@ -575,38 +563,6 @@ If SAVE-CONFLICTS non-nil, don't delete conflicts files."
result result
)) ))
<<<<<<< TREE
(defun xmtn-propagate-conflicts-buffer (data)
"Return a conflicts buffer for FROM-WORK, TO-WORK (absolute paths)."
(let ((from-work (xmtn-propagate-from-work data))
(from-head-rev (xmtn-propagate-data-from-head-rev data))
(to-work (xmtn-propagate-to-work data))
(to-head-rev (xmtn-propagate-data-to-head-rev data)))
(or (dvc-get-buffer 'xmtn 'conflicts to-work)
(let ((default-directory to-work))
(if (not (file-exists-p "_MTN/conflicts"))
(progn
;; create conflicts file
(xmtn-conflicts-save-opts
from-work
to-work
(xmtn-propagate-data-from-branch data)
(xmtn-propagate-data-to-branch data))
(dvc-run-dvc-sync
'xmtn
(list "conflicts" "store" from-head-rev to-head-rev)
:error (lambda (output error status arguments)
(pop-to-buffer error)))))
;; create conflicts buffer
(save-excursion
(let ((dvc-switch-to-buffer-first nil))
(xmtn-conflicts-review to-work)
(current-buffer)))))))
=======
>>>>>>> MERGE-SOURCE
(defun xmtn-propagate-conflicts (data) (defun xmtn-propagate-conflicts (data)
"Return value for xmtn-propagate-data-conflicts for DATA." "Return value for xmtn-propagate-data-conflicts for DATA."
;; Only called if neither side needs merge. See ;; Only called if neither side needs merge. See
@ -662,12 +618,12 @@ If SAVE-CONFLICTS non-nil, don't delete conflicts files."
(setf (xmtn-propagate-data-from-local-changes data) 'need-scan) (setf (xmtn-propagate-data-from-local-changes data) 'need-scan)
(setf (xmtn-propagate-data-to-local-changes data) 'need-scan))) (setf (xmtn-propagate-data-to-local-changes data) 'need-scan)))
(ecase (xmtn-propagate-data-from-local-changes data) (case (xmtn-propagate-data-from-local-changes data)
(need-scan (need-scan
(xmtn-propagate-create-from-status-buffer data)) (xmtn-propagate-create-from-status-buffer data))
(t nil)) (t nil))
(ecase (xmtn-propagate-data-to-local-changes data) (case (xmtn-propagate-data-to-local-changes data)
(need-scan (need-scan
(xmtn-propagate-create-to-status-buffer data)) (xmtn-propagate-create-to-status-buffer data))
(t nil)) (t nil))
@ -699,7 +655,7 @@ If SAVE-CONFLICTS non-nil, don't delete conflicts files."
(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)
"FROM-WORKSPACE, TO-WORKSPACE are relative names" "FROM-WORKSPACE, TO-WORKSPACE are relative names, FROM-NAME, TO_NAME should be root dir names."
(let* ((from-work (concat xmtn-propagate-from-root from-workspace)) (let* ((from-work (concat xmtn-propagate-from-root from-workspace))
(to-work (concat xmtn-propagate-to-root to-workspace)) (to-work (concat xmtn-propagate-to-root to-workspace))
) )
@ -770,11 +726,17 @@ scanned and all common ones found are used."
(format " To root : %s\n" xmtn-propagate-to-root) (format " To root : %s\n" xmtn-propagate-to-root)
) )
"") "")
(let ((from-name (file-name-nondirectory (directory-file-name from-work)))
(to-name (file-name-nondirectory (directory-file-name to-work))))
(if (string-equal from-name to-name)
(progn
(setq from-name (file-name-nondirectory (directory-file-name xmtn-propagate-from-root)))
(setq to-name (file-name-nondirectory (directory-file-name xmtn-propagate-to-root)))))
(xmtn-propagate-make-data (xmtn-propagate-make-data
(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))
(file-name-nondirectory (directory-file-name from-work)) from-name
(file-name-nondirectory (directory-file-name to-work))) to-name))
(xmtn-propagate-mode)) (xmtn-propagate-mode))
(provide 'xmtn-propagate) (provide 'xmtn-propagate)

View File

@ -32,7 +32,7 @@
;;; docs/xmtn-readme.txt. ;;; docs/xmtn-readme.txt.
(eval-and-compile (eval-and-compile
(require 'cl) (require 'cl) ;; yes, we are using cl at runtime; we're working towards eliminating that.
(require 'dvc-unified) (require 'dvc-unified)
(require 'dvc-revlist) (require 'dvc-revlist)
(require 'xmtn-ids) (require 'xmtn-ids)
@ -46,27 +46,14 @@
"Buffer-local variable pointing to a function that generates a "Buffer-local variable pointing to a function that generates a
list of revisions to display in a revlist buffer. Called with one list of revisions to display in a revlist buffer. Called with one
arg; root. Result is of the form: arg; root. Result is of the form:
(branch ((header-lines)
(header-lines)
(footer-lines) (footer-lines)
(revisions))" (revisions))"
(make-variable-buffer-local 'xmtn--revlist-*info-generator-fn*) (make-variable-buffer-local 'xmtn--revlist-*info-generator-fn*)
(defvar xmtn--revlist-*merge-destination-branch* nil) (defvar xmtn--revlist-*path* nil)
(make-variable-buffer-local 'xmtn--revlist-*merge-destination-branch*) "Buffer-local variable containing path argument for log"
(make-variable-buffer-local 'xmtn--revlist-*path*)
(defun xmtn--escape-branch-name-for-selector (branch-name)
;; FIXME. The monotone manual refers to "shell wildcards" but
;; doesn't define what they are, or how to escape them. So just a
;; heuristic here.
(assert (not (position ?* branch-name)))
(assert (not (position ?? branch-name)))
(assert (not (position ?\\ branch-name)))
(assert (not (position ?{ branch-name)))
(assert (not (position ?} branch-name)))
(assert (not (position ?[ branch-name)))
(assert (not (position ?] branch-name)))
branch-name)
(defstruct (xmtn--revlist-entry (:constructor xmtn--make-revlist-entry)) (defstruct (xmtn--revlist-entry (:constructor xmtn--make-revlist-entry))
revision-hash-id revision-hash-id
@ -202,21 +189,11 @@ arg; root. Result is of the form:
(defun xmtn--revlist-refresh () (defun xmtn--revlist-refresh ()
(let ((root default-directory)) (let ((root default-directory))
<<<<<<< TREE
(destructuring-bind (merge-destination-branch
header-lines footer-lines revision-hash-ids)
=======
(destructuring-bind (header-lines footer-lines revs) (destructuring-bind (header-lines footer-lines revs)
>>>>>>> MERGE-SOURCE
(funcall xmtn--revlist-*info-generator-fn* root) (funcall xmtn--revlist-*info-generator-fn* root)
<<<<<<< TREE
(setq xmtn--revlist-*merge-destination-branch* merge-destination-branch)
(let ((ewoc dvc-revlist-cookie))
=======
(let ((ewoc dvc-revlist-cookie) (let ((ewoc dvc-revlist-cookie)
(count (length revs)) (count (length revs))
(last-n dvc-revlist-last-n)) (last-n dvc-revlist-last-n))
>>>>>>> MERGE-SOURCE
(xmtn--revlist-setup-ewoc root ewoc (xmtn--revlist-setup-ewoc root ewoc
(with-temp-buffer (with-temp-buffer
(dolist (line header-lines) (dolist (line header-lines)
@ -248,15 +225,16 @@ arg; root. Result is of the form:
(ewoc-goto-node ewoc (ewoc-nth ewoc 0)))))) (ewoc-goto-node ewoc (ewoc-nth ewoc 0))))))
nil) nil)
(defun xmtn--setup-revlist (root info-generator-fn first-line-only-p last-n) (defun xmtn--setup-revlist (root info-generator-fn path first-line-only-p last-n)
;; Adapted from `dvc-build-revision-list'. ;; Adapted from `dvc-build-revision-list'.
;; info-generator-fn must return a list of back-end revision ids (strings) ;; See xmtn--revlist-*info-generator-fn*
(xmtn-automate-cache-session root) (xmtn-automate-cache-session root)
(let ((dvc-temp-current-active-dvc 'xmtn) (let ((dvc-temp-current-active-dvc 'xmtn)
(buffer (dvc-revlist-create-buffer (buffer (dvc-revlist-create-buffer
'xmtn 'log root 'xmtn--revlist-refresh first-line-only-p last-n))) 'xmtn 'log root 'xmtn--revlist-refresh first-line-only-p last-n)))
(with-current-buffer buffer (with-current-buffer buffer
(setq xmtn--revlist-*info-generator-fn* info-generator-fn) (setq xmtn--revlist-*info-generator-fn* info-generator-fn)
(setq xmtn--revlist-*path* (when path (file-relative-name path root)))
(xmtn--revlist-refresh)) (xmtn--revlist-refresh))
(xmtn--display-buffer-maybe buffer nil)) (xmtn--display-buffer-maybe buffer nil))
nil) nil)
@ -265,7 +243,12 @@ arg; root. Result is of the form:
(defun xmtn-dvc-log (path last-n) (defun xmtn-dvc-log (path last-n)
;; path may be nil or a file. The front-end ensures that ;; path may be nil or a file. The front-end ensures that
;; 'default-directory' is set to a tree root. ;; 'default-directory' is set to a tree root.
(xmtn--log-helper default-directory path t last-n)) (xmtn--setup-revlist
default-directory
'xmtn--log-generator
path
t ;; first-line-only-p
last-n))
;;;###autoload ;;;###autoload
(defun xmtn-log (&optional path last-n) (defun xmtn-log (&optional path last-n)
@ -279,91 +262,6 @@ arg; root. Result is of the form:
;;;###autoload ;;;###autoload
(defun xmtn-dvc-changelog (&optional path) (defun xmtn-dvc-changelog (&optional path)
<<<<<<< TREE
(xmtn--log-helper (dvc-tree-root) path nil nil))
(defun xmtn--log-helper (root path first-line-only-p last-n)
(if path
(xmtn-list-revisions-modifying-file path nil first-line-only-p last-n)
(xmtn--setup-revlist
root
(lambda (root)
(let ((branch (xmtn--tree-default-branch root)))
(list branch
(list
(if dvc-revlist-last-n
(format "Log for branch %s (last %d entries):" branch dvc-revlist-last-n)
(format "Log for branch %s (all entries):" branch)))
'()
(xmtn--expand-selector
root
;; This restriction to current branch is completely
;; arbitrary.
(concat
"b:" ;; returns all revs for current branch
(xmtn--escape-branch-name-for-selector
branch))))))
first-line-only-p
last-n)))
(defun xmtn--revlist--missing-get-info (root)
(let* ((branch (xmtn--tree-default-branch root))
(heads (xmtn--heads root branch))
(base-revision-hash-id (xmtn--get-base-revision-hash-id root))
(difference
(delete-duplicates
(mapcan
(lambda (head)
(xmtn-automate-simple-command-output-lines
root
`("ancestry_difference"
,head ,base-revision-hash-id)))
heads))))
(list
branch
`(,(format "Tree %s" root)
,(format "Branch %s" branch)
,(format "Base %s" base-revision-hash-id)
,(case (length heads)
(1 "branch is merged")
(t (dvc-face-add (format "branch has %s heads; need merge" (length heads)) 'dvc-conflict)))
nil
,(case (length difference)
(0 "No revisions that are not in base revision")
(1 "1 revision that is not in base revision:")
(t (format
"%s revisions that are not in base revision:"
(length 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)))
=======
(xmtn--setup-revlist (xmtn--setup-revlist
(dvc-tree-root) (dvc-tree-root)
'xmtn--log-generator 'xmtn--log-generator
@ -397,7 +295,6 @@ arg; root. Result is of the form:
(xmtn-automate-command-output-lines ;; revisions (xmtn-automate-command-output-lines ;; revisions
root root
(cons options command)))))) (cons options command))))))
>>>>>>> MERGE-SOURCE
(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
@ -472,14 +369,14 @@ from the merge."
;;;###autoload ;;;###autoload
(defun xmtn-dvc-missing (&optional other) (defun xmtn-dvc-missing (&optional other)
;; `other', if non-nil, designates a remote repository (see bzr); mtn doesn't support that. ;; `other', if non-nil, designates a remote repository (see bzr); mtn doesn't support that.
(let ((root (dvc-tree-root))) (let* ((root (dvc-tree-root))
(branch (xmtn--tree-default-branch root))
(heads (xmtn--heads root branch)))
(if (/= 1 (length heads))
(error "%d heads, need merge; use `xmtn-status-one'" (length heads)))
(xmtn--setup-revlist (xmtn--setup-revlist
root root
<<<<<<< TREE
'xmtn--revlist--missing-get-info
;; Passing nil as first-line-only-p is arbitrary here.
;;
=======
(lambda (root) (lambda (root)
(let ((revs (let ((revs
(xmtn-automate-command-output-lines (xmtn-automate-command-output-lines
@ -494,13 +391,12 @@ from the merge."
revs))) revs)))
nil ;; path nil ;; path
nil ;; first-line-only-p nil ;; first-line-only-p
>>>>>>> MERGE-SOURCE
;; When the missing revs are due to a propagate, there can be a ;; When the missing revs are due to a propagate, there can be a
;; lot of them, but we only really need to see the revs since the ;; lot of them, but we only really need to see the revs since the
;; propagate. So dvc-log-last-n is appropriate. We use ;; propagate. So dvc-log-last-n is appropriate. We use
;; dvc-log-last-n, not dvc-revlist-last-n, because -log is user ;; dvc-log-last-n, not dvc-revlist-last-n, because -log is user
;; customizable. ;; customizable.
nil dvc-log-last-n)) dvc-log-last-n))
nil) nil)
;;;###autoload ;;;###autoload
@ -509,9 +405,6 @@ from the merge."
(interactive "D") (interactive "D")
(xmtn--setup-revlist (xmtn--setup-revlist
root root
<<<<<<< TREE
'xmtn--revlist--review-update-info
=======
(lambda (root) (lambda (root)
(let ((revs (let ((revs
(xmtn-automate-command-output-lines (xmtn-automate-command-output-lines
@ -525,7 +418,6 @@ from the merge."
'() ;; footer '() ;; footer
revs))) revs)))
nil ;; path nil ;; path
>>>>>>> MERGE-SOURCE
nil ;; first-line-only-p nil ;; first-line-only-p
dvc-log-last-n) dvc-log-last-n)
nil) nil)
@ -541,63 +433,17 @@ from the merge."
(let* ((branch (xmtn--tree-default-branch root)) (let* ((branch (xmtn--tree-default-branch root))
(head-revision-hash-ids (xmtn--heads root branch))) (head-revision-hash-ids (xmtn--heads root branch)))
(list (list
<<<<<<< TREE
branch
(list (format "Tree %s" root)
(format "Branch %s" branch)
(case head-count
(0 "No head revisions (branch empty (or circular ;))")
(1 "1 head revision:")
(t (format "%s head revisions: " head-count))))
'()
=======
(list ; header (list ; header
(format "workspace %s" root) (format "workspace %s" root)
"Head revisions") "Head revisions")
'() ; footer '() ; footer
>>>>>>> MERGE-SOURCE
head-revision-hash-ids))) head-revision-hash-ids)))
;; Passing nil as first-line-only-p, last-n is arbitrary here. nil ;; path
nil nil)) nil ;; first-line-only-p
nil ;; last-n
))
nil) nil)
;;;###autoload
;; This function doesn't quite offer the interface I really want: From
;; the resulting revlist buffer, there's no way to request a diff
;; restricted to the file in question. But it's still handy.
(defun xmtn-list-revisions-modifying-file (file &optional last-backend-id first-line-only-p last-n)
"Display a revlist buffer showing the revisions that modify FILE.
Only ancestors of revision LAST-BACKEND-ID will be considered.
FILE is a file name in revision LAST-BACKEND-ID, which defaults
to the base revision of the current tree."
(interactive "FList revisions modifying file: ")
(let* ((root (dvc-tree-root))
(normalized-file (xmtn--normalize-file-name root file)))
(unless last-backend-id
(setq last-backend-id `(last-revision ,root 1)))
(lexical-let ((last-backend-id last-backend-id)
(file file)
(normalized-file normalized-file))
(xmtn--setup-revlist
root
(lambda (root)
(let ((branch (xmtn--tree-default-branch root))
(revision-hash-ids
(mapcar #'first
(xmtn--get-content-changed-closure
root last-backend-id normalized-file dvc-revlist-last-n))))
(list
branch
(list
(if dvc-revlist-last-n
(format "Log for %s (last %d entries)" file dvc-revlist-last-n)
(format "Log for %s" file)))
'()
revision-hash-ids)))
first-line-only-p
last-n))))
(defvar xmtn--*selector-history* nil) (defvar xmtn--*selector-history* nil)
;;;###autoload ;;;###autoload
@ -613,25 +459,9 @@ to the base revision of the current tree."
(xmtn--setup-revlist (xmtn--setup-revlist
root root
(lambda (root) (lambda (root)
(let* ((branch (xmtn--tree-default-branch root)) (let* ((revision-hash-ids (xmtn--expand-selector root selector))
(revision-hash-ids (xmtn--expand-selector root selector))
(count (length revision-hash-ids))) (count (length revision-hash-ids)))
(list (list
<<<<<<< TREE
branch
(list (format "Tree %s" root)
(format "Default branch %s" branch)
(if (with-syntax-table (standard-syntax-table)
(string-match "\\`\\s *\\'" selector))
"Blank selector"
(format "Selector %s" selector))
(case count
(0 "No revisions matching selector")
(1 "1 revision matching selector:")
(t (format "%s revisions matching selector: "
count))))
'()
=======
(list ; header (list ; header
(format "workspace %s" root) (format "workspace %s" root)
(if (with-syntax-table (standard-syntax-table) (if (with-syntax-table (standard-syntax-table)
@ -640,12 +470,11 @@ to the base revision of the current tree."
(format "Selector %s" selector)) (format "Selector %s" selector))
"Revisions matching selector") "Revisions matching selector")
'() ; footer '() ; footer
>>>>>>> MERGE-SOURCE
revision-hash-ids))) revision-hash-ids)))
;; Passing nil as first-line-only-p is arbitrary here. nil ;; path
nil nil ;; first-line-only-p
;; FIXME: it might be useful to specify last-n here nil ;; last-n
nil))) )))
nil) nil)
;; This generates the output shown when the user hits RET on a ;; This generates the output shown when the user hits RET on a
@ -674,31 +503,6 @@ to the base revision of the current tree."
(write-line "Untrusted cert, name=%s" name) (write-line "Untrusted cert, name=%s" name)
(write-line "%s: %s" name value))))))))))) (write-line "%s: %s" name value)))))))))))
(defun xmtn-revlist-explicit-merge ()
"Run mtn explicit_merge on the two marked revisions.
To be invoked from an xmtn revlist buffer."
(interactive)
(let ((entries (dvc-revision-marked-revisions))
(root (dvc-tree-root)))
(unless (eql (length entries) 2)
(error "Precisely 2 revisions must be marked for merge, not %s"
(length entries)))
(let ((hash-ids (mapcar #'xmtn--revlist-entry-revision-hash-id entries))
(destination-branch-name xmtn--revlist-*merge-destination-branch*))
;; FIXME: Does it make any difference which one we choose as
;; "left" and which one we choose as "right"? (If it does, we
;; should also make their selection in the UI asymmetrical: For
;; example, require precisely one marked revision and use the
;; one at point as the other.)
(destructuring-bind (left right) hash-ids
(unless (yes-or-no-p
(format "Merge revisions %s and %s onto branch %s? "
left right destination-branch-name))
(error "Aborted merge"))
(xmtn--do-explicit-merge root left right destination-branch-name))))
nil)
(defun xmtn-revlist-update () (defun xmtn-revlist-update ()
"Update current tree to the revision at point. "Update current tree to the revision at point.

View File

@ -76,46 +76,7 @@
,@arguments) ,@arguments)
dvc-run-keys))) dvc-run-keys)))
<<<<<<< TREE
(defun xmtn--command-output-lines (root arguments)
"Run mtn in ROOT with ARGUMENTS and return its output as a list of strings."
(xmtn--check-cached-command-version)
(let ((accu (list)))
(let ((default-directory (file-truename (or root default-directory))))
(dvc-run-dvc-sync
'xmtn
`(,@xmtn-additional-arguments
,@(if root `(,(concat "--root=" (file-truename root))))
,@arguments)
:finished (lambda (output error status arguments)
(with-current-buffer output
(save-excursion
(goto-char (point-min))
(while (not (eobp))
(push (buffer-substring-no-properties
(point)
(progn (end-of-line) (point)))
accu)
(forward-line 1)))))))
(setq accu (nreverse accu))
accu))
(defun xmtn--command-output-line (root arguments)
"Run mtn in ROOT with ARGUMENTS and return the one line of output as string.
Signals an error if more (or fewer) than one line is output."
(let ((lines (xmtn--command-output-lines root arguments)))
(unless (eql (length lines) 1)
(error "Expected precisely one line of output from monotone, got %s: %s %S"
(length lines)
xmtn-executable
arguments))
(first lines)))
(defconst xmtn--minimum-required-command-version '(0 46))
=======
(defconst xmtn--minimum-required-command-version '(0 99)) (defconst xmtn--minimum-required-command-version '(0 99))
>>>>>>> MERGE-SOURCE
;; see also xmtn-sync.el xmtn-sync-required-command-version ;; see also xmtn-sync.el xmtn-sync-required-command-version
(defconst xmtn--required-automate-format-version "2") (defconst xmtn--required-automate-format-version "2")
@ -130,6 +91,7 @@ Signals an error if more (or fewer) than one line is output."
(version-list-<= required (butlast (xmtn--cached-command-version) 2))) (version-list-<= required (butlast (xmtn--cached-command-version) 2)))
(defun xmtn--clear-command-version-cache () (defun xmtn--clear-command-version-cache ()
(interactive)
(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))
@ -152,28 +114,6 @@ VERSION-STRING is the string printed by `mtn version' (with no
trailing newline). MAJOR and MINOR are integers, a parsed trailing newline). MAJOR and MINOR are integers, a parsed
representation of the version number. REVISION is the revision representation of the version number. REVISION is the revision
id." id."
<<<<<<< TREE
(let (
;; Cache a fake version number to avoid infinite mutual
;; recursion.
(xmtn--*cached-command-version*
(append xmtn--minimum-required-command-version
'("xmtn-dummy" "xmtn-dummy")))
(xmtn--*command-version-cached-for-executable* executable)
(xmtn-executable executable))
(let ((string (xmtn--command-output-line nil '("--version"))))
(unless (string-match
(concat "\\`monotone \\([0-9]+\\)\\.\\([0-9]+\\)\\(dev\\)?"
" (base revision: \\(unknown\\|\\([0-9a-f]\\{40\\}\\)\\))\\'")
string)
(error (concat "Version output from monotone --version"
" did not match expected pattern: %S")
string))
(let ((major (parse-integer string (match-beginning 1) (match-end 1)))
(minor (parse-integer string (match-beginning 2) (match-end 2)))
(revision (match-string 4 string)))
(list major minor revision string)))))
=======
(let ((version-string)) (let ((version-string))
(dvc-run-dvc-sync (dvc-run-dvc-sync
'xmtn 'xmtn
@ -194,7 +134,6 @@ id."
(minor (parse-integer version-string (match-beginning 2) (match-end 2))) (minor (parse-integer version-string (match-beginning 2) (match-end 2)))
(revision (match-string 4 version-string))) (revision (match-string 4 version-string)))
(list major minor revision version-string)))) (list major minor revision version-string))))
>>>>>>> MERGE-SOURCE
(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)

View File

@ -25,14 +25,13 @@
) )
(eval-and-compile (eval-and-compile
;; these have functions we use ;; these have functions (and possibly macros) we use
(require 'dvc-config)
(require 'xmtn-automate) (require 'xmtn-automate)
(require 'xmtn-basic-io)
) )
;;; User variables ;;; User variables
(defvar xmtn-sync-branch-file "~/.dvc/branches"
"File associating branch name with workspace root")
(defvar xmtn-sync-executable (defvar xmtn-sync-executable
(cond (cond
((equal system-type 'windows-nt) ((equal system-type 'windows-nt)
@ -44,8 +43,20 @@
"mtn")) "mtn"))
"Executable for running sync command on local db; overrides xmtn-executable.") "Executable for running sync command on local db; overrides xmtn-executable.")
(defvar xmtn-sync-config "xmtn-sync-config" (defvar xmtn-sync-automate-args
"File to store `xmtn-sync-branch-alist' and `xmtn-sync-remote-exec-alist'; relative to `dvc-config-directory'.") (cond
((equal system-type 'windows-nt)
;; Assume using Cygwin, which looks for .monotone/keys in a different place.
(list "--keydir" "~/.monotone/keys"))
(t
;; Unix or Cygwin
nil))
"Extra arguments (list of strings) used when starting a sync automate process;
overrides xmtn-automate-arguments.")
(defvar xmtn-sync-guess-workspace nil
"User-supplied function to guess workspace location given branch.
Called with a string containing the mtn branch name; return a workspace root or nil.")
(defvar xmtn-sync-sort nil (defvar xmtn-sync-sort nil
"User-supplied function to sort branches. "User-supplied function to sort branches.
@ -54,13 +65,6 @@ Called with a string containing the mtn branch name; return
insert at end), key is the sort-key. Sync buffer is current.") insert at end), key is the sort-key. Sync buffer is current.")
;;; Internal variables ;;; Internal variables
<<<<<<< TREE
(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'.")
=======
(defconst xmtn-sync-save-file "sync" (defconst xmtn-sync-save-file "sync"
"File to save sync review state for later; relative to `dvc-config-directory'.") "File to save sync review state for later; relative to `dvc-config-directory'.")
@ -77,15 +81,12 @@ insert at end), key is the sort-key. Sync buffer is current.")
;; Sometimes the Cygwin version lags behind the MinGW version; this allows that. ;; Sometimes the Cygwin version lags behind the MinGW version; this allows that.
"Minimum version for `xmtn-sync-executable'; overrides xmtn--minimum-required-command-version. "Minimum version for `xmtn-sync-executable'; overrides xmtn--minimum-required-command-version.
Must support file:, ssh:, automate sync.") Must support file:, ssh:, automate sync.")
>>>>>>> MERGE-SOURCE
;; loaded from xmtn-sync-config ;; loaded from xmtn-sync-config
(defvar xmtn-sync-branch-alist nil (defvar xmtn-sync-branch-alist nil
"Alist associating branch name with workspace root") "Alist associating branch name with workspace root")
(defvar xmtn-sync-remote-exec-alist (defvar xmtn-sync-remote-exec-alist nil
(list
(list "file://" xmtn-sync-executable))
"Alist of host and remote command. Overrides `xmtn-sync-remote-exec-default'.") "Alist of host and remote command. Overrides `xmtn-sync-remote-exec-default'.")
;; buffer-local ;; buffer-local
@ -97,36 +98,12 @@ Must support file:, ssh:, automate sync.")
"Absolute path to remote database.") "Absolute path to remote database.")
(make-variable-buffer-local 'xmtn-sync-remote-db) (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 (defvar xmtn-sync-ewoc nil
"Buffer-local ewoc for displaying sync. "Buffer-local ewoc for displaying sync.
All xmtn-sync functions operate on this ewoc. All xmtn-sync functions operate on this ewoc.
The elements must all be of type xmtn-sync-sync.") The elements must all be of type xmtn-sync-sync.")
(make-variable-buffer-local 'xmtn-sync-ewoc) (make-variable-buffer-local 'xmtn-sync-ewoc)
<<<<<<< TREE
=======
(defstruct (xmtn-sync-branch (defstruct (xmtn-sync-branch
(:copier nil)) (:copier nil))
;; ewoc element; data for a branch that was received ;; ewoc element; data for a branch that was received
@ -193,24 +170,12 @@ The elements must all be of type xmtn-sync-sync.")
(setf (xmtn-sync-branch-print-mode data) 'summary) (setf (xmtn-sync-branch-print-mode data) 'summary)
(ewoc-invalidate xmtn-sync-ewoc elem))) (ewoc-invalidate xmtn-sync-ewoc elem)))
>>>>>>> MERGE-SOURCE
(defun xmtn-sync-status () (defun xmtn-sync-status ()
"Start xmtn-status-one for current ewoc element." "Start xmtn-status-one for current ewoc element."
(let* ((data (ewoc-data (ewoc-locate xmtn-sync-ewoc))) (interactive)
(let* ((elem (ewoc-locate xmtn-sync-ewoc))
(data (ewoc-data elem))
(branch (xmtn-sync-branch-name data)) (branch (xmtn-sync-branch-name data))
<<<<<<< TREE
(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))
=======
save-work save-work
(work (or (work (or
(cadr (assoc branch xmtn-sync-branch-alist)) (cadr (assoc branch xmtn-sync-branch-alist))
@ -269,16 +234,11 @@ The elements must all be of type xmtn-sync-sync.")
(define-key map [?b] '(menu-item "b) brief" xmtn-sync-brief)) (define-key map [?b] '(menu-item "b) brief" xmtn-sync-brief))
(define-key map [?s] '(menu-item "s) status" xmtn-sync-status)) (define-key map [?s] '(menu-item "s) status" xmtn-sync-status))
(define-key map [?u] '(menu-item "u) update" xmtn-sync-update)) (define-key map [?u] '(menu-item "u) update" xmtn-sync-update))
>>>>>>> MERGE-SOURCE
map) map)
"Keyboard menu keymap for xmtn-sync-ewoc.") "Keyboard menu keymap used in `xmtn-sync-mode'.")
(defvar xmtn-sync-mode-map (defvar xmtn-sync-mode-map
(let ((map (make-sparse-keymap))) (let ((map (make-sparse-keymap)))
<<<<<<< TREE
(define-key map [?q] 'dvc-buffer-quit)
(define-key map "\M-d" xmtn-sync-ewoc-map)
=======
(define-key map "\M-d" xmtn-sync-kbd-map) (define-key map "\M-d" xmtn-sync-kbd-map)
(define-key map [?b] 'xmtn-sync-brief) (define-key map [?b] 'xmtn-sync-brief)
(define-key map [?c] 'xmtn-sync-clean) (define-key map [?c] 'xmtn-sync-clean)
@ -289,17 +249,12 @@ The elements must all be of type xmtn-sync-sync.")
(define-key map [?s] 'xmtn-sync-status) (define-key map [?s] 'xmtn-sync-status)
(define-key map [?u] 'xmtn-sync-update) (define-key map [?u] 'xmtn-sync-update)
(define-key map [?S] 'xmtn-sync-save) (define-key map [?S] 'xmtn-sync-save)
>>>>>>> MERGE-SOURCE
map) map)
"Keymap used in `xmtn-sync-mode'.") "Keymap used in `xmtn-sync-mode'.")
(easy-menu-define xmtn-sync-mode-menu xmtn-sync-mode-map (easy-menu-define xmtn-sync-mode-menu xmtn-sync-mode-map
"`xmtn-sync' menu" "`xmtn-sync' menu"
`("Xmtn-sync" `("Xmtn-sync"
<<<<<<< TREE
["Do the right thing" xmtn-sync-ewoc-map t]
["Quit" dvc-buffer-quit t]
=======
;; first item is top in display ;; first item is top in display
["Status" xmtn-sync-status t] ["Status" xmtn-sync-status t]
["Update" xmtn-sync-update t] ["Update" xmtn-sync-update t]
@ -308,33 +263,20 @@ The elements must all be of type xmtn-sync-sync.")
["Clean/delete" xmtn-sync-clean t] ["Clean/delete" xmtn-sync-clean t]
["Save" xmtn-sync-save t] ["Save" xmtn-sync-save t]
["Save and Quit" (lambda () (kill-buffer (current-buffer))) t] ["Save and Quit" (lambda () (kill-buffer (current-buffer))) t]
>>>>>>> MERGE-SOURCE
)) ))
;; derive from nil causes no keymap to be used, but still have self-insert keys
;; derive from fundamental-mode causes self-insert keys
(define-derived-mode xmtn-sync-mode fundamental-mode "xmtn-sync" (define-derived-mode xmtn-sync-mode fundamental-mode "xmtn-sync"
"Major mode to specify conflict resolutions." "Major mode to specify conflict resolutions."
(setq dvc-buffer-current-active-dvc 'xmtn) (setq dvc-buffer-current-active-dvc 'xmtn)
(setq buffer-read-only nil)
(setq xmtn-sync-ewoc (ewoc-create 'xmtn-sync-printer)) (setq xmtn-sync-ewoc (ewoc-create 'xmtn-sync-printer))
(setq dvc-buffer-refresh-function nil) (setq dvc-buffer-refresh-function nil)
(dvc-install-buffer-menu) (dvc-install-buffer-menu)
<<<<<<< TREE
<<<<<<< TREE
(setq buffer-read-only t)
(buffer-disable-undo)
(set-buffer-modified-p nil))
=======
(buffer-disable-undo))
=======
(add-hook 'kill-buffer-hook 'xmtn-sync-save nil t) (add-hook 'kill-buffer-hook 'xmtn-sync-save nil t)
(buffer-disable-undo) (buffer-disable-undo)
(unless xmtn-sync-branch-alist (unless xmtn-sync-branch-alist
(let ((branch-file (expand-file-name xmtn-sync-branch-file dvc-config-directory))) (let ((branch-file (expand-file-name xmtn-sync-branch-file dvc-config-directory)))
(if (file-exists-p branch-file) (if (file-exists-p branch-file)
(load branch-file))))) (load branch-file)))))
>>>>>>> MERGE-SOURCE
(defun xmtn-sync-parse-revision-certs (direction) (defun xmtn-sync-parse-revision-certs (direction)
"Parse certs associated with a revision; return (branch changelog date author)." "Parse certs associated with a revision; return (branch changelog date author)."
@ -552,47 +494,12 @@ Return non-nil if anything parsed."
(setq buffer-read-only nil) (setq buffer-read-only nil)
(dolist (data stuff) (ewoc-enter-last xmtn-sync-ewoc data)) (dolist (data stuff) (ewoc-enter-last xmtn-sync-ewoc data))
(setq buffer-read-only t) (setq buffer-read-only t)
<<<<<<< TREE
(set-buffer-modified-p nil))
(unless noerror
(error "%s file not found" save-file)))))
>>>>>>> MERGE-SOURCE
=======
(set-buffer-modified-p nil))))) (set-buffer-modified-p nil)))))
>>>>>>> MERGE-SOURCE
;;;###autoload ;;;###autoload
<<<<<<< TREE
(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."
<<<<<<< TREE
(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
)))
=======
=======
(defun xmtn-sync-sync (local-db scheme remote-host remote-db) (defun xmtn-sync-sync (local-db scheme remote-host remote-db)
"Sync LOCAL-DB with using SCHEME to connect to REMOTE-HOST REMOTE-DB, display sent and received branches. "Sync LOCAL-DB with using SCHEME to connect to REMOTE-HOST REMOTE-DB, display sent and received branches.
Remote-db should include branch pattern in URI syntax. Uses `xmtn-sync-executable' to run sync." Remote-db should include branch pattern in URI syntax. Uses `xmtn-sync-executable' to run sync."
>>>>>>> MERGE-SOURCE
(interactive "flocal db: \nMscheme: \nMremote-host: \nMremote-db: ") (interactive "flocal db: \nMscheme: \nMremote-host: \nMremote-db: ")
(pop-to-buffer (get-buffer-create "*xmtn-sync*")) (pop-to-buffer (get-buffer-create "*xmtn-sync*"))
@ -705,7 +612,6 @@ FILE should be output of 'automate sync'. (external sync handles tickers better)
(set-buffer-modified-p nil) (set-buffer-modified-p nil)
(xmtn-sync-save) (xmtn-sync-save)
(delete-file file)))) (delete-file file))))
>>>>>>> MERGE-SOURCE
(provide 'xmtn-sync) (provide 'xmtn-sync)

0
dvc/scripts/dvc-cron.sh Normal file → Executable file
View File

0
dvc/scripts/make-deb-pkg.sh Normal file → Executable file
View File

0
dvc/scripts/rename-tla-dvc.sh Normal file → Executable file
View File

0
dvc/scripts/tla-tree-revision.sh Normal file → Executable file
View File

View File

@ -17,15 +17,16 @@ TEXI2DVI = texi2dvi
datarootdir = @datarootdir@ datarootdir = @datarootdir@
prefix = @prefix@ prefix = @prefix@
info_dir = @info_dir@ info_dir = @info_dir@
DATE_FLAVOR = @DATE_FLAVOR@
############################################################################## ##############################################################################
all: info dvc.dvi dvc.html dvc.pdf all: info dvc.dvi dvc.html dvc-intro.html dvc.pdf
dvi: dvc.dvi dvi: dvc.dvi
pdf: dvc.pdf pdf: dvc.pdf
html: dvc.html html: dvc.html dvc-intro.html
Makefile: $(srcdir)/Makefile.in ../config.status Makefile: $(srcdir)/Makefile.in ../config.status
cd ..; ./config.status cd ..; ./config.status
@ -50,11 +51,7 @@ uninstall:
info: dvc.info dvc-intro.info info: dvc.info dvc-intro.info
<<<<<<< TREE
alldeps = $(srcdir)/dvc.texinfo dvc-version.texinfo
=======
alldeps = $(srcdir)/dvc.texinfo dvc-version.texinfo $(srcdir)/dvc-intro.texinfo alldeps = $(srcdir)/dvc.texinfo dvc-version.texinfo $(srcdir)/dvc-intro.texinfo
>>>>>>> MERGE-SOURCE
dvc.info: $(alldeps) dvc.info: $(alldeps)
$(MAKEINFO) $(srcdir)/dvc.texinfo $(MAKEINFO) $(srcdir)/dvc.texinfo
@ -65,6 +62,9 @@ dvc-intro.info: $(alldeps)
dvc.html: $(alldeps) dvc.html: $(alldeps)
$(MAKEINFO) --html --no-split $(srcdir)/dvc.texinfo $(MAKEINFO) --html --no-split $(srcdir)/dvc.texinfo
dvc-intro.html: $(alldeps)
$(MAKEINFO) --html --no-split $(srcdir)/dvc-intro.texinfo
dvc.dvi: $(alldeps) dvc.dvi: $(alldeps)
$(TEXI2DVI) -o $@ $(srcdir)/dvc.texinfo $(TEXI2DVI) -o $@ $(srcdir)/dvc.texinfo
@ -85,8 +85,18 @@ maintainer-clean:
dvc-version.texinfo: $(top_srcdir)/configure dvc-version.texinfo: $(top_srcdir)/configure
@echo Creating $@ @echo Creating $@
@( echo @set VERSION $(PACKAGE_VERSION) ; \ @if test "${DATE_FLAVOR}" = "GNU"; then \
date '+@set UPDATED %F' -r $< ) > $@ ( echo @set VERSION $(PACKAGE_VERSION) ; \
date '+@set UPDATED %F' -r $< ) > $@ ; \
elif test "${DATE_FLAVOR}" = "BSD"; then \
( echo @set VERSION $(PACKAGE_VERSION) ; \
stat -t'%F' -f'@set UPDATED %Sm' $< ) > $@; \
else \
echo "Uknown date flavor: ${DATE_FLAVOR}"; \
false; \
fi
.PHONY: all dvi pdf html info \ .PHONY: all dvi pdf html info \
install uninstall \ install uninstall \

View File

@ -48,10 +48,7 @@ Invoking
* xmtn-status-one:: * xmtn-status-one::
* xmtn-propagate-one:: * xmtn-propagate-one::
<<<<<<< TREE
=======
* xmtn-sync-review:: * xmtn-sync-review::
>>>>>>> MERGE-SOURCE
Key bindings Key bindings
@ -297,8 +294,6 @@ Supervises propagating one workspace.
@item xmtn-propagate-multiple @item xmtn-propagate-multiple
Supervises propagating several workspaces. Supervises propagating several workspaces.
<<<<<<< TREE
=======
@item xmtn-sync-sync @item xmtn-sync-sync
Syncs the local database with a remote database, then runs Syncs the local database with a remote database, then runs
xmtn-sync-review. xmtn-sync-review.
@ -306,26 +301,14 @@ xmtn-sync-review.
@item xmtn-sync-review @item xmtn-sync-review
Reviews saved output of a command-line @command{mtn automate sync}, Reviews saved output of a command-line @command{mtn automate sync},
displays branches that have been transferred. This is useful for syncs displays branches that have been transferred. This is useful for syncs
<<<<<<< TREE
that take a long time, because external commands display the tickers
much better than DVC does.
The external sync should redirect stdout to @file{~/.dvc/sync.basic_io}.
>>>>>>> MERGE-SOURCE
=======
that take a long time, because the command-line displays progress that take a long time, because the command-line displays progress
tickers. tickers.
>>>>>>> MERGE-SOURCE
@end table @end table
@menu @menu
* xmtn-status-one:: * xmtn-status-one::
* xmtn-propagate-one:: * xmtn-propagate-one::
<<<<<<< TREE
=======
* xmtn-sync-review:: * xmtn-sync-review::
>>>>>>> MERGE-SOURCE
@end menu @end menu
@node xmtn-status-one @node xmtn-status-one
@ -437,8 +420,6 @@ the workspace from the display.
@end table @end table
<<<<<<< TREE
=======
@node xmtn-sync-review @node xmtn-sync-review
@section xmtn-sync-review @section xmtn-sync-review
@command{xmtn-sync-review} supervises the process of updating local @command{xmtn-sync-review} supervises the process of updating local
@ -510,7 +491,6 @@ Save the displayed branches.
@end table @end table
>>>>>>> MERGE-SOURCE
@node Status Display @node Status Display
@chapter Status Display @chapter Status Display