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

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

Add commute methods for composite patches

File size: 4.3 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 :darcs)
18
19(defgeneric commute (p2 p1)
20  (:documentation "Attempt to commute the patches P2 and P1.
21Return a list, (P1-NEW P2-NEW), such that applying P2-NEW and then
22P1-NEW has the same effect as applying P1 and then P2.
23If commutations fails, return nil."))
24
25(defmethod commute ((p2 patch) (p1 patch))
26  "Default method prints a warning and returns nil."
27  (warn "No method defined for commuting ~A and ~A." p2 p1)
28  nil)
29
30(defmethod commute :around ((p2 file-patch) (p1 file-patch))
31  "If P1 and P2 change different files, commutation is trivial."
32  (let ((p1-file (patch-filename p1))
33        (p2-file (patch-filename p2)))
34    (if (not (equal p1-file p2-file))
35        (list p1 p2)
36        (call-next-method))))
37
38(defmethod commute ((p2 hunk-patch) (p1 hunk-patch))
39  "Attempt to commute the two hunk patches P1 and P2."
40  (assert (equal (patch-filename p1) (patch-filename p2)))
41  (with-accessors ((line1 hunk-line-number)
42                   (old1 hunk-old-lines)
43                   (new1 hunk-new-lines)) p1
44    (with-accessors ((line2 hunk-line-number)
45                      (old2 hunk-old-lines)
46                      (new2 hunk-new-lines)) p2
47      (cond
48        ((< (+ line1 (length new1)) line2)
49         ;; The first patch changes text before the second patch.
50         (list p1
51               (make-instance 'hunk-patch :filename (patch-filename p2)
52                              :line-number (+ line2 (- (length new1)) (length old1))
53                              :old old2 :new new2)))
54        ((< (+ line2 (length old2) line1))
55         ;; The second patch changes text before the first patch.
56         (list (make-instance 'hunk-patch :filename (patch-filename p1)
57                              :line-number (+ line1 (length new2) (- (length old2)))
58                              :old old1 :new new1)
59               p2))
60        ((and (= (+ line1 (length new1)) line2)
61              (notany #'zerop
62                      (mapcar #'length (list old1 old2 new1 new2))))
63         ;; The first patch goes exactly until the beginning of the second patch.
64         (list p1
65               (make-instance 'hunk-patch :filename (patch-filename p2)
66                              :line-number (+ line2 (- (length new1)) (length old1))
67                              :old old2 :new new2)))
68        ((and (= (+ line2 (length old2)) line1)
69              (notany #'zerop
70                      (mapcar #'length (list old1 old2 new1 new2))))
71         ;; The second patch goes exactly until the beginning of the first patch.
72         (list (make-instance 'hunk-patch :filename (patch-filename p1)
73                              :line-number (+ line1 (length new2) (- (length old2)))
74                              :old old1 :new new1)
75               p2))
76        (t
77         ;; In other cases, there is no failsafe way to commute the
78         ;; patches, so we give up.
79         nil)))))
80
81(defmethod commute ((p2 composite-patch) (p1 patch))
82  (cond
83    ;; Simple case first...
84    ((null (patches p2))
85     (list p1 p2))
86    (t
87     ;; Now, p1 was committed before all the patches in p2, and we
88     ;; want it to come after.
89     (let ((p2s (patches p2))
90           p2s-new)
91       (loop for p in p2s
92          do (destructuring-bind (&optional p1-new p-new)
93                 (commute p p1)
94               (cond
95                 ((null p1-new)
96                  (return-from commute (call-next-method)))
97                 (t
98                  (setf p1 p1-new)
99                  (push p-new p2s-new)))))
100       (list p1 (make-instance 'composite-patch :patches (nreverse p2s-new)))))))
101(defmethod commute ((p2 patch) (p1 composite-patch))
102  (cond
103    ((null (patches p1))
104     (list p1 p2))
105    (t
106     ;; p2 was committed after all the patches in p1.  Thus we start
107     ;; backwards in p1, commuting p2 with each of the patches.
108     (let ((p1s (reverse (patches p1)))
109           p1s-new)
110       (loop for p in p1s
111          do (destructuring-bind (&optional p-new p2-new)
112                 (commute p2 p)
113               (cond
114                 ((null p-new)
115                  (return-from commute (call-next-method)))
116                 (t
117                  (setf p2 p2-new)
118                  (push p-new p1s-new)))))
119       (list (make-instance 'composite-patch :patches p1s-new)
120             p2)))))
Note: See TracBrowser for help on using the repository browser.