source: cl-darcs/tags/0.1.0/patch-core.lisp

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

Start hacking merger unwinding

File size: 6.4 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(defclass patch ()
20  ())
21
22(defclass composite-patch (patch)
23  ((patches :accessor patches :initarg :patches :initform ()
24            :documentation "List of patches making up the composite patch.")))
25
26(defmethod print-object ((patch composite-patch) stream)
27  (if *print-readably*
28      (call-next-method)
29      (format stream "#<~A: ~W>"
30              (type-of patch) (patches patch))))
31
32(defclass split-patch (patch)
33  ((patches :accessor patches :initarg :patches :initform ())))
34
35(defclass file-patch (patch)
36  ((filename :accessor patch-filename :initarg :filename :type pathname))
37  (:documentation "Base class for patches affecting a single file."))
38
39(defmethod print-object ((patch file-patch) stream)
40  (if *print-readably* (call-next-method)
41      (format stream "#<~A: ~A>" (type-of patch) (patch-filename patch))))
42
43(defclass hunk-patch (file-patch)
44  ((line-number :accessor hunk-line-number :initarg :line-number
45                :documentation "Line number where hunk starts.") ;XXX: old or new?
46   (old :accessor hunk-old-lines :initarg :old
47        :documentation "The lines of the old version (list of strings)")
48   (new :accessor hunk-new-lines :initarg :new
49        :documentation "The lines of the new version (list of strings)"))
50  (:documentation "A single patch \"hunk\"."))
51
52(defmethod print-object ((patch hunk-patch) stream)
53  (if *print-readably* (call-next-method)
54      (format stream "#<~A: ~A ~A~[~:;~:*-~A~]~[~:;~:*+~A~]>"
55              (type-of patch) (patch-filename patch)
56              (hunk-line-number patch)
57              (length (hunk-old-lines patch))
58              (length (hunk-new-lines patch)))))
59
60(defclass add-file-patch (file-patch)
61  ()
62  (:documentation "A patch that creates a file."))
63
64(defclass rm-file-patch (file-patch)
65  ()
66  (:documentation "A patch that removes a file."))
67
68(defclass binary-patch (file-patch)
69  ((oldhex :accessor binary-oldhex :initarg :oldhex
70           :type '(vector (unsigned-byte 8))
71           :documentation "The old contents of the file.")
72   (newhex :accessor binary-newhex :initarg :newhex
73           :type '(vector (unsigned-byte 8))
74           :documentation "The new contents of the file."))
75  (:documentation "A patch that changes a binary file."))
76
77(defclass token-replace-patch (file-patch)
78  ((regexp :accessor token-regexp :initarg :regexp :type 'string)
79   (old-token :accessor old-token :initarg :old-token :type 'string)
80   (new-token :accessor new-token :initarg :new-token :type 'string))
81  (:documentation "A patch that replaces one token with another."))
82
83(defmethod print-object ((patch token-replace-patch) stream)
84  (if *print-readably* (call-next-method)
85      (format stream "#<~A: ~A: s/~A/~A/ (~S)>" (type-of patch) (patch-filename patch)
86              (old-token patch) (new-token patch)
87              (token-regexp patch))))
88
89(defclass directory-patch (patch)
90  ((directory :accessor patch-directory :initarg :directory))
91  (:documentation "Base class for patches affecting a directory."))
92
93(defmethod print-object ((patch directory-patch) stream)
94  (if *print-readably* (call-next-method)
95      (format stream "#<~A: ~A>" (type-of patch) (patch-directory patch))))
96
97(defclass add-dir-patch (directory-patch)
98  ()
99  (:documentation "A patch that creates a directory."))
100
101(defclass rm-dir-patch (directory-patch)
102  ()
103  (:documentation "A patch that removes a directory."))
104
105(defclass named-patch (patch)
106  ((patchinfo :accessor named-patch-patchinfo :initarg :patchinfo
107              :documentation "Metadata about this patch.")
108   (dependencies :accessor named-patch-dependencies :initarg :dependencies
109                 :documentation "List of patchinfo structures naming the dependencies of this patch.")
110   (patch :accessor named-patch-patch :initarg :patch
111          :documentation "The patch itself."))
112  (:documentation "A named patch."))    ;XXX: what does that mean?
113
114(defmethod print-object ((patch named-patch) stream)
115  (if *print-readably*
116      (call-next-method)
117      (let ((patchinfo (named-patch-patchinfo patch)))
118        (format stream "#<~A: ~A ~A: ~<~W~:>>"
119                (type-of patch)
120                (patchinfo-date patchinfo)
121                (patchinfo-name patchinfo)
122                (named-patch-patch patch)))))
123
124(defclass change-pref-patch (patch)
125  ((pref :initarg :pref :accessor change-pref-which)
126   (from :initarg :from :accessor change-pref-from)
127   (to :initarg :to :accessor change-pref-to))
128  (:documentation "A patch for changing a preference."))
129
130(defmethod print-object ((patch change-pref-patch) stream)
131  (if *print-readably*
132      (call-next-method)
133      (format stream "#<~A: ~A: s/~S/~S/>"
134              (type-of patch)
135              (change-pref-which patch)
136              (change-pref-from patch)
137              (change-pref-to patch))))
138
139(defclass move-patch (patch)
140  ((from :initarg :from :accessor patch-move-from)
141   (to :initarg :to :accessor patch-move-to))
142  (:documentation "A patch that moves a file."))
143
144(defmethod print-object ((patch move-patch) stream)
145  (if *print-readably*
146      (call-next-method)
147      (format stream "#<~A: ~A -> ~A>"
148              (type-of patch)
149              (patch-move-from patch)
150              (patch-move-to patch))))
151
152;; XXX: this class is probably incorrect and insufficient.
153(defclass merger-patch (patch)
154  ((version :initarg :version :accessor merger-version)
155   (first :initarg :first :accessor merger-first)
156   (second :initarg :second :accessor merger-second)
157   (inverted :initarg :inverted :accessor merger-inverted)
158   (undo :initarg :undo :accessor merger-undo)
159   (unwindings :initarg :unwindings :accessor merger-unwindings)))
160
161(defmethod print-object ((patch merger-patch) stream)
162  (if *print-readably*
163      (call-next-method)
164      (format stream "#<~A ~:[(inverted) ~;~]~A: ~A ~A>"
165              (type-of patch)
166              (merger-inverted patch)
167              (merger-version patch)
168              (merger-first patch)
169              (merger-second patch))))
170
171;; There are more kinds of patches... let's implement them when need
172;; arises.
Note: See TracBrowser for help on using the repository browser.