From 353da62843a2b976e300fdd37abdd9b6d6c4894a Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Thu, 27 Dec 2012 11:10:40 -0600 Subject: [PATCH] added make-module-language-tag and use it and make-section-tag in a few places --- .../private/language-configuration.rkt | 4 +++- collects/drracket/private/unit.rkt | 9 ++++---- collects/games/show-scribbling.rkt | 21 ++++++++++--------- collects/meta/web/www/code.rkt | 6 ++++-- collects/scribble/tag.rkt | 4 ++++ collects/scribblings/scribble/tag.scrbl | 5 +++++ 6 files changed, 31 insertions(+), 18 deletions(-) diff --git a/collects/drracket/private/language-configuration.rkt b/collects/drracket/private/language-configuration.rkt index 6c4b5b3947..b5f3ab4cbb 100644 --- a/collects/drracket/private/language-configuration.rkt +++ b/collects/drracket/private/language-configuration.rkt @@ -14,6 +14,7 @@ setup/getinfo setup/xref scribble/xref + scribble/tag net/url syntax/toplevel browser/external @@ -1342,7 +1343,8 @@ [else (void)]))) (send t set-clickback before-docs after-docs (λ (t start end) - (define-values (path tag) (xref-tag->path+anchor (load-collections-xref) `(mod-path ,(symbol->string lang)))) + (define-values (path tag) (xref-tag->path+anchor (load-collections-xref) + (make-module-language-tag lang))) (define url (path->url path)) (define url2 (if tag (make-url (url-scheme url) diff --git a/collects/drracket/private/unit.rkt b/collects/drracket/private/unit.rkt index 1249e4d361..40692451f0 100644 --- a/collects/drracket/private/unit.rkt +++ b/collects/drracket/private/unit.rkt @@ -50,6 +50,7 @@ module browser threading seems wrong. scribble/xref setup/xref + scribble/tag (only-in scribble/base doc-prefix)) (provide unit@) @@ -1532,11 +1533,9 @@ module browser threading seems wrong. [callback (λ (x y) (define-values (path tag) (xref-tag->path+anchor (load-collections-xref) - `(part - ,(doc-prefix - '(lib "scribblings/drracket/drracket.scrbl") - #f - "follow-log")))) + (make-section-tag + "follow-log" + #:doc '(lib "scribblings/drracket/drracket.scrbl")))) (define url (path->url path)) (define url2 (if tag (make-url (url-scheme url) diff --git a/collects/games/show-scribbling.rkt b/collects/games/show-scribbling.rkt index 5ad4fbe5ea..815b3e53d2 100644 --- a/collects/games/show-scribbling.rkt +++ b/collects/games/show-scribbling.rkt @@ -3,6 +3,7 @@ (require setup/xref scribble/xref scribble/basic + scribble/tag scheme/promise net/url net/sendurl) @@ -10,13 +11,13 @@ (provide show-scribbling) (define (show-scribbling mod-path tag) - (let ([xref (delay (load-collections-xref))]) - (lambda () - (let-values ([(path anchor) - (xref-tag->path+anchor - (force xref) - (list 'part (list (module-path-prefix->string mod-path) tag)))]) - (if path - (let ([u (path->url path)]) - (send-url (url->string u))) - (error 'show-scribbling "cannot find docs for: ~.s ~.s" mod-path tag)))))) + (define xref (load-collections-xref)) + (λ () + (define-values (path anchor) + (xref-tag->path+anchor + xref + (make-section-tag tag #:doc mod-path))) + (if path + (let ([u (path->url path)]) + (send-url (url->string u))) + (error 'show-scribbling "cannot find docs for: ~.s ~.s" mod-path tag)))) diff --git a/collects/meta/web/www/code.rkt b/collects/meta/web/www/code.rkt index f23628ebc6..d6af294a2a 100644 --- a/collects/meta/web/www/code.rkt +++ b/collects/meta/web/www/code.rkt @@ -1,6 +1,7 @@ #lang meta/web -(require syntax-color/module-lexer setup/xref scribble/xref) +(require syntax-color/module-lexer setup/xref + scribble/xref scribble/tag) (provide code) @@ -53,7 +54,8 @@ (if (or always-orig? (syntax-original? mp-stx)) (let ([mp (syntax->datum mp-stx)]) (define-values [p a] - (xref-tag->path+anchor xref `(mod-path ,(format "~s" mp)) + (xref-tag->path+anchor xref + (make-module-language-tag mp) #:external-root-url doc-root)) (if p (list (let ([pos (sub1 (syntax-position mp-stx))]) diff --git a/collects/scribble/tag.rkt b/collects/scribble/tag.rkt index 3525d936a8..bfddb88f84 100644 --- a/collects/scribble/tag.rkt +++ b/collects/scribble/tag.rkt @@ -14,6 +14,7 @@ #:tag-prefixes (or/c #f (listof string?))) . ->* . tag?)] + [make-module-language-tag (-> symbol? tag?)] [taglet? (any/c . -> . boolean?)] [module-path-prefix->string (module-path? . -> . string?)] [module-path-index->taglet (module-path-index? . -> . taglet?)] @@ -25,6 +26,9 @@ (define (make-section-tag s #:doc [doc #f] #:tag-prefixes [prefix #f]) `(part ,(doc-prefix doc prefix s))) +(define (make-module-language-tag langname) + `(mod-path ,(symbol->string langname))) + (define (taglet? v) (and (not (generated-tag? v)) (tag? (list 'something v)))) diff --git a/collects/scribblings/scribble/tag.scrbl b/collects/scribblings/scribble/tag.scrbl index c0d200a1dc..1153c52fd6 100644 --- a/collects/scribblings/scribble/tag.scrbl +++ b/collects/scribblings/scribble/tag.scrbl @@ -26,6 +26,11 @@ references a section in the document implemented by prefixes (for intermediate sections, typically) can be provided as @racket[tag-prefixes].} +@defproc[(make-module-language-tag [lang symbol?]) tag?]{ + Forms a @tech{tag} that refers to a section + that contains @racket[defmodulelang] for the language + @racket[lang]. +} @defproc[(taglet? [v any/c]) boolean?]{