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

[mhenoch at common-lisp.net]

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