suzanne.soy/hyper-literate
1
0
Fork 0
Code Issues 4 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

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

Browse Source 
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
collects/scribble/extract.ss
View File

@ -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 ...)

20
collects/scribble/srcdoc.ss
View File

@ -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))])))