source: cl-darcs/tags/0.1.0/touching.lisp

Last change on this file was 16, checked in by Magnus Henoch, 16 years ago

Declare filename argument as ignored.

File size: 2.1 KB
Line 
1;;; Copyright (C) 2006 Magnus Henoch
2;;;
3;;; This program is free software; you can redistribute it and/or
4;;; modify it under the terms of the GNU General Public License as
5;;; published by the Free Software Foundation; either version 2 of the
6;;; License, or (at your option) any later version.
7;;;
8;;; This program is distributed in the hope that it will be useful,
9;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
10;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
11;;; General Public License for more details.
12;;;
13;;; You should have received a copy of the GNU General Public License
14;;; along with this program; if not, write to the Free Software
15;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
16
17(in-package :cl-darcs)
18
19(defgeneric find-touching (patch filename)
20  (:documentation "Find and return the subset of PATCH that touches FILENAME.
21Return NIL if PATCH doesn't touch FILENAME at all."))
22
23(defmethod find-touching :around (patch (filename string))
24  (find-touching patch (sanitize-filename filename)))
25
26(defmethod find-touching ((patch patch) filename)
27  "This least specific method returns NIL."
28  (declare (ignore filename))
29  nil)
30
31(defmethod find-touching ((patch composite-patch) filename)
32  "Return a new composite patch containing those patches that touch FILENAME.
33Return nil if no patches do."
34  (let ((touching-patches
35         (loop for p in (patches patch)
36            when (find-touching p filename)
37            collect it)))
38    (when touching-patches
39      (make-instance 'composite-patch :patches touching-patches))))
40
41(defmethod find-touching ((patch file-patch) filename)
42  (when (equal filename (patch-filename patch))
43    patch))
44
45(defmethod find-touching ((patch directory-patch) filename)
46  (when (equal filename (patch-directory patch))
47    patch))
48
49(defmethod find-touching ((patch named-patch) filename)
50  (let ((touching-patch (find-touching (named-patch-patch patch) filename)))
51    (when touching-patch
52      (make-instance 'named-patch 
53                     :patchinfo (named-patch-patchinfo patch)
54                     :dependencies (named-patch-dependencies patch)
55                     :patch touching-patch))))
56
Note: See TracBrowser for help on using the repository browser.