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

Last change on this file was 154, checked in by Magnus Henoch, 14 years ago

Write directory patches without trailing slash

File size: 5.8 KB
Line 
1;;; Copyright (C) 2006, 2008 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(defun write-patch-to-repo (patch repo)
20  "Write the named patch PATCH to REPO, compressed, under correct filename."
21  (let ((filename
22         (upath-subdir repo '("_darcs" "patches")
23                       (patchinfo-make-filename 
24                        (named-patch-patchinfo patch)))))
25    (with-temp-file-name tmp-file
26      (with-open-file (out tmp-file :direction :output :element-type '(unsigned-byte 8)
27                           :if-exists :error)
28        (write-patch patch out))
29      (compress-file tmp-file filename))))
30
31(defgeneric write-patch (patch stream)
32  (:documentation "Write PATCH to STREAM, in darcs patch format.
33STREAM is assumed to have element type (unsigned-byte 8).
34The patch is terminated by a newline character."))
35
36(defun write-as-byte (char stream)
37  "Convert CHAR to a byte, and write it to STREAM."
38  (write-byte (char-code char) stream))
39
40(defun write-as-bytes (string stream)
41  "Convert STRING to bytes, and write it to STREAM."
42  (write-sequence (string-to-bytes string) stream))
43
44(defmethod write-patch ((patch composite-patch) stream)
45  (write-as-byte #\{ stream)
46  (write-byte 10 stream)
47  (dolist (part (patches patch))
48    (write-patch part stream))
49  (write-as-byte #\} stream)
50  (write-byte 10 stream))
51
52(defmethod write-patch ((patch hunk-patch) stream)
53  (write-as-bytes (concatenate
54                   'string
55                   "hunk "
56                   (pathname-to-string (patch-filename patch))
57                   (format nil " ~A" (hunk-line-number patch)))
58                  stream)
59  (write-byte 10 stream)
60  (dolist (line (hunk-old-lines patch))
61    (write-as-byte #\- stream)
62    (write-sequence line stream)
63    (write-byte 10 stream))
64  (dolist (line (hunk-new-lines patch))
65    (write-byte (char-code #\+) stream)
66    (write-sequence line stream)
67    (write-byte 10 stream)))
68
69(defun write-token-and-filename (token filename stream)
70  (write-as-bytes token stream)
71  (write-byte 32 stream)
72  ;; Both files and directories are specified in file format,
73  ;; i.e. without a trailing slash.
74  (write-as-bytes (pathname-to-string (fad:pathname-as-file filename)) stream)
75  (write-byte 10 stream))
76
77(defmethod write-patch ((patch add-file-patch) stream)
78  (write-token-and-filename "addfile" (patch-filename patch) stream))
79
80(defmethod write-patch ((patch rm-file-patch) stream)
81  (write-token-and-filename "rmfile" (patch-filename patch) stream))
82
83(defmethod write-patch ((patch add-dir-patch) stream)
84  (write-token-and-filename "adddir" (patch-directory patch) stream))
85
86(defmethod write-patch ((patch rm-dir-patch) stream)
87  (write-token-and-filename "rmdir" (patch-directory patch) stream))
88
89(defmethod write-patch ((patch binary-patch) stream)
90  (write-token-and-filename "binary" (patch-filename patch) stream)
91  (flet ((write-binary-data (bin)
92           ;; Print binary data in hex format, with 78 characters per
93           ;; line.  Each lines starts with *.  A newline is printed
94           ;; at the start, but not at the end.
95           (loop for i from 0 upto (length bin)
96              do (when (zerop (mod i 49))
97                   (write-byte 10 stream)
98                   (write-as-byte #\* stream))
99                (write-as-bytes (string-downcase
100                                 (format nil "~X" (aref bin i)))
101                                stream))))
102    (write-as-bytes "oldhex" stream)
103    (write-binary-data (binary-oldhex patch))
104    (write-as-bytes "newhex" stream)
105    (write-binary-data (binary-newhex patch))
106    (write-byte 10 stream)))
107
108(defmethod write-patch ((patch token-replace-patch) stream)
109  (write-as-bytes (format nil "replace ~A [~A] ~A ~A"
110                          (pathname-to-string (patch-filename patch))
111                          (token-regexp patch)
112                          (old-token patch)
113                          (new-token patch))
114                  stream)
115  (write-byte 10 stream))
116 
117(defmethod write-patch ((patch named-patch) stream)
118  (write-as-bytes
119   (with-output-to-string (strout)
120     (write-patchinfo (named-patch-patchinfo patch) strout))
121   stream)
122  (when (named-patch-dependencies patch)
123    (write-as-byte #\< stream)
124    (write-byte 10 stream)
125    (dolist (d (named-patch-dependencies patch))
126      (write-as-bytes
127       (with-output-to-string (strout)
128         (write-patchinfo d strout))
129       stream)
130      (write-byte 10 stream))
131    (write-as-byte #\> stream)
132    (write-byte 32 stream))
133  (write-patch (named-patch-patch patch) stream))
134
135(defmethod write-patch ((patch change-pref-patch) stream)
136  (write-as-bytes "changepref " stream)
137  (write-as-bytes (change-pref-which patch) stream)
138  (write-byte 10 stream)
139  (write-as-bytes (change-pref-from patch) stream)
140  (write-byte 10 stream)
141  (write-as-bytes (change-pref-to patch) stream)
142  (write-byte 10 stream))
143
144(defmethod write-patch ((patch move-patch) stream)
145  (write-sequence (string-to-bytes "move ") stream)
146  (write-sequence (string-to-bytes
147                   (pathname-to-string (patch-move-from patch)))
148                  stream)
149  (write-byte 32 stream)
150  (write-sequence (string-to-bytes
151                   (pathname-to-string
152                    (patch-move-to patch))) stream)
153  (write-byte 10 stream))
154
155(defmethod write-patch ((patch merger-patch) stream)
156  (write-as-bytes "merger " stream)
157  (write-as-bytes (merger-version patch) stream)
158  (write-as-bytes " (" stream)
159  (write-byte 10 stream)
160  (write-patch (merger-first patch) stream)
161  (write-patch (merger-second patch) stream)
162  (write-as-byte #\) stream)
163  (write-byte 10 stream))
Note: See TracBrowser for help on using the repository browser.