April 2005 - zip-cvs@common-lisp.net - mailman3.common-lisp.net

[zip-cvs] CVS update: zip/README.html zip/zip.lisp
by dlichteblau＠common-lisp.net 05 Apr '05

05 Apr '05

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

1 0

[zip-cvs] CVS update: zip/zip.lisp
by dlichteblau＠common-lisp.net 05 Apr '05

05 Apr '05

Update of /project/zip/cvsroot/zip In directory common-lisp.net:/tmp/cvs-serv17335 Modified Files: zip.lisp Log Message: fixed unzip on allegro set version to 2.0 Date: Tue Apr 5 20:18:34 2005 Author: dlichteblau Index: zip/zip.lisp diff -u zip/zip.lisp:1.4 zip/zip.lisp:1.5 --- zip/zip.lisp:1.4 Tue Apr 5 17:04:33 2005 +++ zip/zip.lisp Tue Apr 5 20:18:33 2005 @@ -212,7 +212,9 @@ (defun open-zipfile (pathname &key (external-format (default-external-format))) (let* (#+allegro (excl:*locale* (excl:find-locale :latin1)) - (s (open pathname :element-type '(unsigned-byte 8)))) + (s (open pathname + #-allegro :element-type + #-allegro '(unsigned-byte 8)))) (unwind-protect (progn (seek-to-end-header s) @@ -290,7 +292,7 @@ (let ((header (zipwriter-entry-header e)) (entry (make-directory-entry))) (setf (cd/signature entry) #x02014b50) - (setf (cd/version-made-by entry) 0) ;dos compatible + (setf (cd/version-made-by entry) 20) ;version 2.0, fat (setf (cd/version-needed-to-extract entry) (file/version-needed-to-extract header)) (setf (cd/flags entry) (file/flags header))

1 0

[zip-cvs] CVS update: zip/README.html
by dlichteblau＠common-lisp.net 05 Apr '05

05 Apr '05

Update of /project/zip/cvsroot/zip In directory common-lisp.net:/tmp/cvs-serv8082 Modified Files: README.html Log Message: viewcvs link Date: Tue Apr 5 17:47:09 2005 Author: dlichteblau Index: zip/README.html diff -u zip/README.html:1.3 zip/README.html:1.4 --- zip/README.html:1.3 Tue Apr 5 17:43:00 2005 +++ zip/README.html Tue Apr 5 17:47:08 2005 @@ -60,7 +60,7 @@ <h2>Download</h2> <ul> <li>asdf-install: <pre>(asdf-install:install :zip)</pre></li> - <li>Anoncvs: + <li>Anoncvs (<a href="http://common-lisp.net/cgi-bin/viewcvs.cgi/zip/?cvsroot=zip">browse</a>): <pre>$ export CVSROOT=:pserver:anonymous@common-lisp.net:/project/zip/cvsroot $ cvs login Logging in to :pserver:anonymous@common-lisp.net:2401/project/zip/cvsroot

1 0

[zip-cvs] CVS update: zip/gray.lisp
by dlichteblau＠common-lisp.net 05 Apr '05

05 Apr '05

Update of /project/zip/cvsroot/zip In directory common-lisp.net:/tmp/cvs-serv7241 Modified Files: gray.lisp Log Message: missing lispworks fix Date: Tue Apr 5 17:44:54 2005 Author: dlichteblau Index: zip/gray.lisp diff -u zip/gray.lisp:1.1 zip/gray.lisp:1.2 --- zip/gray.lisp:1.1 Tue Apr 5 17:04:33 2005 +++ zip/gray.lisp Tue Apr 5 17:44:54 2005 @@ -5,7 +5,9 @@ (pos :initform 0 :accessor pos))) (defmethod stream-write-sequence - ((stream buffer-output-stream) seq &optional (start 0) end) + #+sbcl ((stream buffer-output-stream) seq &optional (start 0) end) + #+lispworks ((stream buffer-output-stream) seq start end) + #-(or sbcl lispworks) ... (replace (buf stream) :start1 (pos stream) :start2 start

1 0

[zip-cvs] CVS update: zip/README.html
by dlichteblau＠common-lisp.net 05 Apr '05

05 Apr '05

Update of /project/zip/cvsroot/zip In directory common-lisp.net:/tmp/cvs-serv7191 Modified Files: README.html Log Message: new release tarball Date: Tue Apr 5 17:43:00 2005 Author: dlichteblau Index: zip/README.html diff -u zip/README.html:1.2 zip/README.html:1.3 --- zip/README.html:1.2 Tue Apr 5 17:04:33 2005 +++ zip/README.html Tue Apr 5 17:43:00 2005 @@ -38,11 +38,23 @@ Written by David Lichteblau <david(a)lichteblau.com>. </p> <p> + Send bug reports to <a + href="mailto:zip-devel@common-lisp.net"><zip-devel(a)common-lisp.net></a> + (<a + href="http://common-lisp.net/cgi-bin/mailman/listinfo/zip-devel">list information</a>). + </p> + <p> Thanks to <a href="http://common-lisp.net">common-lisp.net</a> for hosting. </p> <p> Uses <a href="http://www.cliki.net/salza">salza</a> for compression. + </p> + + <h2>Recent changes</h2> + <p> + 2005-04-05: ACL fixes (thank to Edi Weitz). Lispworks port + (thanks to Sean Ross). </p> <h2>Download</h2>

1 0

[zip-cvs] CVS update: zip/gray.lisp zip/lispworks.lisp zip/LICENSE zip/README.html zip/acl.lisp zip/package.lisp zip/sbcl.lisp zip/zip.asd zip/zip.lisp
by dlichteblau＠common-lisp.net 05 Apr '05

05 Apr '05

Update of /project/zip/cvsroot/zip In directory common-lisp.net:/tmp/cvs-serv5309 Modified Files: LICENSE README.html acl.lisp package.lisp sbcl.lisp zip.asd zip.lisp Added Files: gray.lisp lispworks.lisp Log Message: merged Lispworks patch, thanks to Sean Ross Date: Tue Apr 5 17:04:33 2005 Author: dlichteblau Index: zip/LICENSE diff -u zip/LICENSE:1.1 zip/LICENSE:1.2 --- zip/LICENSE:1.1 Sun Apr 3 22:38:19 2005 +++ zip/LICENSE Tue Apr 5 17:04:33 2005 @@ -3,6 +3,7 @@ zip.lisp, sbcl.lisp, acl.lisp Copyright (c) 2004,2005 David Lichteblau <david(a)lichteblau.com> + Lizenz: (L)LGPL COMPRESS function taken from Zachary Beane's salza. Changes copyright (c) 2004 knowledgeTools Int. GmbH Index: zip/README.html diff -u zip/README.html:1.1 zip/README.html:1.2 --- zip/README.html:1.1 Sun Apr 3 22:38:19 2005 +++ zip/README.html Tue Apr 5 17:04:33 2005 @@ -63,12 +63,13 @@ <h2>Portability</h2> <p> - Needs gray streams. Currently works out-of-the-box on SBCL and ACL. - Should be trivial to port to other Lisps. + Needs gray streams. Currently works out-of-the-box on SBCL, + Lispworks, and ACL. Should be trivial to port to other Lisps. </p> <p> - Handles Unicode characters in filenames on ACL (within the zip-file), is - waiting for someone to fix Unicode handling on SBCL. + Handles Unicode characters in filenames on ACL and Lispworks + (within the zip-file), is waiting for someone to fix Unicode + handling on SBCL. </p> <h2>ZIP-file reading</h2> Index: zip/acl.lisp diff -u zip/acl.lisp:1.2 zip/acl.lisp:1.3 --- zip/acl.lisp:1.2 Tue Apr 5 16:04:01 2005 +++ zip/acl.lisp Tue Apr 5 17:04:33 2005 @@ -1,5 +1,8 @@ (in-package :zip) +(defun default-external-format () + (excl:find-external-format :default)) + (defun octets-to-string (octets ef) (excl:octets-to-string octets :external-format ef)) Index: zip/package.lisp diff -u zip/package.lisp:1.1.1.1 zip/package.lisp:1.2 --- zip/package.lisp:1.1.1.1 Sun Apr 3 21:36:28 2005 +++ zip/package.lisp Tue Apr 5 17:04:33 2005 @@ -22,4 +22,13 @@ #:skip-gzip-header #:compress ;deflate.lisp - #:store)) + #:store) + #-allegro + (:import-from #+sbcl :sb-gray + #+lispworks :stream + #-(or sbcl lispworks) ... + #:fundamental-binary-output-stream + #:stream-write-sequence + #:fundamental-binary-input-stream + #:stream-read-byte + #:stream-read-sequence)) Index: zip/sbcl.lisp diff -u zip/sbcl.lisp:1.2 zip/sbcl.lisp:1.3 --- zip/sbcl.lisp:1.2 Sun Apr 3 22:41:37 2005 +++ zip/sbcl.lisp Tue Apr 5 17:04:33 2005 @@ -1,7 +1,12 @@ (in-package :zip) +;;;; FIXME + +(defun default-external-format () + :dummy) + (defun octets-to-string (octets ef) - (declare (ignore ef)) ;fixme + (declare (ignore ef)) (let* ((m (length octets)) (n (cond ((zerop m) 0) @@ -12,47 +17,9 @@ result)) (defun string-to-octets (string ef) - (declare (ignore ef)) ;fixme + (declare (ignore ef)) (let ((result (make-array (1+ (length string)) :element-type '(unsigned-byte 8) :initial-element 0))) (map-into result #'char-code string) - result)) - -(defclass buffer-output-stream (sb-gray:fundamental-binary-output-stream) - ((buf :initarg :buf :accessor buf) - (pos :initform 0 :accessor pos))) - -(defmethod sb-gray:stream-write-sequence - ((stream buffer-output-stream) seq &optional (start 0) end) - (replace (buf stream) - :start1 (pos stream) - :start2 start - :end2 end)) - -(defun make-buffer-output-stream (outbuf) - (make-instance 'buffer-output-stream :buf outbuf)) - -(defclass truncating-stream (sb-gray:fundamental-binary-input-stream) - ((input-handle :initarg :input-handle :accessor input-handle) - (size :initarg :size :accessor size) - (pos :initform 0 :accessor pos))) - -(defmethod sb-gray:stream-read-byte ((s truncating-stream)) - (if (< (pos s) (size s)) - (prog1 - (read-byte (input-handle s)) - (incf (pos s))) - nil)) - -(defmethod sb-gray:stream-read-sequence - ((s truncating-stream) seq &optional (start 0) (end (length seq))) - (let* ((n (- end start)) - (max (- (size s) (pos s))) - (result - (read-sequence (input-handle s) - seq - :start start - :end (+ start (min n max))))) - (incf (pos s) (- result start)) result)) Index: zip/zip.asd diff -u zip/zip.asd:1.1.1.1 zip/zip.asd:1.2 --- zip/zip.asd:1.1.1.1 Sun Apr 3 21:36:28 2005 +++ zip/zip.asd Tue Apr 5 17:04:33 2005 @@ -11,14 +11,17 @@ (defsystem :zip :default-component-class silent-source-file - :depends-on (:salza #+sbcl :sb-simple-streams) + :depends-on (:salza) :components ((:file "package") + #-allegro (:file "gray" :depends-on ("package")) (:file dependent :pathname #+sbcl "sbcl" #+allegro "acl" - #-(or sbcl allegro) #.(error "unsupported lisp") - :depends-on ("package")) + #+lispworks "lispworks" + #-(or sbcl allegro lispworks) + #.(error "unsupported lisp") + :depends-on ("package" #-allegro "gray")) (:file "ifstar" :depends-on ("package")) (:file "inflate" :depends-on ("package" "ifstar")) (:file "zip" :depends-on ("inflate" dependent)))) Index: zip/zip.lisp diff -u zip/zip.lisp:1.3 zip/zip.lisp:1.4 --- zip/zip.lisp:1.3 Tue Apr 5 16:04:30 2005 +++ zip/zip.lisp Tue Apr 5 17:04:33 2005 @@ -210,9 +210,7 @@ (cd/comment-length header)))))) (defun open-zipfile - (pathname &key (external-format - #+allegro (excl:find-external-format :default) - #-allegro :dummy)) + (pathname &key (external-format (default-external-format))) (let* (#+allegro (excl:*locale* (excl:find-locale :latin1)) (s (open pathname :element-type '(unsigned-byte 8)))) (unwind-protect @@ -359,9 +357,7 @@ (defun make-zipfile-writer (pathname &key (if-exists :error) - (external-format - #+allegro (excl:find-external-format :default) - #-allegro :dummy)) + (external-format (default-external-format))) (let (#+allegro (excl:*locale* (excl:find-locale :latin1)) (c (cons nil nil))) (make-zipwriter @@ -414,29 +410,32 @@ (defun directoryp (pathname) #+allegro (excl:file-directory-p pathname) - #-allegro (and (null (pathname-name pathname)) - (null (pathname-type pathname)))) + #+lispworks (lispworks:file-directory-p pathname) + #-(or lispworks allegro) + (and (null (pathname-name pathname)) + (null (pathname-type pathname)))) (defun zip (pathname source-directory &key (if-exists :error)) - (with-output-to-zipfile (zip pathname :if-exists if-exists) - (labels ((recurse (d) - (dolist (f #+allegro (directory d :directories-are-files nil) - #-allegro (directory d)) - (cond - ((directoryp f) - (write-zipentry - zip - (enough-namestring (namestring f) source-directory) - (make-concatenated-stream)) - (recurse #+allegro f - #-allegro (make-pathname - :name :wild - :type :wild - :defaults f))) - ((or (pathname-name f) (pathname-type f)) - (with-open-file (s f :element-type '(unsigned-byte 8)) + (let ((base (directory-namestring source-directory))) + (with-output-to-zipfile (zip pathname :if-exists if-exists) + (labels ((recurse (d) + (dolist (f #+allegro (directory d :directories-are-files nil) + #-allegro (directory d)) + (cond + ((directoryp f) (write-zipentry zip - (enough-namestring (namestring f) source-directory) - s))))))) - (recurse source-directory)))) + (enough-namestring (namestring f) base) + (make-concatenated-stream)) + (recurse #+allegro f + #-allegro (make-pathname + :name :wild + :type :wild + :defaults f))) + ((or (pathname-name f) (pathname-type f)) + (with-open-file (s f :element-type '(unsigned-byte 8)) + (write-zipentry + zip + (enough-namestring (namestring f) base) + s))))))) + (recurse source-directory)))))

1 0

[zip-cvs] CVS update: zip/zip.lisp
by dlichteblau＠common-lisp.net 05 Apr '05

05 Apr '05

Update of /project/zip/cvsroot/zip In directory common-lisp.net:/tmp/cvs-serv1848 Modified Files: zip.lisp Log Message: don't call salza functions for empty subsequences (thanks to Edi Weitz for the bugreport) Date: Tue Apr 5 16:04:31 2005 Author: dlichteblau Index: zip/zip.lisp diff -u zip/zip.lisp:1.2 zip/zip.lisp:1.3 --- zip/zip.lisp:1.2 Sun Apr 3 22:42:01 2005 +++ zip/zip.lisp Tue Apr 5 16:04:30 2005 @@ -133,12 +133,14 @@ :callback #'flush-stream))) (loop (let ((end (read-sequence input-buffer input))) - (salza:zlib-write-sequence input-buffer zlib-stream :end end) - (incf nin end) - (setf crc (update-crc crc input-buffer end)) - (when (zerop end) - (salza:finish-zlib-stream zlib-stream) - (return (values nin nout crc))))))))) + (cond + ((plusp end) + (salza:zlib-write-sequence input-buffer zlib-stream :end end) + (incf nin end) + (setf crc (update-crc crc input-buffer end))) + (t + (salza:finish-zlib-stream zlib-stream) + (return (values nin nout crc)))))))))) (defun store (in out) "Copy uncompressed bytes from IN to OUT and return values like COMPRESS."

1 0

[zip-cvs] CVS update: zip/acl.lisp
by dlichteblau＠common-lisp.net 05 Apr '05

05 Apr '05

Update of /project/zip/cvsroot/zip In directory common-lisp.net:/tmp/cvs-serv1823 Modified Files: acl.lisp Log Message: fixed typo (thanks to Edi Weitz) Date: Tue Apr 5 16:04:01 2005 Author: dlichteblau Index: zip/acl.lisp diff -u zip/acl.lisp:1.1.1.1 zip/acl.lisp:1.2 --- zip/acl.lisp:1.1.1.1 Sun Apr 3 21:36:28 2005 +++ zip/acl.lisp Tue Apr 5 16:04:01 2005 @@ -4,7 +4,7 @@ (excl:octets-to-string octets :external-format ef)) (defun string-to-octets (string ef) - (excl:string-to-octets octets :external-format ef)) + (excl:string-to-octets string :external-format ef)) (defun make-buffer-output-stream (outbuf) (excl:make-buffer-output-stream outbuf))

1 0

[zip-cvs] CVS update: zip/inflate.lisp zip/zip.lisp
by dlichteblau＠common-lisp.net 03 Apr '05

03 Apr '05

Update of /project/zip/cvsroot/zip In directory common-lisp.net:/tmp/cvs-serv15091 Modified Files: inflate.lisp zip.lisp Log Message: removed useless SUBSEQ Date: Sun Apr 3 22:42:01 2005 Author: dlichteblau Index: zip/inflate.lisp diff -u zip/inflate.lisp:1.1.1.1 zip/inflate.lisp:1.2 --- zip/inflate.lisp:1.1.1.1 Sun Apr 3 21:36:28 2005 +++ zip/inflate.lisp Sun Apr 3 22:42:01 2005 @@ -21,7 +21,7 @@ ;; Suite 330, Boston, MA 02111-1307 USA ;; ;; -;; $Id: inflate.lisp 10524 2004-10-11 15:25:33Z david $ +;; $Id: inflate.lisp,v 1.1.1.1 2005/04/03 19:36:28 dlichteblau Exp $ ;; Description: ;; inflate a stream of bytes which was compressed with the Deflate Index: zip/zip.lisp diff -u zip/zip.lisp:1.1.1.1 zip/zip.lisp:1.2 --- zip/zip.lisp:1.1.1.1 Sun Apr 3 21:36:28 2005 +++ zip/zip.lisp Sun Apr 3 22:42:01 2005 @@ -120,13 +120,13 @@ (crc 0)) (flet ((flush-stream (zlib-stream) (let ((start (if (zerop nout) 2 0)) - (end (salza::zlib-stream-position zlib-stream))) + (end (salza:zlib-stream-position zlib-stream))) (write-sequence (salza::zlib-stream-buffer zlib-stream) output :start start :end end) (incf nout (- end start)) - (setf (salza::zlib-stream-position zlib-stream) 0)))) + (setf (salza:zlib-stream-position zlib-stream) 0)))) (let* ((input-buffer (make-array 8192 :element-type '(unsigned-byte 8))) (output-buffer (make-array 8192 :element-type '(unsigned-byte 8))) (zlib-stream (salza:make-zlib-stream output-buffer @@ -135,12 +135,7 @@ (let ((end (read-sequence input-buffer input))) (salza:zlib-write-sequence input-buffer zlib-stream :end end) (incf nin end) - (let - ;; fixme - ((b (if (eql end (length input-buffer)) - input-buffer - (subseq input-buffer 0 end)))) - (setf crc (update-crc crc b))) + (setf crc (update-crc crc input-buffer end)) (when (zerop end) (salza:finish-zlib-stream zlib-stream) (return (values nin nout crc))))))))) @@ -152,17 +147,13 @@ :element-type '(unsigned-byte 8))) (ntotal 0) (crc 0)) - ;; Compute CRC using R. Matthew Emerson's Lisp implementation instead of - ;; zlib's CRC function, since STORE is (only) useful in the absence of - ;; zlib anyway. (loop for n = (read-sequence buf in :end (length buf)) until (zerop n) do (write-sequence buf out :end n) (incf ntotal n) - (let ((b (if (eql n (length buf)) buf (subseq buf 0 n)))) - (setf crc (update-crc crc b)))) + (setf crc (update-crc crc buf n))) (values ntotal ntotal crc))) (defun seek-to-end-header (s)

1 0

[zip-cvs] CVS update: zip/sbcl.lisp
by dlichteblau＠common-lisp.net 03 Apr '05

03 Apr '05

Update of /project/zip/cvsroot/zip In directory common-lisp.net:/tmp/cvs-serv15067 Modified Files: sbcl.lisp Log Message: fixed stream-read-sequence method Date: Sun Apr 3 22:41:37 2005 Author: dlichteblau Index: zip/sbcl.lisp diff -u zip/sbcl.lisp:1.1.1.1 zip/sbcl.lisp:1.2 --- zip/sbcl.lisp:1.1.1.1 Sun Apr 3 21:36:28 2005 +++ zip/sbcl.lisp Sun Apr 3 22:41:37 2005 @@ -47,9 +47,12 @@ (defmethod sb-gray:stream-read-sequence ((s truncating-stream) seq &optional (start 0) (end (length seq))) - (let ((n (- end start)) - (max (- (size s) (pos s)))) - (read-sequence (input-handle s) - seq - :start start - :end (+ start (min n max))))) + (let* ((n (- end start)) + (max (- (size s) (pos s))) + (result + (read-sequence (input-handle s) + seq + :start start + :end (+ start (min n max))))) + (incf (pos s) (- result start)) + result))

1 0