suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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

Browse Source 
svn: r14608
This commit is contained in:
Matthew Flatt 2009-04-25 13:46:54 +00:00
parent 6ce301f3c8
commit 22864b594d
5 changed files with 100 additions and 52 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

75
collects/scribble/base-render.ss
View File

@ -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,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))

35
collects/scribble/html-render.ss
View File

@ -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])

3
collects/scribble/latex-render.ss
View File

@ -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)

37
collects/scribble/struct.ss
View File

@ -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))))))
;; ----------------------------------------

2
collects/scribblings/scribble/struct.scrbl
View File

@ -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.