Author: mhenoch Date: Tue Jul 11 12:08:36 2006 New Revision: 22 Modified: cl-darcs/trunk/get.lisp Log: Read patchinfo structures per tag. Write proper inventory files when getting a tree. Modified: cl-darcs/trunk/get.lisp ============================================================================== --- cl-darcs/trunk/get.lisp (original) +++ cl-darcs/trunk/get.lisp Tue Jul 11 12:08:36 2006 @@ -22,12 +22,16 @@ ;; other access methods later... ;; XXX: checkpoints? (let* ((repodir (make-upath inrepodir)) + ;; Here we get a list of lists. Each list represents a tag; + ;; the latest tag is at the head. Each list contains patches + ;; in the order they are to be applied. (patchinfo-list (read-repo-patch-list repodir)) ;; We should probably download checkpoint patches, btw... (checkpoint (when partial (car (last (read-checkpoint-list repodir)))))) ;; Create directories... (prepare-new-repo outname) + (set-default-repo outname inrepodir) (when checkpoint (format t "~&Copying checkpoint...") @@ -37,11 +41,14 @@ (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) - patchinfo-list))) + (apply #'append (reverse patchinfo-list))))) (copy-repo-patches repodir outname patches) - + (if (or (null query) (y-or-n-p "Apply patches?")) (progn (format t "~&Applying patches") @@ -84,16 +91,21 @@ (make-dir outname) (make-dir (merge-pathnames (make-pathname :directory (list :relative "_darcs")) outname)) - (dolist (dir '("patches" "checkpoints" "prefs")) + (dolist (dir '("patches" "checkpoints" "prefs" "inventories")) (make-dir (merge-pathnames (make-pathname :directory (list :relative "_darcs" dir)) - outname)))) + outname))) + (write-default-prefs outname)) ;; {lazily,}read_repo in DarcsRepo.lhs ;; read_repo_private in DarcsRepo.lhs (defun read-repo-patch-list (inrepodir &optional inventory-file) "Read patch info for INREPODIR from INVENTORY-FILE. -Return a list of patchinfo structures." +Return a list of lists of patchinfo structures. + +Note that this function returns patchinfo structures in the order +they were applied, unlike the real darcs which often uses reverse +order." (when (null inventory-file) (setf inventory-file (upath-subdir inrepodir '("_darcs") "inventory"))) (let (tag-patches patches) @@ -106,8 +118,9 @@ ;; read the first patch... (read-patchinfo in)) (new-filename (patchinfo-make-filename tag-patch))) - ;; ...for the first patch is a tag. Recursively read the - ;; inventory of that file. + ;; ...for the first patch is a tag. Recursively read + ;; the inventory of that file. The tag patch then goes + ;; at the head of the current list of patches. (setf tag-patches (read-repo-patch-list inrepodir (upath-subdir inrepodir '("_darcs" "inventories") new-filename))) @@ -117,10 +130,11 @@ ;; Then, just read all patches in the file. (format t "~&Reading patchinfo from ~A" inventory-file) (setf patches - (loop for patch = (read-patchinfo in) - while patch collect patch - do (princ #\.)))) - (nconc tag-patches patches))) + (nconc patches + (loop for patch = (read-patchinfo in) + while patch collect patch + do (princ #\.))))) + (cons patches tag-patches))) (defun read-patch-from-repo (repodir patchinfo) "Read patch named by PATCHINFO from REPODIR." @@ -181,3 +195,48 @@ (upath-subdir from '("_darcs" "checkpoints") filename) :binary t)) (fad:copy-stream in out))))) + +(defun write-inventory (out patchinfo-list &optional file) + "Write PATCHINFO-LIST as inventory in OUT. +FILE is either nil, meaning the main \"inventory\" file, or a +string naming a file in the \"inventories\" directory." + ;; XXX: slightly_optimize_patchset? + (let ((inventory-file (cond + ((null file) + (merge-pathnames + (make-pathname :directory '(:relative "_darcs") + :name "inventory") + out)) + (t + (merge-pathnames + (make-pathname :directory '(:relative "_darcs" "inventories") + :name file) + out))))) + (with-open-file (f inventory-file :direction :output :if-exists :supersede + :element-type '(unsigned-byte 8)) + (flet ((print-patchinfos (patchinfos) + ;; Convert output to binary, using the most direct possible + ;; method... + (dolist (patchinfo patchinfos) + (map nil (lambda (char) + (write-byte (char-code char) f)) + (with-output-to-string (strout) + (write-patchinfo patchinfo strout))) + (write-byte 10 f)))) + (cond + ((null patchinfo-list) + ;; No patches - empty inventory file. Nothing to do. + ) + ((null (cdr patchinfo-list)) + ;; One patch list - no remaining tags. + + (print-patchinfos (car patchinfo-list))) + (t + ;; Several patch lists, one for each tag + (let* ((this-tag (car patchinfo-list)) + (other-tags (cdr patchinfo-list)) + (tag-name (patchinfo-make-filename (car this-tag)))) + (write-inventory out other-tags tag-name) + (write-sequence (map 'vector #'char-code "Starting with tag:") f) + (write-byte 10 f) + (print-patchinfos (car patchinfo-list)))))))))