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