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
- 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.
Portability
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. +
+ ++ 2005-04-05: ACL fixes (thank to Edi Weitz). Lispworks port + (thanks to Sean Ross).
(asdf-install:install :zip)
$ export CVSROOT=:pserver:anonymous at common-lisp.net:/project/zip/cvsroot $ cvs login Logging in to :pserver:anonymous at common-lisp.net:2401/project/zip/cvsroot From dlichteblau at common-lisp.net Tue Apr 5 18:18:34 2005 From: dlichteblau at common-lisp.net (David Lichteblau) Date: Tue, 5 Apr 2005 20:18:34 +0200 (CEST) Subject: [zip-cvs] CVS update: zip/zip.lisp Message-ID: <20050405181834.89CC18866B@common-lisp.net> Update of /project/zip/cvsroot/zip In directory common-lisp.net:/tmp/cvs-serv17335 Modified Files: zip.lisp Log Message: fixed unzip on allegro set version to 2.0 Date: Tue Apr 5 20:18:34 2005 Author: dlichteblau Index: zip/zip.lisp diff -u zip/zip.lisp:1.4 zip/zip.lisp:1.5 --- zip/zip.lisp:1.4 Tue Apr 5 17:04:33 2005 +++ zip/zip.lisp Tue Apr 5 20:18:33 2005 @@ -212,7 +212,9 @@ (defun open-zipfile (pathname &key (external-format (default-external-format))) (let* (#+allegro (excl:*locale* (excl:find-locale :latin1)) - (s (open pathname :element-type '(unsigned-byte 8)))) + (s (open pathname + #-allegro :element-type + #-allegro '(unsigned-byte 8)))) (unwind-protect (progn (seek-to-end-header s) @@ -290,7 +292,7 @@ (let ((header (zipwriter-entry-header e)) (entry (make-directory-entry))) (setf (cd/signature entry) #x02014b50) - (setf (cd/version-made-by entry) 0) ;dos compatible + (setf (cd/version-made-by entry) 20) ;version 2.0, fat (setf (cd/version-needed-to-extract entry) (file/version-needed-to-extract header)) (setf (cd/flags entry) (file/flags header)) From dlichteblau at common-lisp.net Tue Apr 5 19:31:14 2005 From: dlichteblau at common-lisp.net (David Lichteblau) Date: Tue, 5 Apr 2005 21:31:14 +0200 (CEST) Subject: [zip-cvs] CVS update: zip/README.html zip/zip.lisp Message-ID: <20050405193114.814D98866B@common-lisp.net> Update of /project/zip/cvsroot/zip In directory common-lisp.net:/tmp/cvs-serv21945 Modified Files: README.html zip.lisp Log Message: store file-write-date Date: Tue Apr 5 21:31:13 2005 Author: dlichteblau Index: zip/README.html diff -u zip/README.html:1.4 zip/README.html:1.5 --- zip/README.html:1.4 Tue Apr 5 17:47:08 2005 +++ zip/README.html Tue Apr 5 21:31:13 2005 @@ -54,7 +54,8 @@Recent changes
2005-04-05: ACL fixes (thank to Edi Weitz). Lispworks port - (thanks to Sean Ross). + (thanks to Sean Ross). Store file-write-date (also fixes + FilZip compatibility).
Download
@@ -148,11 +149,14 @@-
Function WRITE-ZIPENTRY (zipwriter name data)+Function WRITE-ZIPENTRY (zipwriter name data &key file-write-date)Append a new entry called name to zipwriter. Read data from (unsigned-byte 8) stream data until EOF and compress it into "deflate"-format. + Use file-write-date as the entry's date and time. + Default to (file-write-date data), use 1980-01-01T00:00 + if nil.
Function ZIP (pathname source-directory &key if-exists)@@ -160,6 +164,11 @@ Compress all files in source-directory recursively into a new zip archive at pathname. Note that entry file names will not contain the name source-directory. + + +Bookmark
++ spec