From f69e82e6c54c921ae7dc59df1b0565827f00ce41 Mon Sep 17 00:00:00 2001 From: Abdulaziz Ghuloum Date: Tue, 29 Apr 2008 00:20:29 -0400 Subject: [PATCH] Added with-output-to-port: > (let-values ([(p e) (open-string-output-port)]) (with-output-to-port p (lambda () (printf "Hello\n"))) (e)) "Hello\n" --- scheme/ikarus.io.ss | 15 ++++++++++++++- scheme/last-revision | 2 +- scheme/makefile.ss | 1 + 3 files changed, 16 insertions(+), 2 deletions(-) diff --git a/scheme/ikarus.io.ss b/scheme/ikarus.io.ss index c679bd7..f03f1e8 100644 --- a/scheme/ikarus.io.ss +++ b/scheme/ikarus.io.ss @@ -45,6 +45,7 @@ open-bytevector-output-port call-with-bytevector-output-port open-string-output-port with-output-to-string + with-output-to-port call-with-string-output-port open-output-string get-output-string standard-output-port standard-error-port @@ -112,6 +113,7 @@ current-output-port current-error-port open-file-output-port open-output-file call-with-output-file with-output-to-file + with-output-to-port console-output-port console-input-port console-error-port @@ -469,7 +471,18 @@ (parameterize ([*the-output-port* p]) (proc)) (extract))) - + + (define (with-output-to-port p proc) + (define who 'with-output-to-port) + (unless (procedure? proc) + (die who "not a procedure" proc)) + (unless (output-port? p) + (die who "not an output port" p)) + (unless (textual-port? p) + (die who "not a textual port" p)) + (parameterize ([*the-output-port* p]) + (proc))) + (define-struct output-string-cookie (strings)) diff --git a/scheme/last-revision b/scheme/last-revision index 7105d93..471d548 100644 --- a/scheme/last-revision +++ b/scheme/last-revision @@ -1 +1 @@ -1455 +1456 diff --git a/scheme/makefile.ss b/scheme/makefile.ss index d2d86b2..0a7d346 100755 --- a/scheme/makefile.ss +++ b/scheme/makefile.ss @@ -1186,6 +1186,7 @@ [read-char i r is se] [with-input-from-file i r is se] [with-output-to-file i r is se] + [with-output-to-port i] [write i r is se] [write-char i r is se] [call-with-input-file i r is se]