update subrepo elisp-vcs

This commit is contained in:
Kai Tetzlaff 2011-07-27 08:38:18 +02:00
parent e53bfaa1aa
commit 26afaccc28
6 changed files with 55 additions and 7 deletions

View File

@ -82,6 +82,8 @@ miscfiles = Makefile.in COPYING INSTALL* install-sh \
dvc-load.el.in dvc-load-install.el.in \ dvc-load.el.in dvc-load-install.el.in \
lisp/dvc-version.el \ lisp/dvc-version.el \
texinfo/dvc-version.texinfo \ texinfo/dvc-version.texinfo \
texinfo/dvc-intro.texinfo \
texinfo/fdl.texinfo \
configure.ac configure configure.ac configure
extradist = extradist =

View File

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

View File

@ -316,10 +316,40 @@ Signals an error if output contains zero lines or more than one line."
(buffer (xmtn-automate--new-buffer session)) (buffer (xmtn-automate--new-buffer session))
(root (xmtn-automate--session-root session))) (root (xmtn-automate--session-root session)))
(let ((process-connection-type nil); use a pipe, not a tty (let ((process-connection-type nil); use a pipe, not a tty
<<<<<<< TREE
(default-directory root)) (default-directory root))
(let ((process (let ((process
(apply 'start-process name buffer xmtn-executable (apply 'start-process name buffer xmtn-executable
"automate" "stdio" xmtn-automate-arguments))) "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
;; the packet parser. This is only a problem when the
;; session will run 'sync ssh:' or 'sync file:', since those
;; spawn new mtn processes that can report errors on
;; stderr. All other errors will be reported properly thru
;; the stdout packetized error stream. xmtn-sync uses the
;; unique xmtn-sync-session-root for the session root, so we
;; treat that specially.
(cmd (if (string= xmtn-sync-session-root (file-name-nondirectory root))
(progn
(setf (xmtn-automate--session-error-file session)
(dvc-make-temp-name (concat xmtn-sync-session-root "-errors")))
(list dvc-sh-executable
"-c"
(mapconcat
'concat
(append (list xmtn-executable "--db=:memory:" "automate" "stdio")
xmtn-automate-arguments
(list "2>"
(xmtn-automate--session-error-file session)))
" ")))
;; not the sync session
(append (list xmtn-executable "automate" "stdio")
xmtn-automate-arguments))))
(let ((process (apply 'start-process name buffer cmd)))
>>>>>>> MERGE-SOURCE
(ecase (process-status process) (ecase (process-status process)
(run (run
;; If the process started ok, it outputs the stdio ;; If the process started ok, it outputs the stdio
@ -678,11 +708,9 @@ Each element of the list is a list; key, signature, name, value, trust."
(defun xmtn--heads (root branch) (defun xmtn--heads (root branch)
(xmtn-automate-command-output-lines (xmtn-automate-command-output-lines
root root
(cons
(list "ignore-suspend-certs" "")
(list "heads" (list "heads"
(or branch (or branch
(xmtn--tree-default-branch root)))))) (xmtn--tree-default-branch root)))))
(defun xmtn--rev-author (root rev) (defun xmtn--rev-author (root rev)
"Return first author of REV" "Return first author of REV"

View File

@ -827,7 +827,7 @@ header."
(defun xmtn-conflicts-resolve-ediff (side) (defun xmtn-conflicts-resolve-ediff (side)
"Resolve the current conflict via ediff SIDE." "Resolve the current conflict via ediff SIDE."
(interactive) (interactive)
(if xmtn-conflicts-current-conflict-buffer (if (buffer-live-p xmtn-conflicts-current-conflict-buffer)
(error "another conflict resolution is already in progress.")) (error "another conflict resolution is already in progress."))
(let* ((elem (ewoc-locate xmtn-conflicts-ewoc)) (let* ((elem (ewoc-locate xmtn-conflicts-ewoc))
@ -950,24 +950,34 @@ header."
) )
(ewoc-invalidate xmtn-conflicts-ewoc elem))) (ewoc-invalidate xmtn-conflicts-ewoc elem)))
(defun xmtn-conflicts-left_resolution-needed (conflict)
(let ((res (xmtn-conflicts-conflict-left_resolution conflict)))
(or (not res)
(eq (car res) 'resolved_internal))))
(defun xmtn-conflicts-resolve-user_leftp () (defun xmtn-conflicts-resolve-user_leftp ()
"Non-nil if user_left resolution is appropriate for current conflict." "Non-nil if user_left resolution is appropriate for current conflict."
(let* ((conflict (ewoc-data (ewoc-locate xmtn-conflicts-ewoc))) (let* ((conflict (ewoc-data (ewoc-locate xmtn-conflicts-ewoc)))
(type (xmtn-conflicts-conflict-conflict_type conflict))) (type (xmtn-conflicts-conflict-conflict_type conflict)))
(and (not (xmtn-conflicts-conflict-left_resolution conflict)) (and (xmtn-conflicts-left_resolution-needed conflict)
(or (equal type 'content) (or (equal type 'content)
(and (equal type 'duplicate_name) (and (equal type 'duplicate_name)
;; if no file_id, it's a directory ;; if no file_id, it's a directory
(xmtn-conflicts-conflict-left_file_id conflict))) ))) (xmtn-conflicts-conflict-left_file_id conflict))) )))
(defun xmtn-conflicts-right_resolution-needed (conflict)
(let ((res (xmtn-conflicts-conflict-right_resolution conflict)))
(or (not res)
(eq (car res) 'resolved_internal))))
(defun xmtn-conflicts-resolve-user_rightp () (defun xmtn-conflicts-resolve-user_rightp ()
"Non-nil if user_right resolution is appropriate for current conflict." "Non-nil if user_right resolution is appropriate for current conflict."
(let* ((conflict (ewoc-data (ewoc-locate xmtn-conflicts-ewoc))) (let* ((conflict (ewoc-data (ewoc-locate xmtn-conflicts-ewoc)))
(type (xmtn-conflicts-conflict-conflict_type conflict))) (type (xmtn-conflicts-conflict-conflict_type conflict)))
;; duplicate_name is the only conflict type that needs a right resolution ;; duplicate_name is the only conflict type that needs a right resolution
(and (xmtn-conflicts-conflict-left_resolution conflict) (and (xmtn-conflicts-right_resolution-needed conflict)
(not (xmtn-conflicts-conflict-right_resolution conflict)) (not (xmtn-conflicts-conflict-right_resolution conflict))
(equal type 'duplicate_name) (equal type 'duplicate_name)
;; if no file_id, it's a directory ;; if no file_id, it's a directory

View File

@ -494,6 +494,8 @@ If SAVE-CONFLICTS non-nil, don't delete conflicts files."
(setq default-directory (xmtn-tree-root (expand-file-name work))) (setq default-directory (xmtn-tree-root (expand-file-name work)))
(setq xmtn-status-root (expand-file-name (concat (file-name-as-directory default-directory) "../"))) (setq xmtn-status-root (expand-file-name (concat (file-name-as-directory default-directory) "../")))
(setq xmtn-status-ewoc (ewoc-create 'xmtn-status-printer)) (setq xmtn-status-ewoc (ewoc-create 'xmtn-status-printer))
;; FIXME: sometimes, this causes problems for ewoc-set-hf (deletes bad region)
;; But otherwise it is necessary to clean out old ewoc before creating new one.
(let ((inhibit-read-only t)) (delete-region (point-min) (point-max))) (let ((inhibit-read-only t)) (delete-region (point-min) (point-max)))
(ewoc-set-hf xmtn-status-ewoc (format "Root : %s\n" xmtn-status-root) "") (ewoc-set-hf xmtn-status-ewoc (format "Root : %s\n" xmtn-status-root) "")
(ewoc-enter-last xmtn-status-ewoc (ewoc-enter-last xmtn-status-ewoc

View File

@ -562,6 +562,7 @@ Return non-nil if anything parsed."
>>>>>>> MERGE-SOURCE >>>>>>> MERGE-SOURCE
;;;###autoload ;;;###autoload
<<<<<<< TREE
(defun xmtn-sync-sync (local-db remote-host remote-db) (defun xmtn-sync-sync (local-db remote-host remote-db)
"Sync LOCAL-DB with REMOTE-HOST REMOTE-DB, display sent and received branches. "Sync LOCAL-DB with REMOTE-HOST REMOTE-DB, display sent and received branches.
Remote-db should include branch pattern in URI syntax." Remote-db should include branch pattern in URI syntax."
@ -587,6 +588,11 @@ Remote-db should include branch pattern in URI syntax."
"sync" (concat remote-host remote-db)) ;; command, args "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: ") (interactive "flocal db: \nMscheme: \nMremote-host: \nMremote-db: ")
(pop-to-buffer (get-buffer-create "*xmtn-sync*")) (pop-to-buffer (get-buffer-create "*xmtn-sync*"))