commit 4b9fcbcb7e7acc7b57d26b744588b065d28b793d
parent 313176569f59d94b3ae9c6c48dc1ef2fb9082b1c
Author: Jay McCarthy <jay@racket-lang.org>
Date: Thu, 7 Oct 2010 15:46:05 -0600
Allowing full require spec stx in require/doc
original commit: c74c94d6fdef8abaaa901819cbaba9d14b1beffa
Diffstat:
1 file changed, 27 insertions(+), 20 deletions(-)
diff --git a/collects/scribble/extract.rkt b/collects/scribble/extract.rkt
@@ -5,6 +5,7 @@
scribble/srcdoc
(for-syntax scheme/base
scheme/path
+ scheme/list
syntax/path-spec
(for-syntax scheme/base)))
@@ -55,35 +56,41 @@
(syntax->list #'(spec ...))]
[_ null]))
(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 ...)
(map
strip-context
- (apply
- append
- (map (lambda (c)
- (syntax-case c (#%require #%plain-app void quote-syntax require/doc)
- [(#%require spec ...)
- (let loop ([specs (syntax->list #'(spec ...))])
- (cond
- [(null? specs) '()]
- [else (let ([spec (car specs)])
- (syntax-case spec (for-syntax for-meta)
- [(for-syntax . spec) (loop (cdr specs))]
- [(for-meta . spec) (loop (cdr specs))]
- [(for-template . spec) (loop (cdr specs))]
- [(for-label . spec) (loop (cdr specs))]
- [(just-meta . spec) (loop (cdr specs))]
- [_ (cons #`(for-label #,spec) (loop (cdr specs)))]))]))]
- [(#%plain-app void (quote-syntax (require/doc spec ...)))
- (syntax->list #'(spec ...))]
- [_ null]))
- (syntax->list #'(content ...)))))]
+ (append-map (lambda (c)
+ (syntax-case c (#%require)
+ [(#%require spec ...)
+ (let loop ([specs (syntax->list #'(spec ...))])
+ (cond
+ [(null? specs) '()]
+ [else (let ([spec (car specs)])
+ (syntax-case spec (for-syntax for-meta)
+ [(for-syntax . spec) (loop (cdr specs))]
+ [(for-meta . spec) (loop (cdr specs))]
+ [(for-template . spec) (loop (cdr specs))]
+ [(for-label . spec) (loop (cdr specs))]
+ [(just-meta . spec) (loop (cdr specs))]
+ [_ (cons #`(for-label #,spec) (loop (cdr specs)))]))]))]
+ [_ null]))
+ (syntax->list #'(content ...))))]
[orig-tag (datum->syntax #f 'orig)])
;; This template is matched in `filter-info', below
#`(begin
(#%require (for-label #,(strip-context #'lang))
(for-label #,(strip-context orig-path))
req ...)
+ (require doc-req ...)
(drop-first (quote-syntax id) (def-it orig-tag content)) ...))]))))
(define-syntax (include-extracted stx)