,

svn: r12430

collects/scheme/main.ss

@@ -15,6 +15,7 @@
            scheme/function
            scheme/path
            scheme/file
+           scheme/port
            scheme/cmdline
            scheme/promise
            scheme/bool
@@ -39,6 +40,7 @@
                          scheme/function
                          scheme/path
                          scheme/file
+                         scheme/port
                          scheme/cmdline
                          scheme/promise
                          scheme/bool

collects/scheme/port.ss

@@ -8,7 +8,17 @@
            port->bytes
            port->lines
            port->bytes-lines
-           display-lines)
+           display-lines
+
+           with-output-to-string
+           with-output-to-bytes
+           call-with-output-string
+           call-with-output-bytes
+
+           with-input-from-string
+           with-input-from-bytes
+           call-with-input-string
+           call-with-input-bytes)
 
   (define (port->string-port who p)
     (unless (input-port? p)
@@ -34,4 +44,53 @@
       (raise-type-error 'display-lines "list" l))
     (unless (output-port? p)
       (raise-type-error 'display-lines "output-port" p))
-    (do-lines->port l p newline)))
+    (do-lines->port l p newline))
+
+  (define (with-output-to-x who n proc)
+    (unless (and (procedure? proc)
+                 (procedure-arity-includes? proc n))
+      (raise-type-error who (format "procedure (arity ~a)" n) proc))
+    (let ([s (open-output-bytes)])
+      ;; Use `dup-output-port' to hide string-port-ness of s:
+      (if (zero? n)
+          (parameterize ([current-output-port (dup-output-port s #t)])
+            (proc))
+          (proc (dup-output-port s #t)))
+      s))
+  
+  (define (with-output-to-string proc)
+    (get-output-string (with-output-to-x 'with-output-to-string 0 proc)))
+  
+  (define (with-output-to-bytes proc)
+    (get-output-bytes (with-output-to-x 'with-output-to-bytes 0 proc) #t))
+  
+  (define (call-with-output-string proc)
+    (get-output-string (with-output-to-x 'call-with-output-string 1 proc)))
+  
+  (define (call-with-output-bytes proc)
+    (get-output-bytes (with-output-to-x 'call-with-output-bytes 1 proc) #t))
+
+  (define (with-input-from-x who n b? str proc)
+    (unless (if b? (bytes? str) (string? str))
+      (raise-type-error who (if b? "byte string" "string") 0 str proc))
+    (unless (and (procedure? proc)
+                 (procedure-arity-includes? proc n))
+      (raise-type-error who (format "procedure (arity ~a)" n) 1 str proc))
+    (let ([s (if b? (open-input-bytes str) (open-input-string str))])
+      (if (zero? n)
+          (parameterize ([current-input-port s])
+            (proc))
+          (proc s))))
+
+  (define (with-input-from-string str proc)
+    (with-input-from-x 'with-input-from-string 0 #f str proc))
+
+  (define (with-input-from-bytes str proc)
+    (with-input-from-x 'with-input-from-bytes 0 #t str proc))
+  
+  (define (call-with-input-string str proc)
+    (with-input-from-x 'call-with-input-string 1 #f str proc))
+  
+  (define (call-with-input-bytes str proc)
+    (with-input-from-x 'call-with-input-bytes 1 #t str proc)))
+

collects/scribblings/reference/port-lib.scrbl

@@ -4,7 +4,7 @@
 
 @title[#:tag "port-lib"]{More Port Constructors, Procedures, and Events}
 
-@note-lib-only[scheme/port]
+@note-lib[scheme/port]
 
 @; ----------------------------------------------------------------------
 
@@ -42,6 +42,66 @@ lines like @scheme[read-bytes-line].}
 Use @scheme[display] to each each element of @scheme[lst] to @scheme[out], adding
 @scheme[separator] after each element.}
 
+@defproc[(call-with-output-string [proc (output-port? . -> . any)]) string?]{
+
+Calls @scheme[proc] with an output port that accumulates all output
+into a string, and returns the string.
+
+The port passed to @scheme[proc] is like the one created by
+@scheme[open-output-string], except that it is wrapped via
+@scheme[dup-output-port], so that @scheme[proc] cannot access the
+port's content using @scheme[get-output-string]. If control jumps back
+into @scheme[proc], the port continues to accumulate new data, and
+@scheme[call-with-output-string] returns both the old data and newly
+accumulated data.}
+
+@defproc[(call-with-output-bytes [proc (output-port? . -> . any)]) bytes?]{
+
+Like @scheme[call-with-output-string], but returns accumulated results
+in a @tech{byte string} instead of a string. Furthermore, the port's
+content is emptied when @scheme[call-with-output-bytes] returns, so
+that if control jumps back into @scheme[proc] and returns a second
+time, only the newly accumulated bytes are returned.}
+
+@defproc[(with-output-to-string [proc (-> any)]) string?]{
+
+Equivalent to
+
+@schemeblock[(call-with-output-string
+              (lambda (p) (parameterize ([current-output-port p])
+                            (proc))))]}
+
+@defproc[(with-output-to-bytes [proc (-> any)]) bytes?]{
+
+Equivalent to
+
+@schemeblock[(call-with-output-bytes
+              (lambda (p) (parameterize ([current-output-port p])
+                            (proc))))]}
+
+@defproc[(call-with-input-string [str string?][proc (input-port? . -> . any)]) any]{
+
+Equivalent to @scheme[(proc (open-input-string str))].}
+
+@defproc[(call-with-input-bytes [bstr bytes?][proc (input-port? . -> . any)]) any]{
+
+Equivalent to @scheme[(proc (open-input-bytes bstr))].}
+
+@defproc[(with-input-from-string [str string?][proc (-> any)]) any]{
+
+Equivalent to
+
+@schemeblock[(parameterize ([current-input-port (open-input-string str)])
+               (proc))]}
+
+@defproc[(with-input-from-bytes [bstr bytes?][proc (-> any)]) any]{
+
+Equivalent to
+
+@schemeblock[(parameterize ([current-input-port (open-input-bytes str)])
+               (proc))]}
+
+
 @; ----------------------------------------------------------------------
 
 @section{Creating Ports}

collects/tests/mzscheme/portlib.ss

@@ -33,6 +33,32 @@
 
 ;; ----------------------------------------
 
+(let ()
+  (define (test-with cw-in cw-out s wrap-in wrap-out)
+    (test 'cat cw-in s (wrap-in (lambda (p) (read p))))
+    (test s cw-out (wrap-out (lambda (p) (write 'cat p)))))
+  (test-with call-with-input-bytes call-with-output-bytes #"cat" values values)
+  (test-with call-with-input-string call-with-output-string "cat" values values)
+  (let ([wrap-in (lambda (f) (lambda () (f (current-input-port))))]
+        [wrap-out (lambda (f) (lambda () (f (current-output-port))))])
+    (test-with with-input-from-bytes with-output-to-bytes #"cat" wrap-in wrap-out)
+    (test-with with-input-from-string with-output-to-string "cat" wrap-in wrap-out)))
+
+(err/rt-test (call-with-input-bytes "x" values))
+(err/rt-test (call-with-input-string #"x" values))
+(err/rt-test (with-input-from-bytes "x" values))
+(err/rt-test (with-input-from-string #"x" values))
+(err/rt-test (call-with-input-bytes #"x" (lambda () 'x)))
+(err/rt-test (call-with-input-string "x" (lambda () 'x)))
+(err/rt-test (with-input-from-bytes #"x" add1))
+(err/rt-test (with-input-from-string "x" add1))
+(err/rt-test (call-with-output-bytes (lambda () 'x)))
+(err/rt-test (call-with-output-string (lambda () 'x)))
+(err/rt-test (with-output-to-bytes add1))
+(err/rt-test (with-output-to-string add1))
+
+;; ----------------------------------------
+
 ;; pipe and pipe-with-specials commmit tests
 (define (test-pipe-commit make-pipe)
   (let-values ([(in out) (make-pipe)])

doc/release-notes/mzscheme/HISTORY.txt

@@ -1,9 +1,14 @@
+Version 4.1.2.5
+Changed scheme to re-export scheme/port
+In scheme/port: added [call-]with-input-from-{string,bytes} and
+   [call-]with-output-to-{string,bytes}
+
 Version 4.1.2.4
 Added call-with-immediate-continuation-mark
 In scheme/port: added port->string, port->bytes, port->lines
    port->bytes-lines, and display-list
 In scheme/file: added file->string, file->bytes, file->lines,
-   file->value, file->bytes-lines, write-to-file, display-to-file, 
+   file->value, file->bytes-lines, write-to-file, display-to-file,
    and display-list-to-file
 
 Version 4.1.2.3

src/mzscheme/src/schvers.h

@@ -13,12 +13,12 @@
    consistently.)
 */
 
-#define MZSCHEME_VERSION "4.1.2.4"
+#define MZSCHEME_VERSION "4.1.2.5"
 
 #define MZSCHEME_VERSION_X 4
 #define MZSCHEME_VERSION_Y 1
 #define MZSCHEME_VERSION_Z 2
-#define MZSCHEME_VERSION_W 4
+#define MZSCHEME_VERSION_W 5
 
 #define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
 #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)