commit 4b6b80d7fcfb6a48e5414a306a22980ffd69d16e
parent b0a3be38f4c038bcc52d975b12340f22059de107
Author: Matthew Flatt <mflatt@racket-lang.org>
Date: Sat, 25 Apr 2009 13:46:54 +0000
fix Scribble rendering of links when tag-prefixed sub-sections appear in the same output anchor scope
svn: r14608
original commit: 22864b594d11e027b7162fa82b30e207f91d7e1f
Diffstat:
5 files changed, 100 insertions(+), 52 deletions(-)
diff --git a/collects/scribble/base-render.ss b/collects/scribble/base-render.ss
@@ -110,6 +110,22 @@
(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
(define/public (get-serialize-version)
@@ -174,26 +190,28 @@
(make-collected-info number
parent
(collect-info-ht p-ci)))
- (when (part-title-content d)
- (collect-content (part-title-content d) p-ci))
- (collect-part-tags d p-ci number)
- (collect-content (part-to-collect d) p-ci)
- (collect-flow (part-flow d) p-ci)
- (let loop ([parts (part-parts d)]
- [pos 1])
- (unless (null? parts)
- (let ([s (car parts)])
- (collect-part s d p-ci
- (cons (if (or (unnumbered-part? s)
- (part-style? s 'unnumbered))
- #f
- pos)
- number))
- (loop (cdr parts)
- (if (or (unnumbered-part? s)
- (part-style? s 'unnumbered))
- pos
- (add1 pos))))))
+ (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)
+ (collect-content (part-to-collect d) p-ci)
+ (collect-flow (part-flow d) p-ci)
+ (let loop ([parts (part-parts d)]
+ [pos 1])
+ (unless (null? parts)
+ (let ([s (car parts)])
+ (collect-part s d p-ci
+ (cons (if (or (unnumbered-part? s)
+ (part-style? s 'unnumbered))
+ #f
+ pos)
+ number))
+ (loop (cdr parts)
+ (if (or (unnumbered-part? s)
+ (part-style? s 'unnumbered))
+ 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)
- (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)))
+ (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))))
(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))
diff --git a/collects/scribble/html-render.ss b/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
- (tag-key (if (part? p)
- (car (part-tags p))
- (target-element-tag p))
- ri)))]
+ (add-current-tag-prefix
+ (tag-key (if (part? p)
+ (car (part-tags p))
+ (target-element-tag p))
+ 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)
- ri)))]))
+ `((a ([name ,(format "~a" (anchor-name (add-current-tag-prefix
+ (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])
diff --git a/collects/scribble/latex-render.ss b/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)
diff --git a/collects/scribble/struct.ss b/collects/scribble/struct.ss
@@ -376,26 +376,35 @@
(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))
- (let ([t (cadr tg)])
- (list (car tg)
- (let ([tags (collect-info-tags ci)])
- (or (hash-ref tags t #f)
- (let ([key (list* 'gentag
- (hash-count tags)
- (collect-info-gen-prefix ci))])
- (hash-set! tags t key)
- key)))))
- tg))
+ (let ([t (cadr tg)])
+ (list (car tg)
+ (let ([tags (collect-info-tags ci)])
+ (or (hash-ref tags t #f)
+ (let ([key (list* 'gentag
+ (hash-count tags)
+ (collect-info-gen-prefix ci))])
+ (hash-set! tags t key)
+ key)))))
+ tg))
(define (tag-key tg ri)
(if (generated-tag? (cadr tg))
- (list (car tg)
- (hash-ref (collect-info-tags (resolve-info-ci ri)) (cadr tg)))
- tg))
+ (list (car tg)
+ (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))))))
;; ----------------------------------------
diff --git a/collects/scribblings/scribble/struct.scrbl b/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.
