add code' to
scribble/manual'
original commit: 4555254380c81815195bb55915bdb5cbd3ebc235
This commit is contained in:
parent
97bf4968a3
commit
55eed8ac98
|
@ -12,7 +12,8 @@
|
||||||
|
|
||||||
(provide codeblock
|
(provide codeblock
|
||||||
codeblock0
|
codeblock0
|
||||||
typeset-code)
|
typeset-code
|
||||||
|
code)
|
||||||
|
|
||||||
(define-for-syntax (do-codeblock stx)
|
(define-for-syntax (do-codeblock stx)
|
||||||
(syntax-parse stx
|
(syntax-parse stx
|
||||||
|
@ -53,6 +54,7 @@
|
||||||
#:indent [indent 2]
|
#:indent [indent 2]
|
||||||
#:keep-lang-line? [keep-lang-line? #t]
|
#:keep-lang-line? [keep-lang-line? #t]
|
||||||
#:line-numbers [line-numbers #f]
|
#:line-numbers [line-numbers #f]
|
||||||
|
#:block? [block? #t]
|
||||||
. strs)
|
. strs)
|
||||||
(let* ([str (apply string-append strs)]
|
(let* ([str (apply string-append strs)]
|
||||||
[bstr (string->bytes/utf-8 (regexp-replace* #rx"(?m:^$)" str "\xA0"))]
|
[bstr (string->bytes/utf-8 (regexp-replace* #rx"(?m:^$)" str "\xA0"))]
|
||||||
|
@ -155,12 +157,13 @@
|
||||||
(and (= (cadr a) (cadr b))
|
(and (= (cadr a) (cadr b))
|
||||||
(> (cadddr a) (cadddr b))))))]
|
(> (cadddr a) (cadddr b))))))]
|
||||||
[default-color meta-color])
|
[default-color meta-color])
|
||||||
(table
|
((if block? table (lambda (style lines) (make-element #f lines)))
|
||||||
block-color
|
block-color
|
||||||
((if keep-lang-line? values cdr) ; FIXME: #lang can span lines
|
((if keep-lang-line? values cdr) ; FIXME: #lang can span lines
|
||||||
(list->lines
|
(list->lines
|
||||||
indent
|
indent
|
||||||
#:line-numbers line-numbers
|
#:line-numbers line-numbers
|
||||||
|
#:block? block?
|
||||||
(let loop ([pos 0]
|
(let loop ([pos 0]
|
||||||
[tokens tokens])
|
[tokens tokens])
|
||||||
(cond
|
(cond
|
||||||
|
@ -190,6 +193,40 @@
|
||||||
(split-lines default-color (substring* bstr pos (cadar tokens)))
|
(split-lines default-color (substring* bstr pos (cadar tokens)))
|
||||||
(loop (cadar tokens) 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)
|
(define (split-lines style s)
|
||||||
(cond
|
(cond
|
||||||
|
@ -207,7 +244,9 @@
|
||||||
|
|
||||||
(define omitable (make-style #f '(omitable)))
|
(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)
|
(define indent-elem (if (zero? indent-amt)
|
||||||
""
|
""
|
||||||
(hspace indent-amt)))
|
(hspace indent-amt)))
|
||||||
|
@ -233,11 +272,12 @@
|
||||||
|
|
||||||
(define (make-line accum-line line-number)
|
(define (make-line accum-line line-number)
|
||||||
(define rest (cons indent-elem accum-line))
|
(define rest (cons indent-elem accum-line))
|
||||||
(list (paragraph omitable (if line-numbers
|
(list ((if block? paragraph (lambda (s e) e))
|
||||||
|
omitable
|
||||||
|
(if line-numbers
|
||||||
(prepend-line-number line-number rest)
|
(prepend-line-number line-number rest)
|
||||||
rest))))
|
rest))))
|
||||||
|
|
||||||
(for/list ([l (break-list l 'newline)]
|
(for/list ([l (break-list l 'newline)]
|
||||||
[i (in-naturals (or line-numbers 1))])
|
[i (in-naturals (or line-numbers 1))])
|
||||||
(make-line l i)))
|
(make-line l i)))
|
||||||
|
|
||||||
|
|
|
@ -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 ...)
|
@defform/subs[(racketblock maybe-escape datum ...)
|
||||||
([maybe-escape code:blank
|
([maybe-escape code:blank
|
||||||
(code:line #:escape escape-id)])]{
|
(code:line #:escape escape-id)])]{
|
||||||
|
|
Loading…
Reference in New Issue
Block a user