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