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

[mhenoch at common-lisp.net]

Author: mhenoch
Date: Sat Mar 10 18:04:14 2007
New Revision: 106

Modified:
   cl-darcs/trunk/pull.lisp
   cl-darcs/trunk/record.lisp
Log:
Make PULL conditionally interactive.
SELECT-PATCHES now takes a predicate as second argument.


Modified: cl-darcs/trunk/pull.lisp
==============================================================================
--- cl-darcs/trunk/pull.lisp	(original)
+++ cl-darcs/trunk/pull.lisp	Sat Mar 10 18:04:14 2007
@@ -16,10 +16,16 @@
 
 (in-package :darcs)
 
-(defun pull (ourrepo &optional theirrepo)
+(defun pull (ourrepo &optional theirrepo &key (select-patches :ask))
   "Pull new patches from THEIRREPO into OURREPO.
 If THEIRREPO is not specified, use default repositiory specified
-in preferences."
+in preferences.
+SELECT-PATCHES specifies how to select which remote patches to pull.
+It can be one of:
+:ALL - pull all patches
+:ASK - ask for each patch through Y-OR-N-P
+a function - call this function with a NAMED-PATCH object, and
+             pull if it returns true"
   (setf ourrepo (fad:pathname-as-directory ourrepo))
   (unless theirrepo
     (setf theirrepo (car (get-preflist ourrepo "defaultrepo")))
@@ -42,9 +48,16 @@
 			(read-patch-from-repo theirrepo patchinfo))
 		      only-theirs))
 	     (their-patches
-	      (if (y-or-n-p "Pull all patches?")
+	      (if (or (eq select-patches :all)
+		      (and (eq select-patches :ask)
+			   (y-or-n-p "Pull all patches?")))
 		  all-their-patches
-		  (select-patches all-their-patches)))
+		  (select-patches all-their-patches 
+				  (if (functionp select-patches)
+				      select-patches
+				      (lambda (patch) 
+					(display-patch patch *query-io*)
+					(y-or-n-p "Pull patch ~A? " patch))))))
 	     (our-patches
 	      (mapcar (lambda (patchinfo)
 			(read-patch-from-repo ourrepo patchinfo))

Modified: cl-darcs/trunk/record.lisp
==============================================================================
--- cl-darcs/trunk/record.lisp	(original)
+++ cl-darcs/trunk/record.lisp	Sat Mar 10 18:04:14 2007
@@ -49,20 +49,22 @@
   "Record changes in REPO.
 Arguments as to `record-patches'."
   (let ((patches (diff-repo repo)))
-    (unless patches
-      (error "Nothing to record."))
+    (flet ((ask (patch)
+	     (display-patch patch *query-io*)
+	     (y-or-n-p "Record patch ~A? " patch)))
+      (unless patches
+	(error "Nothing to record."))
 
-    (record-patches repo name author date log (select-patches patches))))
+      (record-patches repo name author date log (select-patches patches #'ask)))))
 
-(defun select-patches (patches)
-  "Ask the user to select some of PATCHES.
+(defun select-patches (patches predicate)
+  "Select some of PATCHES using PREDICATE.
 Do the necessary commutation and dependency elimination."
   (let (patches-to-record)
     (loop while (setf patches (remove nil patches))
        do
        ;; Should we include this patch? 
-       (display-patch (car patches) *query-io*)
-       (if (y-or-n-p "Record patch ~A?" (car patches))
+       (if (funcall predicate (car patches))
 	   (progn
 	     ;; Yes, just add it to the list and go on.
 	     (push (car patches) patches-to-record)