Author: mhenoch Date: Fri Aug 24 08:30:54 2007 New Revision: 128 Modified: cl-darcs/trunk/touching.lisp Log: Add FIND-TOUCHING methods for DIRECTORY-PATCH and subclasses. Add warnings for bizarre situations. Modified: cl-darcs/trunk/touching.lisp ============================================================================== --- cl-darcs/trunk/touching.lisp (original) +++ cl-darcs/trunk/touching.lisp Fri Aug 24 08:30:54 2007 @@ -75,6 +75,7 @@ ;; Should this happen in normal circumstances? If the file was ;; created by this patch, noone would know about its existence ;; before. + (warn "FIND-TOUCHING: File ~A is being added, but it already exists." filename) (values patch filename)) (:backwards ;; Before this patch, the file didn't exist. @@ -88,12 +89,32 @@ (values patch nil)) (:backwards ;; Should this happen? + (warn "FIND-TOUCHING: File ~A was removed, but it still exists." filename) (values patch filename)))) -(defmethod find-touching ((patch directory-patch) filename direction) +(defmethod find-touching :around ((patch directory-patch) filename direction) (declare (ignore direction)) (when (equal filename (patch-directory patch)) - (values patch filename))) + (call-next-method))) + +(defmethod find-touching ((patch add-dir-patch) filename direction) + (ecase direction + (:forwards + ;; Should this happen? + (warn "FIND-TOUCHING: Directory ~A is being added, but it already exists." filename) + (values patch filename)) + (:backwards + ;; Before this patch, the directory didn't exist. + (values patch nil)))) + +(defmethod find-touching ((patch rm-dir-patch) filename direction) + (ecase direction + (:forwards + ;; After this patch, the directory doesn't exist. + (values patch nil)) + (:backwards + (warn "FIND-TOUCHING: Directory ~A was removed, but it still exists." filename) + (values patch filename)))) (defmethod find-touching ((patch named-patch) filename direction) (multiple-value-bind (touching-patch new-name)