From 8de414b74fb8d352747cac4b9c596d7a7b0afbb7 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Fri, 22 Jun 2007 05:59:42 +0000
Subject: [PATCH] change scribble to use new-lambda and new-struct, and
 correlate definitions and uses via lexical binding

svn: r6714

original commit: 7de23b6373ac5d88c54350a847a41bedd3516a2d
---
 collects/scribble/basic.ss                 |  39 ++--
 collects/scribble/doclang.ss               |   4 +-
 collects/scribble/eval.ss                  |  48 +++--
 collects/scribble/html-render.ss           |   5 +
 collects/scribble/manual.ss                | 203 ++++++++++++---------
 collects/scribble/scheme.ss                |  46 +++--
 collects/scribble/scribble.css             |   4 +
 collects/scribblings/scribble/eval.scrbl   |  14 +-
 collects/scribblings/scribble/manual.scrbl |  93 ++++++----
 9 files changed, 265 insertions(+), 191 deletions(-)

diff --git a/collects/scribble/basic.ss b/collects/scribble/basic.ss
index 624837b4..d43b716d 100644
--- a/collects/scribble/basic.ss
+++ b/collects/scribble/basic.ss
@@ -1,9 +1,8 @@
 
-(module basic mzscheme
+(module basic (lib "new-lambda.ss" "scribblings")
   (require "decode.ss"
            "struct.ss"
            "config.ss"
-           (lib "kw.ss")
            (lib "list.ss")
            (lib "class.ss"))
   
@@ -19,23 +18,23 @@
                      (content->string content)
                      "_"))
 
-  (define/kw (title #:key [tag #f] [style #f] #:body str)
+  (define (title #:tag [tag #f] #:style [style #f] . str)
     (let ([content (decode-content str)])
       (make-title-decl (or tag (gen-tag content)) style content)))
   
-  (define/kw (section #:key [tag #f] #:body str)
+  (define (section #:tag [tag #f] . str)
     (let ([content (decode-content str)])
       (make-part-start 0 (or tag (gen-tag content)) content)))
 
-  (define/kw (subsection #:key [tag #f] #:body str)
+  (define (subsection #:tag [tag #f] . str)
     (let ([content (decode-content str)])
       (make-part-start 1 (or tag (gen-tag content)) content)))
 
-  (define/kw (subsubsection #:key [tag #f] #:body str)
+  (define (subsubsection #:tag [tag #f] . str)
     (let ([content (decode-content str)])
       (make-part-start 2 (or tag (gen-tag content)) content)))
 
-  (define/kw (subsubsub*section #:key [tag #f] #:body str)
+  (define (subsubsub*section #:tag [tag #f] . str)
     (let ([content (decode-content str)])
       (make-paragraph (list (make-element 'bold content)))))
 
@@ -50,7 +49,7 @@
 
   (provide itemize item item?)
 
-  (define/kw (itemize #:body items)
+  (define (itemize . items)
     (let ([items (filter (lambda (v) (not (whitespace? v))) items)])
       (for-each (lambda (v)
                   (unless (an-item? v)
@@ -63,7 +62,7 @@
   (define-struct an-item (flow))
   (define (item? x) (an-item? x))
 
-  (define/kw (item #:body str)
+  (define (item . str)
     (make-an-item (decode-flow str)))
 
   ;; ----------------------------------------
@@ -77,28 +76,28 @@
   (define (hspace n)
     (make-element 'hspace (list (make-string n #\space))))
 
-  (define/kw (elem #:body str)
+  (define (elem . str)
     (make-element #f (decode-content str)))
 
-  (define/kw (aux-elem #:body s)
+  (define (aux-elem . s)
     (make-aux-element #f (decode-content s)))
 
-  (define/kw (italic #:body str)
+  (define (italic . str)
     (make-element 'italic (decode-content str)))
 
-  (define/kw (bold #:body str)
+  (define (bold . str)
     (make-element 'bold (decode-content str)))
 
-  (define/kw (tt #:body str)
+  (define (tt . str)
     (make-element 'tt (decode-content str)))
 
-  (define/kw (span-class classname #:body str)
+  (define (span-class classname . str)
     (make-element classname (decode-content str)))
 
-  (define/kw (subscript #:body str)
+  (define (subscript . str)
     (make-element 'subscript (decode-content str)))
 
-  (define/kw (superscript #:body str)
+  (define (superscript . str)
     (make-element 'superscript (decode-content str)))
 
   ;; ----------------------------------------
@@ -116,20 +115,20 @@
      word-seq
      element-seq))
 
-  (define/kw (index* word-seq content-seq #:body s)
+  (define (index* word-seq content-seq . s)
     (let ([key (gen-target)])
       (record-index word-seq
                     content-seq
                     key
                     (decode-content s))))
 
-  (define/kw (index word-seq #:body s)
+  (define (index word-seq . s)
     (let ([word-seq (if (string? word-seq)
                         (list word-seq)
                         word-seq)])
       (apply index* word-seq word-seq s)))
 
-  (define/kw (as-index #:body s)
+  (define (as-index . s)
     (let ([key (gen-target)]
           [content (decode-content s)])
       (record-index (list (content->string content))
diff --git a/collects/scribble/doclang.ss b/collects/scribble/doclang.ss
index ad6ee794..0d6199fc 100644
--- a/collects/scribble/doclang.ss
+++ b/collects/scribble/doclang.ss
@@ -1,11 +1,11 @@
 
-(module doclang mzscheme
+(module doclang (lib "new-lambda.ss" "scribblings") ; <--- temporary
   (require "struct.ss"
            "decode.ss"
            (lib "kw.ss"))
   (require-for-syntax (lib "kerncase.ss" "syntax"))
 
-  (provide (all-from-except mzscheme #%module-begin)
+  (provide (all-from-except (lib "new-lambda.ss" "scribblings") #%module-begin)
            (rename *module-begin #%module-begin))
 
   ;; Module wrapper ----------------------------------------
diff --git a/collects/scribble/eval.ss b/collects/scribble/eval.ss
index a31d011e..e4a660aa 100644
--- a/collects/scribble/eval.ss
+++ b/collects/scribble/eval.ss
@@ -26,7 +26,7 @@
 
            scribble-eval-handler)
 
-  (define current-int-namespace (make-parameter (make-namespace)))
+  (define current-int-namespace (make-parameter (current-namespace)))
   (define scribble-eval-handler (make-parameter (lambda (c? x) (eval x))))
 
   (define image-counter 0)
@@ -108,17 +108,11 @@
                     #f)))))))
 
   (define (do-eval s)
-    (cond
-     [(and (list? s)
-           (eq? 'code:line (car s))
-           (= (length s) 3)
-           (list? (caddr s))
-           (eq? 'code:comment (caaddr s)))
-      (do-eval (cadr s))]
-     [(and (list? s)
-           (eq? 'eval:alts (car s))
-           (= (length s) 3))
-      (do-eval (caddr s))]
+    (syntax-case s (code:comment eval:alts)
+     [(code:line v (code:comment . rest))
+      (do-eval #'v)]
+     [(eval:alts p e)
+      (do-eval #'e)]
      [else
       (let ([o (open-output-string)])
         (parameterize ([current-output-port o])
@@ -160,17 +154,19 @@
                  v2)]
      [else v]))
             
-  (define (strip-comments s)
-    (cond
-     [(and (pair? s)
-           (pair? (car s))
-           (eq? (caar s) 'code:comment))
-      (strip-comments (cdr s))]
-     [(pair? s)
-      (cons (strip-comments (car s))
-            (strip-comments (cdr s)))]
-     [(eq? s 'code:blank) (void)]
-     [else s]))
+  (define (strip-comments stx)
+    (syntax-case stx (code:comment code:blank)
+     [((code:comment . _) . rest)
+      (strip-comments #'rest)]
+     [(a . b)
+      (datum->syntax-object stx
+                            (cons (strip-comments #'a)
+                                  (strip-comments #'b))
+                            stx
+                            stx
+                            stx)]
+     [code:blank #'(void)]
+     [else stx]))
       
 
   (define (do-plain-eval s catching-exns?)
@@ -181,7 +177,7 @@
     (syntax-rules ()
       [(_ e) (#%expression
               (begin (parameterize ([current-command-line-arguments #()])
-                       (do-plain-eval (quote e) #f))
+                       (do-plain-eval (quote-syntax e) #f))
                      ""))]))
 
 
@@ -193,7 +189,7 @@
     (syntax-rules ()
       [(_ e) (#%expression
               (parameterize ([current-command-line-arguments #()])
-                (show-val (car (do-plain-eval (quote e) #f)))))]))
+                (show-val (car (do-plain-eval (quote-syntax e) #f)))))]))
 
   (define (eval-example-string s)
     (eval (read (open-input-string s))))
@@ -239,7 +235,7 @@
       [(_ t schemeinput* e ...)
        (interleave t
                    (list (schemeinput* e) ...)
-                   (map do-eval (list (quote e) ...)))]))
+                   (map do-eval (list (quote-syntax e) ...)))]))
 
     (define-syntax interaction
       (syntax-rules ()
diff --git a/collects/scribble/html-render.ss b/collects/scribble/html-render.ss
index f6297722..35e94ce9 100644
--- a/collects/scribble/html-render.ss
+++ b/collects/scribble/html-render.ss
@@ -200,6 +200,11 @@
                       [(at-right) '((align "right"))]
                       [(at-left) '((align "left"))]
                       [else null])
+                  ,@(let ([a (and (list? (table-style t))
+                                  (assoc 'style (table-style t)))])
+                      (if (and a (string? (cadr a)))
+                          `((class ,(cadr a)))
+                          null))
                   ,@(if (string? (table-style t))
                         `((class ,(table-style t)))
                         null))
diff --git a/collects/scribble/manual.ss b/collects/scribble/manual.ss
index aebaaa9b..bf95ec17 100644
--- a/collects/scribble/manual.ss
+++ b/collects/scribble/manual.ss
@@ -1,12 +1,11 @@
 
-(module manual mzscheme
+(module manual (lib "new-lambda.ss" "scribblings")
   (require "decode.ss"
            "struct.ss"
            "scheme.ss"
            "config.ss"
            "basic.ss"
            (lib "string.ss")
-           (lib "kw.ss")
            (lib "list.ss")
            (lib "class.ss"))
 
@@ -46,7 +45,10 @@
   (define (to-element/id s)
     (make-element "schemesymbol" (list (to-element/no-color s))))
 
-  (define (keep-s-expr ctx s v) s)
+  (define (keep-s-expr ctx s v) 
+    (if (symbol? s)
+        (make-just-context s ctx)
+        s))
   (define (add-sq-prop s name val)
     (if (eq? name 'paren-shape)
         (make-shaped-parens s val)
@@ -97,41 +99,41 @@
            link procedure
            idefterm)
 
-  (define/kw (onscreen #:body str)
+  (define (onscreen . str)
     (make-element 'sf (decode-content str)))
   (define (menuitem menu item)
     (make-element 'sf (list menu "|" item)))
-  (define/kw (defterm #:body str)
+  (define (defterm . str)
     (make-element 'italic (decode-content str)))
-  (define/kw (idefterm #:body str)
+  (define (idefterm . str)
     (let ([c (decode-content str)])
       (make-element 'italic c)))
-  (define/kw (schemefont #:body str)
+  (define (schemefont . str)
     (apply tt str))
-  (define/kw (schemevalfont #:body str)
+  (define (schemevalfont . str)
     (make-element "schemevalue" (decode-content str)))
-  (define/kw (schemeresultfont #:body str)
+  (define (schemeresultfont . str)
     (make-element "schemeresult" (decode-content str)))
-  (define/kw (schemeidfont #:body str)
+  (define (schemeidfont . str)
     (make-element "schemesymbol" (decode-content str)))
-  (define/kw (schemeparenfont #:body str)
+  (define (schemeparenfont . str)
     (make-element "schemeparen" (decode-content str)))
-  (define/kw (schememetafont #:body str)
+  (define (schememetafont . str)
     (make-element "schememeta" (decode-content str)))
-  (define/kw (schemekeywordfont #:body str)
+  (define (schemekeywordfont . str)
     (make-element "schemekeyword" (decode-content str)))
-  (define/kw (file #:body str)
+  (define (file . str)
     (make-element 'tt (append (list "\"") (decode-content str) (list "\""))))
-  (define/kw (exec #:body str)
+  (define (exec . str)
     (make-element 'tt (decode-content str)))
-  (define/kw (procedure #:body str)
+  (define (procedure . str)
     (make-element "schemeresult" (append (list "#<procedure:") (decode-content str) (list ">"))))
 
-  (define/kw (link url #:body str)
+  (define (link url . str)
     (make-element (make-target-url url) (decode-content str)))
 
   (provide t)
-  (define/kw (t #:body str)
+  (define (t . str)
     (decode-paragraph str))
 
   (provide schememodule)
@@ -151,7 +153,7 @@
 
   ;; ----------------------------------------
 
-  (provide deftech tech)
+  (provide deftech tech techlink)
 
   (define (*tech make-elem style s)
     (let* ([c (decode-content s)]
@@ -165,12 +167,15 @@
                  c
                  (format "tech-term:~a" s))))
 
-  (define/kw (deftech #:body s)
+  (define (deftech . s)
     (*tech make-target-element #f (list (apply defterm s))))
 
-  (define/kw (tech #:body s)
+  (define (tech . s)
     (*tech make-link-element "techlink" s))
 
+  (define (techlink . s)
+    (*tech make-link-element #f s))
+
   ;; ----------------------------------------
 
   (provide defproc defproc* defstruct defthing defform defform* defform/subs defform*/subs defform/none
@@ -218,21 +223,23 @@
   (define-syntax defproc 
     (syntax-rules ()
       [(_ (id arg ...) result desc ...)
-       (*defproc '[(id arg ...)]
+       (*defproc (list (quote-syntax id))
+                 '[(id arg ...)]
                  (list (list (lambda () (arg-contract arg)) ...))
                  (list (lambda () (schemeblock0 result))) 
                  (lambda () (list desc ...)))]))
   (define-syntax defproc* 
     (syntax-rules ()
       [(_ [[(id arg ...) result] ...] desc ...)
-       (*defproc '[(id arg ...) ...] 
+       (*defproc (list (quote-syntax id) ...)
+                 '[(id arg ...) ...] 
                  (list (list (lambda () (arg-contract arg)) ...) ...)
                  (list (lambda () (schemeblock0 result)) ...)
                  (lambda () (list desc ...)))]))
   (define-syntax defstruct
     (syntax-rules ()
       [(_ name fields desc ...)
-       (*defstruct 'name 'fields (lambda () (list desc ...)))]))
+       (*defstruct (quote-syntax name) 'name 'fields (lambda () (list desc ...)))]))
   (define-syntax (defform*/subs stx)
     (syntax-case stx ()
       [(_ #:literals (lit ...) [spec spec1 ...] ([non-term-id non-term-form ...] ...) desc ...)
@@ -245,8 +252,11 @@
                                                                       '(unsyntax x)
                                                                       #'name)
                                                 #'rest)
-                                               #'spec)])])
-         #'(*defforms #t '(lit ...)
+                                               #'spec)])]
+                     [spec-id
+                      (syntax-case #'spec ()
+                        [(name . rest) #'name])])
+         #'(*defforms (quote-syntax spec-id) '(lit ...)
                       '(spec spec1 ...) 
                       (list (lambda (x) (schemeblock0 new-spec))
                             (lambda (ignored) (schemeblock0 spec1)) ...)
@@ -260,6 +270,7 @@
        #'(fm #:literals () [spec spec1 ...] ([non-term-id non-term-form ...] ...) desc ...)]))
   (define-syntax (defform* stx)
     (syntax-case stx ()
+      [(_ #:literals lits [spec ...] desc ...) #'(defform*/subs #:literals lits [spec ...] () desc ...)]
       [(_ [spec ...] desc ...) #'(defform*/subs [spec ...] () desc ...)]))
   (define-syntax (defform stx)
     (syntax-case stx ()
@@ -312,7 +323,7 @@
   (define-syntax defthing
     (syntax-rules ()
       [(_ id result desc ...)
-       (*defthing 'id 'result (lambda () (list desc ...)))]))
+       (*defthing (quote-syntax id) 'id 'result (lambda () (list desc ...)))]))
   (define-syntax schemegrammar
     (syntax-rules ()
       [(_ #:literals (lit ...) id clause ...) (*schemegrammar '(lit ...) 
@@ -342,7 +353,7 @@
               (list (make-table style content))))
         (list (make-table style content))))
 
-  (define (*defproc prototypes arg-contractss result-contracts content-thunk)
+  (define (*defproc stx-ids prototypes arg-contractss result-contracts content-thunk)
     (let ([spacer (hspace 1)]
           [has-optional? (lambda (arg)
                            (and (pair? arg)
@@ -378,7 +389,7 @@
            (apply 
             append
             (map 
-             (lambda (prototype arg-contracts result-contract first?)
+             (lambda (stx-id prototype arg-contracts result-contract first?)
                (append
                 (list
                  (list (make-flow
@@ -403,7 +414,7 @@
                                                      (make-target-element
                                                       #f
                                                       (list (to-element (car prototype)))
-                                                      (register-scheme-definition (car prototype)))
+                                                      (register-scheme-definition stx-id))
                                                      (to-element (car prototype))))
                                            (map arg->elem required)
                                            (if (null? optional)
@@ -449,25 +460,29 @@
                                [else null]))
                             (cdr prototype)
                             arg-contracts))))
+             stx-ids
              prototypes
              arg-contractss
              result-contracts
              (cons #t (map (lambda (x) #f) (cdr prototypes))))))
           (content-thunk))))))
 
-  (define (make-target-element* content wrappers)
+  (define (make-target-element* stx-id content wrappers)
     (if (null? wrappers)
         content
         (make-target-element*
+         stx-id
          (make-target-element
           #f
           (list content)
-          (register-scheme-definition (string->symbol
-                                       (apply string-append
-                                              (map symbol->string (car wrappers))))))
+          (register-scheme-definition 
+           (datum->syntax-object stx-id
+                                 (string->symbol
+                                  (apply string-append
+                                         (map symbol->string (car wrappers)))))))
          (cdr wrappers))))
 
-  (define (*defstruct name fields content-thunk)
+  (define (*defstruct stx-id name fields content-thunk)
     (define spacer (hspace 1))
     (make-splice
      (cons
@@ -481,6 +496,7 @@
                   (to-element
                    `(,(schemeparenfont "struct")
                      ,(make-target-element*
+                       stx-id
                        (to-element name)
                        (let ([name (if (pair? name)
                                        (car name)
@@ -515,7 +531,7 @@
              fields)))
       (content-thunk))))
 
-  (define (*defthing name result-contract content-thunk)
+  (define (*defthing stx-id name result-contract content-thunk)
     (define spacer (hspace 1))
     (make-splice
      (cons
@@ -528,19 +544,19 @@
                  (list (make-target-element
                         #f
                         (list (to-element name))
-                        (register-scheme-definition name))
+                        (register-scheme-definition stx-id))
                        spacer ":" spacer
                        (to-element result-contract))))))))
       (content-thunk))))
 
   (define (meta-symbol? s) (memq s '(... ...+ ?)))
 
-  (define (*defforms kw? lits forms form-procs subs sub-procs content-thunk)
+  (define (*defforms kw-id lits forms form-procs subs sub-procs content-thunk)
     (parameterize ([current-variable-list
                     (apply 
                      append
                      (map (lambda (form)
-                            (let loop ([form (cons (if kw? (cdr form) form)
+                            (let loop ([form (cons (if kw-id (cdr form) form)
                                                    subs)])
                               (cond
                                [(symbol? form) (if (or (meta-symbol? form)
@@ -568,22 +584,25 @@
                              (to-element
                               `(,x
                                 . ,(cdr form)))))))
-                     (and kw?
+                     (and kw-id
                           (eq? form (car forms))
                           (make-target-element
                            #f
-                           (list (to-element (car form)))
-                           (register-scheme-form-definition (car form)))))))))
+                           (list (to-element (make-just-context (car form) kw-id)))
+                           (register-scheme-form-definition kw-id))))))))
                forms form-procs)
-          (apply
-           append
-           (map (lambda (sub)
-                  (list (list (make-flow (list (make-paragraph (list (tt 'nbsp))))))
-                        (list (make-flow (list (apply *schemerawgrammar 
-                                                      (map (lambda (f) (f)) sub)))))))
-                sub-procs))))
+          (if (null? sub-procs)
+              null
+              (list (list (make-flow (list (make-paragraph (list (tt 'nbsp))))))
+                    (list (make-flow (list (let ([l (map (lambda (sub)
+                                                           (map (lambda (f) (f)) sub))
+                                                         sub-procs)])
+                                             (*schemerawgrammars
+                                              "specgrammar"
+                                              (map car l)
+                                              (map cdr l))))))))))
         (content-thunk)))))
-
+  
   (define (*specsubform form has-kw? lits form-thunk subs sub-procs content-thunk)
     (parameterize ([current-variable-list
                     (append (let loop ([form (cons (if has-kw? (cdr form) form)
@@ -610,41 +629,47 @@
              (if form-thunk
                  (form-thunk)
                  (make-paragraph (list (to-element form)))))))
-          (apply
-           append
-           (map (lambda (sub)
-                  (list (list (make-flow (list (make-paragraph (list (tt 'nbsp))))))
-                        (list (make-flow (list (apply *schemerawgrammar 
-                                                      (map (lambda (f) (f)) sub)))))))
-                sub-procs))))
+          (if (null? sub-procs)
+              null
+              (list (list (make-flow (list (make-paragraph (list (tt 'nbsp))))))
+                    (list (make-flow (list (let ([l (map (lambda (sub)
+                                                           (map (lambda (f) (f)) sub))
+                                                         sub-procs)])
+                                             (*schemerawgrammars
+                                              "specgrammar"
+                                              (map car l)
+                                              (map cdr l))))))))))
         (flow-paragraphs (decode-flow (content-thunk)))))))
 
-  (define (*schemerawgrammars nonterms clauseses)
+  (define (*schemerawgrammars style nonterms clauseses)
     (make-table
-     '((valignment baseline baseline baseline baseline baseline)
-       (alignment right left center left left))
+     `((valignment baseline baseline baseline baseline baseline)
+       (alignment right left center left left)
+       (style ,style))
      (let ([empty-line (make-flow (list (make-paragraph (list (tt 'nbsp)))))]
            [to-flow (lambda (i) (make-flow (list (make-paragraph (list i)))))])
-       (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)))))
+       (cdr
+        (apply append
+               (map
+                (lambda (nonterm clauses)
+                  (list*
+                   (list empty-line empty-line empty-line empty-line empty-line)
+                   (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 (*schemerawgrammar nonterm clause1 . clauses)
-    (*schemerawgrammars (list nonterm) (list (cons clause1 clauses))))
+  (define (*schemerawgrammar style nonterm clause1 . clauses)
+    (*schemerawgrammars style (list nonterm) (list (cons clause1 clauses))))
 
   (define (*schemegrammar lits s-expr clauseses-thunk)
     (parameterize ([current-variable-list
@@ -657,7 +682,7 @@
                                              (loop (cdr form)))]
                        [else null]))])
       (let ([l (clauseses-thunk)])
-        (*schemerawgrammars (map car l) (map cdr l)))))
+        (*schemerawgrammars #f (map car l) (map cdr l)))))
 
   (define (*var id)
     (to-element (*var-sym id)))
@@ -668,26 +693,26 @@
   ;; ----------------------------------------
 
   (provide centerline)
-  (define/kw (centerline #:body s)
+  (define (centerline . s)
     (make-table 'centered (list (list (make-flow (list (decode-paragraph s)))))))
 
   (provide commandline)
-  (define/kw (commandline #:body s)
+  (define (commandline . s)
     (make-paragraph (list (hspace 2) (apply tt s))))
            
 
   (define (secref s)
     (make-link-element #f null `(part ,s)))
-  (define/kw (seclink tag #:body s)
+  (define (seclink tag . s)
     (make-link-element #f (decode-content s) `(part ,tag)))
-  (define/kw (*schemelink id #:body s)
-    (make-link-element #f (decode-content s) (register-scheme-definition id)))
+  (define (*schemelink stx-id id . s)
+    (make-link-element #f (decode-content s) (register-scheme-definition stx-id)))
   (define-syntax schemelink
     (syntax-rules ()
-      [(_ id . content) (*schemelink 'id . content)]))
+      [(_ id . content) (*schemelink (quote-syntax id) 'id . content)]))
   (provide secref seclink schemelink)
 
-  (define/kw (pidefterm #:body s)
+  (define (pidefterm . s)
     (let ([c (apply defterm s)])
       (index (string-append (content->string (element-content c)) "s") 
              c)))
@@ -707,7 +732,7 @@
   ;; ----------------------------------------
 
   (provide math)
-  (define/kw (math #:body s)
+  (define (math . s)
     (let ([c (decode-content s)])
       (make-element #f (apply append
                               (map (lambda (i)
@@ -727,7 +752,7 @@
 
   (provide cite)
 
-  (define/kw (cite #:key key title author location date)
+  (define (cite #:key key #:title title #:author author #:location location #:date date)
     "[...]"
     #;
     (make-bibliography-element
diff --git a/collects/scribble/scheme.ss b/collects/scribble/scheme.ss
index d2dcdc23..d69d6b37 100644
--- a/collects/scribble/scheme.ss
+++ b/collects/scribble/scheme.ss
@@ -2,7 +2,8 @@
   (require "struct.ss"
            "basic.ss"
            (lib "class.ss")
-           (lib "for.ss"))
+           (lib "for.ss")
+           (lib "modcollapse.ss" "syntax"))
 
   (provide define-code
            to-element
@@ -17,7 +18,8 @@
            current-variable-list
            current-meta-list
 
-           (struct shaped-parens (val shape)))
+           (struct shaped-parens (val shape))
+           (struct just-context (val ctx)))
 
   (define no-color "schemeplain")
   (define reader-color "schemeplain")
@@ -32,13 +34,12 @@
 
   (define current-keyword-list 
     ;; This is temporary, until the MzScheme manual is filled in...
-    (make-parameter '(require 
+    (make-parameter null #;'(require 
                       provide
                       new send else => and or
                       define-syntax syntax-rules define-struct
-                      quote quasiquote unquote unquote-splicing
-                      syntax quasisyntax unsyntax unsyntax-splicing
-                      set! set!-values)))
+                      quasiquote unquote unquote-splicing
+                      syntax quasisyntax unsyntax unsyntax-splicing)))
   (define current-variable-list 
     (make-parameter null))
   (define current-meta-list 
@@ -353,8 +354,8 @@
                                 (not (or it? is-var?)))
                            (make-delayed-element
                             (lambda (renderer sec ht)
-                              (let* ([vtag (register-scheme-definition (syntax-e c))]
-                                     [stag (register-scheme-form-definition (syntax-e c))]
+                              (let* ([vtag (register-scheme-definition c)]
+                                     [stag (register-scheme-form-definition c)]
                                      [vd (hash-table-get ht vtag #f)]
                                      [sd (hash-table-get ht stag #f)])
                                 (list
@@ -431,7 +432,7 @@
 	     (cond
 	      [(syntax? v)
 	       (let ([mk `(,#'d->s
-			   #f
+			   (quote-syntax ,v)
 			   ,(syntax-case v (uncode)
 			      [(uncode e) #'e]
 			      [else (stx->loc-s-expr (syntax-e v))])
@@ -463,11 +464,22 @@
       [(_ code typeset-code) #'(define-code code typeset-code unsyntax)]))
 
   
-  (define (register-scheme-definition sym)
-    (format "definition:~s" sym))
+  (define (register-scheme-definition stx)
+    (unless (identifier? stx)
+      (error 'register-scheme-definition "not an identifier: ~e" (syntax-object->datum stx)))
+    (format "definition:~s" 
+            (let ([b (identifier-binding stx)])
+              (cond
+               [(not b) (format "top:~a" (syntax-e stx))]
+               [(eq? b 'lexical) (format "lexical:~a" (syntax-e stx))]
+               [else (format "module:~a:~a" 
+                             (if (module-path-index? (car b))
+                                 (collapse-module-path-index (car b) '(lib "ack.ss" "scribble"))
+                                 (car b))
+                             (cadr b))]))))
 
-  (define (register-scheme-form-definition sym)
-    (format "formdefinition:~s" sym))
+  (define (register-scheme-form-definition stx)
+    (format "form~s" (register-scheme-definition stx)))
 
   (define syntax-ize-hook (make-parameter (lambda (v col) #f)))
 
@@ -495,6 +507,7 @@
            l))))
 
   (define-struct shaped-parens (val shape))
+  (define-struct just-context (val ctx))
 
   (define (syntax-ize v col)
     (cond
@@ -504,6 +517,13 @@
       (syntax-property (syntax-ize (shaped-parens-val v) col)
                        'paren-shape
                        (shaped-parens-shape v))]
+     [(just-context? v)
+      (let ([s (syntax-ize (just-context-val v) col)])
+        (datum->syntax-object (just-context-ctx v)
+                              (syntax-e s)
+                              s
+                              s
+                              (just-context-ctx v)))]
      [(and (list? v)
            (pair? v)
            (memq (car v) '(quote unquote unquote-splicing)))
diff --git a/collects/scribble/scribble.css b/collects/scribble/scribble.css
index 04ba33ec..77e65b95 100644
--- a/collects/scribble/scribble.css
+++ b/collects/scribble/scribble.css
@@ -184,6 +184,10 @@
                background-color: #ddddff;
                }
 
+               .specgrammar {
+               float: right;
+               }
+
                .hspace {
                font-family: Courier; font-size: 80%;
                }
diff --git a/collects/scribblings/scribble/eval.scrbl b/collects/scribblings/scribble/eval.scrbl
index 37ceb789..d168f358 100644
--- a/collects/scribblings/scribble/eval.scrbl
+++ b/collects/scribblings/scribble/eval.scrbl
@@ -10,24 +10,24 @@ especially to show example uses of defined procedures and syntax.
 
 @defform[(interaction datum ...)]{Like @scheme[schemeinput], except
 that the result for each input @scheme[datum] is shown on the next
-line. The result is determined by evaluating the quoted form of the
-datum.
+line. The result is determined by evaluating the syntax-quoted form of
+the @scheme[datum].
 
 Uses of @scheme[code:comment] and @schemeidfont{code:blank} are
 stipped from each @scheme[datum] before evaluation.
 
-If a datum has the form @scheme[(#,(scheme code:line) #,(svar datum)
-(#,(scheme code:comment) ...))], then only the @svar[datum] is
-evaluated.
+If a @scheme[datum] has the form @scheme[(#,(scheme code:line)
+_code-datum (#,(scheme code:comment) ...))], then only
+@scheme[_code-datum] is evaluated.
 
 If a datum has the form @scheme[(eval:alts #,(svar show-datum) #,(svar
 eval-datum))], then @svar[show-datum] is typeset, while
 @svar[eval-datum] is evaluated.}
 
-@defform[(interaction-eval datum)]{Evaluates the quoted form of
+@defform[(interaction-eval datum)]{Evaluates the syntax-quoted form of
 each @scheme[datum] via @scheme[do-eval] and returns the empty string.}
 
-@defform[(interaction-eval-show datum)]{Evaluates the quoted form of
+@defform[(interaction-eval-show datum)]{Evaluates the syntax-quoted form of
 @scheme[datum] and produces an element represeting the printed form of
 the result.}
 
diff --git a/collects/scribblings/scribble/manual.scrbl b/collects/scribblings/scribble/manual.scrbl
index 16d791dd..7b5745e9 100644
--- a/collects/scribblings/scribble/manual.scrbl
+++ b/collects/scribblings/scribble/manual.scrbl
@@ -14,7 +14,7 @@ more...
 @defform[(schemeblock datum ...)]{
 
 Typesets the @scheme[datum] sequence as a table of Scheme code inset
-by two spaces. The source locations of the @scheme[datum]s determines
+by two spaces. The source locations of the @scheme[datum]s determine
 the generated layout. For example,
 
 @schemeblock[
@@ -32,10 +32,13 @@ produces the output
 
 with the @scheme[(loop (not x))] indented under @scheme[define],
 because that's the way it is idented the use of @scheme[schemeblock].
+
 Furthermore, @scheme[define] is typeset as a keyword (bold and black)
 and as a hyperlink to @scheme[define]'s definition in the reference
 manual, because this document was built using information about the
-MzScheme manual. Similarly, @scheme[not] is a hyperlink to the its
+reference manual, and because the lexical binding of @scheme[define]
+(in the source) matches the lexical binding of the definition in the
+reference manual. Similarly, @scheme[not] is a hyperlink to the its
 definition in the reference manual.
 
 Use @scheme[unsyntax] to escape back to an expression that produces an
@@ -127,7 +130,7 @@ useful with @scheme[verbatim].}
 
 @defproc[(schemefont [pre-content any/c] ...) element?]{Typesets the given
 content as uncolored, unhyperlinked Scheme. This procedure is useful
-for typesetting thngs like @scheme{#module}, which are not
+for typesetting things like @scheme{#module}, which are not
 @scheme[read]able by themselves.}
 
 @defproc[(schemevalfont [pre-content any/c] ...) element?]{Like
@@ -143,7 +146,7 @@ for typesetting thngs like @scheme{#module}, which are not
 @scheme[schemefont], but colored as a syntactic form name.}
 
 @defproc[(procedure [pre-content any/c] ...) element?]{Typesets the given
-content as a procedure name in a REPL result (e.g., in typewrite font
+content as a procedure name in a REPL result (e.g., in typewriter font
 with a @schemefont{#<procedure:} prefix and @schemefont{>} suffix.).}
 
 @defform[(var datum)]{Typesets @scheme[var] as an identifier that is
@@ -164,9 +167,9 @@ in a form definition.}
                   pre-flow ...)]{
 
 Produces a sequence of flow elements (encaptured in a @scheme[splice])
-to document a procedure named @scheme[id]. The
-@scheme[id] is registered so that @scheme[scheme]-typeset uses
-of the identifier are hyperlinked to this documentation.
+to document a procedure named @scheme[id]. The @scheme[id] is
+registered so that @scheme[scheme]-typeset uses of the identifier
+(with the same lexical binding) are hyperlinked to this documentation.
 
 Each @scheme[arg-spec] must have one of the following forms:
 
@@ -213,39 +216,54 @@ Like @scheme[defproc], but for multiple cases with the same
 @scheme[id].  }
 
 
-@defform[(defform (id . datum) pre-flow ...)]{Produces a 
-a sequence of flow elements (encaptured in a @scheme[splice]) to
-document a syntatic form named by @scheme[id]. The
-@scheme[id] is registered so that @scheme[scheme]-typeset uses
-of the identifier are hyperlinked to this documentation.
+@defform/subs[(defform maybe-literals (id . datum) pre-flow ...)
+              ([maybe-literals code:blank
+                               (code:line #:literals (literal-id ...))])]{
+
+Produces a a sequence of flow elements (encaptured in a
+@scheme[splice]) to document a syntatic form named by @scheme[id]. The
+@scheme[id] is registered so that @scheme[scheme]-typeset uses of the
+identifier (with the same lexical binding) are hyperlinked to this
+documentation.
 
 The @scheme[pre-flow]s list is parsed as a flow that documents the
 procedure. In this description, a reference to any identifier in
-@scheme[datum] is typeset as a sub-form non-terminal.
+@scheme[datum] is typeset as a sub-form non-terminal. If
+@scheme[#:literals] clause is provided, however, instances of the
+@scheme[literal-id]s are typeset normally.
 
 The typesetting of @scheme[(id . datum)] preserves the source
 layout, like @scheme[schemeblock], and unlike @scheme[defproc].}
 
-@defform[(defform* [(id . datum) ..+] pre-flow ...)]{Like @scheme[defform],
-but for multiple forms using the same @scheme[id].}
+@defform[(defform* maybe-literals [(id . datum) ..+] pre-flow ...)]{
 
-@defform[(defform/subs (id . datum) 
-           ([nonterm-id clause-datum ...+] ...) 
-           pre-flow ...)]{
+Like @scheme[defform], but for multiple forms using the same
+@scheme[id].}
+
+@defform/subs[(defform/subs maybe-literals (id . datum) 
+                ([nonterm-id clause-datum ...+] ...) 
+                pre-flow ...)
+              ([maybe-literals code:blank
+                               (code:line #:literals (literal-id ...))])]{
 Like @scheme[defform], but including an auxiliary grammar of
 non-terminals shown with the @scheme[id] form. Each
 @scheme[nonterm-id] is specified as being any of the corresponding
 @scheme[clause-datum]s, where the formatting of each
 @scheme[clause-datum] is preserved.}
 
-@defform[(specform (id . datum) pre-flow ...)]{Like @scheme[defform],
-with without registering a definition, and with indenting on the left
-for both the specification and the @scheme[pre-flow]s.}
+@defform/subs[(specform maybe-literals (id . datum) pre-flow ...)
+              ([maybe-literals code:blank
+                               (code:line #:literals (literal-id ...))])]{
 
-@defform[(specsubform datum pre-flow ...)]{Similar to
-@scheme[defform], but without any specific identifier being defined,
-and the table and flow are typeset indented. This form is intended for
-use when refining the syntax of a non-terminal used in a
+Like @scheme[defform], with without registering a definition, and with
+indenting on the left for both the specification and the
+@scheme[pre-flow]s.}
+
+@defform[(specsubform maybe-literals datum pre-flow ...)]{
+
+Similar to @scheme[defform], but without any specific identifier being
+defined, and the table and flow are typeset indented. This form is
+intended for use when refining the syntax of a non-terminal used in a
 @scheme[defform] or other @scheme[specsubform]. For example, it is
 used in the documentation for @scheme[defproc] in the itemization of
 possible shapes for @svar[arg-spec].
@@ -254,8 +272,9 @@ The @scheme[pre-flow]s list is parsed as a flow that documents the
 procedure. In this description, a reference to any identifier in
 @scheme[datum] is typeset as a sub-form non-terminal.}
 
-@defform[(defthing id contract-expr-datum pre-flow ...)]{Like
-@scheme[defproc], but for a non-procedure binding.}
+@defform[(defthing id contract-expr-datum pre-flow ...)]{
+
+Like @scheme[defproc], but for a non-procedure binding.}
 
 @defform/subs[(defstruct struct-name ([field-name contract-expr-datum] ...)
                 pre-flow ...)
@@ -265,13 +284,19 @@ procedure. In this description, a reference to any identifier in
 Similar to @scheme[defform] or @scheme[defproc], but for a structure
 definition.}
 
-@defform/subs[(schemegrammar literals ? id clause-datum ...+)
-              ([literals (code:line #:literals (literal-id ...))])]{
-Creates a table to define the grammar of @scheme[id]. Each identifier mentioned
-in a @scheme[clause-datum] is typeset as a non-terminal, except for the
-identifiers listed as @scheme[literal-id]s, which are typeset as with 
-@scheme[scheme].
-}
+@defform/subs[(schemegrammar maybe-literals id clause-datum ...+)
+              ([maybe-literals code:blank
+                               (code:line #:literals (literal-id ...))])]{
+
+Creates a table to define the grammar of @scheme[id]. Each identifier
+mentioned in a @scheme[clause-datum] is typeset as a non-terminal,
+except for the identifiers listed as @scheme[literal-id]s, which are
+typeset as with @scheme[scheme].}
+
+@defform[(schemegrammar* maybe-literals [id clause-datum ...+] ...)]{
+
+Like @scheme[schemegrammar], but for typesetting multiple productions
+at once, aligned around the @litchar{=} and @litchar{|}.}
 
 @; ------------------------------------------------------------------------
 @section{Various String Forms}