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