commit 73b8f12a0d694e6102fae143eaf887bc9eba58ca
parent 1135fc015a06603e39158b99cc344bbfcba2dbfc
Author: Matthew Flatt <mflatt@racket-lang.org>
Date: Sat, 29 Jan 2011 09:55:40 -0600
Scribble: improve `interaction', `examples', etc. for non-text
by setting the default output port in the sandbox to support
content as "specials" when `current-print' is changed
original commit: 46dc2d66839f83fed424b4e214160faa0894404d
Diffstat:
2 files changed, 59 insertions(+), 8 deletions(-)
diff --git a/collects/scribble/eval.rkt b/collects/scribble/eval.rkt
@@ -8,6 +8,7 @@
racket/sandbox
racket/promise
racket/string
+ racket/port
file/convertible
(for-syntax racket/base))
@@ -78,6 +79,50 @@
(literal-string style s)))))))
s))))))))))
+ (define (format-output-stream in style)
+ (define (add-string string-accum line-accum)
+ (if string-accum
+ (cons (list->string (reverse string-accum))
+ (or line-accum null))
+ line-accum))
+ (define (add-line line-accum flow-accum)
+ (if line-accum
+ (cons (make-paragraph
+ (cons
+ (hspace 2)
+ (map (lambda (s)
+ (if (string? s)
+ (literal-string style s)
+ s))
+ (reverse line-accum))))
+ flow-accum)
+ flow-accum))
+ (let loop ([string-accum #f] [line-accum #f] [flow-accum null])
+ (let ([v (read-char-or-special in)])
+ (cond
+ [(eof-object? v)
+ (let* ([line-accum (add-string string-accum line-accum)]
+ [flow-accum (add-line line-accum flow-accum)])
+ (list
+ (list
+ (make-flow
+ (list
+ (if (= 1 (length flow-accum))
+ (car flow-accum)
+ (make-table
+ #f
+ (map (lambda (l)
+ (list (make-flow (list l))))
+ flow-accum))))))))]
+ [(equal? #\newline v)
+ (loop #f #f (add-line (add-string string-accum line-accum)
+ flow-accum))]
+ [(char? v)
+ (loop (cons v (or string-accum null)) line-accum flow-accum)]
+ [else
+ (loop #f (cons v (or (add-string string-accum line-accum) null))
+ flow-accum)]))))
+
(define (interleave title expr-paras val-list+outputs)
(make-table
#f
@@ -120,8 +165,8 @@
(list s)))
(regexp-split #rx"\n" s))))))]
[(box? (caar val-list+outputs))
- ;; Output formatted as string:
- (format-output (unbox (caar val-list+outputs)) result-color)]
+ ;; Output witten to a port
+ (format-output-stream (unbox (caar val-list+outputs)) result-color)]
[else
;; Normal result case:
(let ([val-list (caar val-list+outputs)])
@@ -178,15 +223,18 @@
(lambda ()
(and (eq? (current-print) cp)
(print-as-expression)))))
+ ;; default printer => get result as S-expression
(make-reader-graph (copy-value v (make-hasheq)))
+ ;; other printer => go through a string
(box
(call-in-sandbox-context
ev
(lambda ()
- (let ([s (open-output-string)])
- (parameterize ([current-output-port s])
+ (let-values ([(in out) (make-pipe-with-specials)])
+ (parameterize ([current-output-port out])
(map (current-print) v))
- (get-output-string s)))))))
+ (close-output-port out)
+ in))))))
(get-output ev)
(get-error-output ev)))])
(when expect
diff --git a/collects/scribblings/scribble/eval.scrbl b/collects/scribblings/scribble/eval.scrbl
@@ -28,9 +28,12 @@ evaluator is created using @racket[make-base-eval]. See also
If the value of @racket[current-print] in the sandbox is changed from
its default value, or if @racket[print-as-expression] in the sandbox
is set to @racket[#f], then each evaluation result is formatted to a
-string by applying @racket[(current-print)] to the value (with the
-output port set to a string port). Otherwise, result values are
-typeset using @racket[to-element/no-color].
+port by applying @racket[(current-print)] to the value; the output
+port is set to a pipe that supports specials in the sense of
+@racket[write-special], and non-character values written to the port
+are used as @tech{content}. Otherwise, when the default
+@racket[current-print] is in place, result values are typeset using
+@racket[to-element/no-color].
Uses of @racket[code:comment] and @racketidfont{code:blank} are
stipped from each @racket[datum] before evaluation.
