add `codeblock' to Scribble
original commit: aa7c4b53d9c2962536b3a37bb244600d7216289e
This commit is contained in:
Matthew Flatt
parent
688bb59c1a
commit
d6b3461aad
|
|
@ -2,6 +2,7 @@
|
|||
(require "base.ss"
|
||||
"private/manual-style.ss"
|
||||
"private/manual-scheme.ss"
|
||||
"private/manual-code.ss"
|
||||
"private/manual-mod.ss"
|
||||
"private/manual-tech.ss"
|
||||
"private/manual-bib.ss"
|
||||
|
|
@ -18,6 +19,7 @@
|
|||
(all-from-out "base.ss"
|
||||
"private/manual-style.ss"
|
||||
"private/manual-scheme.ss"
|
||||
"private/manual-code.ss"
|
||||
"private/manual-mod.ss"
|
||||
"private/manual-tech.ss"
|
||||
"private/manual-bib.ss"
|
||||
|
|
|
|||
194
collects/scribble/private/manual-code.rkt
Normal file
194
collects/scribble/private/manual-code.rkt
Normal file
|
|
@ -0,0 +1,194 @@
|
|||
#lang racket/base
|
||||
(require syntax/strip-context
|
||||
syntax-color/module-lexer
|
||||
"../racket.rkt"
|
||||
"../core.rkt"
|
||||
"../base.rkt"
|
||||
"manual-scheme.rkt"
|
||||
(for-syntax racket/base
|
||||
syntax/parse))
|
||||
|
||||
(provide codeblock
|
||||
typeset-code)
|
||||
|
||||
(define-syntax (codeblock stx)
|
||||
(syntax-parse stx
|
||||
[(_ (~seq (~or (~optional (~seq #:expand expand-expr:expr)
|
||||
#:defaults ([expand-expr #'#f])
|
||||
#:name "#:expand keyword")
|
||||
(~optional (~seq #:indent indent-expr:expr)
|
||||
#:defaults ([indent-expr #'2])
|
||||
#:name "#:expand keyword")
|
||||
(~optional (~seq #:keep-lang-line? keep-lang-line?-expr:expr)
|
||||
#:defaults ([keep-lang-line?-expr #'#t])
|
||||
#:name "#:keep-lang-line? keyword")
|
||||
(~optional (~seq #:context context-expr:expr)
|
||||
#:name "#:context keyword"))
|
||||
...)
|
||||
str ...)
|
||||
#`(typeset-code str ...
|
||||
#:expand expand-expr
|
||||
#:keep-lang-line? keep-lang-line?-expr
|
||||
#:indent indent-expr
|
||||
#:context #,(if (attribute context-expr)
|
||||
#'context-expr
|
||||
(or
|
||||
(let ([v #'(str ...)])
|
||||
(and (pair? (syntax-e v))
|
||||
#`#'#,(car (syntax-e v))))
|
||||
#'#f)))]))
|
||||
|
||||
(define (typeset-code #:context [context #f]
|
||||
#:expand [expand #f]
|
||||
#:indent [indent 2]
|
||||
#:keep-lang-line? [keep-lang-line? #t]
|
||||
. strs)
|
||||
(let* ([str (apply string-append strs)]
|
||||
[bstr (string->bytes/utf-8 (regexp-replace* #rx"(?m:^$)" str "\xA0"))]
|
||||
[in (open-input-bytes bstr)])
|
||||
(let* ([tokens
|
||||
(let loop ([mode #f])
|
||||
(let-values ([(lexeme type data start end backup-delta mode)
|
||||
(module-lexer in 0 mode)])
|
||||
(if (eof-object? lexeme)
|
||||
null
|
||||
(cons (list type (sub1 start) (sub1 end) 0)
|
||||
(loop mode)))))]
|
||||
[substring* (lambda (bstr start [end (bytes-length bstr)])
|
||||
(bytes->string/utf-8 (subbytes bstr start end)))]
|
||||
[e (parameterize ([read-accept-reader #t])
|
||||
((or expand
|
||||
(lambda (stx)
|
||||
(if context
|
||||
(replace-context context stx)
|
||||
stx)))
|
||||
(read-syntax 'prog (open-input-bytes bstr))))]
|
||||
[ids (let loop ([e e])
|
||||
(cond
|
||||
[(and (identifier? e)
|
||||
(syntax-original? e))
|
||||
(let ([pos (sub1 (syntax-position e))])
|
||||
(list (list (to-element e)
|
||||
pos
|
||||
(+ pos (syntax-span e))
|
||||
1)))]
|
||||
[(syntax? e) (append (loop (syntax-e e))
|
||||
(loop (or (syntax-property e 'origin)
|
||||
null))
|
||||
(loop (or (syntax-property e 'disappeared-use)
|
||||
null)))]
|
||||
[(pair? e) (append (loop (car e)) (loop (cdr e)))]
|
||||
[else null]))]
|
||||
[link-mod (lambda (mp-stx priority #:orig? [always-orig? #f])
|
||||
(if (or always-orig?
|
||||
(syntax-original? mp-stx))
|
||||
(let ([mp (syntax->datum mp-stx)]
|
||||
[pos (sub1 (syntax-position mp-stx))])
|
||||
(list (list (racketmodname #,mp)
|
||||
pos
|
||||
(+ pos (syntax-span mp-stx))
|
||||
priority)))
|
||||
null))]
|
||||
;; This makes sense when `expand' actually expands, and
|
||||
;; probably not otherwise:
|
||||
[mods (let loop ([e e])
|
||||
(syntax-case e (module require begin)
|
||||
[(module name lang (mod-beg form ...))
|
||||
(apply append
|
||||
(link-mod #'lang 2)
|
||||
(map loop (syntax->list #'(form ...))))]
|
||||
[(#%require spec ...)
|
||||
(apply append
|
||||
(map (lambda (spec)
|
||||
;; Need to add support for renaming forms, etc.:
|
||||
(if (module-path? (syntax->datum spec))
|
||||
(link-mod spec 2)
|
||||
null))
|
||||
(syntax->list #'(spec ...))))]
|
||||
[(begin form ...)
|
||||
(apply append
|
||||
(map loop (syntax->list #'(form ...))))]
|
||||
[else null]))]
|
||||
[language (if (regexp-match? #rx"^#lang " bstr)
|
||||
(let ([m (regexp-match #rx"^#lang ([-a-zA-Z/._+]+)" bstr)])
|
||||
(if m
|
||||
(link-mod
|
||||
#:orig? #t
|
||||
(datum->syntax #f
|
||||
(string->symbol (bytes->string/utf-8 (cadr m)))
|
||||
(vector 'in 1 6 7 (bytes-length (cadr m))))
|
||||
3)
|
||||
null))
|
||||
null)]
|
||||
[tokens (sort (append ids
|
||||
mods
|
||||
language
|
||||
(filter (lambda (x) (not (eq? (car x) 'symbol)))
|
||||
;; Drop #lang entry:
|
||||
(cdr tokens)))
|
||||
(lambda (a b)
|
||||
(or (< (cadr a) (cadr b))
|
||||
(and (= (cadr a) (cadr b))
|
||||
(> (cadddr a) (cadddr b))))))]
|
||||
[default-color meta-color])
|
||||
(table
|
||||
block-color
|
||||
((if keep-lang-line? values cdr) ; FIXME: #lang can span lines
|
||||
(list->lines
|
||||
indent
|
||||
(let loop ([pos 0]
|
||||
[tokens tokens])
|
||||
(cond
|
||||
[(null? tokens) (split-lines default-color (substring* bstr pos))]
|
||||
[(eq? (caar tokens) 'white-space) (loop pos (cdr tokens))]
|
||||
[(= pos (cadar tokens))
|
||||
(append (let ([style (caar tokens)])
|
||||
(if (symbol? style)
|
||||
(let ([scribble-style
|
||||
(case style
|
||||
[(symbol) symbol-color]
|
||||
[(parenthesis) paren-color]
|
||||
[(constant string) value-color]
|
||||
[(comment) comment-color]
|
||||
[else default-color])])
|
||||
(split-lines scribble-style
|
||||
(substring* bstr (cadar tokens) (caddar tokens))))
|
||||
(list (caar tokens))))
|
||||
(loop (caddar tokens) (cdr tokens)))]
|
||||
[(> pos (cadar tokens))
|
||||
(loop pos (cdr tokens))]
|
||||
[else (append
|
||||
(split-lines default-color (substring* bstr pos (cadar tokens)))
|
||||
(loop (cadar tokens) tokens))]))))))))
|
||||
|
||||
|
||||
(define (split-lines style s)
|
||||
(cond
|
||||
[(regexp-match-positions #rx"(?:\r\n|\r|\n)" s)
|
||||
=> (lambda (m)
|
||||
(list* (element style (substring s 0 (caar m)))
|
||||
'newline
|
||||
(split-lines style (substring s (cdar m)))))]
|
||||
[(regexp-match-positions #rx" +" s)
|
||||
=> (lambda (m)
|
||||
(append (split-lines style (substring s 0 (caar m)))
|
||||
(list (hspace (- (cdar m) (caar m))))
|
||||
(split-lines style (substring s (cdar m)))))]
|
||||
[else (list (element style s))]))
|
||||
|
||||
(define omitable (make-style #f '(omitable)))
|
||||
|
||||
(define (list->lines indent-amt l)
|
||||
(define (make-line accum-line) (list (paragraph omitable
|
||||
(cons indent-elem
|
||||
(reverse accum-line)))))
|
||||
(define indent-elem (hspace indent-amt))
|
||||
(let loop ([l l] [accum-line null])
|
||||
(cond
|
||||
[(null? l) (if (null? accum-line)
|
||||
null
|
||||
(list (make-line accum-line)))]
|
||||
[(eq? 'newline (car l))
|
||||
(cons (make-line accum-line)
|
||||
(loop (cdr l) null))]
|
||||
[else (loop (cdr l) (cons (car l) accum-line))])))
|
||||
|
|
@ -2,9 +2,15 @@
|
|||
@(require scribble/manual
|
||||
scribble/bnf
|
||||
"utils.ss"
|
||||
(for-label scriblib/figure))
|
||||
(for-label scriblib/figure
|
||||
scribble/base
|
||||
scribble/sigplan))
|
||||
|
||||
@(define (sample . text) (nested #:style 'inset (apply verbatim text)))
|
||||
@(define-syntax-rule (samplemod . text) (codeblock . text))
|
||||
@(define-syntax-rule (sample a . text) (codeblock #:context #'a
|
||||
#:keep-lang-line? #f
|
||||
"#lang scribble/base" "\n"
|
||||
a . text))
|
||||
@(define (result . text) (apply nested #:style 'inset text))
|
||||
|
||||
@title[#:tag "getting-started"]{Getting Started}
|
||||
|
|
@ -18,7 +24,7 @@ goal-specific advice on how to continue.
|
|||
|
||||
Create a file @filepath{mouse.scrbl} with this content:
|
||||
|
||||
@sample|{
|
||||
@samplemod|{
|
||||
#lang scribble/base
|
||||
|
||||
@title{On the Cookie-Eating Habits of Mice}
|
||||
|
|
@ -65,7 +71,7 @@ for the kind of document that you want as output:
|
|||
|
||||
Add more text to @filepath{mouse.scrbl} so that it looks like this:
|
||||
|
||||
@sample|{
|
||||
@samplemod|{
|
||||
#lang scribble/base
|
||||
|
||||
@title{On the Cookie-Eating Habits of Mice}
|
||||
|
|
@ -111,7 +117,7 @@ larger document.
|
|||
To split the example document into multiple files, change
|
||||
@filepath{mouse.scrbl} to just
|
||||
|
||||
@sample|{
|
||||
@samplemod|{
|
||||
#lang scribble/base
|
||||
|
||||
@title{On the Cookie-Eating Habits of Mice}
|
||||
|
|
@ -126,7 +132,7 @@ To split the example document into multiple files, change
|
|||
Create @filepath{milk.scrbl} and @filepath{straw.scrbl} in the same
|
||||
directory as @filepath{mouse.scrbl}. In @filepath{milk.scrbl}, put
|
||||
|
||||
@sample|{
|
||||
@samplemod|{
|
||||
#lang scribble/base
|
||||
|
||||
@title{The Consequences of Milk}
|
||||
|
|
@ -136,7 +142,7 @@ directory as @filepath{mouse.scrbl}. In @filepath{milk.scrbl}, put
|
|||
|
||||
and in @filepath{straw.scbl}, put
|
||||
|
||||
@sample|{
|
||||
@samplemod|{
|
||||
#lang scribble/base
|
||||
|
||||
@title{Not the Last Straw}
|
||||
|
|
@ -167,14 +173,14 @@ the paper to a workshop on programming languages, then---well, you
|
|||
probably need a different topic. But you can start making the current
|
||||
content look right by changing the first line to
|
||||
|
||||
@sample|{
|
||||
@samplemod|{
|
||||
#lang scribble/sigplan
|
||||
}|
|
||||
|
||||
If you're instead working toward Racket library documentation,
|
||||
try changing the first line to
|
||||
|
||||
@sample|{
|
||||
@samplemod|{
|
||||
#lang scribble/manual
|
||||
}|
|
||||
|
||||
|
|
@ -191,7 +197,7 @@ version number---but it changes the set of bindings available in the
|
|||
document body. For example, with @racketmodname[scribble/sigplan], the
|
||||
introductory text can be marked as an abstract:
|
||||
|
||||
@sample|{
|
||||
@samplemod|{
|
||||
#lang scribble/sigplan
|
||||
|
||||
@title{On the Cookie-Eating Habits of Mice}
|
||||
|
|
@ -573,9 +579,9 @@ renders as
|
|||
|
||||
because the source is equivalent to
|
||||
|
||||
@sample|{
|
||||
@racketblock[
|
||||
(verbatim (number->string (+ 1 2)))
|
||||
}|
|
||||
]
|
||||
|
||||
where @racket[(number->string (+ 1 2))] is evaluated to produce the
|
||||
argument to @racket[verbatim]. The @litchar["|{"]...@litchar["}|"]
|
||||
|
|
|
|||
|
|
@ -30,6 +30,60 @@ includes a @racket[latex-defaults] @tech{style property}.
|
|||
@; ------------------------------------------------------------------------
|
||||
@section[#:tag "scribble:manual:code"]{Typesetting Code}
|
||||
|
||||
@defform/subs[(codeblock option ... str-expr ...+)
|
||||
([option (code:line #:indent indent-expr)
|
||||
(code:line #:expand expand-expr)
|
||||
(code:line #:context context-expr)
|
||||
(code:line #:keep-lang-line? keep-expr)])
|
||||
#:contracts ([indent-expr exact-nonnegative-integer?]
|
||||
[expand-expr (or/c #f (syntax-object? . -> . syntax-object?))]
|
||||
[context-expr syntax-object?]
|
||||
[keep-expr any/c])]{
|
||||
|
||||
Parses the code formed by the strings produced by the
|
||||
@racket[str-expr]s as a Racket module and produces a @tech{block} that
|
||||
typesets the code. The code is indented by the amount specified by
|
||||
@racket[indent-expr], which defaults to @racket[2].
|
||||
|
||||
When @racket[expand-expr] produces @racket[#f] (which is the default),
|
||||
identifiers in the typeset code are colored and linked based on
|
||||
for-label bindings in the lexical environment of the syntax object
|
||||
provided by @racket[context-expr]. The default @racket[context-expr]
|
||||
has the same lexical context as the first @racket[str-expr].
|
||||
|
||||
When @racket[expand-expr] produces a procedure, it is used to
|
||||
macro-expand the parsed program, and syntax coloring is based on the
|
||||
parsed program.
|
||||
|
||||
When @racket[keep-lang-line?-expr] produces a true value (the
|
||||
default), the @hash-lang[] line in the input is preserved in the
|
||||
typeset output, otherwise the first line is dropped.
|
||||
|
||||
For example,
|
||||
|
||||
@codeblock[#:keep-lang-line? #f]|<|{
|
||||
#lang scribble/manual
|
||||
@codeblock|{
|
||||
#lang scribble/manual
|
||||
@codeblock{
|
||||
#lang scribble/manual
|
||||
@title{Hello}
|
||||
}
|
||||
}|
|
||||
}|>|
|
||||
|
||||
produces the typeset result
|
||||
|
||||
@codeblock|{
|
||||
#lang scribble/manual
|
||||
@codeblock{
|
||||
#lang scribble/manual
|
||||
@title{Hello}
|
||||
}
|
||||
}|
|
||||
|
||||
}
|
||||
|
||||
@defform[(racketblock datum ...)]{
|
||||
|
||||
Typesets the @racket[datum] sequence as a table of Racket code inset
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user