suzanne.soy/scribble-enhanced
1
0
Fork 0
Code Issues 1 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

add 'last' field to picts, and document slideshow/code

Browse Source 
svn: r8033

original commit: 67752bc4355b7bec93880f6dbd8750556ee24bc6
This commit is contained in:
Matthew Flatt 2007-12-17 00:28:20 +00:00
parent 121dc93911
commit f6524e98a9
10 changed files with 199 additions and 129 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
collects/scribble/basic.ss
View File

@ -32,10 +32,11 @@
(apply append (map (lambda (t) (convert-tag t content)) tag)) (apply append (map (lambda (t) (convert-tag t content)) tag))
`((part ,(or tag (gen-tag content)))))) `((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)]) (let ([content (decode-content str)])
(make-title-decl (prefix->string prefix) (make-title-decl (prefix->string prefix)
(convert-tag tag content) (convert-tag tag content)
version
style style
content))) content)))

175
collects/scribble/decode.ss
View File

@ -16,6 +16,7 @@
(provide-structs (provide-structs
[title-decl ([tag-prefix (or/c false/c string?)] [title-decl ([tag-prefix (or/c false/c string?)]
[tags (listof tag?)] [tags (listof tag?)]
[version (or/c string? false/c)]
[style any/c] [style any/c]
[content list?])] [content list?])]
[part-start ([depth integer?] [part-start ([depth integer?]
@ -57,8 +58,14 @@
null null
(list (decode-paragraph (reverse (skip-whitespace accum)))))) (list (decode-paragraph (reverse (skip-whitespace accum))))))
(define (decode-flow* l keys colls tag-prefix tags style title part-depth) (define (part-version p)
(let loop ([l l][next? #f][keys keys][colls colls][accum null][title title][tag-prefix tag-prefix][tags tags][style style]) (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 (cond
[(null? l) [(null? l)
(let ([k-tags (map (lambda (k) (let ([k-tags (map (lambda (k)
@ -67,36 +74,37 @@
[tags (if (null? tags) [tags (if (null? tags)
(list `(part ,(make-generated-tag))) (list `(part ,(make-generated-tag)))
tags)]) tags)])
(make-part tag-prefix (make-versioned-part tag-prefix
(append tags k-tags) (append tags k-tags)
title title
style style
(let ([l (map (lambda (k tag) (let ([l (map (lambda (k tag)
(make-index-element (make-index-element
#f #f
null null
tag tag
(part-index-decl-plain-seq k) (part-index-decl-plain-seq k)
(part-index-decl-entry-seq k) (part-index-decl-entry-seq k)
#f)) #f))
keys k-tags)]) keys k-tags)])
(append (append
(if (and title (not (or (eq? 'hidden style) (if (and title (not (or (eq? 'hidden style)
(and (list? style) (and (list? style)
(memq 'hidden style))))) (memq 'hidden style)))))
(cons (make-index-element (cons (make-index-element
#f #f
null null
(car tags) (car tags)
(list (regexp-replace #px"^(?:A|An|The)\\s" (content->string title) (list (regexp-replace #px"^(?:A|An|The)\\s" (content->string title)
"")) ""))
(list (make-element #f title)) (list (make-element #f title))
(make-part-index-desc)) (make-part-index-desc))
l) l)
l) l)
colls)) colls))
(make-flow (decode-accum-para accum)) (make-flow (decode-accum-para accum))
null))] null
vers))]
[(title-decl? (car l)) [(title-decl? (car l))
(unless part-depth (unless part-depth
(error 'decode (error 'decode
@ -110,31 +118,34 @@
(title-decl-content (car l)) (title-decl-content (car l))
(title-decl-tag-prefix (car l)) (title-decl-tag-prefix (car l))
(title-decl-tags (car l)) (title-decl-tags (car l))
(title-decl-version (car l))
(title-decl-style (car l)))] (title-decl-style (car l)))]
[(flow-element? (car l)) [(flow-element? (car l))
(let ([para (decode-accum-para accum)] (let ([para (decode-accum-para accum)]
[part (decode-flow* (cdr l) keys colls tag-prefix tags style title part-depth)]) [part (decode-flow* (cdr l) keys colls tag-prefix tags vers style title part-depth)])
(make-part (part-tag-prefix part) (make-versioned-part (part-tag-prefix part)
(part-tags part) (part-tags part)
(part-title-content part) (part-title-content part)
(part-style part) (part-style part)
(part-to-collect part) (part-to-collect 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)
(part-version part)))]
[(part? (car l)) [(part? (car l))
(let ([para (decode-accum-para accum)] (let ([para (decode-accum-para accum)]
[part (decode-flow* (cdr l) keys colls tag-prefix tags style title part-depth)]) [part (decode-flow* (cdr l) keys colls tag-prefix tags vers style title part-depth)])
(make-part (part-tag-prefix part) (make-versioned-part (part-tag-prefix part)
(part-tags part) (part-tags part)
(part-title-content part) (part-title-content part)
(part-style part) (part-style part)
(part-to-collect part) (part-to-collect 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))
(part-version 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)))
@ -156,54 +167,56 @@
(part-start-style s) (part-start-style s)
(part-start-title s) (part-start-title s)
(add1 part-depth))] (add1 part-depth))]
[part (decode-flow* l keys colls tag-prefix tags style title part-depth)]) [part (decode-flow* l keys colls tag-prefix tags vers style title part-depth)])
(make-part (part-tag-prefix part) (make-versioned-part (part-tag-prefix part)
(part-tags part) (part-tags part)
(part-title-content part) (part-title-content part)
(part-style part) (part-style part)
(part-to-collect part) (part-to-collect part)
(make-flow para) (make-flow para)
(cons s (part-parts part)))) (cons s (part-parts part))
(part-version part)))
(if (splice? (car l)) (if (splice? (car l))
(loop (append (splice-run (car l)) (cdr l)) s-accum) (loop (append (splice-run (car l)) (cdr l)) s-accum)
(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? keys colls 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 style)] [(null? (cdr l)) (loop null #f keys colls (cons (car l) accum) title tag-prefix tags vers style)]
[(part-index-decl? (car l)) [(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)) [(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)) [(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)) [(and (pair? (cdr l))
(splice? (cadr 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)) [(line-break? (car l))
(if next? (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))]) (let ([m (match-newline-whitespace (cdr l))])
(if m (if m
(let ([part (loop m #t keys colls null title tag-prefix tags style)]) (let ([part (loop m #t keys colls null title tag-prefix tags vers style)])
(make-part (part-tag-prefix part) (make-versioned-part (part-tag-prefix part)
(part-tags part) (part-tags part)
(part-title-content part) (part-title-content part)
(part-style part) (part-style part)
(part-to-collect part) (part-to-collect 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 keys colls (cons (car l) accum) title tag-prefix tags style))))] (part-version part)))
[else (loop (cdr l) #f keys colls (cons (car l) accum) title tag-prefix tags style)]))) (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) (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) (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) (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) (define (match-newline-whitespace l)
(cond (cond

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

@ -25,6 +25,7 @@
(define collecting-sub (make-parameter 0)) (define collecting-sub (make-parameter 0))
(define current-no-links (make-parameter #f)) (define current-no-links (make-parameter #f))
(define extra-breaking? (make-parameter #f)) (define extra-breaking? (make-parameter #f))
(define current-version (make-parameter (version)))
(define (path->relative p) (define (path->relative p)
(let ([p (path->main-doc-relative p)]) (let ([p (path->main-doc-relative p)])
@ -326,7 +327,7 @@
null null
(if (part-style? d 'hidden) (if (part-style? d 'hidden)
(map (lambda (t) (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)) (part-tags d))
`((,(case (length number) `((,(case (length number)
[(0) 'h2] [(0) 'h2]
@ -754,36 +755,53 @@
ri))))) ri)))))
(define/override (render-part d ri) (define/override (render-part d ri)
(let ([number (collected-info-number (part-collected-info d ri))]) (parameterize ([current-version
(cond (if (and (versioned-part? d)
[(and (not (on-separate-page)) (versioned-part-version d))
(or (= 1 (length number)) (versioned-part-version d)
(next-separate-page))) (current-version))])
;; Render as just a link, and put the actual (let ([number (collected-info-number (part-collected-info d ri))])
;; content in a new file: (cond
(let* ([filename (derive-filename d)] [(and (not (on-separate-page))
[full-path (build-path (path-only (current-output-file)) (or (= 1 (length number))
filename)]) (next-separate-page)))
(parameterize ([on-separate-page #t]) ;; Render as just a link, and put the actual
(with-output-to-file full-path ;; content in a new file:
#:exists 'truncate/replace (let* ([filename (derive-filename d)]
(lambda () [full-path (build-path (path-only (current-output-file))
(render-one-part d ri full-path number))) filename)])
null))] (parameterize ([on-separate-page #t])
[else (with-output-to-file full-path
(let ([sep? (on-separate-page)]) #:exists 'truncate/replace
(parameterize ([next-separate-page (toc-part? d)] (lambda ()
[on-separate-page #f]) (render-one-part d ri full-path number)))
(if sep? null))]
;; Navigation bars; [else
`(,@(navigation d ri) (let ([sep? (on-separate-page)])
(p nbsp) (parameterize ([next-separate-page (toc-part? d)]
,@(super render-part d ri) [on-separate-page #f])
(p nbsp) (if sep?
,@(navigation d ri) ;; Navigation bars;
(p nbsp)) `(,@(navigation d ri)
;; Normal section render (p nbsp)
(super render-part d ri))))]))) ,@(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))) (super-new)))

3
collects/scribble/manual.ss
View File

@ -84,6 +84,7 @@
s)) 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 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 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 schemeid to-element/id unsyntax keep-s-expr add-sq-prop)
(define-code *schememodname to-element 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 schemeblock0 SCHEMEBLOCK0 schemeblock0/form
schemeinput schemeinput
schememod schememod
scheme scheme/form schemeresult schemeid schememodname scheme SCHEME scheme/form schemeresult schemeid schememodname
defmodule defmodule* defmodulelang defmodulelang* defmodule defmodule* defmodulelang defmodulelang*
defmodule*/no-declare defmodulelang*/no-declare defmodule*/no-declare defmodulelang*/no-declare
indexed-scheme indexed-scheme

14
collects/scribble/scribble.css
View File

@ -21,6 +21,20 @@
text-align: left; 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 { .refpara {
font-family: Consolas, Courier, monospace; font-size: 13px; font-family: Consolas, Courier, monospace; font-size: 13px;
position: relative; position: relative;

1
collects/scribble/struct.ss
View File

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

10
collects/scribblings/scribble/basic.scrbl
View File

@ -51,6 +51,7 @@ have @schememodname[scribble/manual]).
@defproc[(title [#:tag tag (or/c false/c string?) #f] @defproc[(title [#:tag tag (or/c false/c string?) #f]
[#:style style any/c #f] [#:style style any/c #f]
[#:version vers (or/c string? false/c) #f]
[pre-content any/c] ...+) [pre-content any/c] ...+)
title-decl?]{ 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 indicates an index section whose body is rendered in two columns for
Latex output. Latex output.
The section title is automatically indexed. For the index key, a The @scheme[vers] argument is propagated to the @scheme[title-decl]
leading ``A'', ``An'', or ``The'' (followed by whitespace) is structure.
removed.}
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 @def-section-like[section part-start?]{ Like @scheme[title], but

18
collects/scribblings/scribble/decode.scrbl
View File

@ -45,14 +45,15 @@ then it is bolded.
Decodes a document, producing a part. In @scheme[lst], instances of Decodes a document, producing a part. In @scheme[lst], instances of
@scheme[splice] are inlined into the list. An instance of @scheme[splice] are inlined into the list. An instance of
@scheme[title-decl] supplies the title for the part. Instances of @scheme[title-decl] supplies the title for the part, plus tag, style
@scheme[part-index-decl] (that precede any sub-part) add index entries and version information. Instances of @scheme[part-index-decl] (that
that point to the section. Instances of @scheme[part-collect-decl] add precede any sub-part) add index entries that point to the
elements to the part that are used only during the @techlink{collect section. Instances of @scheme[part-collect-decl] add elements to the
pass}. Instances of @scheme[part-tag-decl] add hyperlink tags to the part that are used only during the @techlink{collect pass}. Instances
section title. Instances of @scheme[part-start] at level 0 trigger of @scheme[part-tag-decl] add hyperlink tags to the section
sub-part parsing. Instances of @scheme[section] trigger are used as-is title. Instances of @scheme[part-start] at level 0 trigger sub-part
as subsections, and instances of @scheme[paragraph] and other 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. 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?)] @defstruct[title-decl ([tag-prefix (or/c false/c string?)]
[tags (listof string?)] [tags (listof string?)]
[version (or/c string? false/c)]
[style any/c] [style any/c]
[content list?])]{ [content list?])]{

3
collects/scribblings/scribble/manual.scrbl
View File

@ -110,6 +110,9 @@ module whose language is @scheme[lang].}
a single line and wrapped with its enclosing paragraph, independent of a single line and wrapped with its enclosing paragraph, independent of
the formatting of @scheme[datum].} 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 @defform[(schemeresult datum ...)]{Like @scheme[scheme], but typeset
as a REPL value (i.e., a single color with no hyperlinks).} as a REPL value (i.e., a single color with no hyperlinks).}

21
collects/scribblings/scribble/struct.scrbl
View File

@ -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, A @deftech{part} is an instance of @scheme[part]; among other things,
it has a title @techlink{content}, an initial @techlink{flow}, and a it has a title @techlink{content}, an initial @techlink{flow}, and a
list of subsection @techlink{parts}. An @scheme[unnumbered-part] is list of subsection @techlink{parts}. An @scheme[unnumbered-part] is
the same as a @scheme[part], but it isn't numbered. There's no the same as a @scheme[part], but it isn't numbered. A
difference between a part and a full document; a particular source @scheme[versioned-part] is add a version field to
module just as easily defines a subsection (incorporated via @scheme[part]. There's no difference between a part and a full
@scheme[include-section]) as a document. 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 A @deftech{flow} is an instance of @scheme[flow]; it has a list of
@techlink{flow elements}. @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?)])]{ @defstruct[flow ([paragraphs (listof flow-element?)])]{
A @techlink{flow} has a list of flow elements. A @techlink{flow} has a list of flow elements.