source: cl-darcs/trunk/invert-patch.lisp

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

Start hacking merger unwinding

File size: 3.2 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 invert-patch (patch)
20  (:documentation "Create a patch that is the inverse of PATCH."))
21
22(defmethod invert-patch ((patch named-patch))
23  (make-instance 'named-patch
24                 :patchinfo (invert-patchinfo (named-patch-patchinfo patch))
25                 :dependencies (mapcar #'invert-patchinfo
26                                       (named-patch-dependencies patch))
27                 :patch (invert-patch (named-patch-patch patch))))
28
29(defmethod invert-patch ((patch change-pref-patch))
30  (make-instance 'change-pref-patch :pref (change-pref-which patch)
31                 :from (change-pref-to patch)
32                 :to (change-pref-from patch)))
33
34(defmethod invert-patch ((patch move-patch))
35  (make-instance 'move-patch :from (patch-move-to patch)
36                 :to (patch-move-from patch)))
37
38(defmethod invert-patch ((patch composite-patch))
39  (make-instance 'composite-patch
40                 :patches (mapcar #'invert-patch
41                                  (reverse (patches patch)))))
42
43(defmethod invert-patch ((patch split-patch))
44  (make-instance 'split-patch
45                 :patches (mapcar #'invert-patch
46                                  (reverse (patches patch)))))
47
48(defmethod invert-patch :around ((patch file-patch))
49  (let ((inverted-patch (call-next-method)))
50    (setf (patch-filename inverted-patch) (patch-filename patch))
51    inverted-patch))
52
53(defmethod invert-patch ((patch hunk-patch))
54  (make-instance 'hunk-patch
55                 :line-number (hunk-line-number patch)
56                 :old (hunk-new-lines patch)
57                 :new (hunk-old-lines patch)))
58
59(defmethod invert-patch ((patch add-file-patch))
60  (make-instance 'rm-file-patch))
61
62(defmethod invert-patch ((patch rm-file-patch))
63  (make-instance 'add-file-patch))
64
65(defmethod invert-patch ((patch binary-patch))
66  (make-instance 'binary-patch
67                 :oldhex (binary-newhex patch)
68                 :newhex (binary-oldhex patch)))
69
70(defmethod invert-patch ((patch token-replace-patch))
71  (make-instance 'token-replace-patch
72                 :regexp (token-regexp patch)
73                 :old-token (old-token patch)
74                 :new-token (new-token patch)))
75
76(defmethod invert-patch :around ((patch directory-patch))
77  (let ((inverted-patch (call-next-method)))
78    (setf (patch-directory inverted-patch) (patch-directory patch))
79    inverted-patch))
80
81(defmethod invert-patch ((patch add-dir-patch))
82  (make-instance 'rm-dir-patch))
83
84(defmethod invert-patch ((patch rm-dir-patch))
85  (make-instance 'add-dir-patch))
86
87(defmethod invert-patch ((patch merger-patch))
88  (make-instance 'merger-patch
89                 :version (merger-version patch)
90                 :first (merger-first patch)
91                 :second (merger-second patch)
92                 :undo (merger-undo patch)
93                 :unwindings (unwind patch)
94                 :inverted (not (merger-inverted patch))))
Note: See TracBrowser for help on using the repository browser.