[zip-cvs] CVS zip

[dlichteblau]

Update of /project/zip/cvsroot/zip
In directory clnet:/tmp/cvs-serv9246

Modified Files:
	README.html package.lisp zip.lisp 
Log Message:
Comment support (Surendra Singhi)
clisp buglet (Klaus Weidner)


--- /project/zip/cvsroot/zip/README.html	2006/03/19 14:01:09	1.6
+++ /project/zip/cvsroot/zip/README.html	2006/06/10 13:58:56	1.7
@@ -60,12 +60,13 @@
 
     <h2>Recent changes</h2>
     <p>
-      2006-xx-yy: Fixed the gray stream port (including a data
-      corruption bug that was in CVS for some time).  Switched to
-      flexi-stream external-format functions for portability.  Uses
-      trivial-gray-streams now.  Allegro 8.0 fix.  Incompatible change:
-      Don't bind <tt>*locale*</tt> on Allegro anymore.  (Thanks to all
-      patch submitters).
+      2006-xx-yy: Fixed the gray stream port, including a data
+      corruption bug that was in CVS for some time.  (Thanks to Kevin
+      Reid and others.)  Switched to flexi-stream external-format
+      functions for portability.  Uses trivial-gray-streams now.
+      Allegro 8.0 fix (thanks to Edi Weitz).  Comment support (thanks
+      to Surendra Singhi).  Incompatible change: Don't bind
+      <tt>*locale*</tt> on Allegro anymore.
     <p>
     </p>
       2005-04-05: ACL fixes (thank to Edi Weitz).  Lispworks port
--- /project/zip/cvsroot/zip/package.lisp	2006/03/19 14:01:09	1.3
+++ /project/zip/cvsroot/zip/package.lisp	2006/06/10 13:58:56	1.4
@@ -10,6 +10,7 @@
 	   #:get-zipfile-entry
 	   #:zipfile-entry-name
            #:zipfile-entry-size
+           #:zipfile-entry-comment
 	   #:do-zipfile-entries
 	   #:zipfile-entry-contents
 	   #:unzip
--- /project/zip/cvsroot/zip/zip.lisp	2006/03/19 14:01:09	1.7
+++ /project/zip/cvsroot/zip/zip.lisp	2006/06/10 13:58:56	1.8
@@ -38,7 +38,9 @@
   (setf (elt array (+ offset 3)) (logand newval #xff))
   newval)
 
-(defmacro define-record (constructor (&key (length (gensym))) &rest fields)
+(defmacro define-record (constructor
+			 (&key (length #-clisp (gensym) #+clisp (gentemp)))
+			 &rest fields)
   `(progn
      (defconstant ,length
 	 ,(loop
@@ -180,7 +182,8 @@
   stream
   offset
   size
-  compressed-size)
+  compressed-size
+  comment)
 
 (defstruct zipwriter
   stream
@@ -196,19 +199,24 @@
 (defun read-entry-object (s external-format)
   (let* ((header (make-directory-entry s))
 	 (name (make-array (cd/name-length header)
-                           :element-type '(unsigned-byte 8))))
+                           :element-type '(unsigned-byte 8)))
+	 (comment
+	  (when (plusp (cd/comment-length header))
+	    (make-array (cd/comment-length header)
+			:element-type '(unsigned-byte 8)))))
     (assert (= (cd/signature header) #x02014b50))
     (read-sequence name s)
     (setf name (octets-to-string name external-format))
-    (prog1
-	(make-zipfile-entry :name name
-                            :stream s
-                            :offset (cd/offset header)
-                            :size (cd/size header)
-                            :compressed-size (cd/compressed-size header))
-      (file-position s (+ (file-position s)
-			  (cd/extra-length header)
-			  (cd/comment-length header))))))
+    (file-position s (+ (file-position s) (cd/extra-length header)))
+    (when comment
+      (read-sequence comment s)
+      (setf comment (octets-to-string comment external-format)))
+    (make-zipfile-entry :name name
+			:stream s
+			:offset (cd/offset header)
+			:size (cd/size header)
+			:compressed-size (cd/compressed-size header)
+			:comment comment)))
 
 (defun open-zipfile
     (pathname &key (external-format (default-external-format)))