From c18603f767b088625d855b8dbf68137b2b8d930d Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Mon, 31 May 2010 13:55:16 -0600 Subject: [PATCH] add racketresultblock, etc. to Scribble --- collects/scribble/eval.rkt | 8 ++-- collects/scribble/private/manual-scheme.rkt | 30 ++++++++++++- collects/scribble/racket.rkt | 50 ++++++++++++--------- collects/scribblings/scribble/manual.scrbl | 19 ++++++-- collects/scribblings/scribble/scheme.scrbl | 21 +++++++-- 5 files changed, 95 insertions(+), 33 deletions(-) diff --git a/collects/scribble/eval.rkt b/collects/scribble/eval.rkt index 9b5e221d6f..fbc0f1dd65 100644 --- a/collects/scribble/eval.rkt +++ b/collects/scribble/eval.rkt @@ -371,10 +371,10 @@ [(_ t racketinput* e ...) (titled-interaction #:eval (make-base-eval) t racketinput* e ...)])) - (define-syntax interaction - (syntax-rules () - [(_ #:eval ev e ...) (titled-interaction #:eval ev #f racketinput* e ...)] - [(_ e ...) (titled-interaction #f racketinput* e ...)])) + (define-syntax interaction + (syntax-rules () + [(_ #:eval ev e ...) (titled-interaction #:eval ev #f racketinput* e ...)] + [(_ e ...) (titled-interaction #f racketinput* e ...)])) (define-syntax racketblock+eval (syntax-rules () diff --git a/collects/scribble/private/manual-scheme.rkt b/collects/scribble/private/manual-scheme.rkt index 96b2d66d6d..c9cea903dd 100644 --- a/collects/scribble/private/manual-scheme.rkt +++ b/collects/scribble/private/manual-scheme.rkt @@ -12,8 +12,10 @@ (provide racketblock RACKETBLOCK racketblock/form racketblock0 RACKETBLOCK0 racketblock0/form + racketresultblock racketresultblock0 + RACKETRESULTBLOCK RACKETRESULTBLOCK0 racketblockelem - racketinput + racketinput RACKETINPUT racketmod racket RACKET racket/form racketresult racketid racketmodname @@ -44,12 +46,38 @@ (define-code RACKETBLOCK (to-paragraph/prefix (hspace 2) (hspace 2) "") UNSYNTAX) (define-code RACKETBLOCK0 to-paragraph UNSYNTAX) + +(define (to-result-paragraph v) + (to-paragraph v + #:color? #f + #:wrap-elem + (lambda (e) (make-element result-color e)))) +(define (to-result-paragraph/prefix a b c) + (let ([to-paragraph (to-paragraph/prefix a b c)]) + (lambda (v) + (to-paragraph v + #:color? #f + #:wrap-elem + (lambda (e) (make-element result-color e)))))) + +(define-code racketresultblock0 to-result-paragraph) +(define-code racketresultblock (to-result-paragraph/prefix (hspace 2) (hspace 2) "")) +(define-code RACKETRESULTBLOCK (to-result-paragraph/prefix (hspace 2) (hspace 2) "") + UNSYNTAX) +(define-code RACKETRESULTBLOCK0 to-result-paragraph UNSYNTAX) + (define interaction-prompt (make-element 'tt (list "> " ))) (define-code racketinput (to-paragraph/prefix (make-element #f (list (hspace 2) interaction-prompt)) (hspace 4) "")) +(define-code RACKETINPUT + (to-paragraph/prefix + (make-element #f (list (hspace 2) interaction-prompt)) + (hspace 4) + "") + UNSYNTAX) (define-syntax (racketmod stx) (syntax-case stx () diff --git a/collects/scribble/racket.rkt b/collects/scribble/racket.rkt index 5a14c8b1e6..08d417f778 100644 --- a/collects/scribble/racket.rkt +++ b/collects/scribble/racket.rkt @@ -253,7 +253,7 @@ (define omitable (make-style #f '(omitable))) - (define (gen-typeset c multi-line? prefix1 prefix suffix color? expr?) + (define (gen-typeset c multi-line? prefix1 prefix suffix color? expr? elem-wrap) (let* ([c (syntax-ize c 0 #:expr? expr?)] [content null] [docs null] @@ -309,13 +309,14 @@ (out prefix cls)) (out " " cls))] [else - (set! content (cons ((if highlight? - (lambda (c) - (make-element highlighted-color c)) - values) - (if (and color? cls) - (make-element/cache cls v) - v)) + (set! content (cons (elem-wrap + ((if highlight? + (lambda (c) + (make-element highlighted-color c)) + values) + (if (and color? cls) + (make-element/cache cls v) + v))) content)) (set! dest-col (+ dest-col len))]))])) (define advance @@ -372,7 +373,7 @@ (if val? value-color #f) (list (make-element/cache (if val? value-color paren-color) '". ") - (typeset a #f "" "" "" (not val?) expr?) + (typeset a #f "" "" "" (not val?) expr? elem-wrap) (make-element/cache (if val? value-color paren-color) '" .")) (+ (syntax-span a) 4))) (list (syntax-source a) @@ -798,7 +799,7 @@ (make-table block-color (map list (reverse docs)))) (make-sized-element #f (reverse content) dest-col)))) - (define (typeset c multi-line? prefix1 prefix suffix color? expr?) + (define (typeset c multi-line? prefix1 prefix suffix color? expr? elem-wrap) (let* ([c (syntax-ize c 0 #:expr? expr?)] [s (syntax-e c)]) (if (or multi-line? @@ -815,31 +816,38 @@ (struct-proxy? s) (and expr? (or (identifier? c) (keyword? (syntax-e c))))) - (gen-typeset c multi-line? prefix1 prefix suffix color? expr?) + (gen-typeset c multi-line? prefix1 prefix suffix color? expr? elem-wrap) (typeset-atom c (letrec ([mk (case-lambda [(elem color) (mk elem color (or (syntax-span c) 1))] [(elem color len) - (if (and (string? elem) - (= len (string-length elem))) - (make-element/cache (and color? color) elem) - (make-sized-element (and color? color) elem len))])]) + (elem-wrap + (if (and (string? elem) + (= len (string-length elem))) + (make-element/cache (and color? color) elem) + (make-sized-element (and color? color) elem len)))])]) mk) color? 0 expr?)))) (define (to-element c #:expr? [expr? #f]) - (typeset c #f "" "" "" #t expr?)) + (typeset c #f "" "" "" #t expr? values)) (define (to-element/no-color c #:expr? [expr? #f]) - (typeset c #f "" "" "" #f expr?)) + (typeset c #f "" "" "" #f expr? values)) - (define (to-paragraph c #:expr? [expr? #f]) - (typeset c #t "" "" "" #t expr?)) + (define (to-paragraph c + #:expr? [expr? #f] + #:color? [color? #t] + #:wrap-elem [elem-wrap (lambda (e) e)]) + (typeset c #t "" "" "" color? expr? elem-wrap)) - (define ((to-paragraph/prefix pfx1 pfx sfx) c #:expr? [expr? #f]) - (typeset c #t pfx1 pfx sfx #t expr?)) + (define ((to-paragraph/prefix pfx1 pfx sfx) c + #:expr? [expr? #f] + #:color? [color? #t] + #:wrap-elem [elem-wrap (lambda (e) e)]) + (typeset c #t pfx1 pfx sfx color? expr? elem-wrap)) (begin-for-syntax (define-struct variable-id (sym) diff --git a/collects/scribblings/scribble/manual.scrbl b/collects/scribblings/scribble/manual.scrbl index 0a4d96dea7..88d5db4489 100644 --- a/collects/scribblings/scribble/manual.scrbl +++ b/collects/scribblings/scribble/manual.scrbl @@ -140,8 +140,21 @@ without insetting the code.} @defform[(RACKETBLOCK0 datum ...)]{Like @racket[RACKETBLOCK], but without insetting the code.} -@defform[(racketinput datum ...)]{Like @racket[racketblock], but the -@racket[datum] are typeset after a prompt representing a REPL.} +@deftogether[( +@defform[(racketresultblock datum ...)] +@defform[(racketresultblock0 datum ...)] +@defform[(RACKETRESULTBLOCK datum ...)] +@defform[(RACKETRESULTBLOCK0 datum ...)] +)]{ + +Like @racketblock[racketblock], etc., but colors the typeset text as a +result (i.e., a single color with no hyperlinks) instead of code.} + +@deftogether[( +@defform[(racketinput datum ...)] +@defform[(RACKETINPUT datum ...)] +)]{Like @racket[racketblock] and @racket[RACKETBLOCK], but the +@racket[datum]s are typeset after a prompt representing a REPL.} @defform/subs[(racketmod maybe-file lang datum ...) ([maybe-file code:blank @@ -167,7 +180,7 @@ the formatting of @racket[datum].} @racket[UNSYNTAX] escape like @racket[racketblock].} @defform[(racketresult datum ...)]{Like @racket[racket], but typeset -as a REPL value (i.e., a single color with no hyperlinks).} +as a result (i.e., a single color with no hyperlinks).} @defform[(racketid datum ...)]{Like @racket[racket], but typeset as an unbound identifier (i.e., no coloring or hyperlinks).} diff --git a/collects/scribblings/scribble/scheme.scrbl b/collects/scribblings/scribble/scheme.scrbl index 5db7a498c4..3015f9d03f 100644 --- a/collects/scribblings/scribble/scheme.scrbl +++ b/collects/scribblings/scribble/scheme.scrbl @@ -43,7 +43,11 @@ The @racket[stx-prop-expr] should produce a procedure for recording a @racket[id] has such a property. The default is @racket[syntax-property].} -@defproc[(to-paragraph [v any/c] [#:expr? expr? any/c #f]) block?]{ +@defproc[(to-paragraph [v any/c] + [#:expr? expr? any/c #f] + [#:color? color? any/c #t] + [#:wrap-elem wrap-elem (element? . -> . element?) (lambda (e) e)]) + block?]{ Typesets an S-expression that is represented by a syntax object, where source-location information in the syntax object controls the @@ -68,11 +72,20 @@ style, much like @racket[print] with the @racket[print-as-expression] parameter set to @racket[#t]. In that case, @racket[for-label] bindings on identifiers are ignored, since the identifiers are all quoted in the output. Typically, @racket[expr?] is set to true for -printing result values.} +printing result values. + +If @racket[color?] is @racket[#f], then the output is typeset without +coloring. + +The @racket[wrap-elem] procedure is applied to each element +constructed for the resulting block. When combined with @racket[#f] +for @racket[color?], for example, the @racket[wrap-elem] procedure can +be used to give a style to an element.} -@defproc[((to-paragraph/prefix [prefix1 any/c] [prefix any/c] [suffix any/c] [#:expr? expr? any/c #f]) - [v any/c]) +@defproc[((to-paragraph/prefix [prefix1 any/c] [prefix any/c] [suffix any/c]) + [v any/c] [#:expr? expr? any/c #f] [#:color? color? any/c #f] + [#:wrap-elem wrap-elem (element? . -> . element?) (lambda (e) e)]) block?]{ Like @racket[to-paragraph], but @racket[prefix1] is prefixed onto the