diff --git a/collects/scribble/base-render.rkt b/collects/scribble/base-render.rkt index 8dd56c06..1e0bb517 100644 --- 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 index bd1527ba..24c488a0 100644 --- 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 index c7bab8ab..b7870aef 100644 --- 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 index 75b7f245..c5ea4d12 100644 --- 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 index 72c2ab94..822f2bd8 100644 --- 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 new file mode 100644 index 00000000..b76eabd8 --- /dev/null +++ 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 new file mode 100644 index 00000000..4bcb2924 --- /dev/null +++ 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 index 1c1c2366..030ebba8 100644 --- 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 new file mode 100644 index 00000000..fd8dea30 --- /dev/null +++ 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 new file mode 100644 index 00000000..6fc7dfaf --- /dev/null +++ b/collects/tests/scribble/docs/cond.txt @@ -0,0 +1,7 @@ +Text! + +Text or HTML! + +Other! + +Text!