From a847663f2d41c29da2ce4cf74479b5a93356c46c Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Mon, 13 Jun 2011 08:56:06 -0700 Subject: [PATCH] adjust `racketmodname' to ignore for-label imports so that `@racketmodname[lazy], for example, typesets correctly when `lazy' is imported for-label original commit: c8999c25413352de46cd1f8006a768ff74938163 --- collects/scribble/private/manual-scheme.rkt | 30 ++++++++++++++++++++- 1 file changed, 29 insertions(+), 1 deletion(-) diff --git a/collects/scribble/private/manual-scheme.rkt b/collects/scribble/private/manual-scheme.rkt index e2d7f600..9e9529c4 100644 --- a/collects/scribble/private/manual-scheme.rkt +++ b/collects/scribble/private/manual-scheme.rkt @@ -156,13 +156,41 @@ (define-code racketid to-element/id unsyntax keep-s-expr add-sq-prop) (define-code *racketmodname to-element unsyntax keep-s-expr add-sq-prop) +(define-syntax (**racketmodname stx) + (syntax-case stx () + [(_ form) + (let ([stx #'form]) + #`(*racketmodname + ;; We want to remove lexical context from identifiers + ;; that correspond to module names, but keep context + ;; for `lib' or `planet' (which are rarely used) + #,(if (identifier? stx) + (datum->syntax #f (syntax-e stx) stx stx) + (if (and (pair? (syntax-e stx)) + (memq (syntax-e (car (syntax-e stx))) '(lib planet file))) + (let ([s (car (syntax-e stx))] + [rest (let loop ([a (cdr (syntax-e stx))] [head? #f]) + (cond + [(identifier? a) (datum->syntax #f (syntax-e a) a a)] + [(and head? (pair? a) (free-identifier=? #'unsyntax (car a))) + a] + [(pair? a) (cons (loop (car a) #t) + (loop (cdr a) #f))] + [(syntax? a) (datum->syntax a + (loop (syntax-e a) head?) + a + a)] + [else a]))]) + (datum->syntax stx (cons s rest) stx stx)) + stx))))])) + (define-syntax racketmodname (syntax-rules (unsyntax) [(racketmodname #,n) (let ([sym n]) (as-modname-link sym (to-element sym)))] [(racketmodname n) - (as-modname-link 'n (*racketmodname n))])) + (as-modname-link 'n (**racketmodname n))])) (define-syntax racketmodlink (syntax-rules (unsyntax)