commit 5218126773855c9c7e7d8d0b3076221e670c01ea
parent 02d8332600dfdd96f89162cced95f378c62ea340
Author: Ryan Culpepper <ryanc@racket-lang.org>
Date: Sun, 9 Oct 2011 22:37:31 -0600
scribble/eval: pretty-print results by default
original commit: eed6016793c9646f5dce28e2660c2a8cd0db1122
Diffstat:
4 files changed, 60 insertions(+), 28 deletions(-)
diff --git a/collects/scribble/eval.rkt b/collects/scribble/eval.rkt
@@ -3,6 +3,7 @@
(require "manual.rkt" "struct.rkt" "scheme.rkt" "decode.rkt"
racket/list
file/convertible ;; attached into new namespace via anchor
+ racket/pretty ;; attached into new namespace via anchor
racket/sandbox racket/promise racket/port
racket/gui/dynamic
(for-syntax racket/base))
@@ -191,19 +192,31 @@
what "without a `sandbox-output' configured to 'string")))
(list (get get-output "output") (get get-error-output "error output")))
(define (render-value v)
- (if (call-in-sandbox-context
- ev (let ([cp (current-print)])
- (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 ()
- (define-values [in out] (make-pipe-with-specials))
- (parameterize ([current-output-port out]) (map (current-print) v))
- (close-output-port out)
- in)))))
+ (let-values ([(eval-print eval-print-as-expr?)
+ (call-in-sandbox-context ev
+ (lambda () (values (current-print) (print-as-expression))))])
+ (cond [(and (eq? eval-print (current-print))
+ eval-print-as-expr?)
+ ;; default printer => get result as S-expression
+ (make-reader-graph (copy-value v (make-hasheq)))]
+ [else
+ ;; other printer => go through a pipe
+ ;; If it happens to be the pretty printer, tell it to retain
+ ;; convertible objects (via write-special)
+ (box (call-in-sandbox-context
+ ev
+ (lambda ()
+ (define-values [in out] (make-pipe-with-specials))
+ (parameterize ((current-output-port out)
+ (pretty-print-size-hook
+ (lambda (obj _mode _out)
+ (and (convertible? obj) 1)))
+ (pretty-print-print-hook
+ (lambda (obj _mode out)
+ (write-special obj out))))
+ (map (current-print) v))
+ (close-output-port out)
+ in)))])))
(define (do-ev s)
(with-handlers ([(lambda (x) (not (exn:break? x)))
(lambda (e)
@@ -287,7 +300,13 @@
[(eq? stx 'code:blank) (void)]
[else stx]))
-(define (make-base-eval)
+(define (install-pretty-printer! e ns)
+ (call-in-sandbox-context e
+ (lambda ()
+ (namespace-attach-module ns 'racket/pretty)
+ (current-print (dynamic-require 'racket/pretty 'pretty-print-handler)))))
+
+(define (make-base-eval #:pretty-print? [pretty-print? #t])
(call-with-trusted-sandbox-configuration
(lambda ()
(parameterize ([sandbox-output 'string]
@@ -297,10 +316,12 @@
(let ([ns (namespace-anchor->namespace anchor)])
(call-in-sandbox-context
e
- (lambda () (namespace-attach-module ns 'file/convertible))))
+ (lambda () (namespace-attach-module ns 'file/convertible)))
+ (when pretty-print? (install-pretty-printer! e ns)))
e)))))
-(define (make-base-eval-factory mod-paths)
+(define (make-base-eval-factory mod-paths
+ #:pretty-print? [pretty-print? #t])
(let ([ns (delay (let ([ns
;; This namespace-creation choice needs to be consistent
;; with the sandbox (i.e., with `make-base-eval')
@@ -309,11 +330,13 @@
(make-base-empty-namespace))])
(parameterize ([current-namespace ns])
(for ([mod-path (in-list mod-paths)])
- (dynamic-require mod-path #f)))
+ (dynamic-require mod-path #f))
+ (when pretty-print? (dynamic-require 'racket/pretty #f)))
ns))])
(lambda ()
- (let ([ev (make-base-eval)]
+ (let ([ev (make-base-eval #:pretty-print? #f)]
[ns (force ns)])
+ (when pretty-print? (install-pretty-printer! ev ns))
(call-in-sandbox-context
ev
(lambda ()
@@ -321,8 +344,9 @@
(namespace-attach-module ns mod-path))))
ev))))
-(define (make-eval-factory mod-paths)
- (let ([base-factory (make-base-eval-factory mod-paths)])
+(define (make-eval-factory mod-paths
+ #:pretty-print? [pretty-print? #t])
+ (let ([base-factory (make-base-eval-factory mod-paths #:pretty-print? pretty-print?)])
(lambda ()
(let ([ev (base-factory)])
(call-in-sandbox-context
diff --git a/collects/scribble/latex-render.rkt b/collects/scribble/latex-render.rkt
@@ -544,7 +544,7 @@
[center? (and (not bottom?)
(not top?))]
[as-box? (and can-box? (boxable? p))])
- (when (style-name vstyle)
+ (when (string? (style-name vstyle))
(printf "\\~a{" (style-name vstyle)))
(let ([minipage? (and can-box? (not as-box?))])
(when minipage?
@@ -569,7 +569,7 @@
(render-block p part ri #f)])
(when minipage?
(printf " \\end{minipage}\n")))
- (when (style-name vstyle)
+ (when (string? (style-name vstyle))
(printf "}"))
null))
diff --git a/collects/scribblings/scribble/eval.scrbl b/collects/scribblings/scribble/eval.scrbl
@@ -1,5 +1,5 @@
#lang scribble/doc
-@(require scribble/manual "utils.rkt" (for-label racket/sandbox))
+@(require scribble/manual "utils.rkt" (for-label racket/sandbox racket/pretty))
@title[#:tag "eval"]{Evaluation and Examples}
@@ -123,14 +123,20 @@ Like @racket[examples], but each definition using @racket[define] or
prompt, and with line of space after it.}
-@defproc[(make-base-eval) (any/c . -> . any)]{
+@defproc[(make-base-eval [#:pretty-print? pretty-print? any/c #t])
+ (any/c . -> . any)]{
Creates an evaluator using @racket[(make-evaluator 'racket/base)],
setting sandbox parameters to disable limits, setting the outputs to
-@racket['string], and not adding extra security guards.}
+@racket['string], and not adding extra security guards.
+If @racket[pretty-print?] is true, the sandbox's printer is set to
+@racket[pretty-print-handler].}
-@defproc[(make-base-eval-factory [mod-paths (listof module-path?)]) (-> (any/c . -> . any))]{
+
+@defproc[(make-base-eval-factory [mod-paths (listof module-path?)]
+ [#:pretty-print? pretty-print? any/c #t])
+ (-> (any/c . -> . any))]{
Produces a function that is like @racket[make-base-eval], except that
each module in @racket[mod-paths] is attached to the evaluator's
@@ -139,7 +145,9 @@ returned @racket[make-base-eval]-like function is called the first
time) and then attached to each evaluator that is created.}
-@defproc[(make-eval-factory [mod-paths (listof module-path?)]) (-> (any/c . -> . any))]{
+@defproc[(make-eval-factory [mod-paths (listof module-path?)]
+ [#:pretty-print? pretty-print? any/c #t])
+ (-> (any/c . -> . any))]{
Like @racket[make-base-eval-factory], but each module in @racket[mod-paths] is
also required into the top-level environment for each generated evaluator.}
diff --git a/collects/scriblib/gui-eval.rkt b/collects/scriblib/gui-eval.rkt
@@ -35,7 +35,7 @@
(λ () (gui-eval 'pict-height)))])
(orig #:eval gui-eval x (... ...)))])))]))
-(define gui-eval (make-base-eval))
+(define gui-eval (make-base-eval #:pretty-print? #f))
(define mred? (getenv "MREVAL"))
(define-namespace-anchor anchor)
