fix Scribble rendering of links when tag-prefixed sub-sections appear in the same output anchor scope

svn: r14608

original commit: 22864b594d11e027b7162fa82b30e207f91d7e1f

collects/scribble/base-render.ss

@@ -109,6 +109,22 @@
       (and (pair? p)
            (mobile-root? (car p))))
 
+    ;; ----------------------------------------
+
+    (define/public (fresh-tag-collect-context? d ci)
+      #f)
+    (define/public (fresh-tag-resolve-context? d ri)
+      #f)
+    (define/public (fresh-tag-render-context? d ri)
+      #f)
+
+    (define/private (extend-prefix d fresh?)
+      (cond
+       [fresh? null]
+       [(part-tag-prefix d)
+        (cons (part-tag-prefix d) (current-tag-prefixes))]
+       [else (current-tag-prefixes)]))
+
     ;; ----------------------------------------
     ;; marshal info
 
@@ -174,6 +190,8 @@
                    (make-collected-info number
                                         parent
                                         (collect-info-ht p-ci)))
+        (parameterize ([current-tag-prefixes
+                        (extend-prefix d (fresh-tag-collect-context? d p-ci))])
           (when (part-title-content d)
             (collect-content (part-title-content d) p-ci))
           (collect-part-tags d p-ci number)
@@ -193,7 +211,7 @@
                       (if (or (unnumbered-part? s) 
                               (part-style? s 'unnumbered))
                           pos
-                        (add1 pos))))))
+                          (add1 pos)))))))
         (let ([prefix (part-tag-prefix d)])
           (for ([(k v) (collect-info-ht p-ci)])
             (when (cadr k)
@@ -284,11 +302,13 @@
       (map (lambda (d) (resolve-part d ri)) ds))
 
     (define/public (resolve-part d ri)
+      (parameterize ([current-tag-prefixes
+                      (extend-prefix d (fresh-tag-resolve-context? d ri))])
         (when (part-title-content d)
           (resolve-content (part-title-content d) d ri))
         (resolve-flow (part-flow d) d ri)
         (for ([p (part-parts d)])
-        (resolve-part p ri)))
+          (resolve-part p ri))))
 
     (define/public (resolve-content c d ri)
       (for ([i c])
@@ -373,6 +393,11 @@
       (render-part d ri))
 
     (define/public (render-part d ri)
+      (parameterize ([current-tag-prefixes
+                      (extend-prefix d (fresh-tag-render-context? d ri))])
+        (render-part-content d ri)))
+
+    (define/public (render-part-content d ri)
       (list
        (when (part-title-content d)
          (render-content (part-title-content d) d ri))

collects/scribble/html-render.ss

@@ -230,6 +230,7 @@
   (class %
     (inherit render-content
              render-block
+             render-part
              collect-part
              install-file
              get-dest-directory
@@ -295,6 +296,13 @@
     (define/public (current-part-whole-page? d)
       (eq? d (current-top-part)))
 
+    (define/override (fresh-tag-collect-context? d ci)
+      (current-part-whole-page? d))
+    (define/override (fresh-tag-resolve-context? d ri)
+      (part-whole-page? d ri))
+    (define/override (fresh-tag-render-context? d ri)
+      (part-whole-page? d ri))
+
     (define/override (collect-part-tags d ci number)
       (for ([t (part-tags d)])
         (let ([key (generate-tag t ci)])
@@ -303,7 +311,7 @@
                                      (path->relative (current-output-file)))
                                 (or (part-title-content d) '("???"))
                                 (current-part-whole-page? d)
-                                key)))))
+                                (add-current-tag-prefix key))))))
 
     (define/override (collect-target-element i ci)
       (let ([key (generate-tag (target-element-tag i) ci)])
@@ -320,7 +328,7 @@
                    (if (redirect-target-element? i)
                      (make-literal-anchor
                       (redirect-target-element-alt-anchor i))
-                     key)))))
+                     (add-current-tag-prefix key))))))
 
     (define (dest-path dest)
       (if (vector? dest) ; temporary
@@ -556,10 +564,11 @@
                                            ,(format
                                              "#~a"
                                              (anchor-name
+                                              (add-current-tag-prefix
                                                (tag-key (if (part? p)
                                                             (car (part-tags p))
                                                             (target-element-tag p))
-                                                       ri)))]
+                                                        ri))))]
                                           [class
                                            ,(cond
                                               [(part? p) "tocsubseclink"]
@@ -795,13 +804,15 @@
                       d
                       ri))))))
 
-    (define/override (render-part d ri)
+    (define/override (render-part-content d ri)
       (let ([number (collected-info-number (part-collected-info d ri))])
         `(,@(cond
               [(and (not (part-title-content d)) (null? number)) null]
               [(part-style? d 'hidden)
                (map (lambda (t)
-                      `(a ((name ,(format "~a" (anchor-name (tag-key t ri)))))))
+                      `(a ((name ,(format "~a" (anchor-name 
+                                                (add-current-tag-prefix
+                                                 (tag-key t ri))))))))
                     (part-tags d))]
               [else `((,(case (length number)
                           [(0) 'h2]
@@ -811,7 +822,8 @@
                        ,@(format-number number '((tt nbsp)))
                        ,@(map (lambda (t)
                                 `(a ([name ,(format "~a" (anchor-name
-                                                          (tag-key t ri)))])))
+                                                          (add-current-tag-prefix
+                                                           (tag-key t ri))))])))
                               (part-tags d))
                        ,@(if (part-title-content d)
                            (render-content (part-title-content d) d ri)
@@ -875,8 +887,9 @@
                  ;; (commented) hack in scribble-common.js)
                  `(noscript ,@(render-plain-element e part ri))))]
         [(target-element? e)
-         `((a ([name ,(format "~a" (anchor-name (tag-key (target-element-tag e)
+         `((a ([name ,(format "~a" (anchor-name (add-current-tag-prefix
-                                                         ri)))]))
+                                                 (tag-key (target-element-tag e)
+                                                          ri))))]))
            ,@(render-plain-element e part ri))]
         [(and (link-element? e) (not (current-no-links)))
          (parameterize ([current-no-links #t])

collects/scribble/latex-render.ss

@@ -33,6 +33,7 @@
 
     (inherit render-block
              render-content
+             render-part
              install-file
              format-number
              extract-part-style-files)
@@ -69,7 +70,7 @@
         (render-part d ri)
         (printf "\n\n\\postDoc\n\\end{document}\n")))
 
-    (define/override (render-part d ri)
+    (define/override (render-part-content d ri)
       (let ([number (collected-info-number (part-collected-info d ri))])
         (when (and (part-title-content d) (pair? number))
           (when (part-style? d 'index)

collects/scribble/struct.ss

@@ -376,7 +376,9 @@
 (define deserialize-generated-tag
   (make-deserialize-info values values))
 
-(provide generate-tag tag-key)
+(provide generate-tag tag-key
+         current-tag-prefixes
+         add-current-tag-prefix)
 
 (define (generate-tag tg ci)
   (if (generated-tag? (cadr tg))
@@ -397,6 +399,13 @@
             (hash-ref (collect-info-tags (resolve-info-ci ri)) (cadr tg)))
       tg))
 
+(define current-tag-prefixes (make-parameter null))
+(define (add-current-tag-prefix t)
+  (let ([l (current-tag-prefixes)])
+    (if (null? l)
+        t
+        (cons (car t) (append l (cdr t))))))
+
 ;; ----------------------------------------
 
 (provide content->string

collects/scribblings/scribble/struct.scrbl

@@ -189,7 +189,7 @@ added to a list value using @scheme[cons]; a prefix is not added to a
 outside the part, including the use of tags in the part's
 @scheme[tags] field. Typically, a document's main part has a tag
 prefix that applies to the whole document; references to sections and
-defined terms within the document from other documents must include,
+defined terms within the document from other documents must include the prefix,
 while references within the same document omit the prefix. Part
 prefixes can be used within a document as well, to help disambiguate
 references within the document.