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

[mhenoch at common-lisp.net]

Author: mhenoch
Date: Fri Aug 24 00:34:10 2007
New Revision: 122

Modified:
   cl-darcs/trunk/repo.lisp
Log:
Add functions for managing pending patches


Modified: cl-darcs/trunk/repo.lisp
==============================================================================
--- cl-darcs/trunk/repo.lisp	(original)
+++ cl-darcs/trunk/repo.lisp	Fri Aug 24 00:34:10 2007
@@ -1,4 +1,4 @@
-;;; Copyright (C) 2006 Magnus Henoch
+;;; Copyright (C) 2006, 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
@@ -162,3 +162,24 @@
     (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))))