split things up so that there are two modes for running the file. See the README

svn: r13613

original commit: e99c3dc3d9bbf1c0ac66f6f4d57079f1f0cfd16e

collects/games/chat-noir/chat-noir-doc.ss

@@ -0,0 +1,75 @@
+#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)
+
+@(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))))))]))
+
+@;{ 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
+       [(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))])))
+
+@content-elsewhere["chat-noir-literate.ss"]

collects/games/chat-noir/literate-lang.ss

@@ -7,7 +7,10 @@
                        scribble/manual)
          chunk)
 
-(require (for-syntax scheme/base syntax/boundmap scheme/list)
+(require (for-syntax scheme/base
+                     syntax/boundmap
+                     scheme/list
+                     syntax/kerncase)
          scribble/manual
          scribble/struct
          scribble/basic
@@ -45,10 +48,7 @@
                              stx 
                              #'name))
        (add-to-block! #'name (syntax->list #'(expr ...)))
-       #`(:make-splice
-          (list
-           (italic #,(format "~a = " (syntax-e #'name)))
-           (schemeblock expr ...))))]))
+       #`(void))]))
 
 (define-syntax (tangle stx)
   (define block-mentions '())
@@ -80,17 +80,34 @@
 (define-syntax (module-begin stx)
   (syntax-case stx ()
     [(module-begin expr ...)
-     (with-syntax ([doc (datum->syntax stx 'doc stx)]
-                   ;; this forces expansion so `chunk' can appear anywhere, if
-                   ;; it's allowed only at the toplevel, then there's no need
-                   ;; for it
-                   [(expr ...)
-                    (map (lambda (expr) (local-expand expr 'module '()))
-                         (syntax->list #'(expr ...)))])
-       ;; define doc as the binding that has all the scribbled documentation
-       #'(#%module-begin 
-          (define doc '())
-          (provide doc)
-          (set! doc (cons expr doc)) ...
-          (tangle)
-          (set! doc (decode (reverse doc)))))]))
+     (let ([body-code
+            (let loop ([exprs (syntax->list #'(expr ...))])
+              (cond
+                [(null? exprs) null]
+                [else
+                 (let ([expanded 
+                        (local-expand (car exprs)
+                                      'module 
+                                      (append (kernel-form-identifier-list)
+                                              (syntax->list #'(provide
+                                                               require
+                                                               #%provide
+                                                               #%require))))])
+                   (syntax-case expanded (begin)
+                     [(begin rest ...)
+                      (append (loop (syntax->list #'(rest ...)))
+                              (loop (cdr exprs)))]
+                     [(id . rest)
+                      (ormap (lambda (kw) (free-identifier=? #'id kw))
+                             (syntax->list #'(require
+                                              provide
+                                              chunk
+                                              #%require
+                                              #%provide)))
+                      (cons expanded (loop (cdr exprs)))]
+                     [else (loop (cdr exprs))]))]))])
+       
+       (with-syntax ([(body-code ...) body-code])
+         #'(#%module-begin 
+            body-code ...
+            (tangle))))]))