From dlichteblau at common-lisp.net  Tue Mar 14 21:48:06 2006
From: dlichteblau at common-lisp.net (dlichteblau)
Date: Tue, 14 Mar 2006 16:48:06 -0500 (EST)
Subject: [zip-cvs] CVS zip
Message-ID: <20060314214806.773AF5300E@common-lisp.net>

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



From dlichteblau at common-lisp.net  Tue Mar 14 21:48:44 2006
From: dlichteblau at common-lisp.net (dlichteblau)
Date: Tue, 14 Mar 2006 16:48:44 -0500 (EST)
Subject: [zip-cvs] CVS zip
Message-ID: <20060314214844.0C91653010@common-lisp.net>

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



From dlichteblau at common-lisp.net  Sun Mar 19 14:01:10 2006
From: dlichteblau at common-lisp.net (dlichteblau)
Date: Sun, 19 Mar 2006 09:01:10 -0500 (EST)
Subject: [zip-cvs] CVS zip
Message-ID: <20060319140110.548C53000F@common-lisp.net>

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