scribble/srcdoc: add form-doc

original commit: 63e940d14708f2eb06e57e5239b9c98b84aeeebe

pkgs/scribble-pkgs/scribble-doc/scribblings/scribble/srcdoc.scrbl

@@ -126,7 +126,7 @@ arguments.
 }
 
 
-@defform[(thing-doc id contract-expr dec-expr)]{
+@defform[(thing-doc id contract-expr (desc-expr ...))]{
 
 Like @racket[proc-doc], but for an export of an arbitrary value.}
 
@@ -156,6 +156,37 @@ Like @racket[proc-doc], but for exporting a parameter.}
   Like @racket[struct*-doc], but for struct declarations that use @racket[define-struct].
 }
 
+
+@defform/subs[(form-doc options form-datum
+                maybe-grammar maybe-contracts
+                (desc-expr ...))
+              ([options (code:line maybe-kind maybe-link maybe-id maybe-literals)]
+               [maybe-kind code:blank
+                           (code:line #:kind kind-string-expr)]
+               [maybe-link code:blank
+                           (code:line #:link-target? link-target?-expr)]
+               [maybe-id code:blank
+                         (code:line #:id id)
+                         (code:line #:id [id id-expr])]
+               [maybe-literals code:blank
+                               (code:line #:literals (literal-id ...))]
+               [maybe-grammar code:blank
+                              (code:line #:grammar ([nonterm-id clause-datum ...+] ...))]
+               [maybe-contracts code:blank
+                                (code:line #:contracts ([subform-datum contract-expr-datum]
+                                                        ...))])]{
+
+Like @racket[proc-doc], but for an export of a syntactic form. If
+@racket[#:id] is provided, then @racket[id] is the exported identifier,
+otherwise the exported identifier is extracted from @racket[form-datum].
+
+See @racket[defform] for information on @racket[options],
+@racket[form-datum], @racket[maybe-grammar], and
+@racket[maybe-contracts].
+
+@history[#:added "1.6"]}
+
+
 @defform[(begin-for-doc form ...)]{
 
 Like to @racket[begin-for-syntax], but for documentation time instead

pkgs/scribble-pkgs/scribble-lib/scribble/extract.rkt

@@ -9,7 +9,11 @@
   (syntax-case stx ()
     [(_ module-path)
      (with-syntax ([get-docs (syntax-local-lift-require 
-                              #'(only (submod module-path srcdoc) get-docs)
+                              #`(only (submod #,@(syntax-case #'module-path (submod)
+                                                   [(submod e ...) #'(e ...)]
+                                                   [e #'(e)])
+                                              srcdoc)
+                                      get-docs)
                               (datum->syntax stx 'get-docs))]
                    [(wrap ...) wraps])
        #'(begin

pkgs/scribble-pkgs/scribble-lib/scribble/private/manual-form.rkt

@@ -24,7 +24,9 @@
          racketgrammar racketgrammar*
          (rename-out [racketgrammar schemegrammar]
                      [racketgrammar* schemegrammar*])
-         var svar)
+         var svar
+         (for-syntax kind-kw id-kw link-target?-kw
+                     literals-kw subs-kw contracts-kw))
 
 (begin-for-syntax
  (define-splicing-syntax-class kind-kw

pkgs/scribble-pkgs/scribble-lib/scribble/srcdoc.rkt

@@ -4,7 +4,8 @@
                      racket/require-transform
                      racket/provide-transform
                      syntax/stx
-                     syntax/private/modcollapse-noctc))
+                     syntax/private/modcollapse-noctc
+                     syntax/parse))
 
 (provide for-doc require/doc
          provide/doc ; not needed anymore
@@ -14,6 +15,7 @@
          proc-doc/names
          struct-doc
          struct*-doc
+         form-doc
          generate-delayed-documents
          begin-for-doc)
 
@@ -129,8 +131,10 @@
                         forms)])
       (with-syntax ([(p/c ...)
                      (map (lambda (form f)
+                            (if (identifier? f)
+                                f
                                 (quasisyntax/loc form
-                              (contract-out #,f)))
+                                  (contract-out #,f))))
                           forms
                           (syntax->list #'(for-provide/contract ...)))])
         (generate-doc-submodule!)
@@ -567,6 +571,81 @@
           #'((only-in scribble/manual defthing))
           #'id))])))
 
+(begin-for-syntax
+ (define-splicing-syntax-class kind-kw
+   #:description "#:kind keyword"
+   (pattern (~seq #:kind kind)
+            #:with (kind-seq ...) #'(#:kind kind))
+   (pattern (~seq)
+            #:with (kind-seq ...) #'()))
+
+ (define-splicing-syntax-class link-target?-kw
+   #:description "#:link-target? keyword"
+   (pattern (~seq #:link-target? expr)
+            #:with (link-target-seq ...) #'(#:link-target? expr))
+   (pattern (~seq)
+            #:with (link-target-seq ...) #'()))
+
+ (define-splicing-syntax-class id-kw
+   #:description "#:id keyword"
+   (pattern (~seq #:id [defined-id:id defined-id-expr])
+            #:with (id-seq ...) #'(#:id [defined-id:id defined-id-expr]))
+   (pattern (~seq #:id defined-id:id)
+            #:with (id-seq ...) #'(#:id defined-id))
+   (pattern (~seq #:id other)
+            #:with defined-id #'#f
+            #:with (id-seq ...) #'(#:id other))
+   (pattern (~seq)
+            #:with defined-id #'#f
+            #:with (id-seq ...) #'()))
+
+ (define-splicing-syntax-class literals-kw
+   #:description "#:literals keyword"
+   (pattern (~seq #:literals l)
+            #:with (literals-seq ...) #'(#:literals l))
+   (pattern (~seq)
+            #:with (literals-seq ...) #'()))
+
+ (define-splicing-syntax-class subs-kw
+   #:description "#:grammar keyword"
+   (pattern (~seq #:grammar g)
+            #:with (grammar-seq ...) #'(#:grammar g))
+   (pattern (~seq)
+            #:with (grammar-seq ...) #'()))
+
+ (define-splicing-syntax-class contracts-kw
+   #:description "#:contracts keyword"
+   (pattern (~seq #:contracts c)
+            #:with (contracts-seq ...) #'(#:contracts c))
+   (pattern (~seq)
+            #:with (contracts-seq ...) #'())))
+
+(define-provide/doc-transformer form-doc
+  (lambda (stx)
+    (syntax-parse stx
+      [(_ k:kind-kw lt:link-target?-kw d:id-kw l:literals-kw spec
+          subs:subs-kw c:contracts-kw desc)
+       (with-syntax ([id (if (syntax-e #'d.defined-id)
+                             #'d.defined-id
+                             (syntax-case #'spec ()
+                               [(id . rest)
+                                (identifier? #'id)
+                                #'id]
+                               [_ #'unknown]))])
+         (values
+          #'id
+          #'(defform 
+              k.kind-seq ...
+              lt.link-target-seq ...
+              d.id-seq ...
+              l.literals-seq ...
+              spec
+              subs.grammar-seq ...
+              c.contracts-seq ...
+              . desc)
+          #'((only-in scribble/manual defform))
+          #'id))])))
+
 (define-syntax (generate-delayed-documents stx)
   (syntax-case stx () 
     [(_) 

pkgs/scribble-pkgs/scribble-test/tests/scribble/docs/srcdoc.rkt

@@ -0,0 +1,12 @@
+#lang racket
+(require scribble/srcdoc
+         (for-doc racket/base
+                  scribble/manual))
+
+(provide
+ (proc-doc f (-> integer?) ["Stuff"])
+ (form-doc #:id a #:literals (foo) (expr foo a) ["Returns " (racket expr) "."]))
+
+(define (f) 5)
+
+(define-syntax-rule (a x) x)

pkgs/scribble-pkgs/scribble-test/tests/scribble/docs/srcdoc.scrbl

@@ -0,0 +1,6 @@
+#lang scribble/manual
+@(require scribble/extract)
+
+@defmodule["srcdoc.rkt" #:packages ("manual-test")]
+
+@(include-extracted "srcdoc.rkt")

pkgs/scribble-pkgs/scribble-test/tests/scribble/docs/srcdoc.txt

@@ -0,0 +1,9 @@
+ (require "srcdoc.rkt") package: manual-test
+
+(f) -> integer?
+
+Stuff
+
+(expr foo a)
+
+Returns expr.