add 'last' field to picts, and document slideshow/code
svn: r8033
This commit is contained in:
Matthew Flatt
parent
116241eee5
commit
67752bc435
|
|
@ -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)))
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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])]
|
||||
|
|
|
|||
|
|
@ -53,7 +53,7 @@ function consumes.
|
|||
Like @scheme[apply], but @scheme[kw-lst] and @scheme[kw-val-lst]
|
||||
supply by-keyword arguments in addition to the by-position arguments
|
||||
of the @scheme[v]s and @scheme[lst]. The given @scheme[kw-lst] must be
|
||||
sorted using @scheme[keyword<], and no keyword can appear twice in
|
||||
sorted using @scheme[keyword<?], and no keyword can appear twice in
|
||||
@scheme[kw-lst], otherwise, the @exnraise[exn:fail:contract]. The
|
||||
given @scheme[kw-val-lst] must have the same length as
|
||||
@scheme[kw-lst], otherwise, the @exnraise[exn:fail:contract]. The
|
||||
|
|
@ -136,9 +136,9 @@ in @scheme[(procedure-arity proc)], the @exnraise[exn:fail:contract].}
|
|||
|
||||
Returns information about the keyword arguments required and accepted
|
||||
by a procedure. The first result is a list of keywords (sorted by
|
||||
@scheme[keyword<]) that are required when applying @scheme[proc]. The
|
||||
@scheme[keyword<?]) that are required when applying @scheme[proc]. The
|
||||
second result is a list of accepted keywords (sorted by
|
||||
@scheme[keyword<]), or @scheme[#f] to mean that any keyword is
|
||||
@scheme[keyword<?]), or @scheme[#f] to mean that any keyword is
|
||||
accepted. When the second result is a list, every element in the first
|
||||
list is also in the second list.
|
||||
|
||||
|
|
@ -150,7 +150,7 @@ list is also in the second list.
|
|||
|
||||
@defproc[(make-keyword-procedure
|
||||
[proc (((listof keyword?) list?) list? . ->* . any)]
|
||||
[plain-proc procedure? (lambda args (apply proc null null args))])
|
||||
[plain-proc procedure? (lambda args (keyword-apply proc null null args))])
|
||||
procedure?]{
|
||||
|
||||
Returns a procedure that accepts all keyword arguments (without
|
||||
|
|
@ -158,7 +158,7 @@ requiring any keyword arguments).
|
|||
|
||||
When the result is called with keyword arguments, then @scheme[proc]
|
||||
is called; the first argument is a list of keywords sorted by
|
||||
@scheme[keyword<], the second argument is a parallel list containing a
|
||||
@scheme[keyword<?], the second argument is a parallel list containing a
|
||||
value for each keyword, and the remaining arguments are the
|
||||
by-position arguments.
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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?])]{
|
||||
|
||||
|
|
|
|||
|
|
@ -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).}
|
||||
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
293
collects/scribblings/slideshow/code.scrbl
Normal file
293
collects/scribblings/slideshow/code.scrbl
Normal file
|
|
@ -0,0 +1,293 @@
|
|||
#lang scribble/doc
|
||||
@(require "ss.ss"
|
||||
(for-label slideshow/code
|
||||
scheme/gui/base))
|
||||
|
||||
@(define stx-obj
|
||||
(tech #:doc '(lib "scribblings/reference/reference.scrbl") "syntax object"))
|
||||
|
||||
@title{Typesetting Scheme Code}
|
||||
|
||||
@defmodule[slideshow/code]{The @scheme[slideshow/code] library
|
||||
provides utilities for typesetting Scheme code as a pict.}
|
||||
|
||||
@defproc[(typeset-code [stx syntax?]) pict?]{
|
||||
|
||||
Produces a pict for code in the given @|stx-obj|. The
|
||||
source-location information of the syntax object determines the line
|
||||
breaks, line indenting, and space within a row. Empty rows are
|
||||
ignored.
|
||||
|
||||
Beware that if you use @scheme[read-syntax] on a file port, you may
|
||||
have to turn on line counting via @scheme[port-count-lines!] for the
|
||||
code to typeset properly. Also beware that when a source file
|
||||
containing a @scheme[syntax] or @scheme[quote-syntax] form is
|
||||
compiled, source location information is omitted from the compiled
|
||||
@|stx-obj|.
|
||||
|
||||
Normally, @scheme[typeset-code] is used through the @scheme[code]
|
||||
syntactic form, which works properly with compilation, and that
|
||||
escapes to pict-producing code via @scheme[unsyntax]. See also
|
||||
@scheme[define-code].
|
||||
|
||||
Embedded picts within @scheme[stx] are used directly. Row elements are
|
||||
combined using and operator like @scheme[htl-append], so use
|
||||
@scheme[code-align] (see below) as necessary to add an ascent to
|
||||
ascentless picts. More precisely, creation of a line of code uses
|
||||
@scheme[pict-last] to determine the end point of the element most
|
||||
recently added to a line; the main effect is that closing parentheses
|
||||
are attached in the right place when a multi-line pict is embedded in
|
||||
@scheme[stx].
|
||||
|
||||
An identifier that starts with @litchar{_} is italicized in the pict,
|
||||
and the @litchar{_} is dropped, unless the
|
||||
@scheme[code-italic-underscore-enabled] parameter is set to
|
||||
@scheme[#f]. Also, unless @scheme[code-scripts-enabled] is set to
|
||||
@scheme[#f], @litchar{_} and @litchar{^} in the middle of a word
|
||||
create superscripts and subscripts, respectively (like TeX); for
|
||||
example @schemeidfont{foo^4_ok} is displayed as the identifier
|
||||
@schemeidfont{foo} with a @schemeidfont{4} superscript and an
|
||||
@schemeidfont{ok} subscript.
|
||||
|
||||
Further, uses of certain identifiers in @scheme[stx] typeset
|
||||
specially:
|
||||
|
||||
@itemize{
|
||||
|
||||
@item{@as-index{@schemeidfont{code:blank}} --- produces a space.}
|
||||
|
||||
@item{@scheme[(#,(as-index (schemeidfont "code:comment")) _s ...)]
|
||||
--- produces a comment block, with each @scheme[_s] on its own line,
|
||||
where each @scheme[_s] must be a string or a pict.}
|
||||
|
||||
@item{@scheme[(#,(as-index (schemeidfont "code:line")) _datum ...)]
|
||||
--- typesets the @scheme[_datum] sequence, which is mostly useful for
|
||||
the top-level sequence, since @scheme[typeset-code] accepts only one
|
||||
argument.}
|
||||
|
||||
@item{@scheme[(#,(as-index (schemeidfont "code:contract")) _datum
|
||||
...)] --- like @schemeidfont{code:line}, but every @scheme[_datum]
|
||||
is colored as a comment, and a @litchar{;} is prefixed to every line.}
|
||||
|
||||
@item{@scheme[(#,(as-index (schemeidfont "code:template")) _datum
|
||||
...)] --- like @schemeidfont{code:line}, but a @litchar{;} is
|
||||
prefixed to every line.}
|
||||
|
||||
@item{@schemeidfont{$} --- typesets as a vertical bar (for no
|
||||
particularly good reason).}
|
||||
|
||||
}}
|
||||
|
||||
|
||||
@defform[(code datum ...)]{
|
||||
|
||||
The macro form of @scheme[typeset-code]. Within a @scheme[datum],
|
||||
@scheme[unsyntax] can be used to escape to an expression.
|
||||
|
||||
For more information, see @scheme[typeset-code] and
|
||||
@scheme[define-code], since @scheme[code] is defined as
|
||||
|
||||
@schemeblock[
|
||||
(define-code code typeset-code)
|
||||
]}
|
||||
|
||||
|
||||
@defparam[current-code-font style text-style/c]{
|
||||
|
||||
Parameter for a base font used to typeset text. The default is
|
||||
@scheme[`(bold . modern)]. For even more control, see
|
||||
@scheme[current-code-tt].}
|
||||
|
||||
|
||||
@defparam[current-code-tt proc (string? . -> . pict?)]{
|
||||
|
||||
Parameter for a one-argument procedure to turn a
|
||||
string into a pict, used to typeset text. The default is
|
||||
|
||||
@schemeblock[
|
||||
(lambda (s) (text s (current-code-font) (current-font-size)))
|
||||
]
|
||||
|
||||
This procedure is not used to typeset subscripts or other items that
|
||||
require font changes, where @scheme[current-code-font] is used
|
||||
directly.}
|
||||
|
||||
|
||||
@defparam[current-code-line-sep amt real?]{
|
||||
|
||||
A parameter that determines the spacing between lines of typeset code.
|
||||
The default is @scheme[2].}
|
||||
|
||||
|
||||
@defparam[current-comment-color color (or/c string? (is-a?/c color%))]{
|
||||
|
||||
A parameter for the color of comments.}
|
||||
|
||||
|
||||
@defparam[current-keyword-color color (or/c string? (is-a?/c color%))]{
|
||||
|
||||
A parameter for the color of syntactic-form names. See
|
||||
@scheme[current-keyword-list].}
|
||||
|
||||
|
||||
@defparam[current-id-color color (or/c string? (is-a?/c color%))]{
|
||||
|
||||
A parameter for the color of identifiers that are not syntactic form
|
||||
names or constants.}
|
||||
|
||||
|
||||
@defparam[current-literal-color color (or/c string? (is-a?/c color%))]{
|
||||
|
||||
A parameter for the color of literal values, such as strings and
|
||||
numbers. See also @scheme[current-literal-list]}
|
||||
|
||||
|
||||
@defparam[current-const-color color (or/c string? (is-a?/c color%))]{
|
||||
|
||||
A parameter for the color of constant names. See
|
||||
@scheme[current-const-list].}
|
||||
|
||||
|
||||
@defparam[current-base-color color (or/c string? (is-a?/c color%))]{
|
||||
|
||||
A parameter for the color of everything else.}
|
||||
|
||||
|
||||
@defparam[current-reader-forms syms (listof symbol?)]{
|
||||
|
||||
Parameter for a list of symbols indicating which built-in reader forms
|
||||
should be used. The default is @scheme['(quote quasiquote unquote
|
||||
unquote-splicing syntax quasisyntax unsyntax unsyntax-splicing)].
|
||||
Remove a symbol to suppress the corresponding reader output.}
|
||||
|
||||
|
||||
@defproc[(code-align [pict pict?]) pict?]{
|
||||
|
||||
Adjusts the ascent of @scheme[pict] so that its bottom aligns with the
|
||||
baseline for text; use this function when @scheme[pict] has no
|
||||
ascent.}
|
||||
|
||||
|
||||
@defparam[current-keyword-list names (listof string?)]{
|
||||
|
||||
A list of strings to color as syntactic-form names. The default
|
||||
includes most of the forms provided by @scheme[scheme/base].}
|
||||
|
||||
|
||||
@defparam[current-const-list names (listof string?)]{
|
||||
|
||||
A list of strings to color as constant names. The default is
|
||||
@scheme[null].}
|
||||
|
||||
|
||||
@defparam[current-literal-list names (listof string?)]{
|
||||
|
||||
A list of strings to color as literals, in addition to literals such
|
||||
as strings. The default is @scheme[null].}
|
||||
|
||||
@defthing[mzscheme-const-list (listof string?)]{
|
||||
|
||||
A list of strings that could be used to initialize the
|
||||
@scheme[current-const-list] parameter.}
|
||||
|
||||
@defboolparam[code-colorize-enabled on?]{
|
||||
|
||||
A parameter to enable or disable all code coloring. The default is
|
||||
@scheme[#t].}
|
||||
|
||||
|
||||
@defboolparam[code-colorize-quote-enabled on?]{
|
||||
|
||||
A parameter to control whether under a @scheme[quote] is colorized as
|
||||
a literal (as in this documentation). The default is @scheme[#t].}
|
||||
|
||||
|
||||
@defboolparam[code-italic-underscore-enabled on?]{
|
||||
|
||||
A parameter to control whether @litchar{_}-prefixed identifiers are
|
||||
italicized (dropping the @litchar{_}). The default is @scheme[#t].}
|
||||
|
||||
@defboolparam[code-scripts-enabled on?]{
|
||||
|
||||
A parameter to control whether TeX-style subscripts and subscripts are
|
||||
recognized in an identifier.}
|
||||
|
||||
@defform*[[(define-code code-id typeset-code-id)
|
||||
(define-code code-id typeset-code-id escape-id)]]{
|
||||
|
||||
Defines @scheme[code-id] as a macro that uses
|
||||
@scheme[typeset-code-id], which is a function with the same input as
|
||||
@scheme[typeset-code]. The @scheme[escape-id] form defaults to
|
||||
@scheme[unsyntax].
|
||||
|
||||
The resulting @scheme[code-id] syntactic form takes a sequence of
|
||||
@scheme[_datum]s:
|
||||
|
||||
@schemeblock[
|
||||
(code-id _datum ...)
|
||||
]
|
||||
|
||||
It produces a pict that typesets the sequence. Source-location
|
||||
information for the @scheme[_datum] determines the layout of code in
|
||||
the resulting pict. The @scheme[code-id] is expanded in such a way
|
||||
that source location is preserved during compilation (so
|
||||
@scheme[typeset-code-id] receives a syntax object with source
|
||||
locations intact).
|
||||
|
||||
If a @scheme[_datum] contains @scheme[(escape-id _expr)]---perhaps as
|
||||
@SCHEME[#,_expr] when @scheme[escape-id] is @scheme[unsyntax]---then
|
||||
the @scheme[_expr] is evaluated and the result datum is spliced in
|
||||
place of the @scheme[escape-id] form in @scheme[_datum]. If the result
|
||||
is not a syntax object, it is given the source location of the
|
||||
@scheme[escape-id] form. A pict value intected this way as a
|
||||
@scheme[_datum] is rendered as itself.}
|
||||
|
||||
|
||||
@defform[(define-exec-code (pict-id runnable-id string-id)
|
||||
datum ...)]{
|
||||
|
||||
Binds @scheme[pict-id] to the result of @scheme[(code datum ...)],
|
||||
except that if an identifier @schemeidfont{_} appears anywhere in a
|
||||
@scheme[datum], then the identifier and the following expression are
|
||||
not included for @scheme[code].
|
||||
|
||||
Meanwhile, @scheme[runnable-id] is bound to a @|stx-obj| that wraps
|
||||
the @scheme[datum]s in a @scheme[begin]. In this case,
|
||||
@schemeidfont{_}s are removed from the @scheme[datum]s, but not the
|
||||
following expression. Thus, an @schemeidfont{_} identifier is used to
|
||||
comment out an expression from the pict, but have it present in the
|
||||
@|stx-obj| for evaluation.
|
||||
|
||||
The @scheme[string-id] is bound to a string representation of the code
|
||||
that is in the pict. This string is useful for copying to the
|
||||
clipboard with @scheme[(send the-clipboard set-clipboard-string
|
||||
string-id 0)].}
|
||||
|
||||
|
||||
@defform[(define-exec-code/scale scale-expr (pict-id runnable-id string-id)
|
||||
datum ...)]{
|
||||
|
||||
Like @scheme[define-exec-code], but with a scale to use via
|
||||
@scheme[scale/improve-new-text] when generating the pict.}
|
||||
|
||||
|
||||
@deftogether[(
|
||||
@defthing[comment-color (or/c string? (is-a?/c color%))]
|
||||
@defthing[keyword-color (or/c string? (is-a?/c color%))]
|
||||
@defthing[id-color (or/c string? (is-a?/c color%))]
|
||||
@defthing[literal-color (or/c string? (is-a?/c color%))]
|
||||
)]{
|
||||
|
||||
For backward compatibility, the default values for
|
||||
@scheme[current-comment-color], etc.}
|
||||
|
||||
@defproc[(code-pict-bottom-line-pict [pict pict?])
|
||||
(or/c pict? false/c)]{
|
||||
|
||||
The same as @scheme[pict-last], provided for backward compatibility.}
|
||||
|
||||
@defproc[(pict->code-pict [pict pict?] [bl-pict (or/c pict? false/c)]) pict?]{
|
||||
|
||||
Mainly for backward compatibility: returns @scheme[(if bl-pict
|
||||
(use-last pict (or (pict-last bl-pict) bl-pict)))].}
|
||||
|
||||
|
|
@ -1,6 +1,7 @@
|
|||
#lang scribble/doc
|
||||
@(require "ss.ss"
|
||||
(for-label mred
|
||||
slideshow/code
|
||||
slideshow/flash
|
||||
slideshow/face
|
||||
slideshow/balloon))
|
||||
|
|
@ -39,7 +40,7 @@ In addition to its drawing part, a pict has the following
|
|||
| | a \
|
||||
|------------------| |
|
||||
| | | h
|
||||
|------------------| |
|
||||
|----------last----| |
|
||||
| | d /
|
||||
------------------
|
||||
EOS
|
||||
|
|
@ -52,6 +53,12 @@ with a function like @scheme[vc-append]), @math{a} is the ascent of
|
|||
the top line, and @math{d} is the descent of the bottom line, so
|
||||
@math{a+d<h}. Many picts have @math{d=0} and @math{a=h}.
|
||||
|
||||
In addition, a pict can have a @defterm{last} sub-pict that
|
||||
corresponds to the last item on the last line of text, so that extra
|
||||
lines can be added to the last line. In particular, the @defterm{last}
|
||||
element is useful for adding closing parentheses to a block of Scheme
|
||||
code, where the last line of code not the longest line in the block.
|
||||
|
||||
The size information for a pict is computed when the pict is
|
||||
created. This strategy supports programs that create new picts though
|
||||
arbitrarily complex computations on the size and shape of existing
|
||||
|
|
@ -66,7 +73,8 @@ information from a pict.
|
|||
[ascent real?]
|
||||
[descent real?]
|
||||
[children (listof child?)]
|
||||
[panbox (or/c false/c any/c)])]{
|
||||
[panbox (or/c false/c any/c)]
|
||||
[last (or/c false/c pict?)])]{
|
||||
|
||||
A @scheme[pict] structure is normally not created directly with
|
||||
@scheme[make-pict]. Instead, functions like @scheme[text],
|
||||
|
|
@ -81,7 +89,12 @@ will be set for a suitable default drawing mode, and the
|
|||
@scheme[dc<%>] scale will be set to scale the resulting image.
|
||||
|
||||
The @scheme[panbox] field is internal, and it should be ininitialized
|
||||
to @scheme[#f].}
|
||||
to @scheme[#f].
|
||||
|
||||
The @scheme[last] field indicates a pict within the @scheme[children]
|
||||
list (transitively) that can be treated as the last element of the
|
||||
last line in the pict. A @scheme[#f] value means that the pict is its
|
||||
own last sub-pict.}
|
||||
|
||||
|
||||
@defstruct[child ([pict pict?]
|
||||
|
|
@ -89,6 +102,7 @@ to @scheme[#f].}
|
|||
[dy real?]
|
||||
[sx real?]
|
||||
[sy real?])]{
|
||||
|
||||
Records, for a pict constructed of other picts, the relative location
|
||||
and scale of one nested pict.
|
||||
|
||||
|
|
@ -335,7 +349,10 @@ pictures.
|
|||
The descent of the result corresponds to baseline that is lowest in
|
||||
the result among all of the picts' descent-specified baselines;
|
||||
similarly, the ascent of the result corresponds to the highest
|
||||
ascent-specified baseline.}
|
||||
ascent-specified baseline. If at least one @scheme[pict] is supplied,
|
||||
then the last element (as reported by @scheme[pict-last]) for the
|
||||
result is @scheme[(or (pict-last pict) pict)] for the using last
|
||||
supplied @scheme[pict].}
|
||||
|
||||
@defproc*[([(lt-superimpose [pict pict?] ...) pict?]
|
||||
[(ltl-superimpose [pict pict?] ...) pict?]
|
||||
|
|
@ -360,7 +377,11 @@ alignment.
|
|||
The descent of the result corresponds to baseline that is lowest in
|
||||
the result among all of the picts' descent-specified baselines;
|
||||
similarly, the ascent of the result corresponds to the highest
|
||||
ascent-specified baseline.}
|
||||
ascent-specified baseline. The last element (as reported by
|
||||
@scheme[pict-last]) for the result is the lowest, right-most among the
|
||||
last-element picts of the @scheme[pict] arguments, as determined by
|
||||
comparing the last-element bottom-right corners.}
|
||||
|
||||
|
||||
@defproc*[([(pin-over [base pict?] [dx real?] [dy real?] [pict pict?])
|
||||
pict?]
|
||||
|
|
@ -378,6 +399,7 @@ pict's corner is from the first pict's corner. Alternately, the
|
|||
@scheme[base] for @scheme[find-pict]; the @scheme[find] procedure
|
||||
should be something like @scheme[lt-find].}
|
||||
|
||||
|
||||
@defproc*[([(pin-under [base pict?] [dx real?] [dy real?] [pict pict?])
|
||||
pict?]
|
||||
[(pin-under [base pict?]
|
||||
|
|
@ -389,6 +411,7 @@ should be something like @scheme[lt-find].}
|
|||
Like @scheme[pin-over], but @scheme[pict] is drawn before
|
||||
@scheme[base] in the resulting combination.}
|
||||
|
||||
|
||||
@defproc[(table [ncols exact-positive-integer?]
|
||||
[picts (listof pict?)]
|
||||
[col-aligns (table-list-of (pict? pict? -> pict?))]
|
||||
|
|
@ -516,13 +539,20 @@ Makes the descent @scheme[0] and the ascent the same as the height.}
|
|||
|
||||
Assuming that @scheme[sub-pict] can be found within @scheme[pict],
|
||||
shifts the overall bounding box to that of @scheme[sub-pict] (but
|
||||
preserving all the drawing of @scheme[pict]).}
|
||||
preserving all the drawing of @scheme[pict]). The last element, as
|
||||
reported by @scheme[pict-last] is also set to @scheme[(or (pict-last
|
||||
sub-pict) sub-pict)].}
|
||||
|
||||
@defproc[(panorama [pict pict?]) pict?]{
|
||||
|
||||
Shifts the given pict's bounding box to enclose the bounding boxes of
|
||||
all sub-picts (even @scheme[launder]ed picts).}
|
||||
|
||||
@defproc[(use-last [pict pict?] [sub-pict pict?]) pict?]{
|
||||
|
||||
Returns a pict like @scheme[pict], but with the last element (as
|
||||
reported by @scheme[pict-last]) set to @scheme[sub-pict]. The
|
||||
@scheme[sub-pict] must exist as a sub-pict within @scheme[pict].}
|
||||
|
||||
@; ------------------------------------------------------------------------
|
||||
|
||||
|
|
|
|||
|
|
@ -26,6 +26,7 @@ the manual are provided by the @schememodname[slideshow] language.}
|
|||
@include-section["guide.scrbl"]
|
||||
@include-section["picts.scrbl"]
|
||||
@include-section["slides.scrbl"]
|
||||
@include-section["code.scrbl"]
|
||||
|
||||
@(bibliography
|
||||
(bib-entry #:key "Findler06"
|
||||
|
|
|
|||
|
|
@ -219,13 +219,16 @@
|
|||
[tags (if (member '(part "top") (part-tags v))
|
||||
(part-tags v)
|
||||
(cons '(part "top") (part-tags v)))])
|
||||
(make-part tag-prefix
|
||||
tags
|
||||
(part-title-content v)
|
||||
(part-style v)
|
||||
(part-to-collect v)
|
||||
(part-flow v)
|
||||
(part-parts v)))))
|
||||
(make-versioned-part tag-prefix
|
||||
tags
|
||||
(part-title-content v)
|
||||
(part-style v)
|
||||
(part-to-collect v)
|
||||
(part-flow v)
|
||||
(part-parts v)
|
||||
(if (versioned-part? v)
|
||||
(versioned-part-version v)
|
||||
#f)))))
|
||||
|
||||
(define ((get-doc-info only-dirs latex-dest) doc)
|
||||
(let ([info-out-file (build-path (or latex-dest (doc-dest-dir doc)) "out.sxref")]
|
||||
|
|
|
|||
|
|
@ -5,11 +5,15 @@
|
|||
(require-for-syntax (lib "to-string.ss" "syntax")
|
||||
(lib "list.ss"))
|
||||
|
||||
(define current-code-line-sep (make-parameter line-sep))
|
||||
|
||||
(define-values/invoke-unit/infer code@)
|
||||
|
||||
(define-code code typeset-code)
|
||||
|
||||
(provide code)
|
||||
(provide code
|
||||
current-code-line-sep
|
||||
define-code)
|
||||
(provide-signature-elements code^)
|
||||
|
||||
(provide define-exec-code/scale
|
||||
|
|
|
|||
|
|
@ -7,20 +7,17 @@
|
|||
|
||||
(provide define-code code^ code-params^ code@)
|
||||
|
||||
(define-struct (code-pict pict) (bottom-line))
|
||||
|
||||
|
||||
(define (to-code-pict p extension)
|
||||
(make-code-pict (pict-draw p)
|
||||
(pict-width p)
|
||||
(pict-height p)
|
||||
(pict-ascent p)
|
||||
(pict-descent p)
|
||||
(pict-children p)
|
||||
(pict-panbox p)
|
||||
(if (code-pict? extension)
|
||||
(code-pict-bottom-line extension)
|
||||
extension)))
|
||||
(let ([last (pict-last extension)])
|
||||
(if last
|
||||
(use-last p last)
|
||||
(use-last p extension))))
|
||||
|
||||
(define (code-pict? p)
|
||||
(and (pict-last p) #t))
|
||||
|
||||
(define (code-pict-bottom-line p)
|
||||
(pict-last p))
|
||||
|
||||
(define (make-code-append htl-append)
|
||||
(case-lambda
|
||||
|
|
@ -105,7 +102,7 @@
|
|||
|
||||
(define-signature code-params^
|
||||
(current-font-size
|
||||
line-sep))
|
||||
current-code-line-sep))
|
||||
|
||||
(define-syntax (define-computed stx)
|
||||
(syntax-case stx ()
|
||||
|
|
@ -144,10 +141,8 @@
|
|||
(to-code-pict p bottom-line)
|
||||
p))
|
||||
|
||||
(define mzscheme-ns (let ([n (make-namespace 'empty)]
|
||||
[orig (current-namespace)])
|
||||
(define mzscheme-ns (let ([n (make-namespace)])
|
||||
(parameterize ([current-namespace n])
|
||||
(namespace-attach-module orig 'mzscheme)
|
||||
(namespace-require/copy 'mzscheme))
|
||||
n))
|
||||
(define mzscheme-bindings (namespace-mapped-symbols mzscheme-ns))
|
||||
|
|
@ -278,7 +273,7 @@
|
|||
(define (pad-bottom space p)
|
||||
(if (= 0 space)
|
||||
p
|
||||
(code-vl-append line-sep (tt " ") (pad-bottom (sub1 space) p))))
|
||||
(code-vl-append (current-code-line-sep) (tt " ") (pad-bottom (sub1 space) p))))
|
||||
|
||||
(define (colorize-id str mode)
|
||||
(cond
|
||||
|
|
@ -347,7 +342,7 @@
|
|||
(define (add-semis p)
|
||||
(let loop ([p p] [semis (color-semi-p)])
|
||||
(if ((pict-height p) . > . (+ (pict-height semis) 1))
|
||||
(loop p (vl-append line-sep (color-semi-p) semis))
|
||||
(loop p (vl-append (current-code-line-sep) (color-semi-p) semis))
|
||||
(htl-append semis p))))
|
||||
|
||||
(define (add-unquote unquote-p loop x closes mode)
|
||||
|
|
@ -481,7 +476,7 @@
|
|||
[else
|
||||
;; Start on next line:
|
||||
(code-vl-append
|
||||
line-sep
|
||||
(current-code-line-sep)
|
||||
line-so-far
|
||||
(let* ([space (max 0 (- (or (syntax-column (car stxs)) 0) left))]
|
||||
[p
|
||||
|
|
|
|||
|
|
@ -3,7 +3,7 @@
|
|||
|
||||
(provide texpict-common^)
|
||||
(define-signature texpict-common^
|
||||
((struct pict (draw width height ascent descent children panbox))
|
||||
((struct pict (draw width height ascent descent children panbox last))
|
||||
(struct child (pict dx dy sx sy))
|
||||
|
||||
black-and-white
|
||||
|
|
@ -57,6 +57,8 @@
|
|||
refocus ; pict pict -> pict
|
||||
panorama ; pict -> pict
|
||||
|
||||
use-last ; pict pict -> pict
|
||||
|
||||
hline ; w h -> pict
|
||||
dash-hline ; w h seg-length -> pict ; default seg-length is 5
|
||||
vline ; w h -> pict
|
||||
|
|
|
|||
|
|
@ -11,13 +11,14 @@
|
|||
(define default-seg 5)
|
||||
(define recordseplinespace 4)
|
||||
|
||||
(define-struct pict (draw ; drawing instructions
|
||||
width ; total width
|
||||
height ; total height >= ascent + desecnt
|
||||
ascent ; portion of height above top baseline
|
||||
descent ; portion of height below bottom baseline
|
||||
children ; list of child records
|
||||
panbox) ; panorama box
|
||||
(define-struct pict (draw ; drawing instructions
|
||||
width ; total width
|
||||
height ; total height >= ascent + desecnt
|
||||
ascent ; portion of height above top baseline
|
||||
descent ; portion of height below bottom baseline
|
||||
children ; list of child records
|
||||
panbox ; panorama box, computed on demand
|
||||
last) ; a descendent for the bottom-right
|
||||
#:mutable)
|
||||
(define-struct child (pict dx dy sx sy))
|
||||
(define-struct bbox (x1 y1 x2 y2 ay dy))
|
||||
|
|
@ -32,8 +33,8 @@
|
|||
[() (blank 0 0 0)]
|
||||
[(s) (blank s s)]
|
||||
[(w h) (blank w h 0)]
|
||||
[(w a d) (make-pict `(picture ,w ,(+ a d)) w (+ a d) a d null #f)]
|
||||
[(w h a d) (make-pict `(picture ,w ,h) w h a d null #f)]))
|
||||
[(w a d) (make-pict `(picture ,w ,(+ a d)) w (+ a d) a d null #f #f)]
|
||||
[(w h a d) (make-pict `(picture ,w ,h) w h a d null #f #f)]))
|
||||
|
||||
(define (extend-pict box dx dy dw da dd draw)
|
||||
(let ([w (pict-width box)]
|
||||
|
|
@ -44,7 +45,8 @@
|
|||
(+ w dw) (+ h da dd)
|
||||
(max 0 (+ a da)) (max 0 (+ d dd))
|
||||
(list (make-child box dx dy 1 1))
|
||||
#f)))
|
||||
#f
|
||||
(pict-last box))))
|
||||
|
||||
(define (single-pict-offset pict subbox)
|
||||
(let floop ([box pict]
|
||||
|
|
@ -168,6 +170,7 @@
|
|||
(let ([b (extend-pict box 0 0 0 0 0 #f)])
|
||||
(set-pict-children! b null)
|
||||
(set-pict-panbox! b (pict-panbox box))
|
||||
(set-pict-last! b #f)
|
||||
b))
|
||||
|
||||
(define (lift p n)
|
||||
|
|
@ -189,7 +192,8 @@
|
|||
(+ dh (child-dy c))
|
||||
1 1))
|
||||
(pict-children p))
|
||||
#f)))
|
||||
#f
|
||||
(pict-last p))))
|
||||
|
||||
(define (drop p n)
|
||||
(let* ([dh (- (max 0 (- n (pict-ascent p))))]
|
||||
|
|
@ -204,7 +208,8 @@
|
|||
(- h2 a2)
|
||||
(pict-descent p))
|
||||
(pict-children p)
|
||||
#f)))
|
||||
#f
|
||||
(pict-last p))))
|
||||
|
||||
(define (baseless p)
|
||||
(let ([p (lift p (pict-descent p))])
|
||||
|
|
@ -220,7 +225,8 @@
|
|||
(pict-width c) (pict-height c)
|
||||
(pict-ascent c) (pict-descent c)
|
||||
(pict-children p)
|
||||
#f))))
|
||||
#f
|
||||
(or (pict-last c) c)))))
|
||||
|
||||
(define (panorama-box! p)
|
||||
(let ([bb (pict-panbox p)])
|
||||
|
|
@ -297,6 +303,22 @@
|
|||
,w ,h
|
||||
(put ,l ,b ,(pict-draw box)))))]))
|
||||
|
||||
(define (use-last p sub-p)
|
||||
(if (let floop ([p p])
|
||||
(or (eq? p sub-p)
|
||||
(ormap (lambda (c) (floop (child-pict c)))
|
||||
(pict-children p))))
|
||||
(make-pict (pict-draw p)
|
||||
(pict-width p) (pict-height p)
|
||||
(pict-ascent p) (pict-descent p)
|
||||
(list (make-child p 0 0 1 1))
|
||||
#f
|
||||
sub-p)
|
||||
(error 'use-last
|
||||
"given new last pict: ~e not in the base pict: ~e"
|
||||
sub-p
|
||||
p)))
|
||||
|
||||
(define dash-frame
|
||||
(case-lambda
|
||||
[(box) (dash-frame box default-seg)]
|
||||
|
|
@ -341,7 +363,8 @@
|
|||
(cadr (rotate width height))
|
||||
(cadr (rotate 0 height)) 0
|
||||
null
|
||||
#f)))
|
||||
#f
|
||||
#f)))
|
||||
|
||||
(define (rlist b a) (list a b))
|
||||
|
||||
|
|
@ -459,7 +482,8 @@
|
|||
(combine-descent fd2 rd2 fd1 rd1 fh rh h (- h dy1) (- h dy2))
|
||||
(list (make-child first dx1 dy1 1 1)
|
||||
(make-child rest dx2 dy2 1 1))
|
||||
#f))])))))]
|
||||
#f
|
||||
(or (pict-last rest) rest)))])))))]
|
||||
[2max (lambda (a b c . rest) (max a b))]
|
||||
[zero (lambda (fw fh rw rh sep fd1 fd2 rd1 rd2 . args) 0)]
|
||||
[fv (lambda (a b . args) a)]
|
||||
|
|
@ -579,7 +603,25 @@
|
|||
(pict-width p) (pict-height p)
|
||||
min-a min-d
|
||||
(pict-children p)
|
||||
#f)))))))]
|
||||
#f
|
||||
;; Find bottomost, rightmost of old last picts to be the
|
||||
;; new last pict.
|
||||
(let ([subs (map (lambda (box)
|
||||
(let ([last (or (pict-last box)
|
||||
box)])
|
||||
(let-values ([(x y) (rb-find p last)])
|
||||
(list last x y))))
|
||||
boxes)])
|
||||
(if (null? subs)
|
||||
#f
|
||||
(caar (sort subs
|
||||
(lambda (a b)
|
||||
(let ([ay (caddr a)]
|
||||
[by (caddr b)])
|
||||
(cond
|
||||
[(ay . > . by) #t]
|
||||
[(= ay by) ((cadr a) . > . (cadr b))]
|
||||
[else #f]))))))))))))))]
|
||||
[norm (lambda (h a d ac dc) h)]
|
||||
[tbase (lambda (h a d ac dc) (+ a ac))]
|
||||
[bbase (lambda (h a d ac dc) (+ d dc))]
|
||||
|
|
@ -717,7 +759,8 @@
|
|||
(cons
|
||||
(make-child title 0 title-y 1 1)
|
||||
(map (lambda (child child-y) (make-child child 0 child-y 1 1)) fields field-ys))
|
||||
#f)))
|
||||
#f
|
||||
#f)))
|
||||
|
||||
(define (picture* w h a d commands)
|
||||
(let loop ([commands commands][translated null][children null])
|
||||
|
|
@ -727,7 +770,8 @@
|
|||
,@(reverse translated))
|
||||
w h a d
|
||||
children
|
||||
#f)
|
||||
#f
|
||||
#f)
|
||||
(let ([c (car commands)]
|
||||
[rest (cdr commands)])
|
||||
(unless (and (pair? c) (symbol? (car c)))
|
||||
|
|
|
|||
|
|
@ -69,7 +69,7 @@
|
|||
(define dc
|
||||
(case-lambda
|
||||
[(f w h a d)
|
||||
(make-pict `(prog ,f ,h) w h a d null #f)]
|
||||
(make-pict `(prog ,f ,h) w h a d null #f #f)]
|
||||
[(f w h)
|
||||
(dc f w h h 0)]))
|
||||
(define prog-picture dc)
|
||||
|
|
|
|||
|
|
@ -142,7 +142,8 @@
|
|||
(+ d h)
|
||||
h d
|
||||
null
|
||||
#f))]))
|
||||
#f
|
||||
#f))]))
|
||||
|
||||
(define (text-line/phantom text phantom . args)
|
||||
(apply tex (format "\\makebox[0pt]{\\vphantom{~a}}~a" phantom text) args))
|
||||
|
|
|
|||
|
|
@ -99,7 +99,8 @@
|
|||
w h
|
||||
a d
|
||||
(list (make-child box 0 0 1 1))
|
||||
#f)))
|
||||
#f
|
||||
(pict-last box))))
|
||||
|
||||
(define cons-colorized-picture
|
||||
(lambda (p color cmds)
|
||||
|
|
@ -925,7 +926,8 @@
|
|||
(pict-ascent new)
|
||||
(pict-descent new)
|
||||
(list (make-child p 0 0 x-factor y-factor))
|
||||
#f)))]
|
||||
#f
|
||||
(pict-last new))))]
|
||||
[(p factor) (scale p factor factor)]))
|
||||
|
||||
(define cellophane
|
||||
|
|
@ -955,7 +957,8 @@
|
|||
(pict-ascent new)
|
||||
(pict-descent new)
|
||||
(list (make-child p 0 0 1 1))
|
||||
#f)))])]))
|
||||
#f
|
||||
(pict-last new))))])]))
|
||||
|
||||
(define inset/clip
|
||||
(case-lambda
|
||||
|
|
@ -982,7 +985,8 @@
|
|||
(pict-ascent new)
|
||||
(pict-descent new)
|
||||
(list (make-child p 0 0 1 1))
|
||||
#f)))]
|
||||
#f
|
||||
(pict-last new))))]
|
||||
[(p h v) (inset/clip p h v h v)]
|
||||
[(p a) (inset/clip p a a a a)]))
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user