;;; Copyright (C) 2007 Magnus Henoch
;;;
;;; This program 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 program 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 program; if not, write to the Free Software
;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA

(in-package :darcs)

(defun send-to-file (our-repo file &key their-repo (select-patches :ask))
  "Write new patches in OUR-REPO to FILE, suitable for sending by e-mail.
\"New\" patches are those present in OUR-REPO but not in
THEIR-REPO.  If THEIR-REPO is NIL, use default repository
specified in preferences.
SELECT-PATCHES specifies how to select which patches to include.
It can be one of:
:ALL - include all patches
:ASK - ask for each patch through Y-OR-N-P
a function - call this function with a NAMED-PATCH object, and
             include if it returns true"
  (setf our-repo (fad:pathname-as-directory our-repo))
  (unless their-repo
    (unless (setf their-repo (car (get-preflist our-repo "defaultrepo")))
      (error "No remote repositiory specified, and no default available.")))

  (with-open-file (f file
		     :direction :output
		     :element-type '(unsigned-byte 8))
    
    (let ((our-patchinfo (read-repo-patch-list our-repo))
	  (their-patchinfo (read-repo-patch-list their-repo)))
      (multiple-value-bind (common only-ours only-theirs)
	  (get-common-and-uncommon our-patchinfo their-patchinfo)
	(declare (ignore only-theirs))
	(format t "~&Found these new patches:")
	(dolist (p only-ours)
	  (format t "~& - ~A" p))

	(let* ((all-our-patches
		(mapcar (lambda (patchinfo)
			  (read-patch-from-repo our-repo patchinfo))
			only-ours))
	       (patches-to-send
		(if (or (eq select-patches :all)
			(and (eq select-patches :ask)
			     (y-or-n-p "Send all patches?")))
		    all-our-patches
		    (select-patches all-our-patches 
				    (if (functionp select-patches)
					select-patches
					(lambda (patch) 
					  (display-patch patch *query-io*)
					  (y-or-n-p "Include patch ~A? " patch)))))))

	  (write-byte 10 f)
	  (write-sequence (string-to-bytes "New patches:") f)
	  (write-byte 10 f)
	  (write-byte 10 f)
	  (dolist (patch patches-to-send)
	    (write-patch patch f))
	  (write-byte 10 f)

	  (write-sequence (string-to-bytes "Context:") f)
	  (write-byte 10 f)
	  (write-byte 10 f)
	  ;; Context is in reverse order: latest applied first.
	  (setf common (nreverse common))

	  ;; XXX: handle tags properly.
	  (let ((latest-tag (member-if
			     (lambda (patchinfo)
			       (string= (patchinfo-name patchinfo) "TAG "
					:end1 4))
			     common)))
	    (when latest-tag
	      ;; Here we just cut history after the latest tag.  This
	      ;; should work in most cases.
	      (setf (cdr latest-tag) nil)))

	  (dolist (patchinfo common)
	    (write-sequence (string-to-bytes
			     (with-output-to-string (strout)
			       (write-patchinfo patchinfo strout)))
			    f)
	    (write-byte 10 f))
	  (write-sequence (string-to-bytes "Patch bundle hash:") f)
	  (write-byte 10 f)
	  (write-sequence (string-to-bytes (hash-bundle patches-to-send)) f)
	  (write-byte 10 f))))))

(defun hash-bundle (patches)
  (let ((patches-as-vector
	 (flexi-streams:with-output-to-sequence (out)
	   (dolist (patch patches)
	     (write-patch patch out)))))
    (setf patches-as-vector
	  (make-array (length patches-as-vector)
		      :element-type '(unsigned-byte 8)
		      :initial-contents patches-as-vector))
    (ironclad:byte-array-to-hex-string
     (ironclad:digest-sequence :sha1 patches-as-vector))))