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

svn: r9545

original commit: 3eb20f5a11269e7f1948c67c655efedab0766dd7
This commit is contained in:
Robby Findler 2008-04-30 19:18:52 +00:00
parent 325918ec5b
commit e06d072534
2 changed files with 25 additions and 11 deletions

View File

@ -20,8 +20,12 @@
(define-syntax (include-extracted stx) (define-syntax (include-extracted stx)
(syntax-case stx () (syntax-case stx ()
[(_ orig-path) [(_ orig-path) #'(include-extracted orig-path #rx"")] ;; this regexp matches everything
(let ([path (resolve-path-spec #'orig-path #'orig-path stx)]) [(_ 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 (let ([s-exp
(parameterize ([current-namespace (make-base-namespace)] (parameterize ([current-namespace (make-base-namespace)]
[read-accept-reader #t]) [read-accept-reader #t])
@ -40,7 +44,13 @@
(map (lambda (c) (map (lambda (c)
(syntax-case c (#%plain-app void quote-syntax provide/doc) (syntax-case c (#%plain-app void quote-syntax provide/doc)
[(#%plain-app void (quote-syntax (provide/doc spec ...))) [(#%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])) [_ null]))
(syntax->list #'(content ...))))] (syntax->list #'(content ...))))]
[(req ...) [(req ...)

View File

@ -17,7 +17,7 @@
(syntax-case stx () (syntax-case stx ()
[(_ form ...) [(_ form ...)
(let ([forms (syntax->list #'(form ...))]) (let ([forms (syntax->list #'(form ...))])
(with-syntax ([((for-provide/contract for-docs) ...) (with-syntax ([((for-provide/contract for-docs id) ...)
(map (lambda (form) (map (lambda (form)
(syntax-case form () (syntax-case form ()
[(id . _) [(id . _)
@ -31,9 +31,10 @@
#'id)) #'id))
(let* ([i (make-syntax-introducer)] (let* ([i (make-syntax-introducer)]
[i2 (lambda (x) (syntax-local-introduce (i x)))]) [i2 (lambda (x) (syntax-local-introduce (i x)))])
(let-values ([(p/c d req/d) ((provide/doc-transformer-proc t) (let-values ([(p/c d req/d id)
(i (syntax-local-introduce form)))]) ((provide/doc-transformer-proc t)
(list (i2 p/c) (list (i2 req/d) (i2 d) (i2 (quote-syntax tag)))))))] (i (syntax-local-introduce form)))])
(list (i2 p/c) (list (i2 req/d) (i2 d) (i2 (quote-syntax tag))) (i2 id)))))]
[_ [_
(raise-syntax-error (raise-syntax-error
#f #f
@ -49,7 +50,7 @@
(syntax->list #'(for-provide/contract ...)))]) (syntax->list #'(for-provide/contract ...)))])
#'(begin #'(begin
p/c ... p/c ...
(void (quote-syntax (provide/doc for-docs ...)))))))])) (void (quote-syntax (provide/doc (for-docs id) ...)))))))]))
(define-provide/doc-transformer proc-doc (define-provide/doc-transformer proc-doc
(lambda (stx) (lambda (stx)
@ -94,7 +95,8 @@
(values (values
#'[id contract] #'[id contract]
#'(defproc header result . desc) #'(defproc header result . desc)
#'(scribble/manual)))]))) #'(scribble/manual)
#'id))])))
(define-provide/doc-transformer proc-doc/names (define-provide/doc-transformer proc-doc/names
(lambda (stx) (lambda (stx)
@ -146,7 +148,8 @@
(values (values
#'[id contract] #'[id contract]
#'(defproc* header . desc) #'(defproc* header . desc)
#'(scribble/manual)))]))) #'(scribble/manual)
#'id))])))
(define-provide/doc-transformer parameter-doc (define-provide/doc-transformer parameter-doc
(lambda (stx) (lambda (stx)
@ -166,4 +169,5 @@
(values (values
#'[id (parameter/c contract)] #'[id (parameter/c contract)]
#'(defparam id arg-id contract . desc) #'(defparam id arg-id contract . desc)
#'(scribble/manual)))]))) #'(scribble/manual)
#'id))])))