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

89
collects/scribble/eval.rkt
View File

@ -92,40 +92,45 @@
(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
;; Error result case: [(string? (caar val-list+outputs))
(map ;; Error result case:
(lambda (s) (map
(car (format-output s error-color))) (lambda (s)
(filter (car (format-output s error-color)))
(lambda (s) (not (equal? s ""))) (filter
(let sloop ([s (caar val-list+outputs)]) (lambda (s) (not (equal? s "")))
(apply (let sloop ([s (caar val-list+outputs)])
append (apply
(map (lambda (s) append
(if ((string-length s) . > . maxlen) (map (lambda (s)
;; break the error message into multiple lines: (if ((string-length s) . > . maxlen)
(let loop ([pos (sub1 maxlen)]) ;; break the error message into multiple lines:
(cond (let loop ([pos (sub1 maxlen)])
[(zero? pos) (cons (substring s 0 maxlen) (cond
(sloop (substring s maxlen)))] [(zero? pos) (cons (substring s 0 maxlen)
[(char-whitespace? (string-ref s pos)) (sloop (substring s maxlen)))]
(cons (substring s 0 pos) [(char-whitespace? (string-ref s pos))
(sloop (substring s (add1 pos))))] (cons (substring s 0 pos)
[else (loop (sub1 pos))])) (sloop (substring s (add1 pos))))]
(list s))) [else (loop (sub1 pos))]))
(regexp-split #rx"\n" s)))))) (list s)))
;; Normal result case: (regexp-split #rx"\n" s))))))]
(let ([val-list (caar val-list+outputs)]) [(box? (caar val-list+outputs))
(if (equal? val-list (list (void))) ;; Output formatted as string:
null (format-output (unbox (caar val-list+outputs)) result-color)]
(map (lambda (v) [else
(list (make-flow (list (make-paragraph ;; Normal result case:
(list (let ([val-list (caar val-list+outputs)])
(hspace 2) (if (equal? val-list (list (void)))
(elem #:style result-color null
(to-element/no-color v #:expr? (print-as-expression))))))))) (map (lambda (v)
val-list)))) (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) (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.}