[zip-cvs] CVS update: zip/README.html zip/zip.lisp
David Lichteblau
dlichteblau at common-lisp.net
Tue Apr 5 19:31:14 UTC 2005
Update of /project/zip/cvsroot/zip
In directory common-lisp.net:/tmp/cvs-serv21945
Modified Files:
README.html zip.lisp
Log Message:
store file-write-date
Date: Tue Apr 5 21:31:13 2005
Author: dlichteblau
Index: zip/README.html
diff -u zip/README.html:1.4 zip/README.html:1.5
--- zip/README.html:1.4 Tue Apr 5 17:47:08 2005
+++ zip/README.html Tue Apr 5 21:31:13 2005
@@ -54,7 +54,8 @@
<h2>Recent changes</h2>
<p>
2005-04-05: ACL fixes (thank to Edi Weitz). Lispworks port
- (thanks to Sean Ross).
+ (thanks to Sean Ross). Store <tt>file-write-date</tt> (also fixes
+ FilZip compatibility).
</p>
<h2>Download</h2>
@@ -148,11 +149,14 @@
<p>
</p>
- <div class="def">Function WRITE-ZIPENTRY (zipwriter name data)</div>
+ <div class="def">Function WRITE-ZIPENTRY (zipwriter name data &key file-write-date)</div>
<p>
Append a new entry called <tt>name</tt> to <tt>zipwriter</tt>.
Read data from <tt>(unsigned-byte 8)</tt> stream <tt>data</tt>
until EOF and compress it into "deflate"-format.
+ Use <tt>file-write-date</tt> as the entry's date and time.
+ Default to <tt>(file-write-date data)</tt>, use 1980-01-01T00:00
+ if <tt>nil</tt>.
</p>
<div class="def">Function ZIP (pathname source-directory &key if-exists)</div>
@@ -160,6 +164,11 @@
Compress all files in <tt>source-directory</tt> recursively into a
new zip archive at <tt>pathname</tt>. Note that entry file names
will not contain the name <tt>source-directory</tt>.
+ </p>
+
+ <h2>Bookmark</h2>
+ <p>
+ <a href="http://www.pkware.com/company/standards/appnote/appnote.txt">spec</a>
</p>
</body>
</html>
Index: zip/zip.lisp
diff -u zip/zip.lisp:1.5 zip/zip.lisp:1.6
--- zip/zip.lisp:1.5 Tue Apr 5 20:18:33 2005
+++ zip/zip.lisp Tue Apr 5 21:31:13 2005
@@ -244,7 +244,8 @@
(defmethod get-zipfile-entry (name (zipfile zipfile))
(gethash name (zipfile-entries zipfile)))
-(defun write-zipentry (z name data)
+(defun write-zipentry
+ (z name data &key (file-write-date (file-write-date data)))
(setf name (substitute #\/ #\\ name))
(let* (#+allegro (excl:*locale* (excl:find-locale :latin1))
(s (zipwriter-stream z))
@@ -258,9 +259,13 @@
(setf (file/version-needed-to-extract header) 2) ;XXX ist das 2.0?
(setf (file/flags header) 8) ;bit 3: descriptor folgt nach daten
(setf (file/method header) 8)
- (setf (file/time header) 0) ;XXX fixme
- (setf (file/date header) 0) ;XXX fixme
- (setf (file/crc header) 0)
+ (multiple-value-bind (s min h d m y)
+ (decode-universal-time
+ (or file-write-date (encode-universal-time 0 0 0 1 1 1980 0)))
+ (setf (file/time header)
+ (logior (ash h 11) (ash min 5) (ash s -1)))
+ (setf (file/date header)
+ (logior (ash (- y 1980) 9) (ash m 5) d)))
(setf (file/compressed-size header) 0)
(setf (file/size header) 0)
(setf (file/name-length header) (length utf8-name))
@@ -428,7 +433,8 @@
(write-zipentry
zip
(enough-namestring (namestring f) base)
- (make-concatenated-stream))
+ (make-concatenated-stream)
+ :file-write-date (file-write-date f))
(recurse #+allegro f
#-allegro (make-pathname
:name :wild
More information about the Zip-cvs
mailing list