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)