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