From 2db9f68d918c03ee705d1926c823ce8585c32318 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Fri, 25 May 2007 01:30:00 +0000 Subject: [PATCH] reorganize guide to have the Scheme background in one section svn: r6284 original commit: 75632a9cc3ce9902ac8f763b237accc3cf00fb52 --- collects/scribble/base-render.ss | 60 +++++++++++--------- collects/scribble/basic.ss | 4 +- collects/scribble/decode.ss | 97 +++++++++++++++++--------------- collects/scribble/html-render.ss | 94 ++++++++++++++++++++++--------- collects/scribble/scribble.css | 7 +-- collects/scribble/struct.ss | 1 + 6 files changed, 157 insertions(+), 106 deletions(-) diff --git a/collects/scribble/base-render.ss b/collects/scribble/base-render.ss index d74b859c..c615263d 100644 --- a/collects/scribble/base-render.ss +++ b/collects/scribble/base-render.ss @@ -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)))) diff --git a/collects/scribble/basic.ss b/collects/scribble/basic.ss index 5fac4c40..c0e00575 100644 --- a/collects/scribble/basic.ss +++ b/collects/scribble/basic.ss @@ -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)]) diff --git a/collects/scribble/decode.ss b/collects/scribble/decode.ss index b245e7ad..f03e4046 100644 --- a/collects/scribble/decode.ss +++ b/collects/scribble/decode.ss @@ -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 diff --git a/collects/scribble/html-render.ss b/collects/scribble/html-render.ss index e2103098..62ceba04 100644 --- a/collects/scribble/html-render.ss +++ b/collects/scribble/html-render.ss @@ -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))) diff --git a/collects/scribble/scribble.css b/collects/scribble/scribble.css index 6f1f26f5..d3c53833 100644 --- a/collects/scribble/scribble.css +++ b/collects/scribble/scribble.css @@ -202,11 +202,8 @@ font-family: monospace; } - .navigation { - color: red; - text-align: right; - font-size: medium; - font-style: italic; + .nonavigation { + color: gray; } .disable { diff --git a/collects/scribble/struct.ss b/collects/scribble/struct.ss index 7a3b09d9..8e60e6fe 100644 --- a/collects/scribble/struct.ss +++ b/collects/scribble/struct.ss @@ -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?])]