From f6524e98a9f8df275ee3be4b1e534fdd995866f1 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Mon, 17 Dec 2007 00:28:20 +0000 Subject: [PATCH] add 'last' field to picts, and document slideshow/code svn: r8033 original commit: 67752bc4355b7bec93880f6dbd8750556ee24bc6 --- collects/scribble/basic.ss | 3 +- collects/scribble/decode.ss | 175 +++++++++++---------- collects/scribble/html-render.ss | 80 ++++++---- collects/scribble/manual.ss | 3 +- collects/scribble/scribble.css | 14 ++ collects/scribble/struct.ss | 1 + collects/scribblings/scribble/basic.scrbl | 10 +- collects/scribblings/scribble/decode.scrbl | 18 ++- collects/scribblings/scribble/manual.scrbl | 3 + collects/scribblings/scribble/struct.scrbl | 21 ++- 10 files changed, 199 insertions(+), 129 deletions(-) diff --git a/collects/scribble/basic.ss b/collects/scribble/basic.ss index b4f4bdb3..82faf9ba 100644 --- a/collects/scribble/basic.ss +++ b/collects/scribble/basic.ss @@ -32,10 +32,11 @@ (apply append (map (lambda (t) (convert-tag t content)) tag)) `((part ,(or tag (gen-tag content)))))) - (define (title #:tag [tag #f] #:tag-prefix [prefix #f] #:style [style #f] . str) + (define (title #:tag [tag #f] #:tag-prefix [prefix #f] #:style [style #f] #:version [version #f] . str) (let ([content (decode-content str)]) (make-title-decl (prefix->string prefix) (convert-tag tag content) + version style content))) diff --git a/collects/scribble/decode.ss b/collects/scribble/decode.ss index fd55cd56..d62a12ac 100644 --- a/collects/scribble/decode.ss +++ b/collects/scribble/decode.ss @@ -16,6 +16,7 @@ (provide-structs [title-decl ([tag-prefix (or/c false/c string?)] [tags (listof tag?)] + [version (or/c string? false/c)] [style any/c] [content list?])] [part-start ([depth integer?] @@ -57,8 +58,14 @@ null (list (decode-paragraph (reverse (skip-whitespace accum)))))) - (define (decode-flow* l keys colls tag-prefix tags style title part-depth) - (let loop ([l l][next? #f][keys keys][colls colls][accum null][title title][tag-prefix tag-prefix][tags tags][style style]) + (define (part-version p) + (if (versioned-part? p) + (versioned-part-version p) + #f)) + + (define (decode-flow* l keys colls tag-prefix tags vers style title part-depth) + (let loop ([l l][next? #f][keys keys][colls colls][accum null][title title] + [tag-prefix tag-prefix][tags tags][vers vers][style style]) (cond [(null? l) (let ([k-tags (map (lambda (k) @@ -67,36 +74,37 @@ [tags (if (null? tags) (list `(part ,(make-generated-tag))) tags)]) - (make-part tag-prefix - (append tags k-tags) - title - style - (let ([l (map (lambda (k tag) - (make-index-element - #f - null - tag - (part-index-decl-plain-seq k) - (part-index-decl-entry-seq k) - #f)) - keys k-tags)]) - (append - (if (and title (not (or (eq? 'hidden style) - (and (list? style) - (memq 'hidden style))))) - (cons (make-index-element - #f - null - (car tags) - (list (regexp-replace #px"^(?:A|An|The)\\s" (content->string title) - "")) - (list (make-element #f title)) - (make-part-index-desc)) - l) - l) - colls)) - (make-flow (decode-accum-para accum)) - null))] + (make-versioned-part tag-prefix + (append tags k-tags) + title + style + (let ([l (map (lambda (k tag) + (make-index-element + #f + null + tag + (part-index-decl-plain-seq k) + (part-index-decl-entry-seq k) + #f)) + keys k-tags)]) + (append + (if (and title (not (or (eq? 'hidden style) + (and (list? style) + (memq 'hidden style))))) + (cons (make-index-element + #f + null + (car tags) + (list (regexp-replace #px"^(?:A|An|The)\\s" (content->string title) + "")) + (list (make-element #f title)) + (make-part-index-desc)) + l) + l) + colls)) + (make-flow (decode-accum-para accum)) + null + vers))] [(title-decl? (car l)) (unless part-depth (error 'decode @@ -110,31 +118,34 @@ (title-decl-content (car l)) (title-decl-tag-prefix (car l)) (title-decl-tags (car l)) + (title-decl-version (car l)) (title-decl-style (car l)))] [(flow-element? (car l)) (let ([para (decode-accum-para accum)] - [part (decode-flow* (cdr l) keys colls tag-prefix tags style title part-depth)]) - (make-part (part-tag-prefix part) - (part-tags part) - (part-title-content part) - (part-style part) - (part-to-collect part) - (make-flow (append para - (list (car l)) - (flow-paragraphs (part-flow part)))) - (part-parts part)))] + [part (decode-flow* (cdr l) keys colls tag-prefix tags vers style title part-depth)]) + (make-versioned-part (part-tag-prefix part) + (part-tags part) + (part-title-content part) + (part-style part) + (part-to-collect part) + (make-flow (append para + (list (car l)) + (flow-paragraphs (part-flow part)))) + (part-parts part) + (part-version part)))] [(part? (car l)) (let ([para (decode-accum-para accum)] - [part (decode-flow* (cdr l) keys colls tag-prefix tags style title part-depth)]) - (make-part (part-tag-prefix part) - (part-tags part) - (part-title-content part) - (part-style part) - (part-to-collect part) - (make-flow (append para - (flow-paragraphs - (part-flow part)))) - (cons (car l) (part-parts part))))] + [part (decode-flow* (cdr l) keys colls tag-prefix tags vers style title part-depth)]) + (make-versioned-part (part-tag-prefix part) + (part-tags part) + (part-title-content part) + (part-style part) + (part-to-collect part) + (make-flow (append para + (flow-paragraphs + (part-flow part)))) + (cons (car l) (part-parts part)) + (part-version part)))] [(and (part-start? (car l)) (or (not part-depth) ((part-start-depth (car l)) . <= . part-depth))) @@ -156,54 +167,56 @@ (part-start-style s) (part-start-title s) (add1 part-depth))] - [part (decode-flow* l keys colls tag-prefix tags style title part-depth)]) - (make-part (part-tag-prefix part) - (part-tags part) - (part-title-content part) - (part-style part) - (part-to-collect part) - (make-flow para) - (cons s (part-parts part)))) + [part (decode-flow* l keys colls tag-prefix tags vers style title part-depth)]) + (make-versioned-part (part-tag-prefix part) + (part-tags part) + (part-title-content part) + (part-style part) + (part-to-collect part) + (make-flow para) + (cons s (part-parts part)) + (part-version part))) (if (splice? (car l)) (loop (append (splice-run (car l)) (cdr l)) s-accum) (loop (cdr l) (cons (car l) s-accum))))))] [(splice? (car l)) - (loop (append (splice-run (car l)) (cdr l)) next? keys colls accum title tag-prefix tags style)] - [(null? (cdr l)) (loop null #f keys colls (cons (car l) accum) title tag-prefix tags style)] + (loop (append (splice-run (car l)) (cdr l)) next? keys colls accum title tag-prefix tags vers style)] + [(null? (cdr l)) (loop null #f keys colls (cons (car l) accum) title tag-prefix tags vers style)] [(part-index-decl? (car l)) - (loop (cdr l) next? (cons (car l) keys) colls accum title tag-prefix tags style)] + (loop (cdr l) next? (cons (car l) keys) colls accum title tag-prefix tags vers style)] [(part-collect-decl? (car l)) - (loop (cdr l) next? keys (cons (part-collect-decl-element (car l)) colls) accum title tag-prefix tags style)] + (loop (cdr l) next? keys (cons (part-collect-decl-element (car l)) colls) accum title tag-prefix tags vers style)] [(part-tag-decl? (car l)) - (loop (cdr l) next? keys colls accum title tag-prefix (append tags (list (part-tag-decl-tag (car l)))) style)] + (loop (cdr l) next? keys colls accum title tag-prefix (append tags (list (part-tag-decl-tag (car l)))) vers style)] [(and (pair? (cdr l)) (splice? (cadr l))) - (loop (cons (car l) (append (splice-run (cadr l)) (cddr l))) next? keys colls accum title tag-prefix tags style)] + (loop (cons (car l) (append (splice-run (cadr l)) (cddr l))) next? keys colls accum title tag-prefix tags vers style)] [(line-break? (car l)) (if next? - (loop (cdr l) #t keys colls accum title tag-prefix tags style) + (loop (cdr l) #t keys colls accum title tag-prefix tags vers style) (let ([m (match-newline-whitespace (cdr l))]) (if m - (let ([part (loop m #t keys colls null title tag-prefix tags style)]) - (make-part (part-tag-prefix part) - (part-tags part) - (part-title-content part) - (part-style part) - (part-to-collect part) - (make-flow (append (decode-accum-para accum) - (flow-paragraphs (part-flow part)))) - (part-parts part))) - (loop (cdr l) #f keys colls (cons (car l) accum) title tag-prefix tags style))))] - [else (loop (cdr l) #f keys colls (cons (car l) accum) title tag-prefix tags style)]))) + (let ([part (loop m #t keys colls null title tag-prefix tags vers style)]) + (make-versioned-part (part-tag-prefix part) + (part-tags part) + (part-title-content part) + (part-style part) + (part-to-collect part) + (make-flow (append (decode-accum-para accum) + (flow-paragraphs (part-flow part)))) + (part-parts part) + (part-version part))) + (loop (cdr l) #f keys colls (cons (car l) accum) title tag-prefix tags vers style))))] + [else (loop (cdr l) #f keys colls (cons (car l) accum) title tag-prefix tags vers style)]))) (define (decode-part l tags title depth) - (decode-flow* l null null #f tags #f title depth)) + (decode-flow* l null null #f tags #f #f title depth)) (define (decode-styled-part l tag-prefix tags style title depth) - (decode-flow* l null null tag-prefix tags style title depth)) + (decode-flow* l null null tag-prefix tags #f style title depth)) (define (decode-flow l) - (part-flow (decode-flow* l null null #f null #f #f #f))) + (part-flow (decode-flow* l null null #f null #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 e1421d01..06d7c1d9 100644 --- a/collects/scribble/html-render.ss +++ b/collects/scribble/html-render.ss @@ -25,6 +25,7 @@ (define collecting-sub (make-parameter 0)) (define current-no-links (make-parameter #f)) (define extra-breaking? (make-parameter #f)) + (define current-version (make-parameter (version))) (define (path->relative p) (let ([p (path->main-doc-relative p)]) @@ -326,7 +327,7 @@ null (if (part-style? d 'hidden) (map (lambda (t) - `(a ((name ,(format "~a" (anchor-name (tag-key t ri))))))) + `(a ((name ,(format "~a" (anchor-name (tag-key t ri))))))) (part-tags d)) `((,(case (length number) [(0) 'h2] @@ -754,36 +755,53 @@ ri))))) (define/override (render-part d ri) - (let ([number (collected-info-number (part-collected-info d ri))]) - (cond - [(and (not (on-separate-page)) - (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)] - [full-path (build-path (path-only (current-output-file)) - filename)]) - (parameterize ([on-separate-page #t]) - (with-output-to-file full-path - #:exists 'truncate/replace - (lambda () - (render-one-part d ri full-path number))) - null))] - [else - (let ([sep? (on-separate-page)]) - (parameterize ([next-separate-page (toc-part? d)] - [on-separate-page #f]) - (if sep? - ;; Navigation bars; - `(,@(navigation d ri) - (p nbsp) - ,@(super render-part d ri) - (p nbsp) - ,@(navigation d ri) - (p nbsp)) - ;; Normal section render - (super render-part d ri))))]))) + (parameterize ([current-version + (if (and (versioned-part? d) + (versioned-part-version d)) + (versioned-part-version d) + (current-version))]) + (let ([number (collected-info-number (part-collected-info d ri))]) + (cond + [(and (not (on-separate-page)) + (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)] + [full-path (build-path (path-only (current-output-file)) + filename)]) + (parameterize ([on-separate-page #t]) + (with-output-to-file full-path + #:exists 'truncate/replace + (lambda () + (render-one-part d ri full-path number))) + null))] + [else + (let ([sep? (on-separate-page)]) + (parameterize ([next-separate-page (toc-part? d)] + [on-separate-page #f]) + (if sep? + ;; Navigation bars; + `(,@(navigation d ri) + (p nbsp) + ,@(render-table (make-table + "versionbox" + (list + (list + (make-flow + (list + (make-paragraph (list + (make-element "version" + (list "Version: " + (current-version)))))))))) + d + ri) + ,@(super render-part d ri) + (p nbsp) + ,@(navigation d ri) + (p nbsp)) + ;; Normal section render + (super render-part d ri))))])))) (super-new))) diff --git a/collects/scribble/manual.ss b/collects/scribble/manual.ss index c347a057..35833269 100644 --- a/collects/scribble/manual.ss +++ b/collects/scribble/manual.ss @@ -84,6 +84,7 @@ s)) (define-code scheme to-element unsyntax keep-s-expr add-sq-prop) + (define-code SCHEME to-element UNSYNTAX keep-s-expr add-sq-prop) (define-code schemeresult to-element/result unsyntax keep-s-expr add-sq-prop) (define-code schemeid to-element/id unsyntax keep-s-expr add-sq-prop) (define-code *schememodname to-element unsyntax keep-s-expr add-sq-prop) @@ -221,7 +222,7 @@ schemeblock0 SCHEMEBLOCK0 schemeblock0/form schemeinput schememod - scheme scheme/form schemeresult schemeid schememodname + scheme SCHEME scheme/form schemeresult schemeid schememodname defmodule defmodule* defmodulelang defmodulelang* defmodule*/no-declare defmodulelang*/no-declare indexed-scheme diff --git a/collects/scribble/scribble.css b/collects/scribble/scribble.css index 37191585..c7a28acb 100644 --- a/collects/scribble/scribble.css +++ b/collects/scribble/scribble.css @@ -21,6 +21,20 @@ text-align: left; } + .versionbox { + position: relative; + float: right; + left: 3em; + top: -2em; + height: 0em; + width: 13em; + margin: 0em -13em 0em 0em; + } + .version { + font-family: sans-serif; + font-size: 13px; + } + .refpara { font-family: Consolas, Courier, monospace; font-size: 13px; position: relative; diff --git a/collects/scribble/struct.ss b/collects/scribble/struct.ss index a4616ee8..98f45a40 100644 --- a/collects/scribble/struct.ss +++ b/collects/scribble/struct.ss @@ -131,6 +131,7 @@ [flow flow?] [parts (listof part?)])] [(unnumbered-part part) ()] + [(versioned-part part) ([version (or/c string? false/c)])] [flow ([paragraphs (listof flow-element?)])] [paragraph ([content list?])] [(styled-paragraph paragraph) ([style any/c])] diff --git a/collects/scribblings/scribble/basic.scrbl b/collects/scribblings/scribble/basic.scrbl index 65187cbb..125abf15 100644 --- a/collects/scribblings/scribble/basic.scrbl +++ b/collects/scribblings/scribble/basic.scrbl @@ -51,6 +51,7 @@ have @schememodname[scribble/manual]). @defproc[(title [#:tag tag (or/c false/c string?) #f] [#:style style any/c #f] + [#:version vers (or/c string? false/c) #f] [pre-content any/c] ...+) title-decl?]{ @@ -66,9 +67,12 @@ separate pages in multi-page HTML output. A style of @scheme['index] indicates an index section whose body is rendered in two columns for Latex output. -The section title is automatically indexed. For the index key, a -leading ``A'', ``An'', or ``The'' (followed by whitespace) is -removed.} +The @scheme[vers] argument is propagated to the @scheme[title-decl] +structure. + +The section title is automatically indexed by +@scheme[decode-part]. For the index key, a leading ``A'', ``An'', or +``The'' (followed by whitespace) is removed.} @def-section-like[section part-start?]{ Like @scheme[title], but diff --git a/collects/scribblings/scribble/decode.scrbl b/collects/scribblings/scribble/decode.scrbl index a2af53a2..f94a7459 100644 --- a/collects/scribblings/scribble/decode.scrbl +++ b/collects/scribblings/scribble/decode.scrbl @@ -45,14 +45,15 @@ then it is bolded. Decodes a document, producing a part. In @scheme[lst], instances of @scheme[splice] are inlined into the list. An instance of -@scheme[title-decl] supplies the title for the part. Instances of -@scheme[part-index-decl] (that precede any sub-part) add index entries -that point to the section. Instances of @scheme[part-collect-decl] add -elements to the part that are used only during the @techlink{collect -pass}. Instances of @scheme[part-tag-decl] add hyperlink tags to the -section title. Instances of @scheme[part-start] at level 0 trigger -sub-part parsing. Instances of @scheme[section] trigger are used as-is -as subsections, and instances of @scheme[paragraph] and other +@scheme[title-decl] supplies the title for the part, plus tag, style +and version information. Instances of @scheme[part-index-decl] (that +precede any sub-part) add index entries that point to the +section. Instances of @scheme[part-collect-decl] add elements to the +part that are used only during the @techlink{collect pass}. Instances +of @scheme[part-tag-decl] add hyperlink tags to the section +title. Instances of @scheme[part-start] at level 0 trigger sub-part +parsing. Instances of @scheme[section] trigger are used as-is as +subsections, and instances of @scheme[paragraph] and other flow-element datatypes are used as-is in the enclosing flow. } @@ -107,6 +108,7 @@ otherwise. @defstruct[title-decl ([tag-prefix (or/c false/c string?)] [tags (listof string?)] + [version (or/c string? false/c)] [style any/c] [content list?])]{ diff --git a/collects/scribblings/scribble/manual.scrbl b/collects/scribblings/scribble/manual.scrbl index f149da00..1ad0a1e4 100644 --- a/collects/scribblings/scribble/manual.scrbl +++ b/collects/scribblings/scribble/manual.scrbl @@ -110,6 +110,9 @@ module whose language is @scheme[lang].} a single line and wrapped with its enclosing paragraph, independent of the formatting of @scheme[datum].} +@defform[(SCHEME datum ...)]{Like @scheme[scheme], but with the +@scheme[UNSYNTAX] escape like @scheme[schemeblock].} + @defform[(schemeresult datum ...)]{Like @scheme[scheme], but typeset as a REPL value (i.e., a single color with no hyperlinks).} diff --git a/collects/scribblings/scribble/struct.scrbl b/collects/scribblings/scribble/struct.scrbl index 76c000eb..75676766 100644 --- a/collects/scribblings/scribble/struct.scrbl +++ b/collects/scribblings/scribble/struct.scrbl @@ -30,10 +30,11 @@ A document is processed in three passes. The first pass is the A @deftech{part} is an instance of @scheme[part]; among other things, it has a title @techlink{content}, an initial @techlink{flow}, and a list of subsection @techlink{parts}. An @scheme[unnumbered-part] is - the same as a @scheme[part], but it isn't numbered. There's no - difference between a part and a full document; a particular source - module just as easily defines a subsection (incorporated via - @scheme[include-section]) as a document. + the same as a @scheme[part], but it isn't numbered. A + @scheme[versioned-part] is add a version field to + @scheme[part]. There's no difference between a part and a full + document; a particular source module just as easily defines a + subsection (incorporated via @scheme[include-section]) as a document. A @deftech{flow} is an instance of @scheme[flow]; it has a list of @techlink{flow elements}. @@ -260,6 +261,18 @@ during the @techlink{collect pass}, the number is not rendered. } +@defstruct[(versioned-part part) ([version (or/c string? false/c)])]{ + +Supplies a version number for this part and its sub-parts (except as +overridden). A @scheme[#f] version is the same as not supplying a +version. + +The version number may be used when rendering a document. At a +minimum, a version is rendered when it is attached to a part +representing the whole document. The default version for a document is +@scheme[(version)].} + + @defstruct[flow ([paragraphs (listof flow-element?)])]{ A @techlink{flow} has a list of flow elements.