diff --git a/collects/scribble/private/manual-code.rkt b/collects/scribble/private/manual-code.rkt index a5146b4b..f90e7507 100644 --- a/collects/scribble/private/manual-code.rkt +++ b/collects/scribble/private/manual-code.rkt @@ -12,7 +12,8 @@ (provide codeblock codeblock0 - typeset-code) + typeset-code + code) (define-for-syntax (do-codeblock stx) (syntax-parse stx @@ -53,6 +54,7 @@ #:indent [indent 2] #:keep-lang-line? [keep-lang-line? #t] #:line-numbers [line-numbers #f] + #:block? [block? #t] . strs) (let* ([str (apply string-append strs)] [bstr (string->bytes/utf-8 (regexp-replace* #rx"(?m:^$)" str "\xA0"))] @@ -155,12 +157,13 @@ (and (= (cadr a) (cadr b)) (> (cadddr a) (cadddr b))))))] [default-color meta-color]) - (table + ((if block? table (lambda (style lines) (make-element #f lines))) block-color ((if keep-lang-line? values cdr) ; FIXME: #lang can span lines (list->lines indent #:line-numbers line-numbers + #:block? block? (let loop ([pos 0] [tokens tokens]) (cond @@ -190,6 +193,40 @@ (split-lines default-color (substring* bstr pos (cadar tokens))) (loop (cadar tokens) tokens))])))))))) +(define (typeset-code-line context expand lang-line . strs) + (typeset-code + #:context context + #:expand expand + #:keep-lang-line? (not lang-line) + #:block? #f + #:indent 0 + (let ([s (regexp-replace* #px"(?:\\s*(?:\r|\n|\r\n)\\s*)+" (apply string-append strs) " ")]) + (if lang-line + (string-append "#lang " lang-line "\n" s) + s)))) + +(define-syntax (code stx) + (syntax-parse stx + [(_ (~seq (~or (~optional (~seq #:expand expand-expr:expr) + #:defaults ([expand-expr #'#f]) + #:name "#:expand keyword") + (~optional (~seq #:context context-expr:expr) + #:name "#:context keyword") + (~optional (~seq #:lang lang-line-expr:expr) + #:defaults ([lang-line-expr #'#f]) + #:name "#:lang-line keyword")) + ...) + str ...) + #`(typeset-code-line #,(if (attribute context-expr) + #'context-expr + (or + (let ([v #'(str ...)]) + (and (pair? (syntax-e v)) + #`#'#,(car (syntax-e v)))) + #'#f)) + expand-expr + lang-line-expr + str ...)])) (define (split-lines style s) (cond @@ -207,7 +244,9 @@ (define omitable (make-style #f '(omitable))) -(define (list->lines indent-amt l #:line-numbers [line-numbers #f]) +(define (list->lines indent-amt l + #:line-numbers line-numbers + #:block? block?) (define indent-elem (if (zero? indent-amt) "" (hspace indent-amt))) @@ -233,11 +272,12 @@ (define (make-line accum-line line-number) (define rest (cons indent-elem accum-line)) - (list (paragraph omitable (if line-numbers - (prepend-line-number line-number rest) - rest)))) + (list ((if block? paragraph (lambda (s e) e)) + omitable + (if line-numbers + (prepend-line-number line-number rest) + rest)))) (for/list ([l (break-list l 'newline)] [i (in-naturals (or line-numbers 1))]) - (make-line l i))) - + (make-line l i))) diff --git a/collects/scribblings/scribble/manual.scrbl b/collects/scribblings/scribble/manual.scrbl index 537e0ac0..994fba0e 100644 --- a/collects/scribblings/scribble/manual.scrbl +++ b/collects/scribblings/scribble/manual.scrbl @@ -97,6 +97,41 @@ produces the typeset result } +@defform/subs[(code option ... str-expr ...+) + ([option (code:line #:lang lang-line-expr) + (code:line #:expand expand-expr) + (code:line #:context context-expr)]) + #:contracts ([lang-line-expr (or/c #f string?)] + [expand-expr (or/c #f (syntax-object? . -> . syntax-object?))] + [context-expr syntax-object?])]{ + +Like @racket[codeblock], but produces an element instead of a +block. No @hash-lang[] line should appear in the string content; +instead, it should be provided @racket[#:lang] (as a string +without @racket["#lang"]) if needed, and the @hash-lang[] line is always stripped +from the output when provided. Also, each newline in @racket[str-expr]s is collapsed +along with all surrounding whitespace to a single space. + +For example, + +@codeblock[#:keep-lang-line? #f]|<|{ + #lang scribble/manual + + This is @code[#:lang "at-exp racket"]|{@bold{Hi}}|'s result: + @bold{Hi}. +}|>| + +produces the typeset result + +@nested[#:style 'inset]{ + This is @code[#:lang "at-exp racket"]|{@bold{Hi}}|'s result: + @bold{Hi}. +} + +} + + + @defform/subs[(racketblock maybe-escape datum ...) ([maybe-escape code:blank (code:line #:escape escape-id)])]{