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

[mhenoch at common-lisp.net]

Author: mhenoch
Date: Mon Nov 27 18:31:02 2006
New Revision: 78

Modified:
   cl-darcs/trunk/record.lisp
Log:
Add select-patches and use it


Modified: cl-darcs/trunk/record.lisp
==============================================================================
--- cl-darcs/trunk/record.lisp	(original)
+++ cl-darcs/trunk/record.lisp	Mon Nov 27 18:31:02 2006
@@ -51,4 +51,47 @@
     (unless patches
       (error "Nothing to record."))
 
-    (record-patches repo name author date log patches)))
+    (record-patches repo name author date log (select-patches patches))))
+
+(defun select-patches (patches)
+  "Ask the user to select some of PATCHES.
+Do the necessary commutation and dependency elimination."
+  (let (patches-to-record)
+    (loop while (setf patches (remove nil patches))
+       do
+       ;; Should we include this patch? 
+       (if (y-or-n-p "Record patch ~A?" (car patches))
+	   (progn
+	     ;; Yes, just add it to the list and go on.
+	     (push (car patches) patches-to-record)
+	     (setf patches (cdr patches)))
+	   ;; No, we need to commute it through the rest of the patches.
+	   (loop for commute-patches on (cdr patches)
+	      ;; Try to commute it with the next patch in line.
+	      do (let ((commute-result (commute (car commute-patches) (car patches))))
+		   (if commute-result
+		       ;; Commutation succeeded; use the altered patches.
+		       (destructuring-bind (commuted-current commuted-future) commute-result
+			 (setf (car patches) commuted-current)
+			 (setf (car commute-patches) commuted-future))
+		       ;; Commutation failed; (car commute-patches) depends on (car patches).
+		       ;; Try to commute them together.
+		       (progn
+			 ;; Turn the patch we are commuting through
+			 ;; the list into a composite patch, unless it is
+			 ;; one already.  Append the dependency.
+			 (etypecase (car patches)
+			   (composite-patch
+			    (nconc (patches (car patches))
+				   (list (car commute-patches))))
+			   (patch
+			    (setf (car patches)
+				  (make-instance 'composite-patch
+						 :patches (list
+							   (car patches)
+							   (car commute-patches))))))
+			 ;; Drop the dependency from the list of
+			 ;; patches to consider.
+			 (setf (car commute-patches) nil))))
+	      finally (setf patches (cdr patches)))))
+    (nreverse patches-to-record)))