commit 5c1f7ccbbc3d0cfea44f8e8bf7a0806404a1363d
parent 38ad7672e413b646b400485819ee25caff4fdda6
Author: Matthew Flatt <mflatt@racket-lang.org>
Date: Fri, 6 Jun 2008 15:09:14 +0000
repair uses of module paths for Scribble keys that I missed before
svn: r10173
original commit: af1c17353bcce74385984205d39c00507b8a4443
Diffstat:
3 files changed, 59 insertions(+), 58 deletions(-)
diff --git a/collects/scribble/basic.ss b/collects/scribble/basic.ss
@@ -79,13 +79,66 @@
;; ----------------------------------------
-(provide module-path-prefix->string)
+(provide intern-taglet
+ module-path-index->taglet
+ module-path-prefix->string)
+
+(define interned (make-weak-hash))
+
+(define (intern-taglet v)
+ (let ([v (if (list? v)
+ (map intern-taglet v)
+ v)])
+ (if (or (string? v)
+ (bytes? v)
+ (list? v))
+ (let ([b (hash-ref interned v #f)])
+ (if b
+ (weak-box-value b)
+ (begin
+ (hash-set! interned v (make-weak-box v))
+ v)))
+ v)))
+
+(define (module-path-index->taglet mod)
+ ;; Derive the name from the module path:
+ (let ([p (collapse-module-path-index
+ mod
+ (current-directory))])
+ (if (path? p)
+ ;; If we got a path back anyway, then it's best to use the resolved
+ ;; name; if the current directory has changed since we
+ ;; the path-index was resolved, then p might not be right
+ (intern-taglet
+ (path->main-collects-relative
+ (resolved-module-path-name (module-path-index-resolve mod))))
+ (let ([p (if (and (pair? p)
+ (eq? (car p) 'planet))
+ ;; Normalize planet verion number based on current
+ ;; linking:
+ (let-values ([(path pkg)
+ (get-planet-module-path/pkg p #f #f)])
+ (list* 'planet
+ (cadr p)
+ (list (car (caddr p))
+ (cadr (caddr p))
+ (pkg-maj pkg)
+ (pkg-min pkg))
+ (cdddr p)))
+ ;; Otherwise the path is fully normalized:
+ p)])
+ (intern-taglet p)))))
(define (module-path-prefix->string p)
- (format "~a" (path->main-collects-relative (resolve-module-path p #f))))
+ (format "~a" (module-path-index->taglet (module-path-index-join p #f))))
;; ----------------------------------------
+(require syntax/modcollapse
+ ;; Needed to normalize planet version numbers:
+ (only-in planet/resolver get-planet-module-path/pkg)
+ (only-in planet/private/data pkg-maj pkg-min))
+
(provide itemize item item?)
(define (itemize #:style [style #f] . items)
diff --git a/collects/scribble/html-render.ss b/collects/scribble/html-render.ss
@@ -15,7 +15,8 @@
scheme/serialize
(prefix-in xml: xml/xml)
(for-syntax scheme/base)
- "search.ss")
+ "search.ss"
+ "basic.ss")
(provide render-mixin
render-multi-mixin)
diff --git a/collects/scribble/search.ss b/collects/scribble/search.ss
@@ -2,16 +2,9 @@
(require "struct.ss"
"basic.ss"
setup/main-collects
- syntax/modcode
- syntax/modcollapse
-
- ;; Needed to normalize planet version numbers:
- (only-in planet/resolver get-planet-module-path/pkg)
- (only-in planet/private/data pkg-maj pkg-min))
+ syntax/modcode)
- (provide find-scheme-tag
- intern-taglet
- module-path-index->taglet)
+ (provide find-scheme-tag)
(define module-info-cache (make-hasheq))
@@ -24,52 +17,6 @@
(module-path-index-join name
(module-path-index-rejoin base rel-to))])))
- (define interned (make-weak-hash))
-
- (define (intern-taglet v)
- (let ([v (if (list? v)
- (map intern-taglet v)
- v)])
- (if (or (string? v)
- (bytes? v)
- (list? v))
- (let ([b (hash-ref interned v #f)])
- (if b
- (weak-box-value b)
- (begin
- (hash-set! interned v (make-weak-box v))
- v)))
- v)))
-
- (define (module-path-index->taglet mod)
- ;; Derive the name from the module path:
- (let ([p (collapse-module-path-index
- mod
- (current-directory))])
- (if (path? p)
- ;; If we got a path back anyway, then it's best to use the resolved
- ;; name; if the current directory has changed since we
- ;; the path-index was resolved, then p might not be right
- (intern-taglet
- (path->main-collects-relative
- (resolved-module-path-name (module-path-index-resolve mod))))
- (let ([p (if (and (pair? p)
- (eq? (car p) 'planet))
- ;; Normalize planet verion number based on current
- ;; linking:
- (let-values ([(path pkg)
- (get-planet-module-path/pkg p #f #f)])
- (list* 'planet
- (cadr p)
- (list (car (caddr p))
- (cadr (caddr p))
- (pkg-maj pkg)
- (pkg-min pkg))
- (cdddr p)))
- ;; Otherwise the path is fully normalized:
- p)])
- (intern-taglet p)))))
-
(define (find-scheme-tag part ri stx/binding phase-level)
;; The phase-level argument is used only when `stx/binding'
;; is an identifier.
