diff --git a/collects/scribble/eval.rkt b/collects/scribble/eval.rkt index df9e8f8c..1e9440de 100644 --- a/collects/scribble/eval.rkt +++ b/collects/scribble/eval.rkt @@ -1,6 +1,7 @@ #lang racket/base (require "manual.rkt" "struct.rkt" "scheme.rkt" "decode.rkt" + (only-in "core.rkt" content?) racket/list file/convertible ;; attached into new namespace via anchor racket/pretty ;; attached into new namespace via anchor @@ -110,6 +111,8 @@ (values (substring word 0 fits) (substring word fits) #f) (values #f word #f))))) +(struct formatted-result (content)) + (define (interleave inset? title expr-paras val-list+outputs) (let ([lines (let loop ([expr-paras expr-paras] @@ -139,9 +142,11 @@ (map (lambda (v) (list.flow.list (make-paragraph - (list (elem #:style result-color - (to-element/no-color - v #:expr? (print-as-expression))))))) + (list (if (formatted-result? v) + (formatted-result-content v) + (elem #:style result-color + (to-element/no-color + v #:expr? (print-as-expression)))))))) val-list)))]) (loop (cdr expr-paras) (cdr val-list+outputs) #f))))]) (if inset? @@ -162,6 +167,25 @@ (struct nothing-to-eval ()) +(struct eval-results (contents out err)) +(define (make-eval-results contents out err) + (unless (and (list? contents) + (andmap content? contents)) + (raise-type-error 'eval:results "list of content" contents)) + (unless (string? out) + (raise-type-error 'eval:results "string" out)) + (unless (string? err) + (raise-type-error 'eval:results "string" err)) + (eval-results contents out err)) +(define (make-eval-result content out err) + (unless (content? content) + (raise-type-error 'eval:result "content" content)) + (unless (string? out) + (raise-type-error 'eval:result "string" out)) + (unless (string? err) + (raise-type-error 'eval:result "string" err)) + (eval-results (list content) out err)) + (define (extract-to-evaluate s) (let loop ([s s] [expect #f]) (syntax-case s (code:line code:comment eval:alts eval:check) @@ -227,10 +251,14 @@ (raise-syntax-error 'eval "example result check failed" s)))) r) (lambda (str) - (let-values ([(s expect) (extract-to-evaluate str)]) - (if (nothing-to-eval? s) - (values (list (list (void)) "" "")) - (do-ev/expect s expect))))) + (if (eval-results? str) + (list (map formatted-result (eval-results-contents str)) + (eval-results-out str) + (eval-results-err str)) + (let-values ([(s expect) (extract-to-evaluate str)]) + (if (nothing-to-eval? s) + (list (list (void)) "" "") + (do-ev/expect s expect)))))) ;; Since we evaluate everything in an interaction before we typeset, ;; copy each value to avoid side-effects. @@ -373,12 +401,23 @@ [else s])))) list))) -;; Quote an expression to be evaluated: -(define-syntax-rule (quote-expr e) 'e) -;; This means that sandbox evaluation always works on sexprs, to get -;; it to work on syntaxes, use this definition: -;; (require syntax/strip-context) -;; (define-syntax-rule (quote-expr e) (strip-context (quote-syntax e))) +;; Quote an expression to be evaluated or wrap as escaped: +(define-syntax quote-expr + (syntax-rules (eval:alts eval:result eval:results) + [(_ (eval:alts e1 e2)) (quote-expr e2)] + [(_ (eval:result e)) (make-eval-result (list e) "" "")] + [(_ (eval:result e out)) (make-eval-result (list e) out "")] + [(_ (eval:result e out err)) (make-eval-result (list e) out err)] + [(_ (eval:results es)) (make-eval-results es "" "")] + [(_ (eval:results es out)) (make-eval-results es out "")] + [(_ (eval:results es out err)) (make-eval-results es out err)] + [(_ e) + ;; Using quote means that sandbox evaluation works on + ;; sexprs; to get it to work on syntaxes, use + ;; (strip-context (quote-syntax e))) + ;; while importing + ;; (require syntax/strip-context) + 'e])) (define (do-interaction-eval ev e) (let-values ([(e expect) (extract-to-evaluate e)]) diff --git a/collects/scribblings/scribble/eval.scrbl b/collects/scribblings/scribble/eval.scrbl index 4c57b407..014b38e4 100644 --- a/collects/scribblings/scribble/eval.scrbl +++ b/collects/scribblings/scribble/eval.scrbl @@ -36,17 +36,45 @@ 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. +Certain patterns in @racket[datum] are treated specially: -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. +@itemlist[ -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?]. + @item{A @racket[datum] of the form + @racket[(@#,indexed-racket[code:line] _code-datum (@#,racketidfont{code:comment} _comment-datum ...))] + is treated as @racket[_code-datum] for evaluation.} + + @item{Other uses of @racketidfont{code:comment} and + @racketidfont{code:blank} are stripped from each @racket[datum] + before evaluation.} + + @item{A @racket[datum] of the form + @racket[(@#,indexed-racket[eval:alts] #,(svar show-datum) #,(svar eval-datum))] + is treated as @svar[show-datum] for typesetting and @svar[eval-datum] for evaluation.} + + @item{A @racket[datum] of the form + @racket[(@#,indexed-racket[eval:check] #,(svar eval-datum) #,(svar expect-datum))] + is treated like @racket[_eval-datum], but @svar[check-datum] is also + evaluated, and an error is raised if they are not @racket[equal?].} + + @item{A @racket[datum] of the form + @racket[(@#,indexed-racket[eval:result] _content-expr _out-expr _err-expr)] + involves no sandboxed evaluation; instead, the @tech{content} result of @racket[_content-expr] is used as the + typeset form of the result, @racket[_out-expr] is treated as output printed + by the expression, and @racket[_err-expr] is error output printed by the + expression. The @racket[_out-expr] and/or @racket[_err-expr] can be omitted, + in which case they default to empty strings. + + Normally, @racketidfont{eval:result} + is used in the second part of an @racketidfont{eval:alts} combination.} + + @item{A @racket[datum] of the form + @racket[(@#,indexed-racket[eval:results] _content-list-expr _out-expr _err-expr)] + is treated like an @racketidfont{eval:result} form, except that @racket[_content-list-expr] + should produce a list of @tech{content} for multiple results of evaluation. As + with @racketidfont{eval:result}, @racket[_out-expr] and @racket[_err-expr] are optional.} + +] As an example, diff --git a/collects/tests/scribble/docs/eval-special.scrbl b/collects/tests/scribble/docs/eval-special.scrbl new file mode 100644 index 00000000..bcb12e53 --- /dev/null +++ b/collects/tests/scribble/docs/eval-special.scrbl @@ -0,0 +1,14 @@ +#lang scribble/manual +@(require scribble/eval) + +@interaction[ + (+ 1 2) + (code:line (+ 1 2) (code:comment "three")) + (eval:alts (+ 1 2) 5) + (eval:result @bold{example}) + (eval:alts (+ 1 2) (eval:result @bold{same})) + (eval:alts (+ 1 2) (eval:result @elem{really the same} "Again...")) + (eval:alts (+ 1 2) (eval:result @bold{still the same} "!" "error: too many repeats")) + (eval:alts (+ 1 2) (eval:results (list @racketresult[1] @elem{2} "3") "counting")) +] + diff --git a/collects/tests/scribble/docs/eval-special.txt b/collects/tests/scribble/docs/eval-special.txt new file mode 100644 index 00000000..30072833 --- /dev/null +++ b/collects/tests/scribble/docs/eval-special.txt @@ -0,0 +1,22 @@ + > (+ 1 2) + 3 + > (+ 1 2) ; three + 3 + > (+ 1 2) + 5 + > (eval:result (bold "example")) + example + > (+ 1 2) + same + > (+ 1 2) + Again... + really the same + > (+ 1 2) + ! + error: too many repeats + still the same + > (+ 1 2) + counting + 1 + 2 + 3