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

Diff of /zip/zip.lisp

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

revision 1.5 by dlichteblau, Tue Apr 5 18:18:33 2005 UTC revision 1.6 by dlichteblau, Tue Apr 5 19:31:13 2005 UTC
# Line 244  Line 244 
244  (defmethod get-zipfile-entry (name (zipfile zipfile))  (defmethod get-zipfile-entry (name (zipfile zipfile))
245    (gethash name (zipfile-entries zipfile)))    (gethash name (zipfile-entries zipfile)))
246    
247  (defun write-zipentry (z name data)  (defun write-zipentry
248        (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* (#+allegro (excl:*locale* (excl:find-locale :latin1))
251           (s (zipwriter-stream z))           (s (zipwriter-stream z))
# Line 258  Line 259 
259      (setf (file/version-needed-to-extract header) 2) ;XXX ist das 2.0?      (setf (file/version-needed-to-extract header) 2) ;XXX ist das 2.0?
260      (setf (file/flags header) 8)        ;bit 3: descriptor folgt nach daten      (setf (file/flags header) 8)        ;bit 3: descriptor folgt nach daten
261      (setf (file/method header) 8)      (setf (file/method header) 8)
262      (setf (file/time header) 0)         ;XXX fixme      (multiple-value-bind (s min h d m y)
263      (setf (file/date header) 0)         ;XXX fixme          (decode-universal-time
264      (setf (file/crc header) 0)           (or file-write-date (encode-universal-time 0 0 0 1 1 1980 0)))
265          (setf (file/time header)
266                (logior (ash h 11) (ash min 5) (ash s -1)))
267          (setf (file/date header)
268                (logior (ash (- y 1980) 9) (ash m 5) d)))
269      (setf (file/compressed-size header) 0)      (setf (file/compressed-size header) 0)
270      (setf (file/size header) 0)      (setf (file/size header) 0)
271      (setf (file/name-length header) (length utf8-name))      (setf (file/name-length header) (length utf8-name))
# Line 428  Line 433 
433                         (write-zipentry                         (write-zipentry
434                          zip                          zip
435                          (enough-namestring (namestring f) base)                          (enough-namestring (namestring f) base)
436                          (make-concatenated-stream))                          (make-concatenated-stream)
437                            :file-write-date (file-write-date f))
438                         (recurse #+allegro f                         (recurse #+allegro f
439                                  #-allegro (make-pathname                                  #-allegro (make-pathname
440                                             :name :wild                                             :name :wild

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

  ViewVC Help
Powered by ViewVC 1.1.5