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

[mhenoch at common-lisp.net]

Author: mhenoch
Date: Fri Aug 24 08:15:10 2007
New Revision: 126

Modified:
   cl-darcs/trunk/touching.lisp
Log:
Make FIND-TOUCHING direction-aware


Modified: cl-darcs/trunk/touching.lisp
==============================================================================
--- cl-darcs/trunk/touching.lisp	(original)
+++ cl-darcs/trunk/touching.lisp	Fri Aug 24 08:15:10 2007
@@ -1,4 +1,4 @@
-;;; Copyright (C) 2006 Magnus Henoch
+;;; Copyright (C) 2006, 2007 Magnus Henoch
 ;;;
 ;;; This program is free software; you can redistribute it and/or
 ;;; modify it under the terms of the GNU General Public License as
@@ -16,41 +16,74 @@
 
 (in-package :cl-darcs)
 
-(defgeneric find-touching (patch filename)
+(defgeneric find-touching (patch filename direction)
   (:documentation "Find and return the subset of PATCH that touches FILENAME.
-Return NIL if PATCH doesn't touch FILENAME at all."))
 
-(defmethod find-touching :around (patch (filename string))
-  (find-touching patch (sanitize-filename filename)))
+DIRECTION is either :FORWARDS or :BACKWARDS.  If it is :FORWARDS,
+FILENAME is the name of the file before this patch; if :BACKWARDS,
+after.
+
+Two values are returned, the subset patch, and the new name of the
+file.  The subset patch is NIL if PATCH doesn't touch FILENAME at all.
+The name is the same as the old one, if the patch didn't
+change the file's name.  The name is NIL if the file doesn't exist
+before/after the patch, or if the patch doesn't touch the file."))
 
-(defmethod find-touching ((patch patch) filename)
+(defmethod find-touching :around (patch (filename string) direction)
+  (find-touching patch (sanitize-filename filename) direction))
+
+(defmethod find-touching ((patch patch) filename direction)
   "This least specific method returns NIL."
-  (declare (ignore filename))
+  (declare (ignore filename direction))
   nil)
 
-(defmethod find-touching ((patch composite-patch) filename)
+(defmethod find-touching ((patch composite-patch) filename direction)
   "Return a new composite patch containing those patches that touch FILENAME.
 Return nil if no patches do."
-  (let ((touching-patches
-	 (loop for p in (patches patch)
-	    when (find-touching p filename)
-	    collect it)))
+  (let ((patches (ecase direction
+		   (:forwards (patches patch))
+		   (:backwards (reverse (patches patch)))))
+	touching-patches)
+    (dolist (p patches)
+      (multiple-value-bind
+	    (subset-patch new-name)
+	  (find-touching p filename direction)
+	(when subset-patch
+	  (push subset-patch touching-patches)
+	  (setf filename new-name)
+	  (when (null filename)
+	    (return)))))
     (when touching-patches
-      (make-instance 'composite-patch :patches touching-patches))))
+      (make-instance 'composite-patch :patches (nreverse touching-patches)))))
 
-(defmethod find-touching ((patch file-patch) filename)
+(defmethod find-touching ((patch file-patch) filename direction)
+  (declare (ignore direction))
   (when (equal filename (patch-filename patch))
-    patch))
+    (values patch filename)))
 
-(defmethod find-touching ((patch directory-patch) filename)
+(defmethod find-touching ((patch directory-patch) filename direction)
+  (declare (ignore direction))
   (when (equal filename (patch-directory patch))
-    patch))
+    (values patch filename)))
 
-(defmethod find-touching ((patch named-patch) filename)
-  (let ((touching-patch (find-touching (named-patch-patch patch) filename)))
+(defmethod find-touching ((patch named-patch) filename direction)
+  (multiple-value-bind (touching-patch new-name)
+      (find-touching (named-patch-patch patch) filename direction)
     (when touching-patch
-      (make-instance 'named-patch 
-		     :patchinfo (named-patch-patchinfo patch)
-		     :dependencies (named-patch-dependencies patch)
-		     :patch touching-patch))))
-
+      (values
+       (make-instance 'named-patch 
+		      :patchinfo (named-patch-patchinfo patch)
+		      :dependencies (named-patch-dependencies patch)
+		      :patch touching-patch)
+       new-name))))
+
+(defmethod find-touching ((patch move-patch) filename direction)
+  (let ((from (patch-move-from patch))
+	(to (patch-move-to patch)))
+    (ecase direction
+      (:forwards
+       (when (equal filename from)
+	 (values patch to)))
+      (:backwards
+       (when (equal filename to)
+	 (values patch from))))))