diff --git a/collects/scribble/srcdoc.ss b/collects/scribble/srcdoc.ss
index 064b97a1..3a358733 100644
--- a/collects/scribble/srcdoc.ss
+++ b/collects/scribble/srcdoc.ss
@@ -117,15 +117,55 @@
                          (syntax-case #'names ()
                            [((mandatory-names ...)
                              ((optional-names optional-default) ...))
-                            (begin
-                              (unless (= (length (syntax->list #'(mandatory-names ...)))
-                                         (length (syntax->list #'(mandatory ...))))
-                                (raise-syntax-error #f "mismatched mandatory argument list and domain contract count" stx))
-                              (unless (= (length (syntax->list #'(optional-names ...)))
-                                         (length (syntax->list #'(optional ...))))
-                                (raise-syntax-error #f "mismatched mandatory argument list and domain contract count" stx))
-                              #'([(id (mandatory-names mandatory) ... (optional-names optional optional-default) ...)
-                                  result]))]
+                            
+                            (let ([build-mandatories/optionals
+                                   (λ (names contracts extras)
+                                     (let ([names-length (length names)]
+                                           [contracts-length (length contracts)])
+                                       (let loop ([contracts contracts]
+                                                  [names names]
+                                                  [extras extras])
+                                         (cond
+                                           [(and (null? names) (null? contracts)) '()]
+                                           [(or (null? names) (null? contracts))
+                                            (raise-syntax-error #f
+                                                                (format "mismatched ~a argument list count and domain contract count (~a)"
+                                                                        (if extras "optional" "mandatory")
+                                                                        (if (null? names)
+                                                                            "ran out of names"
+                                                                            "ran out of contracts"))
+                                                                stx)]
+                                           [else
+                                            (let ([fst-name (car names)]
+                                                  [fst-ctc (car contracts)])
+                                              (if (keyword? (syntax-e fst-ctc))
+                                                  (begin
+                                                    (unless (pair? (cdr contracts))
+                                                      (raise-syntax-error #f
+                                                                          "keyword not followed by a contract"
+                                                                          stx))
+                                                    (cons (if extras
+                                                              (list fst-ctc fst-name (cadr contracts) (car extras))
+                                                              (list fst-ctc fst-name (cadr contracts)))
+                                                          (loop (cddr contracts)
+                                                                (cdr names)
+                                                                (if extras
+                                                                    (cdr extras)
+                                                                    extras))))
+                                                  (cons (if extras 
+                                                            (list fst-name fst-ctc (car extras))
+                                                            (list fst-name fst-ctc))
+                                                        (loop (cdr contracts) (cdr names) (if extras
+                                                                                              (cdr extras)
+                                                                                              extras)))))]))))])
+                            
+                              #`([(id #,@(build-mandatories/optionals (syntax->list #'(mandatory-names ...))
+                                                                      (syntax->list #'(mandatory ...))
+                                                                      #f)
+                                      #,@(build-mandatories/optionals (syntax->list #'(optional-names ...))
+                                                                      (syntax->list #'(optional ...))
+                                                                      (syntax->list #'(optional-default ...))))
+                                result]))]
                            [(mandatory-names optional-names)
                             (begin
                               (syntax-case #'mandatory-names ()
diff --git a/collects/scribblings/scribble/srcdoc.scrbl b/collects/scribblings/scribble/srcdoc.scrbl
index 2a66afcc..4c926b26 100644
--- a/collects/scribblings/scribble/srcdoc.scrbl
+++ b/collects/scribblings/scribble/srcdoc.scrbl
@@ -71,10 +71,14 @@ to get core Scheme forms and basic Scribble functions to use in
 documentation expressions.}
 
 @defform*/subs[#:literals (-> ->* case->)
-               [(proc-doc/names id contract (arg-id ...) desc-expr)
-                (proc-doc/names id case-contract ((arg-id ...) ...) desc-expr)]
+               [(proc-doc/names id contract ((arg-id ...) ((arg-id default-expr) ...)) desc-expr)
+                (proc-doc/names id case-contract ((arg-id ...) ((arg-id default-expr) ...)) desc-expr)]
                ([contract (-> arg ... result)
                           (->* (mandatory ...) (optional ...) result)]
+                [mandatory contract-expr
+                           (code:line keyword contract-expr)]
+                [optional contract-expr
+                          (code:line keyword contract-expr)]
                 [case-contract (case-> (-> arg ... result) ...)])]{
                           
 When used in @scheme[provide/doc], exports @scheme[id] with the
@@ -84,7 +88,8 @@ just like using @scheme[provide/contract].
 The @scheme[arg-id]s specify the names of arguments, which are not
 normally written as part of a contract. They are combined with the
 contract expression to generate the description of the binding in the
-documentation via @scheme[defproc].
+documentation via @scheme[defproc]. The @scheme[(arg-id default-expr)]
+pairs specify the names and default values of the optional arguments.
 
 The @scheme[desc-expr] is a documentation-time expression that
 produces prose to describe the exported binding---that is, the last