suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

change Scribble's interaction', etc. to use non-default current-print'

Browse Source 
to format results, if one is installed in a sandboxed evaluator
This commit is contained in:
Matthew Flatt 2010-08-24 20:50:46 -06:00
parent cf300b91b9
commit a19899898f
2 changed files with 70 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
collects/scribble/eval.rkt
View File

@ -92,7 +92,8 @@
(make-flow (list p)))))) (make-flow (list p))))))
(format-output (cadar val-list+outputs) output-color) (format-output (cadar val-list+outputs) output-color)
(format-output (caddar val-list+outputs) error-color) (format-output (caddar val-list+outputs) error-color)
(if (string? (caar val-list+outputs)) (cond
[(string? (caar val-list+outputs))
;; Error result case: ;; Error result case:
(map (map
(lambda (s) (lambda (s)
@ -114,7 +115,11 @@
(sloop (substring s (add1 pos))))] (sloop (substring s (add1 pos))))]
[else (loop (sub1 pos))])) [else (loop (sub1 pos))]))
(list s))) (list s)))
(regexp-split #rx"\n" s)))))) (regexp-split #rx"\n" s))))))]
[(box? (caar val-list+outputs))
;; Output formatted as string:
(format-output (unbox (caar val-list+outputs)) result-color)]
[else
;; Normal result case: ;; Normal result case:
(let ([val-list (caar val-list+outputs)]) (let ([val-list (caar val-list+outputs)])
(if (equal? val-list (list (void))) (if (equal? val-list (list (void)))
@ -125,7 +130,7 @@
(hspace 2) (hspace 2)
(elem #:style result-color (elem #:style result-color
(to-element/no-color v #:expr? (print-as-expression))))))))) (to-element/no-color v #:expr? (print-as-expression)))))))))
val-list)))) val-list)))])
(loop (cdr expr-paras) (loop (cdr expr-paras)
(cdr val-list+outputs) (cdr val-list+outputs)
#f))))))) #f)))))))
@ -159,7 +164,21 @@
(get-output ev) (get-output ev)
(get-error-output ev)))]) (get-error-output ev)))])
(list (let ([v (do-plain-eval ev s #t)]) (list (let ([v (do-plain-eval ev s #t)])
(make-reader-graph (copy-value v (make-hasheq)))) (if (call-in-sandbox-context
ev
(let ([cp (current-print)])
(lambda ()
(and (eq? (current-print) cp)
(print-as-expression)))))
(make-reader-graph (copy-value v (make-hasheq)))
(box
(call-in-sandbox-context
ev
(lambda ()
(let ([s (open-output-string)])
(parameterize ([current-output-port s])
(map (current-print) v))
(get-output-string s)))))))
(get-output ev) (get-output ev)
(get-error-output ev)))]) (get-error-output ev)))])
(when expect (when expect

20
collects/scribblings/scribble/eval.scrbl
View File

@ -25,12 +25,24 @@ set to @racket['string]. If @racket[eval] is not provided, an
evaluator is created using @racket[make-base-eval]. See also evaluator is created using @racket[make-base-eval]. See also
@racket[make-eval-factory]. @racket[make-eval-factory].
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].
Uses of @racket[code:comment] and @racketidfont{code:blank} are Uses of @racket[code:comment] and @racketidfont{code:blank} are
stipped from each @racket[datum] before evaluation. stipped from each @racket[datum] before evaluation.
If a @racket[datum] has the form @racket[(@#,indexed-racket[eval:alts] If a @racket[datum] has the form @racket[(@#,indexed-racket[eval:alts]
#,(svar show-datum) #,(svar eval-datum))], then @svar[show-datum] is #,(svar show-datum) #,(svar eval-datum))], then @svar[show-datum] is
typeset, while @svar[eval-datum] is evaluated.} typeset, while @svar[eval-datum] is evaluated.
If a @racket[datum] has the form
@racket[(@#,indexed-racket[eval:check] #,(svar eval-datum) #,(svar
expect-datum))], then both @svar[eval-datum] and @svar[check-datum]
are evaluated, and an error is raised if they are not @racket[equal?].}
@defform*[[(interaction-eval datum) @defform*[[(interaction-eval datum)
@ -90,8 +102,8 @@ prompt, and with line of space after it.}
@defproc[(make-base-eval) (any/c . -> . any)]{ @defproc[(make-base-eval) (any/c . -> . any)]{
Creates an evaluator using @racket[(make-evaluator 'racket/base)], Creates an evaluator using @racket[(make-evaluator 'racket/base)],
setting sandbox parameters to disable limits, set the outputs to setting sandbox parameters to disable limits, setting the outputs to
@racket['string], and not add extra security guards.} @racket['string], and not adding extra security guards.}
@defproc[(make-base-eval-factory [mod-paths (listof module-path?)]) (-> (any/c . -> . any))]{ @defproc[(make-base-eval-factory [mod-paths (listof module-path?)]) (-> (any/c . -> . any))]{
@ -105,7 +117,7 @@ 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?)]) (-> (any/c . -> . any))]{
Like @racket[make-base-eval-factor], but each module in @racket[mod-paths] is 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.} also required into the top-level environment for each generated evaluator.}