707 lines
23 KiB
EmacsLisp
707 lines
23 KiB
EmacsLisp
;;; xmtn-sync.el --- database sync handling for DVC backend for monotone
|
|
;;
|
|
;; Copyright (C) 2010, 2011 Stephen Leake
|
|
;;
|
|
;; Author: Stephen Leake
|
|
;; Keywords: tools
|
|
;;
|
|
;; This file is free software; you can redistribute it and/or modify
|
|
;; it under the terms of the GNU General Public License as published by
|
|
;; the Free Software Foundation; either version 2 of the License, or
|
|
;; (at your option) any later version.
|
|
;;
|
|
;; This file is distributed in the hope that it will be useful,
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;; GNU General Public License for more details.
|
|
;;
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with this file; see the file COPYING. If not, write to
|
|
;; the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor,
|
|
;; Boston, MA 02110-1301 USA.
|
|
|
|
(eval-when-compile
|
|
;; these have macros we use
|
|
)
|
|
|
|
(eval-and-compile
|
|
;; these have functions we use
|
|
(require 'xmtn-automate)
|
|
)
|
|
|
|
;;; User variables
|
|
(defvar xmtn-sync-branch-file "~/.dvc/branches"
|
|
"File associating branch name with workspace root")
|
|
|
|
(defvar xmtn-sync-executable
|
|
(cond
|
|
((equal system-type 'windows-nt)
|
|
;; Native MinGW does not support file: or ssh: - assume Cygwin is
|
|
;; installed, but not first in path
|
|
"c:/bin/mtn")
|
|
(t
|
|
;; Unix or Cygwin; assume mtn is in path
|
|
"mtn"))
|
|
"Executable for running sync command on local db; overrides xmtn-executable.")
|
|
|
|
(defvar xmtn-sync-config "xmtn-sync-config"
|
|
"File to store `xmtn-sync-branch-alist' and `xmtn-sync-remote-exec-alist'; relative to `dvc-config-directory'.")
|
|
|
|
(defvar xmtn-sync-sort nil
|
|
"User-supplied function to sort branches.
|
|
Called with a string containing the mtn branch name; return
|
|
'(node key) where node is the ewoc node to insert before (nil to
|
|
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'.")
|
|
|
|
(defconst xmtn-sync-review-file "sync.basic_io"
|
|
"File to save shell sync basic_io output for input by `xmtn-sync-review'; relative to `dvc-config-directory'.")
|
|
|
|
(defconst xmtn-sync-branch-file "branches"
|
|
"File associating branch name with workspace root; relative to `dvc-config-directory'.")
|
|
|
|
(defconst xmtn-sync-config "xmtn-sync-config"
|
|
"File to store `xmtn-sync-branch-alist'; relative to `dvc-config-directory'.")
|
|
|
|
(defconst xmtn-sync-required-command-version '(0 99)
|
|
;; 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))
|
|
"Alist of host and remote command. Overrides `xmtn-sync-remote-exec-default'.")
|
|
|
|
;; buffer-local
|
|
(defvar xmtn-sync-local-db nil
|
|
"Absolute path to local database.")
|
|
(make-variable-buffer-local 'xmtn-sync-local-db)
|
|
|
|
(defvar xmtn-sync-remote-db nil
|
|
"Absolute path to remote database.")
|
|
(make-variable-buffer-local 'xmtn-sync-remote-db)
|
|
|
|
(defstruct (xmtn-sync-branch
|
|
(:copier nil))
|
|
;; ewoc element; data for a branch that was received
|
|
name)
|
|
|
|
(defun xmtn-sync-set-hf ()
|
|
"Set ewoc header and footer."
|
|
(ewoc-set-hf
|
|
xmtn-sync-ewoc
|
|
(concat
|
|
(format " local database : %s\n" xmtn-sync-local-db)
|
|
(format "remote database : %s\n" xmtn-sync-remote-db)
|
|
)
|
|
""))
|
|
|
|
(defun xmtn-sync-printer (branch)
|
|
"Print an ewoc element; BRANCH must be of type xmtn-sync-branch."
|
|
(insert "branch: ")
|
|
(insert (xmtn-sync-branch-name branch))
|
|
(insert "\n")
|
|
)
|
|
|
|
(defvar xmtn-sync-ewoc nil
|
|
"Buffer-local ewoc for displaying sync.
|
|
All xmtn-sync functions operate on this ewoc.
|
|
The elements must all be of type xmtn-sync-sync.")
|
|
(make-variable-buffer-local 'xmtn-sync-ewoc)
|
|
|
|
<<<<<<< TREE
|
|
=======
|
|
(defstruct (xmtn-sync-branch
|
|
(:copier nil))
|
|
;; ewoc element; data for a branch that was received
|
|
name ;; monotone branch name
|
|
rev-alist ;; alist of '(revid (date author changelog)) for received revs
|
|
send-count ;; integer count of sent revs
|
|
print-mode ;; 'summary | 'brief | 'full | 'started
|
|
sort-key ;; for use by xmtn-sync-sort
|
|
)
|
|
|
|
(defun xmtn-sync-print-rev (rev print-mode)
|
|
"Print a REV (element of branch rev-alist) according to PRINT-MODE ('brief or 'full)."
|
|
(let ((date (nth 0 (cadr rev)))
|
|
(author (nth 1 (cadr rev)))
|
|
(changelog (nth 2 (cadr rev))))
|
|
(insert (dvc-face-add (format "\n %s %s\n" date author) 'dvc-header))
|
|
(ecase print-mode
|
|
(brief
|
|
(insert (substring changelog 0 (string-match "\n" changelog))))
|
|
(full
|
|
(insert changelog)))))
|
|
|
|
(defun xmtn-sync-printer (branch)
|
|
"Print an ewoc element; BRANCH must be of type xmtn-sync-branch."
|
|
;; sometimes mtn will allow a revision with no branch!
|
|
(if (xmtn-sync-branch-name branch)
|
|
(insert (dvc-face-add (xmtn-sync-branch-name branch) 'dvc-keyword))
|
|
(insert (dvc-face-add "<no branch>" 'dvc-keyword)))
|
|
(insert (format " rx %d tx %d\n"
|
|
(length (xmtn-sync-branch-rev-alist branch))
|
|
(xmtn-sync-branch-send-count branch)))
|
|
(ecase (xmtn-sync-branch-print-mode branch)
|
|
(summary nil)
|
|
|
|
((brief full)
|
|
(loop for rev in (xmtn-sync-branch-rev-alist branch) do
|
|
(xmtn-sync-print-rev rev (xmtn-sync-branch-print-mode branch))))
|
|
|
|
(started
|
|
(insert " started\n")))
|
|
)
|
|
|
|
(defun xmtn-sync-brief ()
|
|
"Set display mode for current item to brief."
|
|
(interactive)
|
|
(let* ((elem (ewoc-locate xmtn-sync-ewoc))
|
|
(data (ewoc-data elem)))
|
|
(setf (xmtn-sync-branch-print-mode data) 'brief)
|
|
(ewoc-invalidate xmtn-sync-ewoc elem)))
|
|
|
|
(defun xmtn-sync-full ()
|
|
"Set display mode for current item to full."
|
|
(interactive)
|
|
(let* ((elem (ewoc-locate xmtn-sync-ewoc))
|
|
(data (ewoc-data elem)))
|
|
(setf (xmtn-sync-branch-print-mode data) 'full)
|
|
(ewoc-invalidate xmtn-sync-ewoc elem)))
|
|
|
|
(defun xmtn-sync-summary ()
|
|
"Set display mode for current item to summary."
|
|
(interactive)
|
|
(let* ((elem (ewoc-locate xmtn-sync-ewoc))
|
|
(data (ewoc-data elem)))
|
|
(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)))
|
|
(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))
|
|
(if (functionp xmtn-sync-guess-workspace)
|
|
(funcall xmtn-sync-guess-workspace branch))
|
|
(prog1
|
|
(read-directory-name (format "workspace root for %s: " branch))
|
|
(setq save-work t))
|
|
)))
|
|
(setf (xmtn-sync-branch-print-mode data) 'started) ; indicate we've started work on it
|
|
(ewoc-invalidate xmtn-sync-ewoc elem)
|
|
|
|
(condition-case err
|
|
(xmtn-status-one work)
|
|
('error
|
|
(if (and (not save-work) (functionp xmtn-sync-guess-workspace))
|
|
;; xmtn-sync-guess-workspace guessed wrong; prompt and try again
|
|
(progn
|
|
(setq work (read-directory-name (format "workspace root for %s: " branch)))
|
|
(setq save-work t)
|
|
(xmtn-status-one work)))))
|
|
|
|
;; don't save the workspace association until it is validated by xmtn-status-one
|
|
(if save-work
|
|
(progn
|
|
(push (list branch work) xmtn-sync-branch-alist)
|
|
(dvc-save-state
|
|
(list 'xmtn-sync-branch-alist)
|
|
(expand-file-name xmtn-sync-branch-file dvc-config-directory))))))
|
|
|
|
(defun xmtn-sync-update ()
|
|
"Start xmtn-status-on for current ewoc element, do update if possible."
|
|
(interactive)
|
|
(xmtn-sync-status)
|
|
(if (xmtn-status-updatep)
|
|
(xmtn-status-update)))
|
|
|
|
(defun xmtn-sync-clean ()
|
|
"Clean and delete current ewoc element."
|
|
(interactive)
|
|
(let* ((elem (ewoc-locate xmtn-sync-ewoc))
|
|
(status-buffer (get-buffer-create "*xmtn-multi-status*"))
|
|
(inhibit-read-only t))
|
|
(if (buffer-live-p status-buffer)
|
|
(kill-buffer status-buffer))
|
|
(ewoc-delete xmtn-sync-ewoc elem)))
|
|
|
|
(dvc-make-ewoc-next xmtn-sync-next xmtn-sync-ewoc)
|
|
(dvc-make-ewoc-prev xmtn-sync-prev xmtn-sync-ewoc)
|
|
|
|
(defvar xmtn-sync-kbd-map
|
|
(let ((map (make-sparse-keymap "action")))
|
|
;; last defined is first in displayed menu
|
|
(define-key map [?c] '(menu-item "c) clean" xmtn-sync-clean))
|
|
(define-key map [?f] '(menu-item "f) full" xmtn-sync-full))
|
|
(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.")
|
|
|
|
(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)
|
|
(define-key map [?f] 'xmtn-sync-full)
|
|
(define-key map [?n] 'xmtn-sync-next)
|
|
(define-key map [?p] 'xmtn-sync-prev)
|
|
(define-key map [?q] 'dvc-buffer-quit)
|
|
(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]
|
|
["Brief display" xmtn-sync-brief t]
|
|
["Full display" xmtn-sync-full t]
|
|
["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)."
|
|
(let ((keyword (ecase direction
|
|
('receive "receive_cert")
|
|
('send "send_cert")))
|
|
cert-label branch date author changelog old-branch)
|
|
(while (xmtn-basic-io-optional-line keyword (setq cert-label (cadar value)))
|
|
(cond
|
|
((string= cert-label "branch")
|
|
(xmtn-basic-io-check-line "value" (setq branch (cadar value)))
|
|
(xmtn-basic-io-skip-line "key")
|
|
(xmtn-basic-io-skip-line "revision"))
|
|
|
|
((string= cert-label "changelog")
|
|
(xmtn-basic-io-check-line "value" (setq changelog (cadar value)))
|
|
(xmtn-basic-io-skip-line "key")
|
|
(xmtn-basic-io-skip-line "revision"))
|
|
|
|
((string= cert-label "date")
|
|
(xmtn-basic-io-check-line "value" (setq date (cadar value)))
|
|
(xmtn-basic-io-skip-line "key")
|
|
(xmtn-basic-io-skip-line "revision"))
|
|
|
|
((string= cert-label "author")
|
|
(xmtn-basic-io-check-line "value" (setq author (cadar value)))
|
|
(xmtn-basic-io-skip-line "key")
|
|
(xmtn-basic-io-skip-line "revision"))
|
|
|
|
(t
|
|
;; ignore other certs
|
|
(xmtn-basic-io-skip-stanza))
|
|
)
|
|
(xmtn-basic-io-skip-blank-lines) ;; might be at end of parsing region
|
|
) ;; end while cert
|
|
|
|
(list branch changelog date author)))
|
|
|
|
(defun xmtn-sync-enter-rev (revid branch date author changelog direction)
|
|
"Enter data for REVID into ewoc."
|
|
(let (old-branch)
|
|
(ewoc-map
|
|
(lambda (data)
|
|
(if (string= branch (xmtn-sync-branch-name data))
|
|
;; already some data for branch
|
|
(let ((rev-alist (xmtn-sync-branch-rev-alist data)))
|
|
(ecase direction
|
|
('receive
|
|
(setf (xmtn-sync-branch-rev-alist data)
|
|
;; sync sends revs newest first, we want newest
|
|
;; displayed last, so append to head of list
|
|
(push (list revid (list date author changelog)) rev-alist)))
|
|
('send
|
|
(setf (xmtn-sync-branch-send-count data) (+ 1 (xmtn-sync-branch-send-count data)))))
|
|
(setq old-branch t)
|
|
t; update ewoc
|
|
)))
|
|
xmtn-sync-ewoc)
|
|
|
|
(if (not old-branch)
|
|
(let*
|
|
((node-key (and (functionp xmtn-sync-sort)
|
|
(funcall xmtn-sync-sort branch)))
|
|
(data
|
|
(ecase direction
|
|
('receive
|
|
(make-xmtn-sync-branch
|
|
:name branch
|
|
:rev-alist (list (list revid (list date author changelog)))
|
|
:send-count 0
|
|
:print-mode 'summary
|
|
:sort-key (nth 1 node-key)))
|
|
('send
|
|
(make-xmtn-sync-branch
|
|
:name branch
|
|
:rev-alist nil
|
|
:send-count 1
|
|
:print-mode 'summary
|
|
:sort-key (nth 1 node-key))))))
|
|
(if (nth 0 node-key)
|
|
(ewoc-enter-before xmtn-sync-ewoc (nth 0 node-key) data)
|
|
(ewoc-enter-last xmtn-sync-ewoc data))
|
|
))))
|
|
|
|
(defun xmtn-sync-parse-revisions (direction)
|
|
"Parse revisions with associated certs."
|
|
(let ((keyword (ecase direction
|
|
('receive "receive_revision")
|
|
('send "send_revision")))
|
|
revid)
|
|
(while (xmtn-basic-io-optional-line keyword (setq revid (cadar value)))
|
|
(xmtn-basic-io-skip-blank-lines)
|
|
(let* ((cert-values (xmtn-sync-parse-revision-certs direction))
|
|
(branch (nth 0 cert-values))
|
|
(changelog (nth 1 cert-values))
|
|
(date (nth 2 cert-values))
|
|
(author (nth 3 cert-values)))
|
|
|
|
(xmtn-sync-enter-rev revid branch date author changelog direction)))))
|
|
|
|
(defun xmtn-sync-parse-certs (direction)
|
|
"Parse certs not associated with revisions."
|
|
(let ((keyword (ecase direction
|
|
('receive "receive_cert")
|
|
('send "send_cert")))
|
|
revid
|
|
cert-label
|
|
branch
|
|
(date "")
|
|
(author "")
|
|
(changelog "create or propagate branch\n")
|
|
old-branch)
|
|
|
|
(while (xmtn-basic-io-optional-line keyword (setq cert-label (cadar value)))
|
|
(cond
|
|
((string= cert-label "branch")
|
|
;; This happens when a new branch is created, or a branch is
|
|
;; propagated without any conflicts.
|
|
(xmtn-basic-io-check-line "value" (setq branch (cadar value)))
|
|
(xmtn-basic-io-skip-line "key")
|
|
(xmtn-basic-io-check-line "revision" (setq revid (cadar value)))
|
|
|
|
(xmtn-sync-enter-rev revid branch date author changelog direction))
|
|
|
|
(t
|
|
;; ignore other certs
|
|
(xmtn-basic-io-skip-stanza))
|
|
)
|
|
|
|
;; move to next stanza or end of parsing region
|
|
(xmtn-basic-io-skip-blank-lines)
|
|
|
|
)))
|
|
|
|
(defun xmtn-sync-parse-keys (direction)
|
|
;; just ignore all keys
|
|
(let ((keyword (ecase direction
|
|
('receive "receive_key")
|
|
('send "send_key"))))
|
|
(xmtn-basic-io-skip-blank-lines)
|
|
(while (xmtn-basic-io-optional-skip-line keyword))))
|
|
|
|
(defun xmtn-sync-parse (begin)
|
|
"Parse current buffer starting at BEGIN, fill in `xmtn-sync-ewoc' in current buffer, erase parsed text.
|
|
Return non-nil if anything parsed."
|
|
(set-syntax-table xmtn-basic-io--*syntax-table*)
|
|
(goto-char begin)
|
|
|
|
;; receive_cert "branch"
|
|
;; value "foo2"
|
|
;; key [46ec58576f9e4f34a9eede521422aa5fd299dc50]
|
|
;; revision [e4352c1d28b38e87b5040f770a66be2ec9b2362d]
|
|
;;
|
|
;; ... more unattached certs
|
|
;;
|
|
;; receive_revision [e4352c1d28b38e87b5040f770a66be2ec9b2362d]
|
|
;;
|
|
;; receive_cert "branch"
|
|
;; value "foo2"
|
|
;; key [46ec58576f9e4f34a9eede521422aa5fd299dc50]
|
|
;; revision [...]
|
|
;;
|
|
;; receive_cert "changelog"
|
|
;; value "more
|
|
;; "
|
|
;; key [46ec58576f9e4f34a9eede521422aa5fd299dc50]
|
|
;; revision [...]
|
|
;;
|
|
;; receive_cert "date"
|
|
;; value "2010-09-21T08:29:11"
|
|
;; key [46ec58576f9e4f34a9eede521422aa5fd299dc50]
|
|
;; revision [...]
|
|
;;
|
|
;; receive_cert "author"
|
|
;; value "tester@test.net"
|
|
;; key [46ec58576f9e4f34a9eede521422aa5fd299dc50]
|
|
;; revision [...]
|
|
;;
|
|
;; ... more certs
|
|
;;
|
|
;; ... more revisions with certs
|
|
;;
|
|
;; receive_key
|
|
;;
|
|
;; key [46ec58576f9e4f34a9eede521422aa5fd299dc50]
|
|
;; key [46ec58576f9e4f34a9eede521422aa5fd299dc50]
|
|
;; ... more keys
|
|
;;
|
|
;; send_cert ... (unattached)
|
|
;;
|
|
;; send_revision [...]
|
|
;; send_cert ...
|
|
;;
|
|
;; send_key ...
|
|
|
|
(xmtn-sync-parse-certs 'receive)
|
|
(xmtn-sync-parse-revisions 'receive)
|
|
(xmtn-sync-parse-keys 'receive)
|
|
(xmtn-sync-parse-certs 'send)
|
|
(xmtn-sync-parse-revisions 'send)
|
|
(xmtn-sync-parse-keys 'send)
|
|
|
|
(let ((result (not (= begin (point)))))
|
|
(delete-region begin (point))
|
|
result)
|
|
)
|
|
|
|
(defun xmtn-sync-load-file (&optional noerror)
|
|
"Add contents of `xmtn-sync-save-file' to current ewoc."
|
|
(let ((save-file (expand-file-name xmtn-sync-save-file dvc-config-directory))
|
|
stuff)
|
|
(if (file-exists-p save-file)
|
|
(progn
|
|
(load save-file)
|
|
(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
|
|
(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
|
|
)))
|
|
=======
|
|
(interactive "flocal db: \nMscheme: \nMremote-host: \nMremote-db: ")
|
|
|
|
(pop-to-buffer (get-buffer-create "*xmtn-sync*"))
|
|
(setq buffer-read-only nil)
|
|
(delete-region (point-min) (point-max))
|
|
|
|
;; `xmtn-sync-parse' creates ewoc entries, which are inserted into
|
|
;; the xmtn-sync buffer. Since it is parsing the same buffer, we
|
|
;; need them to be inserted _after_ the text that is being
|
|
;; parsed. `xmtn-sync-mode' creates the ewoc at point.
|
|
|
|
(let ((opts xmtn-sync-automate-args)
|
|
(remote-uri (concat scheme "://" remote-host remote-db))
|
|
(msg "Running mtn sync ..."))
|
|
|
|
(message msg)
|
|
(redisplay) ;; show tickers in mode-line
|
|
|
|
;; Remote command (if needed by scheme) is determined by a custom
|
|
;; version of get_netsync_connect_command; see xmtn-hooks.lua.
|
|
|
|
(if (eq system-type 'windows-nt)
|
|
(add-to-list 'opts
|
|
(concat "--rcfile=" (substring (locate-library "xmtn-hooks.lua") 2)))
|
|
(add-to-list 'opts
|
|
(concat "--rcfile=" (locate-library "xmtn-hooks.lua"))))
|
|
|
|
;; Always use mtn executable that supports file and ssh, so we
|
|
;; only need one session for all syncs.
|
|
(let ((xmtn-executable xmtn-sync-executable)
|
|
(xmtn--minimum-required-command-version xmtn-sync-required-command-version)
|
|
(xmtn-automate-arguments opts))
|
|
(xmtn-automate-command-output-buffer
|
|
(expand-file-name "~/sync") ; root - one session for all syncs
|
|
(current-buffer) ; output-buffer
|
|
(list
|
|
(list "db" local-db) ;; options
|
|
"sync" remote-uri) ;; command, args
|
|
'("revisions" "revs in" "revs out") ;; display-tickers
|
|
))
|
|
|
|
(message (concat msg " done"))
|
|
|
|
(goto-char (point-max))
|
|
|
|
;; don't lose what was saved from last sync; may not have been reviewed yet
|
|
(xmtn-sync-mode)
|
|
(xmtn-sync-load-file t)
|
|
|
|
(setq buffer-read-only nil)
|
|
(ewoc-set-hf
|
|
xmtn-sync-ewoc
|
|
(concat ;; header
|
|
(format " local db: %s\n" local-db)
|
|
(format "remote db: %s\n" remote-uri))
|
|
"") ;; footer
|
|
|
|
(xmtn-sync-parse (point-min))
|
|
(setq buffer-read-only t)
|
|
(set-buffer-modified-p nil)
|
|
(xmtn-sync-save)
|
|
))
|
|
|
|
(defun xmtn-sync-save ()
|
|
"Save current sync results in `xmtn-sync-save-file' for later review."
|
|
(interactive)
|
|
(let ((save-file (expand-file-name xmtn-sync-save-file dvc-config-directory))
|
|
stuff)
|
|
;; Directly saving the ewoc doesn't work; too complicated for
|
|
;; pp-to-string. So we turn the ewoc into a simpler list of data
|
|
;; items
|
|
(ewoc-map
|
|
(lambda (data)
|
|
(setq stuff (add-to-list 'stuff data t))
|
|
nil)
|
|
xmtn-sync-ewoc)
|
|
|
|
(dvc-save-state
|
|
(list 'stuff)
|
|
(expand-file-name xmtn-sync-save-file dvc-config-directory))))
|
|
|
|
;;;###autoload
|
|
(defun xmtn-sync-review (&optional file)
|
|
"Display sync results in FILE (defaults to `xmtn-sync-review-file'), appended to content of `xmtn-sync-save-file'.
|
|
FILE should be output of 'automate sync'. (external sync handles tickers better)."
|
|
(interactive)
|
|
(if (buffer-live-p (get-buffer "*xmtn-sync*"))
|
|
(progn
|
|
(pop-to-buffer "*xmtn-sync*")
|
|
(xmtn-sync-save))
|
|
;; else create
|
|
(pop-to-buffer (get-buffer-create "*xmtn-sync*"))
|
|
(setq buffer-read-only nil)
|
|
(delete-region (point-min) (point-max))
|
|
(xmtn-sync-mode)
|
|
(xmtn-sync-load-file file))
|
|
|
|
;; now add FILE
|
|
(setq file (or file
|
|
(expand-file-name xmtn-sync-review-file dvc-config-directory)))
|
|
(if (file-exists-p file)
|
|
(progn
|
|
(goto-char (point-min))
|
|
(setq buffer-read-only nil)
|
|
(insert-file-contents-literally file)
|
|
|
|
;; user may have run several syncs, dumping each output into FILE; loop thru each.
|
|
(while (xmtn-sync-parse (point-min)))
|
|
(setq buffer-read-only t)
|
|
(set-buffer-modified-p nil)
|
|
(xmtn-sync-save)
|
|
(delete-file file))))
|
|
>>>>>>> MERGE-SOURCE
|
|
|
|
(provide 'xmtn-sync)
|
|
|
|
;; end of file
|