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@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@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))
