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

reorganize guide to have the Scheme background in one section

Browse Source 
svn: r6284

original commit: 75632a9cc3ce9902ac8f763b237accc3cf00fb52
This commit is contained in:
Matthew Flatt 2007-05-25 01:30:00 +00:00
parent 7fcbe97842
commit 2db9f68d91
6 changed files with 157 additions and 106 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

60
collects/scribble/base-render.ss
View File

@ -252,36 +252,40 @@
;; ---------------------------------------- ;; ----------------------------------------
(define/public (table-of-contents part ht) (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 ([number (collected-info-number (part-collected-info part))])
(let ([l (cons (let ([subs
(list (make-flow (apply
(list append
(make-paragraph (map (lambda (p) (render-toc p #f)) (part-parts part)))])
(list (if skip?
(make-element 'hspace (list (make-string (* 2 (length number)) #\space))) subs
(make-link-element (if (= 1 (length number)) (let ([l (cons
"toptoclink" (list (make-flow
"toclink") (list
(append (make-paragraph
(format-number number (list
(list (make-element 'hspace (list (make-string (* 2 (length number)) #\space)))
(make-element 'hspace '(" ")))) (make-link-element (if (= 1 (length number))
(part-title-content part)) "toptoclink"
`(part ,(part-tag part)))))))) "toclink")
(apply (append
append (format-number number
(map (lambda (p) (render-toc p)) (part-parts part))))]) (list
(if (and (= 1 (length number)) (make-element 'hspace '(" "))))
(or (not (car number)) (part-title-content part))
((car number) . > . 1))) `(part ,(part-tag part))))))))
(cons (list (make-flow (list (make-paragraph (list subs)])
(make-element 'hspace (list ""))))))) (if (and (= 1 (length number))
l) (or (not (car number))
l)))) ((car number) . > . 1)))
(cons (list (make-flow (list (make-paragraph (list
(make-element 'hspace (list "")))))))
l)
l))))))
;; ---------------------------------------- ;; ----------------------------------------
(super-new)))) (super-new))))

4
collects/scribble/basic.ss
View File

@ -19,9 +19,9 @@
(content->string content) (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)]) (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) (define/kw (section #:key [tag #f] #:body str)
(let ([content (decode-content str)]) (let ([content (decode-content str)])

97
collects/scribble/decode.ss
View File

@ -14,6 +14,7 @@
(provide-structs (provide-structs
[title-decl ([tag any/c] [title-decl ([tag any/c]
[style any/c]
[content list?])] [content list?])]
[part-start ([depth integer?] [part-start ([depth integer?]
[tag (or/c false/c string?)] [tag (or/c false/c string?)]
@ -48,14 +49,15 @@
null null
(list (decode-paragraph (reverse (skip-whitespace accum)))))) (list (decode-paragraph (reverse (skip-whitespace accum))))))
(define (decode-flow* l tag title part-depth) (define (decode-flow* l tag style title part-depth)
(let loop ([l l][next? #f][accum null][title title][tag tag]) (let loop ([l l][next? #f][accum null][title title][tag tag][style style])
(cond (cond
[(null? l) (make-part tag [(null? l) (make-styled-part tag
title title
#f #f
(make-flow (decode-accum-para accum)) (make-flow (decode-accum-para accum))
null)] null
style)]
[(title-decl? (car l)) [(title-decl? (car l))
(unless part-depth (unless part-depth
(error 'decode (error 'decode
@ -65,30 +67,35 @@
(error 'decode (error 'decode
"found extra title: ~v" "found extra title: ~v"
(car l))) (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)) [(or (paragraph? (car l))
(table? (car l)) (table? (car l))
(itemization? (car l)) (itemization? (car l))
(delayed-flow-element? (car l))) (delayed-flow-element? (car l)))
(let ([para (decode-accum-para accum)] (let ([para (decode-accum-para accum)]
[part (decode-flow* (cdr l) tag title part-depth)]) [part (decode-flow* (cdr l) tag style title part-depth)])
(make-part (part-tag part) (make-styled-part (part-tag part)
(part-title-content part) (part-title-content part)
(part-collected-info part) (part-collected-info part)
(make-flow (append para (make-flow (append para
(list (car l)) (list (car l))
(flow-paragraphs (part-flow part)))) (flow-paragraphs (part-flow part))))
(part-parts part)))] (part-parts part)
(styled-part-style part)))]
[(part? (car l)) [(part? (car l))
(let ([para (decode-accum-para accum)] (let ([para (decode-accum-para accum)]
[part (decode-part (cdr l) tag title part-depth)]) [part (decode-flow* (cdr l) tag style title part-depth)])
(make-part (part-tag part) (make-styled-part (part-tag part)
(part-title-content part) (part-title-content part)
(part-collected-info part) (part-collected-info part)
(make-flow (append para (make-flow (append para
(flow-paragraphs (flow-paragraphs
(part-flow part)))) (part-flow part))))
(cons (car l) (part-parts part))))] (cons (car l) (part-parts part))
(styled-part-style part)))]
[(and (part-start? (car l)) [(and (part-start? (car l))
(or (not part-depth) (or (not part-depth)
((part-start-depth (car l)) . <= . part-depth))) ((part-start-depth (car l)) . <= . part-depth)))
@ -109,38 +116,40 @@
(part-start-title s) (part-start-title s)
(add1 part-depth))] (add1 part-depth))]
[part (decode-part l tag title part-depth)]) [part (decode-part l tag title part-depth)])
(make-part (part-tag part) (make-styled-part (part-tag part)
(part-title-content part) (part-title-content part)
(part-collected-info part) (part-collected-info part)
(make-flow para) (make-flow para)
(cons s (part-parts part)))) (cons s (part-parts part))
(styled-part-style part)))
(loop (cdr l) (cons (car l) s-accum)))))] (loop (cdr l) (cons (car l) s-accum)))))]
[(splice? (car l)) [(splice? (car l))
(loop (append (splice-run (car l)) (cdr l)) next? 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)] [(null? (cdr l)) (loop null #f (cons (car l) accum) title tag style)]
[(and (pair? (cdr l)) [(and (pair? (cdr l))
(splice? (cadr 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)) [(line-break? (car l))
(if next? (if next?
(loop (cdr l) #t accum title tag) (loop (cdr l) #t accum title tag style)
(let ([m (match-newline-whitespace (cdr l))]) (let ([m (match-newline-whitespace (cdr l))])
(if m (if m
(let ([part (loop m #t null title tag)]) (let ([part (loop m #t null title tag style)])
(make-part (part-tag part) (make-styled-part (part-tag part)
(part-title-content part) (part-title-content part)
(part-collected-info part) (part-collected-info part)
(make-flow (append (decode-accum-para accum) (make-flow (append (decode-accum-para accum)
(flow-paragraphs (part-flow part)))) (flow-paragraphs (part-flow part))))
(part-parts part))) (part-parts part)
(loop (cdr l) #f (cons (car l) accum) title tag))))] (styled-part-style part)))
[else (loop (cdr l) #f (cons (car l) accum) title tag)]))) (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) (define (decode-part l tag title depth)
(decode-flow* l tag title depth)) (decode-flow* l tag #f title depth))
(define (decode-flow l) (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) (define (match-newline-whitespace l)
(cond (cond

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

@ -3,6 +3,7 @@
(require "struct.ss" (require "struct.ss"
(lib "class.ss") (lib "class.ss")
(lib "file.ss") (lib "file.ss")
(lib "list.ss")
(lib "runtime-path.ss") (lib "runtime-path.ss")
(prefix xml: (lib "xml.ss" "xml"))) (prefix xml: (lib "xml.ss" "xml")))
(provide render-mixin (provide render-mixin
@ -14,7 +15,8 @@
(define current-subdirectory (make-parameter #f)) (define current-subdirectory (make-parameter #f))
(define current-output-file (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)) (define collecting-sub (make-parameter 0))
;; ---------------------------------------- ;; ----------------------------------------
@ -243,9 +245,15 @@
(define/override (part-whole-page? d) (define/override (part-whole-page? d)
(= 2 (collecting-sub))) (= 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) (define/override (collect-part d parent ht number)
(let ([prev-sub (collecting-sub)]) (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) (if (= 1 prev-sub)
(let ([filename (derive-filename d)]) (let ([filename (derive-filename d)])
(parameterize ([current-output-file (build-path (path-only (current-output-file)) (parameterize ([current-output-file (build-path (path-only (current-output-file))
@ -275,19 +283,43 @@
(inherit render-table) (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) (define/private (navigation d ht)
(let ([parent (collected-info-parent (part-collected-info d))]) (let ([parent (collected-info-parent (part-collected-info d))])
(let-values ([(prev next) (let*-values ([(prev next) (find-siblings d)]
(let loop ([l (if parent [(prev) (if prev
(part-parts parent) (let loop ([prev prev])
(if (null? (part-parts d)) (if (and (toc-part? prev)
(list d) (pair? (part-parts prev)))
(list d (car (part-parts d)))))] (loop (car (last-pair (part-parts prev))))
[prev #f]) prev))
(cond (and parent
[(eq? (car l) d) (values prev (and (pair? (cdr l)) (toc-part? parent)
(cadr l)))] parent))]
[else (loop (cdr l) (car l))]))]) [(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 (render-table (make-table
'at-right 'at-right
(list (list
@ -306,13 +338,17 @@
sep-element sep-element
(if parent (if parent
(make-element (make-element
(make-target-url "index.html") (make-target-url
(if (toc-part? parent)
(derive-filename parent)
"index.html"))
up-content) up-content)
"") "")
sep-element sep-element
(make-element (make-element
(and next (if next
(make-target-url (derive-filename next))) (make-target-url (derive-filename next))
"nonavigation")
next-content)))))))) next-content))))))))
d d
ht)))) ht))))
@ -321,7 +357,8 @@
(let ([number (collected-info-number (part-collected-info d))]) (let ([number (collected-info-number (part-collected-info d))])
(cond (cond
[(and (not (on-separate-page)) [(and (not (on-separate-page))
(= 1 (length number))) (or (= 1 (length number))
(next-separate-page)))
;; Render as just a link, and put the actual ;; Render as just a link, and put the actual
;; content in a new file: ;; content in a new file:
(let* ([filename (derive-filename d)] (let* ([filename (derive-filename d)]
@ -334,16 +371,19 @@
'truncate/replace) 'truncate/replace)
null))] null))]
[else [else
(if ((length number) . <= . 1) (let ([sep? (on-separate-page)])
;; Navigation bars; (parameterize ([next-separate-page (toc-part? d)]
`(,@(navigation d ht) [on-separate-page #f])
(p nbsp) (if sep?
,@(super render-part d ht) ;; Navigation bars;
(p nbsp) `(,@(navigation d ht)
,@(navigation d ht) (p nbsp)
(p nbsp)) ,@(super render-part d ht)
;; Normal section render (p nbsp)
(super render-part d ht))]))) ,@(navigation d ht)
(p nbsp))
;; Normal section render
(super render-part d ht))))])))
(super-new))) (super-new)))

7
collects/scribble/scribble.css
View File

@ -202,11 +202,8 @@
font-family: monospace; font-family: monospace;
} }
.navigation { .nonavigation {
color: red; color: gray;
text-align: right;
font-size: medium;
font-style: italic;
} }
.disable { .disable {

1
collects/scribble/struct.ss
View File

@ -56,6 +56,7 @@
[collected-info (or/c false/c collected-info?)] [collected-info (or/c false/c collected-info?)]
[flow flow?] [flow flow?]
[parts (listof part?)])] [parts (listof part?)])]
[(styled-part part) ([style any/c])]
[(unnumbered-part part) ()] [(unnumbered-part part) ()]
[flow ([paragraphs (listof flow-element?)])] [flow ([paragraphs (listof flow-element?)])]
[paragraph ([content list?])] [paragraph ([content list?])]