diff --git a/dvc/configure.ac b/dvc/configure.ac index e4149a1..0d013a6 100644 --- a/dvc/configure.ac +++ b/dvc/configure.ac @@ -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 diff --git a/dvc/debian/rules b/dvc/debian/rules old mode 100644 new mode 100755 diff --git a/dvc/docs/CONTRIBUTORS b/dvc/docs/CONTRIBUTORS old mode 100644 new mode 100755 diff --git a/dvc/install-sh b/dvc/install-sh old mode 100644 new mode 100755 diff --git a/dvc/lisp/dvc-fileinfo.el b/dvc/lisp/dvc-fileinfo.el index 3c9ccb9..88e1473 100644 --- a/dvc/lisp/dvc-fileinfo.el +++ b/dvc/lisp/dvc-fileinfo.el @@ -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." diff --git a/dvc/lisp/dvc-status.el b/dvc/lisp/dvc-status.el index 1139f24..35a7916 100644 --- a/dvc/lisp/dvc-status.el +++ b/dvc/lisp/dvc-status.el @@ -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 -dvc-status. diff --git a/dvc/lisp/dvc-unified.el b/dvc/lisp/dvc-unified.el index 512c9cd..65182ee 100644 --- a/dvc/lisp/dvc-unified.el +++ b/dvc/lisp/dvc-unified.el @@ -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, @@ -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)) diff --git a/dvc/lisp/tla-core.el b/dvc/lisp/tla-core.el index bc5897b..724ae27 100644 --- a/dvc/lisp/tla-core.el +++ b/dvc/lisp/tla-core.el @@ -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) diff --git a/dvc/lisp/tla-tests.el b/dvc/lisp/tla-tests.el index f11f816..e1a8d22 100644 --- a/dvc/lisp/tla-tests.el +++ b/dvc/lisp/tla-tests.el @@ -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 )) diff --git a/dvc/lisp/tla.el b/dvc/lisp/tla.el index ebff058..7a4c4fe 100644 --- a/dvc/lisp/tla.el +++ b/dvc/lisp/tla.el @@ -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 diff --git a/dvc/lisp/xhg.el b/dvc/lisp/xhg.el index 271fa5b..221b05b 100644 --- a/dvc/lisp/xhg.el +++ b/dvc/lisp/xhg.el @@ -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) diff --git a/dvc/lisp/xmtn-automate.el b/dvc/lisp/xmtn-automate.el index 34c25cd..1360429 100644 --- a/dvc/lisp/xmtn-automate.el +++ b/dvc/lisp/xmtn-automate.el @@ -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 diff --git a/dvc/lisp/xmtn-basic-io.el b/dvc/lisp/xmtn-basic-io.el index 61c3aac..e6494fe 100644 --- a/dvc/lisp/xmtn-basic-io.el +++ b/dvc/lisp/xmtn-basic-io.el @@ -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) diff --git a/dvc/lisp/xmtn-conflicts.el b/dvc/lisp/xmtn-conflicts.el index b104335..2476299 100644 --- a/dvc/lisp/xmtn-conflicts.el +++ b/dvc/lisp/xmtn-conflicts.el @@ -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) diff --git a/dvc/lisp/xmtn-dvc.el b/dvc/lisp/xmtn-dvc.el index 8ec4446..b10a0e8 100644 --- a/dvc/lisp/xmtn-dvc.el +++ b/dvc/lisp/xmtn-dvc.el @@ -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 diff --git a/dvc/lisp/xmtn-hooks.lua b/dvc/lisp/xmtn-hooks.lua index 575ebc8..fd68bf1 100644 --- a/dvc/lisp/xmtn-hooks.lua +++ b/dvc/lisp/xmtn-hooks.lua @@ -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 diff --git a/dvc/lisp/xmtn-multi-status.el b/dvc/lisp/xmtn-multi-status.el index 8dc9950..3a10e79 100644 --- a/dvc/lisp/xmtn-multi-status.el +++ b/dvc/lisp/xmtn-multi-status.el @@ -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) diff --git a/dvc/lisp/xmtn-propagate.el b/dvc/lisp/xmtn-propagate.el index 1e4251b..906b4db 100644 --- a/dvc/lisp/xmtn-propagate.el +++ b/dvc/lisp/xmtn-propagate.el @@ -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) diff --git a/dvc/lisp/xmtn-revlist.el b/dvc/lisp/xmtn-revlist.el index ebae40f..c4f2aa8 100644 --- a/dvc/lisp/xmtn-revlist.el +++ b/dvc/lisp/xmtn-revlist.el @@ -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. diff --git a/dvc/lisp/xmtn-run.el b/dvc/lisp/xmtn-run.el index 65fe4a7..e124b88 100644 --- a/dvc/lisp/xmtn-run.el +++ b/dvc/lisp/xmtn-run.el @@ -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) diff --git a/dvc/lisp/xmtn-sync.el b/dvc/lisp/xmtn-sync.el index 784f19e..d8b01d0 100644 --- a/dvc/lisp/xmtn-sync.el +++ b/dvc/lisp/xmtn-sync.el @@ -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) diff --git a/dvc/scripts/dvc-cron.sh b/dvc/scripts/dvc-cron.sh old mode 100644 new mode 100755 diff --git a/dvc/scripts/make-deb-pkg.sh b/dvc/scripts/make-deb-pkg.sh old mode 100644 new mode 100755 diff --git a/dvc/scripts/rename-tla-dvc.sh b/dvc/scripts/rename-tla-dvc.sh old mode 100644 new mode 100755 diff --git a/dvc/scripts/tla-tree-revision.sh b/dvc/scripts/tla-tree-revision.sh old mode 100644 new mode 100755 diff --git a/dvc/texinfo/Makefile.in b/dvc/texinfo/Makefile.in index be4e321..7143aed 100644 --- a/dvc/texinfo/Makefile.in +++ b/dvc/texinfo/Makefile.in @@ -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 \ diff --git a/dvc/texinfo/dvc-intro.texinfo b/dvc/texinfo/dvc-intro.texinfo index d954653..e9b2dda 100644 --- a/dvc/texinfo/dvc-intro.texinfo +++ b/dvc/texinfo/dvc-intro.texinfo @@ -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