[Cl-darcs-cvs] r35 - cl-darcs/trunk

[mhenoch at common-lisp.net]

Author: mhenoch
Date: Thu Aug 31 09:09:18 2006
New Revision: 35

Modified:
   cl-darcs/trunk/get.lisp
   cl-darcs/trunk/pull.lisp
   cl-darcs/trunk/repo.lisp
Log:
Enable specifying which patches to get in get-repo, at the cost of not
writing tag-based inventories.


Modified: cl-darcs/trunk/get.lisp
==============================================================================
--- cl-darcs/trunk/get.lisp	(original)
+++ cl-darcs/trunk/get.lisp	Thu Aug 31 09:09:18 2006
@@ -41,50 +41,44 @@
 	(apply-patch checkpoint-patch outname))
       (format t "done"))
 
-    (write-inventory outname patchinfo-list)
 
-    (let ((patches (if checkpoint
-		       ;; XXX: patchinfo-list is a list of lists now
-		       (find-remaining-patches patchinfo-list checkpoint)
-		       (apply #'append (reverse patchinfo-list)))))
+    (let* ((all-patches (if checkpoint
+			    ;; XXX: patchinfo-list is a list of lists now
+			    (find-remaining-patches patchinfo-list checkpoint)
+			    (apply #'append (reverse patchinfo-list))))
+	   (patches
+	    (if (or (null query) (y-or-n-p "Apply all patches?"))
+		all-patches
+		(select-some-patches all-patches))))
+      ;; write-inventory wants patches ordered by tags, but we have
+      ;;them all in a list in all-patches and patches...
+      ;;(write-inventory outname patchinfo-list)
       (copy-repo-patches repodir outname patches)
       
-      (if (or (null query) (y-or-n-p "Apply patches?"))
-	  (progn
-	    (format t "~&Applying patches")
-	    (dolist (patch patches)
-	      (apply-patch (read-patch-from-repo outname patch)
-			   outname)
-	      (format t ".")))
-	  (format t "~&Not applying patches"))
+      (format t "~&Applying patches")
+      (dolist (patchinfo patches)
+	(let ((patch (read-patch-from-repo outname patchinfo)))
+	  (apply-patch patch outname)
+	  ;; XXX: this is where we write tags to inventory correctly
+	  ;; Check how darcs handles tags - rotate inventory files?
+	  ;; What happens when adding patches one by one?
+	  (append-inventory outname patchinfo)
+	  (format t ".")))
       (format t "~&All done"))))
 
-(defun apply-some-patches (repo)
-  "Interactively select some patches to apply to REPO."
-  (setf repo (fad:pathname-as-directory repo))
-  (let ((patch-files 
-	 (sort 
-	  (directory 
-	   (merge-pathnames
-	    (make-pathname :directory (list :relative "_darcs" "patches")
-			   :name :wild :type "gz")
-	    repo))
-	  #'string< :key #'pathname-name)))
-    (format t "~&Available patches:")
-    (loop for file in patch-files
-       count file into i
-       do (format t "~&~3 at A ~A" i (pathname-name file)))
-    (format t "~&Specify inclusive start and end (NIL will do): ")
-    (let ((start (read)) (end (read)))
-      (if start
-	  (decf start)
-	  (setf start 0))
-      (let ((file-subset (subseq patch-files start end)))
-	(format t "~&Applying patches")
-	(dolist (patch-file file-subset)
-	  (apply-patch (read-patch-from-file patch-file) repo)
-	  (format t "."))
-	(format t "~&Done")))))
+(defun select-some-patches (patchinfo-list)
+  "Interactively select some patches from PATCHINFO-LIST.
+Return a new list containing the selected patches."
+  (format t "~&Available patches:")
+  (loop for patchinfo in patchinfo-list
+     count patchinfo into i
+     do (format t "~&~3 at A ~A" i patchinfo))
+  (format t "~&Specify inclusive start and end (NIL will do): ")
+  (let ((start (read)) (end (read)))
+    (if start
+	(decf start)
+	(setf start 0))
+    (subseq patchinfo-list start end)))
 
 (defun find-remaining-patches (patchinfo-list checkpoint)
   "Find the patches remaining after getting to CHECKPOINT."

Modified: cl-darcs/trunk/pull.lisp
==============================================================================
--- cl-darcs/trunk/pull.lisp	(original)
+++ cl-darcs/trunk/pull.lisp	Thu Aug 31 09:09:18 2006
@@ -34,7 +34,7 @@
       (dolist (p only-theirs)
 	(format t "~& - ~A" p))
       ;; XXX: This is where we pick which of their patches we want to
-      ;; pull.
+      ;; pull.  And copy them to our repo.
       (let* ((their-patches
 	      (mapcar (lambda (pi)
 			(read-patch-from-repo theirrepo pi))

Modified: cl-darcs/trunk/repo.lisp
==============================================================================
--- cl-darcs/trunk/repo.lisp	(original)
+++ cl-darcs/trunk/repo.lisp	Thu Aug 31 09:09:18 2006
@@ -138,7 +138,9 @@
 		      (make-pathname :directory '(:relative "_darcs")
 				     :name "inventory")
 		      outrepo)
-		     :direction :output :if-exists :append
+		     :direction :output
+		     :if-exists :append
+		     :if-does-not-exist :create
 		     :element-type '(unsigned-byte 8))
     (map nil (lambda (char)
 	       (write-byte (char-code char) f))