[Cl-darcs-cvs] r124 - cl-darcs/trunk

[mhenoch at common-lisp.net]

Author: mhenoch
Date: Fri Aug 24 01:05:53 2007
New Revision: 124

Added:
   cl-darcs/trunk/pending.lisp
Modified:
   cl-darcs/trunk/cl-darcs.asd
   cl-darcs/trunk/repo.lisp
Log:
Add ADD-FILE.  Move "pending" functions to pending.lisp.


Modified: cl-darcs/trunk/cl-darcs.asd
==============================================================================
--- cl-darcs/trunk/cl-darcs.asd	(original)
+++ cl-darcs/trunk/cl-darcs.asd	Fri Aug 24 01:05:53 2007
@@ -53,6 +53,7 @@
    (:file "equal" :depends-on ("patch-core"))
    (:file "send" :depends-on ("patch-core"))
    (:file "revert" :depends-on ("patch-core"))
+   (:file "pending" :depends-on ("patch-core"))
 
    ;; Franz' inflate implementation
    #-allegro (:file "ifstar")

Added: cl-darcs/trunk/pending.lisp
==============================================================================
--- (empty file)
+++ cl-darcs/trunk/pending.lisp	Fri Aug 24 01:05:53 2007
@@ -0,0 +1,72 @@
+;;; Copyright (C) 2007 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 pending-filename (repodir)
+  "Get the name of the file containing \"pending\" patches for REPODIR."
+  (upath-subdir repodir '("_darcs" "patches") "pending"))
+
+(defun read-pending (repodir)
+  "Read the \"pending\" patches of REPODIR."
+  (let ((pending-file (pending-filename repodir)))
+    (when (probe-file pending-file)
+      (read-patch-from-file pending-file :compressed nil))))
+
+(defun add-to-pending (repodir patch)
+  "Add PATCH to the list of \"pending\" patches in REPODIR."
+  (let ((pending (read-pending repodir)))
+    (when (null pending)
+      (setf pending (make-instance 'composite-patch)))
+    (setf (patches pending) (append (patches pending) (list patch)))
+    (with-open-file (out (pending-filename repodir)
+			 :direction :output :element-type '(unsigned-byte 8)
+			 :if-exists :supersede)
+      (write-patch pending out))))
+
+(defun add-file (repo file)
+  "Schedule FILE for recording to REPO.
+FILE can be a string or a pathname denoting a relative path.
+FILE can be either a file or a directory."
+  (setf repo (fad:pathname-as-directory repo))
+  (let (type)
+    (if (pathnamep file)
+	(progn
+	  (unless (pathname-sane-p file)
+	    (error "~A is not a relative pathname going strictly down." file))
+	  (setf type (if (fad:directory-pathname-p file) :directory :file)))
+	(progn
+	  (setf type (if (fad:directory-exists-p (fad:pathname-as-directory file))
+			 :directory 
+			 :file))
+	  (setf file (sanitize-filename file :type type))))
+
+    (let ((pristine-file (merge-pathnames file (upath-subdir repo '("_darcs" "pristine"))))
+	  (working-file (merge-pathnames file repo)))
+      (when (if (eql type :file)
+		(fad:file-exists-p pristine-file)
+		(fad:directory-exists-p pristine-file))
+	(error "~A already exists in the repository." (pathname-to-string file)))
+      (when (not (if (eql type :file)
+		     (fad:file-exists-p working-file)
+		     (fad:directory-exists-p working-file)))
+	(error "~A does not exist in the working directory." (pathname-to-string file))))
+
+    (add-to-pending
+     repo 
+     (if (eql type :file)
+	 (make-instance 'add-file-patch :filename (pathname-to-string file))
+	 (make-instance 'add-dir-patch :directory (pathname-to-string file))))))

Modified: cl-darcs/trunk/repo.lisp
==============================================================================
--- cl-darcs/trunk/repo.lisp	(original)
+++ cl-darcs/trunk/repo.lisp	Fri Aug 24 01:05:53 2007
@@ -162,24 +162,3 @@
     (values (intersection ours-list theirs-list :test #'equalp)
 	    (set-difference ours-list theirs-list :test #'equalp)
 	    (set-difference theirs-list ours-list :test #'equalp))))
-
-(defun pending-filename (repodir)
-  "Get the name of the file containing \"pending\" patches for REPODIR."
-  (upath-subdir repodir '("_darcs" "patches") "pending"))
-
-(defun read-pending (repodir)
-  "Read the \"pending\" patches of REPODIR."
-  (let ((pending-file (pending-filename repodir)))
-    (when (probe-file pending-file)
-      (read-patch-from-file pending-file :compressed nil))))
-
-(defun add-to-pending (repodir patch)
-  "Add PATCH to the list of \"pending\" patches in REPODIR."
-  (let ((pending (read-pending repodir)))
-    (when (null pending)
-      (setf pending (make-instance 'composite-patch)))
-    (setf (patches pending) (append (patches pending) (list patch)))
-    (with-open-file (out (pending-filename repodir)
-			 :direction :output :element-type '(unsigned-byte 8)
-			 :if-exists :supersede)
-      (write-patch pending out))))