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

Allowing full require spec stx in require/doc

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

47
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,35 +56,41 @@
(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) [(#%require spec ...)
(syntax-case c (#%require #%plain-app void quote-syntax require/doc) (let loop ([specs (syntax->list #'(spec ...))])
[(#%require spec ...) (cond
(let loop ([specs (syntax->list #'(spec ...))]) [(null? specs) '()]
(cond [else (let ([spec (car specs)])
[(null? specs) '()] (syntax-case spec (for-syntax for-meta)
[else (let ([spec (car specs)]) [(for-syntax . spec) (loop (cdr specs))]
(syntax-case spec (for-syntax for-meta) [(for-meta . spec) (loop (cdr specs))]
[(for-syntax . spec) (loop (cdr specs))] [(for-template . spec) (loop (cdr specs))]
[(for-meta . spec) (loop (cdr specs))] [(for-label . spec) (loop (cdr specs))]
[(for-template . spec) (loop (cdr specs))] [(just-meta . spec) (loop (cdr specs))]
[(for-label . spec) (loop (cdr specs))] [_ (cons #`(for-label #,spec) (loop (cdr specs)))]))]))]
[(just-meta . spec) (loop (cdr specs))] [_ null]))
[_ (cons #`(for-label #,spec) (loop (cdr specs)))]))]))] (syntax->list #'(content ...))))]
[(#%plain-app void (quote-syntax (require/doc spec ...)))
(syntax->list #'(spec ...))]
[_ null]))
(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)