bkyk8rc3zvpnsf5inmcqq4n3k98cv6hj-my-site-hyper-literate-git.test.suzanne.soy-0.0.1

commit e06d072534735a43f903f12dd3a3334fedb03cc3
parent 325918ec5b57caaa827288b17bcddfb156426ae8
Author: Robby Findler <robby@racket-lang.org>
Date:   Wed, 30 Apr 2008 19:18:52 +0000

moved all of the framework's function documentation into the scribble/srcdoc world

svn: r9545

original commit: 3eb20f5a11269e7f1948c67c655efedab0766dd7

Diffstat:
M
collects/scribble/extract.ss
 | 
16
+++++++++++++---
M
collects/scribble/srcdoc.ss
 | 
20
++++++++++++--------

2 files changed, 25 insertions(+), 11 deletions(-)
diff --git a/collects/scribble/extract.ss b/collects/scribble/extract.ss
@@ -20,8 +20,12 @@
 
 (define-syntax (include-extracted stx)
   (syntax-case stx ()
-    [(_ orig-path)
-     (let ([path (resolve-path-spec #'orig-path #'orig-path stx)])
+    [(_ orig-path) #'(include-extracted orig-path #rx"")] ;; this regexp matches everything
+    [(_ orig-path regexp-s)
+     (let ([path (resolve-path-spec #'orig-path #'orig-path stx)]
+           [reg (syntax-e #'regexp-s)])
+       (unless (regexp? reg)
+         (raise-syntax-error #f "expected a literal regular expression as the second argument" stx #'regexp-s))
        (let ([s-exp 
               (parameterize ([current-namespace (make-base-namespace)]
                              [read-accept-reader #t])
@@ -40,7 +44,13 @@
                             (map (lambda (c)
                                    (syntax-case c (#%plain-app void quote-syntax provide/doc)
                                      [(#%plain-app void (quote-syntax (provide/doc spec ...)))
-                                      (syntax->list #'(spec ...))]
+                                      (map
+                                       (λ (x) (syntax-case x () [(docs id) #'docs])) 
+                                       (filter (λ (x)
+                                                 (syntax-case x ()
+                                                   [(stuff id)
+                                                    (regexp-match reg (symbol->string (syntax-e #'id)))]))
+                                               (syntax->list #'(spec ...))))]
                                      [_ null]))
                                  (syntax->list #'(content ...))))]
                           [(req ...)
diff --git a/collects/scribble/srcdoc.ss b/collects/scribble/srcdoc.ss
@@ -17,7 +17,7 @@
   (syntax-case stx ()
     [(_ form ...)
      (let ([forms (syntax->list #'(form ...))])
-       (with-syntax ([((for-provide/contract for-docs) ...)
+       (with-syntax ([((for-provide/contract for-docs id) ...)
                       (map (lambda (form)
                              (syntax-case form ()
                                [(id . _)
@@ -31,9 +31,10 @@
                                      #'id))
                                   (let* ([i (make-syntax-introducer)]
                                          [i2 (lambda (x) (syntax-local-introduce (i x)))])
-                                    (let-values ([(p/c d req/d) ((provide/doc-transformer-proc t)
-                                                                 (i (syntax-local-introduce form)))])
-                                      (list (i2 p/c) (list (i2 req/d) (i2 d) (i2 (quote-syntax tag)))))))]
+                                    (let-values ([(p/c d req/d id)
+                                                  ((provide/doc-transformer-proc t)
+                                                   (i (syntax-local-introduce form)))])
+                                      (list (i2 p/c) (list (i2 req/d) (i2 d) (i2 (quote-syntax tag))) (i2 id)))))]
                                [_
                                 (raise-syntax-error
                                  #f
@@ -49,7 +50,7 @@
                              (syntax->list #'(for-provide/contract ...)))])
            #'(begin
                p/c ...
-               (void (quote-syntax (provide/doc for-docs ...)))))))]))
+               (void (quote-syntax (provide/doc (for-docs id) ...)))))))]))
 
 (define-provide/doc-transformer proc-doc
   (lambda (stx)
@@ -94,7 +95,8 @@
          (values
           #'[id contract]
           #'(defproc header result . desc)
-          #'(scribble/manual)))])))
+          #'(scribble/manual)
+          #'id))])))
 
 (define-provide/doc-transformer proc-doc/names
   (lambda (stx)
@@ -146,7 +148,8 @@
          (values
           #'[id contract]
           #'(defproc* header . desc)
-          #'(scribble/manual)))])))
+          #'(scribble/manual)
+          #'id))])))
 
 (define-provide/doc-transformer parameter-doc
   (lambda (stx)
@@ -166,4 +169,5 @@
          (values
           #'[id (parameter/c contract)]
           #'(defparam id arg-id contract . desc)
-          #'(scribble/manual)))])))
+          #'(scribble/manual)
+          #'id))])))