commit befd85c2d8abeecc71abc624dd6ce26544c2ae4c
parent 09a020b547e0368622e42cc1222bf12898ebf81e
Author: Matthew Flatt <mflatt@racket-lang.org>
Date: Mon, 4 Apr 2011 10:44:18 -0600
Scribble: simplify content that is conditioned on the render mode
including a new `scriblib/render-cond' library
original commit: df2a875ff4aaff90b20906a80dff6218470eb455
Diffstat:
10 files changed, 217 insertions(+), 10 deletions(-)
diff --git a/collects/scribble/base-render.rkt b/collects/scribble/base-render.rkt
@@ -24,6 +24,9 @@
[style-extra-files null]
[extra-files null])
+ (define/public (current-render-mode)
+ '())
+
(define/public (get-dest-directory [create? #f])
(when (and dest-dir create? (not (directory-exists? dest-dir)))
(make-directory* dest-dir))
@@ -306,14 +309,21 @@
(traverse-content c fp))]
[else fp]))
- (define (traverse-force fp p proc again)
+ (define/private (traverse-force fp p proc again)
(let ([v (hash-ref fp p (lambda () proc))])
(if (procedure? v)
(let ([fp fp])
(let ([v2 (v (lambda (key default)
- (hash-ref fp key default))
+ (if (eq? key 'scribble:current-render-mode)
+ (current-render-mode)
+ (hash-ref fp key default)))
(lambda (key val)
- (set! fp (hash-set fp key val))))])
+ (if (eq? key 'scribble:current-render-mode)
+ (raise-mismatch-error
+ 'traverse-info-set!
+ "cannot set value for built-in key: "
+ key)
+ (set! fp (hash-set fp key val)))))])
(let ([fp (hash-set fp p v2)])
(if (procedure? v2)
fp
diff --git a/collects/scribble/html-render.rkt b/collects/scribble/html-render.rkt
@@ -199,6 +199,9 @@
[script-file #f]
[search-box? #f])
+ (define/override (current-render-mode)
+ '(html))
+
(define/override (get-suffix) #".html")
(define/override (index-manual-newlines?)
diff --git a/collects/scribble/latex-render.rkt b/collects/scribble/latex-render.rkt
@@ -38,6 +38,9 @@
(class %
(inherit-field prefix-file style-file style-extra-files)
+ (define/override (current-render-mode)
+ '(latex))
+
(define/override (get-suffix) #".tex")
(inherit render-block
diff --git a/collects/scribble/text-render.rkt b/collects/scribble/text-render.rkt
@@ -28,6 +28,9 @@
(define (render-mixin %)
(class %
+ (define/override (current-render-mode)
+ '(text))
+
(define/override (get-substitutions)
'((#rx"---" "\U2014")
(#rx"--" "\U2013")
diff --git a/collects/scribblings/scribble/core.scrbl b/collects/scribblings/scribble/core.scrbl
@@ -2,7 +2,9 @@
@(require scribble/manual
"utils.ss"
(for-label scribble/manual-struct
- setup/main-collects))
+ file/convertible
+ setup/main-collects
+ scriblib/render-cond))
@title[#:tag "core"]{Structures And Processing}
@@ -610,15 +612,34 @@ for Latex output (see @secref["extra-style"]). The following
@defstruct[traverse-block ([traverse block-traverse-procedure/c])]{
Produces another block during the @tech{traverse pass}, eventually.
-The @scheme[traverse] procedure is called with procedures to get and
-set symbol-keyed information, and it should return either a
-@tech{block} (which effectively takes the @racket[traverse-block]'s
-place) or a procedure like @racket[traverse] to be called in the next
-iteration of the @tech{traverse pass}.
+
+The @scheme[traverse] procedure is called with @racket[_get] and
+@racket[_set] procedures to get and set symbol-keyed information; the
+@racket[traverse] procedure should return either a @tech{block} (which
+effectively takes the @racket[traverse-block]'s place) or a procedure
+like @racket[traverse] to be called in the next iteration of the
+@tech{traverse pass}.
All @racket[traverse-element] and @racket[traverse-block]s that have
not been replaced are forced in document order relative to each other
-during an iteration of the @tech{traverse pass}.}
+during an iteration of the @tech{traverse pass}.
+
+The @racket[_get] procedure passed to @scheme[traverse] takes a symbol
+and any value to act as a default; it returns information registered
+for the symbol or the given default if no value has been
+registered. The @racket[_set] procedure passed to @scheme[traverse]
+takes a symbol and a value to registered for the symbol.
+
+@margin-note*{See also @racket[cond-block] in @racketmodname[scriblib/render-cond].}
+@;
+The symbol @indexed-racket['scribble:current-render-mode] is
+automatically registered to a list of symbols that describe the
+target of document rendering. The list contains @racket['html]
+when rendering to HTML, @racket['latex] when rendering via Latex, and
+@racket['text] when rendering to text. The registration of
+@racket['scribble:current-render-mode] cannot be changed via
+@racket[_set].}
+
@defstruct[delayed-block ([resolve (any/c part? resolve-info? . -> . block?)])]{
@@ -810,6 +831,8 @@ in curly braces) as elements of @racket[content].}
@defstruct[traverse-element ([traverse element-traverse-procedure/c])]{
+@margin-note*{See also @racket[cond-element] in @racketmodname[scriblib/render-cond].}
+@;
Like @racket[traverse-block], but the @racket[traverse] procedure must
eventually produce @tech{content}, rather than a @tech{block}.}
diff --git a/collects/scriblib/render-cond.rkt b/collects/scriblib/render-cond.rkt
@@ -0,0 +1,75 @@
+#lang racket/base
+(require scribble/core
+ (for-syntax racket/base))
+
+(provide cond-element
+ cond-block)
+
+(define-for-syntax (render-cond stx mk check-result no-matching-case)
+ (syntax-case stx ()
+ [(_ [test body0 body ...] ...)
+ (let ([tests (syntax->list #'(test ...))])
+ (with-syntax ([(test-expr ...)
+ (for/list ([test (in-list tests)]
+ [pos (in-naturals)])
+ (let loop ([test test])
+ (syntax-case test (else and or not)
+ [else
+ (unless (= pos (sub1 (length tests)))
+ (raise-syntax-error
+ #f
+ "found `else' not in last clause"
+ stx
+ test))
+ #'#t]
+ [(and test ...)
+ #`(and . #,(map loop (syntax->list #'(test ...))))]
+ [(or test ...)
+ #`(or . #,(map loop (syntax->list #'(test ...))))]
+ [(not test)
+ #`(not #,(loop #'test))]
+ [id
+ (identifier? #'id)
+ #'(memq 'id mode)])))]
+ [mk mk]
+ [check-result check-result]
+ [no-matching-case no-matching-case])
+ #'(mk
+ (lambda (get put)
+ (let ([mode (get 'scribble:current-render-mode 'text)])
+ (cond
+ [test-expr (check-result (let () body0 body ...))]
+ ...
+ [else (no-matching-case)]))))))]))
+
+(define-syntax (cond-block stx)
+ (render-cond stx #'traverse-block #'check-block #'no-block-case))
+
+(define-syntax (cond-element stx)
+ (render-cond stx #'traverse-element #'check-content #'no-element-case))
+
+(define (check-block v)
+ (unless (block? v)
+ (raise-mismatch-error
+ 'cond-block
+ "clause result is not a block: "
+ v))
+ v)
+
+(define (check-content v)
+ (unless (content? v)
+ (raise-mismatch-error
+ 'cond-element
+ "clause result is not content: "
+ v))
+ v)
+
+(define (no-block-case)
+ (raise (make-exn:fail:contract
+ "cond-element: no clause matched"
+ (current-continuation-marks))))
+
+(define (no-element-case)
+ (raise (make-exn:fail:contract
+ "cond-element: no clause matched"
+ (current-continuation-marks))))
diff --git a/collects/scriblib/scribblings/render-cond.scrbl b/collects/scriblib/scribblings/render-cond.scrbl
@@ -0,0 +1,63 @@
+#lang scribble/manual
+@(require (for-label scribble/core
+ racket/base
+ scriblib/render-cond))
+
+@(define scribble-doc '(lib "scribblings/scribble/scribble.scrbl"))
+
+@title[#:tag "render-cond"]{Conditional Content}
+
+@defmodule[scriblib/render-cond]
+
+As much as possible, Scribble documents should be independent of the
+target format for rendering the document. To customize generated
+output, use styes plus ``back end'' configurations for each target
+format (see @secref[#:doc scribble-doc "config"] in
+@other-manual[scribble-doc]).
+
+As a last resort, the @racket[cond-element] and @racket[cond-block]
+forms support varying the document content depending on the target
+format. More precisely, they generate parts of a document where
+content is delayed until the @tech[#:doc scribble-doc]{traverse pass}
+of document rendering. Format detection relies on the
+@racket['scribble:current-render-mode] registration that is accessible
+through a @racket[traverse-element] or @racket[traverse-block].
+
+The syntax of @racket[cond-element] and @racket[cond-block] is based
+on SRFI-0.
+
+@defform*/subs[#:literals (and or not else)
+ [(cond-element [feature-requirement body ...+])
+ (cond-element [feature-requirement body ...+] [else body ...+])]
+ ([feature-requirement identifier
+ (not feature-requirement)
+ (and feature-requirement ...)
+ (or feature-requirement ...)])]{
+
+Generates a @racket[traverse-element] whose replacement content is
+produced by the @racket[body] of one of the first matching
+@racket[cond-element] clause.
+
+A @racket[feature-requirement] can be any identifier; a useful
+identifier is one whose symbol form can appear in a
+@racket['scribble:current-render-mode] list. The identifier matches
+when its symbol form is in the @racket['scribble:current-render-mode]
+list. Typically, the identifier is @racket[html], @racket[latex], or
+@racket[text] to indicate the corresponding rendering target.
+
+A @racket[(not feature-requirement)] test matches when
+@racket[feature-requirement] does not match, and so on. An
+@racket[else] clause always matches. If no @racket[else] clause is
+present and no clause matches, then the @racket[exn:fail:contract]
+exception is raised. Similarly, if the result of the selected
+@racket[body] is not content according to @racket[content?], then the
+@racket[exn:fail:contract] exception is raised.}
+
+@defform*[[(cond-block [feature-requirement body ...+])
+ (cond-block [feature-requirement body ...+] [else body ...+])]]{
+
+Like @racket[cond-element], but generates a @racket[traverse-block]
+where the selected @racket[body] must produce a block according to
+@racket[block?].}
+
+
diff --git a/collects/scriblib/scribblings/scriblib.scrbl b/collects/scriblib/scribblings/scriblib.scrbl
@@ -8,3 +8,4 @@
@include-section["figure.scrbl"]
@include-section["autobib.scrbl"]
@include-section["footnote.scrbl"]
+@include-section["render-cond.scrbl"]
diff --git a/collects/tests/scribble/docs/cond.scrbl b/collects/tests/scribble/docs/cond.scrbl
@@ -0,0 +1,19 @@
+#lang scribble/base
+@(require scriblib/render-cond)
+
+@(cond-element
+ [text "Text!"]
+ [html "HTML!"]
+ [latex "Latex!"])
+
+@(cond-element
+ [(or text html) "Text or HTML!"]
+ [else "Latex!"])
+
+@(cond-element
+ [(and text html) "Text and HTML?!"]
+ [else "Other!"])
+
+@(cond-element
+ [(not text) "Not Text!"]
+ [else "Text!"])
diff --git a/collects/tests/scribble/docs/cond.txt b/collects/tests/scribble/docs/cond.txt
@@ -0,0 +1,7 @@
+Text!
+
+Text or HTML!
+
+Other!
+
+Text!
