scribble HTML output: add page-specific table-of-contents; also add call-with-values and values to reference
svn: r7025 original commit: 36c962cae107a3c83e649bb16b471825ab92078f
This commit is contained in:
Matthew Flatt
parent
f0fd3e6b6b
commit
c0f03edcee
|
|
@ -273,24 +273,32 @@
|
|||
|
||||
;; ----------------------------------------
|
||||
|
||||
(define/public (table-of-contents part ht)
|
||||
(define/private (do-table-of-contents part ht delta quiet)
|
||||
(make-table #f (render-toc part
|
||||
(sub1 (length (collected-info-number
|
||||
(part-collected-info part))))
|
||||
#t)))
|
||||
(+ delta
|
||||
(length (collected-info-number
|
||||
(part-collected-info part))))
|
||||
#t
|
||||
quiet)))
|
||||
|
||||
(define/public (table-of-contents part ht)
|
||||
(do-table-of-contents part ht -1 not))
|
||||
|
||||
(define/public (local-table-of-contents part ht)
|
||||
(table-of-contents part ht))
|
||||
|
||||
(define/private (render-toc part base-len skip?)
|
||||
(define/public (quiet-table-of-contents part ht)
|
||||
(do-table-of-contents part ht 1 (lambda (x) #t)))
|
||||
|
||||
(define/private (render-toc part base-len skip? quiet)
|
||||
(let ([number (collected-info-number (part-collected-info part))])
|
||||
(let ([subs
|
||||
(if (not (and (styled-part? part)
|
||||
(eq? 'quiet (styled-part-style part))
|
||||
(not (= base-len (sub1 (length number))))))
|
||||
(if (quiet (and (styled-part? part)
|
||||
(eq? 'quiet (styled-part-style part))
|
||||
(not (= base-len (sub1 (length number))))))
|
||||
(apply
|
||||
append
|
||||
(map (lambda (p) (render-toc p base-len #f)) (part-parts part)))
|
||||
(map (lambda (p) (render-toc p base-len #f quiet)) (part-parts part)))
|
||||
null)])
|
||||
(if skip?
|
||||
subs
|
||||
|
|
|
|||
|
|
@ -32,7 +32,8 @@
|
|||
get-dest-directory
|
||||
format-number
|
||||
strip-aux
|
||||
lookup)
|
||||
lookup
|
||||
quiet-table-of-contents)
|
||||
|
||||
(define/override (get-suffix) #".html")
|
||||
|
||||
|
|
@ -47,7 +48,11 @@
|
|||
fns)
|
||||
ht))
|
||||
|
||||
(define/public (part-whole-page? d)
|
||||
(define/public (part-whole-page? p ht)
|
||||
(let ([dest (lookup p ht `(part ,(part-tag p)))])
|
||||
(caddr dest)))
|
||||
|
||||
(define/public (current-part-whole-page?)
|
||||
#f)
|
||||
|
||||
(define/override (collect-part-tag d ht number)
|
||||
|
|
@ -55,7 +60,7 @@
|
|||
`(part ,(part-tag d))
|
||||
(list (current-output-file)
|
||||
(part-title-content d)
|
||||
(part-whole-page? d))))
|
||||
(current-part-whole-page?))))
|
||||
|
||||
(define/override (collect-target-element i ht)
|
||||
(hash-table-put! ht
|
||||
|
|
@ -71,37 +76,117 @@
|
|||
(if p
|
||||
(loop p d)
|
||||
(values d mine))))])
|
||||
`((div ((class "tocview"))
|
||||
(div ((class "tocviewtitle"))
|
||||
(a ((href "index.html")
|
||||
(class "tocviewlink"))
|
||||
,@(render-content (part-title-content top) d ht)))
|
||||
(div nbsp)
|
||||
(table
|
||||
((class "tocviewlist")
|
||||
(cellspacing "0"))
|
||||
,@(map (lambda (p)
|
||||
`(tr
|
||||
(td
|
||||
((align "right"))
|
||||
,@(format-number (collected-info-number (part-collected-info p))
|
||||
'((tt nbsp))))
|
||||
(td
|
||||
(a ((href ,(let ([dest (lookup p ht `(part ,(part-tag p)))])
|
||||
(format "~a~a~a"
|
||||
(from-root (car dest)
|
||||
(get-dest-directory))
|
||||
(if (caddr dest)
|
||||
""
|
||||
"#")
|
||||
(if (caddr dest)
|
||||
""
|
||||
`(part ,(part-tag p))))))
|
||||
(class ,(if (eq? p mine)
|
||||
"tocviewselflink"
|
||||
"tocviewlink")))
|
||||
,@(render-content (part-title-content p) d ht)))))
|
||||
(part-parts top)))))))
|
||||
`((div ((class "tocset"))
|
||||
(div ((class "tocview"))
|
||||
(div ((class "tocviewtitle"))
|
||||
(a ((href "index.html")
|
||||
(class "tocviewlink"))
|
||||
,@(render-content (part-title-content top) d ht)))
|
||||
(div nbsp)
|
||||
(table
|
||||
((class "tocviewlist")
|
||||
(cellspacing "0"))
|
||||
,@(map (lambda (p)
|
||||
`(tr
|
||||
(td
|
||||
((align "right"))
|
||||
,@(format-number (collected-info-number (part-collected-info p))
|
||||
'((tt nbsp))))
|
||||
(td
|
||||
(a ((href ,(let ([dest (lookup p ht `(part ,(part-tag p)))])
|
||||
(format "~a~a~a"
|
||||
(from-root (car dest)
|
||||
(get-dest-directory))
|
||||
(if (caddr dest)
|
||||
""
|
||||
"#")
|
||||
(if (caddr dest)
|
||||
""
|
||||
`(part ,(part-tag p))))))
|
||||
(class ,(if (eq? p mine)
|
||||
"tocviewselflink"
|
||||
"tocviewlink")))
|
||||
,@(render-content (part-title-content p) d ht)))))
|
||||
(part-parts top))))
|
||||
,@(if (ormap (lambda (p) (part-whole-page? p ht)) (part-parts d))
|
||||
null
|
||||
(let ([ps (cdr
|
||||
(let flatten ([d d])
|
||||
(cons d
|
||||
(apply
|
||||
append
|
||||
(letrec ([flow-targets
|
||||
(lambda (flow)
|
||||
(apply append (map flow-element-targets (flow-paragraphs flow))))]
|
||||
[flow-element-targets
|
||||
(lambda (e)
|
||||
(cond
|
||||
[(table? e) (table-targets e)]
|
||||
[(paragraph? e) (para-targets e)]
|
||||
[(itemization? e)
|
||||
(apply append (map flow-targets (itemization-flows e)))]
|
||||
[(blockquote? e)
|
||||
(apply append (map flow-element-targets (blockquote-paragraphs e)))]
|
||||
[(delayed-flow-element? e)
|
||||
null]))]
|
||||
[para-targets
|
||||
(lambda (para)
|
||||
(let loop ([c (paragraph-content para)])
|
||||
(cond
|
||||
[(empty? c) null]
|
||||
[else (let ([a (car c)])
|
||||
(cond
|
||||
[(toc-target-element? a)
|
||||
(cons a (loop (cdr c)))]
|
||||
[(element? a)
|
||||
(append (loop (element-content a))
|
||||
(loop (cdr c)))]
|
||||
[(delayed-element? a)
|
||||
(loop (cons (force-delayed-element a this d ht)
|
||||
(cdr c)))]
|
||||
[else
|
||||
(loop (cdr c))]))])))]
|
||||
[table-targets
|
||||
(lambda (table)
|
||||
(apply append
|
||||
(map (lambda (flows)
|
||||
(apply append (map (lambda (f)
|
||||
(if (eq? f 'cont)
|
||||
null
|
||||
(flow-targets f)))
|
||||
flows)))
|
||||
(table-flowss table))))])
|
||||
(apply append (map flow-element-targets (flow-paragraphs (part-flow d)))))
|
||||
(map flatten (part-parts d))))))])
|
||||
(if (null? ps)
|
||||
null
|
||||
`((div ((class "tocsub"))
|
||||
(div ((class "tocsubtitle"))
|
||||
"On this page:")
|
||||
(table
|
||||
((class "tocsublist")
|
||||
(cellspacing "0"))
|
||||
,@(map (lambda (p)
|
||||
(parameterize ([current-no-links #t])
|
||||
`(tr
|
||||
(td
|
||||
,@(if (part? p)
|
||||
`((span ((class "tocsublinknumber"))
|
||||
,@(format-number (collected-info-number (part-collected-info p))
|
||||
'((tt nbsp)))))
|
||||
'(""))
|
||||
(a ((href ,(if (part? p)
|
||||
(let ([dest (lookup p ht `(part ,(part-tag p)))])
|
||||
(format "#~a"
|
||||
`(part ,(part-tag p))))
|
||||
(format "#~a" (target-element-tag p))))
|
||||
(class ,(if (part? p)
|
||||
"tocsubseclink"
|
||||
"tocsublink")))
|
||||
,@(if (part? p)
|
||||
(render-content (part-title-content p) d ht)
|
||||
(render-content (element-content p) d ht)))))))
|
||||
ps)))))))))))
|
||||
|
||||
(define/public (render-one-part d ht fn number)
|
||||
(parameterize ([current-output-file fn])
|
||||
|
|
@ -356,7 +441,7 @@
|
|||
(build-path fn "index.html"))
|
||||
fns)))
|
||||
|
||||
(define/override (part-whole-page? d)
|
||||
(define/override (current-part-whole-page?)
|
||||
((collecting-sub) . <= . 2))
|
||||
|
||||
(define/private (toc-part? d)
|
||||
|
|
|
|||
|
|
@ -487,7 +487,7 @@
|
|||
(loop (cdr a) (cons (car a) o-accum)))))
|
||||
(loop (cdr a) (cons (car a) r-accum))))]
|
||||
[(tagged) (if first?
|
||||
(make-target-element
|
||||
(make-toc-target-element
|
||||
#f
|
||||
(list (to-element (make-just-context (car prototype)
|
||||
stx-id)))
|
||||
|
|
@ -661,12 +661,13 @@
|
|||
(cons #t (map (lambda (x) #f) (cdr prototypes))))))
|
||||
(content-thunk))))))
|
||||
|
||||
(define (make-target-element* stx-id content wrappers)
|
||||
(define (make-target-element* inner-make-target-element stx-id content wrappers)
|
||||
(if (null? wrappers)
|
||||
content
|
||||
(make-target-element*
|
||||
make-target-element
|
||||
stx-id
|
||||
(make-target-element
|
||||
(inner-make-target-element
|
||||
#f
|
||||
(list content)
|
||||
(register-scheme-definition
|
||||
|
|
@ -686,38 +687,42 @@
|
|||
(cons
|
||||
(list (make-flow
|
||||
(list
|
||||
(let* ([the-name
|
||||
(make-target-element*
|
||||
stx-id
|
||||
(to-element (if (pair? name)
|
||||
(map (lambda (x)
|
||||
(make-just-context x stx-id))
|
||||
name)
|
||||
stx-id))
|
||||
(let ([name (if (pair? name)
|
||||
(car name)
|
||||
name)])
|
||||
(list* (list name)
|
||||
(list name '?)
|
||||
(list 'make- name)
|
||||
(append
|
||||
(map (lambda (f)
|
||||
(list name '- (car f)))
|
||||
fields)
|
||||
(if immutable?
|
||||
null
|
||||
(map (lambda (f)
|
||||
(list 'set- name '- (car f) '!))
|
||||
fields))))))]
|
||||
[short-width (apply +
|
||||
(length fields)
|
||||
8
|
||||
(map (lambda (s)
|
||||
(string-length (symbol->string s)))
|
||||
(append (if (pair? name)
|
||||
name
|
||||
(list name))
|
||||
(map car fields))))])
|
||||
(let* ([the-name
|
||||
(let ([just-name
|
||||
(make-target-element*
|
||||
make-toc-target-element
|
||||
stx-id
|
||||
(to-element (if (pair? name)
|
||||
(make-just-context (car name) stx-id)
|
||||
stx-id))
|
||||
(let ([name (if (pair? name)
|
||||
(car name)
|
||||
name)])
|
||||
(list* (list name)
|
||||
(list name '?)
|
||||
(list 'make- name)
|
||||
(append
|
||||
(map (lambda (f)
|
||||
(list name '- (car f)))
|
||||
fields)
|
||||
(if immutable?
|
||||
null
|
||||
(map (lambda (f)
|
||||
(list 'set- name '- (car f) '!))
|
||||
fields))))))])
|
||||
(if (pair? name)
|
||||
(to-element (list just-name
|
||||
(make-just-context (cadr name) stx-id)))
|
||||
just-name))]
|
||||
[short-width (apply +
|
||||
(length fields)
|
||||
8
|
||||
(map (lambda (s)
|
||||
(string-length (symbol->string s)))
|
||||
(append (if (pair? name)
|
||||
name
|
||||
(list name))
|
||||
(map car fields))))])
|
||||
(if (and (short-width . < . max-proto-width)
|
||||
(not immutable?)
|
||||
(not transparent?))
|
||||
|
|
@ -836,7 +841,7 @@
|
|||
(list (make-flow
|
||||
(list
|
||||
(make-paragraph
|
||||
(list (make-target-element
|
||||
(list (make-toc-target-element
|
||||
#f
|
||||
(list (to-element (make-just-context name stx-id)))
|
||||
(register-scheme-definition stx-id))
|
||||
|
|
@ -885,7 +890,7 @@
|
|||
. ,(cdr form)))))))
|
||||
(and kw-id
|
||||
(eq? form (car forms))
|
||||
(make-target-element
|
||||
(make-toc-target-element
|
||||
#f
|
||||
(list (to-element (make-just-context (if (pair? form)
|
||||
(car form)
|
||||
|
|
|
|||
|
|
@ -35,15 +35,24 @@
|
|||
border: 0.5em solid #F5F5DC;
|
||||
}
|
||||
|
||||
.tocview {
|
||||
.tocset {
|
||||
position: relative;
|
||||
float: left;
|
||||
width: 10em;
|
||||
margin-right: 2em;
|
||||
}
|
||||
|
||||
.tocview {
|
||||
text-align: left;
|
||||
background-color: #F5F5DC;
|
||||
}
|
||||
|
||||
.tocsub {
|
||||
margin-top: 1em;
|
||||
text-align: left;
|
||||
background-color: #DCF5F5;
|
||||
}
|
||||
|
||||
.tocviewtitle {
|
||||
font-size: 80%;
|
||||
font-weight: bold;
|
||||
|
|
@ -63,6 +72,35 @@
|
|||
text-decoration: none;
|
||||
}
|
||||
|
||||
.tocsublist {
|
||||
margin: 0.2em 0.2em 0.2em 0.2em;
|
||||
}
|
||||
|
||||
.tocsublist td {
|
||||
vertical-align: top;
|
||||
padding-left: 1em;
|
||||
text-indent: -1em;
|
||||
}
|
||||
|
||||
.tocsublinknumber {
|
||||
font-size: 80%;
|
||||
}
|
||||
|
||||
.tocsublink {
|
||||
text-decoration: none;
|
||||
}
|
||||
|
||||
.tocsubseclink {
|
||||
font-size: 80%;
|
||||
text-decoration: none;
|
||||
}
|
||||
|
||||
.tocsubtitle {
|
||||
font-size: 80%;
|
||||
font-style: italic;
|
||||
margin: 0.2em 0.2em 0.2em 0.2em;
|
||||
}
|
||||
|
||||
.leftindent {
|
||||
margin-left: 1em;
|
||||
margin-right: 0em;
|
||||
|
|
|
|||
|
|
@ -72,6 +72,7 @@
|
|||
[element ([style any/c]
|
||||
[content list?])]
|
||||
[(target-element element) ([tag tag?])]
|
||||
[(toc-target-element target-element) ()]
|
||||
[(link-element element) ([tag tag?])]
|
||||
[(index-element element) ([tag tag?]
|
||||
[plain-seq (listof string?)]
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user