Author: mhenoch Date: Fri Jul 14 19:47:25 2006 New Revision: 32 Added: cl-darcs/trunk/pull.lisp Log: Add pull.lisp Added: cl-darcs/trunk/pull.lisp ============================================================================== --- (empty file) +++ cl-darcs/trunk/pull.lisp Fri Jul 14 19:47:25 2006 @@ -0,0 +1,52 @@ +;;; Copyright (C) 2006 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 theirrepo) + "Pull new patches from THEIRREPO into OURREPO." + (setf ourrepo (fad:pathname-as-directory ourrepo)) + (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)) + (format t "~&Found these new patches:") + (dolist (p only-theirs) + (format t "~& - ~A" p)) + ;; XXX: This is where we pick which of their patches we want to + ;; pull. + (let* ((their-patches + (mapcar (lambda (pi) + (read-patch-from-repo theirrepo pi)) + only-theirs)) + (our-patches + (mapcar (lambda (pi) + (read-patch-from-repo ourrepo pi)) + 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") + (dolist (p merged-patches) + (apply-patch p ourrepo) + ;; If this is not a named patch, our assumptions are + ;; challenged. + (append-inventory ourrepo (named-patch-patchinfo p)) + (format t "."))))) + (format t "~&All done"))