From 09999b990d9d4618d1005e4c9d93a9eb25411c84 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Tue, 19 Jun 2007 08:32:38 +0000
Subject: [PATCH] doc work

svn: r6692

original commit: 2fe7c75dc15cef9c23ec5dd548cda5f2855cc323
---
 collects/scribble/manual.ss | 54 ++++++++++++++++++++++++-------------
 1 file changed, 35 insertions(+), 19 deletions(-)

diff --git a/collects/scribble/manual.ss b/collects/scribble/manual.ss
index 1c5d438a..b8ad7a58 100644
--- a/collects/scribble/manual.ss
+++ b/collects/scribble/manual.ss
@@ -154,7 +154,7 @@
   (provide defproc defproc* defstruct defthing defform defform* defform/subs defform*/subs defform/none
            specform specform/subs 
            specsubform specspecsubform specsubform/inline
-           schemegrammar
+           schemegrammar schemegrammar*
            var svar void-const undefined-const)
 
   (define void-const
@@ -295,8 +295,16 @@
     (syntax-rules ()
       [(_ #:literals (lit ...) id clause ...) (*schemegrammar '(lit ...) 
                                                               '(id clause ...)
-                                                              (lambda () (list (scheme id) (schemeblock0 clause) ...)))]
+                                                              (lambda () (list (list (scheme id) (schemeblock0 clause) ...))))]
       [(_ id clause ...) (schemegrammar #:literals () id clause ...)]))
+  (define-syntax schemegrammar*
+    (syntax-rules ()
+      [(_ #:literals (lit ...) [id clause ...] ...) (*schemegrammar '(lit ...) 
+                                                                    '(id ... clause ... ...)
+                                                                    (lambda () 
+                                                                      (list
+                                                                       (list (scheme id) (schemeblock0 clause) ...) ...)))]
+      [(_ [id clause ...] ...) (schemegrammar #:literals () [id clause ...] ...)]))
   (define-syntax var
     (syntax-rules ()
       [(_ id) (*var 'id)]))
@@ -589,27 +597,34 @@
                 sub-procs))))
         (flow-paragraphs (decode-flow (content-thunk)))))))
 
-  (define (*schemerawgrammar nonterm clause1 . clauses)
+  (define (*schemerawgrammars nonterms clauseses)
     (make-table
      '((valignment baseline baseline baseline baseline baseline)
-       (alignment left left center left left))
+       (alignment right left center left left))
      (let ([empty-line (make-flow (list (make-paragraph (list (tt 'nbsp)))))]
            [to-flow (lambda (i) (make-flow (list (make-paragraph (list i)))))])
-       (cons
-        (list (to-flow nonterm)
-              empty-line
-              (to-flow "=")
-              empty-line
-              (make-flow (list clause1)))
-        (map (lambda (clause)
-               (list empty-line
-                     empty-line
-                     (to-flow "|")
-                     empty-line
-                     (make-flow (list clause))))
-             clauses)))))
+       (apply append
+              (map
+               (lambda (nonterm clauses)
+                 (cons
+                  (list (to-flow nonterm)
+                        empty-line
+                        (to-flow "=")
+                        empty-line
+                        (make-flow (list (car clauses))))
+                  (map (lambda (clause)
+                         (list empty-line
+                               empty-line
+                               (to-flow "|")
+                               empty-line
+                               (make-flow (list clause))))
+                       (cdr clauses))))
+               nonterms clauseses)))))
 
-  (define (*schemegrammar lits s-expr clauses-thunk)
+  (define (*schemerawgrammar nonterm clause1 . clauses)
+    (*schemerawgrammars (list nonterm) (list (cons clause1 clauses))))
+
+  (define (*schemegrammar lits s-expr clauseses-thunk)
     (parameterize ([current-variable-list
                     (let loop ([form s-expr])
                       (cond
@@ -619,7 +634,8 @@
                        [(pair? form) (append (loop (car form))
                                              (loop (cdr form)))]
                        [else null]))])
-      (apply *schemerawgrammar (clauses-thunk))))
+      (let ([l (clauseses-thunk)])
+        (*schemerawgrammars (map car l) (map cdr l)))))
 
   (define (*var id)
     (to-element (*var-sym id)))