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

scribble: fix HTML navigation when the main part has 'toc

Browse Source
This commit is contained in:
Matthew Flatt 2011-09-15 07:12:58 -06:00
parent cc9514f8ca
commit 9bd50695b5
1 changed files with 17 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
collects/scribble/html-render.rkt
View File

@ -92,9 +92,6 @@
(define current-version (make-parameter (version))) (define current-version (make-parameter (version)))
(define current-part-files (make-parameter #f)) (define current-part-files (make-parameter #f))
(define (toc-part? d)
(part-style? d 'toc))
;; HTML anchors should be case-insensitively unique. To make them ;; HTML anchors should be case-insensitively unique. To make them
;; distinct, add a "." in front of capital letters. Also clean up ;; distinct, add a "." in front of capital letters. Also clean up
;; characters that give browers trouble (i.e., the ones that are not ;; characters that give browers trouble (i.e., the ones that are not
@ -698,6 +695,11 @@
(define/private (part-parent d ri) (define/private (part-parent d ri)
(collected-info-parent (part-collected-info d ri))) (collected-info-parent (part-collected-info d ri)))
(define (toc-part? d ri)
(and (part-style? d 'toc)
;; topmost part doesn't count as toc, since it
(part-parent d ri)))
(define/private (find-siblings d ri) (define/private (find-siblings d ri)
(let ([parent (collected-info-parent (part-collected-info d ri))]) (let ([parent (collected-info-parent (part-collected-info d ri))])
(let loop ([l (cond (let loop ([l (cond
@ -729,17 +731,19 @@
(define prev (define prev
(if prev0 (if prev0
(let loop ([p prev0]) (let loop ([p prev0])
(if (and (toc-part? p) (pair? (part-parts p))) (if (and (toc-part? p ri) (pair? (part-parts p)))
(loop (last (part-parts p))) (loop (last (part-parts p)))
p)) p))
(and parent (toc-part? parent) parent))) (and parent (toc-part? parent ri) parent)))
(define next (define next
(cond [(and (toc-part? d) (pair? (part-parts d))) (car (part-parts d))] (cond [(and (toc-part? d ri) (pair? (part-parts d))) (car (part-parts d))]
[(not next0) [(not next0)
(let loop ([p parent]) (let loop ([p parent])
(and p (toc-part? p) (and p
(toc-part? p ri)
(let-values ([(prev next) (find-siblings p ri)]) (let-values ([(prev next) (find-siblings p ri)])
(or next (loop (part-parent p ri))))))] (or next
(loop (part-parent p ri))))))]
[else next0])) [else next0]))
(define index (define index
(let loop ([d d]) (let loop ([d d])
@ -779,7 +783,9 @@
(make-style (make-style
#f #f
(list (list
(make-target-url url) (make-target-url (if (equal? url "")
"#"
url))
(make-attributes (make-attributes
`([title . ,(if title* (string-append label " to " title*) label)] `([title . ,(if title* (string-append label " to " title*) label)]
[pltdoc . "x"] [pltdoc . "x"]
@ -822,7 +828,7 @@
sep-element sep-element
(make-element (make-element
(cond (cond
[(and (part? parent) (toc-part? parent) [(and (part? parent) (toc-part? parent ri)
(part-parent parent ri)) (part-parent parent ri))
(titled-url "up" parent)] (titled-url "up" parent)]
[parent (titled-url "up" "index.html" #:title-from parent)] [parent (titled-url "up" "index.html" #:title-from parent)]
@ -1472,7 +1478,7 @@
(define/override (collect-part d parent ci number) (define/override (collect-part d parent ci number)
(let ([prev-sub (collecting-sub)]) (let ([prev-sub (collecting-sub)])
(parameterize ([collecting-sub (if (toc-part? d) (parameterize ([collecting-sub (if (part-style? d 'toc)
1 1
(add1 prev-sub))] (add1 prev-sub))]
[collecting-whole-page (prev-sub . <= . 1)]) [collecting-whole-page (prev-sub . <= . 1)])