change Scribble's interaction', etc. to use non-default current-print'
to format results, if one is installed in a sandboxed evaluator original commit: a19899898f1f7774f634ad44df560f4813fec91c
This commit is contained in:
Matthew Flatt
parent
d9f0de4582
commit
6ce47a9d1e
|
|
@ -92,40 +92,45 @@
|
|||
(make-flow (list p))))))
|
||||
(format-output (cadar val-list+outputs) output-color)
|
||||
(format-output (caddar val-list+outputs) error-color)
|
||||
(if (string? (caar val-list+outputs))
|
||||
;; Error result case:
|
||||
(map
|
||||
(lambda (s)
|
||||
(car (format-output s error-color)))
|
||||
(filter
|
||||
(lambda (s) (not (equal? s "")))
|
||||
(let sloop ([s (caar val-list+outputs)])
|
||||
(apply
|
||||
append
|
||||
(map (lambda (s)
|
||||
(if ((string-length s) . > . maxlen)
|
||||
;; break the error message into multiple lines:
|
||||
(let loop ([pos (sub1 maxlen)])
|
||||
(cond
|
||||
[(zero? pos) (cons (substring s 0 maxlen)
|
||||
(sloop (substring s maxlen)))]
|
||||
[(char-whitespace? (string-ref s pos))
|
||||
(cons (substring s 0 pos)
|
||||
(sloop (substring s (add1 pos))))]
|
||||
[else (loop (sub1 pos))]))
|
||||
(list s)))
|
||||
(regexp-split #rx"\n" s))))))
|
||||
;; Normal result case:
|
||||
(let ([val-list (caar val-list+outputs)])
|
||||
(if (equal? val-list (list (void)))
|
||||
null
|
||||
(map (lambda (v)
|
||||
(list (make-flow (list (make-paragraph
|
||||
(list
|
||||
(hspace 2)
|
||||
(elem #:style result-color
|
||||
(to-element/no-color v #:expr? (print-as-expression)))))))))
|
||||
val-list))))
|
||||
(cond
|
||||
[(string? (caar val-list+outputs))
|
||||
;; Error result case:
|
||||
(map
|
||||
(lambda (s)
|
||||
(car (format-output s error-color)))
|
||||
(filter
|
||||
(lambda (s) (not (equal? s "")))
|
||||
(let sloop ([s (caar val-list+outputs)])
|
||||
(apply
|
||||
append
|
||||
(map (lambda (s)
|
||||
(if ((string-length s) . > . maxlen)
|
||||
;; break the error message into multiple lines:
|
||||
(let loop ([pos (sub1 maxlen)])
|
||||
(cond
|
||||
[(zero? pos) (cons (substring s 0 maxlen)
|
||||
(sloop (substring s maxlen)))]
|
||||
[(char-whitespace? (string-ref s pos))
|
||||
(cons (substring s 0 pos)
|
||||
(sloop (substring s (add1 pos))))]
|
||||
[else (loop (sub1 pos))]))
|
||||
(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)]
|
||||
[else
|
||||
;; Normal result case:
|
||||
(let ([val-list (caar val-list+outputs)])
|
||||
(if (equal? val-list (list (void)))
|
||||
null
|
||||
(map (lambda (v)
|
||||
(list (make-flow (list (make-paragraph
|
||||
(list
|
||||
(hspace 2)
|
||||
(elem #:style result-color
|
||||
(to-element/no-color v #:expr? (print-as-expression)))))))))
|
||||
val-list)))])
|
||||
(loop (cdr expr-paras)
|
||||
(cdr val-list+outputs)
|
||||
#f)))))))
|
||||
|
|
@ -159,7 +164,21 @@
|
|||
(get-output ev)
|
||||
(get-error-output ev)))])
|
||||
(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-error-output ev)))])
|
||||
(when expect
|
||||
|
|
|
|||
|
|
@ -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
|
||||
@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
|
||||
stipped from each @racket[datum] before evaluation.
|
||||
|
||||
If a @racket[datum] has the form @racket[(@#,indexed-racket[eval:alts]
|
||||
#,(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)
|
||||
|
|
@ -90,8 +102,8 @@ prompt, and with line of space after it.}
|
|||
@defproc[(make-base-eval) (any/c . -> . any)]{
|
||||
|
||||
Creates an evaluator using @racket[(make-evaluator 'racket/base)],
|
||||
setting sandbox parameters to disable limits, set the outputs to
|
||||
@racket['string], and not add extra security guards.}
|
||||
setting sandbox parameters to disable limits, setting the outputs to
|
||||
@racket['string], and not adding extra security guards.}
|
||||
|
||||
|
||||
@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))]{
|
||||
|
||||
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.}
|
||||
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user