diff --git a/collects/scribble/manual.ss b/collects/scribble/manual.ss
index a926c89f..b248d5df 100644
--- a/collects/scribble/manual.ss
+++ b/collects/scribble/manual.ss
@@ -12,7 +12,9 @@
          scheme/stxparam
          scheme/serialize
          setup/main-collects
-         (for-syntax scheme/base)
+         (for-syntax scheme/base
+                     syntax/boundmap
+                     syntax/kerncase)
          (for-label scheme/base
                     scheme/class))
 
@@ -739,13 +741,16 @@
     [(_ [[proto result] ...] desc ...)
      (defproc* #:mode procedure #:within #f [[proto result] ...] desc ...)]
     [(_ #:mode m #:within cl [[proto result] ...] desc ...)
-     (*defproc 'm (quote-syntax/loc cl)
-               (list (extract-proc-id proto) ...)
-               '[proto ...]
-               (list (arg-contracts proto) ...)
-               (list (arg-defaults proto) ...)
-               (list (lambda () (result-contract result)) ...)
-               (lambda () (list desc ...)))]))
+     (with-togetherable-scheme-variables
+      ()
+      ([proc proto] ...)
+      (*defproc 'm (quote-syntax/loc cl)
+                (list (extract-proc-id proto) ...)
+                '[proto ...]
+                (list (arg-contracts proto) ...)
+                (list (arg-defaults proto) ...)
+                (list (lambda () (result-contract result)) ...)
+                (lambda () (list desc ...))))]))
 (define-syntax defstruct
   (syntax-rules ()
     [(_ name fields #:mutable #:inspector #f desc ...)
@@ -762,10 +767,13 @@
      (**defstruct name fields #t #f desc ...)]))
 (define-syntax-rule (**defstruct name ([field field-contract] ...) immutable?
                                  transparent? desc ...)
-  (*defstruct (quote-syntax/loc name) 'name
-              '([field field-contract] ...)
-              (list (lambda () (schemeblock0 field-contract)) ...)
-              immutable? transparent? (lambda () (list desc ...))))
+  (with-togetherable-scheme-variables
+   ()
+   ()
+   (*defstruct (quote-syntax/loc name) 'name
+               '([field field-contract] ...)
+               (list (lambda () (schemeblock0 field-contract)) ...)
+               immutable? transparent? (lambda () (list desc ...)))))
 (define-syntax (defform*/subs stx)
   (syntax-case stx ()
     [(_ #:id defined-id #:literals (lit ...) [spec spec1 ...]
@@ -783,16 +791,20 @@
                                           spec
                                           spec)]
                           [_ spec])))])
-       #'(*defforms (quote-syntax/loc defined-id) '(lit ...)
-                    '(spec spec1 ...)
-                    (list (lambda (x) (schemeblock0/form new-spec))
-                          (lambda (ignored) (schemeblock0/form spec1)) ...)
-                    '((non-term-id non-term-form ...) ...)
-                    (list (list (lambda () (scheme non-term-id))
-                                (lambda () (schemeblock0/form non-term-form))
-                                ...)
-                          ...)
-                    (lambda () (list desc ...))))]
+       #'(with-togetherable-scheme-variables
+          (lit ...)
+          ([form spec] [form spec1] ... 
+           [non-term (non-term-id non-term-form ...)] ...)
+          (*defforms (quote-syntax/loc defined-id)
+                     '(spec spec1 ...)
+                     (list (lambda (x) (schemeblock0/form new-spec))
+                           (lambda (ignored) (schemeblock0/form spec1)) ...)
+                     '((non-term-id non-term-form ...) ...)
+                     (list (list (lambda () (scheme non-term-id))
+                                 (lambda () (schemeblock0/form non-term-form))
+                                 ...)
+                           ...)
+                     (lambda () (list desc ...)))))]
     [(fm #:id id [spec spec1 ...] ([non-term-id non-term-form ...] ...)
          desc ...)
      #'(fm #:id id #:literals () [spec spec1 ...]
@@ -839,46 +851,60 @@
 (define-syntax (defform/none stx)
   (syntax-case stx ()
     [(_ #:literals (lit ...) spec desc ...)
-     #'(*defforms #f '(lit ...)
-                  '(spec) (list (lambda (ignored) (schemeblock0/form spec)))
-                  null null
-                  (lambda () (list desc ...)))]
+     #'(with-togetherable-scheme-variables
+        (lit ...)
+        ([form spec])
+        (*defforms #f
+                   '(spec) (list (lambda (ignored) (schemeblock0/form spec)))
+                   null null
+                   (lambda () (list desc ...))))]
     [(_ spec desc ...)
      #'(defform/none #:literals () spec desc ...)]))
 (define-syntax (defidform stx)
   (syntax-case stx ()
     [(_ spec-id desc ...)
-     #'(*defforms (quote-syntax/loc spec-id) null
-                  '(spec-id)
-                  (list (lambda (x) (make-omitable-paragraph (list x))))
-                  null
-                  null
-                  (lambda () (list desc ...)))]))
+     #'(with-togetherable-scheme-variables
+        ()
+        ()
+        (*defforms (quote-syntax/loc spec-id)
+                   '(spec-id)
+                   (list (lambda (x) (make-omitable-paragraph (list x))))
+                   null
+                   null
+                   (lambda () (list desc ...))))]))
 (define-syntax (defsubform stx)
   (syntax-case stx ()
     [(_ . rest) #'(into-blockquote (defform . rest))]))
 (define-syntax (defsubform* stx)
   (syntax-case stx ()
     [(_ . rest) #'(into-blockquote (defform* . rest))]))
+(define-syntax spec?form/subs
+  (syntax-rules ()
+    [(_ has-kw? #:literals (lit ...) spec ([non-term-id non-term-form ...] ...)
+        desc ...)
+     (with-scheme-variables
+      (lit ...)
+      ([form/maybe (has-kw? spec)]
+       [non-term (non-term-id non-term-form ...)] ...)
+      (*specsubform 'spec '(lit ...) (lambda () (schemeblock0/form spec))
+                    '((non-term-id non-term-form ...) ...)
+                    (list (list (lambda () (scheme non-term-id))
+                                (lambda () (schemeblock0/form non-term-form))
+                                ...)
+                          ...)
+                    (lambda () (list desc ...))))]))
 (define-syntax specsubform
   (syntax-rules ()
     [(_ #:literals (lit ...) spec desc ...)
-     (*specsubform 'spec #f '(lit ...) (lambda () (schemeblock0/form spec))
-                   null null (lambda () (list desc ...)))]
+     (spec?form/subs #f #:literals (lit ...) spec () desc ...)]
     [(_ spec desc ...)
-     (*specsubform 'spec #f null (lambda () (schemeblock0/form spec))
-                   null null (lambda () (list desc ...)))]))
+     (specsubform #:literals () spec desc ...)]))
 (define-syntax specsubform/subs
   (syntax-rules ()
     [(_ #:literals (lit ...) spec ([non-term-id non-term-form ...] ...)
         desc ...)
-     (*specsubform 'spec #f '(lit ...) (lambda () (schemeblock0/form spec))
-                   '((non-term-id non-term-form ...) ...)
-                   (list (list (lambda () (scheme non-term-id))
-                               (lambda () (schemeblock0/form non-term-form))
-                               ...)
-                         ...)
-                   (lambda () (list desc ...)))]
+     (spec?form/subs #f #:literals (lit ...) spec ([non-term-id non-term-form ...] ...)
+                     desc ...)]
     [(_ spec subs desc ...)
      (specsubform/subs #:literals () spec subs desc ...)]))
 (define-syntax-rule (specspecsubform spec desc ...)
@@ -888,37 +914,37 @@
 (define-syntax specform
   (syntax-rules ()
     [(_ #:literals (lit ...) spec desc ...)
-     (*specsubform 'spec #t '(lit ...) (lambda () (schemeblock0/form spec))
-                   null null (lambda () (list desc ...)))]
+     (spec?form/subs #t #:literals (lit ...) spec () desc ...)]
     [(_ spec desc ...)
-     (*specsubform 'spec #t null (lambda () (schemeblock0/form spec))
-                   null null (lambda () (list desc ...)))]))
+     (specform #:literals () spec desc ...)]))
 (define-syntax specform/subs
   (syntax-rules ()
     [(_ #:literals (lit ...) spec ([non-term-id non-term-form ...] ...)
         desc ...)
-     (*specsubform 'spec #t
-                   '(lit ...)
-                   (lambda () (schemeblock0/form spec))
-                   '((non-term-id non-term-form ...) ...)
-                   (list (list (lambda () (scheme non-term-id))
-                               (lambda () (schemeblock0/form non-term-form))
-                               ...)
-                         ...)
-                   (lambda () (list desc ...)))]
+     (spec?form/subs #t #:literals (lit ...) spec ([non-term-id non-term-form ...] ...)
+                     desc ...)]
     [(_ spec ([non-term-id non-term-form ...] ...) desc ...)
      (specform/subs #:literals () spec ([non-term-id non-term-form ...] ...)
                     desc ...)]))
 (define-syntax-rule (specsubform/inline spec desc ...)
-  (*specsubform 'spec #f null #f null null (lambda () (list desc ...))))
+  (with-scheme-variables
+   ()
+   ([form/maybe (#f spec)])
+   (*specsubform 'spec null #f null null (lambda () (list desc ...)))))
 (define-syntax-rule (defthing id result desc ...)
-  (*defthing (list (quote-syntax/loc id)) (list 'id) #f
-             (list (schemeblock0 result))
-             (lambda () (list desc ...))))
+  (with-togetherable-scheme-variables
+   ()
+   ()
+   (*defthing (list (quote-syntax/loc id)) (list 'id) #f
+              (list (schemeblock0 result))
+              (lambda () (list desc ...)))))
 (define-syntax-rule (defthing* ([id result] ...) desc ...)
-  (*defthing (list (quote-syntax/loc id) ...) (list 'id ...) #f
-             (list (schemeblock0 result) ...)
-             (lambda () (list desc ...))))
+  (with-togetherable-scheme-variables
+   ()
+   ()
+   (*defthing (list (quote-syntax/loc id) ...) (list 'id ...) #f
+              (list (schemeblock0 result) ...)
+              (lambda () (list desc ...)))))
 (define-syntax-rule (defparam id arg contract desc ...)
   (defproc* ([(id) contract] [(id [arg contract]) void?]) desc ...))
 (define-syntax-rule (defparam* id arg in-contract out-contract desc ...)
@@ -928,20 +954,26 @@
 (define-syntax schemegrammar
   (syntax-rules ()
     [(_ #:literals (lit ...) id clause ...)
-     (*schemegrammar '(lit ...)
-                     '(id clause ...)
-                     (lambda ()
-                       (list (list (scheme id)
-                                   (schemeblock0/form clause) ...))))]
+     (with-scheme-variables
+      (lit ...)
+      ([non-term (id clause ...)])
+      (*schemegrammar '(lit ...)
+                      '(id clause ...)
+                      (lambda ()
+                        (list (list (scheme id)
+                                    (schemeblock0/form 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/form clause) ...)
-                             ...)))]
+     (with-scheme-variables
+      (lit ...)
+      ([non-term (id clause ...)] ...)
+      (*schemegrammar '(lit ...)
+                      '(id ... clause ... ...)
+                      (lambda ()
+                        (list (list (scheme id) (schemeblock0/form clause) ...)
+                              ...))))]
     [(_ [id clause ...] ...)
      (schemegrammar* #:literals () [id clause ...] ...)]))
 (define-syntax-rule (var id)
@@ -949,6 +981,75 @@
 (define-syntax-rule (svar id)
   (*var 'id))
 
+(define-syntax (with-togetherable-scheme-variables stx)
+  (syntax-case stx ()
+    [(_ . rest)
+     ;; Make it transparent, so deftogether is allowed to pull it apart
+     (syntax-property
+      (syntax/loc stx
+        (with-togetherable-scheme-variables* . rest))
+      'certify-mode
+      'transparent)]))
+
+(define-syntax-rule (with-togetherable-scheme-variables* . rest)
+  (with-scheme-variables . rest))
+
+(define-syntax (with-scheme-variables stx)
+  (syntax-case stx ()
+    [(_ lits ([kind s-exp] ...) body)
+     (let ([ht (make-bound-identifier-mapping)]
+           [lits (syntax->datum #'lits)])
+       (for-each (lambda (kind s-exp)
+                   (case (syntax-e kind)
+                     [(proc)
+                      (for-each
+                       (lambda (arg)
+                         (if (identifier? arg)
+                             (unless (or (eq? (syntax-e arg) '...)
+                                         (eq? (syntax-e arg) '...+)
+                                         (memq (syntax-e arg) lits))
+                               (bound-identifier-mapping-put! ht arg #t))
+                             (syntax-case arg ()
+                               [(kw arg . rest)
+                                (keyword? (syntax-e #'kw))
+                                (bound-identifier-mapping-put! ht #'arg #t)]
+                               [(arg . rest)
+                                (identifier? #'arg)
+                                (bound-identifier-mapping-put! ht #'arg #t)])))
+                       (cdr (syntax->list s-exp)))]
+                     [(form form/maybe non-term)
+                      (let loop ([form (case (syntax-e kind)
+                                         [(form) (if (identifier? s-exp)
+                                                     null
+                                                     (cdr (syntax-e s-exp)))]
+                                         [(form/maybe)
+                                          (syntax-case s-exp ()
+                                            [(#f form) #'form]
+                                            [(#t (id . form)) #'form])]
+                                         [(non-term) s-exp])])
+                        (if (identifier? form)
+                            (unless (or (eq? (syntax-e form) '...)
+                                        (eq? (syntax-e form) '...+)
+                                        (eq? (syntax-e form) '?)
+                                        (memq (syntax-e form) lits))
+                              (bound-identifier-mapping-put! ht form #t))
+                            (syntax-case form (unsyntax)
+                              [(unsyntax _) (void)]
+                              [(a . b) (loop #'a) (loop #'b)]
+                              [#(a ...) (loop #'(a ...))]
+                              [_ (void)])))]
+                     [else
+                      (raise-syntax-error
+                       #f
+                       "unknown variable mode"
+                       stx
+                       kind)]))
+                 (syntax->list #'(kind ...))
+                 (syntax->list #'(s-exp ...)))
+       (with-syntax ([(id ...) (bound-identifier-mapping-map ht (lambda (k v) k))])
+         #'(parameterize ([current-variable-list '(id ...)])
+             body)))]))
+
 (define (defthing/proc id contract descs)
   (*defthing (list id) (list (syntax-e id)) #f (list contract)
              (lambda () descs)))
@@ -1009,7 +1110,7 @@
    (lambda (render part ri)
      (proc (or (get-exporting-libraries render part ri) null)))))
 
-(define-struct (box-splice splice) (var-list))
+(define-struct (box-splice splice) ())
 
 (define (*deftogether boxes body-thunk)
   (make-splice
@@ -1029,12 +1130,33 @@
                                 "together"
                                 (table-flowss (car (splice-run box))))))))
       boxes))
-    (parameterize ([current-variable-list
-                    (append-map box-splice-var-list boxes)])
-      (body-thunk)))))
+    (body-thunk))))
 
-(define-syntax-rule (deftogether (box ...) . body)
-  (*deftogether (list box ...) (lambda () (list . body))))
+(define-syntax (deftogether stx)
+  (syntax-case stx ()
+    [(_ (def ...) . body)
+     (with-syntax ([((_ (lit ...) (var ...) decl) ...)
+                    (map (lambda (def)
+                           (let ([exp-def (local-expand 
+                                           def
+                                           'expression
+                                           (cons
+                                            #'with-togetherable-scheme-variables*
+                                            (kernel-form-identifier-list)))])
+                             (syntax-case exp-def (with-togetherable-scheme-variables*)
+                               [(with-togetherable-scheme-variables* lits vars decl)
+                                exp-def]
+                               [_
+                                (raise-syntax-error
+                                 #f
+                                 "sub-form is not a documentation form that can be combined"
+                                 stx
+                                 def)])))
+                         (syntax->list #'(def ...)))])
+       #'(with-togetherable-scheme-variables
+          (lit ... ...)
+          (var ... ...)
+          (*deftogether (list decl ...) (lambda () (list . body)))))]))
 
 (define-struct arg
   (special? kw id optional? starts-optional? ends-optional? num-closers))
@@ -1365,22 +1487,20 @@
   (define var-list
     (filter-map (lambda (a) (and (not (arg-special? a)) (arg-id a)))
                 (append* all-args)))
-  (parameterize ([current-variable-list var-list])
-    (make-box-splice
-     (cons
-      (make-table
-       'boxed
-       (append-map
-        do-one
-        stx-ids prototypes all-args arg-contractss arg-valss result-contracts
-        (let loop ([ps prototypes] [accum null])
-          (cond [(null? ps) null]
-                [(ormap (lambda (a) (eq? (extract-id (car ps)) a)) accum)
-                 (cons #f (loop (cdr ps) accum))]
-                [else (cons #t (loop (cdr ps)
-                                     (cons (extract-id (car ps)) accum)))]))))
-      (content-thunk))
-     var-list)))
+  (make-box-splice
+   (cons
+    (make-table
+     'boxed
+     (append-map
+      do-one
+      stx-ids prototypes all-args arg-contractss arg-valss result-contracts
+      (let loop ([ps prototypes] [accum null])
+        (cond [(null? ps) null]
+              [(ormap (lambda (a) (eq? (extract-id (car ps)) a)) accum)
+               (cons #f (loop (cdr ps) accum))]
+              [else (cons #t (loop (cdr ps)
+                                   (cons (extract-id (car ps)) accum)))]))))
+    (content-thunk))))
 
 (define (make-target-element* inner-make-target-element stx-id content wrappers)
   (if (null? wrappers)
@@ -1577,8 +1697,7 @@
                                (make-flow (list (field-contract))))))))]
                [else null]))
            fields field-contracts)))
-    (content-thunk))
-   null))
+    (content-thunk))))
 
 (define (*defthing stx-ids names form? result-contracts content-thunk)
   (make-box-splice
@@ -1623,24 +1742,12 @@
                                 result-contract
                                 (make-omitable-paragraph (list result-contract)))))))))))
       stx-ids names result-contracts))
-    (content-thunk))
-   null))
+    (content-thunk))))
 
 (define (meta-symbol? s) (memq s '(... ...+ ?)))
 
-(define (*defforms kw-id lits forms form-procs subs sub-procs content-thunk)
-  (define var-list
-    (let loop ([form (cons forms subs)])
-      (cond [(symbol? form)
-             (if (or (meta-symbol? form)
-                     (and kw-id (eq? form (syntax-e kw-id)))
-                     (memq form lits))
-               null
-               (list form))]
-            [(pair? form) (append (loop (car form)) (loop (cdr form)))]
-            [else null])))
-  (parameterize ([current-variable-list var-list]
-                 [current-meta-list '(... ...+)])
+(define (*defforms kw-id forms form-procs subs sub-procs content-thunk)
+  (parameterize ([current-meta-list '(... ...+)])
     (make-box-splice
      (cons
       (make-table
@@ -1689,23 +1796,10 @@
                                (*schemerawgrammars "specgrammar"
                                                    (map car l)
                                                    (map cdr l))))))))))
-      (content-thunk))
-     var-list)))
+      (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)
-                                                 subs)])
-                            (cond
-                              [(symbol? form) (if (or (meta-symbol? form)
-                                                      (memq form lits))
-                                                null
-                                                (list form))]
-                              [(pair? form) (append (loop (car form))
-                                                    (loop (cdr form)))]
-                              [else null]))
-                          (current-variable-list))]
-                 [current-meta-list '(... ...+)])
+(define (*specsubform form lits form-thunk subs sub-procs content-thunk)
+  (parameterize ([current-meta-list '(... ...+)])
     (make-blockquote
      "leftindent"
      (cons
@@ -1754,23 +1848,14 @@
   (*schemerawgrammars style (list nonterm) (list (cons clause1 clauses))))
 
 (define (*schemegrammar lits s-expr clauseses-thunk)
-  (parameterize ([current-variable-list
-                  (let loop ([form s-expr])
-                    (cond
-                      [(symbol? form) (if (memq form lits)
-                                        null
-                                        (list form))]
-                      [(pair? form) (append (loop (car form))
-                                            (loop (cdr form)))]
-                      [else null]))])
-    (let ([l (clauseses-thunk)])
-      (*schemerawgrammars #f
-                          (map (lambda (x)
-                                 (make-element #f
-                                               (list (hspace 2)
-                                                     (car x))))
-                               l)
-                          (map cdr l)))))
+  (let ([l (clauseses-thunk)])
+    (*schemerawgrammars #f
+                        (map (lambda (x)
+                               (make-element #f
+                                             (list (hspace 2)
+                                                   (car x))))
+                             l)
+                        (map cdr l))))
 
 (define (*var id)
   (to-element (*var-sym id)))
@@ -2425,16 +2510,22 @@
          signature-desc)
 
 (define-syntax-rule (defsignature name (super ...) body ...)
-  (*defsignature (quote-syntax name)
-                 (list (quote-syntax super) ...)
-                 (lambda () (list body ...))
-                 #t))
+  (with-togetherable-scheme-variables
+   ()
+   ()
+   (*defsignature (quote-syntax name)
+                  (list (quote-syntax super) ...)
+                  (lambda () (list body ...))
+                  #t)))
 
 (define-syntax-rule (defsignature/splice name (super ...) body ...)
-  (*defsignature (quote-syntax name)
-                 (list (quote-syntax super) ...)
-                 (lambda () (list body ...))
-                 #f))
+  (with-togetherable-scheme-variables
+   ()
+   ()
+   (*defsignature (quote-syntax name)
+                  (list (quote-syntax super) ...)
+                  (lambda () (list body ...))
+                  #f)))
 
 (define-struct sig-desc (in))
 (define (signature-desc . l)