scribble/base: generalize `itemlist' to splice/coerce some arguments

Also, add a `spliceof' contract constructor to `scribble/decode'.

original commit: f11450d6019924f38bc523967cab1384514f2163
This commit is contained in:
Matthew Flatt 2012-08-03 13:38:09 -06:00
parent 989d851497
commit 9dd4dddb90
6 changed files with 83 additions and 6 deletions

View File

@ -8,6 +8,7 @@
scheme/list
scheme/class
racket/contract/base
racket/contract/combinator
setup/main-collects
(for-syntax scheme/base))
@ -249,10 +250,23 @@
(define (item? x) (an-item? x))
(define recur-items/c
(make-flat-contract
#:name 'items/c
#:first-order (lambda (x)
((flat-contract-predicate items/c) x))))
(define items/c (or/c item?
block?
(listof recur-items/c)
(spliceof recur-items/c)))
(provide items/c)
(provide/contract
[itemlist (->* ()
(#:style (or/c style? string? symbol? #f))
#:rest (listof item?)
#:rest (listof items/c)
itemization?)]
[item (->* ()
()
@ -262,7 +276,18 @@
[item? (any/c . -> . boolean?)])
(define (itemlist #:style [style plain] . items)
(let ([flows (map an-item-flow items)])
(let ([flows (let loop ([items items])
(cond
[(null? items) null]
[(item? (car items)) (cons (an-item-flow (car items))
(loop (cdr items)))]
[(block? (car items)) (cons (list (car items))
(loop (cdr items)))]
[(splice? (car items))
(loop (append (splice-run (car items))
(cdr items)))]
[else
(loop (append (car items) (cdr items)))]))])
(make-itemization (convert-block-style style) flows)))
(define-struct an-item (flow))

View File

@ -3,6 +3,7 @@
"private/provide-structs.rkt"
"decode-struct.rkt"
racket/contract/base
racket/contract/combinator
scheme/list)
(define (pre-content? i)
@ -81,6 +82,16 @@
[decode-string (-> string? content?)]
[clean-up-index-string (-> string? string?)])
(define (spliceof c)
(define name `(spliceof ,(contract-name c)))
(define p (flat-contract-predicate c))
(make-flat-contract #:name name
#:first-order (lambda (x)
(and (splice? x)
(andmap p (splice-run x))))))
(provide/contract
[spliceof (flat-contract? . -> . flat-contract?)])
(define the-part-index-desc (make-part-index-desc))
(define (clean-up-index-string s)

View File

@ -200,18 +200,32 @@ used in the middle of a paragraph; at the same time, its content is
constrained to form a single paragraph in the margin.}
@defproc[(itemlist [itm item?] ...
@defproc[(itemlist [itm items/c] ...
[#:style style (or/c style? string? symbol? #f) #f])
itemization?]{
Constructs an @racket[itemization] given a sequence of items
constructed by @racket[item].
Constructs an @racket[itemization] given a sequence of items. Typical
each @racket[itm] is constructed by @racket[item], but an
@racket[itm] can be a @tech{block} that is coerced to an
@racket[item]. Finally, @racket[itm] can be a list or @racket[splice]
whose elements are spliced (recursively, if necessary) into the
@racket[itemlist] sequence.
The @racket[style] argument is handled the same as @racket[para]. The
@racket['ordered] style numbers items, instead of just using a
bullet.}
@defthing[items/c flat-contract?]{
A contract that is equivalent to the following recursive
specification:
@racketblock[
(or/c item? block? (listof items/c) (spliceof items/c))
]}
@defproc[(item [pre-flow pre-flow?] ...) item?]{
Creates an item for use with @racket[itemlist]. The @tech{decode}d

View File

@ -205,6 +205,12 @@ See @racket[decode].}
See @racket[decode], @racket[decode-part], and @racket[decode-flow].}
@defproc[(spliceof [ctc flat-contract?]) flat-contract?]{
Produces a contract for a @racket[splice] instance whose
@racketidfont{run} elements satisfy @racket[ctc].}
@defproc[(clean-up-index-string [str string?]) string?]{
Trims leading and trailing whitespace, and converts non-empty

View File

@ -0,0 +1,10 @@
#lang scribble/base
@(require scribble/decode)
@itemlist[
(list @item{a}
(list @item{b}))
@para{c}
@item{d}
(splice (list @item{e} (list @para{f})))
]

View File

@ -0,0 +1,11 @@
* a
* b
* c
* d
* e
* f