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

more fixes when 'toc sections are not immediately under a 'toc section

Browse Source 
svn: r13985

original commit: 060bb38ebb99af6a4637160bda2eb01dec90d6b5
This commit is contained in:
Matthew Flatt 2009-03-06 18:41:39 +00:00
parent 49027e78cd
commit ff3a20bb98
1 changed files with 22 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -367,11 +367,20 @@
(define/public (toc-wrap table) (define/public (toc-wrap table)
null) null)
(define/private (dest->url dest)
(format "~a~a~a"
(from-root (relative->path (dest-path dest))
(get-dest-directory))
(if (dest-page? dest) "" "#")
(if (dest-page? dest)
""
(anchor-name (dest-anchor dest)))))
(define/public (render-toc-view d ri) (define/public (render-toc-view d ri)
(define has-sub-parts? (define has-sub-parts?
(pair? (part-parts d))) (pair? (part-parts d)))
(define sub-parts-on-other-page? (define sub-parts-on-other-page?
(and (pair? (part-parts d)) (and has-sub-parts?
(part-whole-page? (car (part-parts d)) ri))) (part-whole-page? (car (part-parts d)) ri)))
(define toc-chain (define toc-chain
(let loop ([d d] [r (if has-sub-parts? (list d) '())]) (let loop ([d d] [r (if has-sub-parts? (list d) '())])
@ -383,14 +392,7 @@
(define top (car toc-chain)) (define top (car toc-chain))
(define (toc-item->title+num t show-mine?) (define (toc-item->title+num t show-mine?)
(values (values
`((a ([href ,(let ([dest (resolve-get t ri (car (part-tags t)))]) `((a ([href ,(dest->url (resolve-get t ri (car (part-tags t))))]
(format "~a~a~a"
(from-root (relative->path (dest-path dest))
(get-dest-directory))
(if (dest-page? dest) "" "#")
(if (dest-page? dest)
""
(anchor-name (dest-anchor dest)))))]
[class ,(if (or (eq? t d) (and show-mine? (memq t toc-chain))) [class ,(if (or (eq? t d) (and show-mine? (memq t toc-chain)))
"tocviewselflink" "tocviewselflink"
"tocviewlink")]) "tocviewlink")])
@ -456,7 +458,8 @@
;; toc-wrap determines if we get the toc or just the title !!! ;; toc-wrap determines if we get the toc or just the title !!!
`((div ([class "tocview"]) ,@(toc-content)))) `((div ([class "tocview"]) ,@(toc-content))))
,@(render-onthispage-contents ,@(render-onthispage-contents
d ri top (if (part-style? d 'no-toc) "tocview" "tocsub")) d ri top (if (part-style? d 'no-toc) "tocview" "tocsub")
sub-parts-on-other-page?)
,@(parameterize ([extra-breaking? #t]) ,@(parameterize ([extra-breaking? #t])
(append-map (append-map
(lambda (t) (lambda (t)
@ -478,11 +481,16 @@
(define/public (nearly-top? d ri top) (define/public (nearly-top? d ri top)
#f) #f)
(define/private (render-onthispage-contents d ri top box-class) (define/private (render-onthispage-contents d ri top box-class sections-in-toc?)
(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) (nearly-top? d ri top))]) (let ([nearly-top? (lambda (d)
;; If ToC would be collapsed, then
;; no section is nearly the top
(if (not sections-in-toc?)
#f
(nearly-top? d ri top)))])
(define (flow-targets flow) (define (flow-targets flow)
(append-map block-targets (flow-paragraphs flow))) (append-map block-targets (flow-paragraphs flow)))
(define (block-targets e) (define (block-targets e)
@ -690,7 +698,7 @@
(define-values (url title) (define-values (url title)
(cond [(part? x) (cond [(part? x)
(values (values
(derive-filename x) (dest->url (resolve-get x ri (car (part-tags x))))
(string-append (string-append
"\"" "\""
(content->string (content->string
@ -912,13 +920,7 @@
(url-query u))])))] (url-query u))])))]
[else [else
;; Normal link: ;; Normal link:
(format "~a~a~a" (dest->url dest)]))
(from-root (relative->path (dest-path dest))
(get-dest-directory))
(if (dest-page? dest) "" "#")
(if (dest-page? dest)
""
(anchor-name (dest-anchor dest))))]))
,@(if (string? (element-style e)) ,@(if (string? (element-style e))
`([class ,(element-style e)]) `([class ,(element-style e)])
null)] null)]