suzanne.soy/hyper-literate
1
0
Fork 0
Code Issues 4 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

enable extra line breaking for ToC display

Browse Source 
svn: r9879

original commit: 2662eff0b0d4aa0affb94fb72cc78e6abd4f57bd
This commit is contained in:
Matthew Flatt 2008-05-18 16:12:25 +00:00
parent ab7c7e7f92
commit 04e6d902c8
1 changed files with 31 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -326,36 +326,37 @@
(loop p (if (reveal-subparts? d) mine d)) (loop p (if (reveal-subparts? d) mine d))
(values d mine))))) (values d mine)))))
(define toc-content (define toc-content
(map (lambda (pp) (parameterize ([extra-breaking? #t])
(let ([p (car pp)] (map (lambda (pp)
[show-number? (cdr pp)]) (let ([p (car pp)]
`(tr [show-number? (cdr pp)])
(td ([align "right"]) `(tr
,@(if show-number? (td ([align "right"])
(format-number (collected-info-number (part-collected-info p ri)) ,@(if show-number?
'((tt nbsp))) (format-number (collected-info-number (part-collected-info p ri))
'("-" nbsp))) '((tt nbsp)))
(td '("-" nbsp)))
(a ([href ,(let ([dest (resolve-get p ri (car (part-tags p)))]) (td
(format "~a~a~a" (a ([href ,(let ([dest (resolve-get p ri (car (part-tags p)))])
(from-root (relative->path (dest-path dest)) (format "~a~a~a"
(get-dest-directory)) (from-root (relative->path (dest-path dest))
(if (dest-page? dest) "" "#") (get-dest-directory))
(if (dest-page? dest) (if (dest-page? dest) "" "#")
"" (if (dest-page? dest)
(anchor-name (dest-anchor dest)))))] ""
[class ,(if (eq? p mine) (anchor-name (dest-anchor dest)))))]
"tocviewselflink" [class ,(if (eq? p mine)
"tocviewlink")]) "tocviewselflink"
,@(render-content (or (part-title-content p) '("???")) "tocviewlink")])
d ri)))))) ,@(render-content (or (part-title-content p) '("???"))
(let loop ([l (map (lambda (v) (cons v #t)) (part-parts top))]) d ri))))))
(cond [(null? l) null] (let loop ([l (map (lambda (v) (cons v #t)) (part-parts top))])
[(reveal-subparts? (caar l)) (cond [(null? l) null]
(cons (car l) (loop (append (map (lambda (v) (cons v #f)) [(reveal-subparts? (caar l))
(part-parts (caar l))) (cons (car l) (loop (append (map (lambda (v) (cons v #f))
(cdr l))))] (part-parts (caar l)))
[else (cons (car l) (loop (cdr l)))])))) (cdr l))))]
[else (cons (car l) (loop (cdr l)))])))))
`((div ([class "tocset"]) `((div ([class "tocset"])
,@(let* ([content (render-content ,@(let* ([content (render-content
(or (part-title-content top) '("???")) (or (part-title-content top) '("???"))