Author: mhenoch Date: Thu Mar 15 22:19:21 2007 New Revision: 114 Modified: cl-darcs/trunk/commute.lisp Log: Add COMMUTE methods for trivial commutations of FILE-PATCH and MERGER-PATCH. Modified: cl-darcs/trunk/commute.lisp ============================================================================== --- cl-darcs/trunk/commute.lisp (original) +++ cl-darcs/trunk/commute.lisp Thu Mar 15 22:19:21 2007 @@ -97,6 +97,30 @@ (list p1 p2) (call-next-method)))) +(defmethod commute :around ((p2 file-patch) (p1 merger-patch)) + "If P1 touches only one file, and P2 touches another, commutation is trivial." + (let ((p1-first (merger-first p1)) + (p1-second (merger-second p1)) + (p2-file (patch-filename p2))) + (if (and (typep p1-first 'file-patch) + (typep p1-second 'file-patch) + (equal (patch-filename p1-first) (patch-filename p1-second)) + (not (equal (patch-filename p1-first) p2-file))) + (list p1 p2) + (call-next-method)))) + +(defmethod commute :around ((p2 merger-patch) (p1 file-patch)) + "If P2 touches only one file, and P1 touches another, commutation is trivial." + (let ((p1-file (patch-filename p1)) + (p2-first (merger-first p2)) + (p2-second (merger-second p2))) + (if (and (typep p2-first 'file-patch) + (typep p2-second 'file-patch) + (equal (patch-filename p2-first) (patch-filename p2-second)) + (not (equal (patch-filename p2-first) p1-file))) + (list p1 p2) + (call-next-method)))) + (defmethod commute ((p2 hunk-patch) (p1 hunk-patch)) "Attempt to commute the two hunk patches P1 and P2." (assert (equal (patch-filename p1) (patch-filename p2)))