source: cl-darcs/tags/0.1.0/patchinfo.lisp

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

Add print-object method for patchinfo structures

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