commit 9dd4dddb90011a9081a995a62b7f8a9a93ef60a7
parent 989d8514977f79bf8caf55550776e699edbc5110
Author: Matthew Flatt <mflatt@racket-lang.org>
Date: Fri, 3 Aug 2012 13:38:09 -0600
scribble/base: generalize `itemlist' to splice/coerce some arguments
Also, add a `spliceof' contract constructor to `scribble/decode'.
original commit: f11450d6019924f38bc523967cab1384514f2163
Diffstat:
6 files changed, 83 insertions(+), 6 deletions(-)
diff --git a/collects/scribble/base.rkt b/collects/scribble/base.rkt
@@ -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))
diff --git a/collects/scribble/decode.rkt b/collects/scribble/decode.rkt
@@ -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)
diff --git a/collects/scribblings/scribble/base.scrbl b/collects/scribblings/scribble/base.scrbl
@@ -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
diff --git a/collects/scribblings/scribble/decode.scrbl b/collects/scribblings/scribble/decode.scrbl
@@ -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
diff --git a/collects/tests/scribble/docs/itemlist.scrbl b/collects/tests/scribble/docs/itemlist.scrbl
@@ -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})))
+]
diff --git a/collects/tests/scribble/docs/itemlist.txt b/collects/tests/scribble/docs/itemlist.txt
@@ -0,0 +1,11 @@
+* a
+
+* b
+
+* c
+
+* d
+
+* e
+
+* f
