suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

opt-lambda -> define/kw

Browse Source 
svn: r4032
This commit is contained in:
Eli Barzilay 2006-08-12 03:22:56 +00:00
parent 21939a881d
commit b20f81b781
2 changed files with 19 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
collects/mzlib/tar.ss
View File

@ -1,5 +1,5 @@
(module tar mzscheme
(require (lib "deflate.ss") (lib "file.ss") (lib "etc.ss"))
(require (lib "deflate.ss") (lib "file.ss") (lib "kw.ss"))
(define tar-block-size 512)
(define tar-name-length 100)
@ -119,13 +119,12 @@
;; tar-write : (listof relative-path) ->
;; writes a tar file to current-output-port
(provide tar->output)
(define tar->output
(opt-lambda (files [out (current-output-port)])
(parameterize ([current-output-port out])
(let* ([buf (new-block)] [entry (tar-one-entry buf)])
(for-each entry files)
;; two null blocks end-marker
(write-bytes buf) (write-bytes buf)))))
(define/kw (tar->output files #:optional [out (current-output-port)])
(parameterize ([current-output-port out])
(let* ([buf (new-block)] [entry (tar-one-entry buf)])
(for-each entry files)
;; two null blocks end-marker
(write-bytes buf) (write-bytes buf))))
;; tar : output-file paths ->
(provide tar)

25
collects/mzlib/zip.ss
View File

@ -1,7 +1,7 @@
;; A modification of Dave Herman's zip module
(module zip mzscheme
(require (lib "deflate.ss") (lib "file.ss") (lib "etc.ss"))
(require (lib "deflate.ss") (lib "file.ss") (lib "kw.ss"))
;; ===========================================================================
;; DATA DEFINITIONS
@ -246,19 +246,18 @@
;; zip-write : (listof relative-path) ->
;; writes a zip file to current-output-port
(provide zip->output)
(define zip->output
(opt-lambda (files [out (current-output-port)])
(parameterize ([current-output-port out])
(let* ([seekable? (seekable-port? (current-output-port))]
[headers ; note: MzScheme's `map' is always left-to-right
(map (lambda (file)
(zip-one-entry (build-metadata file) seekable?))
files)])
(when (zip-verbose)
(fprintf (current-error-port) "zip: writing headers...\n"))
(write-central-directory headers))
(define/kw (zip->output files #:optional [out (current-output-port)])
(parameterize ([current-output-port out])
(let* ([seekable? (seekable-port? (current-output-port))]
[headers ; note: MzScheme's `map' is always left-to-right
(map (lambda (file)
(zip-one-entry (build-metadata file) seekable?))
files)])
(when (zip-verbose)
(fprintf (current-error-port) "zip: done.\n")))))
(fprintf (current-error-port) "zip: writing headers...\n"))
(write-central-directory headers))
(when (zip-verbose)
(fprintf (current-error-port) "zip: done.\n"))))
;; zip : output-file paths ->
(provide zip)