/[zip]/zip/zip.lisp
ViewVC logotype

Diff of /zip/zip.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.6 by dlichteblau, Tue Apr 5 19:31:13 2005 UTC revision 1.7 by dlichteblau, Sun Mar 19 14:01:09 2006 UTC
# Line 1  Line 1 
1  ;;;; Copyright (c) 2004,2005 David Lichteblau <david@lichteblau.com>  ;;;; Copyright (c) 2004-2006 David Lichteblau <david@lichteblau.com>
2  ;;;; Lizenz: (L)LGPL  ;;;; Lizenz: (L)LGPL
3  ;;;;  ;;;;
4  ;;;; Urspruenglicher Autor: David Lichteblau.  ;;;; Urspruenglicher Autor: David Lichteblau.
5  ;;;; Aenderungen durch knowledgeTools GmbH.  ;;;; Aenderungen durch knowledgeTools GmbH.
6    
7  ;;;; http://www.pkware.com/company/standards/appnote/  ;;;; http://www.pkware.com/business_and_developers/developer/popups/appnote.txt
8    ;;;; (http://www.pkware.com/company/standards/appnote/)
9    
10  (in-package :zip)  (in-package :zip)
11    
# Line 211  Line 212 
212    
213  (defun open-zipfile  (defun open-zipfile
214      (pathname &key (external-format (default-external-format)))      (pathname &key (external-format (default-external-format)))
215    (let* (#+allegro (excl:*locale* (excl:find-locale :latin1))    (let* ((s (open pathname
          (s (open pathname  
216                    #-allegro :element-type                    #-allegro :element-type
217                    #-allegro '(unsigned-byte 8))))                    #-allegro '(unsigned-byte 8))))
218      (unwind-protect      (unwind-protect
# Line 247  Line 247 
247  (defun write-zipentry  (defun write-zipentry
248      (z name data &key (file-write-date (file-write-date data)))      (z name data &key (file-write-date (file-write-date data)))
249    (setf name (substitute #\/ #\\ name))    (setf name (substitute #\/ #\\ name))
250    (let* (#+allegro (excl:*locale* (excl:find-locale :latin1))    (let* ((s (zipwriter-stream z))
          (s (zipwriter-stream z))  
251           (header (make-local-header))           (header (make-local-header))
252           (utf8-name (string-to-octets name (zipwriter-external-format z)))           (utf8-name (string-to-octets name (zipwriter-external-format z)))
253           (entry (make-zipwriter-entry           (entry (make-zipwriter-entry
# Line 288  Line 287 
287      name))      name))
288    
289  (defun write-central-directory (z)  (defun write-central-directory (z)
290    (let* (#+allegro (excl:*locale* (excl:find-locale :latin1))    (let* ((s (zipwriter-stream z))
          (s (zipwriter-stream z))  
291           (pos (file-position s))           (pos (file-position s))
292           (n 0))           (n 0))
293      (dolist (e (cdr (zipwriter-head z)))      (dolist (e (cdr (zipwriter-head z)))
# Line 331  Line 329 
329        (write-sequence end s))))        (write-sequence end s))))
330    
331  (defmethod zipfile-entry-contents ((entry zipfile-entry) &optional stream)  (defmethod zipfile-entry-contents ((entry zipfile-entry) &optional stream)
332    (let (#+allegro (excl:*locale* (excl:find-locale :latin1))    (let ((s (zipfile-entry-stream entry))
         (s (zipfile-entry-stream entry))  
333          header)          header)
334      (file-position s (zipfile-entry-offset entry))      (file-position s (zipfile-entry-offset entry))
335      (setf header (make-local-header s))      (setf header (make-local-header s))
# Line 365  Line 362 
362  (defun make-zipfile-writer  (defun make-zipfile-writer
363      (pathname &key (if-exists :error)      (pathname &key (if-exists :error)
364                     (external-format (default-external-format)))                     (external-format (default-external-format)))
365    (let (#+allegro (excl:*locale* (excl:find-locale :latin1))    (let ((c (cons nil nil)))
         (c (cons nil nil)))  
366      (make-zipwriter      (make-zipwriter
367       :stream (open pathname       :stream (open pathname
368                     :direction :output                     :direction :output

Legend:
Removed from v.1.6  
changed lines
  Added in v.1.7

  ViewVC Help
Powered by ViewVC 1.1.5