source: cl-darcs/trunk/touching.lisp

;;; 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
;;; published by the Free Software Foundation; either version 2 of the
;;; License, or (at your option) any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;; General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program; if not, write to the Free Software
;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA

(in-package :cl-darcs)

(defgeneric find-touching (patch filename direction)
  (:documentation "Find and return the subset of PATCH that touches 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 :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 direction))
  nil)

(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 ((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
      (values (make-instance 'composite-patch :patches (nreverse touching-patches)) filename))))

(defmethod find-touching :around ((patch file-patch) filename direction)
  ;; File patches touch a single file, so we can ignore them if they
  ;; don't touch the file we're interested in.
  (declare (ignore direction))
  (when (equal filename (patch-filename patch))
    (call-next-method)))

(defmethod find-touching ((patch file-patch) filename direction)
  ;; By default, assume that file patches modify an existing file.
  (declare (ignore direction))
  (values patch filename))

(defmethod find-touching ((patch add-file-patch) filename direction)
  ;; Adding a file is different, though.
  (ecase direction
    (:forwards
     ;; 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.
     (values patch nil))))

(defmethod find-touching ((patch rm-file-patch) filename direction)
  ;; As is removing a file.
  (ecase direction
    (:forwards
     ;; After this patch, the file doesn't exist.
     (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 :around ((patch directory-patch) filename direction)
  (declare (ignore direction))
  (when (equal filename (patch-directory patch))
    (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)
      (find-touching (named-patch-patch patch) filename direction)
    (when 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))))))