repair uses of module paths for Scribble keys that I missed before

svn: r10173

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)

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)
 

collects/scribble/search.ss

@@ -2,16 +2,9 @@
   (require "struct.ss"
            "basic.ss"
            setup/main-collects
-           syntax/modcode
+           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))
 
-  (provide find-scheme-tag
+  (provide find-scheme-tag)
-           intern-taglet
-           module-path-index->taglet)
 
   (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.

collects/setup/scribble.ss

@@ -11,6 +11,7 @@
          scheme/serialize
          scribble/base-render
          scribble/struct
+         scribble/basic
          scribble/manual ; really shouldn't be here... see dynamic-require-doc
          (prefix-in html: scribble/html-render)
          (prefix-in latex: scribble/latex-render))
@@ -273,14 +274,14 @@
                          (and (path? base) (loop base)))))))
              only-dirs)))
 
-(define (ensure-doc-prefix v src-file)
+(define (ensure-doc-prefix v src-spec)
-  (let ([p (format "~a" (path->main-collects-relative src-file))])
+  (let ([p (module-path-prefix->string src-spec)])
     (when (and (part-tag-prefix v)
                (not (equal? p (part-tag-prefix v))))
       (error 'setup
              "bad tag prefix: ~e for: ~a expected: ~e"
              (part-tag-prefix v)
-             src-file
+             src-spec
              p))
     (let ([tag-prefix p]
           [tags (if (member '(part "top") (part-tags v))
@@ -406,7 +407,7 @@
            (parameterize ([current-directory (doc-src-dir doc)])
              (let* ([v (ensure-doc-prefix
                         (dynamic-require-doc (doc-src-spec doc))
-                        (doc-src-file doc))]
+                        (doc-src-spec doc))]
                     [dest-dir (pick-dest latex-dest doc)]
                     [ci (send renderer collect (list v) (list dest-dir))]
                     [ri (send renderer resolve (list v) (list dest-dir) ci)]
@@ -469,7 +470,7 @@
        (let* ([v (ensure-doc-prefix (render-time 
                                      "load"
                                      (dynamic-require-doc (doc-src-spec doc)))
-                                    (doc-src-file doc))]
+                                    (doc-src-spec doc))]
               [dest-dir (pick-dest latex-dest doc)]
               [ci (render-time "collect" 
                                (send renderer collect (list v) (list dest-dir)))])