From dlichteblau at common-lisp.net Sun Apr 3 19:36:29 2005 From: dlichteblau at common-lisp.net (David Lichteblau) Date: Sun, 3 Apr 2005 21:36:29 +0200 (CEST) Subject: [zip-cvs] CVS update: Module imported: zip Message-ID: <20050403193629.9ED2B8866C@common-lisp.net> Update of /project/zip/cvsroot/zip In directory common-lisp.net:/tmp/cvs-serv9080 Log Message: initial import Status: Vendor Tag: dlichteblau Release Tags: start N zip/sbcl.lisp N zip/ifstar.lisp N zip/README N zip/zip.asd N zip/zip.lisp N zip/acl.lisp N zip/inflate.lisp N zip/package.lisp No conflicts created by this import Date: Sun Apr 3 21:36:29 2005 Author: dlichteblau New module zip added From dlichteblau at common-lisp.net Sun Apr 3 20:38:21 2005 From: dlichteblau at common-lisp.net (David Lichteblau) Date: Sun, 3 Apr 2005 22:38:21 +0200 (CEST) Subject: [zip-cvs] CVS update: zip/LICENSE zip/README.html zip/README Message-ID: <20050403203821.6E07A8866C@common-lisp.net> Update of /project/zip/cvsroot/zip In directory common-lisp.net:/tmp/cvs-serv15003 Added Files: LICENSE README.html Removed Files: README Log Message: README HTMLifiziert Date: Sun Apr 3 22:38:20 2005 Author: dlichteblau From dlichteblau at common-lisp.net Sun Apr 3 20:41:37 2005 From: dlichteblau at common-lisp.net (David Lichteblau) Date: Sun, 3 Apr 2005 22:41:37 +0200 (CEST) Subject: [zip-cvs] CVS update: zip/sbcl.lisp Message-ID: <20050403204137.0F4C58866C@common-lisp.net> 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)) From dlichteblau at common-lisp.net Sun Apr 3 20:42:02 2005 From: dlichteblau at common-lisp.net (David Lichteblau) Date: Sun, 3 Apr 2005 22:42:02 +0200 (CEST) Subject: [zip-cvs] CVS update: zip/inflate.lisp zip/zip.lisp Message-ID: <20050403204202.4FF8D8866C@common-lisp.net> 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) From dlichteblau at common-lisp.net Tue Apr 5 14:04:02 2005 From: dlichteblau at common-lisp.net (David Lichteblau) Date: Tue, 5 Apr 2005 16:04:02 +0200 (CEST) Subject: [zip-cvs] CVS update: zip/acl.lisp Message-ID: <20050405140402.6AAAA88665@common-lisp.net> 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)) From dlichteblau at common-lisp.net Tue Apr 5 14:04:31 2005 From: dlichteblau at common-lisp.net (David Lichteblau) Date: Tue, 5 Apr 2005 16:04:31 +0200 (CEST) Subject: [zip-cvs] CVS update: zip/zip.lisp Message-ID: <20050405140431.70CDE88665@common-lisp.net> 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." From dlichteblau at common-lisp.net Tue Apr 5 15:04:35 2005 From: dlichteblau at common-lisp.net (David Lichteblau) Date: Tue, 5 Apr 2005 17:04:35 +0200 (CEST) Subject: [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 Message-ID: <20050405150435.7511C88665@common-lisp.net> 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 + 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 @@

Portability

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

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

ZIP-file reading

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))))) From dlichteblau at common-lisp.net Tue Apr 5 15:43:00 2005 From: dlichteblau at common-lisp.net (David Lichteblau) Date: Tue, 5 Apr 2005 17:43:00 +0200 (CEST) Subject: [zip-cvs] CVS update: zip/README.html Message-ID: <20050405154300.AF9F888665@common-lisp.net> 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 at lichteblau.com>.

+ Send bug reports to <zip-devel at common-lisp.net> + (list information). +

+

Thanks to common-lisp.net for hosting.

Uses salza for compression. +

+ +

Recent changes

+

+ 2005-04-05: ACL fixes (thank to Edi Weitz). Lispworks port + (thanks to Sean Ross).

Download

From dlichteblau at common-lisp.net Tue Apr 5 15:44:54 2005 From: dlichteblau at common-lisp.net (David Lichteblau) Date: Tue, 5 Apr 2005 17:44:54 +0200 (CEST) Subject: [zip-cvs] CVS update: zip/gray.lisp Message-ID: <20050405154454.0507388665@common-lisp.net> 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 From dlichteblau at common-lisp.net Tue Apr 5 15:47:09 2005 From: dlichteblau at common-lisp.net (David Lichteblau) Date: Tue, 5 Apr 2005 17:47:09 +0200 (CEST) Subject: [zip-cvs] CVS update: zip/README.html Message-ID: <20050405154709.8EF6A88665@common-lisp.net> 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 @@

Download