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/%22%3Eflexi-streams</a> for external + format support, <a + href="http://common-lisp.net/project/cl-plus-ssl/#trivial-gray-streams%22%3Etrivia...</a> + for gray streams portability, and includes <a + href="http://opensource.franz.com/deflate/%22%3Einflate.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@lichteblau.com +;;;; Copyright (c) 2004-2006 David Lichteblau david@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