suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

use a more convenient hack to include the literate source

Browse Source 
svn: r13632
This commit is contained in:
Eli Barzilay 2009-02-15 23:46:17 +00:00
parent 10b89445c6
commit 2e9eed3d25
1 changed files with 26 additions and 69 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

95
collects/games/chat-noir/chat-noir-doc.ss
View File

@ -1,76 +1,33 @@
#lang scribble/doc #lang scribble/doc
@(require (for-syntax scheme/base @(begin
syntax/boundmap
scheme/list
(prefix-in scr: scribble/reader)
compiler/cm-accomplice))
@(require scribble/manual (require (for-syntax scheme/base
scribble/struct syntax/boundmap
scribble/basic scheme/list
scribble/decode) compiler/cm-accomplice)
scribble/manual
scribble/struct
scribble/basic
scribble/decode
scheme/include)
@(define :make-splice make-splice) ;; define `chunk' as a macro that typesets the code
(define-syntax (chunk stx)
@(define-syntax (chunk stx) (syntax-case stx ()
(syntax-case stx () [(_ name expr ...)
[(_ name expr ...)
(begin
(unless (identifier? #'name)
(raise-syntax-error #f "expected a chunk name" stx #'name))
(unless (regexp-match #rx"^<.*>$" (symbol->string (syntax-e #'name)))
(raise-syntax-error #f "chunk names must begin and end with angle brackets, <...>"
stx
#'name))
#`(:make-splice
(list
(italic #,(format "~a = " (syntax-e #'name)))
(schemeblock expr ...))))]))
@;{the two lines below seem like they shoudl work, but they loop forever; probably the read-syntax-inside vs read-syntax difference. If they did work, then all of the stuff below could go away}
@;(require scheme/include)
@;(include/reader "chat-noir-literate.ss" scr:read-syntax-inside)
@;{ stolen from include.ss. Should probably be refactored to just have one of these.}
@(define-for-syntax (give-lexical-content ctx content)
(let loop ([content content])
(cond (cond
[(pair? content) [(not (identifier? #'name))
(cons (loop (car content)) (raise-syntax-error #f "expected a chunk name" stx #'name)]
(loop (cdr content)))] [(not (regexp-match? #rx"^<.*>$" (symbol->string (syntax-e #'name))))
[(null? content) null] (raise-syntax-error
[else #f "chunk names must begin and end with angle brackets, <...>"
(let ([v (syntax-e content)]) stx #'name)]
(datum->syntax [else #`(make-splice (list (emph (scheme name) " ::=")
ctx (schemeblock expr ...)))])]))
(cond
[(pair? v)
(loop v)]
[(vector? v)
(list->vector (loop (vector->list v)))]
[(box? v)
(box (loop (unbox v)))]
[else
v])
content
content))])))
@(define-syntax (content-elsewhere stx) (define-syntax module
(syntax-case stx () (syntax-rules () [(module name base body ...) (begin body ...)]))
[(_ fn) (include "chat-noir-literate.ss")
(string? (syntax-e #'fn))
(let ([fn (syntax-e #'fn)])
(register-external-file (path->complete-path fn))
(call-with-input-file fn
(λ (port)
(port-count-lines! port)
(let ([reader-line (read-line port)])
(unless (regexp-match #rx"^#reader" reader-line)
(raise-syntax-error #f (format "expected a #reader line, found ~s" reader-line) stx))
(let* ([content (scr:read-syntax-inside fn port)]
[w/context (give-lexical-content stx content)])
#`(begin #,@w/context))))))]))
)
@content-elsewhere["chat-noir-literate.ss"]