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

clean up TOC and on-this-page boxes a bit for single-page mode

Browse Source 
svn: r7925

original commit: 9ea7af5ee5d3bd6d5c0b94451dfe11e43a768e81
This commit is contained in:
Matthew Flatt 2007-12-07 21:23:34 +00:00
parent 40d4f61785
commit 2c117e2cc8
1 changed files with 61 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -120,48 +120,52 @@
d)) d))
(values d mine))))]) (values d mine))))])
`((div ((class "tocset")) `((div ((class "tocset"))
(div ((class "tocview")) ,@(let ([toc-content
(div ((class "tocviewtitle")) (map (lambda (pp)
(a ((href "index.html") (let ([p (car pp)]
(class "tocviewlink")) [show-number? (cdr pp)])
,@(render-content (or (part-title-content top) '("???")) d ri))) `(tr
(div nbsp) (td
(table ((align "right"))
((class "tocviewlist") ,@(if show-number?
(cellspacing "0")) (format-number (collected-info-number (part-collected-info p ri))
,@(map (lambda (pp) '((tt nbsp)))
(let ([p (car pp)] '("-" nbsp)))
[show-number? (cdr pp)]) (td
`(tr (a ((href ,(let ([dest (resolve-get p ri (car (part-tags p)))])
(td (format "~a~a~a"
((align "right")) (from-root (relative->path (car dest))
,@(if show-number? (get-dest-directory))
(format-number (collected-info-number (part-collected-info p ri)) (if (caddr dest)
'((tt nbsp))) ""
'("-" nbsp))) "#")
(td (if (caddr dest)
(a ((href ,(let ([dest (resolve-get p ri (car (part-tags p)))]) ""
(format "~a~a~a" (anchor-name (cadddr dest))))))
(from-root (relative->path (car dest)) (class ,(if (eq? p mine)
(get-dest-directory)) "tocviewselflink"
(if (caddr dest) "tocviewlink")))
"" ,@(render-content (or (part-title-content p) '("???")) d ri))))))
"#") (let loop ([l (map (lambda (v) (cons v #t)) (part-parts top))])
(if (caddr dest) (cond
"" [(null? l) null]
(anchor-name (cadddr dest)))))) [(reveal-subparts? (caar l))
(class ,(if (eq? p mine) (cons (car l) (loop (append (map (lambda (v) (cons v #f))
"tocviewselflink" (part-parts (caar l)))
"tocviewlink"))) (cdr l))))]
,@(render-content (or (part-title-content p) '("???")) d ri)))))) [else (cons (car l) (loop (cdr l)))])))])
(let loop ([l (map (lambda (v) (cons v #t)) (part-parts top))]) (if (null? toc-content)
(cond null
[(null? l) null] `((div ((class "tocview"))
[(reveal-subparts? (caar l)) (div ((class "tocviewtitle"))
(cons (car l) (loop (append (map (lambda (v) (cons v #f)) (a ((href "index.html")
(part-parts (caar l))) (class "tocviewlink"))
(cdr l))))] ,@(render-content (or (part-title-content top) '("???")) d ri)))
[else (cons (car l) (loop (cdr l)))]))))) (div nbsp)
(table
((class "tocviewlist")
(cellspacing "0"))
,@toc-content)))))
,@(render-onthispage-contents d ri top) ,@(render-onthispage-contents d ri top)
,@(apply append ,@(apply append
(map (lambda (t) (map (lambda (t)
@ -177,12 +181,17 @@
(loop (delayed-flow-element-flow-elements e ri)))))) (loop (delayed-flow-element-flow-elements e ri))))))
(flow-paragraphs (part-flow d))))))))) (flow-paragraphs (part-flow d)))))))))
(define/public (get-onthispage-label)
null)
(define/public (nearly-top? d ri top)
#f)
(define/private (render-onthispage-contents d ri top) (define/private (render-onthispage-contents d ri top)
(if (ormap (lambda (p) (part-whole-page? p ri)) (if (ormap (lambda (p) (part-whole-page? p ri))
(part-parts d)) (part-parts d))
null null
(let* ([nearly-top? (lambda (d) (let* ([nearly-top? (lambda (d) (nearly-top? d ri top))]
(eq? top (collected-info-parent (part-collected-info d ri))))]
[ps ((if (nearly-top? d) values cdr) [ps ((if (nearly-top? d) values cdr)
(let flatten ([d d]) (let flatten ([d d])
(apply (apply
@ -238,8 +247,7 @@
(if (null? ps) (if (null? ps)
null null
`((div ((class "tocsub")) `((div ((class "tocsub"))
(div ((class "tocsubtitle")) ,@(get-onthispage-label)
"On this page:")
(table (table
((class "tocsublist") ((class "tocsublist")
(cellspacing "0")) (cellspacing "0"))
@ -594,6 +602,13 @@
ds ds
fns)) fns))
(define/override (nearly-top? d ri top)
(eq? top (collected-info-parent (part-collected-info d ri))))
(define/override (get-onthispage-label)
`((div ((class "tocsubtitle"))
"On this page:")))
(define contents-content '("contents")) (define contents-content '("contents"))
(define index-content '("index")) (define index-content '("index"))
(define prev-content '(larr " prev")) (define prev-content '(larr " prev"))