source: cl-darcs/trunk/touching.lisp

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

Make FIND-TOUCHING for COMPOSITE-PATCH return two values.

File size: 5.2 KB
Line 
1;;; Copyright (C) 2006, 2007 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 direction)
20  (:documentation "Find and return the subset of PATCH that touches FILENAME.
21
22DIRECTION is either :FORWARDS or :BACKWARDS.  If it is :FORWARDS,
23FILENAME is the name of the file before this patch; if :BACKWARDS,
24after.
25
26Two values are returned, the subset patch, and the new name of the
27file.  The subset patch is NIL if PATCH doesn't touch FILENAME at all.
28The name is the same as the old one, if the patch didn't
29change the file's name.  The name is NIL if the file doesn't exist
30before/after the patch, or if the patch doesn't touch the file."))
31
32(defmethod find-touching :around (patch (filename string) direction)
33  (find-touching patch (sanitize-filename filename) direction))
34
35(defmethod find-touching ((patch patch) filename direction)
36  "This least specific method returns NIL."
37  (declare (ignore filename direction))
38  nil)
39
40(defmethod find-touching ((patch composite-patch) filename direction)
41  "Return a new composite patch containing those patches that touch FILENAME.
42Return nil if no patches do."
43  (let ((patches (ecase direction
44                   (:forwards (patches patch))
45                   (:backwards (reverse (patches patch)))))
46        touching-patches)
47    (dolist (p patches)
48      (multiple-value-bind
49            (subset-patch new-name)
50          (find-touching p filename direction)
51        (when subset-patch
52          (push subset-patch touching-patches)
53          (setf filename new-name)
54          (when (null filename)
55            (return)))))
56    (when touching-patches
57      (values (make-instance 'composite-patch :patches (nreverse touching-patches)) filename))))
58
59(defmethod find-touching :around ((patch file-patch) filename direction)
60  ;; File patches touch a single file, so we can ignore them if they
61  ;; don't touch the file we're interested in.
62  (declare (ignore direction))
63  (when (equal filename (patch-filename patch))
64    (call-next-method)))
65
66(defmethod find-touching ((patch file-patch) filename direction)
67  ;; By default, assume that file patches modify an existing file.
68  (declare (ignore direction))
69  (values patch filename))
70
71(defmethod find-touching ((patch add-file-patch) filename direction)
72  ;; Adding a file is different, though.
73  (ecase direction
74    (:forwards
75     ;; Should this happen in normal circumstances?  If the file was
76     ;; created by this patch, noone would know about its existence
77     ;; before.
78     (warn "FIND-TOUCHING: File ~A is being added, but it already exists." filename)
79     (values patch filename))
80    (:backwards
81     ;; Before this patch, the file didn't exist.
82     (values patch nil))))
83
84(defmethod find-touching ((patch rm-file-patch) filename direction)
85  ;; As is removing a file.
86  (ecase direction
87    (:forwards
88     ;; After this patch, the file doesn't exist.
89     (values patch nil))
90    (:backwards
91     ;; Should this happen?
92     (warn "FIND-TOUCHING: File ~A was removed, but it still exists." filename)
93     (values patch filename))))
94
95(defmethod find-touching :around ((patch directory-patch) filename direction)
96  (declare (ignore direction))
97  (when (equal filename (patch-directory patch))
98    (call-next-method)))
99
100(defmethod find-touching ((patch add-dir-patch) filename direction)
101  (ecase direction
102    (:forwards
103     ;; Should this happen?
104     (warn "FIND-TOUCHING: Directory ~A is being added, but it already exists." filename)
105     (values patch filename))
106    (:backwards
107     ;; Before this patch, the directory didn't exist.
108     (values patch nil))))
109
110(defmethod find-touching ((patch rm-dir-patch) filename direction)
111  (ecase direction
112    (:forwards
113     ;; After this patch, the directory doesn't exist.
114     (values patch nil))
115    (:backwards
116     (warn "FIND-TOUCHING: Directory ~A was removed, but it still exists." filename)
117     (values patch filename))))
118
119(defmethod find-touching ((patch named-patch) filename direction)
120  (multiple-value-bind (touching-patch new-name)
121      (find-touching (named-patch-patch patch) filename direction)
122    (when touching-patch
123      (values
124       (make-instance 'named-patch 
125                      :patchinfo (named-patch-patchinfo patch)
126                      :dependencies (named-patch-dependencies patch)
127                      :patch touching-patch)
128       new-name))))
129
130(defmethod find-touching ((patch move-patch) filename direction)
131  (let ((from (patch-move-from patch))
132        (to (patch-move-to patch)))
133    (ecase direction
134      (:forwards
135       (when (equal filename from)
136         (values patch to)))
137      (:backwards
138       (when (equal filename to)
139         (values patch from))))))
Note: See TracBrowser for help on using the repository browser.