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