sync to trunk

svn: r13623

collects/games/chat-noir/README

@@ -0,0 +1,31 @@
+These are the files for the literate version of Chat Noir. The files
+not mentioned are actually in use for Chat Noir that you get via PLT
+Games.
+
+ - chat-noir-literate.ss: the actual file containing the literate
+   description of the chat noir game, as well as the game itself, in
+   the chunks.
+
+ - chat-noir-doc.ss: the wrapper file that you run via scribble to get
+   the rendered output.
+
+ - literate-lang.ss: the language for running literate programs
+   (contains the tangler)
+
+ - literate-reader.ss: the reader used for chat-noir-literate.ss to
+   put it into the literate-lang.ss.
+
+Problems:
+
+ - the code is not hyperlinked in the scribble output-- this is due to
+   the confusion about how the requires should work in the two modes.
+
+ - The char-noir-doc.ss file contains code that should move into
+   scribble proper; ideally that file should just be (something like):
+
+   #lang scribble/doc
+   @include-literate["chat-noir-literate.ss"]
+
+   and it should be built when setup-plt runs on this collection to
+   build the documentation, ie, this file should eventually be merged
+   together with ../scribblings/chat-noir.scrbl.

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

@@ -0,0 +1,76 @@
+#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])
+     (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"]

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

@@ -1,5 +1,6 @@
 #reader "literate-reader.ss"
 
+@(require scheme/local scheme/list scheme/bool scheme/math)
 
 @title{Chat Noir}
 
@@ -24,7 +25,7 @@ The main data structure for Chat Noir is @tt{world}.
 It consists of a structure with six fields:
 @itemize{
 @item{
-a @scheme[board],}
+a @scheme[board], which is represented as a list of @tt{cell}s, one for each circle on the game. }
 @item{
 a @scheme[posn] for the cat,}
 @item{the state of the game (@scheme[state] below), which can be one of
@@ -41,6 +42,13 @@ mouse is not in the window),}
 key has been pushed down.}
 }
 
+A @tt{cell} is a structure with two fields:
+
+@chunk[<data-definitions>
+       (define-struct cell (p blocked?) #:transparent)]
+
+The first field contains a @scheme[posn] struct.
+
 @verbatim[#<<---
 ;; a cell is
 ;; (make-cell (make-posn int[0-board-size]
@@ -49,8 +57,7 @@ key has been pushed down.}
 ---
 ]
 
-@chunk[<data-definitions>
-       (define-struct cell (p blocked?) #:transparent)]
+
 
 @section{Init Junk}
 

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))))]))

collects/net/scribblings/uri-codec.scrbl

@@ -98,7 +98,7 @@ Encode a string using the @tt{application/x-www-form-urlencoded}
 encoding rules. The result string contains no non-ASCII characters.}
 
 
-@defproc[(form-urlencoded-deecode [str string?]) string?]{
+@defproc[(form-urlencoded-decode [str string?]) string?]{
 
 Decode a string encoded using the
 @tt{application/x-www-form-urlencoded} encoding rules.}