1 | ;;; Copyright (C) 2006, 2007 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? |
---|
20 | (defstruct patchinfo |
---|
21 | date name author log inverted) |
---|
22 | |
---|
23 | ;; make_filename in PatchInfo.lhs |
---|
24 | (defun patchinfo-make-filename (patchinfo) |
---|
25 | (with-slots (date name author log inverted) patchinfo |
---|
26 | (labels ((sha1-internal (bytes) |
---|
27 | (ironclad:digest-sequence :sha1 bytes)) |
---|
28 | (sha1 (str) |
---|
29 | (ironclad:byte-array-to-hex-string |
---|
30 | (sha1-internal |
---|
31 | (ironclad:ascii-string-to-byte-array str))))) |
---|
32 | (concatenate 'string |
---|
33 | ;; the original code uses cleanDate... but why? |
---|
34 | date |
---|
35 | "-" |
---|
36 | (subseq (sha1 author) 0 5) |
---|
37 | "-" |
---|
38 | (sha1 |
---|
39 | (concatenate |
---|
40 | 'string |
---|
41 | name author date |
---|
42 | (apply #'concatenate 'string log) |
---|
43 | (if inverted "t" "f"))) |
---|
44 | ".gz")))) |
---|
45 | |
---|
46 | ;; readPatchInfo in PatchInfo.lhs |
---|
47 | (defun read-patchinfo (stream) |
---|
48 | "Read a patch id from STREAM. |
---|
49 | Return NIL if none found due to EOF." |
---|
50 | ;; skip whitespace |
---|
51 | (let ((c |
---|
52 | (loop for c = (read-byte stream nil :eof) |
---|
53 | while (and (not (eql c :eof)) (isspace c)) |
---|
54 | finally (return c)))) |
---|
55 | (cond |
---|
56 | ;; EOF? |
---|
57 | ((eql c :eof) |
---|
58 | (return-from read-patchinfo nil)) |
---|
59 | ;; First character must be [ |
---|
60 | ((eql c (char-code #\[)) |
---|
61 | ) |
---|
62 | (t |
---|
63 | (error "~S is not #\\[, no patchinfo read." (code-char c))))) |
---|
64 | |
---|
65 | (let ( ;; Now, the rest of the line is the name. |
---|
66 | (name (read-binary-line stream)) |
---|
67 | ;; And up to * is the author. |
---|
68 | (author (read-until (char-code #\*) stream)) |
---|
69 | ;; Next character is '*' (normal patch) or '-' (inverted patch) |
---|
70 | (inverted (eql (read-byte stream) (char-code #\-)))) |
---|
71 | ;; Up to end of line (modulo possible ]) is date |
---|
72 | (multiple-value-bind (date char) (read-until (list 10 (char-code #\])) stream) |
---|
73 | ;; If char is #\] here, we have no log. Else, the log is the |
---|
74 | ;; following lines starting with a space. The line after the |
---|
75 | ;; log starts with #\]. We should remove the space in front of |
---|
76 | ;; each line. We need bit-by-bit quality, since the log is used |
---|
77 | ;; for hashing later. |
---|
78 | (dformat "~&Date terminated by ~A." char) |
---|
79 | (let ((log (when (/= char (char-code #\])) |
---|
80 | (loop |
---|
81 | for line = (read-binary-line stream) |
---|
82 | until (= (elt line 0) (char-code #\])) |
---|
83 | do (dformat "~&Got line ~S." line) |
---|
84 | do (when (or (zerop (length line)) |
---|
85 | (/= (elt line 0) 32)) |
---|
86 | (error "Malformed log line ~S." line)) |
---|
87 | collect (bytes-to-string (subseq line 1)) |
---|
88 | finally (unread-line stream (subseq line 1)))))) ;discard #\] |
---|
89 | (make-patchinfo :date (bytes-to-string date) |
---|
90 | :name (bytes-to-string name) |
---|
91 | :author (bytes-to-string author) |
---|
92 | :log log |
---|
93 | :inverted inverted))))) |
---|
94 | |
---|
95 | (defun write-patchinfo (patchinfo stream) |
---|
96 | "Write PATCHINFO to STREAM." |
---|
97 | (write-char #\[ stream) |
---|
98 | (write-line (patchinfo-name patchinfo) stream) |
---|
99 | (write-string (patchinfo-author patchinfo) stream) |
---|
100 | (write-string (if (patchinfo-inverted patchinfo) |
---|
101 | "*-" |
---|
102 | "**") |
---|
103 | stream) |
---|
104 | (write-string (patchinfo-date patchinfo) stream) |
---|
105 | (when (patchinfo-log patchinfo) |
---|
106 | (terpri stream) |
---|
107 | (dolist (log (patchinfo-log patchinfo)) |
---|
108 | (write-char #\Space stream) |
---|
109 | (write-line log stream))) |
---|
110 | (write-string "] " stream)) |
---|
111 | |
---|
112 | (defun invert-patchinfo (patchinfo) |
---|
113 | "Make a copy of PATCHINFO with the inverted flag toggled." |
---|
114 | (let ((copy (copy-patchinfo patchinfo))) |
---|
115 | (setf (patchinfo-inverted copy) |
---|
116 | (not (patchinfo-inverted copy))) |
---|
117 | copy)) |
---|
118 | |
---|
119 | (defmethod print-object ((patchinfo patchinfo) stream) |
---|
120 | (print-unreadable-object (patchinfo stream) |
---|
121 | (format stream "~A ~A (~A)" (patchinfo-date patchinfo) |
---|
122 | (patchinfo-name patchinfo) |
---|
123 | (patchinfo-author patchinfo)))) |
---|