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)))