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