March 2006 - zip-cvs@common-lisp.net - mailman3.common-lisp.net

[zip-cvs] CVS zip
by dlichteblau 19 Mar '06

19 Mar '06

Update of /project/zip/cvsroot/zip In directory clnet:/tmp/cvs-serv10297 Modified Files: README.html acl.lisp gray.lisp package.lisp zip.asd zip.lisp Removed Files: lispworks.lisp sbcl.lisp Log Message: <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). + <p> --- /project/zip/cvsroot/zip/README.html 2005/04/05 19:31:13 1.5 +++ /project/zip/cvsroot/zip/README.html 2006/03/19 14:01:09 1.6 @@ -48,11 +48,26 @@ hosting. </p> <p> - Uses <a href="http://www.cliki.net/salza">salza</a> for compression. + Uses <a href="http://www.cliki.net/salza">salza</a> for + compression, <a + href="http://www.weitz.de/flexi-streams/">flexi-streams</a> for external + format support, <a + href="http://common-lisp.net/project/cl-plus-ssl/#trivial-gray-streams">trivial-gray-streams</a> + for gray streams portability, and includes <a + href="http://opensource.franz.com/deflate/">inflate.cl</a> + for decompression. </p> <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). + <p> + </p> 2005-04-05: ACL fixes (thank to Edi Weitz). Lispworks port (thanks to Sean Ross). Store <tt>file-write-date</tt> (also fixes FilZip compatibility). --- /project/zip/cvsroot/zip/acl.lisp 2006/03/14 21:48:43 1.4 +++ /project/zip/cvsroot/zip/acl.lisp 2006/03/19 14:01:09 1.5 @@ -1,3 +1,5 @@ +;;; native implementation of the portable functions in gray.lisp + (in-package :zip) (defun default-external-format () @@ -7,7 +9,9 @@ (excl:octets-to-string octets :external-format ef)) (defun string-to-octets (string ef) - (excl:string-to-octets string :external-format ef)) + (excl:string-to-octets string + :external-format ef + :null-terminate nil)) (defun make-buffer-output-stream (outbuf) (excl:make-buffer-output-stream outbuf)) --- /project/zip/cvsroot/zip/gray.lisp 2006/03/14 21:48:06 1.4 +++ /project/zip/cvsroot/zip/gray.lisp 2006/03/19 14:01:09 1.5 @@ -1,14 +1,34 @@ (in-package :zip) +(defun default-external-format () + :utf-8) + +(defun octets-to-string (octets ef) + (with-output-to-string (out) + (flexi-streams:with-input-from-sequence (in octets) + (let ((in* (flexi-streams:make-flexi-stream in :external-format ef))) + (loop + for c = (read-char in* nil nil) + while c + do (write-char c out)))))) + +(defun string-to-octets (string ef) + (flexi-streams:with-output-to-sequence (out) + (with-input-from-string (in string) + (let ((out* (flexi-streams:make-flexi-stream out :external-format ef))) + (loop + for c = (read-char in nil nil) + while c + do (write-char c out*)))))) + (defclass buffer-output-stream (fundamental-binary-output-stream) ((buf :initarg :buf :accessor buf) (pos :initform 0 :accessor pos))) (defmethod stream-write-sequence - #+sbcl ((stream buffer-output-stream) seq &optional (start 0) (end (length seq))) - #+lispworks ((stream buffer-output-stream) seq start end) - #-(or sbcl lispworks) ... - (replace (buf stream) seq + ((stream buffer-output-stream) seq start end &key) + (replace (buf stream) + seq :start1 (pos stream) :start2 start :end2 end) @@ -18,7 +38,8 @@ (defun make-buffer-output-stream (outbuf) (make-instance 'buffer-output-stream :buf outbuf)) -(defclass truncating-stream (fundamental-binary-input-stream) +(defclass truncating-stream + (trivial-gray-stream-mixin fundamental-binary-input-stream) ((input-handle :initarg :input-handle :accessor input-handle) (size :initarg :size :accessor size) (pos :initform 0 :accessor pos))) @@ -30,10 +51,7 @@ (incf (pos s))) nil)) -(defmethod stream-read-sequence - #+sbcl ((s truncating-stream) seq &optional (start 0) (end (length seq))) - #+lispworks ((s truncating-stream) seq start end) - #-(or sbcl lispworks) ... +(defmethod stream-read-sequence ((s truncating-stream) seq start end &key) (let* ((n (- end start)) (max (- (size s) (pos s))) (result --- /project/zip/cvsroot/zip/package.lisp 2005/04/05 15:04:33 1.2 +++ /project/zip/cvsroot/zip/package.lisp 2006/03/19 14:01:09 1.3 @@ -1,7 +1,7 @@ (in-package :cl-user) (defpackage :zip - (:use :cl) + (:use :cl #-allegro :trivial-gray-streams) (:export #:zipfile ;reading ZIP files #:open-zipfile #:close-zipfile @@ -22,13 +22,4 @@ #:skip-gzip-header #:compress ;deflate.lisp - #: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)) + #:store)) --- /project/zip/cvsroot/zip/zip.asd 2005/04/05 15:04:33 1.2 +++ /project/zip/cvsroot/zip/zip.asd 2006/03/19 14:01:09 1.3 @@ -11,17 +11,11 @@ (defsystem :zip :default-component-class silent-source-file - :depends-on (:salza) + :depends-on (:salza :trivial-gray-streams :flexi-streams) :components ((:file "package") - #-allegro (:file "gray" :depends-on ("package")) (:file dependent - :pathname - #+sbcl "sbcl" - #+allegro "acl" - #+lispworks "lispworks" - #-(or sbcl allegro lispworks) - #.(error "unsupported lisp") - :depends-on ("package" #-allegro "gray")) + :pathname #+allegro "acl" #-allegro "gray" + :depends-on ("package")) (:file "ifstar" :depends-on ("package")) (:file "inflate" :depends-on ("package" "ifstar")) (:file "zip" :depends-on ("inflate" dependent)))) --- /project/zip/cvsroot/zip/zip.lisp 2005/04/05 19:31:13 1.6 +++ /project/zip/cvsroot/zip/zip.lisp 2006/03/19 14:01:09 1.7 @@ -1,10 +1,11 @@ -;;;; Copyright (c) 2004,2005 David Lichteblau <david(a)lichteblau.com> +;;;; Copyright (c) 2004-2006 David Lichteblau <david(a)lichteblau.com> ;;;; Lizenz: (L)LGPL ;;;; ;;;; Urspruenglicher Autor: David Lichteblau. ;;;; Aenderungen durch knowledgeTools GmbH. -;;;; http://www.pkware.com/company/standards/appnote/ +;;;; http://www.pkware.com/business_and_developers/developer/popups/appnote.txt +;;;; (http://www.pkware.com/company/standards/appnote/) (in-package :zip) @@ -211,8 +212,7 @@ (defun open-zipfile (pathname &key (external-format (default-external-format))) - (let* (#+allegro (excl:*locale* (excl:find-locale :latin1)) - (s (open pathname + (let* ((s (open pathname #-allegro :element-type #-allegro '(unsigned-byte 8)))) (unwind-protect @@ -247,8 +247,7 @@ (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)) + (let* ((s (zipwriter-stream z)) (header (make-local-header)) (utf8-name (string-to-octets name (zipwriter-external-format z))) (entry (make-zipwriter-entry @@ -288,8 +287,7 @@ name)) (defun write-central-directory (z) - (let* (#+allegro (excl:*locale* (excl:find-locale :latin1)) - (s (zipwriter-stream z)) + (let* ((s (zipwriter-stream z)) (pos (file-position s)) (n 0)) (dolist (e (cdr (zipwriter-head z))) @@ -331,8 +329,7 @@ (write-sequence end s)))) (defmethod zipfile-entry-contents ((entry zipfile-entry) &optional stream) - (let (#+allegro (excl:*locale* (excl:find-locale :latin1)) - (s (zipfile-entry-stream entry)) + (let ((s (zipfile-entry-stream entry)) header) (file-position s (zipfile-entry-offset entry)) (setf header (make-local-header s)) @@ -365,8 +362,7 @@ (defun make-zipfile-writer (pathname &key (if-exists :error) (external-format (default-external-format))) - (let (#+allegro (excl:*locale* (excl:find-locale :latin1)) - (c (cons nil nil))) + (let ((c (cons nil nil))) (make-zipwriter :stream (open pathname :direction :output

1 0

[zip-cvs] CVS zip
by dlichteblau 14 Mar '06

14 Mar '06

Update of /project/zip/cvsroot/zip In directory clnet:/tmp/cvs-serv14610 Modified Files: acl.lisp Log Message: allegro 8.0 compatibility (thanks to Edi Weitz) --- /project/zip/cvsroot/zip/acl.lisp 2005/04/05 15:04:33 1.3 +++ /project/zip/cvsroot/zip/acl.lisp 2006/03/14 21:48:43 1.4 @@ -20,9 +20,9 @@ (make-array length :element-type '(unsigned-byte 8) :initial-element 0)) (defmethod excl:device-open ((stream truncating-stream) - #+allegro-v7.0 slots + #+(version>= 7 0) slots options) - (declare (ignore options #+allegro-v7.0 slots)) + (declare (ignore options #+(version>= 7 0) slots)) (excl:with-stream-class (truncating-stream stream) (setf (slot-value stream 'excl::buffer) (make-octets (excl:device-buffer-length stream)))

1 0

[zip-cvs] CVS zip
by dlichteblau 14 Mar '06

14 Mar '06

Update of /project/zip/cvsroot/zip In directory clnet:/tmp/cvs-serv14577 Modified Files: gray.lisp Log Message: another stupid bug in the gray stream port --- /project/zip/cvsroot/zip/gray.lisp 2005/11/24 21:26:51 1.3 +++ /project/zip/cvsroot/zip/gray.lisp 2006/03/14 21:48:06 1.4 @@ -5,13 +5,15 @@ (pos :initform 0 :accessor pos))) (defmethod stream-write-sequence - #+sbcl ((stream buffer-output-stream) seq &optional (start 0) end) + #+sbcl ((stream buffer-output-stream) seq &optional (start 0) (end (length seq))) #+lispworks ((stream buffer-output-stream) seq start end) #-(or sbcl lispworks) ... (replace (buf stream) seq :start1 (pos stream) :start2 start - :end2 end)) + :end2 end) + (incf (pos stream) (- end start)) + seq) (defun make-buffer-output-stream (outbuf) (make-instance 'buffer-output-stream :buf outbuf))

1 0