;;; xmtn-sync.el --- database sync handling for DVC backend for monotone
;;
;; Copyright (C) 2010 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'.")

;;; 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)

(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))
         (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))
    map)
  "Keyboard menu keymap for xmtn-sync-ewoc.")

(defvar xmtn-sync-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map [?q]  'dvc-buffer-quit)
    (define-key map "\M-d" xmtn-sync-ewoc-map)
    map)
  "Keymap used in `xmtn-sync-mode'.")

(easy-menu-define xmtn-sync-mode-menu xmtn-sync-mode-map
  "`xmtn-sync' menu"
  `("Xmtn-sync"
    ["Do the right thing"  xmtn-sync-ewoc-map t]
    ["Quit"                dvc-buffer-quit t]
    ))

;; 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
  (setq buffer-read-only t)
  (buffer-disable-undo)
  (set-buffer-modified-p nil))
=======
  (buffer-disable-undo))

(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)
	(ewoc-enter-last
	 xmtn-sync-ewoc
	 (ecase direction
	   ('receive
	    (make-xmtn-sync-branch
	     :name branch
	     :rev-alist (list (list revid (list date author changelog)))
	     :send-count 0
	     :print-mode 'summary))
	   ('send
	    (make-xmtn-sync-branch
	     :name branch
	     :rev-alist nil
	     :send-count 1
	     :print-mode 'summary)))))))

(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."
  ;; The only case we care about is a new branch created from an existing revision.
  (let ((keyword (ecase direction
		   ('receive "receive_cert")
		   ('send    "send_cert")))
	revid
	cert-label
	branch
	(date "")
	(author "")
	(changelog "create branch\n")
	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-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."
  (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)

  (delete-region begin (point))
  )

(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)
	  (set-buffer-modified-p nil))
      (unless noerror
	(error "%s file not found" save-file)))))
>>>>>>> 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)
    (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))))
    ))

(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)
  ;; first load xmtn-sync-save-file
  (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)

  ;; 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)
	(xmtn-sync-parse (point-min))
	(setq buffer-read-only t)
	(delete-file file))))
>>>>>>> MERGE-SOURCE

(provide 'xmtn-sync)

;; end of file