suzanne.soy/hyper-literate
1
0
Fork 0
Code Issues 4 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

some improvements

Browse Source 
svn: r13670

original commit: 6539836e12c2d8bc99f3d2fa6fe3b73c8edb8338
This commit is contained in:
Eli Barzilay 2009-02-16 16:42:37 +00:00
parent 9f64663db4
commit 5b3b204a92
1 changed files with 22 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
collects/games/chat-noir/literate-doc-wrapper.ss
View File

@ -3,9 +3,7 @@
;; 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 (provide include chunk chunkref
chunk
chunkref
(all-from-out scribble/manual)) (all-from-out scribble/manual))
(require scribble/manual scribble/decode scribble/struct scheme/include (require scribble/manual scribble/decode scribble/struct scheme/include
@ -14,7 +12,12 @@
(begin-for-syntax (begin-for-syntax
;; maps chunk identifiers to a counter, so we can distinguish multiple uses ;; maps chunk identifiers to a counter, so we can distinguish multiple uses
;; of the same name ;; of the same name
(define chunk-number (make-free-identifier-mapping))) (define chunk-numbers (make-free-identifier-mapping))
(define (get-chunk-number id)
(let ([n (add1 (free-identifier-mapping-get chunk-numbers id
(lambda () 0)))])
(free-identifier-mapping-put! chunk-numbers id n)
n)))
;; This is the doc-view implementation of `chunk', see "literate-lang.ss" for ;; This is the doc-view implementation of `chunk', see "literate-lang.ss" for
;; the cide-view implementation. Defines `chunk' as a macro that typesets the ;; the cide-view implementation. Defines `chunk' as a macro that typesets the
@ -22,20 +25,22 @@
(define-syntax (chunk stx) (define-syntax (chunk stx)
(syntax-case stx () (syntax-case stx ()
[(_ name expr ...) [(_ name expr ...)
(let ([n (add1 (free-identifier-mapping-get ;; no need for more error checking, using chunk for the code will do that
chunk-number #'name (lambda () 0)))]) (identifier? #'name)
(free-identifier-mapping-put! chunk-number #'name n) (let ([n (get-chunk-number #'name)]
(with-syntax ([tag (format "~a~a" [str (symbol->string (syntax-e #'name))])
(syntax-e #'name) (with-syntax ([tag (if (n . > . 1) (format "~a:~a" str n) str)]
(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 [str str])
(make-toc-element #f #`(make-splice
(list (make-toc-element
#f
(list (elemtag '(chunk tag) (italic (scheme name) " ::="))) (list (elemtag '(chunk tag) (italic (scheme name) " ::=")))
(list (make-element "smaller" (list (elemref '(chunk tag) str more ...))))) (list (make-element
"smaller"
(list (elemref '(chunk tag) str more ...)))))
(schemeblock expr ...)))))])) (schemeblock expr ...)))))]))
(define-syntax (chunkref stx) (define-syntax (chunkref stx)