commit e257507b0932672f40efa61e64e4b9012d324c9c
parent efd572e4260d5176cc4f30ae42bc0e525ceb8d02
Author: Eli Barzilay <eli@racket-lang.org>
Date: Sun, 15 Feb 2009 23:46:17 +0000
use a more convenient hack to include the literate source
svn: r13632
original commit: 2e9eed3d2508dfcedef07c83ae9c7b91c58cb9c7
Diffstat:
1 file changed, 30 insertions(+), 73 deletions(-)
diff --git a/collects/games/chat-noir/chat-noir-doc.ss b/collects/games/chat-noir/chat-noir-doc.ss
@@ -1,76 +1,33 @@
#lang scribble/doc
-@(require (for-syntax scheme/base
- syntax/boundmap
- scheme/list
- (prefix-in scr: scribble/reader)
- compiler/cm-accomplice))
-
-@(require scribble/manual
- scribble/struct
- scribble/basic
- scribble/decode)
-
-@(define :make-splice make-splice)
-
-@(define-syntax (chunk stx)
- (syntax-case stx ()
- [(_ 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])
+@(begin
+
+(require (for-syntax scheme/base
+ syntax/boundmap
+ scheme/list
+ compiler/cm-accomplice)
+ scribble/manual
+ scribble/struct
+ scribble/basic
+ scribble/decode
+ scheme/include)
+
+;; define `chunk' as a macro that typesets the code
+(define-syntax (chunk stx)
+ (syntax-case stx ()
+ [(_ name expr ...)
(cond
- [(pair? content)
- (cons (loop (car content))
- (loop (cdr content)))]
- [(null? content) null]
- [else
- (let ([v (syntax-e content)])
- (datum->syntax
- ctx
- (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)
- (syntax-case stx ()
- [(_ fn)
- (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"]
+ [(not (identifier? #'name))
+ (raise-syntax-error #f "expected a chunk name" stx #'name)]
+ [(not (regexp-match? #rx"^<.*>$" (symbol->string (syntax-e #'name))))
+ (raise-syntax-error
+ #f "chunk names must begin and end with angle brackets, <...>"
+ stx #'name)]
+ [else #`(make-splice (list (emph (scheme name) " ::=")
+ (schemeblock expr ...)))])]))
+
+(define-syntax module
+ (syntax-rules () [(module name base body ...) (begin body ...)]))
+(include "chat-noir-literate.ss")
+
+)
