opt-lambda -> define/kw

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

View File

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

View File

@ -1,7 +1,7 @@
;; A modification of Dave Herman's zip module ;; A modification of Dave Herman's zip module
(module zip mzscheme (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 ;; DATA DEFINITIONS
@ -246,8 +246,7 @@
;; zip-write : (listof relative-path) -> ;; zip-write : (listof relative-path) ->
;; writes a zip file to current-output-port ;; writes a zip file to current-output-port
(provide zip->output) (provide zip->output)
(define zip->output (define/kw (zip->output files #:optional [out (current-output-port)])
(opt-lambda (files [out (current-output-port)])
(parameterize ([current-output-port out]) (parameterize ([current-output-port out])
(let* ([seekable? (seekable-port? (current-output-port))] (let* ([seekable? (seekable-port? (current-output-port))]
[headers ; note: MzScheme's `map' is always left-to-right [headers ; note: MzScheme's `map' is always left-to-right
@ -258,7 +257,7 @@
(fprintf (current-error-port) "zip: writing headers...\n")) (fprintf (current-error-port) "zip: writing headers...\n"))
(write-central-directory headers)) (write-central-directory headers))
(when (zip-verbose) (when (zip-verbose)
(fprintf (current-error-port) "zip: done.\n"))))) (fprintf (current-error-port) "zip: done.\n"))))
;; zip : output-file paths -> ;; zip : output-file paths ->
(provide zip) (provide zip)