commit f6524e98a9f8df275ee3be4b1e534fdd995866f1
parent 121dc93911a42d3cd9efe1b3772c5cf9a3f64387
Author: Matthew Flatt <mflatt@racket-lang.org>
Date: Mon, 17 Dec 2007 00:28:20 +0000
add 'last' field to picts, and document slideshow/code
svn: r8033
original commit: 67752bc4355b7bec93880f6dbd8750556ee24bc6
Diffstat:
10 files changed, 199 insertions(+), 129 deletions(-)
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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.
