suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Allowing full require spec stx in require/doc

Browse Source
This commit is contained in:
Jay McCarthy 2010-10-07 15:46:05 -06:00
parent 637c541190
commit c74c94d6fd
1 changed files with 27 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
collects/scribble/extract.rkt
View File

@ -5,6 +5,7 @@
scribble/srcdoc scribble/srcdoc
(for-syntax scheme/base (for-syntax scheme/base
scheme/path scheme/path
scheme/list
syntax/path-spec syntax/path-spec
(for-syntax scheme/base))) (for-syntax scheme/base)))
@ -55,13 +56,20 @@
(syntax->list #'(spec ...))] (syntax->list #'(spec ...))]
[_ null])) [_ null]))
(syntax->list #'(content ...))))] (syntax->list #'(content ...))))]
[(doc-req ...)
(map
strip-context
(append-map (lambda (c)
(syntax-case c (#%plain-app void quote-syntax require/doc)
[(#%plain-app void (quote-syntax (require/doc spec ...)))
(syntax->list #'(spec ...))]
[_ null]))
(syntax->list #'(content ...))))]
[(req ...) [(req ...)
(map (map
strip-context strip-context
(apply (append-map (lambda (c)
append (syntax-case c (#%require)
(map (lambda (c)
(syntax-case c (#%require #%plain-app void quote-syntax require/doc)
[(#%require spec ...) [(#%require spec ...)
(let loop ([specs (syntax->list #'(spec ...))]) (let loop ([specs (syntax->list #'(spec ...))])
(cond (cond
@ -74,16 +82,15 @@
[(for-label . spec) (loop (cdr specs))] [(for-label . spec) (loop (cdr specs))]
[(just-meta . spec) (loop (cdr specs))] [(just-meta . spec) (loop (cdr specs))]
[_ (cons #`(for-label #,spec) (loop (cdr specs)))]))]))] [_ (cons #`(for-label #,spec) (loop (cdr specs)))]))]))]
[(#%plain-app void (quote-syntax (require/doc spec ...)))
(syntax->list #'(spec ...))]
[_ null])) [_ null]))
(syntax->list #'(content ...)))))] (syntax->list #'(content ...))))]
[orig-tag (datum->syntax #f 'orig)]) [orig-tag (datum->syntax #f 'orig)])
;; This template is matched in `filter-info', below ;; This template is matched in `filter-info', below
#`(begin #`(begin
(#%require (for-label #,(strip-context #'lang)) (#%require (for-label #,(strip-context #'lang))
(for-label #,(strip-context orig-path)) (for-label #,(strip-context orig-path))
req ...) req ...)
(require doc-req ...)
(drop-first (quote-syntax id) (def-it orig-tag content)) ...))])))) (drop-first (quote-syntax id) (def-it orig-tag content)) ...))]))))
(define-syntax (include-extracted stx) (define-syntax (include-extracted stx)