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

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

Unquote type declarations.

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