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 2012-07-29 23:06:41 +02:00
parent 34d25895bf
commit 510d1a196b
27 changed files with 435 additions and 724 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
dvc/configure.ac
View File

@ -56,6 +56,7 @@ AC_CONFIG_FILES([Makefile lisp/Makefile texinfo/Makefile dvc-load.el lisp/dvc-si
# Common system utilities checking:
AC_PROG_MAKE_SET
AC_PROG_INSTALL
AC_PROG_MKDIR_P
# 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])
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
# 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

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

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

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

@ -140,7 +140,8 @@
(buffer-disable-undo)
(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)
"Prepare and return a status buffer. Should be called by <back-end>-dvc-status.

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

@ -1,6 +1,6 @@
;;; 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>
@ -78,7 +78,9 @@
;;; Code:
(require 'dired-x)
(condition-case nil
(require 'dired-x)
(error nil))
(require 'ffap)
(require 'dvc-register)
(require 'dvc-core)
@ -101,7 +103,7 @@ Note: this function is only useful when called interactively."
(working-dir (dvc-uniquify-file-name default-directory))
(dvc))
;; hide backends that don't provide an init function
(mapcar '(lambda (elem)
(mapc '(lambda (elem)
(setq supported-variants (delete elem supported-variants)))
'("xdarcs" "xmtn" "baz"))
(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
many entries (absolute value)). Use `dvc-changelog' for the full log."
(interactive "i\nP")
<<<<<<< TREE
(let* ((allentries (or (eq last-n nil)
(< (prefix-numeric-value last-n) 0)))
(last-n (prefix-numeric-value last-n))
(path (if (< last-n 0)
nil (buffer-file-name)))
(last-n (if allentries nil last-n))
=======
(let* ((path (if (and last-n (< (prefix-numeric-value last-n) 0))
nil (buffer-file-name)))
(last-n (if last-n
(abs (prefix-numeric-value last-n))
dvc-log-last-n))
>>>>>>> MERGE-SOURCE
(default-directory
(dvc-read-project-tree-maybe "DVC tree root (directory): "
(when path (expand-file-name path))

2
dvc/lisp/tla-core.el
View File

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

2
dvc/lisp/tla-tests.el
View File

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

8
dvc/lisp/tla.el
View File

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

4
dvc/lisp/xhg.el
View File

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

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

@ -47,7 +47,7 @@
;; process must be killed with `xmtn-automate-kill-session'.
;;
;; 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 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
;; 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
;; output. Your Emacs Lisp code can also do other computation while
;; the monotone command runs. Allowing this kind of parallelism is
@ -74,9 +74,12 @@
(require 'xmtn-run)
(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.")
(defconst xmtn-sync-session-root "sync"
"Name for unique automate session used for sync commands.")
(defun xmtn-automate-command-buffer (command)
(xmtn-automate--command-handle-buffer command))
@ -86,8 +89,10 @@
(defun xmtn-automate-command-wait-until-finished (handle)
(let ((session (xmtn-automate--command-handle-session handle)))
(while (not (xmtn-automate--command-handle-finished-p handle))
;; we use a timeout here to allow debugging, and possible incremental processing
(accept-process-output (xmtn-automate--session-process session) 1.0)
;; We use a timeout here to allow debugging, and incremental
;; 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))
(unless (eql (xmtn-automate--command-handle-error-code handle) 0)
(xmtn-automate--cleanup-command handle)
@ -95,6 +100,8 @@
(goto-char (point-max))
(newline)
(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)))
(if (xmtn-automate--command-handle-warnings handle)
(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-output-as-string command-handle)))
(defun xmtn-automate-command-output-buffer
(root buffer command)
"Send COMMAND to session for ROOT, insert result into BUFFER."
(defun xmtn-automate-command-output-buffer (root buffer command &optional display-tickers)
"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))
(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)
(with-current-buffer buffer
(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
;; position, not a marker, because text gets inserted in front of
;; the marker, and it moves.
(remaining-chars 0)
(remaining-chars 0) ;; until end of packet
(stream 0); determines output buffer
)
@ -210,6 +218,7 @@ Signals an error if output contains zero lines or more than one line."
(root)
(name)
(buffer nil)
(error-file nil)
(process nil)
(decoder-state)
(next-command-number 0)
@ -227,7 +236,11 @@ Signals an error if output contains zero lines or more than one line."
(write-marker)
(finished-p 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)
(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))
(root (xmtn-automate--session-root session)))
(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)
;; start-process merges stderr and stdout from the child,
;; 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")
xmtn-automate-arguments))))
(let ((process (apply 'start-process name buffer cmd)))
>>>>>>> MERGE-SOURCE
(ecase (process-status process)
(run
;; 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)))
;; Some error. Display the session buffer to show the error
(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)
(pop-to-buffer buffer)
(error "failed to create mtn automate process")))
@ -461,8 +470,9 @@ the buffer."
(unless xmtn-automate--*preserve-buffers-for-debugging*
(kill-buffer buffer))))))
(defun xmtn-automate--new-command (session command)
"Send COMMAND to SESSION."
(defun xmtn-automate--new-command (session command &optional display-tickers display-buffer)
"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)
(let* ((command-number
(1- (incf (xmtn-automate--session-next-command-number
@ -493,7 +503,9 @@ the buffer."
:command command
:session-command-number command-number
: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
(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*
(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)
"Copy SESSION current packet output to command output or error buffer.
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))
(state (xmtn-automate--session-decoder-state session))
(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)
(?m
(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))
(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.
(get-buffer-create (format dvc-error-buffer 'xmtn)))))
(write-marker
@ -536,22 +612,42 @@ Return non-nil if some text copied."
(if (not (buffer-live-p output-buffer))
;; Buffer has already been killed, just discard input.
t
(with-current-buffer output-buffer
(save-excursion
(goto-char write-marker)
(let ((inhibit-read-only t)
deactivate-mark)
(insert-buffer-substring-no-properties session-buffer
(xmtn-automate--decoder-state-read-marker state)
end))
(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)
(decf (xmtn-automate--decoder-state-remaining-chars state)
chars-to-read)
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
(save-excursion
(goto-char write-marker)
(let ((inhibit-read-only t)
deactivate-mark)
(insert-buffer-substring-no-properties session-buffer
(xmtn-automate--decoder-state-read-marker state)
end))
(set-marker write-marker (point))))
(setf (xmtn-automate--decoder-state-read-marker state) end)
(decf (xmtn-automate--decoder-state-remaining-chars state)
chars-to-read)
t)))
))))))
(defun xmtn--debug-mark-text-processed (buffer start end bold-p)
(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)))
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)
;;; xmtn-automate.el ends here

58
dvc/lisp/xmtn-basic-io.el
View File

@ -1,6 +1,6 @@
;;; 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
;; Author: Christian M. Ohler
@ -177,8 +177,9 @@ Possible classes are `string', `null-id', `id', `symbol'."
(nreverse accu))))
stanza))
(defun xmtn-basic-io--next-parsed-line-notinline ()
(xmtn-basic-io--next-parsed-line))
(defun xmtn-basic-io-skip-stanza ()
"Skip to end of stanza at point."
(while (not (memq (xmtn-basic-io--next-parsed-line) '(empty eof)))))
(eval-and-compile
(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)))
(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
string), `value' bound to list containing parsed rest of line.
List is of form ((category value) ...)."
@ -212,22 +213,37 @@ List is of form ((category value) ...)."
,body))))
(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
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
again."
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)))
(string= (car line) ,expected-key))
(let ((value (cdr line)))
,body-present)
(beginning-of-line 0)
,body-present
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)
"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
execute BODY with `value' bound to list containing parsed rest of
line. List is of form ((category value) ...)."
@ -239,6 +255,26 @@ line. List is of form ((category value) ...)."
(let ((value (cdr line)))
,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 ()
"Read next basic-io line at point. Error if it is not `empty' or `eof'."
(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
;; every user of this macro. The performance advantage of this
;; would be small.
'xmtn-basic-io--next-parsed-line-notinline
'xmtn-basic-io--next-parsed-line
line-parser buffer-form body))
(defmacro* xmtn-basic-io-with-stanza-parser ((stanza-parser buffer-form)

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

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

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

@ -33,7 +33,7 @@
;;; docs/xmtn-readme.txt.
(eval-and-compile
(require 'cl)
(require 'cl) ;; yes, we are using cl at runtime; we're working towards eliminating that.
(require 'dvc-unified)
(require 'xmtn-basic-io)
(require 'xmtn-base)
@ -702,7 +702,8 @@ otherwise newer."
(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."
"Create or reuse 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 " ..."))
@ -875,9 +876,7 @@ otherwise newer."
root
(let ((default-directory root))
(mapcan (lambda (file-name)
(if (or (file-symlink-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)))
normalized-file-names))
t))))
@ -1016,21 +1015,6 @@ finished."
;;; synchronousness/asynchronousness, progress messages and return
;;; 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)
(check-type root string)
(check-type target-revision-hash-id xmtn--hash-id)
@ -1253,75 +1237,9 @@ a workspace for CACHED-BRANCH."
(setq buffer-file-coding-system 'binary)
(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)
(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
source-revision-backend-id
target-revision-backend-id)
@ -1419,33 +1337,6 @@ a workspace for CACHED-BRANCH."
(xmtn-automate-command-output-string
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))
;; matches data output by 'mtn diff'
new-manifest-hash-id

85
dvc/lisp/xmtn-hooks.lua
View File

@ -21,20 +21,79 @@
-- 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.
function get_netsync_connect_command(uri, args)
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 of file

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

@ -416,16 +416,9 @@ If SAVE-CONFLICTS non-nil, don't delete conflicts files."
(case (xmtn-status-data-local-changes data)
(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))))
(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))
(case (xmtn-status-data-heads data)
@ -491,7 +484,7 @@ If SAVE-CONFLICTS non-nil, don't delete conflicts files."
(interactive "DStatus for (workspace): ")
(pop-to-buffer (get-buffer-create "*xmtn-multi-status*"))
;; 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-ewoc (ewoc-create 'xmtn-status-printer))
;; FIXME: sometimes, this causes problems for ewoc-set-hf (deletes bad region)

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

@ -242,16 +242,10 @@ If SAVE-CONFLICTS non-nil, don't delete conflicts files."
(let* ((elem (ewoc-locate xmtn-propagate-ewoc))
(data (ewoc-data elem)))
(xmtn-propagate-need-refresh elem data)
<<<<<<< TREE
<<<<<<< TREE
=======
=======
;; assume the commit is successful
(setf (xmtn-propagate-data-to-local-changes data) 'ok)
>>>>>>> MERGE-SOURCE
(if (not (buffer-live-p (xmtn-propagate-data-to-status-buffer data)))
(xmtn-propagate-create-to-status-buffer data))
>>>>>>> MERGE-SOURCE
(pop-to-buffer (xmtn-propagate-data-to-status-buffer data))))
(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))
(data (ewoc-data elem)))
(xmtn-propagate-need-refresh elem data)
<<<<<<< TREE
<<<<<<< TREE
=======
=======
;; assume the commit is successful
(setf (xmtn-propagate-data-from-local-changes data) 'ok)
>>>>>>> MERGE-SOURCE
(if (not (buffer-live-p (xmtn-propagate-data-from-status-buffer data)))
(xmtn-propagate-create-from-status-buffer data))
>>>>>>> MERGE-SOURCE
(pop-to-buffer (xmtn-propagate-data-from-status-buffer data))))
(defun xmtn-propagate-commit-fromp ()
@ -575,38 +563,6 @@ If SAVE-CONFLICTS non-nil, don't delete conflicts files."
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)
"Return value for xmtn-propagate-data-conflicts for DATA."
;; 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-to-local-changes data) 'need-scan)))
(ecase (xmtn-propagate-data-from-local-changes data)
(case (xmtn-propagate-data-from-local-changes data)
(need-scan
(xmtn-propagate-create-from-status-buffer data))
(t nil))
(ecase (xmtn-propagate-data-to-local-changes data)
(case (xmtn-propagate-data-to-local-changes data)
(need-scan
(xmtn-propagate-create-to-status-buffer data))
(t nil))
@ -699,7 +655,7 @@ If SAVE-CONFLICTS non-nil, don't delete conflicts files."
(message "done"))
(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))
(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)
)
"")
(xmtn-propagate-make-data
(file-name-nondirectory (directory-file-name from-work))
(file-name-nondirectory (directory-file-name to-work))
(file-name-nondirectory (directory-file-name from-work))
(file-name-nondirectory (directory-file-name to-work)))
(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
(file-name-nondirectory (directory-file-name from-work))
(file-name-nondirectory (directory-file-name to-work))
from-name
to-name))
(xmtn-propagate-mode))
(provide 'xmtn-propagate)

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

@ -32,7 +32,7 @@
;;; docs/xmtn-readme.txt.
(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-revlist)
(require 'xmtn-ids)
@ -46,27 +46,14 @@
"Buffer-local variable pointing to a function that generates a
list of revisions to display in a revlist buffer. Called with one
arg; root. Result is of the form:
(branch
(header-lines)
((header-lines)
(footer-lines)
(revisions))"
(make-variable-buffer-local 'xmtn--revlist-*info-generator-fn*)
(defvar xmtn--revlist-*merge-destination-branch* nil)
(make-variable-buffer-local 'xmtn--revlist-*merge-destination-branch*)
(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)
(defvar xmtn--revlist-*path* nil)
"Buffer-local variable containing path argument for log"
(make-variable-buffer-local 'xmtn--revlist-*path*)
(defstruct (xmtn--revlist-entry (:constructor xmtn--make-revlist-entry))
revision-hash-id
@ -202,21 +189,11 @@ arg; root. Result is of the form:
(defun xmtn--revlist-refresh ()
(let ((root default-directory))
<<<<<<< TREE
(destructuring-bind (merge-destination-branch
header-lines footer-lines revision-hash-ids)
=======
(destructuring-bind (header-lines footer-lines revs)
>>>>>>> MERGE-SOURCE
(funcall xmtn--revlist-*info-generator-fn* root)
<<<<<<< TREE
(setq xmtn--revlist-*merge-destination-branch* merge-destination-branch)
(let ((ewoc dvc-revlist-cookie))
=======
(let ((ewoc dvc-revlist-cookie)
(count (length revs))
(last-n dvc-revlist-last-n))
>>>>>>> MERGE-SOURCE
(xmtn--revlist-setup-ewoc root ewoc
(with-temp-buffer
(dolist (line header-lines)
@ -248,15 +225,16 @@ arg; root. Result is of the form:
(ewoc-goto-node ewoc (ewoc-nth ewoc 0))))))
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'.
;; info-generator-fn must return a list of back-end revision ids (strings)
;; See xmtn--revlist-*info-generator-fn*
(xmtn-automate-cache-session root)
(let ((dvc-temp-current-active-dvc 'xmtn)
(buffer (dvc-revlist-create-buffer
'xmtn 'log root 'xmtn--revlist-refresh first-line-only-p last-n)))
(with-current-buffer buffer
(setq xmtn--revlist-*info-generator-fn* info-generator-fn)
(setq xmtn--revlist-*path* (when path (file-relative-name path root)))
(xmtn--revlist-refresh))
(xmtn--display-buffer-maybe buffer nil))
nil)
@ -265,7 +243,12 @@ arg; root. Result is of the form:
(defun xmtn-dvc-log (path last-n)
;; path may be nil or a file. The front-end ensures that
;; '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
(defun xmtn-log (&optional path last-n)
@ -279,91 +262,6 @@ arg; root. Result is of the form:
;;;###autoload
(defun xmtn-dvc-changelog (&optional path)
<<<<<<< TREE
(xmtn--log-helper (dvc-tree-root) path nil nil))
(defun xmtn--log-helper (root path first-line-only-p last-n)
(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
(dvc-tree-root)
'xmtn--log-generator
@ -397,7 +295,6 @@ arg; root. Result is of the form:
(xmtn-automate-command-output-lines ;; revisions
root
(cons options command))))))
>>>>>>> MERGE-SOURCE
(defun xmtn-revlist-show-conflicts ()
"If point is on a revision that has two parents, show conflicts
@ -472,14 +369,14 @@ from the merge."
;;;###autoload
(defun xmtn-dvc-missing (&optional other)
;; `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
root
<<<<<<< TREE
'xmtn--revlist--missing-get-info
;; Passing nil as first-line-only-p is arbitrary here.
;;
=======
(lambda (root)
(let ((revs
(xmtn-automate-command-output-lines
@ -494,13 +391,12 @@ from the merge."
revs)))
nil ;; path
nil ;; first-line-only-p
>>>>>>> MERGE-SOURCE
;; When the missing revs are due to a propagate, there can be a
;; lot of them, but we only really need to see the revs since the
;; propagate. So dvc-log-last-n is appropriate. We use
;; dvc-log-last-n, not dvc-revlist-last-n, because -log is user
;; customizable.
nil dvc-log-last-n))
dvc-log-last-n))
nil)
;;;###autoload
@ -509,9 +405,6 @@ from the merge."
(interactive "D")
(xmtn--setup-revlist
root
<<<<<<< TREE
'xmtn--revlist--review-update-info
=======
(lambda (root)
(let ((revs
(xmtn-automate-command-output-lines
@ -525,7 +418,6 @@ from the merge."
'() ;; footer
revs)))
nil ;; path
>>>>>>> MERGE-SOURCE
nil ;; first-line-only-p
dvc-log-last-n)
nil)
@ -541,63 +433,17 @@ from the merge."
(let* ((branch (xmtn--tree-default-branch root))
(head-revision-hash-ids (xmtn--heads root branch)))
(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
(format "workspace %s" root)
"Head revisions")
'() ; footer
>>>>>>> MERGE-SOURCE
head-revision-hash-ids)))
;; Passing nil as first-line-only-p, last-n is arbitrary here.
nil nil))
nil ;; path
nil ;; first-line-only-p
nil ;; last-n
))
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)
;;;###autoload
@ -613,25 +459,9 @@ to the base revision of the current tree."
(xmtn--setup-revlist
root
(lambda (root)
(let* ((branch (xmtn--tree-default-branch root))
(revision-hash-ids (xmtn--expand-selector root selector))
(let* ((revision-hash-ids (xmtn--expand-selector root selector))
(count (length revision-hash-ids)))
(list
<<<<<<< TREE
branch
(list (format "Tree %s" root)
(format "Default branch %s" branch)
(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
(format "workspace %s" root)
(if (with-syntax-table (standard-syntax-table)
@ -640,12 +470,11 @@ to the base revision of the current tree."
(format "Selector %s" selector))
"Revisions matching selector")
'() ; footer
>>>>>>> MERGE-SOURCE
revision-hash-ids)))
;; Passing nil as first-line-only-p is arbitrary here.
nil
;; FIXME: it might be useful to specify last-n here
nil)))
nil ;; path
nil ;; first-line-only-p
nil ;; last-n
)))
nil)
;; 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 "%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 ()
"Update current tree to the revision at point.

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

@ -76,46 +76,7 @@
,@arguments)
dvc-run-keys)))
<<<<<<< TREE
(defun xmtn--command-output-lines (root arguments)
"Run mtn in ROOT with ARGUMENTS and return its output as a list of strings."
(xmtn--check-cached-command-version)
(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))
>>>>>>> MERGE-SOURCE
;; see also xmtn-sync.el xmtn-sync-required-command-version
(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)))
(defun xmtn--clear-command-version-cache ()
(interactive)
(setq xmtn--*command-version-cached-for-executable* nil
;; This is redundant but neater.
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
representation of the version number. REVISION is the revision
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))
(dvc-run-dvc-sync
'xmtn
@ -194,7 +134,6 @@ id."
(minor (parse-integer version-string (match-beginning 2) (match-end 2)))
(revision (match-string 4 version-string)))
(list major minor revision version-string))))
>>>>>>> MERGE-SOURCE
(defun xmtn--check-cached-command-version ()
(let ((minimum-version xmtn--minimum-required-command-version)

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

@ -25,14 +25,13 @@
)
(eval-and-compile
;; these have functions we use
;; these have functions (and possibly macros) we use
(require 'dvc-config)
(require 'xmtn-automate)
(require 'xmtn-basic-io)
)
;;; 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)
@ -44,8 +43,20 @@
"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'.")
(defvar xmtn-sync-automate-args
(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
"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.")
;;; 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"
"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.
"Minimum version for `xmtn-sync-executable'; overrides xmtn--minimum-required-command-version.
Must support file:, ssh:, automate sync.")
>>>>>>> MERGE-SOURCE
;; 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))
(defvar xmtn-sync-remote-exec-alist nil
"Alist of host and remote command. Overrides `xmtn-sync-remote-exec-default'.")
;; buffer-local
@ -97,36 +98,12 @@ Must support file:, ssh:, automate sync.")
"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)
<<<<<<< TREE
=======
(defstruct (xmtn-sync-branch
(:copier nil))
;; 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)
(ewoc-invalidate xmtn-sync-ewoc elem)))
>>>>>>> MERGE-SOURCE
(defun xmtn-sync-status ()
"Start xmtn-status-one for current ewoc element."
(let* ((data (ewoc-data (ewoc-locate xmtn-sync-ewoc)))
(interactive)
(let* ((elem (ewoc-locate xmtn-sync-ewoc))
(data (ewoc-data elem))
(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
(work (or
(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 [?s] '(menu-item "s) status" xmtn-sync-status))
(define-key map [?u] '(menu-item "u) update" xmtn-sync-update))
>>>>>>> MERGE-SOURCE
map)
"Keyboard menu keymap for xmtn-sync-ewoc.")
"Keyboard menu keymap used in `xmtn-sync-mode'.")
(defvar xmtn-sync-mode-map
(let ((map (make-sparse-keymap)))
<<<<<<< TREE
(define-key map [?q] 'dvc-buffer-quit)
(define-key map "\M-d" xmtn-sync-ewoc-map)
=======
(define-key map "\M-d" xmtn-sync-kbd-map)
(define-key map [?b] 'xmtn-sync-brief)
(define-key map [?c] 'xmtn-sync-clean)
@ -289,17 +249,12 @@ The elements must all be of type xmtn-sync-sync.")
(define-key map [?s] 'xmtn-sync-status)
(define-key map [?u] 'xmtn-sync-update)
(define-key map [?S] 'xmtn-sync-save)
>>>>>>> MERGE-SOURCE
map)
"Keymap used in `xmtn-sync-mode'.")
(easy-menu-define xmtn-sync-mode-menu xmtn-sync-mode-map
"`xmtn-sync' menu"
`("Xmtn-sync"
<<<<<<< TREE
["Do the right thing" xmtn-sync-ewoc-map t]
["Quit" dvc-buffer-quit t]
=======
;; first item is top in display
["Status" xmtn-sync-status t]
["Update" xmtn-sync-update t]
@ -308,33 +263,20 @@ The elements must all be of type xmtn-sync-sync.")
["Clean/delete" xmtn-sync-clean t]
["Save" xmtn-sync-save t]
["Save and Quit" (lambda () (kill-buffer (current-buffer))) t]
>>>>>>> MERGE-SOURCE
))
;; derive from nil causes no keymap to be used, but still have self-insert keys
;; 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)
<<<<<<< TREE
<<<<<<< TREE
(setq buffer-read-only t)
(buffer-disable-undo)
(set-buffer-modified-p nil))
=======
(buffer-disable-undo))
=======
(add-hook 'kill-buffer-hook 'xmtn-sync-save nil t)
(buffer-disable-undo)
(unless xmtn-sync-branch-alist
(let ((branch-file (expand-file-name xmtn-sync-branch-file dvc-config-directory)))
(if (file-exists-p branch-file)
(load branch-file)))))
>>>>>>> MERGE-SOURCE
(defun xmtn-sync-parse-revision-certs (direction)
"Parse certs associated with a revision; return (branch changelog date author)."
@ -552,47 +494,12 @@ Return non-nil if anything parsed."
(setq buffer-read-only nil)
(dolist (data stuff) (ewoc-enter-last xmtn-sync-ewoc data))
(setq buffer-read-only t)
<<<<<<< TREE
(set-buffer-modified-p nil))
(unless noerror
(error "%s file not found" save-file)))))
>>>>>>> MERGE-SOURCE
=======
(set-buffer-modified-p nil)))))
>>>>>>> MERGE-SOURCE
;;;###autoload
<<<<<<< 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)
"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."
>>>>>>> MERGE-SOURCE
(interactive "flocal db: \nMscheme: \nMremote-host: \nMremote-db: ")
(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)
(xmtn-sync-save)
(delete-file file))))
>>>>>>> MERGE-SOURCE
(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

26
dvc/texinfo/Makefile.in
View File

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

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

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