;;; Copyright (C) 2006, 2007, 2008 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 pull (ourrepo &optional theirrepo &key (select-patches :ask))
  "Pull new patches from THEIRREPO into OURREPO.
If THEIRREPO is not specified, use default repository specified
in preferences.
SELECT-PATCHES specifies how to select which remote patches to pull.
It can be one of:
:ALL - pull all patches
:ASK - ask for each patch through Y-OR-N-P
a function - call this function with a NAMED-PATCH object, and
             pull if it returns true"
  (setf ourrepo (fad:pathname-as-directory ourrepo))
  (unless theirrepo
    (setf theirrepo (car (get-preflist ourrepo "defaultrepo")))
    (unless theirrepo
      (error "No remote repository specified, and no default available.")))
  (add-to-preflist ourrepo "repos" (upath-to-string theirrepo))
  (let ((motd (get-preflist theirrepo "motd")))
    (when motd
      (format t "~{~&~A~}" motd)))
  (let ((our-patchinfo (read-repo-patch-list ourrepo))
	(their-patchinfo (read-repo-patch-list theirrepo)))
    (multiple-value-bind (common only-ours only-theirs)
	(get-common-and-uncommon our-patchinfo their-patchinfo)
      (declare (ignore common))

      (when (null only-theirs)
	(format t "~&No remote changes to pull in.")
	(return-from pull))

      (format t "~&Found these new patches:")
      (dolist (p only-theirs)
	(format t "~& - ~A" p))
      (let* ((all-their-patches
	      (mapcar (lambda (patchinfo)
			(read-patch-from-repo theirrepo patchinfo))
		      only-theirs))
	     (their-patches
	      (if (or (eq select-patches :all)
		      (and (eq select-patches :ask)
			   (y-or-n-p "Pull all patches?")))
		  all-their-patches
		  (select-patches all-their-patches 
				  (if (functionp select-patches)
				      select-patches
				      (lambda (patch) 
					(display-patch patch *query-io*)
					(y-or-n-p "Pull patch ~A? " patch))))))
	     (our-patches
	      (mapcar (lambda (patchinfo)
			(read-patch-from-repo ourrepo patchinfo))
		      only-ours))
	     (merged-patches (patches
			      (merge-patches (make-instance 'composite-patch
							    :patches their-patches)
					     (make-instance 'composite-patch
							    :patches our-patches)))))
	(format t "~&Applying patches")
	(let ((applying-to-source t)
	      (source-and-pristine-differ nil))
	  (dolist (p merged-patches)
	    ;; First, copy the modified patch to the repository.
	    (write-patch-to-repo p ourrepo)
	    ;; Then, apply it to the pristine copy.  This couldn't
	    ;; possibly fail.
	    (apply-patch-to-pristine p ourrepo)
	    ;; Note the patch in the inventory.
	    (append-inventory ourrepo (named-patch-patchinfo p))
	    ;; And finally apply the patch to the real source.  This
	    ;; could fail if the source has been modified.  Deal with
	    ;; that in a crude way.  XXX: it is wasteful to apply
	    ;; patches twice.
	    (when applying-to-source
	      (restart-case
		  (apply-patch p ourrepo)
		(skip-this ()
		    :report "Don't apply this patch to the source tree (it was applied to the pristine tree)"
		    (setf source-and-pristine-differ t))
		(skip-all ()
		    :report "Stop trying to apply patches to the source tree (they will be applied to the pristine tree)"
		    (setf source-and-pristine-differ t)
		    (setf applying-to-source nil))))
	    (princ #\.)
	    (force-output))
	  (when source-and-pristine-differ
	    (format t "~&~<Some patches could not be applied to the source tree.  ~
You should manually merge changes from the pristine tree in _darcs/pristine/.~>" nil)))))
    (format t "~&Finished pulling and applying.")))