[zip-cvs] CVS zip
dlichteblau
dlichteblau at common-lisp.net
Sun Mar 19 14:01:10 UTC 2006
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 at lichteblau.com>
+;;;; Copyright (c) 2004-2006 David Lichteblau <david at 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
More information about the Zip-cvs
mailing list