Author: mhenoch Date: Wed Jul 12 10:21:13 2006 New Revision: 23 Added: cl-darcs/trunk/repo.lisp Modified: cl-darcs/trunk/cl-darcs.asd cl-darcs/trunk/get.lisp Log: Split get.lisp, add repo.lisp Modified: cl-darcs/trunk/cl-darcs.asd ============================================================================== --- cl-darcs/trunk/cl-darcs.asd (original) +++ cl-darcs/trunk/cl-darcs.asd Wed Jul 12 10:21:13 2006 @@ -31,6 +31,7 @@ (:file "get" :depends-on ("util")) (:file "init" :depends-on ("util")) (:file "prefs" :depends-on ("util")) + (:file "repo" :depends-on ("util")) (:file "patch-core" :depends-on ("util")) (:file "read-patch" :depends-on ("patch-core")) Modified: cl-darcs/trunk/get.lisp ============================================================================== --- cl-darcs/trunk/get.lisp (original) +++ cl-darcs/trunk/get.lisp Wed Jul 12 10:21:13 2006 @@ -86,77 +86,6 @@ (format t ".")) (format t "~&Done"))))) -(defun prepare-new-repo (outname) - "Create directories for starting a repo at OUTNAME." - (make-dir outname) - (make-dir (merge-pathnames (make-pathname :directory (list :relative "_darcs")) - outname)) - (dolist (dir '("patches" "checkpoints" "prefs" "inventories")) - (make-dir (merge-pathnames - (make-pathname :directory (list :relative "_darcs" dir)) - 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 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) - (with-open-stream (in (make-instance 'unreadable-stream - :base-stream (open-upath inventory-file :binary t))) - ;; If first line is "Starting with tag:", - (let ((first-line (read-binary-line in))) - (if (string= (bytes-to-string first-line) "Starting with tag:") - (let* ((tag-patch - ;; 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. 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))) - (setf patches (list tag-patch))) - ;; If it's not, pretend we never read that line. - (unread-line in first-line))) - ;; Then, just read all patches in the file. - (format t "~&Reading patchinfo from ~A" inventory-file) - (setf 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." - (read-patch-from-file - (upath-subdir repodir '("_darcs" "patches") (patchinfo-make-filename patchinfo)))) - -(defun read-checkpoint-from-repo (repodir patchinfo) - "Read checkpoint named by PATCHINFO from REPODIR." - (read-patch-from-file - (upath-subdir repodir '("_darcs" "checkpoints") (patchinfo-make-filename patchinfo)))) - -(defun read-checkpoint-list (repodir) - "Read a list of checkpoints from REPODIR. -Return as a patchinfo list." - ;; If there are no checkpoints, it doesn't matter. - (ignore-errors - (with-open-stream (in (open-upath (upath-subdir repodir '("_darcs" "checkpoints") "inventory"))) - (format t "~&Reading checkpoints") - (loop for patch = (read-patchinfo in) - while patch collect patch - do (princ #\.))))) - (defun find-remaining-patches (patchinfo-list checkpoint) "Find the patches remaining after getting to CHECKPOINT." ;; XXX: this is incorrect; the checkpoint isn't among ordinary patches. @@ -196,47 +125,3 @@ :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))))))))) Added: cl-darcs/trunk/repo.lisp ============================================================================== --- (empty file) +++ cl-darcs/trunk/repo.lisp Wed Jul 12 10:21:13 2006 @@ -0,0 +1,134 @@ +;;; 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 prepare-new-repo (outname) + "Create directories for starting a repo at OUTNAME." + (make-dir outname) + (make-dir (merge-pathnames (make-pathname :directory (list :relative "_darcs")) + outname)) + (dolist (dir '("patches" "checkpoints" "prefs" "inventories")) + (make-dir (merge-pathnames + (make-pathname :directory (list :relative "_darcs" dir)) + 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 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) + (with-open-stream (in (make-instance 'unreadable-stream + :base-stream (open-upath inventory-file :binary t))) + ;; If first line is "Starting with tag:", + (let ((first-line (read-binary-line in))) + (if (string= (bytes-to-string first-line) "Starting with tag:") + (let* ((tag-patch + ;; 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. 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))) + (setf patches (list tag-patch))) + ;; If it's not, pretend we never read that line. + (unread-line in first-line))) + ;; Then, just read all patches in the file. + (format t "~&Reading patchinfo from ~A" inventory-file) + (setf 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." + (read-patch-from-file + (upath-subdir repodir '("_darcs" "patches") (patchinfo-make-filename patchinfo)))) + +(defun read-checkpoint-from-repo (repodir patchinfo) + "Read checkpoint named by PATCHINFO from REPODIR." + (read-patch-from-file + (upath-subdir repodir '("_darcs" "checkpoints") (patchinfo-make-filename patchinfo)))) + +(defun read-checkpoint-list (repodir) + "Read a list of checkpoints from REPODIR. +Return as a patchinfo list." + ;; If there are no checkpoints, it doesn't matter. + (ignore-errors + (with-open-stream (in (open-upath (upath-subdir repodir '("_darcs" "checkpoints") "inventory"))) + (format t "~&Reading checkpoints") + (loop for patch = (read-patchinfo in) + while patch collect patch + do (princ #\.))))) + +(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))))))))) +