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