Author: mhenoch Date: Fri Oct 6 15:55:15 2006 New Revision: 51 Added: cl-darcs/trunk/pristine.lisp Modified: cl-darcs/trunk/get.lisp cl-darcs/trunk/pull.lisp Log: Add functions for keeping a pristine. Use it when getting and pulling. Modified: cl-darcs/trunk/get.lisp ============================================================================== --- cl-darcs/trunk/get.lisp (original) +++ cl-darcs/trunk/get.lisp Fri Oct 6 15:55:15 2006 @@ -64,6 +64,8 @@ ;; What happens when adding patches one by one? (append-inventory outname patchinfo) (format t "."))) + (format t "~&Creating pristine") + (create-pristine-from-tree outname) (format t "~&All done")))) (defun select-some-patches (patchinfo-list) Added: cl-darcs/trunk/pristine.lisp ============================================================================== --- (empty file) +++ cl-darcs/trunk/pristine.lisp Fri Oct 6 15:55:15 2006 @@ -0,0 +1,28 @@ +;;; 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 create-pristine-from-tree (repodir) + "Copy the checked-out tree at REPODIR to get a pristine tree." + (let* ((darcs-dir (upath-subdir repodir '("_darcs"))) + (pristine-dir (upath-subdir darcs-dir '("pristine")))) + (make-dir pristine-dir) + (copy-directory repodir pristine-dir :excluding (list darcs-dir)))) + +(defun apply-patch-to-pristine (patch repodir) + "Apply PATCH to the pristine tree in REPODIR." + (apply-patch patch (upath-subdir repodir '("_darcs" "pristine")))) Modified: cl-darcs/trunk/pull.lisp ============================================================================== --- cl-darcs/trunk/pull.lisp (original) +++ cl-darcs/trunk/pull.lisp Fri Oct 6 15:55:15 2006 @@ -49,11 +49,32 @@ (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)) - (write-patch-to-repo p ourrepo) - (format t "."))))) - (format t "~&All done")) + (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)))) + (format t ".")) + (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/.~:@>"))))) + (format t "~&All done")))