reorganize guide to have the Scheme background in one section
svn: r6284 original commit: 75632a9cc3ce9902ac8f763b237accc3cf00fb52
This commit is contained in:
Matthew Flatt
parent
7fcbe97842
commit
2db9f68d91
|
|
@ -252,36 +252,40 @@
|
|||
;; ----------------------------------------
|
||||
|
||||
(define/public (table-of-contents part ht)
|
||||
(make-table #f (cdr (render-toc part))))
|
||||
(make-table #f (render-toc part #t)))
|
||||
|
||||
(define/private (render-toc part)
|
||||
(define/private (render-toc part skip?)
|
||||
(let ([number (collected-info-number (part-collected-info part))])
|
||||
(let ([l (cons
|
||||
(list (make-flow
|
||||
(list
|
||||
(make-paragraph
|
||||
(list
|
||||
(make-element 'hspace (list (make-string (* 2 (length number)) #\space)))
|
||||
(make-link-element (if (= 1 (length number))
|
||||
"toptoclink"
|
||||
"toclink")
|
||||
(append
|
||||
(format-number number
|
||||
(list
|
||||
(make-element 'hspace '(" "))))
|
||||
(part-title-content part))
|
||||
`(part ,(part-tag part))))))))
|
||||
(apply
|
||||
append
|
||||
(map (lambda (p) (render-toc p)) (part-parts part))))])
|
||||
(if (and (= 1 (length number))
|
||||
(or (not (car number))
|
||||
((car number) . > . 1)))
|
||||
(cons (list (make-flow (list (make-paragraph (list
|
||||
(make-element 'hspace (list "")))))))
|
||||
l)
|
||||
l))))
|
||||
|
||||
(let ([subs
|
||||
(apply
|
||||
append
|
||||
(map (lambda (p) (render-toc p #f)) (part-parts part)))])
|
||||
(if skip?
|
||||
subs
|
||||
(let ([l (cons
|
||||
(list (make-flow
|
||||
(list
|
||||
(make-paragraph
|
||||
(list
|
||||
(make-element 'hspace (list (make-string (* 2 (length number)) #\space)))
|
||||
(make-link-element (if (= 1 (length number))
|
||||
"toptoclink"
|
||||
"toclink")
|
||||
(append
|
||||
(format-number number
|
||||
(list
|
||||
(make-element 'hspace '(" "))))
|
||||
(part-title-content part))
|
||||
`(part ,(part-tag part))))))))
|
||||
subs)])
|
||||
(if (and (= 1 (length number))
|
||||
(or (not (car number))
|
||||
((car number) . > . 1)))
|
||||
(cons (list (make-flow (list (make-paragraph (list
|
||||
(make-element 'hspace (list "")))))))
|
||||
l)
|
||||
l))))))
|
||||
|
||||
;; ----------------------------------------
|
||||
|
||||
(super-new))))
|
||||
|
|
|
|||
|
|
@ -19,9 +19,9 @@
|
|||
(content->string content)
|
||||
"_"))
|
||||
|
||||
(define/kw (title #:key [tag #f] #:body str)
|
||||
(define/kw (title #:key [tag #f] [style #f] #:body str)
|
||||
(let ([content (decode-content str)])
|
||||
(make-title-decl (or tag (gen-tag content)) content)))
|
||||
(make-title-decl (or tag (gen-tag content)) style content)))
|
||||
|
||||
(define/kw (section #:key [tag #f] #:body str)
|
||||
(let ([content (decode-content str)])
|
||||
|
|
|
|||
|
|
@ -14,6 +14,7 @@
|
|||
|
||||
(provide-structs
|
||||
[title-decl ([tag any/c]
|
||||
[style any/c]
|
||||
[content list?])]
|
||||
[part-start ([depth integer?]
|
||||
[tag (or/c false/c string?)]
|
||||
|
|
@ -48,14 +49,15 @@
|
|||
null
|
||||
(list (decode-paragraph (reverse (skip-whitespace accum))))))
|
||||
|
||||
(define (decode-flow* l tag title part-depth)
|
||||
(let loop ([l l][next? #f][accum null][title title][tag tag])
|
||||
(define (decode-flow* l tag style title part-depth)
|
||||
(let loop ([l l][next? #f][accum null][title title][tag tag][style style])
|
||||
(cond
|
||||
[(null? l) (make-part tag
|
||||
title
|
||||
#f
|
||||
(make-flow (decode-accum-para accum))
|
||||
null)]
|
||||
[(null? l) (make-styled-part tag
|
||||
title
|
||||
#f
|
||||
(make-flow (decode-accum-para accum))
|
||||
null
|
||||
style)]
|
||||
[(title-decl? (car l))
|
||||
(unless part-depth
|
||||
(error 'decode
|
||||
|
|
@ -65,30 +67,35 @@
|
|||
(error 'decode
|
||||
"found extra title: ~v"
|
||||
(car l)))
|
||||
(loop (cdr l) next? accum (title-decl-content (car l)) (title-decl-tag (car l)))]
|
||||
(loop (cdr l) next? accum
|
||||
(title-decl-content (car l))
|
||||
(title-decl-tag (car l))
|
||||
(title-decl-style (car l)))]
|
||||
[(or (paragraph? (car l))
|
||||
(table? (car l))
|
||||
(itemization? (car l))
|
||||
(delayed-flow-element? (car l)))
|
||||
(let ([para (decode-accum-para accum)]
|
||||
[part (decode-flow* (cdr l) tag title part-depth)])
|
||||
(make-part (part-tag part)
|
||||
(part-title-content part)
|
||||
(part-collected-info part)
|
||||
(make-flow (append para
|
||||
(list (car l))
|
||||
(flow-paragraphs (part-flow part))))
|
||||
(part-parts part)))]
|
||||
[part (decode-flow* (cdr l) tag style title part-depth)])
|
||||
(make-styled-part (part-tag part)
|
||||
(part-title-content part)
|
||||
(part-collected-info part)
|
||||
(make-flow (append para
|
||||
(list (car l))
|
||||
(flow-paragraphs (part-flow part))))
|
||||
(part-parts part)
|
||||
(styled-part-style part)))]
|
||||
[(part? (car l))
|
||||
(let ([para (decode-accum-para accum)]
|
||||
[part (decode-part (cdr l) tag title part-depth)])
|
||||
(make-part (part-tag part)
|
||||
(part-title-content part)
|
||||
(part-collected-info part)
|
||||
(make-flow (append para
|
||||
(flow-paragraphs
|
||||
(part-flow part))))
|
||||
(cons (car l) (part-parts part))))]
|
||||
[part (decode-flow* (cdr l) tag style title part-depth)])
|
||||
(make-styled-part (part-tag part)
|
||||
(part-title-content part)
|
||||
(part-collected-info part)
|
||||
(make-flow (append para
|
||||
(flow-paragraphs
|
||||
(part-flow part))))
|
||||
(cons (car l) (part-parts part))
|
||||
(styled-part-style part)))]
|
||||
[(and (part-start? (car l))
|
||||
(or (not part-depth)
|
||||
((part-start-depth (car l)) . <= . part-depth)))
|
||||
|
|
@ -109,38 +116,40 @@
|
|||
(part-start-title s)
|
||||
(add1 part-depth))]
|
||||
[part (decode-part l tag title part-depth)])
|
||||
(make-part (part-tag part)
|
||||
(part-title-content part)
|
||||
(part-collected-info part)
|
||||
(make-flow para)
|
||||
(cons s (part-parts part))))
|
||||
(make-styled-part (part-tag part)
|
||||
(part-title-content part)
|
||||
(part-collected-info part)
|
||||
(make-flow para)
|
||||
(cons s (part-parts part))
|
||||
(styled-part-style part)))
|
||||
(loop (cdr l) (cons (car l) s-accum)))))]
|
||||
[(splice? (car l))
|
||||
(loop (append (splice-run (car l)) (cdr l)) next? accum title tag)]
|
||||
[(null? (cdr l)) (loop null #f (cons (car l) accum) title tag)]
|
||||
(loop (append (splice-run (car l)) (cdr l)) next? accum title tag style)]
|
||||
[(null? (cdr l)) (loop null #f (cons (car l) accum) title tag style)]
|
||||
[(and (pair? (cdr l))
|
||||
(splice? (cadr l)))
|
||||
(loop (cons (car l) (append (splice-run (cadr l)) (cddr l))) next? accum title tag)]
|
||||
(loop (cons (car l) (append (splice-run (cadr l)) (cddr l))) next? accum title tag style)]
|
||||
[(line-break? (car l))
|
||||
(if next?
|
||||
(loop (cdr l) #t accum title tag)
|
||||
(loop (cdr l) #t accum title tag style)
|
||||
(let ([m (match-newline-whitespace (cdr l))])
|
||||
(if m
|
||||
(let ([part (loop m #t null title tag)])
|
||||
(make-part (part-tag part)
|
||||
(part-title-content part)
|
||||
(part-collected-info part)
|
||||
(make-flow (append (decode-accum-para accum)
|
||||
(flow-paragraphs (part-flow part))))
|
||||
(part-parts part)))
|
||||
(loop (cdr l) #f (cons (car l) accum) title tag))))]
|
||||
[else (loop (cdr l) #f (cons (car l) accum) title tag)])))
|
||||
(let ([part (loop m #t null title tag style)])
|
||||
(make-styled-part (part-tag part)
|
||||
(part-title-content part)
|
||||
(part-collected-info part)
|
||||
(make-flow (append (decode-accum-para accum)
|
||||
(flow-paragraphs (part-flow part))))
|
||||
(part-parts part)
|
||||
(styled-part-style part)))
|
||||
(loop (cdr l) #f (cons (car l) accum) title tag style))))]
|
||||
[else (loop (cdr l) #f (cons (car l) accum) title tag style)])))
|
||||
|
||||
(define (decode-part l tag title depth)
|
||||
(decode-flow* l tag title depth))
|
||||
(decode-flow* l tag #f title depth))
|
||||
|
||||
(define (decode-flow l)
|
||||
(part-flow (decode-flow* l #f #f #f)))
|
||||
(part-flow (decode-flow* l #f #f #f #f)))
|
||||
|
||||
(define (match-newline-whitespace l)
|
||||
(cond
|
||||
|
|
|
|||
|
|
@ -3,6 +3,7 @@
|
|||
(require "struct.ss"
|
||||
(lib "class.ss")
|
||||
(lib "file.ss")
|
||||
(lib "list.ss")
|
||||
(lib "runtime-path.ss")
|
||||
(prefix xml: (lib "xml.ss" "xml")))
|
||||
(provide render-mixin
|
||||
|
|
@ -14,7 +15,8 @@
|
|||
|
||||
(define current-subdirectory (make-parameter #f))
|
||||
(define current-output-file (make-parameter #f))
|
||||
(define on-separate-page (make-parameter #f))
|
||||
(define on-separate-page (make-parameter #t))
|
||||
(define next-separate-page (make-parameter #f))
|
||||
(define collecting-sub (make-parameter 0))
|
||||
|
||||
;; ----------------------------------------
|
||||
|
|
@ -243,9 +245,15 @@
|
|||
(define/override (part-whole-page? d)
|
||||
(= 2 (collecting-sub)))
|
||||
|
||||
(define/private (toc-part? d)
|
||||
(and (styled-part? d)
|
||||
(eq? 'toc (styled-part-style d))))
|
||||
|
||||
(define/override (collect-part d parent ht number)
|
||||
(let ([prev-sub (collecting-sub)])
|
||||
(parameterize ([collecting-sub (add1 prev-sub)])
|
||||
(parameterize ([collecting-sub (if (toc-part? d)
|
||||
1
|
||||
(add1 prev-sub))])
|
||||
(if (= 1 prev-sub)
|
||||
(let ([filename (derive-filename d)])
|
||||
(parameterize ([current-output-file (build-path (path-only (current-output-file))
|
||||
|
|
@ -275,19 +283,43 @@
|
|||
|
||||
(inherit render-table)
|
||||
|
||||
(define/private (find-siblings d)
|
||||
(let ([parent (collected-info-parent (part-collected-info d))])
|
||||
(let loop ([l (if parent
|
||||
(part-parts parent)
|
||||
(if (null? (part-parts d))
|
||||
(list d)
|
||||
(list d (car (part-parts d)))))]
|
||||
[prev #f])
|
||||
(cond
|
||||
[(eq? (car l) d) (values prev
|
||||
(and (pair? (cdr l))
|
||||
(cadr l)))]
|
||||
[else (loop (cdr l) (car l))]))))
|
||||
|
||||
(define/private (navigation d ht)
|
||||
(let ([parent (collected-info-parent (part-collected-info d))])
|
||||
(let-values ([(prev next)
|
||||
(let loop ([l (if parent
|
||||
(part-parts parent)
|
||||
(if (null? (part-parts d))
|
||||
(list d)
|
||||
(list d (car (part-parts d)))))]
|
||||
[prev #f])
|
||||
(cond
|
||||
[(eq? (car l) d) (values prev (and (pair? (cdr l))
|
||||
(cadr l)))]
|
||||
[else (loop (cdr l) (car l))]))])
|
||||
(let*-values ([(prev next) (find-siblings d)]
|
||||
[(prev) (if prev
|
||||
(let loop ([prev prev])
|
||||
(if (and (toc-part? prev)
|
||||
(pair? (part-parts prev)))
|
||||
(loop (car (last-pair (part-parts prev))))
|
||||
prev))
|
||||
(and parent
|
||||
(toc-part? parent)
|
||||
parent))]
|
||||
[(next) (cond
|
||||
[(and (toc-part? d)
|
||||
(pair? (part-parts d)))
|
||||
(car (part-parts d))]
|
||||
[(and (not next)
|
||||
parent
|
||||
(toc-part? parent))
|
||||
(let-values ([(prev next)
|
||||
(find-siblings parent)])
|
||||
next)]
|
||||
[else next])])
|
||||
(render-table (make-table
|
||||
'at-right
|
||||
(list
|
||||
|
|
@ -306,13 +338,17 @@
|
|||
sep-element
|
||||
(if parent
|
||||
(make-element
|
||||
(make-target-url "index.html")
|
||||
(make-target-url
|
||||
(if (toc-part? parent)
|
||||
(derive-filename parent)
|
||||
"index.html"))
|
||||
up-content)
|
||||
"")
|
||||
sep-element
|
||||
(make-element
|
||||
(and next
|
||||
(make-target-url (derive-filename next)))
|
||||
(if next
|
||||
(make-target-url (derive-filename next))
|
||||
"nonavigation")
|
||||
next-content))))))))
|
||||
d
|
||||
ht))))
|
||||
|
|
@ -321,7 +357,8 @@
|
|||
(let ([number (collected-info-number (part-collected-info d))])
|
||||
(cond
|
||||
[(and (not (on-separate-page))
|
||||
(= 1 (length number)))
|
||||
(or (= 1 (length number))
|
||||
(next-separate-page)))
|
||||
;; Render as just a link, and put the actual
|
||||
;; content in a new file:
|
||||
(let* ([filename (derive-filename d)]
|
||||
|
|
@ -334,16 +371,19 @@
|
|||
'truncate/replace)
|
||||
null))]
|
||||
[else
|
||||
(if ((length number) . <= . 1)
|
||||
;; Navigation bars;
|
||||
`(,@(navigation d ht)
|
||||
(p nbsp)
|
||||
,@(super render-part d ht)
|
||||
(p nbsp)
|
||||
,@(navigation d ht)
|
||||
(p nbsp))
|
||||
;; Normal section render
|
||||
(super render-part d ht))])))
|
||||
(let ([sep? (on-separate-page)])
|
||||
(parameterize ([next-separate-page (toc-part? d)]
|
||||
[on-separate-page #f])
|
||||
(if sep?
|
||||
;; Navigation bars;
|
||||
`(,@(navigation d ht)
|
||||
(p nbsp)
|
||||
,@(super render-part d ht)
|
||||
(p nbsp)
|
||||
,@(navigation d ht)
|
||||
(p nbsp))
|
||||
;; Normal section render
|
||||
(super render-part d ht))))])))
|
||||
|
||||
(super-new)))
|
||||
|
||||
|
|
|
|||
|
|
@ -202,11 +202,8 @@
|
|||
font-family: monospace;
|
||||
}
|
||||
|
||||
.navigation {
|
||||
color: red;
|
||||
text-align: right;
|
||||
font-size: medium;
|
||||
font-style: italic;
|
||||
.nonavigation {
|
||||
color: gray;
|
||||
}
|
||||
|
||||
.disable {
|
||||
|
|
|
|||
|
|
@ -56,6 +56,7 @@
|
|||
[collected-info (or/c false/c collected-info?)]
|
||||
[flow flow?]
|
||||
[parts (listof part?)])]
|
||||
[(styled-part part) ([style any/c])]
|
||||
[(unnumbered-part part) ()]
|
||||
[flow ([paragraphs (listof flow-element?)])]
|
||||
[paragraph ([content list?])]
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user