adjusted TOC

svn: r13666

original commit: 16d3208fb351e6803e62234205d3ff94bc5ff397
This commit is contained in:
Robby Findler 2009-02-16 16:18:26 +00:00
parent d166f0969c
commit 196e960734

View File

@ -3,9 +3,12 @@
;; Use this module to create literate doc wrappers -- files that require the ;; Use this module to create literate doc wrappers -- files that require the
;; literate code in a way that makes it a scribble file. ;; literate code in a way that makes it a scribble file.
(provide include chunk (all-from-out scribble/manual)) (provide include
chunk
chunkref
(all-from-out scribble/manual))
(require scribble/manual scribble/decode scheme/include (require scribble/manual scribble/decode scribble/struct scheme/include
(for-syntax scheme/base syntax/boundmap)) (for-syntax scheme/base syntax/boundmap))
(begin-for-syntax (begin-for-syntax
@ -18,21 +21,29 @@
;; contained code. ;; contained code.
(define-syntax (chunk stx) (define-syntax (chunk stx)
(syntax-case stx () (syntax-case stx ()
[(_ #:part #f name expr ...) [(_ name expr ...)
#'(make-splice (list (bold (scheme name) " ::=")
(schemeblock expr ...)))]
[(_ #:part part-function name expr ...)
(let ([n (add1 (free-identifier-mapping-get (let ([n (add1 (free-identifier-mapping-get
chunk-number #'name (lambda () 0)))]) chunk-number #'name (lambda () 0)))])
(free-identifier-mapping-put! chunk-number #'name n) (free-identifier-mapping-put! chunk-number #'name n)
(with-syntax ([tag (format "~a~a" (syntax->datum #'name) (with-syntax ([tag (format "~a~a"
(syntax-e #'name)
(if (n . > . 1) (format ":~a" n) ""))] (if (n . > . 1) (format ":~a" n) ""))]
[str (format "~a" (syntax-e #'name))]
[(more ...) (if (n . > . 1) [(more ...) (if (n . > . 1)
#`((subscript #,(format "~a" n))) #`((subscript #,(format "~a" n)))
#`())]) #`())])
#'(make-splice (list (part-function #:tag tag (scheme name) more ...) #`(make-splice (list
(schemeblock expr ...)))))] (make-toc-element #f
[(_ name expr ...) #'(chunk #:part subsection name expr ...)])) (list (elemtag '(chunk tag) (italic (scheme name) " ::=")))
(list (make-element "smaller" (list (elemref '(chunk tag) str more ...)))))
(schemeblock expr ...)))))]))
(define-syntax (chunkref stx)
(syntax-case stx ()
[(_ id)
(identifier? #'id)
(with-syntax ([str (format "~a" (syntax-e #'id))])
#'(elemref '(chunk str) str))]))
;; HACK: provide a fake `module', which makes it possible to include a module ;; HACK: provide a fake `module', which makes it possible to include a module
;; and get only its code in. ;; and get only its code in.