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

[mhenoch at common-lisp.net]

Author: mhenoch
Date: Sat Jul  8 11:05:25 2006
New Revision: 18

Modified:
   cl-darcs/trunk/equal.lisp
Log:
Use normal method combination for equal-patch.


Modified: cl-darcs/trunk/equal.lisp
==============================================================================
--- cl-darcs/trunk/equal.lisp	(original)
+++ cl-darcs/trunk/equal.lisp	Sat Jul  8 11:05:25 2006
@@ -15,25 +15,23 @@
 (defgeneric equal-patch (a b &optional really)
   (:documentation "Return true if patches A and B are equal.
 If REALLY is false, consider named patches with the same name
-to be equal, regardless of content.")
-  (:method-combination and :most-specific-last))
+to be equal, regardless of content."))
 
-(defmethod equal-patch :around ((a patch) (b patch) &optional really)
+(defmethod equal-patch ((a patch) (b patch) &optional really)
   "If there are no methods for comparing A and B, they are not equal."
   (declare (ignore really))
-  (if (next-method-p)
-      (call-next-method)
-      nil))
+  nil)
 
-(defmethod equal-patch and ((a file-patch) (b file-patch) &optional really)
+(defmethod equal-patch :around ((a file-patch) (b file-patch) &optional really)
   "Compare two file patches.
 Two file patches can be equal only if they are of the same type and
 patch the same file."
   (declare (ignore really))
-  (and (eq (class-of a) (class-of b))
-       (equal (patch-filename a) (patch-filename b))))
+  (when (and (eq (class-of a) (class-of b))
+	     (equal (patch-filename a) (patch-filename b)))
+    (call-next-method)))
 
-(defmethod equal-patch and ((a hunk-patch) (b hunk-patch) &optional really)
+(defmethod equal-patch ((a hunk-patch) (b hunk-patch) &optional really)
   "Compare two hunk patches."
   (declare (ignore really))
   (flet ((compare (accessor)
@@ -44,13 +42,7 @@
 	 (compare #'hunk-old-lines)
 	 (compare #'hunk-new-lines))))
 
-(defmethod equal-patch and ((a binary-patch) (b binary-patch) &optional really)
-  "Compare two binary patches."
-  (declare (ignore really))
-  (and (equalp (binary-oldhex a) (binary-oldhex b))
-       (equalp (binary-newhex a) (binary-newhex b))))
-
-(defmethod equal-patch and ((a token-replace-patch) (b token-replace-patch) &optional really)
+(defmethod equal-patch ((a token-replace-patch) (b token-replace-patch) &optional really)
   "Compare two token replacing patches."
   (declare (ignore really))
   (flet ((compare (accessor)
@@ -60,7 +52,13 @@
 	 (compare #'old-token)
 	 (compare #'new-token))))
 
-(defmethod equal-patch and ((a merger-patch) (b merger-patch) &optional really)
+(defmethod equal-patch ((a binary-patch) (b binary-patch) &optional really)
+  "Compare two binary patches."
+  (declare (ignore really))
+  (and (equalp (binary-oldhex a) (binary-oldhex b))
+       (equalp (binary-newhex a) (binary-newhex b))))
+
+(defmethod equal-patch ((a merger-patch) (b merger-patch) &optional really)
   "Compare two merger patches."
   (and (string= (merger-version a) (merger-version b))
        (eql (merger-inverted a) (merger-inverted b))