zip-cvs

zip-cvs@common-lisp.net

23 discussions

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

14 Aug '06

Update of /project/zip/cvsroot/zip In directory clnet:/tmp/cvs-serv14138 Modified Files: gray.lisp Log Message: From: Edi Weitz <edi(a)agharta.de> Subject: Typo in STREAM-READ-SEQUENCE (Was: NIL vs. :UNSPECIFIC) --- /project/zip/cvsroot/zip/gray.lisp 2006/04/12 20:35:33 1.7 +++ /project/zip/cvsroot/zip/gray.lisp 2006/08/14 07:52:13 1.8 @@ -61,11 +61,11 @@ (defmethod stream-read-sequence ((s truncating-stream) seq start end &key) (let* ((n (- end start)) - (max (- (size s) (pos s))) - (result - (read-sequence (input-handle s) - seq - :start start - :end (+ start (min n max))))) + (max (- (size s) (pos s))) + (result + (read-sequence seq + (input-handle s) + :start start + :end (+ start (min n max))))) (incf (pos s) (- result start)) result))

1 0

[zip-cvs] CVS zip
by dlichteblau 11 Aug '06

11 Aug '06

Update of /project/zip/cvsroot/zip In directory clnet:/tmp/cvs-serv17276 Modified Files: zip.lisp Log Message: :unspecific workaround for lispworks --- /project/zip/cvsroot/zip/zip.lisp 2006/06/10 14:07:53 1.9 +++ /project/zip/cvsroot/zip/zip.lisp 2006/08/11 13:47:45 1.10 @@ -401,8 +401,11 @@ (zipfile-entries ,zipfile)))) (defun unzip (pathname target-directory &key (if-exists :error) verbose) - (when (or (pathname-name target-directory) - (pathname-type target-directory)) + ;; <Xof> "When reading[1] the value of any pathname component, conforming + ;; programs should be prepared for the value to be :unspecific." + (when (set-difference (list (pathname-name target-directory) + (pathname-type target-directory)) + '(nil :unspecific)) (error "pathname not a directory, lacks trailing slash?")) (with-zipfile (zip pathname) (do-zipfile-entries (name entry zip)

1 0

[zip-cvs] CVS zip
by dlichteblau 10 Jun '06

10 Jun '06

Update of /project/zip/cvsroot/zip In directory clnet:/tmp/cvs-serv10937 Modified Files: zip.lisp Log Message: CLISP workarounds (Klaus Weidner) --- /project/zip/cvsroot/zip/zip.lisp 2006/06/10 13:58:56 1.8 +++ /project/zip/cvsroot/zip/zip.lisp 2006/06/10 14:07:53 1.9 @@ -419,31 +419,48 @@ :element-type '(unsigned-byte 8)) (zipfile-entry-contents entry s))))))) -(defun directoryp (pathname) +(defun %directoryp (pathname) #+allegro (excl:file-directory-p pathname) #+lispworks (lispworks:file-directory-p pathname) - #-(or lispworks allegro) + #+clisp (ignore-errors + (ext:probe-directory + (concatenate 'string (princ-to-string pathname) "/"))) + #-(or lispworks allegro clisp) (and (null (pathname-name pathname)) (null (pathname-type pathname)))) +(defun %directory (d) + #+allegro (directory d :directories-are-files nil) + #+clisp (append (directory (concatenate 'string (princ-to-string d) "/*/")) + (directory (concatenate 'string (princ-to-string d) "/*"))) + #-(or allegro clisp) (directory d)) + +(defun %file-write-date (f) + #+clisp (posix:file-stat-mtime (posix:file-stat f)) + #-clisp (file-write-date f)) + +(defun %pathname-for-directory (f) + #+(or allegro clisp) f + #-(or allegro clisp) (make-pathname :name :wild :type :wild :defaults f)) + +(defun %directory-namestring (d) + #+clisp (directory-namestring + (truename (concatenate 'string (princ-to-string d) "/"))) + #-clisp (directory-namestring d)) + (defun zip (pathname source-directory &key (if-exists :error)) - (let ((base (directory-namestring source-directory))) + (let ((base (%directory-namestring (merge-pathnames 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)) + (dolist (f (%directory d)) (cond - ((directoryp f) + ((%directoryp f) (write-zipentry zip (enough-namestring (namestring f) base) (make-concatenated-stream) - :file-write-date (file-write-date f)) - (recurse #+allegro f - #-allegro (make-pathname - :name :wild - :type :wild - :defaults f))) + :file-write-date (%file-write-date f)) + (recurse (%pathname-for-directory f))) ((or (pathname-name f) (pathname-type f)) (with-open-file (s f :element-type '(unsigned-byte 8)) (write-zipentry

1 0

[zip-cvs] CVS zip
by dlichteblau 10 Jun '06

10 Jun '06

Update of /project/zip/cvsroot/zip In directory clnet:/tmp/cvs-serv9246 Modified Files: README.html package.lisp zip.lisp Log Message: Comment support (Surendra Singhi) clisp buglet (Klaus Weidner) --- /project/zip/cvsroot/zip/README.html 2006/03/19 14:01:09 1.6 +++ /project/zip/cvsroot/zip/README.html 2006/06/10 13:58:56 1.7 @@ -60,12 +60,13 @@ <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). + 2006-xx-yy: Fixed the gray stream port, including a data + corruption bug that was in CVS for some time. (Thanks to Kevin + Reid and others.) Switched to flexi-stream external-format + functions for portability. Uses trivial-gray-streams now. + Allegro 8.0 fix (thanks to Edi Weitz). Comment support (thanks + to Surendra Singhi). Incompatible change: Don't bind + <tt>*locale*</tt> on Allegro anymore. <p> </p> 2005-04-05: ACL fixes (thank to Edi Weitz). Lispworks port --- /project/zip/cvsroot/zip/package.lisp 2006/03/19 14:01:09 1.3 +++ /project/zip/cvsroot/zip/package.lisp 2006/06/10 13:58:56 1.4 @@ -10,6 +10,7 @@ #:get-zipfile-entry #:zipfile-entry-name #:zipfile-entry-size + #:zipfile-entry-comment #:do-zipfile-entries #:zipfile-entry-contents #:unzip --- /project/zip/cvsroot/zip/zip.lisp 2006/03/19 14:01:09 1.7 +++ /project/zip/cvsroot/zip/zip.lisp 2006/06/10 13:58:56 1.8 @@ -38,7 +38,9 @@ (setf (elt array (+ offset 3)) (logand newval #xff)) newval) -(defmacro define-record (constructor (&key (length (gensym))) &rest fields) +(defmacro define-record (constructor + (&key (length #-clisp (gensym) #+clisp (gentemp))) + &rest fields) `(progn (defconstant ,length ,(loop @@ -180,7 +182,8 @@ stream offset size - compressed-size) + compressed-size + comment) (defstruct zipwriter stream @@ -196,19 +199,24 @@ (defun read-entry-object (s external-format) (let* ((header (make-directory-entry s)) (name (make-array (cd/name-length header) - :element-type '(unsigned-byte 8)))) + :element-type '(unsigned-byte 8))) + (comment + (when (plusp (cd/comment-length header)) + (make-array (cd/comment-length header) + :element-type '(unsigned-byte 8))))) (assert (= (cd/signature header) #x02014b50)) (read-sequence name s) (setf name (octets-to-string name external-format)) - (prog1 - (make-zipfile-entry :name name - :stream s - :offset (cd/offset header) - :size (cd/size header) - :compressed-size (cd/compressed-size header)) - (file-position s (+ (file-position s) - (cd/extra-length header) - (cd/comment-length header)))))) + (file-position s (+ (file-position s) (cd/extra-length header))) + (when comment + (read-sequence comment s) + (setf comment (octets-to-string comment external-format))) + (make-zipfile-entry :name name + :stream s + :offset (cd/offset header) + :size (cd/size header) + :compressed-size (cd/compressed-size header) + :comment comment))) (defun open-zipfile (pathname &key (external-format (default-external-format)))

1 0

[zip-cvs] CVS zip
by dlichteblau 12 Apr '06

12 Apr '06

Update of /project/zip/cvsroot/zip In directory clnet:/tmp/cvs-serv10783 Modified Files: gray.lisp Log Message: added a fallback method stream-write-byte for buffer-output-stream --- /project/zip/cvsroot/zip/gray.lisp 2006/04/12 20:29:35 1.6 +++ /project/zip/cvsroot/zip/gray.lisp 2006/04/12 20:35:33 1.7 @@ -26,6 +26,13 @@ ((buf :initarg :buf :accessor buf) (pos :initform 0 :accessor pos))) +;; fallback method just in case the lisp doesn't have or doesn't use +;; stream-write-sequence: +(defmethod stream-write-byte + ((stream buffer-output-stream) byte) + (stream-write-sequence stream (vector byte) 0 1) + byte) + (defmethod stream-write-sequence ((stream buffer-output-stream) seq start end &key) (replace (buf stream)

1 0

[zip-cvs] CVS zip
by dlichteblau 12 Apr '06

12 Apr '06

Update of /project/zip/cvsroot/zip In directory clnet:/tmp/cvs-serv9082 Modified Files: gray.lisp Log Message: fixed buffer-output-stream --- /project/zip/cvsroot/zip/gray.lisp 2006/03/19 14:01:09 1.5 +++ /project/zip/cvsroot/zip/gray.lisp 2006/04/12 20:29:35 1.6 @@ -21,7 +21,8 @@ while c do (write-char c out*)))))) -(defclass buffer-output-stream (fundamental-binary-output-stream) +(defclass buffer-output-stream + (trivial-gray-stream-mixin fundamental-binary-output-stream) ((buf :initarg :buf :accessor buf) (pos :initform 0 :accessor pos)))

1 0

[zip-cvs] CVS zip
by dlichteblau 12 Apr '06

12 Apr '06

Update of /project/zip/cvsroot/zip In directory clnet:/tmp/cvs-serv8872 Modified Files: zip.asd Log Message: Can't hurt to write :pathname including its type. (Reported to be necessary under unknown circumstances on unknown asdf versions.) --- /project/zip/cvsroot/zip/zip.asd 2006/03/19 14:01:09 1.3 +++ /project/zip/cvsroot/zip/zip.asd 2006/04/12 20:26:30 1.4 @@ -14,7 +14,7 @@ :depends-on (:salza :trivial-gray-streams :flexi-streams) :components ((:file "package") (:file dependent - :pathname #+allegro "acl" #-allegro "gray" + :pathname #+allegro "acl.lisp" #-allegro "gray.lisp" :depends-on ("package")) (:file "ifstar" :depends-on ("package")) (:file "inflate" :depends-on ("package" "ifstar"))

1 0

[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

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

zip-cvs