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

major Scribble revision (v4.2.1.2)

Browse Source 
svn: r15569

original commit: 345c17e85c78771b1dd237c99c58571eb9f5fe7d
This commit is contained in:
Matthew Flatt 2009-07-25 20:25:33 +00:00
parent 44a248fef1
commit 478de81b55
81 changed files with 7720 additions and 3796 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

327
collects/scribble/base-render.ss
View File

@ -1,6 +1,7 @@
#lang scheme/base
(require "struct.ss"
(require "core.ss"
"private/render-utils.ss"
mzlib/class
mzlib/serialize
scheme/file
@ -51,36 +52,109 @@
;; ----------------------------------------
(define/public (extract-part-style-files d ri tag stop-at-part?)
(let loop ([p d][up? #t][only-up? #f])
(let ([s (part-style p)])
(apply
append
(if up?
(let ([p (collected-info-parent (part-collected-info p ri))])
(if p
(loop p #t #t)
null))
null)
(if (list? s)
(filter
values
(map (lambda (s)
(and (list? s)
(= 2 (length s))
(eq? (car s) tag)
(path-string? (cadr s))
(cadr s)))
s))
null)
(if only-up?
null
(map (lambda (p)
(if (stop-at-part? p)
null
(loop p #f #f)))
(part-parts p)))))))
(define/public (extract-part-style-files d ri tag stop-at-part? pred extract)
(let ([ht (make-hash)])
(let loop ([p d][up? #t][only-up? #f])
(let ([s (part-style p)])
(when up?
(let ([p (collected-info-parent (part-collected-info p ri))])
(if p
(loop p #t #t)
null)))
(extract-style-style-files (part-style p) ht pred extract)
(unless only-up?
(extract-content-style-files (part-to-collect p) d ri ht pred extract)
(extract-content-style-files (part-title-content p) d ri ht pred extract)
(extract-flow-style-files (part-blocks p) d ri ht pred extract))
(unless only-up?
(for-each (lambda (p)
(unless (stop-at-part? p)
(loop p #f #f)))
(part-parts p)))))
(for/list ([k (in-hash-keys ht)]) (main-collects-relative->path k))))
(define/private (extract-style-style-files s ht pred extract)
(for ([v (in-list (style-variants s))])
(when (pred v)
(hash-set! ht (extract v) #t))))
(define/private (extract-flow-style-files blocks d ri ht pred extract)
(for ([b (in-list blocks)])
(extract-block-style-files b d ri ht pred extract)))
(define/private (extract-block-style-files p d ri ht pred extract)
(cond
[(table? p)
(extract-style-style-files (table-style p) ht pred extract)
(for-each (lambda (blocks)
(for-each (lambda (block)
(unless (eq? block 'cont)
(extract-block-style-files block d ri ht pred extract)))
blocks))
(table-blockss p))]
[(itemization? p)
(extract-style-style-files (itemization-style p) ht pred extract)
(for-each (lambda (blocks)
(extract-flow-style-files blocks d ri ht pred extract))
(itemization-blockss p))]
[(nested-flow? p)
(extract-style-style-files (nested-flow-style p) ht pred extract)
(extract-flow-style-files (nested-flow-blocks p) d ri ht pred extract)]
[(compound-paragraph? p)
(extract-style-style-files (compound-paragraph-style p) ht pred extract)
(extract-flow-style-files (compound-paragraph-blocks p) d ri ht pred extract)]
[(delayed-block? p)
(let ([v ((delayed-block-resolve p) this d ri)])
(extract-block-style-files v d ri ht pred extract))]
[else
(extract-style-style-files (paragraph-style p) ht pred extract)
(extract-content-style-files (paragraph-content p) d ri ht pred extract)]))
(define/private (extract-content-style-files e d ri ht pred extract)
(cond
[(element? e)
(when (style? (element-style e))
(extract-style-style-files (element-style e) ht pred extract))
(extract-content-style-files (element-content e) d ri ht pred extract)]
[(multiarg-element? e)
(when (style? (multiarg-element-style e))
(extract-style-style-files (multiarg-element-style e) ht pred extract))
(extract-content-style-files (multiarg-element-contents e) d ri ht pred extract)]
[(list? e)
(for ([e (in-list e)])
(extract-content-style-files e d ri ht pred extract))]
[(delayed-element? e)
(extract-content-style-files (delayed-element-content e ri) d ri ht pred extract)]
[(part-relative-element? e)
(extract-content-style-files (part-relative-element-content e ri) d ri ht pred extract)]))
(define/public (extract-version d)
(or (ormap (lambda (v)
(and (document-version? v)
(document-version-text v)))
(style-variants (part-style d)))
""))
(define/private (extract-pre-paras d sym)
(let loop ([l (part-blocks d)])
(cond
[(null? l) null]
[else (let ([v (car l)])
(cond
[(and (paragraph? v)
(eq? sym (style-name (paragraph-style v))))
(cons v (loop (cdr l)))]
[(compound-paragraph? v)
(append (loop (compound-paragraph-blocks v))
(loop (cdr l)))]
[else (loop (cdr l))]))])))
(define/public (extract-authors d)
(extract-pre-paras d 'author))
(define/public (extract-pretitle d)
(extract-pre-paras d 'pretitle))
;; ----------------------------------------
(define root (make-mobile-root root-path))
@ -196,20 +270,18 @@
(collect-content (part-title-content d) p-ci))
(collect-part-tags d p-ci number)
(collect-content (part-to-collect d) p-ci)
(collect-flow (part-flow d) p-ci)
(collect-flow (part-blocks d) p-ci)
(let loop ([parts (part-parts d)]
[pos 1])
(unless (null? parts)
(let ([s (car parts)])
(collect-part s d p-ci
(cons (if (or (unnumbered-part? s)
(part-style? s 'unnumbered))
(cons (if (part-style? s 'unnumbered)
#f
pos)
number))
(loop (cdr parts)
(if (or (unnumbered-part? s)
(part-style? s 'unnumbered))
(if (part-style? s 'unnumbered)
pos
(add1 pos)))))))
(let ([prefix (part-tag-prefix d)])
@ -241,41 +313,38 @@
number
(add-current-tag-prefix t))))))
(define/public (collect-content c ci)
(for ([i (in-list c)]) (collect-element i ci)))
(define/public (collect-paragraph p ci)
(collect-content (paragraph-content p) ci))
(define/public (collect-flow p ci)
(for ([p (in-list (flow-paragraphs p))])
(for ([p (in-list p)])
(collect-block p ci)))
(define/public (collect-block p ci)
(cond [(table? p) (collect-table p ci)]
[(itemization? p) (collect-itemization p ci)]
[(blockquote? p) (collect-blockquote p ci)]
[(nested-flow? p) (collect-nested-flow p ci)]
[(compound-paragraph? p) (collect-compound-paragraph p ci)]
[(delayed-block? p) (void)]
[else (collect-paragraph p ci)]))
(define/public (collect-table i ci)
(for ([d (in-list (apply append (table-flowss i)))])
(when (flow? d) (collect-flow d ci))))
(for ([d (in-list (apply append (table-blockss i)))])
(unless (eq? d 'cont) (collect-block d ci))))
(define/public (collect-itemization i ci)
(for ([d (in-list (itemization-flows i))])
(for ([d (in-list (itemization-blockss i))])
(collect-flow d ci)))
(define/public (collect-blockquote i ci)
(for ([d (in-list (blockquote-paragraphs i))])
(define/public (collect-nested-flow i ci)
(for ([d (in-list (nested-flow-blocks i))])
(collect-block d ci)))
(define/public (collect-compound-paragraph i ci)
(for ([d (in-list (compound-paragraph-blocks i))])
(collect-block d ci)))
(define/public (collect-element i ci)
(define/public (collect-content i ci)
(if (part-relative-element? i)
(let ([content (or (hash-ref (collect-info-relatives ci) i #f)
(let ([v ((part-relative-element-collect i) ci)])
@ -286,7 +355,11 @@
(when (index-element? i) (collect-index-element i ci))
(when (collect-element? i) ((collect-element-collect i) ci))
(when (element? i)
(for ([e (element-content i)]) (collect-element e ci))))))
(collect-content (element-content i) ci))
(when (multiarg-element? i)
(collect-content (multiarg-element-contents i) ci))
(when (list? i)
(for ([e (in-list i)]) (collect-content e ci))))))
(define/public (collect-target-element i ci)
(let ([t (generate-tag (target-element-tag i) ci)])
@ -315,26 +388,22 @@
(extend-prefix d (fresh-tag-resolve-context? d ri))])
(when (part-title-content d)
(resolve-content (part-title-content d) d ri))
(resolve-flow (part-flow d) d ri)
(resolve-flow (part-blocks d) d ri)
(for ([p (part-parts d)])
(resolve-part p ri))))
(define/public (resolve-content c d ri)
(for ([i (in-list c)])
(resolve-element i d ri)))
(define/public (resolve-paragraph p d ri)
(resolve-content (paragraph-content p) d ri))
(define/public (resolve-flow p d ri)
(for ([p (flow-paragraphs p)])
(define/public (resolve-flow f d ri)
(for ([p (in-list f)])
(resolve-block p d ri)))
(define/public (resolve-block p d ri)
(cond
[(table? p) (resolve-table p d ri)]
[(itemization? p) (resolve-itemization p d ri)]
[(blockquote? p) (resolve-blockquote p d ri)]
[(nested-flow? p) (resolve-nested-flow p d ri)]
[(compound-paragraph? p) (resolve-compound-paragraph p d ri)]
[(delayed-block? p)
(let ([v ((delayed-block-resolve p) this d ri)])
@ -343,22 +412,22 @@
[else (resolve-paragraph p d ri)]))
(define/public (resolve-table i d ri)
(for ([f (in-list (apply append (table-flowss i)))])
(when (flow? f) (resolve-flow f d ri))))
(for ([f (in-list (apply append (table-blockss i)))])
(unless (eq? f 'cont) (resolve-block f d ri))))
(define/public (resolve-itemization i d ri)
(for ([f (in-list (itemization-flows i))])
(for ([f (in-list (itemization-blockss i))])
(resolve-flow f d ri)))
(define/public (resolve-blockquote i d ri)
(for ([f (in-list (blockquote-paragraphs i))])
(define/public (resolve-nested-flow i d ri)
(for ([f (in-list (nested-flow-blocks i))])
(resolve-block f d ri)))
(define/public (resolve-compound-paragraph i d ri)
(for ([f (in-list (compound-paragraph-blocks i))])
(resolve-block f d ri)))
(define/public (resolve-element i d ri)
(define/public (resolve-content i d ri)
(cond
[(part-relative-element? i)
(resolve-content (part-relative-element-content i ri) d ri)]
@ -368,6 +437,9 @@
(hash-set! (resolve-info-delays ri) i v)
v))
d ri)]
[(list? i)
(for ([i (in-list i)])
(resolve-content i d ri))]
[(element? i)
(cond
[(index-element? i)
@ -377,19 +449,30 @@
(hash-set! (resolve-info-delays ri) e v))))]
[(link-element? i)
(resolve-get d ri (link-element-tag i))])
(for ([e (element-content i)])
(resolve-element e d ri))]))
(resolve-content (element-content i) d ri)]
[(multiarg-element? i)
(resolve-content (multiarg-element-contents i) d ri)]))
;; ----------------------------------------
;; render methods
(define/public (install-extra-files)
(for ([fn extra-files]) (install-file fn)))
(define/public (auto-extra-files? v) #f)
(define/public (auto-extra-files-paths v) null)
(define/public (install-extra-files ds)
(for ([fn extra-files]) (install-file fn))
(unless prefix-file
(for ([d (in-list ds)])
(let ([extras (ormap (lambda (v) (and (auto-extra-files? v) v))
(style-variants (part-style d)))])
(when extras
(for ([fn (in-list (auto-extra-files-paths extras))])
(install-file (main-collects-relative->path fn))))))))
(define/public (render ds fns ri)
;; maybe this should happen even if fns is empty or all #f?
;; or maybe it should happen for each file rendered (when d is not #f)?
(unless (andmap not ds) (install-extra-files))
(unless (andmap not ds) (install-extra-files ds))
(map (lambda (d fn)
(define (one) (render-one d ri fn))
(when (report-output?) (printf " [Output to ~a]\n" fn))
@ -415,13 +498,10 @@
(list
(when (part-title-content d)
(render-content (part-title-content d) d ri))
(render-flow (part-flow d) d ri #f)
(render-flow (part-blocks d) d ri #f)
(map (lambda (s) (render-part s ri))
(part-parts d))))
(define/public (render-content c part ri)
(apply append (map (lambda (i) (render-element i part ri)) c)))
(define/public (render-paragraph p part ri)
(render-content (paragraph-content p) part ri))
@ -436,49 +516,51 @@
(loop (cdr l) #f))]))))
(define/public (render-flow p part ri starting-item?)
(if (null? (flow-paragraphs p))
(if (null? p)
null
(append
(render-block (car (flow-paragraphs p))
(render-block (car p)
part ri starting-item?)
(apply append
(map (lambda (p)
(render-block p part ri #f))
(cdr (flow-paragraphs p)))))))
(cdr p))))))
(define/public (render-intrapara-block p part ri first? last? starting-item?)
(render-block p part ri starting-item?))
(define/public (render-block p part ri inline?)
(define/public (render-block p part ri starting-item?)
(cond
[(table? p) (if (auxiliary-table? p)
(render-auxiliary-table p part ri)
(render-table p part ri inline?))]
[(itemization? p) (render-itemization p part ri)]
[(blockquote? p) (render-blockquote p part ri)]
[(compound-paragraph? p) (render-compound-paragraph p part ri inline?)]
[(delayed-block? p)
(render-block (delayed-block-blocks p ri) part ri inline?)]
[else (render-paragraph p part ri)]))
[(table? p) (if (memq 'aux (style-variants (table-style p)))
(render-auxiliary-table p part ri)
(render-table p part ri starting-item?))]
[(itemization? p) (render-itemization p part ri)]
[(nested-flow? p) (render-nested-flow p part ri)]
[(compound-paragraph? p) (render-compound-paragraph p part ri starting-item?)]
[(delayed-block? p)
(render-block (delayed-block-blocks p ri) part ri starting-item?)]
[else (render-paragraph p part ri)]))
(define/public (render-auxiliary-table i part ri)
null)
(define/public (render-table i part ri inline?)
(map (lambda (d) (if (flow? i) (render-flow d part ri #f) null))
(apply append (table-flowss i))))
(define/public (render-table i part ri starting-item?)
(map (lambda (d) (if (eq? i 'cont) null (render-block d part ri #f)))
(apply append (table-blockss i))))
(define/public (render-itemization i part ri)
(map (lambda (d) (render-flow d part ri #t))
(itemization-flows i)))
(itemization-blockss i)))
(define/public (render-blockquote i part ri)
(define/public (render-nested-flow i part ri)
(map (lambda (d) (render-block d part ri #f))
(blockquote-paragraphs i)))
(nested-flow-blocks i)))
(define/public (render-element i part ri)
(define/public (render-content i part ri)
(cond
[(string? i) (render-other i part ri)] ; short-cut for common case
[(list? i)
(apply append (for/list ([i (in-list i)]) (render-content i part ri)))]
[(and (link-element? i)
(null? (element-content i)))
(let ([v (resolve-get part ri (link-element-tag i))])
@ -489,6 +571,8 @@
(when (render-element? i)
((render-element-render i) this part ri))
(render-content (element-content i) part ri)]
[(multiarg-element? i)
(render-content (multiarg-element-contents i) part ri)]
[(delayed-element? i)
(render-content (delayed-element-content i ri) part ri)]
[(part-relative-element? i)
@ -568,15 +652,15 @@
;; ----------------------------------------
(define/private (do-table-of-contents part ri delta quiet depth)
(make-table #f (generate-toc part
ri
(+ delta
(length (collected-info-number
(part-collected-info part ri))))
#t
quiet
depth
null)))
(make-table plain (generate-toc part
ri
(+ delta
(length (collected-info-number
(part-collected-info part ri))))
#t
quiet
depth
null)))
(define/public (table-of-contents part ri)
(do-table-of-contents part ri -1 not +inf.0))
@ -605,31 +689,30 @@
(if skip?
subs
(let ([l (cons
(list (make-flow
(list (make-paragraph
plain
(list
(make-paragraph
(list
(make-element
'hspace
(list (make-string (* 2 (- (length number)
base-len))
#\space)))
(make-link-element
(if (= 1 (length number)) "toptoclink" "toclink")
(append
(format-number
number
(list (make-element 'hspace '(" "))))
(or (part-title-content part) '("???")))
(for/fold ([t (car (part-tags part))])
([prefix (in-list prefixes)])
(convert-key prefix t))))))))
(make-element
'hspace
(list (make-string (* 2 (- (length number)
base-len))
#\space)))
(make-link-element
(if (= 1 (length number)) "toptoclink" "toclink")
(append
(format-number
number
(list (make-element 'hspace '(" "))))
(or (part-title-content part) '("???")))
(for/fold ([t (car (part-tags part))])
([prefix (in-list prefixes)])
(convert-key prefix t))))))
subs)])
(if (and (= 1 (length number))
(or (not (car number)) ((car number) . > . 1)))
(cons (list (make-flow
(list (make-paragraph
(list (make-element 'hspace (list "")))))))
(cons (list (make-paragraph
plain
(list (make-element 'hspace (list "")))))
l)
l)))))

740
collects/scribble/base.ss Normal file
View File

@ -0,0 +1,740 @@
#lang scheme/base
(require "decode.ss"
"core.ss"
"manual-struct.ss"
"decode-struct.ss"
"html-variants.ss"
scheme/list
scheme/class
scheme/contract
setup/main-collects
syntax/modresolve
(for-syntax scheme/base))
;; ----------------------------------------
(define-syntax-rule (title-like-contract)
(->* ()
(#:tag (or/c #f string? (listof string?))
#:tag-prefix (or/c #f string? module-path?)
#:style (or/c style? string? symbol? (listof symbol?) #f))
#:rest (listof pre-content?)
part-start?))
(provide/contract
[title (->* ()
(#:tag (or/c #f string? (listof string?))
#:tag-prefix (or/c #f string? module-path?)
#:style (or/c style? string? symbol? (listof symbol?) #f)
#:version (or/c string? #f))
#:rest (listof pre-content?)
title-decl?)]
[section (title-like-contract)]
[subsection (title-like-contract)]
[subsubsection (title-like-contract)]
[subsubsub*section (->* ()
(#:tag (or/c #f string? (listof string?)))
#:rest (listof pre-content?)
block?)])
(provide include-section)
(define (gen-tag content)
(regexp-replace* "[^-a-zA-Z0-9_=]" (content->string content) "_"))
(define (prefix->string p)
(and p (if (string? p) p (module-path-prefix->string p))))
(define (convert-tag tag content)
(if (list? tag)
(append-map (lambda (t) (convert-tag t content)) tag)
`((part ,(or tag (gen-tag content))))))
(define (convert-part-style who s)
(cond
[(style? s) s]
[(not s) plain]
[(string? s) (make-style s null)]
[(symbol? s) (make-style #f (list s))]
[(and (list? s) (andmap symbol? s)) (make-style #f s)]
[else (raise-type-error who "style, string, symbol, list of symbols, or #f" s)]))
(define (title #:tag [tag #f] #:tag-prefix [prefix #f] #:style [style plain]
#:version [version #f] . str)
(let ([content (decode-content str)])
(make-title-decl (prefix->string prefix)
(convert-tag tag content)
version
(convert-part-style 'title style)
content)))
(define (section #:tag [tag #f] #:tag-prefix [prefix #f] #:style [style plain]
. str)
(let ([content (decode-content str)])
(make-part-start 0 (prefix->string prefix)
(convert-tag tag content)
(convert-part-style 'section style)
content)))
(define (subsection #:tag [tag #f] #:tag-prefix [prefix #f] #:style [style plain]
. str)
(let ([content (decode-content str)])
(make-part-start 1
(prefix->string prefix)
(convert-tag tag content)
(convert-part-style 'subsection style)
content)))
(define (subsubsection #:tag [tag #f] #:tag-prefix [prefix #f]
#:style [style plain] . str)
(let ([content (decode-content str)])
(make-part-start 2
(prefix->string prefix)
(convert-tag tag content)
(convert-part-style 'subsubsection style)
content)))
(define (subsubsub*section #:tag [tag #f] . str)
(let ([content (decode-content str)])
(make-paragraph plain
(list
(make-element 'bold
(if tag
(make-target-element #f content `(part ,tag))
content))))))
(define-syntax (include-section stx)
(syntax-case stx ()
[(_ mod)
(with-syntax ([mod (syntax-local-introduce #'mod)])
(unless (module-path? (syntax->datum #'mod))
(raise-syntax-error #f
"not a module path"
stx
#'mod))
#'(begin
(require (only-in mod doc))
doc))]))
;; ----------------------------------------
(provide/contract
[author (->* (content?) () #:rest (listof content?) block?)]
[author+email (-> content? string? element?)])
(define (author . auths)
(make-paragraph
(make-style 'author null)
(let ([nl (make-element 'newline '("\n"))])
(case (length auths)
[(1) auths]
[(2) (list (car auths) nl "and " (cadr auths))]
[else (let ([r (reverse auths)])
(append (add-between (reverse (cdr r))
(make-element #f (list "," nl)))
(list "," nl "and " (car r))))]))))
(define (author+email name email)
(make-element #f
(list
name
" <"
(regexp-replace* #rx"[.]"
(regexp-replace* #rx"@" email " at ")
" dot ")
">")))
;; ----------------------------------------
(provide intern-taglet
module-path-index->taglet
module-path-prefix->string
doc-prefix)
(require syntax/modcollapse
;; Needed to normalize planet version numbers:
(only-in planet/resolver get-planet-module-path/pkg)
(only-in planet/private/data pkg-maj pkg-min))
(define interned (make-weak-hash))
(define (intern-taglet v)
(let ([v (if (list? v)
(map intern-taglet v)
v)])
(if (or (string? v)
(bytes? v)
(list? v))
(let ([b (hash-ref interned v #f)])
(if b
(or (weak-box-value b)
;; just in case the value is GCed before we extract it:
(intern-taglet v))
(begin
(hash-set! interned v (make-weak-box v))
v)))
v)))
(define (do-module-path-index->taglet mod)
;; Derive the name from the module path:
(let ([p (collapse-module-path-index
mod
(lambda () (build-path (current-directory) "dummy")))])
(if (path? p)
;; If we got a path back anyway, then it's best to use the resolved
;; name; if the current directory has changed since we
;; the path-index was resolved, then p might not be right. Also,
;; the resolved path might be a symbol instead of a path.
(let ([rp (resolved-module-path-name
(module-path-index-resolve mod))])
(if (path? rp)
(intern-taglet
(path->main-collects-relative rp))
rp))
(let ([p (if (and (pair? p)
(eq? (car p) 'planet))
;; Normalize planet verion number based on current
;; linking:
(let-values ([(path pkg)
(get-planet-module-path/pkg p #f #f)])
(list* 'planet
(cadr p)
(list (car (caddr p))
(cadr (caddr p))
(pkg-maj pkg)
(pkg-min pkg))
(cdddr p)))
;; Otherwise the path is fully normalized:
p)])
(intern-taglet p)))))
(define collapsed (make-weak-hasheq))
(define (module-path-index->taglet mod)
(or (hash-ref collapsed mod #f)
(let ([v (do-module-path-index->taglet mod)])
(hash-set! collapsed mod v)
v)))
(define (module-path-prefix->string p)
(format "~a" (module-path-index->taglet (module-path-index-join p #f))))
(define doc-prefix
(case-lambda
[(doc s)
(if doc
(list (module-path-prefix->string doc) s)
s)]
[(doc prefix s)
(doc-prefix doc (if prefix
(append prefix (list s))
s))]))
;; ----------------------------------------
(define (item? x) (an-item? x))
(provide/contract
[itemlist (->* ()
(#:style (or/c style? string? symbol? #f))
#:rest (listof item?)
itemization?)]
[item (->* ()
()
#:rest (listof pre-flow?)
item?)])
(provide item?)
(define (itemlist #:style [style plain] . items)
(let ([flows (map an-item-flow items)])
(make-itemization (convert-block-style style) flows)))
(define-struct an-item (flow))
(define (item . str)
(make-an-item (decode-flow str)))
;; ----------------------------------------
(define elem-like-contract
(->* () () #:rest (listof pre-content?) element?))
(provide/contract
[hspace (-> exact-nonnegative-integer? element?)]
[elem (->* ()
(#:style element-style?)
#:rest (listof pre-content?)
element?)]
[italic elem-like-contract]
[bold elem-like-contract]
[smaller elem-like-contract]
[larger elem-like-contract]
[emph elem-like-contract]
[tt elem-like-contract]
[subscript elem-like-contract]
[superscript elem-like-contract]
[literal (->* (string?) () #:rest (listof string?) element?)]
[image (->* ((or/c path-string? (cons/c 'collects (listof bytes?))))
(#:scale real?
#:suffixes (listof #rx"^[.]"))
#:rest (listof content?)
image-element?)])
(define hspace-cache (make-vector 100 #f))
(define (hspace n)
(if (n . < . (vector-length hspace-cache))
(or (vector-ref hspace-cache n)
(let ([h (make-element 'hspace (list (make-string n #\space)))])
(vector-set! hspace-cache n h)
h))
(make-element 'hspace (list (make-string n #\space)))))
(define (elem #:style [style plain] . str)
(make-element style (decode-content str)))
(define (italic . str)
(make-element 'italic (decode-content str)))
(define (bold . str)
(make-element 'bold (decode-content str)))
(define (smaller . str)
(make-element 'smaller (decode-content str)))
(define (larger . str)
(make-element 'larger (decode-content str)))
(define (emph . str)
(make-element 'italic (decode-content str)))
(define (tt . str)
(let* ([l (decode-content str)]
[l (let ([m (and (pair? l)
(string? (car l))
(regexp-match-positions #rx"^ +" (car l)))])
(if m
(list* (hspace (- (cdar m) (caar m)))
(substring (car l) (cdar m))
(cdr l))
l))])
(if (andmap string? l)
(make-element 'tt l)
(make-element #f (map (lambda (s)
(if (or (string? s) (symbol? s))
(make-element 'tt (list s))
s))
l)))))
(define (span-class classname . str)
(make-element classname (decode-content str)))
(define (subscript . str)
(make-element 'subscript (decode-content str)))
(define (superscript . str)
(make-element 'superscript (decode-content str)))
(define (literal s . strs)
(let ([s (apply string-append s strs)])
(make-element #f s)))
(define (image #:scale [scale 1.0]
filename-relative-to-source
#:suffixes [suffixes null]
. alt)
(make-image-element #f
(decode-content alt)
filename-relative-to-source
suffixes
scale))
;; ----------------------------------------
(provide/contract
[para (->* ()
(#:style (or/c style? string? symbol? #f ))
#:rest (listof pre-content?)
paragraph?)]
[nested (->* ()
(#:style (or/c style? string? symbol? #f ))
#:rest (listof pre-flow?)
nested-flow?)]
[compound (->* ()
(#:style (or/c style? string? symbol? #f ))
#:rest (listof pre-flow?)
compound-paragraph?)]
[tabular (->* ((listof (listof (or/c 'cont block? content?))))
(#:style (or/c style? string? symbol? #f ))
table?)])
(define (convert-block-style style)
(cond
[(style? style) style]
[(or (string? style) (symbol? style)) (make-style style null)]
[else plain]))
(define (nested #:style [style #f] . c)
(make-nested-flow (convert-block-style style)
(decode-flow c)))
(define (para #:style [style #f] . c)
(make-paragraph (convert-block-style style)
(decode-content c)))
(define (compound #:style [style #f] . c)
(make-compound-paragraph (convert-block-style style)
(decode-flow c)))
(define (tabular #:style [style #f] cells)
(define (nth-str pos)
(case (modulo pos 10)
[(1) "st"]
[(2) "nd"]
[(3) "rd"]
[else "th"]))
(unless (null? cells)
(let ([n (length (car cells))])
(for ([row (in-list (cdr cells))]
[pos (in-naturals 2)])
(unless (= n (length row))
(raise-mismatch-error
'tabular
(format "bad length (~a does not match first row's length ~a) for ~a~a row: "
(length row)
n
pos
(nth-str pos))
row)))))
(for ([row (in-list cells)]
[pos (in-naturals 1)])
(when (and (pair? row) (eq? (car row) 'cont))
(raise-mismatch-error
'tabular
(format "~a~a row starts with 'cont: " pos (nth-str pos))
row)))
(make-table (convert-block-style style)
(map (lambda (row)
(map (lambda (cell)
(cond
[(eq? cell 'cont) cell]
[(block? cell) cell]
[else (make-paragraph plain cell)]))
row))
cells)))
;; ----------------------------------------
(provide/contract
[elemtag (->* ((or/c tag? string?))
()
#:rest (listof pre-content?)
element?)]
[elemref (->* ((or/c tag? string?))
(#:underline? any/c)
#:rest (listof pre-content?)
element?)]
[secref (->* (string?)
(#:doc module-path?
#:tag-prefixes (or/c #f (listof string))
#:underline? any/c)
element?)]
[Secref (->* (string?)
(#:doc module-path?
#:tag-prefixes (or/c #f (listof string))
#:underline? any/c)
element?)]
[seclink (->* (string?)
(#:doc module-path?
#:tag-prefixes (or/c #f (listof string))
#:underline? any/c)
#:rest (listof pre-content?)
element?)]
[other-doc (->* (module-path?)
(#:underline? any/c)
element?)])
(define (elemtag t . body)
(make-target-element #f (decode-content body) `(elem ,t)))
(define (elemref #:underline? [u? #t] t . body)
(make-link-element (if u? #f "plainlink") (decode-content body) `(elem ,t)))
(define (secref s #:underline? [u? #t] #:doc [doc #f] #:tag-prefixes [prefix #f])
(make-link-element (if u? #f "plainlink") null `(part ,(doc-prefix doc prefix s))))
(define (Secref s #:underline? [u? #t] #:doc [doc #f] #:tag-prefixes [prefix #f])
(let ([le (secref s #:underline? u? #:doc doc #:tag-prefixes prefix)])
(make-link-element
(make-style (element-style le) '(uppercase))
(element-content le)
(link-element-tag le))))
(define (seclink tag #:underline? [u? #t] #:doc [doc #f] #:tag-prefixes [prefix #f] . s)
(make-link-element (if u? #f "plainlink") (decode-content s)
`(part ,(doc-prefix doc prefix tag))))
(define (other-doc #:underline? [u? #t] doc)
(secref #:doc doc #:underline? u? "top"))
;; ----------------------------------------
(provide/contract
[hyperlink (->* ((or/c string? path?))
(#:underline? any/c
#:style element-style?)
#:rest (listof pre-content?)
element?)]
[url (-> string? element?)]
[margin-note (->* () () #:rest (listof pre-flow?) block?)]
[centered (->* () () #:rest (listof pre-flow?) block?)]
[verbatim (->* (string?) (#:indent exact-nonnegative-integer?) #:rest (listof string?) block?)])
(define (centered . s)
(make-nested-flow (make-style "SCentered" null) (decode-flow s)))
(define (hyperlink url
#:underline? [underline? #t]
#:style [style (if underline? #f "plainlink")]
. str)
(make-element (make-style (if (style? style)
(style-name style)
style)
(cons (make-target-url url)
(if (style? style)
(style-variants style)
null)))
(decode-content str)))
(define (url str)
(hyperlink str (make-element 'url str)))
(define (margin-note . c)
(make-nested-flow
(make-style "refpara" '(command))
(list
(make-nested-flow
(make-style "refcolumn" null)
(list
(make-nested-flow
(make-style "refcontent" null)
(decode-flow c)))))))
(define (verbatim #:indent [i 0] s . more)
(define indent
(if (zero? i)
values
(let ([hs (hspace i)]) (lambda (x) (cons hs x)))))
(define strs (regexp-split #rx"\n" (apply string-append s more)))
(define (str->elts str)
(let ([spaces (regexp-match-positions #rx"(?:^| ) +" str)])
(if spaces
(list* (substring str 0 (caar spaces))
(hspace (- (cdar spaces) (caar spaces)))
(str->elts (substring str (cdar spaces))))
(list (make-element 'tt (list str))))))
(define (make-nonempty l)
(if (let loop ([l l])
(cond
[(null? l) #t]
[(equal? "" l) #t]
[(list? l) (andmap loop l)]
[(element? l) (loop (element-content l))]
[(multiarg-element? l) (loop (multiarg-element-contents l))]
[else #f]))
(list l (hspace 1))
l))
(define (make-line str)
(let* ([line (indent (str->elts str))]
[line (list (make-element 'tt line))])
(list (make-paragraph omitable-style (make-nonempty line)))))
(make-table plain (map make-line strs)))
(define omitable-style (make-style 'omitable null))
;; ----------------------------------------
(provide section-index index index* as-index index-section
get-index-entries index-block)
(define (section-index . elems)
(make-part-index-decl (map content->string elems) elems))
(define (record-index word-seq element-seq tag content)
(make-index-element #f
(list (make-target-element #f content `(idx ,tag)))
`(idx ,tag)
word-seq
element-seq
#f))
(define (index* word-seq content-seq . s)
(let ([key (make-generated-tag)])
(record-index (map clean-up-index-string word-seq)
content-seq key (decode-content s))))
(define (index word-seq . s)
(let ([word-seq (if (string? word-seq) (list word-seq) word-seq)])
(apply index* word-seq word-seq s)))
(define (as-index . s)
(let ([key (make-generated-tag)]
[content (decode-content s)])
(record-index
(list (clean-up-index-string (content->string content)))
(if (= 1 (length content)) content (list (make-element #f content)))
key
content)))
(define (index-section #:title [title "Index"] #:tag [tag #f])
(make-part #f
`((part ,(or tag "doc-index")))
(list title)
(make-style 'index '(unnumbered))
null
(list (index-block))
null))
;; returns an ordered list of (list tag (text ...) (element ...) index-desc)
(define (get-index-entries sec ri)
(define (compare-lists xs ys <?)
(let loop ([xs xs] [ys ys])
(cond [(and (null? xs) (null? ys)) '=]
[(null? xs) '<]
[(null? ys) '>]
[(<? (car xs) (car ys)) '<]
[(<? (car ys) (car xs)) '>]
[else (loop (cdr ys) (cdr xs))])))
;; string-ci<? as a major key, and string<? next, so "Foo" precedes "foo"
;; (define (string*<? s1 s2)
;; (or (string-ci<? s1 s2)
;; (and (not (string-ci<? s2 s1)) (string<? s1 s2))))
(define (get-desc entry)
(let ([desc (cadddr entry)])
(cond [(exported-index-desc? desc)
(cons 'libs (map (lambda (l)
(format "~s" l))
(exported-index-desc-from-libs desc)))]
[(module-path-index-desc? desc) '(mod)]
[(part-index-desc? desc) '(part)]
[(delayed-index-desc? desc) '(delayed)]
[else '(#f)])))
;; parts first, then modules, then bindings, delayed means it's not
;; the last round, and #f means no desc
(define desc-order '(part mod libs delayed #f))
;; this defines an imposed ordering for module names
(define lib-order '(#rx"^scheme(?:/|$)" #rx"^r.rs(?:/|$)" #rx"^lang(?:/|$)"))
(define (lib<? lib1 lib2)
(define (lib-level lib)
(let loop ([i 0] [rxs lib-order])
(if (or (null? rxs) (regexp-match? (car rxs) lib))
i (loop (add1 i) (cdr rxs)))))
(let ([l1 (lib-level lib1)] [l2 (lib-level lib2)])
(if (= l1 l2) (string<? lib1 lib2) (< l1 l2))))
(define (compare-desc e1 e2)
(let* ([d1 (get-desc e1)] [d2 (get-desc e2)]
[t1 (car d1)] [t2 (car d2)])
(cond [(memq t2 (cdr (memq t1 desc-order))) '<]
[(memq t1 (cdr (memq t2 desc-order))) '>]
[else (case t1 ; equal to t2
[(part) '=] ; will just compare tags
[(mod) '=] ; the text fields are the names of the modules
[(libs) (compare-lists (cdr d1) (cdr d2) lib<?)]
[(delayed) '>] ; dosn't matter, will run again
[(#f) '=])])))
(define (entry<? e1 e2)
(let ([text1 (cadr e1)] [text2 (cadr e2)])
(case (compare-lists text1 text2 string-ci<?)
[(<) #t] [(>) #f]
[else (case (compare-desc e1 e2)
[(<) #t] [(>) #f]
[else (case (compare-lists text1 text2 string<?)
[(<) #t] [(>) #f]
[else
;; (error 'get-index-entries
;; ;; when this happens, revise this code so
;; ;; ordering will always be deterministic
;; "internal error -- unordered entries: ~e ~e"
;; e1 e2)
;; Instead, just compare the tags
(string<? (format "~a" (car e1))
(format "~a" (car e2)))])])])))
(define l null)
(hash-for-each
(let ([parent (collected-info-parent (part-collected-info sec ri))])
(if parent
(collected-info-info (part-collected-info parent ri))
(collect-info-ext-ht (resolve-info-ci ri))))
(lambda (k v)
(when (and (pair? k) (eq? 'index-entry (car k)))
(set! l (cons (cons (cadr k) v) l)))))
(sort l entry<?))
(define (index-block)
(define alpha (string->list "ABCDEFGHIJKLMNOPQRSTUVWXYZ"))
(define (rows . rows)
(make-table (make-style 'index null)
(map (lambda (row)
(list (make-paragraph plain row)))
rows)))
(define contents
(lambda (renderer sec ri)
(define l (get-index-entries sec ri))
(define manual-newlines? (send renderer index-manual-newlines?))
(define alpha-starts (make-hasheq))
(define alpha-row
(let loop ([i l] [alpha alpha])
(define (add-letter let l)
(list* (make-element "nonavigation" (list (string let))) " " l))
(cond [(null? alpha) null]
[(null? i) (add-letter (car alpha) (loop i (cdr alpha)))]
[else
(let* ([strs (cadr (car i))]
[letter (if (or (null? strs) (string=? "" (car strs)))
#f
(char-upcase (string-ref (car strs) 0)))])
(cond [(not letter) (loop (cdr i) alpha)]
[(char-ci>? letter (car alpha))
(add-letter (car alpha) (loop i (cdr alpha)))]
[(char-ci=? letter (car alpha))
(hash-set! alpha-starts (car i) letter)
(list* (make-element
(make-style #f (list (make-target-url (format "#alpha:~a" letter))))
(list (string (car alpha))))
" "
(loop (cdr i) (cdr alpha)))]
[else (loop (cdr i) alpha)]))])))
(define body
(let ([br (if manual-newlines? (make-element 'newline '("\n")) "")])
(map (lambda (i)
(let ([e (make-link-element
"indexlink"
`(,@(add-between (caddr i) ", ") ,br)
(car i))])
(cond [(hash-ref alpha-starts i #f)
=> (lambda (let)
(make-element
(make-style #f (list
(make-url-anchor
(format "alpha:~a" (char-upcase let)))))
(list e)))]
[else e])))
l)))
(if manual-newlines?
(rows alpha-row '(nbsp) body)
(apply rows alpha-row '(nbsp) (map list body)))))
(make-delayed-block contents))
;; ----------------------------------------
(provide table-of-contents
local-table-of-contents)
(define (table-of-contents)
(make-delayed-block
(lambda (renderer part ri)
(send renderer table-of-contents part ri))))
(define (local-table-of-contents #:style [style plain])
(make-delayed-block
(lambda (renderer part ri)
(send renderer local-table-of-contents part ri style))))

4
collects/scribble/base/lang.ss Normal file
View File

@ -0,0 +1,4 @@
#lang scheme
(require scribble/doclang scribble/base)
(provide (all-from-out scribble/doclang
scribble/base))

10
collects/scribble/base/lang/reader.ss Normal file
View File

@ -0,0 +1,10 @@
#lang s-exp syntax/module-reader
scribble/base/lang
#:read scribble:read-inside
#:read-syntax scribble:read-syntax-inside
#:whole-body-readers? #t
#:wrapper1 (lambda (t) (list* 'doc 'values '() (t)))
(require (prefix-in scribble: "../../reader.ss"))

443
collects/scribble/basic.ss
View File

@ -1,443 +1,46 @@
#lang scheme/base
(require "decode.ss"
"struct.ss"
"config.ss"
"manual-struct.ss"
"decode-struct.ss"
scheme/list
scheme/class
setup/main-collects
syntax/modresolve
(for-syntax scheme/base))
(require "base.ss"
"core.ss"
"decode.ss")
(provide title
section
subsection
subsubsection
subsubsub*section
include-section)
include-section
(define (gen-tag content)
(regexp-replace* "[^-a-zA-Z0-9_=]" (content->string content) "_"))
author
author+email
(define (prefix->string p)
(and p (if (string? p) p (module-path-prefix->string p))))
(define (convert-tag tag content)
(if (list? tag)
(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]
#:version [version #f] . str)
(let ([content (decode-content str)])
(make-title-decl (prefix->string prefix)
(convert-tag tag content)
version
style
content)))
(define (section #:tag [tag #f] #:tag-prefix [prefix #f] #:style [style #f]
. str)
(let ([content (decode-content str)])
(make-part-start 0 (prefix->string prefix)
(convert-tag tag content)
style
content)))
(define (subsection #:tag [tag #f] #:tag-prefix [prefix #f] #:style [style #f]
. str)
(let ([content (decode-content str)])
(make-part-start 1
(prefix->string prefix)
(convert-tag tag content)
style
content)))
(define (subsubsection #:tag [tag #f] #:tag-prefix [prefix #f]
#:style [style #f] . str)
(let ([content (decode-content str)])
(make-part-start 2
(prefix->string prefix)
(convert-tag tag content)
style
content)))
(define (subsubsub*section #:tag [tag #f] . str)
(let ([content (decode-content str)])
(make-paragraph (list (make-element 'bold content)))))
(define-syntax (include-section stx)
(syntax-case stx ()
[(_ mod)
(with-syntax ([mod (syntax-local-introduce #'mod)])
#'(begin
(require (only-in mod doc))
doc))]))
;; ----------------------------------------
(provide author
author+email)
(define (author . auths)
(make-styled-paragraph
(let ([nl (make-element 'newline '("\n"))])
(case (length auths)
[(1) auths]
[(2) (list (car auths) nl "and " (cadr auths))]
[else (let ([r (reverse auths)])
(append (add-between (reverse (cdr r))
(make-element #f (list "," nl)))
(list "," nl "and " (car r))))]))
"author"))
(define (author+email name email)
(make-element #f
(list
name
" <"
(regexp-replace* #rx"[.]"
(regexp-replace* #rx"@" email " at ")
" dot ")
">")))
;; ----------------------------------------
(provide intern-taglet
intern-taglet
module-path-index->taglet
module-path-prefix->string)
module-path-prefix->string
itemize item item?
(define interned (make-weak-hash))
(define (intern-taglet v)
(let ([v (if (list? v)
(map intern-taglet v)
v)])
(if (or (string? v)
(bytes? v)
(list? v))
(let ([b (hash-ref interned v #f)])
(if b
(or (weak-box-value b)
;; just in case the value is GCed before we extract it:
(intern-taglet v))
(begin
(hash-set! interned v (make-weak-box v))
v)))
v)))
(define (do-module-path-index->taglet mod)
;; Derive the name from the module path:
(let ([p (collapse-module-path-index
mod
(lambda () (build-path (current-directory) "dummy")))])
(if (path? p)
;; If we got a path back anyway, then it's best to use the resolved
;; name; if the current directory has changed since we
;; the path-index was resolved, then p might not be right. Also,
;; the resolved path might be a symbol instead of a path.
(let ([rp (resolved-module-path-name
(module-path-index-resolve mod))])
(if (path? rp)
(intern-taglet
(path->main-collects-relative rp))
rp))
(let ([p (if (and (pair? p)
(eq? (car p) 'planet))
;; Normalize planet verion number based on current
;; linking:
(let-values ([(path pkg)
(get-planet-module-path/pkg p #f #f)])
(list* 'planet
(cadr p)
(list (car (caddr p))
(cadr (caddr p))
(pkg-maj pkg)
(pkg-min pkg))
(cdddr p)))
;; Otherwise the path is fully normalized:
p)])
(intern-taglet p)))))
(define collapsed (make-weak-hasheq))
(define (module-path-index->taglet mod)
(or (hash-ref collapsed mod #f)
(let ([v (do-module-path-index->taglet mod)])
(hash-set! collapsed mod v)
v)))
(define (module-path-prefix->string p)
(format "~a" (module-path-index->taglet (module-path-index-join p #f))))
;; ----------------------------------------
(require syntax/modcollapse
;; Needed to normalize planet version numbers:
(only-in planet/resolver get-planet-module-path/pkg)
(only-in planet/private/data pkg-maj pkg-min))
(provide itemize item item?)
(define (itemize #:style [style #f] . items)
(let ([items (filter (lambda (v) (not (whitespace? v))) items)])
(for ([v items])
(unless (an-item? v)
(error 'itemize "expected an item, found something else: ~e" v)))
(let ([flows (map an-item-flow items)])
(if style
(make-styled-itemization flows style)
(make-itemization flows)))))
(define-struct an-item (flow))
(define (item? x) (an-item? x))
(define (item . str)
(make-an-item (decode-flow str)))
;; ----------------------------------------
(provide hspace
hspace
elem aux-elem
italic bold smaller
tt span-class
subscript superscript)
tt
subscript superscript
(define hspace-cache (make-vector 100 #f))
section-index index index* as-index index-section
get-index-entries index-block
(define (hspace n)
(if (n . < . (vector-length hspace-cache))
(or (vector-ref hspace-cache n)
(let ([h (make-element 'hspace (list (make-string n #\space)))])
(vector-set! hspace-cache n h)
h))
(make-element 'hspace (list (make-string n #\space)))))
table-of-contents
local-table-of-contents
(define (elem #:style [style #f] . str)
(make-element style (decode-content str)))
(define (aux-elem . s)
(make-aux-element #f (decode-content s)))
(define (italic . str)
(make-element 'italic (decode-content str)))
(define (bold . str)
(make-element 'bold (decode-content str)))
(define (smaller . str)
(make-element "smaller" (decode-content str)))
(define (tt . str)
(let* ([l (decode-content str)]
[l (let ([m (and (pair? l)
(string? (car l))
(regexp-match-positions #rx"^ +" (car l)))])
(if m
(list* (hspace (- (cdar m) (caar m)))
(substring (car l) (cdar m))
(cdr l))
l))])
(if (andmap string? l)
(make-element 'tt l)
(make-element #f (map (lambda (s)
(if (or (string? s) (symbol? s))
(make-element 'tt (list s))
s))
l)))))
span-class)
(define (span-class classname . str)
(make-element classname (decode-content str)))
(define (subscript . str)
(make-element 'subscript (decode-content str)))
(define (aux-elem . s)
(make-element (make-style #f (list 'aux)) (decode-content s)))
(define (superscript . str)
(make-element 'superscript (decode-content str)))
(define (itemize #:style [style #f] . items)
(let ([items (filter (lambda (v) (not (whitespace? v))) items)])
(apply itemlist #:style style items)))
;; ----------------------------------------
(provide section-index index index* as-index index-section
get-index-entries index-block)
(define (section-index . elems)
(make-part-index-decl (map element->string elems) elems))
(define (record-index word-seq element-seq tag content)
(make-index-element #f
(list (make-target-element #f content `(idx ,tag)))
`(idx ,tag)
word-seq
element-seq
#f))
(define (index* word-seq content-seq . s)
(let ([key (make-generated-tag)])
(record-index (map clean-up-index-string word-seq)
content-seq key (decode-content s))))
(define (index word-seq . s)
(let ([word-seq (if (string? word-seq) (list word-seq) word-seq)])
(apply index* word-seq word-seq s)))
(define (as-index . s)
(let ([key (make-generated-tag)]
[content (decode-content s)])
(record-index
(list (clean-up-index-string (content->string content)))
(if (= 1 (length content)) content (list (make-element #f content)))
key
content)))
(define (index-section #:title [title "Index"] #:tag [tag #f])
(make-unnumbered-part #f
`((part ,(or tag "doc-index")))
(list title)
'index
null
(make-flow (list (index-block)))
null))
;; returns an ordered list of (list tag (text ...) (element ...) index-desc)
(define (get-index-entries sec ri)
(define (compare-lists xs ys <?)
(let loop ([xs xs] [ys ys])
(cond [(and (null? xs) (null? ys)) '=]
[(null? xs) '<]
[(null? ys) '>]
[(<? (car xs) (car ys)) '<]
[(<? (car ys) (car xs)) '>]
[else (loop (cdr ys) (cdr xs))])))
;; string-ci<? as a major key, and string<? next, so "Foo" precedes "foo"
;; (define (string*<? s1 s2)
;; (or (string-ci<? s1 s2)
;; (and (not (string-ci<? s2 s1)) (string<? s1 s2))))
(define (get-desc entry)
(let ([desc (cadddr entry)])
(cond [(exported-index-desc? desc)
(cons 'libs (map (lambda (l)
(format "~s" l))
(exported-index-desc-from-libs desc)))]
[(module-path-index-desc? desc) '(mod)]
[(part-index-desc? desc) '(part)]
[(delayed-index-desc? desc) '(delayed)]
[else '(#f)])))
;; parts first, then modules, then bindings, delayed means it's not
;; the last round, and #f means no desc
(define desc-order '(part mod libs delayed #f))
;; this defines an imposed ordering for module names
(define lib-order '(#rx"^scheme(?:/|$)" #rx"^r.rs(?:/|$)" #rx"^lang(?:/|$)"))
(define (lib<? lib1 lib2)
(define (lib-level lib)
(let loop ([i 0] [rxs lib-order])
(if (or (null? rxs) (regexp-match? (car rxs) lib))
i (loop (add1 i) (cdr rxs)))))
(let ([l1 (lib-level lib1)] [l2 (lib-level lib2)])
(if (= l1 l2) (string<? lib1 lib2) (< l1 l2))))
(define (compare-desc e1 e2)
(let* ([d1 (get-desc e1)] [d2 (get-desc e2)]
[t1 (car d1)] [t2 (car d2)])
(cond [(memq t2 (cdr (memq t1 desc-order))) '<]
[(memq t1 (cdr (memq t2 desc-order))) '>]
[else (case t1 ; equal to t2
[(part) '=] ; will just compare tags
[(mod) '=] ; the text fields are the names of the modules
[(libs) (compare-lists (cdr d1) (cdr d2) lib<?)]
[(delayed) '>] ; dosn't matter, will run again
[(#f) '=])])))
(define (entry<? e1 e2)
(let ([text1 (cadr e1)] [text2 (cadr e2)])
(case (compare-lists text1 text2 string-ci<?)
[(<) #t] [(>) #f]
[else (case (compare-desc e1 e2)
[(<) #t] [(>) #f]
[else (case (compare-lists text1 text2 string<?)
[(<) #t] [(>) #f]
[else
;; (error 'get-index-entries
;; ;; when this happens, revise this code so
;; ;; ordering will always be deterministic
;; "internal error -- unordered entries: ~e ~e"
;; e1 e2)
;; Instead, just compare the tags
(string<? (format "~a" (car e1))
(format "~a" (car e2)))])])])))
(define l null)
(hash-for-each
(let ([parent (collected-info-parent (part-collected-info sec ri))])
(if parent
(collected-info-info (part-collected-info parent ri))
(collect-info-ext-ht (resolve-info-ci ri))))
(lambda (k v)
(when (and (pair? k) (eq? 'index-entry (car k)))
(set! l (cons (cons (cadr k) v) l)))))
(sort l entry<?))
(define (index-block)
(define alpha (string->list "ABCDEFGHIJKLMNOPQRSTUVWXYZ"))
(define (rows . rows)
(make-table 'index (map (lambda (row)
(list (make-flow (list (make-paragraph row)))))
rows)))
(define contents
(lambda (renderer sec ri)
(define l (get-index-entries sec ri))
(define manual-newlines? (send renderer index-manual-newlines?))
(define alpha-starts (make-hasheq))
(define alpha-row
(let loop ([i l] [alpha alpha])
(define (add-letter let l)
(list* (make-element "nonavigation" (list (string let))) " " l))
(cond [(null? alpha) null]
[(null? i) (add-letter (car alpha) (loop i (cdr alpha)))]
[else
(let* ([strs (cadr (car i))]
[letter (if (or (null? strs) (string=? "" (car strs)))
#f
(char-upcase (string-ref (car strs) 0)))])
(cond [(not letter) (loop (cdr i) alpha)]
[(char-ci>? letter (car alpha))
(add-letter (car alpha) (loop i (cdr alpha)))]
[(char-ci=? letter (car alpha))
(hash-set! alpha-starts (car i) letter)
(list* (make-element
(make-target-url (format "#alpha:~a" letter)
#f)
(list (string (car alpha))))
" "
(loop (cdr i) (cdr alpha)))]
[else (loop (cdr i) alpha)]))])))
(define body
(let ([br (if manual-newlines? (make-element 'newline '("\n")) "")])
(map (lambda (i)
(let ([e (make-link-element
"indexlink"
`(,@(add-between (caddr i) ", ") ,br)
(car i))])
(cond [(hash-ref alpha-starts i #f)
=> (lambda (let)
(make-element
(make-url-anchor
(format "alpha:~a" (char-upcase let)))
(list e)))]
[else e])))
l)))
(if manual-newlines?
(rows alpha-row '(nbsp) body)
(apply rows alpha-row '(nbsp) (map list body)))))
(make-delayed-block contents))
;; ----------------------------------------
(provide table-of-contents
local-table-of-contents)
(define (table-of-contents)
(make-delayed-block
(lambda (renderer part ri)
(send renderer table-of-contents part ri))))
(define (local-table-of-contents #:style [style #f])
(make-delayed-block
(lambda (renderer part ri)
(send renderer local-table-of-contents part ri style))))

532
collects/scribble/core.ss Normal file
View File

@ -0,0 +1,532 @@
#lang scheme/base
(require "private/provide-structs.ss"
scheme/serialize
scheme/contract)
;; ----------------------------------------
(define-struct collect-info (ht ext-ht parts tags gen-prefix relatives parents))
(define-struct resolve-info (ci delays undef searches))
(define (part-collected-info part ri)
(hash-ref (collect-info-parts (resolve-info-ci ri))
part))
(define (collect-put! ci key val)
(let ([ht (collect-info-ht ci)])
(let ([old-val (hash-ref ht key #f)])
(when old-val
(fprintf (current-error-port)
"WARNING: collected information for key multiple times: ~e; values: ~e ~e\n"
key old-val val))
(hash-set! ht key val))))
(define (resolve-get/where part ri key)
(let ([key (tag-key key ri)])
(let ([v (hash-ref (if part
(collected-info-info (part-collected-info part ri))
(collect-info-ht (resolve-info-ci ri)))
key
#f)])
(cond
[v (values v #f)]
[part (resolve-get/where
(collected-info-parent (part-collected-info part ri))
ri key)]
[else
(values (hash-ref (collect-info-ext-ht (resolve-info-ci ri)) key #f)
#t)]))))
(define (resolve-get/ext? part ri key)
(let-values ([(v ext?) (resolve-get/where part ri key)])
(when ext?
(hash-set! (resolve-info-undef ri) (tag-key key ri) #t))
(values v ext?)))
(define (resolve-get part ri key)
(let-values ([(v ext?) (resolve-get/ext? part ri key)])
v))
(define (resolve-get/tentative part ri key)
(let-values ([(v ext?) (resolve-get/where part ri key)])
v))
(define (resolve-search search-key part ri key)
(let ([s-ht (hash-ref (resolve-info-searches ri)
search-key
(lambda ()
(let ([s-ht (make-hash)])
(hash-set! (resolve-info-searches ri)
search-key s-ht)
s-ht)))])
(hash-set! s-ht key #t))
(resolve-get part ri key))
(define (resolve-get-keys part ri key-pred)
(let ([l null])
(hash-for-each
(collected-info-info (part-collected-info part ri))
(lambda (k v) (when (key-pred k) (set! l (cons k l)))))
l))
(provide (struct-out collect-info)
(struct-out resolve-info))
;; ----------------------------------------
(provide tag?)
(define (tag? s)
(and (pair? s)
(symbol? (car s))
(pair? (cdr s))
(or (string? (cadr s))
(generated-tag? (cadr s))
(and (pair? (cadr s))
(list? (cadr s))))
(null? (cddr s))))
(provide block?)
(define (block? p)
(or (paragraph? p)
(table? p)
(itemization? p)
(nested-flow? p)
(compound-paragraph? p)
(delayed-block? p)))
(define content-symbols
#hasheq([nbsp . #t]
[mdash . #t]
[ndash . #t]
[ldquo . #t]
[rdquo . #t]
[rsquo . #t]
[prime . #t]
[rarr . #t]
[larr . #t]
[alpha . #t]
[infin . #t]
[lang . #t]
[rang . #t]))
(provide content?)
(define (content? v)
(or (string? v)
(element? v)
(and (list? v) (andmap content? v))
(delayed-element? v)
(part-relative-element? v)
(multiarg-element? v)
(hash-ref content-symbols v #f)))
(provide element-style?)
(define (element-style? s)
(or (style? s) (not s) (string? s) (symbol? s)))
(define (string-without-newline? s)
(and (string? s)
(not (regexp-match? #rx"\n" s))))
(provide-structs
[part ([tag-prefix (or/c false/c string?)]
[tags (listof tag?)]
[title-content (or/c false/c content?)]
[style style?]
[to-collect list?]
[blocks (listof block?)]
[parts (listof part?)])]
[paragraph ([style style?]
[content content?])]
[table ([style style?]
[blockss (listof (listof (or/c block? (one-of/c 'cont))))])]
[delayed-block ([resolve (any/c part? resolve-info? . -> . block?)])]
[itemization ([style style?]
[blockss (listof (listof block?))])]
[nested-flow ([style style?]
[blocks (listof block?)])]
[compound-paragraph ([style style?]
[blocks (listof block?)])]
[element ([style element-style?]
[content content?])]
[(toc-element element) ([toc-content content?])]
[(target-element element) ([tag tag?])]
[(toc-target-element target-element) ()]
[(page-target-element target-element) ()]
[(redirect-target-element target-element) ([alt-path path-string?]
[alt-anchor string?])]
[(link-element element) ([tag tag?])]
[(index-element element) ([tag tag?]
[plain-seq (and/c pair? (listof string-without-newline?))]
[entry-seq (listof content?)]
[desc any/c])]
[(image-element element) ([path (or/c path-string?
(cons/c (one-of/c 'collects)
(listof bytes?)))]
[suffixes (listof #rx"^[.]")]
[scale real?])]
[multiarg-element ([style element-style?]
[contents (listof content?)])]
[style ([name (or/c string? symbol? #f)]
[variants list?])]
;; variants:
[document-version ([text (or/c string? false/c)])]
[target-url ([addr path-string?])]
[color-variant ([color (or/c string? (list/c byte? byte? byte?))])]
[background-color-variant ([color (or/c string? (list/c byte? byte? byte?))])]
[table-columns ([styles (listof style?)])]
[table-cells ([styless (listof (listof style?))])]
[collected-info ([number (listof (or/c false/c integer?))]
[parent (or/c false/c part?)]
[info any/c])])
(provide plain)
(define plain (make-style #f null))
;; ----------------------------------------
;; Delayed element has special serialization support:
(define-struct delayed-element (resolve sizer plain)
#:property
prop:serializable
(make-serialize-info
(lambda (d)
(let ([ri (current-serialize-resolve-info)])
(unless ri
(error 'serialize-delayed-element
"current-serialize-resolve-info not set"))
(with-handlers ([exn:fail:contract?
(lambda (exn)
(error 'serialize-delayed-element
"serialization failed (wrong resolve info? delayed element never rendered?); ~a"
(exn-message exn)))])
(vector
(let ([l (delayed-element-content d ri)])
l)))))
#'deserialize-delayed-element
#f
(or (current-load-relative-directory) (current-directory))))
(provide/contract
(struct delayed-element ([resolve (any/c part? resolve-info? . -> . list?)]
[sizer (-> any)]
[plain (-> any)])))
(provide deserialize-delayed-element)
(define deserialize-delayed-element
(make-deserialize-info values values))
(provide delayed-element-content)
(define (delayed-element-content e ri)
(hash-ref (resolve-info-delays ri) e))
(provide delayed-block-blocks)
(define (delayed-block-blocks p ri)
(hash-ref (resolve-info-delays ri) p))
(provide current-serialize-resolve-info)
(define current-serialize-resolve-info (make-parameter #f))
;; ----------------------------------------
;; part-relative element has special serialization support:
(define-struct part-relative-element (collect sizer plain)
#:property
prop:serializable
(make-serialize-info
(lambda (d)
(let ([ri (current-serialize-resolve-info)])
(unless ri
(error 'serialize-part-relative-element
"current-serialize-resolve-info not set"))
(with-handlers ([exn:fail:contract?
(lambda (exn)
(error 'serialize-part-relative-element
"serialization failed (wrong resolve info? part-relative element never rendered?); ~a"
(exn-message exn)))])
(vector
(part-relative-element-content d ri)))))
#'deserialize-part-relative-element
#f
(or (current-load-relative-directory) (current-directory))))
(provide/contract
(struct part-relative-element ([collect (collect-info? . -> . list?)]
[sizer (-> any)]
[plain (-> any)])))
(provide deserialize-part-relative-element)
(define deserialize-part-relative-element
(make-deserialize-info values values))
(provide part-relative-element-content)
(define (part-relative-element-content e ci/ri)
(hash-ref (collect-info-relatives
(if (resolve-info? ci/ri) (resolve-info-ci ci/ri) ci/ri))
e))
(provide collect-info-parents)
;; ----------------------------------------
;; Delayed index entry also has special serialization support.
;; It uses the same delay -> value table as delayed-element
(define-struct delayed-index-desc (resolve)
#:mutable
#:property
prop:serializable
(make-serialize-info
(lambda (d)
(let ([ri (current-serialize-resolve-info)])
(unless ri
(error 'serialize-delayed-index-desc
"current-serialize-resolve-info not set"))
(with-handlers ([exn:fail:contract?
(lambda (exn)
(error 'serialize-index-desc
"serialization failed (wrong resolve info?); ~a"
(exn-message exn)))])
(vector
(delayed-element-content d ri)))))
#'deserialize-delayed-index-desc
#f
(or (current-load-relative-directory) (current-directory))))
(provide/contract
(struct delayed-index-desc ([resolve (any/c part? resolve-info? . -> . any)])))
(provide deserialize-delayed-index-desc)
(define deserialize-delayed-index-desc
(make-deserialize-info values values))
;; ----------------------------------------
(define-struct (collect-element element) (collect)
#:mutable
#:property
prop:serializable
(make-serialize-info
(lambda (d)
(vector (make-element
(element-style d)
(element-content d))))
#'deserialize-collect-element
#f
(or (current-load-relative-directory) (current-directory))))
(provide deserialize-collect-element)
(define deserialize-collect-element
(make-deserialize-info values values))
(provide/contract
[struct collect-element ([style element-style?]
[content content?]
[collect (collect-info? . -> . any)])])
;; ----------------------------------------
(define-struct (render-element element) (render)
#:property
prop:serializable
(make-serialize-info
(lambda (d)
(vector (make-element
(element-style d)
(element-content d))))
#'deserialize-render-element
#f
(or (current-load-relative-directory) (current-directory))))
(provide deserialize-render-element)
(define deserialize-render-element
(make-deserialize-info values values))
(provide/contract
[struct render-element ([style element-style?]
[content content?]
[render (any/c part? resolve-info? . -> . any)])])
;; ----------------------------------------
(define-struct generated-tag ()
#:property
prop:serializable
(make-serialize-info
(lambda (g)
(let ([ri (current-serialize-resolve-info)])
(unless ri
(error 'serialize-generated-tag
"current-serialize-resolve-info not set"))
(let ([t (hash-ref (collect-info-tags (resolve-info-ci ri)) g #f)])
(if t
(vector t)
(error 'serialize-generated-tag
"serialization failed (wrong resolve info?)")))))
#'deserialize-generated-tag
#f
(or (current-load-relative-directory) (current-directory))))
(provide (struct-out generated-tag))
(provide deserialize-generated-tag)
(define deserialize-generated-tag
(make-deserialize-info values values))
(provide generate-tag tag-key
current-tag-prefixes
add-current-tag-prefix)
(define (generate-tag tg ci)
(if (generated-tag? (cadr tg))
(let ([t (cadr tg)])
(list (car tg)
(let ([tags (collect-info-tags ci)])
(or (hash-ref tags t #f)
(let ([key (list* 'gentag
(hash-count tags)
(collect-info-gen-prefix ci))])
(hash-set! tags t key)
key)))))
tg))
(define (tag-key tg ri)
(if (generated-tag? (cadr tg))
(list (car tg)
(hash-ref (collect-info-tags (resolve-info-ci ri)) (cadr tg)))
tg))
(define current-tag-prefixes (make-parameter null))
(define (add-current-tag-prefix t)
(let ([l (current-tag-prefixes)])
(if (null? l)
t
(cons (car t) (append l (cdr t))))))
;; ----------------------------------------
(provide content->string
strip-aux)
(define content->string
(case-lambda
[(c)
(cond
[(element? c) (content->string (element-content c))]
[(multiarg-element? c) (content->string (multiarg-element-contents c))]
[(list? c) (apply string-append (map content->string c))]
[(part-relative-element? c) (content->string ((part-relative-element-plain c)))]
[(delayed-element? c) (content->string ((delayed-element-plain c)))]
[(string? c) c]
[else (case c
[(mdash) "---"]
[(ndash) "--"]
[(ldquo rdquo) "\""]
[(rsquo) "'"]
[(rarr) "->"]
[(lang) "<"]
[(rang) ">"]
[else (format "~s" c)])])]
[(c renderer sec ri)
(cond
[(and (link-element? c)
(null? (element-content c)))
(let ([dest (resolve-get sec ri (link-element-tag c))])
;; FIXME: this is specific to renderer
(if dest
(content->string (strip-aux
(if (pair? dest) (cadr dest) (vector-ref dest 1)))
renderer sec ri)
"???"))]
[(element? c) (content->string (element-content c) renderer sec ri)]
[(multiarg-element? c) (content->string (multiarg-element-contents c) renderer sec ri)]
[(list? c) (apply string-append
(map(lambda (e) (content->string e renderer sec ri))
c))]
[(delayed-element? c)
(content->string (delayed-element-content c ri) renderer sec ri)]
[(part-relative-element? c)
(content->string (part-relative-element-content c ri) renderer sec ri)]
[else (content->string c)])]))
(define (aux-element? e)
(and (element? e)
(let ([s (element-style e)])
(and (style? e)
(memq 'aux (style-variants s))))))
(define (strip-aux content)
(cond
[(null? content) null]
[(aux-element? content) null]
[(list? content) (map strip-aux content)]
[else content]))
;; ----------------------------------------
(provide block-width
content-width)
(define (content-width s)
(cond
[(string? s) (string-length s)]
[(list? s) (for/fold ([v 0]) ([s (in-list s)]) (+ v (content-width s)))]
[(element? s) (content-width (element-content s))]
[(multiarg-element? s) (content-width (multiarg-element-contents s))]
[(delayed-element? s) (content-width ((delayed-element-sizer s)))]
[(part-relative-element? s) (content-width ((part-relative-element-sizer s)))]
[else 1]))
(define (paragraph-width s)
(content-width (paragraph-content s)))
(define (flow-width f)
(apply max 0 (map block-width f)))
(define (block-width p)
(cond
[(paragraph? p) (paragraph-width p)]
[(table? p) (table-width p)]
[(itemization? p) (itemization-width p)]
[(nested-flow? p) (nested-flow-width p)]
[(compound-paragraph? p) (compound-paragraph-width p)]
[(delayed-block? p) 1]
[(eq? p 'cont) 0]))
(define (table-width p)
(let ([blocks (table-blockss p)])
(if (null? blocks)
0
(let loop ([blocks blocks])
(if (null? (car blocks))
0
(+ (apply max 0 (map block-width (map car blocks)))
(loop (map cdr blocks))))))))
(define (itemization-width p)
(apply max 0 (map flow-width (itemization-blockss p))))
(define (nested-flow-width p)
(+ 4 (apply max 0 (map block-width (nested-flow-blocks p)))))
(define (compound-paragraph-width p)
(apply max 0 (map block-width (compound-paragraph-blocks p))))
;; ----------------------------------------
(define (info-key? l)
(and (pair? l)
(symbol? (car l))
(pair? (cdr l))))
(provide info-key?)
(provide/contract
[part-collected-info (part? resolve-info? . -> . collected-info?)]
[collect-put! (collect-info? info-key? any/c . -> . any)]
[resolve-get ((or/c part? false/c) resolve-info? info-key? . -> . any)]
[resolve-get/tentative ((or/c part? false/c) resolve-info? info-key? . -> . any)]
[resolve-get/ext? ((or/c part? false/c) resolve-info? info-key? . -> . any)]
[resolve-search (any/c (or/c part? false/c) resolve-info? info-key? . -> . any)]
[resolve-get-keys ((or/c part? false/c) resolve-info? (info-key? . -> . any/c) . -> . any/c)])

3
collects/scribble/decode-struct.ss
View File

@ -1,6 +1,7 @@
#lang scheme/base
(require "struct.ss")
(require "core.ss"
"private/provide-structs.ss")
(provide-structs
[part-index-desc ()])

103
collects/scribble/decode.ss
View File

@ -1,5 +1,6 @@
#lang scheme/base
(require "struct.ss"
(require "core.ss"
"private/provide-structs.ss"
"decode-struct.ss"
scheme/contract
scheme/class
@ -14,19 +15,36 @@
(rename-out [decode-content decode-elements])
decode-string
whitespace?
clean-up-index-string)
clean-up-index-string
pre-content?
pre-flow?)
(define (pre-content? i)
(or (string? i)
(and (content? i)
(not (list? i)))
(and (splice? i)
(andmap pre-content? (splice-run i)))))
(define (pre-flow? i)
(or (string? i)
(and (content? i)
(not (list? i)))
(block? i)
(and (splice? i)
(andmap pre-flow? (splice-run i)))))
(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?])]
[style style?]
[content content?])]
[part-start ([depth integer?]
[tag-prefix (or/c false/c string?)]
[tags (listof tag?)]
[style any/c]
[title list?])]
[style style?]
[title content?])]
[splice ([run list?])]
[part-index-decl ([plain-seq (listof string?)]
[entry-seq list?])]
@ -67,11 +85,6 @@
null
(list (decode-compound-paragraph (reverse (skip-whitespace accum))))))
(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]
@ -82,11 +95,15 @@
[tags (if (null? tags)
(list `(part ,(make-generated-tag)))
tags)])
(make-versioned-part
(make-part
tag-prefix
(append tags k-tags)
title
style
(if vers
(make-style (style-name style)
(cons (make-document-version vers)
(style-variants style)))
style)
(let ([l (append
(map (lambda (k tag)
(make-index-element #f null tag
@ -95,8 +112,8 @@
#f))
keys k-tags)
colls)])
(if (and title (not (or (eq? 'hidden style)
(and (list? style) (memq 'hidden style)))))
(if (and title
(not (memq 'hidden (style-variants style))))
(cons (make-index-element
#f null (car tags)
(list (clean-up-index-string
@ -106,9 +123,8 @@
(make-part-index-desc))
l)
l))
(make-flow (decode-accum-para accum))
null
vers))]
(decode-accum-para accum)
null))]
[(title-decl? (car l))
(cond [(not part-depth) (error 'decode "misplaced title: ~e" (car l))]
[title (error 'decode "found extra title: ~v" (car l))]
@ -124,29 +140,26 @@
(let ([para (decode-accum-para accum)]
[part (decode-flow* (cdr l) keys colls tag-prefix tags vers style
title part-depth)])
(make-versioned-part
(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-version part)))]
(append para (list (car l)) (part-flow part))
(part-parts part)))]
[(part? (car l))
(let ([para (decode-accum-para accum)]
[part (decode-flow* (cdr l) keys colls tag-prefix tags vers style
title part-depth)])
(make-versioned-part
(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-version part)))]
(append para (part-blocks part))
(cons (car l) (part-parts part))))]
[(and (part-start? (car l))
(or (not part-depth)
((part-start-depth (car l)) . <= . part-depth)))
@ -166,14 +179,13 @@
(add1 part-depth))]
[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)))
(make-part (part-tag-prefix part)
(part-tags part)
(part-title-content part)
(part-style part)
(part-to-collect part)
para
(cons s (part-parts part))))
(if (splice? (car l))
(loop (append (splice-run (car l)) (cdr l)) s-accum)
(loop (cdr l) (cons (car l) s-accum))))))]
@ -205,29 +217,28 @@
(if m
(let ([part (loop m #t keys colls null title tag-prefix tags vers
style)])
(make-versioned-part
(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)
(part-version part)))
(append (decode-accum-para accum)
(part-blocks part))
(part-parts 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 #f title depth))
(decode-flow* l null null #f tags #f plain title depth))
(define (decode-styled-part l 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 #f)))
(part-blocks (decode-flow* l null null #f null #f plain #f #f)))
(define (match-newline-whitespace l)
(cond [(null? l) #f]
@ -246,7 +257,7 @@
(decode-part l null #f 0))
(define (decode-paragraph l)
(make-paragraph (decode-content l)))
(make-paragraph plain (decode-content l)))
(define (decode-content l)
(append-map (lambda (s) (if (string? s) (decode-string s) (list s)))
@ -256,7 +267,7 @@
(define (finish-accum para-accum)
(if (null? para-accum)
null
(list (make-paragraph (skip-whitespace (apply append (reverse para-accum)))))))
(list (make-paragraph plain (skip-whitespace (apply append (reverse para-accum)))))))
(let ([r (let loop ([l (skip-whitespace l)]
[para-accum null])
(cond
@ -274,7 +285,7 @@
(cons (list (car l)) para-accum))]))]))])
(cond
[(null? r)
(make-paragraph null)]
(make-paragraph plain null)]
[(null? (cdr r))
(car r)]
[(make-compound-paragraph #f r)])))
[(make-compound-paragraph plain r)])))

2
collects/scribble/doc/reader.ss
View File

@ -5,6 +5,6 @@ scribble/doclang
#:read scribble:read-inside
#:read-syntax scribble:read-syntax-inside
#:whole-body-readers? #t
#:wrapper1 (lambda (t) (list* 'doc '() (t)))
#:wrapper1 (lambda (t) (list* 'doc 'values '() (t)))
(require (prefix-in scribble: "../reader.ss"))

18
collects/scribble/doclang.ss
View File

@ -12,17 +12,17 @@
(define-syntax (*module-begin stx)
(syntax-case stx ()
[(_ id exprs . body)
[(_ id post-process exprs . body)
#'(#%module-begin
(doc-begin id exprs . body))]))
(doc-begin id post-process exprs . body))]))
(define-syntax (doc-begin stx)
(syntax-case stx ()
[(_ m-id (expr ...))
[(_ m-id post-process (expr ...))
#`(begin
(define m-id (decode (list . #,(reverse (syntax->list #'(expr ...))))))
(define m-id (post-process (decode (list . #,(reverse (syntax->list #'(expr ...)))))))
(provide m-id))]
[(_ m-id exprs . body)
[(_ m-id post-process exprs . body)
;; `body' probably starts with lots of string constants; it's
;; slow to trampoline on every string, so do them in a batch
;; here:
@ -34,7 +34,7 @@
(loop #'rest (cons #'s accum))]
[()
(with-syntax ([(accum ...) accum])
#`(doc-begin m-id (accum ... . exprs)))]
#`(doc-begin m-id post-process (accum ... . exprs)))]
[(body1 . body)
(with-syntax ([exprs (append accum #'exprs)])
(let ([expanded (local-expand
@ -46,7 +46,7 @@
#%require))))])
(syntax-case expanded (begin)
[(begin body1 ...)
#`(doc-begin m-id exprs body1 ... . body)]
#`(doc-begin m-id post-process exprs body1 ... . body)]
[(id . rest)
(and (identifier? #'id)
(ormap (lambda (kw) (free-identifier=? #'id kw))
@ -57,6 +57,6 @@
define-values-for-syntax
#%require
#%provide))))
#`(begin #,expanded (doc-begin m-id exprs . body))]
#`(begin #,expanded (doc-begin m-id post-process exprs . body))]
[_else
#`(doc-begin m-id (#,expanded . exprs) . body)])))]))]))
#`(doc-begin m-id post-process (#,expanded . exprs) . body)])))]))]))

14
collects/scribble/eval.ss
View File

@ -90,13 +90,13 @@
(if (flow? p)
p
(make-flow (list p))))))
(format-output (cadar val-list+outputs) "schemestdout")
(format-output (caddar val-list+outputs) "schemeerror")
(format-output (cadar val-list+outputs) output-color)
(format-output (caddar val-list+outputs) error-color)
(if (string? (caar val-list+outputs))
;; Error result case:
(map
(lambda (s)
(car (format-output s "schemeerror")))
(car (format-output s error-color)))
(let sloop ([s (caar val-list+outputs)])
(if ((string-length s) . > . maxlen)
;; break the error message into multiple lines:
@ -117,8 +117,8 @@
(list (make-flow (list (make-paragraph
(list
(hspace 2)
(span-class "schemeresult"
(to-element/no-color v))))))))
(elem #:style result-color
(to-element/no-color v))))))))
val-list))))
(loop (cdr expr-paras)
(cdr val-list+outputs)
@ -313,8 +313,8 @@
(define (show-val v)
(span-class "schemeresult"
(to-element/no-color v)))
(elem #:style result-color
(to-element/no-color v)))
(define (do-interaction-eval-show ev e)
(parameterize ([current-command-line-arguments #()])

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

File diff suppressed because it is too large Load Diff

16
collects/scribble/html-variants.ss Normal file
View File

@ -0,0 +1,16 @@
#lang scheme/base
(require "private/provide-structs.ss"
scheme/contract)
(provide-structs
[body-id ([value string?])]
[hover-variant ([text string?])]
[script-variant ([type string?]
[script (or/c path-string? (listof string?))])]
[css-addition ([path (or/c path-string? (cons/c 'collects (listof bytes?)))])]
[html-defaults ([prefix-path (or/c bytes? path-string? (cons/c 'collects (listof bytes?)))]
[style-path (or/c bytes? path-string? (cons/c 'collects (listof bytes?)))]
[extra-files (listof (or/c path-string? (cons/c 'collects (listof bytes?))))])]
[url-anchor ([name string?])]
[attributes ([assoc (listof (cons/c symbol? string?))])])

537
collects/scribble/latex-render.ss
View File

@ -1,6 +1,8 @@
#lang scheme/base
(require "struct.ss"
(require "core.ss"
"latex-variants.ss"
"private/render-utils.ss"
scheme/class
scheme/runtime-path
scheme/port
@ -20,11 +22,15 @@
(define-runtime-path scribble-prefix-tex "scribble-prefix.tex")
(define-runtime-path scribble-tex "scribble.tex")
(define-runtime-path scribble-style-tex "scribble-style.tex")
(define (gif-to-png p)
(if (equal? (filename-extension p) #"gif")
(path-replace-suffix p #".png")
p))
(define (color->string c)
(if (string? c)
c
(format "~a,~a,~a"
(/ (car c) 255.0)
(/ (cadr c) 255.0)
(/ (caddr c) 255.0))))
(define (render-mixin %)
(class %
@ -33,48 +39,76 @@
(define/override (get-suffix) #".tex")
(inherit render-block
render-content
render-part
install-file
format-number
extract-part-style-files)
extract-part-style-files
extract-version
extract-authors
extract-pretitle)
(define/override (auto-extra-files? v) (latex-defaults? v))
(define/override (auto-extra-files-paths v) (latex-defaults-extra-files v))
(define/override (render-one d ri fn)
(let ([style-file (or style-file scribble-tex)]
[prefix-file (or prefix-file scribble-prefix-tex)])
(let* ([defaults (ormap (lambda (v) (and (latex-defaults? v) v))
(style-variants (part-style d)))]
[prefix-file (or prefix-file
(and defaults
(let ([v (latex-defaults-prefix defaults)])
(cond
[(bytes? v) v]
[else (main-collects-relative->path v)])))
scribble-prefix-tex)]
[style-file (or style-file
(and defaults
(let ([v (latex-defaults-style defaults)])
(cond
[(bytes? v) v]
[else (main-collects-relative->path v)])))
scribble-style-tex)])
(for-each
(lambda (style-file)
(with-input-from-file style-file
(lambda ()
(copy-port (current-input-port) (current-output-port)))))
(list* prefix-file style-file
(append style-extra-files
(extract-part-style-files
(if (bytes? style-file)
(display style-file)
(with-input-from-file style-file
(lambda ()
(copy-port (current-input-port) (current-output-port))))))
(list* prefix-file
scribble-tex
(append (extract-part-style-files
d
ri
'tex
(lambda (p) #f)))))
(lambda (p) #f)
tex-addition?
tex-addition-path)
(list style-file)
style-extra-files)))
(printf "\\begin{document}\n\\preDoc\n")
(when (part-title-content d)
(let ([m (ormap (lambda (v)
(and (styled-paragraph? v)
(equal? "author" (styled-paragraph-style v))
v))
(flow-paragraphs (part-flow d)))])
(when m
(do-render-paragraph m d ri #t)))
(let ([vers (or (and (versioned-part? d) (versioned-part-version d))
(version))])
(printf "\\titleAnd~aVersion{" (if (equal? vers "") "Empty" ""))
(let ([vers (extract-version d)]
[pres (extract-pretitle d)]
[auths (extract-authors d)])
(for ([pre (in-list pres)])
(do-render-paragraph pre d ri #t))
(printf "\\titleAnd~aVersionAnd~aAuthors{"
(if (equal? vers "") "Empty" "")
(if (null? auths) "Empty" ""))
(render-content (part-title-content d) d ri)
(printf "}{~a}\n" vers)))
(printf "}{~a}{" vers)
(for/fold ([first? #t]) ([auth (in-list auths)])
(unless first? (printf "\\SAuthorSep{}"))
(do-render-paragraph auth d ri #t)
#f)
(printf "}\n")))
(render-part d ri)
(printf "\n\n\\postDoc\n\\end{document}\n")))
(define/override (render-part-content d ri)
(let ([number (collected-info-number (part-collected-info d ri))])
(when (and (part-title-content d) (pair? number))
(when (part-style? d 'index)
(when (eq? (style-name (part-style d)) 'index)
(printf "\\twocolumn\n\\parskip=0pt\n\\addcontentsline{toc}{section}{Index}\n"))
(let ([no-number? (and (pair? number)
(or (not (car number))
@ -96,38 +130,32 @@
(printf "{")
(render-content (part-title-content d) d ri)
(printf "}")
(when (part-style? d 'index) (printf "\n\n")))
(when (eq? (style-name (part-style d)) 'index) (printf "\n\n")))
(for ([t (part-tags d)])
(printf "\\label{t:~a}\n\n" (t-encode (add-current-tag-prefix (tag-key t ri)))))
(render-flow (part-flow d) d ri #f)
(render-flow (part-blocks d) d ri #f)
(for ([sec (part-parts d)]) (render-part sec ri))
(when (part-style? d 'index) (printf "\\onecolumn\n\n"))
(when (eq? (style-name (part-style d)) 'index) (printf "\\onecolumn\n\n"))
null))
(define/override (render-paragraph p part ri)
(do-render-paragraph p part ri #f))
(define/private (do-render-paragraph p part ri author?)
(let ([style (and (styled-paragraph? p)
(let ([s (flatten-style
(styled-paragraph-style p))])
(if (with-attributes? s)
(let ([base (with-attributes-style s)])
(if (eq? base 'div)
(let ([a (assq 'class (with-attributes-assoc s))])
(if a
(cdr a)
base))
base))
s)))])
(unless (and (not author?)
(equal? style "author"))
(when (string? style)
(printf "\\~a{" style))
(if (toc-paragraph? p)
(printf "\\newpage \\tableofcontents \\newpage")
(super render-paragraph p part ri))
(when (string? style) (printf "}"))))
(define/private (do-render-paragraph p part ri show-pre?)
(let* ([sn (style-name (paragraph-style p))]
[style (if (eq? sn 'author)
"SAuthor"
sn)])
(unless (and (not show-pre?)
(or (eq? sn 'author)
(eq? sn 'pretitle)))
(let ([use-style? (string? style)])
(when use-style?
(printf "\\~a{" style))
(if (toc-paragraph? p)
(printf "\\newpage \\tableofcontents \\newpage")
(super render-paragraph p part ri))
(when use-style? (printf "}")))))
null)
(define/override (render-intrapara-block p part ri first? last? starting-item?)
@ -136,91 +164,131 @@
(begin0
(super render-intrapara-block p part ri first? last? starting-item?)))
(define/override (render-element e part ri)
(define/override (render-content e part ri)
(when (render-element? e)
((render-element-render e) this part ri))
(let ([part-label? (and (link-element? e)
(pair? (link-element-tag e))
(eq? 'part (car (link-element-tag e)))
(null? (element-content e)))])
(empty-content? (element-content e)))])
(parameterize ([done-link-page-numbers (or (done-link-page-numbers)
(link-element? e))])
(when (target-element? e)
(printf "\\label{t:~a}"
(t-encode (add-current-tag-prefix (tag-key (target-element-tag e) ri)))))
(when part-label?
(printf "\\SecRef{")
(render-content
(let ([dest (resolve-get part ri (link-element-tag e))])
(let ([dest (resolve-get part ri (link-element-tag e))])
(printf "\\~aRef~a{"
(case (and dest (length (cadr dest)))
[(0) "Book"]
[(1) "Chap"]
[else "Sec"])
(if (let ([s (element-style e)])
(and (style? s) (memq 'uppercase (style-variants s))))
"UC"
""))
(render-content
(if dest
(if (list? (cadr dest))
(format-number (cadr dest) null)
(begin (fprintf (current-error-port)
"Internal tag error: ~s -> ~s\n"
(link-element-tag e)
dest)
'("!!!")))
(list "???")))
part ri)
(printf "}{"))
(let ([style (and (element? e)
(let ([s (flatten-style (element-style e))])
(if (with-attributes? s)
(with-attributes-style s)
s)))]
[wrap (lambda (e s tt?)
(printf "\\~a{" s)
(parameterize ([rendering-tt (or tt? (rendering-tt))])
(super render-element e part ri))
(printf "}"))])
(cond
[(symbol? style)
(case style
[(italic) (wrap e "textit" #f)]
[(bold) (wrap e "textbf" #f)]
[(tt) (wrap e "Scribtexttt" #t)]
[(url) (wrap e "nolinkurl" 'exact)]
[(no-break) (super render-element e part ri)]
[(sf) (wrap e "textsf" #f)]
[(subscript) (wrap e "textsub" #f)]
[(superscript) (wrap e "textsuper" #f)]
[(hspace)
(let ([s (content->string (element-content e))])
(case (string-length s)
[(0) (void)]
[else
(printf "\\mbox{\\hphantom{\\Scribtexttt{~a}}}"
(regexp-replace* #rx"." s "x"))]))]
[(newline) (printf "\\\\")]
[else (error 'latex-render
"unrecognzied style symbol: ~s" style)])]
[(target-url? style)
(wrap e (format "href{~a}" (target-url-addr style)) #f)]
[(string? style)
(wrap e style (regexp-match? #px"^scheme(?!error)" style))]
[(and (pair? style) (memq (car style) '(bg-color color)))
(wrap e (format
"~a{~a}"
(format (if (eq? (car style) 'bg-color)
"in~acolorbox" "intext~acolor")
(if (= (length style) 2) "" "rgb"))
(if (= (length style) 2)
(cadr style)
(format "~a,~a,~a"
(/ (cadr style) 255.0)
(/ (caddr style) 255.0)
(/ (cadddr style) 255.0))))
#f)]
[(image-file? style)
(if (disable-images)
(void)
(let ([fn (install-file
(gif-to-png
(main-collects-relative->path
(image-file-path style))))])
(printf "\\includegraphics[scale=~a]{~a}"
(image-file-scale style) fn)))]
[else (super render-element e part ri)])))
(if (list? (cadr dest))
(format-number (cadr dest) null)
(begin (fprintf (current-error-port)
"Internal tag error: ~s -> ~s\n"
(link-element-tag e)
dest)
'("!!!")))
(list "???"))
part ri)
(printf "}{")))
(let* ([es (cond
[(element? e) (element-style e)]
[(multiarg-element? e) (multiarg-element-style e)]
[else #f])]
[style-name (if (style? es)
(style-name es)
es)]
[style (and (style? es) es)]
[core-render (lambda (e tt?)
(if (and (image-element? e)
(not (disable-images)))
(let ([fn (install-file
(select-suffix
(main-collects-relative->path
(image-element-path e))
(image-element-suffixes e)
'(".pdf" ".ps" ".png")))])
(printf "\\includegraphics[scale=~a]{~a}"
(image-element-scale e) fn))
(parameterize ([rendering-tt (or tt? (rendering-tt))])
(super render-content e part ri))))]
[wrap (lambda (e s tt?)
(printf "\\~a{" s)
(core-render e tt?)
(printf "}"))])
(define (finish tt?)
(cond
[(symbol? style-name)
(case style-name
[(italic) (wrap e "textit" tt?)]
[(bold) (wrap e "textbf" tt?)]
[(tt) (wrap e "Scribtexttt" #t)]
[(url) (wrap e "nolinkurl" 'exact)]
[(no-break) (core-render e tt?)]
[(sf) (wrap e "textsf" #f)]
[(subscript) (wrap e "textsub" #f)]
[(superscript) (wrap e "textsuper" #f)]
[(smaller) (wrap e "Smaller" #f)]
[(larger) (wrap e "Larger" #f)]
[(hspace)
(let ([s (content->string e)])
(case (string-length s)
[(0) (void)]
[else
(printf "\\mbox{\\hphantom{\\Scribtexttt{~a}}}"
(regexp-replace* #rx"." s "x"))]))]
[(newline) (printf "\\\\")]
[else (error 'latex-render
"unrecognzied style symbol: ~s" style)])]
[(string? style-name)
(let* ([v (if style (style-variants style) null)]
[tt? (cond
[(memq 'tt-chars v) #t]
[(memq 'exact-chars v) 'exact]
[else tt?])])
(cond
[(multiarg-element? e)
(printf "\\~a" style-name)
(if (null? (multiarg-element-contents e))
(printf "{}")
(for ([i (in-list (multiarg-element-contents e))])
(printf "{")
(render-content i part ri)
(printf "}")))]
[else
(wrap e style-name tt?)]))]
[else
(core-render e tt?)]))
(let loop ([l (if style (style-variants style) null)] [tt? #f])
(if (null? l)
(finish tt?)
(let ([v (car l)])
(cond
[(target-url? v)
(printf "\\href{~a}{" (target-url-addr v))
(loop (cdr l) #t)
(printf "}")]
[(color-variant? v)
(printf "\\intext~acolor{~a}{"
(if (string? (color-variant-color v)) "" "rgb")
(color->string (color-variant-color v)))
(loop (cdr l) tt?)
(printf "}")]
[(background-color-variant? v)
(printf "\\in~acolorbox{~a}{"
(if (string? (background-color-variant-color v)) "" "rgb")
(color->string (background-color-variant-color v)))
(loop (cdr l) tt?)
(printf "}")]
[else (loop (cdr l) tt?)]))))))
(when part-label?
(printf "}"))
(when (and (link-element? e)
@ -244,60 +312,70 @@
(string->list (format "~s" s)))))
(define/override (render-flow p part ri starting-item?)
(if (null? (flow-paragraphs p))
(if (null? p)
null
(begin
(render-block (car (flow-paragraphs p)) part ri starting-item?)
(for ([b (in-list (cdr (flow-paragraphs p)))])
(render-block (car p) part ri starting-item?)
(for ([b (in-list (cdr p))])
(printf "\n\n")
(render-block b part ri #f))
null)))
(define/override (render-table t part ri starting-item?)
(let* ([boxed? (eq? 'boxed (table-style t))]
[index? (eq? 'index (table-style t))]
(render-table* t part ri starting-item? "[t]"))
(define/private (render-table* t part ri starting-item? alignment)
(let* ([s-name (style-name (table-style t))]
[boxed? (eq? 'boxed s-name)]
[index? (eq? 'index s-name)]
[tableform
(cond [index? "list"]
[(not (current-table-mode)) "bigtabular"]
[else "tabular"])]
[opt (cond [(equal? tableform "bigtabular") ""]
[(equal? tableform "tabular") "[t]"]
[(equal? tableform "tabular") alignment]
[else ""])]
[flowss (if index? (cddr (table-flowss t)) (table-flowss t))]
[row-styles (cdr (or (and (list? (table-style t))
(assoc 'row-styles (table-style t)))
(cons #f (map (lambda (x) #f) flowss))))]
[twidth (if (null? (table-flowss t))
[blockss (if index? (cddr (table-blockss t)) (table-blockss t))]
[cell-styless (extract-table-cell-styles t)]
[twidth (if (null? (table-blockss t))
1
(length (car (table-flowss t))))]
(length (car (table-blockss t))))]
[single-column? (and (= 1 twidth)
(or (not (table-style t))
(string? (table-style t)))
(or (not s-name) (string? s-name))
(not (ormap (lambda (cell-styles)
(ormap (lambda (s)
(or (string? (style-name s))
(let ([l (style-variants s)])
(or (memq 'right l)
(memq 'center l)))))
cell-styles))
cell-styless))
(not (current-table-mode)))]
[inline?
(and (not single-column?)
(not boxed?)
(not index?)
(ormap (lambda (rs) (equal? rs "inferencetop")) row-styles)
(ormap (lambda (rs)
(ormap (lambda (cs) (style-name cs)) rs))
cell-styless)
(= 1 twidth)
(let ([m (current-table-mode)])
(and m
(equal? "bigtabular" (car m))
(= 1 (length (car (table-flowss (cadr m))))))))]
(= 1 (length (car (table-blockss (cadr m))))))))]
[boxline "{\\setlength{\\unitlength}{\\linewidth}\\begin{picture}(1,0)\\put(0,0){\\line(1,0){1}}\\end{picture}}"])
(if single-column?
(begin
(when (string? (table-style t))
(printf "\\begin{~a}" (table-style t)))
(do-render-blockquote
(make-blockquote "SingleColumn"
(apply append (map flow-paragraphs (map car (table-flowss t)))))
(when (string? s-name)
(printf "\\begin{~a}" s-name))
(do-render-nested-flow
(make-nested-flow (make-style "SingleColumn" null) (map car (table-blockss t)))
part
ri
#t)
(when (string? (table-style t))
(printf "\\end{~a}" (table-style t))))
(unless (or (null? flowss) (null? (car flowss)))
(when (string? s-name)
(printf "\\end{~a}" s-name)))
(unless (or (null? blockss) (null? (car blockss)))
(parameterize ([current-table-mode
(if inline? (current-table-mode) (list tableform t))]
[show-link-page-numbers
@ -311,8 +389,8 @@
(if (and starting-item? (equal? tableform "bigtabular"))
"\\bigtableinlinecorrect"
"")
(if (string? (table-style t))
(format "\\begin{~a}" (table-style t))
(if (string? s-name)
(format "\\begin{~a}" s-name)
"")
tableform
opt
@ -320,36 +398,27 @@
"\\bigtableleftpad"
"")
(string-append*
(map (lambda (i align)
(map (lambda (i cell-style)
(format "~a@{}"
(case align
[(center) "c"]
[(right) "r"]
[else "l"])))
(car flowss)
(cdr (or (and (list? (table-style t))
(assoc 'alignment
(or (table-style t) null)))
(cons #f (map (lambda (x) #f)
(car flowss)))))))
(cond
[(memq 'center (style-variants cell-style)) "c"]
[(memq 'right (style-variants cell-style)) "r"]
[else "l"])))
(car blockss)
(car cell-styless)))
(if boxed?
(if (equal? tableform "bigtabular")
(format "~a \\SEndFirstHead\n" boxline)
(format "\\multicolumn{~a}{@{}l@{}}{~a} \\\\\n"
(length (car flowss))
(length (car blockss))
boxline))
""))])
(let loop ([flowss flowss]
[row-styles row-styles])
(let ([flows (car flowss)]
[row-style (car row-styles)])
(let loop ([blockss blockss]
[cell-styless cell-styless])
(let ([flows (car blockss)]
[cell-styles (car cell-styless)])
(let loop ([flows flows]
[col-v-styles (or (and (list? row-style)
(let ([p (assoc 'valignment row-style)])
(and p (cdr p))))
(let ([p (and (list? (table-style t))
(assoc 'valignment (table-style t)))])
(and p (cdr p))))])
[cell-styles cell-styles])
(unless (null? flows)
(when index? (printf "\n\\item "))
(unless (eq? 'cont (car flows))
@ -359,110 +428,103 @@
(loop (cdr flows) (add1 n))]
[else n]))])
(unless (= cnt 1) (printf "\\multicolumn{~a}{l}{" cnt))
(render-table-flow (car flows) part ri twidth (and col-v-styles
(car col-v-styles)))
(render-table-cell (car flows) part ri twidth (car cell-styles))
(unless (= cnt 1) (printf "}"))
(unless (null? (list-tail flows cnt)) (printf " &\n"))))
(unless (null? (cdr flows)) (loop (cdr flows)
(and col-v-styles (cdr col-v-styles))))))
(unless (or index? (null? (cdr flowss)))
(printf " \\\\\n")
(when (equal? row-style "inferencetop") (printf "\\hline\n")))
(unless (null? (cdr flowss))
(loop (cdr flowss) (cdr row-styles)))))
(cdr cell-styles)))))
(unless (or index? (null? (cdr blockss)))
(printf " \\\\\n"))
(unless (null? (cdr blockss))
(loop (cdr blockss) (cdr cell-styless)))))
(unless inline?
(printf "\\end{~a}~a"
tableform
(if (string? (table-style t))
(format "\\end{~a}" (table-style t))
(if (string? s-name)
(format "\\end{~a}" s-name)
"")))))))
null)
(define/private (render-table-flow p part ri twidth vstyle)
;; Emit a \\ between blocks in single-column mode,
;; used a nested table otherwise for multiple elements.
(let ([in-table? (or (and (not (= twidth 1))
((length (flow-paragraphs p)) . > . 1))
(eq? vstyle 'top))])
(when in-table?
(printf "\\begin{tabular}~a{@{}l@{}}\n"
(cond
[(eq? vstyle 'top) "[t]"]
[(eq? vstyle 'center) "[c]"]
[else ""])))
(let loop ([ps (flow-paragraphs p)])
(cond
[(null? ps) (void)]
[else
(let ([minipage? (or (not (or (paragraph? (car ps))
(table? (car ps))))
(eq? vstyle 'center))])
(define/private (render-table-cell p part ri twidth vstyle)
(let ([top? (memq 'top (style-variants vstyle))]
[center? (memq 'vcenter (style-variants vstyle))])
(when (style-name vstyle)
(printf "\\~a{" (style-name vstyle)))
(let ([minipage? (and (not (table? p))
(or (not (paragraph? p))
top?
center?))])
(when minipage?
(printf "\\begin{minipage}~a{~a\\linewidth}\n"
(cond
[(eq? vstyle 'top) "[t]"]
[(eq? vstyle 'center) "[c]"]
[top? "[t]"]
[center? "[c]"]
[else ""])
(/ 1.0 twidth)))
(render-block (car ps) part ri #f)
(if (table? p)
(render-table* p part ri #f (cond
[center? "[c]"]
[else "[t]"]))
(render-block p part ri #f))
(when minipage?
(printf " \\end{minipage}\n"))
(unless (null? (cdr ps))
(printf " \\\\\n")
(when in-table?
(printf " ~ \\\\\n"))
(loop (cdr ps))))]))
(when in-table?
(printf "\n\\end{tabular}"))
(printf " \\end{minipage}\n")))
(when (style-name vstyle)
(printf "}"))
null))
(define/override (render-itemization t part ri)
(let* ([style-str (and (styled-itemization? t)
(string? (styled-itemization-style t))
(styled-itemization-style t))]
[mode (or style-str
(if (and (styled-itemization? t)
(eq? (styled-itemization-style t) 'ordered))
(let* ([style-str (let ([s (style-name (itemization-style t))])
(if (eq? s 'compact)
"compact"
s))]
[mode (or (and (string? style-str)
style-str)
(if (eq? 'ordered style-str)
"enumerate"
"itemize"))])
(printf "\\begin{~a}\\atItemizeStart" mode)
(for ([flow (itemization-flows t)])
(printf "\n\n\\~a" (if style-str
(for ([flow (in-list (itemization-blockss t))])
(printf "\n\n\\~a" (if (string? style-str)
(format "~aItem{" style-str)
"item "))
(render-flow flow part ri #t)
(when style-str
(when (string? style-str)
(printf "}")))
(printf "\\end{~a}" mode)
null))
(define/private (do-render-blockquote t part ri single-column?)
(let ([kind (or (blockquote-style t) "quote")])
(if (regexp-match #rx"^[\\]" kind)
(printf "~a{" kind)
(define/private (do-render-nested-flow t part ri single-column?)
(let ([kind (or (let ([s (style-name (nested-flow-style t))])
(or (and (string? s) s)
(and (eq? s 'inset) "quote")))
"Subflow")]
[command? (memq 'command (style-variants (nested-flow-style t)))])
(if command?
(printf "\\~a{" kind)
(printf "\\begin{~a}" kind))
(parameterize ([current-table-mode (if (or single-column?
(not (current-table-mode)))
(current-table-mode)
(list "blockquote" t))])
(render-flow (make-flow (blockquote-paragraphs t)) part ri #f))
(if (regexp-match #rx"^[\\]" kind)
(list "nested-flow" t))])
(render-flow (nested-flow-blocks t) part ri #f))
(if command?
(printf "}")
(printf "\\end{~a}" kind))
null))
(define/override (render-blockquote t part ri)
(do-render-blockquote t part ri #f))
(define/override (render-nested-flow t part ri)
(do-render-nested-flow t part ri #f))
(define/override (render-compound-paragraph t part ri starting-item?)
(let ([kind (compound-paragraph-style t)])
(let ([kind (style-name (compound-paragraph-style t))]
[command? (memq 'command (style-variants (compound-paragraph-style t)))])
(when kind
(if (regexp-match #rx"^[\\]" kind)
(printf "~a{" kind)
(if command?
(printf "\\~a{" kind)
(printf "\\begin{~a}" kind)))
(super render-compound-paragraph t part ri starting-item?)
(when kind
(if (regexp-match #rx"^[\\]" kind)
(if command?
(printf "}")
(printf "\\end{~a}" kind)))
null))
@ -480,6 +542,7 @@
[(rsquo) "'"]
[(prime) "$'$"]
[(rarr) "$\\rightarrow$"]
[(larr) "$\\leftarrow$"]
[(alpha) "$\\alpha$"]
[(infin) "$\\infty$"]
[(lang) "$\\langle$"]
@ -674,10 +737,10 @@
(define/override (table-of-contents sec ri)
;; FIXME: isn't local to the section
(make-toc-paragraph null))
(make-toc-paragraph plain null))
(define/override (local-table-of-contents part ri style)
(make-paragraph null))
(make-paragraph plain null))
;; ----------------------------------------

9
collects/scribble/latex-variants.ss Normal file
View File

@ -0,0 +1,9 @@
#lang scheme/base
(require "private/provide-structs.ss"
scheme/contract)
(provide-structs
[tex-addition ([path (or/c path-string? (cons/c 'collects (listof bytes?)))])]
[latex-defaults ([prefix (or/c bytes? path-string? (cons/c 'collects (listof bytes?)))]
[style (or/c bytes? path-string? (cons/c 'collects (listof bytes?)))]
[extra-files (listof (or/c path-string? (cons/c 'collects (listof bytes?))))])])

12
collects/scribble/manual-prefix.tex Normal file
View File

@ -0,0 +1,12 @@
% This is the prefix for PLT Scheme manuals
\documentclass{article}
\parskip=10pt
\parindent=0pt
\partopsep=0pt
% Adjust margins to match HTML width for
% fixed-width font
\advance \oddsidemargin by -0.15in
\advance \evensidemargin by -0.15in
\advance \textwidth by 0.3in

3
collects/scribble/manual-struct.ss
View File

@ -1,6 +1,7 @@
#lang scheme/base
(require "struct.ss"
(require "core.ss"
"private/provide-structs.ss"
scheme/contract)
(provide-structs

11
collects/scribble/manual-style.tex Normal file
View File

@ -0,0 +1,11 @@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Re-definitions for the PLT Scheme manual style
\renewcommand{\sectionNewpage}{\newpage}
\renewcommand{\preDoc}{\sloppy}
\renewcommand{\ChapRef}[2]{\SecRef{#1}{#2}}
\renewcommand{\SecRef}[2]{\S#1 ``#2''}
\renewcommand{\ChapRefUC}[2]{\SecRefUC{#1}{#2}}
\renewcommand{\SecRefUC}[2]{\SecRef{#1}{#2}}

4
collects/scribble/manual.ss
View File

@ -1,5 +1,5 @@
#lang scheme/base
(require "basic.ss"
(require "base.ss"
"private/manual-style.ss"
"private/manual-scheme.ss"
"private/manual-mod.ss"
@ -15,7 +15,7 @@
(provide unsyntax
make-binding-redirect-elements
defidentifier
(all-from-out "basic.ss"
(all-from-out "base.ss"
"private/manual-style.ss"
"private/manual-scheme.ss"
"private/manual-mod.ss"

21
collects/scribble/manual/lang.ss
View File

@ -1,4 +1,17 @@
#lang scheme
(require scribble/doclang scribble/manual)
(provide (all-from-out scribble/doclang
scribble/manual))
#lang scheme/base
(require scribble/doclang
scribble/manual
"../private/defaults.ss")
(provide (except-out (all-from-out scribble/doclang) #%module-begin)
(all-from-out scribble/manual)
(rename-out [module-begin #%module-begin]))
(define-syntax-rule (module-begin id . body)
(#%module-begin id post-process () . body))
(define (post-process doc)
(add-defaults doc
(scribble-file "manual-prefix.tex")
(scribble-file "manual-style.tex")
null
#t))

2
collects/scribble/manual/lang/reader.ss
View File

@ -5,6 +5,6 @@ scribble/manual/lang
#:read scribble:read-inside
#:read-syntax scribble:read-syntax-inside
#:whole-body-readers? #t
#:wrapper1 (lambda (t) (list* 'doc '() (t)))
#:wrapper1 (lambda (t) (cons 'doc (t)))
(require (prefix-in scribble: "../../reader.ss"))

28
collects/scribble/private/defaults.ss Normal file
View File

@ -0,0 +1,28 @@
#lang scheme/base
(require scribble/core
scribble/latex-variants
setup/main-collects)
(provide scribble-file
add-defaults)
(define (add-variant variants pred new)
(if (ormap pred variants)
variants
(cons new variants)))
(define (scribble-file s)
(path->main-collects-relative (build-path (collection-path "scribble") s)))
(define (add-defaults doc pfx styl extras version?)
(struct-copy part doc [style (make-style (style-name (part-style doc))
((if version? add-variant (lambda (x y z) x))
(add-variant
(style-variants (part-style doc))
latex-defaults?
(make-latex-defaults
pfx
styl
extras))
document-version?
(make-document-version (version))))]))

13
collects/scribble/private/manual-bind.ss
View File

@ -3,7 +3,6 @@
"../struct.ss"
"../scheme.ss"
"../search.ss"
"../config.ss"
"../basic.ss"
"../manual-struct.ss"
"manual-ex.ss"
@ -52,10 +51,10 @@
[sd (and stag (resolve-get/tentative sec ri stag))])
(list
(make-element
"schemesymbol"
symbol-color
(list
(cond [sd (make-link-element "schemesyntaxlink" (list s) stag)]
[vtag (make-link-element "schemevaluelink" (list s) vtag)]
(cond [sd (make-link-element syntax-link-color (list s) stag)]
[vtag (make-link-element value-link-color (list s) vtag)]
[else s]))))))
(lambda () s)
(lambda () s))))
@ -232,12 +231,12 @@
(list (symbol->string id))
(list
(make-element
"schemesymbol"
symbol-color
(list
(make-element
(if form?
"schemesyntaxlink"
"schemevaluelink")
syntax-link-color
value-link-color)
(list (symbol->string id))))))
((if form?
make-form-index-desc

5
collects/scribble/private/manual-class.ss
View File

@ -3,7 +3,6 @@
"../struct.ss"
"../scheme.ss"
"../search.ss"
"../config.ss"
"../basic.ss"
"../manual-struct.ss"
"qsloc.ss"
@ -134,9 +133,9 @@
`(cls/intf ,(cadr tag))
(make-cls/intf
(make-element
"schemesymbol"
symbol-color
(list (make-link-element
"schemevaluelink"
value-link-color
(list (symbol->string (syntax-e (decl-name decl))))
tag)))
(map id-info (decl-app-mixins decl))

1
collects/scribble/private/manual-form.ss
View File

@ -3,7 +3,6 @@
"../struct.ss"
"../scheme.ss"
"../search.ss"
"../config.ss"
"../basic.ss"
"../manual-struct.ss"
"qsloc.ss"

4
collects/scribble/private/manual-method.ss
View File

@ -34,8 +34,8 @@
(lambda (c mk) (mk id/tag)))
content
(lambda (tag)
(make-element "schemesymbol"
(list (make-link-element "schemevaluelink" content
(make-element symbol-color
(list (make-link-element value-link-color content
(method-tag tag sym))))))))
(define (method-tag vtag sym)

7
collects/scribble/private/manual-proc.ss
View File

@ -3,7 +3,6 @@
"../struct.ss"
"../scheme.ss"
"../search.ss"
"../config.ss"
"../basic.ss"
"../manual-struct.ss"
"qsloc.ss"
@ -27,9 +26,9 @@
*defthing)
(define dots0
(make-element "schememeta" (list "...")))
(make-element meta-color (list "...")))
(define dots1
(make-element "schememeta" (list "...+")))
(make-element meta-color (list "...+")))
(define (make-openers n)
(schemeparenfont
@ -772,7 +771,7 @@
(list content)
tag
(list name)
(list (schemeidfont (make-element "schemevaluelink"
(list (schemeidfont (make-element value-link-color
(list name))))
(with-exporting-libraries
(lambda (libs)

6
collects/scribble/private/manual-scheme.ss
View File

@ -57,9 +57,9 @@
(syntax/loc stx (schememod #:file #f lang rest ...))]))
(define (to-element/result s)
(make-element "schemeresult" (list (to-element/no-color s))))
(make-element result-color (list (to-element/no-color s))))
(define (to-element/id s)
(make-element "schemesymbol" (list (to-element/no-color s))))
(make-element symbol-color (list (to-element/no-color s))))
(define-syntax (keep-s-expr stx)
(syntax-case stx ()
@ -106,7 +106,7 @@
(define (as-modname-link s e)
(if (symbol? s)
(make-link-element "schememodlink"
(make-link-element module-link-color
(list e)
`(mod-path ,(symbol->string s)))
e))

130
collects/scribble/private/manual-style.ss
View File

@ -1,30 +1,34 @@
#lang scheme/base
(require "../decode.ss"
"../struct.ss"
"../basic.ss"
"../base.ss"
(only-in "../basic.ss" aux-elem itemize)
"../scheme.ss"
(only-in "../core.ss" make-style plain)
"manual-utils.ss"
scheme/list
scheme/string)
(provide PLaneT etc
litchar verbatim
image image/plain onscreen menuitem defterm emph
litchar
image (rename-out [image image/plain]) onscreen menuitem defterm
schemefont schemevalfont schemeresultfont schemeidfont schemevarfont
schemeparenfont schemekeywordfont schememetafont schememodfont
schemeerror
schemeerror schemeoutput
filepath exec envvar Flag DFlag PFlag DPFlag
indexed-file indexed-envvar
link procedure
(rename-out [hyperlink link])
(rename-out [other-doc other-manual])
(rename-out [centered centerline])
itemize
procedure
idefterm
t inset-flow
pidefterm
hash-lang
centerline
commandline
elemtag elemref
secref seclink other-manual
margin-note
commandline
void-const undefined-const
aux-elem
math)
(define PLaneT (make-element "planetName" '("PLaneT")))
@ -37,51 +41,20 @@
(let ([s (string-append* (map (lambda (s) (regexp-replace* "\n" s " "))
strs))])
(if (regexp-match? #rx"^ *$" s)
(make-element "schemeinputbg" (list (hspace (string-length s))))
(make-element input-background-color (list (hspace (string-length s))))
(let ([^spaces (car (regexp-match-positions #rx"^ *" s))]
[$spaces (car (regexp-match-positions #rx" *$" s))])
(make-element
"schemeinputbg"
input-background-color
(list (hspace (cdr ^spaces))
(make-element "schemeinput"
(make-element input-color
(list (substring s (cdr ^spaces) (car $spaces))))
(hspace (- (cdr $spaces) (car $spaces)))))))))
(define (verbatim #:indent [i 0] s . more)
(define indent
(if (zero? i)
values
(let ([hs (hspace i)]) (lambda (x) (cons hs x)))))
(define strs (regexp-split #rx"\n" (string-append* s more)))
(define (str->elts str)
(let ([spaces (regexp-match-positions #rx"(?:^| ) +" str)])
(if spaces
(list* (substring str 0 (caar spaces))
(hspace (- (cdar spaces) (caar spaces)))
(str->elts (substring str (cdar spaces))))
(list (make-element 'tt (list str))))))
(define (make-line str)
(let* ([line (indent (str->elts str))]
[line (list (make-element 'tt line))])
(list (make-flow (list (make-omitable-paragraph line))))))
(make-table #f (map make-line strs)))
;; String String *-> Element
;; an in-lined image, relative to the current directory
(define (image #:scale [scale 1.0] filename-relative-to-source . alt)
(make-element (make-image-file filename-relative-to-source scale)
(decode-content alt)))
(define (image/plain filename-relative-to-source . alt)
(make-element (make-image-file filename-relative-to-source 1.0)
(decode-content alt)))
(define (onscreen . str)
(make-element 'sf (decode-content str)))
(define (menuitem menu item)
(make-element 'sf (list menu "|" item)))
(define (emph . str)
(make-element 'italic (decode-content str)))
(define (defterm . str)
(make-element 'italic (decode-content str)))
(define (idefterm . str)
@ -90,21 +63,21 @@
(define (schemefont . str)
(apply tt str))
(define (schemevalfont . str)
(make-element "schemevalue" (decode-content str)))
(make-element value-color (decode-content str)))
(define (schemeresultfont . str)
(make-element "schemeresult" (decode-content str)))
(make-element result-color (decode-content str)))
(define (schemeidfont . str)
(make-element "schemesymbol" (decode-content str)))
(make-element symbol-color (decode-content str)))
(define (schemevarfont . str)
(make-element "schemevariable" (decode-content str)))
(make-element variable-color (decode-content str)))
(define (schemeparenfont . str)
(make-element "schemeparen" (decode-content str)))
(make-element paren-color (decode-content str)))
(define (schememetafont . str)
(make-element "schememeta" (decode-content str)))
(make-element meta-color (decode-content str)))
(define (schememodfont . str)
(make-element "schememod" (decode-content str)))
(make-element module-color (decode-content str)))
(define (schemekeywordfont . str)
(make-element "schemekeyword" (decode-content str)))
(make-element keyword-color (decode-content str)))
(define (filepath . str)
(make-element 'tt (append (list "\"") (decode-content str) (list "\""))))
(define (indexed-file . str)
@ -141,17 +114,12 @@
[s (element->string f)])
(index* (list s) (list f) f)))
(define (procedure . str)
(make-element "schemeresult" `("#<procedure:" ,@(decode-content str) ">")))
(define (link url
#:underline? [underline? #t]
#:style [style (if underline? #f "plainlink")]
. str)
(make-element (make-target-url url style)
(decode-content str)))
(make-element result-color `("#<procedure:" ,@(decode-content str) ">")))
(define (schemeoutput . str)
(make-element output-color (decode-content str)))
(define (schemeerror . str)
(make-element "schemeerror" (decode-content str)))
(make-element error-color (decode-content str)))
(define (t . str)
(decode-paragraph str))
@ -159,11 +127,6 @@
(define (inset-flow . c)
(make-blockquote "insetpara" (flow-paragraphs (decode-flow c))))
(define (centerline . s)
(make-blockquote "SCentered" (flow-paragraphs (decode-flow s))))
(define (commandline . s)
(make-paragraph (cons (hspace 2) (map (lambda (s)
(if (string? s)
@ -171,20 +134,6 @@
s))
s))))
(define (elemtag t . body)
(make-target-element #f (decode-content body) `(elem ,t)))
(define (elemref #:underline? [u? #t] t . body)
(make-link-element (if u? #f "plainlink") (decode-content body) `(elem ,t)))
(define (secref s #:underline? [u? #t] #:doc [doc #f] #:tag-prefixes [prefix #f])
(make-link-element (if u? #f "plainlink") null `(part ,(doc-prefix doc prefix s))))
(define (seclink tag #:underline? [u? #t] #:doc [doc #f] #:tag-prefixes [prefix #f] . s)
(make-link-element (if u? #f "plainlink") (decode-content s)
`(part ,(doc-prefix doc prefix tag))))
(define (other-manual #:underline? [u? #t] doc)
(secref #:doc doc #:underline? u? "top"))
(define (pidefterm . s)
(let ([c (apply defterm s)])
(index (string-append (content->string (element-content c)) "s")
@ -192,26 +141,21 @@
(define (hash-lang)
(make-link-element
"schememodlink"
module-link-color
(list (schememodfont "#lang"))
`(part ,(doc-prefix '(lib "scribblings/guide/guide.scrbl") "hash-lang"))))
(define (margin-note . c)
(make-blockquote
"\\refpara"
(list
(make-blockquote
"refcolumn"
(list
(make-blockquote
"refcontent"
(flow-paragraphs (decode-flow c))))))))
(define void-const
(schemeresultfont "#<void>"))
(define undefined-const
(schemeresultfont "#<undefined>"))
(define (link url
#:underline? [underline? #t]
#:style [style (if underline? #f "plainlink")]
. str)
(apply hyperlink url #:style (if style (make-style style null) plain) str))
(define (math . s)
(let ([c (decode-content s)])
(make-element
@ -243,4 +187,4 @@
(list (make-element 'italic (list i)))])]
[(eq? i 'rsquo) (list 'prime)]
[else (list i)])))
c))))
c))))

13
collects/scribble/private/manual-utils.ss
View File

@ -1,7 +1,7 @@
#lang scheme/base
(require "../struct.ss"
"../decode.ss"
"../basic.ss"
"../base.ss"
scheme/list)
(provide spacer doc-prefix
@ -12,17 +12,6 @@
(define spacer (hspace 1))
(define doc-prefix
(case-lambda
[(doc s)
(if doc
(list (module-path-prefix->string doc) s)
s)]
[(doc prefix s)
(doc-prefix doc (if prefix
(append prefix (list s))
s))]))
(define (to-flow e)
(make-flow (list (make-omitable-paragraph (list e)))))
(define flow-spacer (to-flow spacer))

3
collects/scribble/private/manual-vars.ss
View File

@ -2,6 +2,7 @@
(require "../decode.ss"
"../scheme.ss"
"../struct.ss"
(only-in "../core.ss" style-name)
(for-syntax scheme/base
syntax/kerncase
syntax/boundmap)
@ -108,7 +109,7 @@
(unless (and (box-splice? box)
(= 1 (length (splice-run box)))
(table? (car (splice-run box)))
(eq? 'boxed (table-style (car (splice-run box)))))
(eq? 'boxed (style-name (table-style (car (splice-run box))))))
(error 'deftogether
"element is not a boxing splice containing a single table: ~e"
box))

37
collects/scribble/private/provide-structs.ss Normal file
View File

@ -0,0 +1,37 @@
#lang scheme/base
(require scheme/serialize
scheme/contract
(for-syntax scheme/base))
(provide provide-structs)
(define-syntax (provide-structs stx)
(syntax-case stx ()
[(_ (id ([field ct] ...)) ...)
#`(begin
(define-serializable-struct id (field ...)) ...
(provide/contract
#,@(let ([ids (syntax->list #'(id ...))]
[fields+cts (syntax->list #'(([field ct] ...) ...))])
(define (get-fields super-id)
(ormap (lambda (id fields+cts)
(if (identifier? id)
(and (free-identifier=? id super-id)
fields+cts)
(syntax-case id ()
[(my-id next-id)
(free-identifier=? #'my-id super-id)
#`[#,@(get-fields #'next-id)
#,@fields+cts]]
[_else #f])))
ids fields+cts))
(map (lambda (id fields+cts)
(if (identifier? id)
#`[struct #,id #,fields+cts]
(syntax-case id ()
[(id super)
#`[struct id (#,@(get-fields #'super)
#,@fields+cts)]])))
ids
fields+cts))))]))

55
collects/scribble/private/render-utils.ss Normal file
View File

@ -0,0 +1,55 @@
#lang scheme/base
(require "../core.ss")
(provide part-style?
select-suffix
extract-table-cell-styles
empty-content?)
(define (part-style? p s)
(memq s (style-variants (part-style p))))
(define (select-suffix path suggested-suffixes accepted-suffixes)
(or (ormap (lambda (suggested)
(and (member suggested accepted-suffixes)
(let ([p (bytes->path
(bytes-append (path->bytes (if (string? path)
(string->path path)
path))
(string->bytes/utf-8 suggested)))])
(and (file-exists? p)
p))))
suggested-suffixes)
path))
(define (extract-table-cell-styles t)
(let ([vars (style-variants (table-style t))])
(or (let ([l (ormap (lambda (v)
(and (table-cells? v)
(table-cells-styless v)))
vars)])
(and l
(unless (= (length l) (length (table-blockss t)))
(error 'table
"table-cells variant list's length does not match row count: ~e vs. ~e"
l (length (table-blockss t))))
(for-each (lambda (l row)
(unless (= (length l) (length row))
(error 'table
"table-cells variant list contains a row whose length does not match the content: ~e vs. ~e"
l (length row))))
l (table-blockss t))
l))
(let ([cols (ormap (lambda (v) (and (table-columns? v) v)) vars)])
(and cols
(let ([cols (table-columns-styles cols)])
(map (lambda (row)
(unless (= (length cols) (length row))
(error 'table
"table-columns variant list's length does not match a row length: ~e vs. ~e"
cols (length row)))
cols)
(table-blockss t)))))
(map (lambda (row) (map (lambda (c) plain) row)) (table-blockss t)))))
(define (empty-content? c) (null? c))

4
collects/scribble/run.ss
View File

@ -1,6 +1,6 @@
#lang scheme/base
(require "struct.ss"
(require "core.ss"
"base-render.ss"
"xref.ss"
scheme/cmdline
@ -64,7 +64,7 @@
#:multi
[("++extra") file "add given file"
(current-extra-files (cons file (current-extra-files)))]
[("++style") file "add given .css/.tex file"
[("++style") file "add given .css/.tex file after others"
(current-style-extra-files (cons file (current-style-extra-files)))]
[("++info-in") file "load format-specific link information from <file>"
(current-info-input-files

166
collects/scribble/scheme.css Normal file
View File

@ -0,0 +1,166 @@
/* See the beginning of "scribble.css". */
/* Monospace: */
.ScmIn, .ScmRdr, .ScmPn, .ScmMeta,
.ScmMod, .ScmKw, .ScmVar, .ScmSym,
.ScmRes, .ScmOut, .ScmCmt, .ScmVal {
font-family: monospace;
}
/* Serif: */
.inheritedlbl {
font-family: serif;
}
/* ---------------------------------------- */
/* Inherited methods, left margin */
.inherited {
width: 100%;
margin-top: 0.5em;
text-align: left;
background-color: #ECF5F5;
}
.inherited td {
font-size: 82%;
padding-left: 1em;
text-indent: -0.8em;
padding-right: 0.2em;
}
.inheritedlbl {
font-style: italic;
}
/* ---------------------------------------- */
/* Scheme text styles */
.ScmIn {
color: #cc6633;
background-color: #eeeeee;
}
.ScmInBG {
background-color: #eeeeee;
}
.ScmRdr {
}
.ScmPn {
color: #843c24;
}
.ScmMeta {
color: #262680;
}
.ScmMod {
color: black;
}
.ScmOpt {
color: black;
}
.ScmKw {
color: black;
font-weight: bold;
}
.ScmErr {
color: red;
font-style: italic;
}
.ScmVar {
color: #262680;
font-style: italic;
}
.ScmSym {
color: #262680;
}
.ScmValLink {
text-decoration: none;
color: blue;
}
.ScmModLink {
text-decoration: none;
color: blue;
}
.ScmStxLink {
text-decoration: none;
color: black;
font-weight: bold;
}
.ScmRes {
color: #0000af;
}
.ScmOut {
color: #960096;
}
.ScmCmt {
color: #c2741f;
}
.ScmVal {
color: #228b22;
}
/* ---------------------------------------- */
/* Some inline styles */
.together {
width: 100%;
}
.prototype td {
vertical-align: text-top;
}
.longprototype td {
vertical-align: bottom;
}
.ScmBlk td {
vertical-align: baseline;
}
.argcontract td {
vertical-align: text-top;
}
.highlighted {
background-color: #ddddff;
}
.defmodule {
width: 100%;
background-color: #F5F5DC;
}
.specgrammar {
float: right;
}
.SBibliography td {
vertical-align: text-top;
}
.leftindent {
margin-left: 1em;
margin-right: 0em;
}
.insetpara {
margin-left: 1em;
margin-right: 1em;
}

112
collects/scribble/scheme.ss
View File

@ -1,7 +1,9 @@
(module scheme scheme/base
(require "struct.ss"
(require "core.ss"
"basic.ss"
"search.ss"
"html-variants.ss"
"latex-variants.ss"
mzlib/class
mzlib/for
setup/main-collects
@ -20,6 +22,28 @@
current-variable-list
current-meta-list
input-color
output-color
input-background-color
no-color
reader-color
result-color
keyword-color
comment-color
paren-color
meta-color
value-color
symbol-color
variable-color
opt-color
error-color
syntax-link-color
value-link-color
module-color
module-link-color
block-color
highlighted-color
(struct-out var-id)
(struct-out shaped-parens)
(struct-out just-context)
@ -29,16 +53,38 @@
make-element-id-transformer
element-id-transformer?))
(define no-color "schemeplain")
(define reader-color "schemereader")
(define keyword-color "schemekeyword")
(define comment-color "schemecomment")
(define paren-color "schemeparen")
(define meta-color "schememeta")
(define value-color "schemevalue")
(define symbol-color "schemesymbol")
(define variable-color "schemevariable")
(define opt-color "schemeopt")
(define scheme-variants
(let ([abs (lambda (s)
(path->main-collects-relative (build-path (collection-path "scribble") s)))])
(list (make-css-addition (abs "scheme.css"))
(make-tex-addition (abs "scheme.tex")))))
(define (make-scheme-style s #:tt? [tt? #t])
(make-style s (if tt?
(cons 'tt-chars scheme-variants)
scheme-variants)))
(define output-color (make-scheme-style "ScmOut"))
(define input-color (make-scheme-style "ScmIn"))
(define input-background-color (make-scheme-style "ScmInBG"))
(define no-color (make-scheme-style "ScmPlain"))
(define reader-color (make-scheme-style "ScmRdr"))
(define result-color (make-scheme-style "ScmRes"))
(define keyword-color (make-scheme-style "ScmKw"))
(define comment-color (make-scheme-style "ScmCmt"))
(define paren-color (make-scheme-style "ScmPn"))
(define meta-color (make-scheme-style "ScmMeta"))
(define value-color (make-scheme-style "ScmVal"))
(define symbol-color (make-scheme-style "ScmSym"))
(define variable-color (make-scheme-style "ScmVar"))
(define opt-color (make-scheme-style "ScmOpt"))
(define error-color (make-scheme-style "ScmErr" #:tt? #f))
(define syntax-link-color (make-scheme-style "ScmStxLink"))
(define value-link-color (make-scheme-style "ScmValLink"))
(define module-color (make-scheme-style "ScmMod"))
(define module-link-color (make-scheme-style "ScmModLink"))
(define block-color (make-scheme-style "ScmBlk"))
(define highlighted-color (make-scheme-style "highlighted" #:tt? #f))
(define current-keyword-list
(make-parameter null))
@ -66,7 +112,7 @@
i)))
(define line-breakable-space (make-element 'tt (list " ")))
(define line-breakable-space (make-element 'tt " "))
;; These caches intentionally record a key with the value.
;; That way, when the value is no longer used, the key
@ -96,12 +142,12 @@
(list
(case (car tag)
[(form)
(make-link-element "schemesyntaxlink" (list s) tag)]
(make-link-element syntax-link-color (list s) tag)]
[else
(make-link-element "schemevaluelink" (list s) tag)]))
(make-link-element value-link-color (list s) tag)]))
(list
(make-element "badlink"
(list (make-element "schemevaluelink" (list s))))))))
(make-element value-link-color s))))))
(lambda () s)
(lambda () s)
key)])
@ -111,10 +157,8 @@
(define (make-element/cache style content)
(if (and element-cache
(pair? content)
(string? (car content))
(null? (cdr content)))
(let ([key (vector style (car content))])
(string? content))
(let ([key (vector style content)])
(let ([b (hash-ref element-cache key #f)])
(or (and b (weak-box-value b))
(let ([e (make-cached-element style content key)])
@ -184,6 +228,8 @@
[else paren-color])
(string-length s))))))
(define omitable (make-style #f '(omitable)))
(define (gen-typeset c multi-line? prefix1 prefix suffix color?)
(let* ([c (syntax-ize c 0)]
[content null]
@ -200,7 +246,7 @@
[line (or (syntax-line first) 0)])
(define (finish-line!)
(when multi-line?
(set! docs (cons (make-flow (list (make-omitable-paragraph (reverse content))))
(set! docs (cons (make-paragraph omitable (reverse content))
docs))
(set! content null)))
(define out
@ -209,16 +255,14 @@
(out v cls (let sz-loop ([v v])
(cond
[(string? v) (string-length v)]
[(list? v) (for/fold ([s 0]) ([v (in-list v)]) (+ s (sz-loop v)))]
[(sized-element? v) (sized-element-length v)]
[(and (element? v)
(= 1 (length (element-content v))))
(sz-loop (car (element-content v)))]
[(element? v)
(element-width v)]
(sz-loop (element-content v))]
[(delayed-element? v)
(element-width v)]
(content-width v)]
[(part-relative-element? v)
(element-width v)]
(content-width v)]
[(spaces? v)
(+ (sz-loop (car (element-content v)))
(spaces-cnt v)
@ -240,10 +284,10 @@
[else
(set! content (cons ((if highlight?
(lambda (c)
(make-element "highlighted" (list c)))
(make-element highlighted-color c))
values)
(if (and color? cls)
(make-element/cache cls (list v))
(make-element/cache cls v)
v))
content))
(set! dest-col (+ dest-col len))]))]))
@ -300,9 +344,9 @@
(make-sized-element
(if val? value-color #f)
(list
(make-element/cache (if val? value-color paren-color) '(". "))
(make-element/cache (if val? value-color paren-color) '". ")
(typeset a #f "" "" "" (not val?))
(make-element/cache (if val? value-color paren-color) '(" .")))
(make-element/cache (if val? value-color paren-color) '" ."))
(+ (syntax-span a) 4)))
(list (syntax-source a)
(syntax-line a)
@ -564,8 +608,8 @@
(finish-line!))
(if multi-line?
(if (= 1 (length docs))
(car (flow-paragraphs (car docs)))
(make-table "schemeblock" (map list (reverse docs))))
(car docs)
(make-table block-color (map list (reverse docs))))
(make-sized-element #f (reverse content) dest-col))))
(define (typeset c multi-line? prefix1 prefix suffix color?)
@ -590,8 +634,8 @@
[(elem color len)
(if (and (string? elem)
(= len (string-length elem)))
(make-element/cache (and color? color) (list elem))
(make-sized-element (and color? color) (list elem) len))])])
(make-element/cache (and color? color) elem)
(make-sized-element (and color? color) elem len))])])
mk)
color? 0))))

10
collects/scribble/scribble-prefix.tex
View File

@ -1,12 +1,2 @@
% This is the default prefix for Scribble-generated Latex
\documentclass{article}
\parskip=10pt
\parindent=0pt
\partopsep=0pt
% Adjust margins to match HTML width for
% fixed-width font
\advance \oddsidemargin by -0.15in
\advance \evensidemargin by -0.15in
\advance \textwidth by 0.3in

0
collects/scribble/scribble-style.css Normal file
View File

0
collects/scribble/scribble-style.tex Normal file
View File

204
collects/scribble/scribble.css
View File

@ -8,20 +8,17 @@
see if any font is set. */
/* Monospace: */
.maincolumn, .refpara, .tocset, .stt, .hspace,
.schemeinput, .schemereader, .schemeparen, .schememeta,
.schememod, .schemekeyword, .schemevariable, .schemesymbol,
.schemeresult, .schemestdout, .schemecomment, .schemevalue {
.maincolumn, .refpara, .tocset, .stt, .hspace {
font-family: monospace;
}
/* Serif: */
.main, .refcontent, .tocview, .tocsub, .inheritedlbl, i {
.main, .refcontent, .tocview, .tocsub, i {
font-family: serif;
}
/* Sans-serif: */
.version {
.version, .versionNoNav {
font-family: sans-serif;
}
@ -136,6 +133,9 @@ table td {
.version {
font-size: small;
}
.versionNoNav {
font-size: xx-small; /* avoid overlap with author */
}
/* ---------------------------------------- */
/* Margin notes */
@ -292,122 +292,9 @@ table td {
font-size: 70%;
}
/* ---------------------------------------- */
/* Inherited methods, left margin */
.inherited {
width: 100%;
margin-top: 0.5em;
text-align: left;
background-color: #ECF5F5;
}
.inherited td {
font-size: 82%;
padding-left: 1em;
text-indent: -0.8em;
padding-right: 0.2em;
}
.inheritedlbl {
font-style: italic;
}
/* ---------------------------------------- */
/* Scheme text styles */
.schemeinput {
color: #cc6633;
background-color: #eeeeee;
}
.schemeinputbg {
background-color: #eeeeee;
}
.schemereader {
}
.schemeparen {
color: #843c24;
}
.schememeta {
color: #262680;
}
.schememod {
color: black;
}
.schemeopt {
color: black;
}
.schemekeyword {
color: black;
font-weight: bold;
}
.schemeerror {
color: red;
font-style: italic;
}
.schemevariable {
color: #262680;
font-style: italic;
}
.schemesymbol {
color: #262680;
}
.schemevaluelink {
text-decoration: none;
color: blue;
}
.schememodlink {
text-decoration: none;
color: blue;
}
.schemesyntaxlink {
text-decoration: none;
color: black;
font-weight: bold;
}
.schemeresult {
color: #0000af;
}
.schemestdout {
color: #960096;
}
.schemecomment {
color: #c2741f;
}
.schemevalue {
color: #228b22;
}
/* ---------------------------------------- */
/* Some inline styles */
.leftindent {
margin-left: 1em;
margin-right: 0em;
}
.insetpara {
margin-left: 1em;
margin-right: 1em;
}
.indexlink {
text-decoration: none;
}
@ -437,52 +324,15 @@ ol ol ol ol { list-style-type: upper-alpha; }
i {
}
.SubFlow {
display: block;
}
.boxed {
width: 100%;
background-color: #E8E8FF;
}
.inlinetop{
display: inline;
vertical-align: text-top;
}
.together {
width: 100%;
}
.prototype td {
vertical-align: text-top;
}
.longprototype td {
vertical-align: bottom;
}
.schemeblock td {
vertical-align: baseline;
}
.argcontract td {
vertical-align: text-top;
}
.ghost {
color: white;
}
.highlighted {
background-color: #ddddff;
}
.defmodule {
width: 100%;
background-color: #F5F5DC;
}
.specgrammar {
float: right;
}
.hspace {
}
@ -490,14 +340,6 @@ i {
font-style: oblique;
}
.inferencetop td {
border-bottom: 1px solid black;
text-align: center;
}
.inferencebottom td {
text-align: center;
}
.badlink {
text-decoration: underline;
color: red;
@ -518,10 +360,6 @@ i {
.techinside:hover { color: blue; }
.techoutside:hover>.techinside { color: inherit; }
.SBibliography td {
vertical-align: text-top;
}
.SCentered {
text-align: center;
}
@ -531,10 +369,14 @@ i {
margin-right: 0.3em;
}
.smaller{
.Smaller{
font-size: 82%;
}
.Larger{
font-size: 122%;
}
/* A hack, inserted to break some Scheme ids: */
.mywbr {
width: 0;
@ -550,16 +392,22 @@ i {
border: 0;
}
.author {
.SAuthorListBox {
position: relative;
float: right;
left: 2em;
top: -3em;
top: -2.5em;
height: 0em;
width: 23em; /* very wide to keep author names on separate lines */
margin: 0em -23em 0em 0em;
width: 13em;
margin: 0em -13em 0em 0em;
}
.SAuthorList {
font-size: 82%;
}
.author:before {
.SAuthorList:before {
content: "by ";
}
.author {
display: inline;
white-space: nowrap;
}

125
collects/scribble/scribble.tex
View File

@ -11,47 +11,36 @@
\usepackage[usenames,dvipsnames]{color}
\hypersetup{bookmarks=true,bookmarksopen=true,bookmarksnumbered=true}
\newcommand{\SColorize}[2]{\color{#1}{#2}}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Configuration that is especially meant to be overridden:
\newcommand{\inColor}[2]{{\Scribtexttt{\SColorize{#1}{#2}}}}
\definecolor{CommentColor}{rgb}{0.76,0.45,0.12}
\definecolor{ParenColor}{rgb}{0.52,0.24,0.14}
\definecolor{IdentifierColor}{rgb}{0.15,0.15,0.50}
\definecolor{ResultColor}{rgb}{0.0,0.0,0.69}
\definecolor{ValueColor}{rgb}{0.13,0.55,0.13}
\definecolor{OutputColor}{rgb}{0.59,0.00,0.59}
\definecolor{PaleBlue}{rgb}{0.90,0.90,1.0}
\definecolor{LightGray}{rgb}{0.90,0.90,0.90}
% Inserted before every ``chapter'', useful for starting each one on a new page:
\newcommand{\sectionNewpage}{}
% Hooks for actions within the `document' environment:
\newcommand{\preDoc}{}
\newcommand{\postDoc}{}
% Generated by `secref'; first arg is section number, second is section title:
\newcommand{\BookRef}[2]{\emph{#2}}
\newcommand{\ChapRef}[2]{\SecRef{#1}{#2}}
\newcommand{\SecRef}[2]{section~#1}
% Generated by `Secref':
\newcommand{\BookRefUC}[2]{\BookRef{#1}{#2}}
\newcommand{\ChapRefUC}[2]{\SecRefUC{#1}{#2}}
\newcommand{\SecRefUC}[2]{Section~#1}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Fonts
% Font commands used by generated text:
\newcommand{\Scribtexttt}[1]{{\texttt{#1}}}
\newcommand{\schemeplain}[1]{\inColor{black}{#1}}
\newcommand{\schemekeyword}[1]{{\SColorize{black}{\Scribtexttt{\textbf{#1}}}}}
\newcommand{\schemesyntaxlink}[1]{\schemekeyword{#1}}
\newcommand{\schemecomment}[1]{\inColor{CommentColor}{#1}}
\newcommand{\schemeparen}[1]{\inColor{ParenColor}{#1}}
\newcommand{\schemeinputbg}[1]{\inColor{ParenColor}{#1}}
\newcommand{\schemesymbol}[1]{\inColor{IdentifierColor}{#1}}
\newcommand{\schemevalue}[1]{\inColor{ValueColor}{#1}}
\newcommand{\schemevaluelink}[1]{\inColor{blue}{#1}}
\newcommand{\schememodlink}[1]{\inColor{blue}{#1}}
\newcommand{\schemeresult}[1]{\inColor{ResultColor}{#1}}
\newcommand{\schemestdout}[1]{\inColor{OutputColor}{#1}}
\newcommand{\schememeta}[1]{\inColor{IdentifierColor}{#1}}
\newcommand{\schememod}[1]{\inColor{black}{#1}}
\newcommand{\schemereader}[1]{\inColor{black}{#1}}
\newcommand{\schemevariablecol}[1]{\inColor{IdentifierColor}{#1}}
\newcommand{\schemevariable}[1]{{\schemevariablecol{\textsl{#1}}}}
\newcommand{\schemeerrorcol}[1]{\inColor{red}{#1}}
\newcommand{\schemeerror}[1]{{\schemeerrorcol{\textrm{\textit{#1}}}}}
\newcommand{\schemeopt}[1]{#1}
\newcommand{\textsub}[1]{$_{\hbox{\textsmaller{#1}}}$}
\newcommand{\textsuper}[1]{$^{\hbox{\textsmaller{#1}}}$}
\newcommand{\intextcolor}[2]{\textcolor{#1}{#2}}
\newcommand{\intextrgbcolor}[2]{\textcolor[rgb]{#1}{#2}}
\newcommand{\incolorbox}[2]{{\fboxrule=0pt\fboxsep=0pt\colorbox{#1}{#2}}}
\newcommand{\inrgbcolorbox}[2]{{\fboxrule=0pt\fboxsep=0pt\colorbox[rgb]{#1}{#2}}}
\newcommand{\schemeinput}[1]{\incolorbox{LightGray}{\schemeinputbg{#1}}}
\newcommand{\highlighted}[1]{\colorbox{PaleBlue}{\hspace{-0.5ex}\schemeinputbg{#1}\hspace{-0.5ex}}}
\newcommand{\plainlink}[1]{#1}
\newcommand{\techoutside}[1]{#1}
\newcommand{\techinside}[1]{#1}
@ -59,65 +48,75 @@
\newcommand{\indexlink}[1]{#1}
\newcommand{\noborder}[1]{#1}
\newcommand{\imageleft}[1]{} % drop it
\renewcommand{\smaller}[1]{\textsmaller{#1}}
\newcommand{\Smaller}[1]{\textsmaller{#1}}
\newcommand{\Larger}[1]{\textlarger{#1}}
\newcommand{\planetName}[1]{PLane\hspace{-0.1ex}T}
\newcommand{\refpara}[1]{\marginpar{\raggedright \footnotesize #1}}
\newenvironment{refcolumn}{}{}
\newenvironment{refcontent}{}{}
\newcommand{\titleAndEmptyVersion}[2]{\title{#1}\maketitle}
\newcommand{\titleAndVersion}[2]{\title{#1\\{\normalsize Version #2}}\maketitle}
\newcommand{\sectionNewpage}{\newpage}
\newcommand{\preDoc}{\sloppy}
\newcommand{\postDoc}{}
\newcommand{\slant}[1]{{\textsl{#1}}}
\newenvironment{leftindent}{\begin{quote}}{\end{quote}}
\newenvironment{insetpara}{\begin{quote}}{\end{quote}}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Tables
\newcommand{\bibentry}[1]{\parbox[t]{0.8\linewidth}{#1}}
% stabular seems to be the lesser of all page-breaking table evironments
% The `stabular' environment seems to be the lesser of evils among
% page-breaking table environments:
\newenvironment{bigtabular}{\begin{stabular}}{\end{stabular}}
% used to keep the horizontal line for a definition on the same page:
% Used to keep the horizontal line for a definition on the same page:
\newcommand{\SEndFirstHead}[0]{ \nopagebreak \\ }
% attempts to correct weirdness when a table is the first thing in
% Corrects weirdness when a table is the first thing in
% an itemization:
\newcommand{\bigtableinlinecorrect}[0]{~
\vspace{-\baselineskip}\vspace{\parskip}}
% used to indent the table correctly in an itemization, since that's
% one of the things stabular gets wrong
% Used to indent the table correctly in an itemization, since that's
% one of the things stabular gets wrong:
\newlength{\stabLeft}
\newcommand{\bigtableleftpad}{\hspace{\stabLeft}}
\newcommand{\atItemizeStart}[0]{\addtolength{\stabLeft}{\labelsep}
\addtolength{\stabLeft}{\labelwidth}}
% For a single-column table in simple environments, it's better to
% use the `list' environment instead of `stabular'.
\newenvironment{SingleColumn}{\begin{list}{}{\topsep=0pt\partopsep=0pt%
\listparindent=0pt\itemindent=0pt\labelwidth=0pt\leftmargin=0pt\rightmargin=0pt%
\itemsep=0pt\parsep=0pt}\item}{\end{list}}
\newenvironment{schemeblock}{}{}
\newenvironment{defmodule}{}{}
\newenvironment{prototype}{}{}
\newenvironment{argcontract}{}{}
\newenvironment{together}{}{}
\newenvironment{SBibliography}{}{}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Etc.
% Default style for a nested flow:
\newenvironment{Subflow}{\begin{list}{}{\topsep=0pt\partopsep=0pt%
\listparindent=0pt\itemindent=0pt\labelwidth=0pt\leftmargin=0pt\rightmargin=0pt%
\itemsep=0pt}\item}{\end{list}}
% The 'inset neested-flow style uses the `quote' environment
% The 'compact itemization style:
\newenvironment{compact}{\begin{itemize}}{\end{itemize}}
\newcommand{\compactItem}[1]{\item #1}
\newcommand{\SecRef}[2]{\S#1 ``#2''}
% The nested-flow style for `centerline':
\newenvironment{SCentered}{\begin{trivlist}\item \centering}{\end{trivlist}}
% The \refpara command corresponds to `margin-note'. The
% refcolumn and refcontent environments also wrap the note,
% because they simplify the CSS side.
\newcommand{\refpara}[1]{\marginpar{\raggedright \footnotesize #1}}
\newenvironment{refcolumn}{}{}
\newenvironment{refcontent}{}{}
% Macros used by `title' and `author':
\newcommand{\titleAndVersionAndAuthors}[3]{\title{#1\\{\normalsize Version #2}}\author{#3}\maketitle}
\newcommand{\titleAndVersionAndEmptyAuthors}[3]{\title{#1\\{\normalsize Version #2}}#3\maketitle}
\newcommand{\titleAndEmptyVersionAndAuthors}[3]{\title{#1}\author{#3}\maketitle}
\newcommand{\titleAndEmptyVersionAndEmptyAuthors}[3]{\title{#1}\maketitle}
\newcommand{\SAuthor}[1]{#1}
\newcommand{\SAuthorSep}[1]{\qquad}
% Used for parts with the 'hidden style variant:
\newcommand{\sectionhidden}[1]{\section{#1}}
\newcommand{\subsectionhidden}[1]{\subsection{#1}}
\newcommand{\subsubsectionhidden}[1]{\subsubsection{#1}}
\newenvironment{SCentered}{\begin{trivlist}\item \centering}{\end{trivlist}}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Scribble then generates the following:
%

109
collects/scribble/sigplan.ss Normal file
View File

@ -0,0 +1,109 @@
#lang scheme/base
(require setup/main-collects
scribble/core
scribble/base
scribble/decode
scribble/html-variants
scribble/latex-variants
(for-syntax scheme/base))
(provide preprint
abstract include-abstract
authorinfo
conferenceinfo copyrightyear copyrightdata
category terms keywords)
(define-syntax (preprint stx)
(raise-syntax-error #f
"option must appear on the same line as `#lang scribble/sigplan'"
stx))
(define sigplan-extras
(let ([abs (lambda (s)
(path->main-collects-relative
(build-path (collection-path "scribble") "sigplan" s)))])
(list
(make-css-addition (abs "sigplan.css"))
(make-tex-addition (abs "sigplan.tex")))))
;; ----------------------------------------
;; Abstracts:
(define abstract-style (make-style "abstract" sigplan-extras))
(define (abstract . strs)
(make-nested-flow
abstract-style
(decode-flow strs)))
(define (extract-abstract p)
(unless (part? p)
(error 'include-abstract "doc binding is not a part: ~e" p))
(unless (null? (part-parts p))
(error 'include-abstract "abstract part has sub-parts: ~e" (part-parts p)))
(when (part-title-content p)
(error 'include-abstract "abstract part has title content: ~e" (part-title-content p)))
(part-blocks p))
(define-syntax-rule (include-abstract mp)
(begin
(require (only-in mp [doc abstract-doc]))
(make-nested-flow abstract-style (extract-abstract abstract-doc))))
;; ----------------------------------------
;; Authors and conference info:
(define (authorinfo name affiliation e-mail)
(author
(make-multiarg-element
(make-style "SAuthorinfo"sigplan-extras)
(list
(make-element #f (decode-content (list name)))
(make-element (make-style "SAuthorPlace" sigplan-extras)
(decode-content (list affiliation)))
(make-element (make-style "SAuthorEmail" sigplan-extras)
(decode-content (list e-mail)))))))
(define (conferenceinfo what where)
(make-paragraph
(make-style 'pretitle null)
(make-multiarg-element
(make-style "SConferenceInfo" sigplan-extras)
(list
(make-element #f (decode-content (list what)))
(make-element #f (decode-content (list where)))))))
(define (copyrightyear . when)
(make-paragraph
(make-style 'pretitle null)
(make-element
(make-style "SCopyrightYear" sigplan-extras)
(decode-content when))))
(define (copyrightdata . what)
(make-paragraph
(make-style 'pretitle null)
(make-element
(make-style "SCopyrightData" sigplan-extras)
(decode-content what))))
;; ----------------------------------------
;; Categories, terms, and keywords:
(define (category sec title sub [more #f])
(make-multiarg-element
(make-style (format "SCategory~a" (if more "Plus" "")) sigplan-extras)
(append
(list
(make-element #f (decode-content (list sec)))
(make-element #f (decode-content (list title)))
(make-element #f (decode-content (list sub))))
(if more
(list (make-element #f (decode-content (list more))))
null))))
(define (terms . str)
(make-element (make-style "STerms" sigplan-extras) (decode-content str)))
(define (keywords . str)
(make-element (make-style "SKeywords" sigplan-extras) (decode-content str)))

41
collects/scribble/sigplan/lang.ss Normal file
View File

@ -0,0 +1,41 @@
#lang scheme/base
(require scribble/doclang
scribble/core
scribble/base
scribble/decode
scribble/sigplan
"../private/defaults.ss"
(for-syntax scheme/base))
(provide (except-out (all-from-out scribble/doclang) #%module-begin)
(all-from-out scribble/sigplan)
(all-from-out scribble/base)
(rename-out [module-begin #%module-begin]))
(define-syntax (module-begin stx)
(syntax-case* stx (preprint) (lambda (a b) (eq? (syntax-e a) (syntax-e b)))
[(_ id ws . body)
;; Skip intraline whitespace to find options:
(and (string? (syntax-e #'ws))
(regexp-match? #rx"^ *$" (syntax-e #'ws)))
#'(module-begin id . body)]
[(_ id preprint . body)
#'(#%module-begin id (post-process #t) () . body)]
[(_ id . body)
#'(#%module-begin id (post-process #f) () . body)]))
(define ((post-process preprint?) doc)
(add-sigplan-styles
(add-defaults doc
(string->bytes/utf-8
(format "\\documentclass~a{sigplanconf}\n\\usepackage{times}\n\\usepackage{qcourier}\n"
(if preprint? "[preprint]" "")))
(scribble-file "sigplan/style.tex")
(list (scribble-file "sigplan/sigplanconf.cls"))
#f)))
(define (add-sigplan-styles doc)
;; Ensure that "sigplan.tex" is used, since "style.tex"
;; re-defines commands.
(struct-copy part doc [to-collect
(cons (terms)
(part-to-collect doc))]))

10
collects/scribble/sigplan/lang/reader.ss Normal file
View File

@ -0,0 +1,10 @@
#lang s-exp syntax/module-reader
scribble/sigplan/lang
#:read scribble:read-inside
#:read-syntax scribble:read-syntax-inside
#:whole-body-readers? #t
#:wrapper1 (lambda (t) (cons 'doc (t)))
(require (prefix-in scribble: "../../reader.ss"))

8
collects/scribble/sigplan/sigplan.css Normal file
View File

@ -0,0 +1,8 @@
/* Support for styles in scribble/sigplan */
.SAuthorPlace, .SAuthorEmail,
.SConferenceInfo, .SCopyrightYear, .SCopyrightData,
.SCategory, .SCategoryPlus, .STerms, .SKeywords {
display: none;
}

18
collects/scribble/sigplan/sigplan.tex Normal file
View File

@ -0,0 +1,18 @@
% Support for styles in scribble/sigplan
% These are replaced by scribble/sigplan/style.tex,
% which is used in combination with sigplanconf.sty
\newcommand{\SAuthorinfo}[3]{#1}
\newcommand{\SAuthorPlace}[1]{#1}
\newcommand{\SAuthorEmail}[1]{#1}
\newcommand{\SConferenceInfo}[2]{}
\newcommand{\SCopyrightYear}[1]{}
\newcommand{\SCopyrightData}[1]{}
\newcommand{\SCategory}[3]{}
\newcommand{\SCategoryPlus}[4]{}
\newcommand{\STerms}[1]{}
\newcommand{\SKeywords}[1]{}

1222
collects/scribble/sigplan/sigplanconf.cls Normal file
View File

File diff suppressed because it is too large Load Diff

20
collects/scribble/sigplan/style.tex Normal file
View File

@ -0,0 +1,20 @@
\renewcommand{\titleAndVersionAndAuthors}[3]{\title{#1}#3\maketitle}
\renewcommand{\titleAndEmptyVersionAndAuthors}[3]{\titleAndVersionAndAuthors{#1}{#2}{#3}}
\renewcommand{\titleAndVersionAndEmptyAuthors}[3]{\title{#1}\authorinfo{Anonymous}{}{}\maketitle}
\renewcommand{\titleAndEmptyVersionAndEmptyAuthors}[3]{\titleAndVersionAndEmptyAuthors{#1}{#2}{#3}}
% Disable plain `author', enable `authorinfo:'
\renewcommand{\SAuthor}[1]{#1}
\renewcommand{\SAuthorinfo}[3]{\authorinfo{#1}{#2}{#3}}
\renewcommand{\SAuthorSep}[1]{}
\renewcommand{\SConferenceInfo}[2]{\conferenceinfo{#1}{#2}}
\renewcommand{\SCopyrightYear}[1]{\copyrightyear{#1}}
\renewcommand{\SCopyrightData}[1]{\copyrightdata{#1}}
\renewcommand{\SCategory}[3]{\category{#1}{#2}{#3}}
\renewcommand{\SCategoryPlus}[4]{\category{#1}{#2}{#3}[#4]}
\renewcommand{\STerms}[1]{\terms{#1}}
\renewcommand{\SKeywords}[1]{\keywords{#1}}

837
collects/scribble/struct.ss
View File

@ -1,544 +1,401 @@
#lang scheme/base
(require scheme/serialize
(require (rename-in (except-in "core.ss"
target-url struct:target-url target-url? target-url-addr
deserialize-info:target-url-v0)
[make-target-url core:make-target-url])
"private/provide-structs.ss"
"html-variants.ss"
scheme/provide-syntax
scheme/struct-info
scheme/contract
(for-syntax scheme/base))
;; ----------------------------------------
(define-provide-syntax (compat**-out stx)
(syntax-case stx ()
[(_ struct-out o)
(let ([id (syntax-case #'o ()
[(id (field-id ...)) #'id]
[id #'id])])
(with-syntax ([make-id (datum->syntax id
(string->symbol (format "make-~a" (syntax-e id)))
id)]
[make-id/compat (datum->syntax id
(string->symbol (format "make-~a/compat" (syntax-e id)))
id)])
#'(combine-out
(except-out (struct-out o) make-id)
(rename-out [make-id/compat make-id]))))]
[(_ struct-out o ...) #'(combine-out (compat**-out struct-out o) ...)]))
(define-struct collect-info (ht ext-ht parts tags gen-prefix relatives parents))
(define-struct resolve-info (ci delays undef searches))
(define-provide-syntax (compat-out stx)
(syntax-case stx ()
[(_ . outs) #'(compat**-out struct-out . outs)]))
(define (part-collected-info part ri)
(hash-ref (collect-info-parts (resolve-info-ci ri))
part))
(define-provide-syntax (compat*-out stx)
(syntax-case stx ()
[(_ . outs) #'(compat**-out struct*-out . outs)]))
(define (collect-put! ci key val)
(let ([ht (collect-info-ht ci)])
(let ([old-val (hash-ref ht key #f)])
(when old-val
(fprintf (current-error-port)
"WARNING: collected information for key multiple times: ~e; values: ~e ~e\n"
key old-val val))
(hash-set! ht key val))))
(define (resolve-get/where part ri key)
(let ([key (tag-key key ri)])
(let ([v (hash-ref (if part
(collected-info-info (part-collected-info part ri))
(collect-info-ht (resolve-info-ci ri)))
key
#f)])
(cond
[v (values v #f)]
[part (resolve-get/where
(collected-info-parent (part-collected-info part ri))
ri key)]
[else
(values (hash-ref (collect-info-ext-ht (resolve-info-ci ri)) key #f)
#t)]))))
(define (resolve-get/ext? part ri key)
(let-values ([(v ext?) (resolve-get/where part ri key)])
(when ext?
(hash-set! (resolve-info-undef ri) (tag-key key ri) #t))
(values v ext?)))
(define (resolve-get part ri key)
(let-values ([(v ext?) (resolve-get/ext? part ri key)])
v))
(define (resolve-get/tentative part ri key)
(let-values ([(v ext?) (resolve-get/where part ri key)])
v))
(define (resolve-search search-key part ri key)
(let ([s-ht (hash-ref (resolve-info-searches ri)
search-key
(lambda ()
(let ([s-ht (make-hash)])
(hash-set! (resolve-info-searches ri)
search-key s-ht)
s-ht)))])
(hash-set! s-ht key #t))
(resolve-get part ri key))
(define (resolve-get-keys part ri key-pred)
(let ([l null])
(hash-for-each
(collected-info-info (part-collected-info part ri))
(lambda (k v) (when (key-pred k) (set! l (cons k l)))))
l))
(define-provide-syntax (struct*-out stx)
(syntax-case stx ()
[(_ [id (field-id ...)])
(with-syntax ([id? (datum->syntax #'id
(string->symbol (format "~a?" (syntax-e #'id)))
#'id)]
[struct:id (datum->syntax #'id
(string->symbol (format "struct:~a" (syntax-e #'id)))
#'id)]
[make-id (datum->syntax #'id
(string->symbol (format "make-~a" (syntax-e #'id)))
#'id)]
[(sel-id ...)
(map (lambda (field-id)
(datum->syntax field-id
(string->symbol (format "~a-~a" (syntax-e #'id) (syntax-e field-id)))
field-id))
(syntax->list #'(field-id ...)))])
#'(combine-out
id struct:id make-id id? sel-id ...))]
[(_ [id (field-id ...)]...)
#'(combine-out (struct*-out [id (field-id ...)]) ...)]))
(provide (struct-out collect-info)
(struct-out resolve-info))
(struct-out resolve-info)
tag? block?
make-flow flow? flow-paragraphs
;; ----------------------------------------
(except-out (compat-out part) part-title-content)
(rename-out [part-blocks part-flow]
[part-title-content/compat part-title-content])
make-versioned-part versioned-part?
make-unnumbered-part unnumbered-part?
(provide provide-structs)
(except-out (compat-out paragraph) paragraph-content)
(rename-out [paragraph-content/compat paragraph-content])
make-styled-paragraph
(rename-out [paragraph? styled-paragraph?]
[paragraph-style styled-paragraph-style])
make-omitable-paragraph omitable-paragraph?
(define-syntax (provide-structs stx)
(syntax-case stx ()
[(_ (id ([field ct] ...)) ...)
#`(begin
(define-serializable-struct id (field ...)) ...
(provide/contract
#,@(let ([ids (syntax->list #'(id ...))]
[fields+cts (syntax->list #'(([field ct] ...) ...))])
(define (get-fields super-id)
(ormap (lambda (id fields+cts)
(if (identifier? id)
(and (free-identifier=? id super-id)
fields+cts)
(syntax-case id ()
[(my-id next-id)
(free-identifier=? #'my-id super-id)
#`[#,@(get-fields #'next-id)
#,@fields+cts]]
[_else #f])))
ids fields+cts))
(map (lambda (id fields+cts)
(if (identifier? id)
#`[struct #,id #,fields+cts]
(syntax-case id ()
[(id super)
#`[struct id (#,@(get-fields #'super)
#,@fields+cts)]])))
ids
fields+cts))))]))
(compat-out table)
table-flowss
make-auxiliary-table auxiliary-table?
(provide tag?)
(define (tag? s)
(and (pair? s)
(symbol? (car s))
(pair? (cdr s))
(or (string? (cadr s))
(generated-tag? (cadr s))
(and (pair? (cadr s))
(list? (cadr s))))
(null? (cddr s))))
(struct-out delayed-block)
(provide block?)
(define (block? p)
(or (paragraph? p)
(table? p)
(itemization? p)
(blockquote? p)
(compound-paragraph? p)
(delayed-block? p)))
(compat-out itemization)
(rename-out [itemization-blockss itemization-flows]
[itemization? styled-itemization?]
[itemization-style styled-itemization-style])
make-styled-itemization
(define (string-without-newline? s)
(and (string? s)
(not (regexp-match? #rx"\n" s))))
make-blockquote
(compat-out compound-paragraph)
(except-out (compat-out element) element? element-style element-content)
(rename-out [element?/compat element?]
[element-style/compat element-style]
[element-content/compat element-content])
(except-out (compat*-out [toc-element (toc-content)])
toc-element-toc-content)
(rename-out [toc-element-toc-content/compat toc-element-toc-content])
(compat*-out [target-element (tag)]
[toc-target-element ()]
[page-target-element ()]
[redirect-target-element (alt-path alt-anchor)]
[link-element (tag)]
[index-element (tag plain-seq entry-seq desc)])
make-aux-element aux-element?
make-hover-element hover-element? hover-element-text
make-script-element script-element? script-element-type script-element-script
(struct-out collected-info)
(struct-out delayed-element)
; delayed-element-content delayed-block-blocks current-serialize-resolve-info
(struct-out part-relative-element)
; part-relative-element-content collect-info-parents
(struct-out delayed-index-desc)
(struct*-out [collect-element (collect)])
(struct*-out [render-element (render)])
(struct-out generated-tag)
; generate-tag tag-key current-tag-prefixes add-current-tag-prefix
content->string
(rename-out [content->string element->string]
[content-width element-width])
; strip-aux
block-width
info-key? part-collected-info collect-put!
resolve-get resolve-get/tentative resolve-get/ext? resolve-search resolve-get-keys)
(provide-structs
[part ([tag-prefix (or/c false/c string?)]
[tags (listof tag?)]
[title-content (or/c false/c list?)]
[style any/c]
[to-collect list?]
[flow flow?]
[parts (listof part?)])]
[(unnumbered-part part) ()]
[(versioned-part part) ([version (or/c string? false/c)])]
[flow ([paragraphs (listof block?)])]
[paragraph ([content list?])]
[(styled-paragraph paragraph) ([style any/c])]
[(omitable-paragraph paragraph) ()]
[table ([style any/c]
[flowss (listof (listof (or/c flow? (one-of/c 'cont))))])]
[(auxiliary-table table) ()]
[delayed-block ([resolve (any/c part? resolve-info? . -> . block?)])]
[itemization ([flows (listof flow?)])]
[(styled-itemization itemization) ([style any/c])]
[blockquote ([style any/c]
[paragraphs (listof block?)])]
[compound-paragraph ([style any/c]
[blocks (listof block?)])]
;; content = list of elements
[element ([style any/c]
[content list?])]
[(toc-element element) ([toc-content list?])]
[(target-element element) ([tag tag?])]
[(toc-target-element target-element) ()]
[(page-target-element target-element) ()]
[(redirect-target-element target-element) ([alt-path path-string?]
[alt-anchor string?])]
[(link-element element) ([tag tag?])]
[(index-element element) ([tag tag?]
[plain-seq (and/c pair? (listof string-without-newline?))]
[entry-seq list?]
[desc any/c])]
[(aux-element element) ()]
[(hover-element element) ([text string?])]
[(script-element element) ([type string?]
[script (or/c path-string? (listof string?))])]
;; specific renders support other elements, especially strings
[with-attributes ([style any/c]
[assoc (listof (cons/c symbol? string?))])]
[collected-info ([number (listof (or/c false/c integer?))]
[parent (or/c false/c part?)]
[info any/c])]
[target-url ([addr path-string?] [style any/c])]
[url-anchor ([name string?])]
[image-file ([path (or/c path-string?
(cons/c (one-of/c 'collects)
(listof bytes?)))]
[scale real?])])
[scale real?])]
[target-url ([addr path-string?] [style any/c])])
;; ----------------------------------------
(define (make-flow l) l)
(define (flow? l) (and (list? l) (andmap block? l)))
(define (flow-paragraphs l) l)
;; Delayed element has special serialization support:
(define-struct delayed-element (resolve sizer plain)
#:property
prop:serializable
(make-serialize-info
(lambda (d)
(let ([ri (current-serialize-resolve-info)])
(unless ri
(error 'serialize-delayed-element
"current-serialize-resolve-info not set"))
(with-handlers ([exn:fail:contract?
(lambda (exn)
(error 'serialize-delayed-element
"serialization failed (wrong resolve info? delayed element never rendered?); ~a"
(exn-message exn)))])
(vector
(let ([l (delayed-element-content d ri)])
(if (and (pair? l) (null? (cdr l)))
(car l)
(make-element #f l)))))))
#'deserialize-delayed-element
#f
(or (current-load-relative-directory) (current-directory))))
(define (list->content l)
(if (and (pair? l) (null? (cdr l)))
(car l)
l))
(provide/contract
(struct delayed-element ([resolve (any/c part? resolve-info? . -> . list?)]
[sizer (-> any)]
[plain (-> any)])))
(define (content->list v)
(if (list? v)
v
(list v)))
(provide deserialize-delayed-element)
(define deserialize-delayed-element
(make-deserialize-info values values))
(define (make-part/compat tag-prefix tags title-content orig-style to-collect flow parts)
(make-part tag-prefix
tags
(list->content title-content)
(convert-style orig-style)
to-collect
(flow-paragraphs flow)
parts))
(provide delayed-element-content)
(define (delayed-element-content e ri)
(hash-ref (resolve-info-delays ri) e))
(define (part-title-content/compat p)
(list (part-title-content p)))
(provide delayed-block-blocks)
(define (delayed-block-blocks p ri)
(hash-ref (resolve-info-delays ri) p))
(define (make-versioned-part tag-prefix tags title-content orig-style to-collect flow parts version)
(make-part tag-prefix
tags
(list->content title-content)
(let ([s (convert-style orig-style)])
(make-style (style-name s)
(cons
(make-document-version version)
(style-variants s))))
to-collect
(flow-paragraphs flow)
parts))
(define (versioned-part? p)
(and (part? p) (ormap document-version? (style-variants (part-style p)))))
(provide current-serialize-resolve-info)
(define current-serialize-resolve-info (make-parameter #f))
(define (make-unnumbered-part tag-prefix tags title-content orig-style to-collect flow parts)
(make-part tag-prefix
tags
(list->content title-content)
(let ([s (convert-style orig-style)])
(make-style (style-name s)
(cons 'unnumbered (style-variants s))))
to-collect
(flow-paragraphs flow)
parts))
(define (unnumbered-part? p)
(and (part? p) (memq 'unnumbered (style-variants (part-style p)))))
;; ----------------------------------------
(define (make-paragraph/compat content)
(make-paragraph plain (list->content content)))
(define (paragraph-content/compat p)
(content->list (paragraph-content p)))
(define (make-styled-paragraph content style)
(make-paragraph (convert-style style) (list->content content)))
;; part-relative element has special serialization support:
(define-struct part-relative-element (collect sizer plain)
#:property
prop:serializable
(make-serialize-info
(lambda (d)
(let ([ri (current-serialize-resolve-info)])
(unless ri
(error 'serialize-part-relative-element
"current-serialize-resolve-info not set"))
(with-handlers ([exn:fail:contract?
(lambda (exn)
(error 'serialize-part-relative-element
"serialization failed (wrong resolve info? part-relative element never rendered?); ~a"
(exn-message exn)))])
(vector
(make-element #f (part-relative-element-content d ri))))))
#'deserialize-part-relative-element
#f
(or (current-load-relative-directory) (current-directory))))
(define (make-omitable-paragraph content)
(make-paragraph (make-style #f '(omitable)) (list->content content)))
(define (omitable-paragraph? p)
(and (paragraph? p) (memq 'omitable (style-variants (paragraph-style p)))))
(provide/contract
(struct part-relative-element ([collect (collect-info? . -> . list?)]
[sizer (-> any)]
[plain (-> any)])))
(define (make-table/compat style cellss)
(make-table (convert-style style)
(map (lambda (cells)
(map (lambda (cell)
(cond
[(eq? cell 'cont) 'cont]
[(= 1 (length cell)) (car cell)]
[else (make-nested-flow plain cell)]))
cells))
cellss)))
(define (table-flowss t)
(map (lambda (row) (map (lambda (c) (make-flow (list c))) row))
(table-blockss t)))
(provide deserialize-part-relative-element)
(define deserialize-part-relative-element
(make-deserialize-info values values))
(define (make-auxiliary-table style cells)
(let ([t (make-table/compat style cells)])
(make-table (make-style (style-name (table-style t))
(cons 'aux
(style-variants (table-style t))))
(table-blockss t))))
(provide part-relative-element-content)
(define (part-relative-element-content e ci/ri)
(hash-ref (collect-info-relatives
(if (resolve-info? ci/ri) (resolve-info-ci ci/ri) ci/ri))
e))
(define (auxiliary-table? t)
(ormap (lambda (v) (eq? v 'aux) (style-variants (table-style t)))))
(provide collect-info-parents)
(define (make-itemization/compat flows)
(make-itemization plain flows))
(define (make-styled-itemization style flows)
(make-itemization (convert-style style) flows))
;; ----------------------------------------
(define (make-blockquote style blocks)
(make-nested-flow (convert-style (or style 'inset)) blocks))
;; Delayed index entry also has special serialization support.
;; It uses the same delay -> value table as delayed-element
(define-struct delayed-index-desc (resolve)
#:mutable
#:property
prop:serializable
(make-serialize-info
(lambda (d)
(let ([ri (current-serialize-resolve-info)])
(unless ri
(error 'serialize-delayed-index-desc
"current-serialize-resolve-info not set"))
(with-handlers ([exn:fail:contract?
(lambda (exn)
(error 'serialize-index-desc
"serialization failed (wrong resolve info?); ~a"
(exn-message exn)))])
(vector
(delayed-element-content d ri)))))
#'deserialize-delayed-index-desc
#f
(or (current-load-relative-directory) (current-directory))))
(define (make-compound-paragraph/compat style blocks)
(make-compound-paragraph (convert-style style) blocks))
(provide/contract
(struct delayed-index-desc ([resolve (any/c part? resolve-info? . -> . any)])))
(define (element-style-name s)
(if (style? s)
(style-name s)
s))
(define (element-style-variants s)
(if (style? s)
(style-variants s)
null))
(provide deserialize-delayed-index-desc)
(define deserialize-delayed-index-desc
(make-deserialize-info values values))
(define (add-element-variant v e)
(make-element (make-style (element-style-name (element-style e))
(cons v
(element-style-variants (element-style e))))
(element-content e)))
(define (check-element-style e pred)
(ormap pred (style-variants (element-style e))))
;; ----------------------------------------
(define (handle-image-style ctr style . args)
(if (image-file? style)
(make-image-element #f (list (apply ctr #f args))
(image-file-path style)
null
(image-file-scale style))
(apply ctr (convert-element-style style) args)))
(define-struct (collect-element element) (collect)
#:mutable
#:property
prop:serializable
(make-serialize-info
(lambda (d)
(vector (make-element
(element-style d)
(element-content d))))
#'deserialize-collect-element
#f
(or (current-load-relative-directory) (current-directory))))
(provide deserialize-collect-element)
(define deserialize-collect-element
(make-deserialize-info values values))
(provide/contract
[struct collect-element ([style any/c]
[content list?]
[collect (collect-info? . -> . any)])])
;; ----------------------------------------
(define-struct (render-element element) (render)
#:property
prop:serializable
(make-serialize-info
(lambda (d)
(vector (make-element
(element-style d)
(element-content d))))
#'deserialize-render-element
#f
(or (current-load-relative-directory) (current-directory))))
(provide deserialize-render-element)
(define deserialize-render-element
(make-deserialize-info values values))
(provide/contract
[struct render-element ([style any/c]
[content list?]
[render (any/c part? resolve-info? . -> . any)])])
;; ----------------------------------------
(define-struct generated-tag ()
#:property
prop:serializable
(make-serialize-info
(lambda (g)
(let ([ri (current-serialize-resolve-info)])
(unless ri
(error 'serialize-generated-tag
"current-serialize-resolve-info not set"))
(let ([t (hash-ref (collect-info-tags (resolve-info-ci ri)) g #f)])
(if t
(vector t)
(error 'serialize-generated-tag
"serialization failed (wrong resolve info?)")))))
#'deserialize-generated-tag
#f
(or (current-load-relative-directory) (current-directory))))
(provide (struct-out generated-tag))
(provide deserialize-generated-tag)
(define deserialize-generated-tag
(make-deserialize-info values values))
(provide generate-tag tag-key
current-tag-prefixes
add-current-tag-prefix)
(define (generate-tag tg ci)
(if (generated-tag? (cadr tg))
(let ([t (cadr tg)])
(list (car tg)
(let ([tags (collect-info-tags ci)])
(or (hash-ref tags t #f)
(let ([key (list* 'gentag
(hash-count tags)
(collect-info-gen-prefix ci))])
(hash-set! tags t key)
key)))))
tg))
(define (tag-key tg ri)
(if (generated-tag? (cadr tg))
(list (car tg)
(hash-ref (collect-info-tags (resolve-info-ci ri)) (cadr tg)))
tg))
(define current-tag-prefixes (make-parameter null))
(define (add-current-tag-prefix t)
(let ([l (current-tag-prefixes)])
(if (null? l)
t
(cons (car t) (append l (cdr t))))))
;; ----------------------------------------
(provide content->string
element->string
strip-aux)
(define content->string
(case-lambda
[(c) (c->s c element->string)]
[(c renderer sec ri)
(c->s c (lambda (e) (element->string e renderer sec ri)))]))
(define (c->s c do-elem)
(apply string-append (map do-elem c)))
(define element->string
(case-lambda
[(c)
(cond
[(element? c) (content->string (element-content c))]
[(part-relative-element? c) (element->string ((part-relative-element-plain c)))]
[(delayed-element? c) (element->string ((delayed-element-plain c)))]
[(string? c) c]
[else (case c
[(mdash) "---"]
[(ndash) "--"]
[(ldquo rdquo) "\""]
[(rsquo) "'"]
[(rarr) "->"]
[(lang) "<"]
[(rang) ">"]
[else (format "~s" c)])])]
[(c renderer sec ri)
(cond
[(and (link-element? c)
(null? (element-content c)))
(let ([dest (resolve-get sec ri (link-element-tag c))])
;; FIXME: this is specific to renderer
(if dest
(content->string (strip-aux
(if (pair? dest) (cadr dest) (vector-ref dest 1)))
renderer sec ri)
"???"))]
[(element? c) (content->string (element-content c) renderer sec ri)]
[(delayed-element? c)
(content->string (delayed-element-content c ri) renderer sec ri)]
[(part-relative-element? c)
(content->string (part-relative-element-content c ri) renderer sec ri)]
[else (element->string c)])]))
(define (strip-aux content)
(define (convert-element-style style)
(cond
[(null? content) null]
[(aux-element? (car content)) (strip-aux (cdr content))]
[else (cons (car content) (strip-aux (cdr content)))]))
[(not style) style]
[(string? style) style]
[(symbol? style) style]
[else (convert-style style)]))
;; ----------------------------------------
(provide block-width
element-width)
(define (element-width s)
(define (element?/compat e)
(or (element? e) (and (list? e) (content? e))))
(define (element-content/compat e)
(cond
[(string? s) (string-length s)]
[(element? s) (apply + (map element-width (element-content s)))]
[(delayed-element? s) (element-width ((delayed-element-sizer s)))]
[(part-relative-element? s) (element-width ((part-relative-element-sizer s)))]
[else 1]))
(define (paragraph-width s)
(apply + (map element-width (paragraph-content s))))
(define (flow-width f)
(apply max 0 (map block-width (flow-paragraphs f))))
(define (block-width p)
[(element? e) (content->list (element-content e))]
[else e]))
(define (element-style/compat e)
(cond
[(paragraph? p) (paragraph-width p)]
[(table? p) (table-width p)]
[(itemization? p) (itemization-width p)]
[(blockquote? p) (blockquote-width p)]
[(compound-paragraph? p) (compound-paragraph-width p)]
[(delayed-block? p) 1]))
[(element? e) (element-style e)]
[else #f]))
(define (table-width p)
(let ([flowss (table-flowss p)])
(if (null? flowss)
0
(let loop ([flowss flowss])
(if (null? (car flowss))
0
(+ (apply max 0 (map flow-width (map car flowss)))
(loop (map cdr flowss))))))))
(define (make-element/compat style content)
(handle-image-style make-element style (list->content content)))
(define (make-toc-element/compat style content toc-content)
(handle-image-style make-toc-element style (list->content content) (list->content toc-content)))
(define (toc-element-toc-content/compat e)
(content->list (toc-element-toc-content e)))
(define (make-target-element/compat style content tag)
(handle-image-style make-target-element style (list->content content) tag))
(define (make-toc-target-element/compat style content tag)
(handle-image-style make-toc-target-element style (list->content content) tag))
(define (make-page-target-element/compat style content tag)
(handle-image-style make-page-target-element style (list->content content) tag))
(define (make-redirect-target-element/compat style content tag alt-path alt-anchor)
(handle-image-style make-redirect-target-element style (list->content content) tag alt-path alt-anchor))
(define (make-link-element/compat style content tag)
(handle-image-style make-link-element style (list->content content) tag))
(define (make-index-element/compat style content tag plain-seq etry-seq desc)
(handle-image-style make-index-element style (list->content content) tag plain-seq etry-seq desc))
(define (itemization-width p)
(apply max 0 (map flow-width (itemization-flows p))))
(define (make-aux-element style content)
(add-element-variant 'aux (make-element/compat style content)))
(define (aux-element? e)
(check-element-style e (lambda (v) (eq? v 'aux))))
(define (blockquote-width p)
(+ 4 (apply max 0 (map block-width (blockquote-paragraphs p)))))
(define (make-hover-element style content text)
(add-element-variant (make-hover-variant text)
(make-element/compat style content)))
(define (hover-element? e)
(check-element-style e hover-variant?))
(define (hover-element-text e)
(ormap (lambda (v)
(and (hover-variant? v) (hover-variant-text e)))
(style-variants (element-style e))))
(define (compound-paragraph-width p)
(apply max 0 (map block-width (compound-paragraph-blocks p))))
(define (make-script-element style content type script)
(add-element-variant (make-script-variant type script)
(make-element/compat style content)))
(define (script-element? e)
(check-element-style e script-variant?))
(define (script-element-type e)
(ormap (lambda (v)
(and (script-variant? v) (script-variant-type e)))
(style-variants (element-style e))))
(define (script-element-script e)
(ormap (lambda (v)
(and (script-variant? v) (script-variant-script e)))
(style-variants (element-style e))))
;; ----------------------------------------
(provide part-style?)
(define (part-style? p s)
(let ([st (part-style p)])
(or (eq? s st)
(and (list? st) (memq s st)))))
;; ----------------------------------------
(define (info-key? l)
(and (pair? l)
(symbol? (car l))
(pair? (cdr l))))
(provide info-key?)
(provide/contract
[part-collected-info (part? resolve-info? . -> . collected-info?)]
[collect-put! (collect-info? info-key? any/c . -> . any)]
[resolve-get ((or/c part? false/c) resolve-info? info-key? . -> . any)]
[resolve-get/tentative ((or/c part? false/c) resolve-info? info-key? . -> . any)]
[resolve-get/ext? ((or/c part? false/c) resolve-info? info-key? . -> . any)]
[resolve-search (any/c (or/c part? false/c) resolve-info? info-key? . -> . any)]
[resolve-get-keys ((or/c part? false/c) resolve-info? (info-key? . -> . any/c) . -> . any/c)])
;; ----------------------------------------
(define (convert-style s)
(cond
[(not s) plain]
[(style? s) s]
[(string? s) (make-style s null)]
[(symbol? s) (make-style s null)]
[(and (list? s) (andmap symbol? s)) (make-style #f s)]
[(with-attributes? s) (let* ([wa (flatten-style s)]
[s (convert-style (with-attributes-style wa))])
(make-style (style-name s)
(cons
(make-attributes (with-attributes-assoc wa))
(style-variants s))))]
[(target-url? s) (let ([s (convert-style (target-url-style s))])
(make-style (style-name s)
(cons
(core:make-target-url (target-url-addr s))
(style-variants s))))]
[(image-file? s) (make-style #f null)]
[(and (list? s) (pair? s) (eq? (car s) 'color))
(make-style #f (list (make-color-variant
(if (string? (cadr s)) (cadr s) (cdr s)))))]
[(and (list? s) (pair? s) (eq? (car s) 'bg-color))
(make-style #f (list (make-background-color-variant
(if (string? (cadr s)) (cadr s) (cdr s)))))]
[(and (pair? s)
(list? s)
(andmap (lambda (v) (and (pair? v)
(memq (car v) '(alignment valignment row-styles style))))
s))
(let ([gen-columns (lambda (sn a va)
(map (lambda (sn a va)
(make-style sn
(append (if a (list a) null)
(if va (list va) null))))
(cdr (or sn (map (lambda (x) #f) (or va a))))
(cdr (or a (map (lambda (x) #f) (or va sn))))
(cdr (or va (map (lambda (x) #f) (or a sn))))))])
(make-style (let ([s (assq 'style s)])
(and s (cadr s)))
(let ([a (assq 'alignment s)]
[va (assq 'valignment s)])
(if (or a va)
(list (make-table-columns (gen-columns #f a va)))
(let ([l (cdr (assq 'row-styles s))])
(list
(make-table-cells
(map (lambda (row)
(let ([sn (assq 'style row)]
[a (assq 'alignment row)]
[va (assq 'valignment row)])
(if (or sn a va)
(gen-columns sn a va)
(error 'convert-style "no row style found"))))
l))))))))]
[else (error 'convert-style "unrecognized style: ~e" s)]))
(define (flatten-style s)
(cond
@ -568,5 +425,3 @@
(target-url-addr s)
rest)))]
[else s]))
(provide flatten-style)

29
collects/scribble/text-render.ss
View File

@ -1,6 +1,6 @@
(module text-render mzscheme
(require "struct.ss"
(require "core.ss"
mzlib/class)
(provide render-mixin)
@ -35,7 +35,7 @@
(part-title-content d))
(newline))
(newline)
(render-flow (part-flow d) d ht #f)
(render-flow (part-blocks d) d ht #f)
(let loop ([pos 1]
[secs (part-parts d)])
(unless (null? secs)
@ -44,31 +44,30 @@
(loop (add1 pos) (cdr secs))))))
(define/override (render-flow f part ht starting-item?)
(let ([f (flow-paragraphs f)])
(if (null? f)
null
(apply
append
(render-block (car f) part ht starting-item?)
(map (lambda (p)
(newline) (newline)
(render-block p part ht #f))
(cdr f))))))
(if (null? f)
null
(apply
append
(render-block (car f) part ht starting-item?)
(map (lambda (p)
(newline) (newline)
(render-block p part ht #f))
(cdr f)))))
(define/override (render-table i part ht inline?)
(let ([flowss (table-flowss i)])
(let ([flowss (table-blockss i)])
(if (null? flowss)
null
(apply
append
(map (lambda (d) (unless (eq? d 'cont) (render-flow d part ht #f))) (car flowss))
(map (lambda (d) (unless (eq? d 'cont) (render-block d part ht #f))) (car flowss))
(map (lambda (flows)
(newline)
(map (lambda (d) (unless (eq? d 'cont) (render-flow d part ht #f))) flows))
(cdr flowss))))))
(define/override (render-itemization i part ht)
(let ([flows (itemization-flows i)])
(let ([flows (itemization-blockss i)])
(if (null? flows)
null
(apply append

494
collects/scribblings/scribble/base.scrbl Normal file
View File

@ -0,0 +1,494 @@
#lang scribble/doc
@(require scribble/manual
"utils.ss"
(for-syntax scheme/base)
(for-label setup/main-collects))
@(define-syntax def-section-like
(syntax-rules ()
[(_ id result/c x ...)
(defproc (id [#:tag tag (or/c false/c string? (listof string?)) #f]
[#:tag-prefix tag-prefix (or/c false/c string? module-path?) #f]
[#:style style (or/c style? #f string? symbol? (listof symbol?)) #f]
[pre-content pre-content?] (... ...+))
result/c
x ...)]))
@(define-syntax def-elem-proc
(syntax-rules ()
[(_ id x ...)
(defproc (id [pre-content pre-content?] (... ...))
element?
x ...)]))
@(define-syntax def-style-proc
(syntax-rules ()
[(_ id)
@def-elem-proc[id]{Like @scheme[elem], but with style @scheme['id].}]))
@title[#:tag "base"]{Base Document Forms}
@defmodule[scribble/base]{The @schememodname[scribble/base] library
provides functions and forms that can be used from code written either
in Scheme or with @elem["@"] expressions.
The @schememodname[scribble/base] name can also be used as a
language with @hash-lang[]. It acts like the
@schememodname[scribble/doc] language, except that the
@schememodname[scribble/base] library is also required into
the module.}
Functions provided by this library, such as @scheme[title] and
@scheme[italic], might be called from Scheme as
@schemeblock[
(title #:tag "how-to"
"How to Design " (italic "Great") " Programs")
]
They can also be called with @elem["@"] notation as
@verbatim[#:indent 2]|{
@title[#:tag "how-to"]{How to Design @italic{Great} Programs}
}|
Although the procedures are mostly design to be used from @elem["@"]
mode, they are easier to document in Scheme mode (partly because we
have @schememodname[scribble/manual]).
@; ------------------------------------------------------------------------
@section{Document Structure}
@defproc[(title [#:tag tag (or/c false/c string? (listof string?)) #f]
[#:tag-prefix tag-prefix (or/c false/c string? module-path?) #f]
[#:style style (or/c style? #f string? symbol? (listof symbol?)) #f]
[#:version vers (or/c string? false/c) #f]
[pre-content pre-content?] ...+)
title-decl?]{
Generates a @scheme[title-decl] to be picked up by @scheme[decode] or
@scheme[decode-part]. The @tech{decode}d @scheme[pre-content] (i.e.,
parsed with @scheme[decode-content]) supplies the title content. If
@scheme[tag] is @scheme[#f], a tag string is generated automatically
from the content. The tag string is combined with the symbol
@scheme['part] to form the full tag.
The @scheme[style] argument can be a style structure, or it can be one
of the following: a @scheme[#f] that corresponds to a ``plain'' style,
a string that is used as a @tech{style name}, a symbol that is used as
a @tech{variant}, or a list of symbols to be used as @tech{variants}.
For information on styles, see @scheme[part]. For example, a style of
@scheme['toc] causes sub-sections to be generated as separate pages in
multi-page HTML output.
The @scheme[tag-prefix] argument is propagated to the generated
structure (see @secref["tags"]). If @scheme[tag-prefix] is a module
path, it is converted to a string using
@scheme[module-path-prefix->string].
The @scheme[vers] argument is propagated to the @scheme[title-decl]
structure. Use @scheme[""] as @scheme[vers] to suppress version
rendering in the output.
The section title is automatically indexed by
@scheme[decode-part]. For the index key, leading whitespace and a
leading ``A'', ``An'', or ``The'' (followed by more whitespace) is
removed.}
@def-section-like[section part-start?]{ Like @scheme[title], but
generates a @scheme[part-start] of depth @scheme[0] to be by
@scheme[decode] or @scheme[decode-part].}
@def-section-like[subsection part-start?]{ Like @scheme[section], but
generates a @scheme[part-start] of depth @scheme[1].}
@def-section-like[subsubsection part-start?]{ Like @scheme[section], but
generates a @scheme[part-start] of depth @scheme[2].}
@def-section-like[subsubsub*section paragraph?]{ Similar to
@scheme[section], but merely generates a paragraph that looks like an
unnumbered section heading (for when the nesting gets too deep to
include in a table of contents).}
@defform[(include-section module-path)]{ Requires @scheme[module-path]
and returns its @scheme[doc] export (without making any imports
visible to the enclosing context). Since this form expands to
@scheme[require], it must be used in a module or top-level context.}
@defproc[(author [auth content?] ...) block?]{
Generates a @scheme[paragraph] with style name @scheme['author] to
show the author(s) of a document, where each author is represented by
@tech{content}. Normally, this function is used after
@scheme[title] for the beginning of a document. See also
@scheme[author+email].}
@defproc[(author+email [author elem] [email string?]) element?]{
Combines an author name with an e-mail address, obscuring the e-mail
address slightly to avoid address-harvesting robots.}
@; ------------------------------------------------------------------------
@section{Blocks}
@defproc[(para [#:style style (or/c style? string? symbol? #f)]
[pre-content pre-content?] ...) paragraph?]{
Creates a @tech{paragraph} containing the @tech{decode}d
@scheme[pre-content] (i.e., parsed with @scheme[decode-paragraph]).
The @scheme[style] argument can be a style, @scheme[#f] to indicate a
``plain'' style, a string that is used as a @tech{style name}, or a
symbol that is used as a @tech{style name}. (Note that
@scheme[section] and @scheme[para] treat symbols differently as
@scheme[style] arguments.)}
@defproc[(nested [#:style style (or/c style? string? symbol? #f)]
[pre-flow pre-flow?] ...) nested-flow?]{
Creates a @tech{nested flow} containing the @tech{decode}d
@scheme[pre-flow] (i.e., parsed with @scheme[decode-flow]).
The @scheme[style] argument is handled the same as @scheme[para].
The @scheme['inset] style causes the nested flow to be inset compared
to surrounding text.}
@defproc[(centered [pre-flow pre-flow?] ...) nested-flow?]{
Produces a @tech{nested flow} whose content is centered.}
@defproc[(margin-note [pre-content pre-content?] ...) blockquote?]{
Produces a @tech{nested flow} that is typeset in the margin, instead
of inlined.}
@defproc[(itemlist [itm item?] ...
[#:style style (or/c style? string? symbol? #f) #f])
itemization?]{
Constructs an @scheme[itemization] given a sequence of items
constructed by @scheme[item].
The @scheme[style] argument is handled the same as @scheme[para]. The
@scheme['ordered] style numbers items, instead of just using a
bullet.}
@defproc[(item [pre-flow pre-flow?] ...) item?]{
Creates an item for use with @scheme[itemlist]. The @tech{decode}d
@scheme[pre-flow] (i.e., parsed with @scheme[decode-flow]) is the item
content.}
@defproc[(item? [v any/c]) boolean?]{
Returns @scheme[#t] if @scheme[v] is an item produced by
@scheme[item], @scheme[#f] otherwise.}
@defproc[(tabular [cells (listof (listof (or/c block? content? 'cont)))]
[#:style style (or/c style? string? symbol? #f) #f])
table?]{
Creates a @tech{table} with the given content, which is supplies as a
list of rows, where each row has a list of cells. The length of all
rows must match.
Use @scheme['cont] as a cell to continue the content of the preceding
cell in a row in the space that would otherwise be used for a new
cell. A @scheme['cont] must not appear as the first cell in a row.
The @scheme[style] argument is handled the same as @scheme[para].}
@defproc[(verbatim [#:indent indent exact-nonnegative-integer? 0] [str string?] ...+)
block?]{
Typesets @scheme[str]s in typewriter font with the linebreaks
specified by newline characters in @scheme[str]. Consecutive spaces in
the @scheme[str]s are converted to @scheme[hspace] to ensure that they
are all preserved in the output. Additional space (via
@scheme[hspace]) as specified by @scheme[indent] is added to the
beginning of each line.
The @scheme[str]s are @emph{not} decoded with @scheme[decode-content],
so @scheme[(verbatim "---")] renders with three hyphens instead of an
em-dash. Beware, however, that @litchar["@"] for a @scheme[verbatim]
call performs some processing before delivering arguments to
@scheme[verbatim]. The @scheme[verbatim] form is typically used with
@litchar["|{"]...@litchar["}|"] or similar brackets to disable
@litchar["@"] notation within the @scheme[verbatim] argument, like
this:
@verbatim[#:indent 2]|{
@verbatim|{
Use @bold{---} like this...
}|
}|
which renders as
@verbatim[#:indent 2]|{
Use @bold{---} like this...
}|
Even with @litchar["|{"]...@litchar["}|"], beware that consistent
leading whitespace is removed; see @secref["alt-body-syntax"] for more
information.
See also @scheme[literal].}
@; ------------------------------------------------------------------------
@section{Text Styles and Content}
@defproc[(elem [pre-content pre-content?] ...
[#:style style (or style? string? symbol? #f) #f])
element?]{
Wraps the @tech{decode}d @scheme[pre-content] as an element with style
@scheme[style].}
@def-style-proc[italic]
@def-style-proc[bold]
@def-style-proc[tt]
@def-style-proc[subscript]
@def-style-proc[superscript]
@def-elem-proc[smaller]{Like @scheme[elem], but with style
@scheme['smaller]. When uses of @scheme[smaller] are nested, text
gets progressively smaller.}
@def-elem-proc[larger]{Like @scheme[elem], but with style
@scheme['larger]. When uses of @scheme[larger] are nested, text
gets progressively larger.}
@defproc[(emph [pre-content pre-content?] ...) element?]{
The same as @scheme[italic].}
@defproc[(hspace [n exact-nonnegative-integer?]) element?]{
Produces an element containing @scheme[n] spaces and style
@scheme['hspace].}
@defproc[(literal [str string?] ...+) element?]{
Produces an element containing literally @scheme[str]s with no
decoding via @scheme[decode-content].
Beware that @litchar["@"] for a @scheme[literal] call performs some
processing before delivering arguments to @scheme[literal]. The
@scheme[literal] form can be used with @litchar["|{"]...@litchar["}|"]
or similar brackets to disable @litchar["@"] notation within the
@scheme[literal] argument, like this:
@verbatim[#:indent 2]|{
@literal|{@bold{---}}|
}|
which renders as
@verbatim[#:indent 2]|{
@literal|{@bold{---}}|
}|
See also @scheme[verbatim].}
@defproc[(image [path (or/c path-string? (cons/c 'collects (listof bytes?)))]
[#:scale scale real? 1.0]
[#:suffixes suffixes (listof #rx"^[.]") null]
[pre-content pre-content?] ...)
element?]{
Creates an image element from the given path. The @tech{decode}d
@scheme[pre-content] serves as the alternate text for contexts where
the image cannot be displayed.
The path is relative to the current directory, which is set by
@exec{setup-plt} and @exec{scribble} to the directory of the main
document file. The @scheme[path] argument also can be a result of
@scheme[path->main-collects-relative].
The strings in @scheme[suffixes] are filtered to those supported by
given renderer, and then the acceptable suffixes are tried in
order. The HTML renderer supports @scheme[".png"] and
@scheme[".gif"], while the Latex renderer supports @scheme[".png"],
@scheme[".pdf"], and @scheme[".ps"] (but @scheme[".ps"] works only
when converting Latex output to DVI, and @scheme[".png"] and
@scheme[".pdf"] work only for converting Latex output to PDF).}
@; ------------------------------------------------------------------------
@section[#:tag "base-links"]{Links}
@defproc[(hyperlink [url string?] [pre-content pre-content?] ...
[#:underline? underline? any/c #t]
[#:style style (or/c style? string? symbol? #f) (if underline? #f "plainlink")])
element?]{
The @tech{decode}d @scheme[pre-content] is hyperlinked to
@scheme[url]. If @scheme[style] is not supplied, then
@scheme[underline?] determines how the link is rendered.}
@defproc[(url [dest string?]) element?]{
Generates a literal hyperlinked URL.}
@defproc[(secref [tag string?]
[#:doc module-path (or/c module-path? false/c) #f]
[#:tag-prefixes prefixes (or/c (listof string?) false/c) #f]
[#:underline? underline? any/c #t])
element?]{
Inserts the hyperlinked title of the section tagged @scheme[tag], but
elements in the title content with the @scheme['aux] @tech{variant}
are omitted in the hyperlink label.
If @scheme[#:doc module-path] is provided, the @scheme[tag] refers to
a tag with a prefix determined by @scheme[module-path]. When
@exec{setup-plt} renders documentation, it automatically adds a tag
prefix to the document based on the source module. Thus, for example,
to refer to a section of the PLT Scheme reference,
@scheme[module-path] would be @scheme['(lib
"scribblings/reference/reference.scrbl")].
The @scheme[#:tag-prefixes prefixes] argument similarly supports
selecting a particular section as determined by a path of tag
prefixes. When a @scheme[#:doc] argument is provided, then
@scheme[prefixes] should trace a path of tag-prefixed subsections to
reach the @scheme[tag] section. When @scheme[#:doc] is not provided,
the @scheme[prefixes] path is relative to any enclosing section (i.e.,
the youngest ancestor that produces a match).
If @scheme[underline?] is @scheme[#f], then the hyperlink is rendered
in HTML without an underline.}
@defproc[(seclink [tag string?]
[#:doc module-path (or/c module-path? false/c) #f]
[#:tag-prefixes prefixes (or/c (listof string?) false/c) #f]
[#:underline? underline? any/c #t]
[pre-content pre-content?] ...) element?]{
Like @scheme[secref], but the link label is the @tech{decode}d
@scheme[pre-content] instead of the target section's name.}
@defproc[(other-doc [module-path module-path?]
[#:underline? underline? any/c #t])
element?]{
Like @scheme[secref] for the document's implicit @scheme["top"]
tag. Use this function to refer to a whole manual instead of
@scheme[secref], in case a special style in the future is used for
manual titles.}
@defproc[(elemtag [t (or/c tag? string?)] [pre-content pre-content?] ...) element?]{
The tag @scheme[t] refers to the content form of
@scheme[pre-content].}
@defproc[(elemref [t (or/c tag? string?)] [pre-content pre-content?] ...
[#:underline? underline? any/c #t]) element?]{
The @tech{decode}d @scheme[pre-content] is hyperlinked to @scheme[t],
which is normally defined using @scheme[elemtag].}
@defproc[(module-path-prefix->string [mod-path module-path?])
string?]{
Converts a module path to a string by resolving it to a path, and
using @scheme[path->main-collects-relative].}
@; ------------------------------------------------------------------------
@section[#:tag "base-indexing"]{Indexing}
@defproc[(index [words (or/c string? (listof string?))]
[pre-content pre-content?] ...)
index-element?]{
Creates an index element given a plain-text string---or list of
strings for a hierarchy, such as @scheme['("strings" "plain")] for a
``plain'' entry below a more general ``strings'' entry. As index keys,
the strings are ``cleaned'' using @scheme[clean-up-index-strings]. The
strings (without clean-up) also serve as the text to render in the
index. The @tech{decode}d @scheme[pre-content] is the text to appear
inline as the index target.
Use @scheme[index] when an index entry should point to a specific word
or phrase within the typeset document (i.e., the
@scheme[pre-content]). Use @scheme[section-index], instead, to create
an index entry that leads to a section, instead of a specific word or
phrase within the section.}
@defproc[(index* [words (listof string?)]
[word-contents (listof list?)]
[pre-content pre-content?] ...)
index-element?]{
Like @scheme[index], except that @scheme[words] must be a list, and
the list of contents render in the index (in parallel to
@scheme[words]) is supplied as @scheme[word-contents].
}
@defproc[(as-index [pre-content pre-content?] ...)
index-element?]{
Like @scheme[index], but the word to index is determined by applying
@scheme[content->string] on the @tech{decode}d @scheme[pre-content].}
@defproc[(section-index [word string?] ...)
part-index-decl?]{
Creates a @scheme[part-index-decl] to be associated with the enclosing
section by @scheme[decode]. The @scheme[word]s serve as both the keys
and as the rendered forms of the keys within the index.}
@defproc[(index-section [#:tag tag (or/c false/c string?) "doc-index"])
part?]{
Produces a part that shows the index the enclosing document. The
optional @scheme[tag] argument is used as the index section's tag.}
@; ------------------------------------------------------------------------
@section{Tables of Contents}
@defproc[(table-of-contents) delayed-block?]{
Returns a delayed flow element that expands to a table of contents for
the enclosing section. For Latex output, however, the table of
contents currently spans the entire enclosing document.}
@defproc[(local-table-of-contents [#:style style (or/c symbol? #f) #f])
delayed-block?]{
Returns a delayed flow element that may expand to a table of contents
for the enclosing section, depending on the output type. For
multi-page HTML output, the flow element is a table of contents; for
Latex output, the flow element is empty.
The meaning of the @scheme[style] argument depends on the output type,
but @scheme['immediate-only] normally creates a table of contents that
contains only immediate sub-sections of the enclosing section. See
also the @scheme['quiet] style of @scheme[part] (i.e., in a
@scheme[part] structure, not supplied as the @scheme[style] argument
to @scheme[local-table-of-contents]), which normally suppresses
sub-part entries in a table of contents.}

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

@ -1,265 +1,27 @@
#lang scribble/doc
@(require scribble/manual
"utils.ss"
(for-syntax scheme/base)
(for-label setup/main-collects))
#lang scribble/manual
@(require "utils.ss"
(for-label (only-in scribble/basic span-class)))
@(define-syntax def-section-like
(syntax-rules ()
[(_ id result/c x ...)
(defproc (id [#:tag tag (or/c false/c string?) #f]
[#:tag-prefix tag-prefix (or/c false/c string? module-path?) #f]
[#:style style any/c #f]
[pre-content any/c] (... ...+))
result/c
x ...)]))
@(define (compat)
@italic{For backward compatibility.})
@(define-syntax def-elem-proc
(syntax-rules ()
[(_ id x ...)
(defproc (id [pre-content any/c] (... ...))
element?
x ...)]))
@(define-syntax def-style-proc
(syntax-rules ()
[(_ id)
@def-elem-proc[id]{Like @scheme[elem], but with style @scheme['id].}]))
@title[#:tag "basic"]{Basic Document Forms}
@defmodule[scribble/basic]{The @schememodname[scribble/basic] library
provides functions and forms that can be used from code written either
in Scheme or with @elem["@"] expressions.}
For example, the @scheme[title] and @scheme[italic] functions might be
called from Scheme as
@schemeblock[
(title #:tag "how-to"
"How to Design " (italic "Great") " Programs")
]
or with an @elem["@"] expression as
@verbatim[#:indent 2]|{
@title[#:tag "how-to"]{How to Design @italic{Great} Programs}
}|
Although the procedures are mostly design to be used from @elem["@"]
mode, they are easier to document in Scheme mode (partly because we
have @schememodname[scribble/manual]).
@; ------------------------------------------------------------------------
@section{Document Structure}
@defproc[(title [#:tag tag (or/c false/c string?) #f]
[#:tag-prefix tag-prefix (or/c false/c string? module-path?) #f]
[#:style style any/c #f]
[#:version vers (or/c string? false/c) #f]
[pre-content any/c] ...+)
title-decl?]{
Generates a @scheme[title-decl] to be picked up by @scheme[decode] or
@scheme[decode-part]. The @tech{decode}d @scheme[pre-content] (i.e.,
parsed with @scheme[decode-content]) supplies the title content. If
@scheme[tag] is @scheme[#f], a tag string is generated automatically
from the content. The tag string is combined with the symbol
@scheme['part] to form the full tag.
A style of @scheme['toc] causes sub-sections to be generated as
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 @scheme[tag-prefix] argument is propagated to the generated
structure (see @secref["tags"]). If @scheme[tag-prefix] is a module
path, it is converted to a string using
@scheme[module-path-prefix->string].
The @scheme[vers] argument is propagated to the @scheme[title-decl]
structure. Use @scheme[""] as @scheme[vers] to suppress version
rendering in the output.
The section title is automatically indexed by
@scheme[decode-part]. For the index key, leading whitespace and a
leading ``A'', ``An'', or ``The'' (followed by more whitespace) is
removed.}
@def-section-like[section part-start?]{ Like @scheme[title], but
generates a @scheme[part-start] of depth @scheme[0] to be by
@scheme[decode] or @scheme[decode-part].}
@def-section-like[subsection part-start?]{ Like @scheme[section], but
generates a @scheme[part-start] of depth @scheme[1].}
@def-section-like[subsubsection part-start?]{ Like @scheme[section], but
generates a @scheme[part-start] of depth @scheme[2].}
@def-section-like[subsubsub*section paragraph?]{ Similar to
@scheme[section], but merely generates a paragraph that looks like an
unnumbered section heading (for when the nesting gets too deep to
include in a table of contents).}
@defproc[(itemize [itm (or/c whitespace? an-item?)] ...
[#:style style any/c #f]) itemization?]{
Constructs an @scheme[itemization] or (when @scheme[style] is not
@scheme[#f]) @scheme[styled-itemization] given a sequence of items
constructed by @scheme[item]. Whitespace strings among the
@scheme[itm]s are ignored.
}
@defproc[(item [pre-flow any/c] ...) item?]{
Creates an item for use with @scheme[itemize]. The @tech{decode}d
@scheme[pre-flow] (i.e., parsed with @scheme[decode-flow]) is the item
content.}
@defproc[(item? [v any/c]) boolean?]{
Returns @scheme[#t] if @scheme[v] is an item produced by
@scheme[item], @scheme[#f] otherwise.}
@defform[(include-section module-path)]{ Requires @scheme[module-path]
and returns its @scheme[doc] export (without making any imports
visible to the enclosing context). Since this form expands to
@scheme[require], it must be used in a module or top-level context.}
@defproc[(author [auth any/c] ...) block?]{
Generates a @scheme[styled-paragraph] to show the author(s) of a
document, where each author is represented by an
@tech{element}. Normally, this function is used after @scheme[title]
for the beginning of a document. See also @scheme[author+email].}
@defproc[(author+email [author elem] [email string?]) element?]{
Combines an author name with an e-mail address, obscuring the e-mail
address slightly to avoid address-harvesting robots.}
@defproc[(module-path-prefix->string [mod-path module-path?])
string?]{
Converts a module path to a string by resolving it to a path, and
using @scheme[path->main-collects-relative].}
@; ------------------------------------------------------------------------
@section{Text Styles}
@defproc[(elem [pre-content any/c] ...
[#:style style any/c #f])
element?]{
Wraps the @tech{decode}d @scheme[pre-content] as an element with style
@scheme[style].}
@def-elem-proc[aux-elem]{Like @scheme[elem], but creates an
@scheme[aux-element].}
@def-style-proc[italic]
@def-style-proc[bold]
@def-style-proc[tt]
@def-style-proc[subscript]
@def-style-proc[superscript]
@def-elem-proc[smaller]{Like @scheme[elem], but with style
@scheme["smaller"]. When uses of @scheme[smaller] are nested, text
gets progressively smaller.}
@defproc[(hspace [n exact-nonnegative-integer?]) element?]{
Produces an element containing @scheme[n] spaces and style
@scheme['hspace].}
@title[#:tag "basic"]{Compatibility Basic Functions}
@defmodule[scribble/basic]{The @schememodname[scribble/basic]
compatibility library mostly just re-exports
@schememodname[scribble/base].}
@defproc[(span-class [style-name string?] [pre-content any/c] ...)
element?]{
Wraps the @tech{decode}d @scheme[pre-content] as an element with style
@scheme[style-name].}
@; ------------------------------------------------------------------------
@section{Indexing}
@defproc[(index [words (or/c string? (listof string?))]
[pre-content any/c] ...)
index-element?]{
Creates an index element given a plain-text string---or list of
strings for a hierarchy, such as @scheme['("strings" "plain")] for a
``plain'' entry below a more general ``strings'' entry. As index keys,
the strings are ``cleaned'' using @scheme[clean-up-index-strings]. The
strings (without clean-up) also serve as the text to render in the
index. The @tech{decode}d @scheme[pre-content] is the text to appear
inline as the index target.
Use @scheme[index] when an index entry should point to a specific word
or phrase within the typeset document (i.e., the
@scheme[pre-content]). Use @scheme[section-index], instead, to create
an index entry that leads to a section, instead of a specific word or
phrase within the section.}
@compat[] Wraps the @tech{decode}d
@scheme[pre-content] as an element with style @scheme[style-name].}
@defproc[(index* [words (listof string?)]
[word-contents (listof list?)]
[pre-content any/c] ...)
index-element?]{
Like @scheme[index], except that @scheme[words] must be a list, and
the list of contents render in the index (in parallel to
@scheme[words]) is supplied as @scheme[word-contents].
}
@defproc[(as-index [pre-content any/c] ...)
index-element?]{
@defproc[(itemize [itm (or/c whitespace? an-item?)] ...
[#:style style (or/c style? string? symbol? #f) #f])
itemization?]{
Like @scheme[index], but the word to index is determined by applying
@scheme[content->string] on the @tech{decode}d @scheme[pre-content].}
@defproc[(section-index [word string?] ...)
part-index-decl?]{
Creates a @scheme[part-index-decl] to be associated with the enclosing
section by @scheme[decode]. The @scheme[word]s serve as both the keys
and as the rendered forms of the keys within the index.}
@defproc[(index-section [#:tag tag (or/c false/c string?) "doc-index"])
part?]{
Produces a part that shows the index the enclosing document. The
optional @scheme[tag] argument is used as the index section's tag.}
@; ------------------------------------------------------------------------
@section{Tables of Contents}
@defproc[(table-of-contents) delayed-block?]{
Returns a delayed flow element that expands to a table of contents for
the enclosing section. For LaTeX output, however, the table of
contents currently spans the entire enclosing document.}
@defproc[(local-table-of-contents [#:style style any/c #f])
delayed-block?]{
Returns a delayed flow element that may expand to a table of contents
for the enclosing section, depending on the output type. For
multi-page HTML output, the flow element is a table of contents; for
Latex output, the flow element is empty.
The meaning of the @scheme[style] argument depends on the output type,
but @scheme['immediate-only] normally creates a table of contents that
contains only immediate sub-sections of the enclosing section. See
also the @scheme['quiet] style of @scheme[part], which normally
suppresses sub-part entries in the table of contents.}
@compat[] Like @scheme[itemlist], but whitespace strings among the
@scheme[itm]s are ignored.}

6
collects/scribblings/scribble/compat.scrbl Normal file
View File

@ -0,0 +1,6 @@
#lang scribble/manual
@title{Compatibility Libraries}
@include-section["struct.scrbl"]
@include-section["basic.scrbl"]

192
collects/scribblings/scribble/config.scrbl
View File

@ -1,12 +1,12 @@
#lang scribble/doc
@(require scribble/manual
scribble/struct
scribble/core
scribble/decode
scribble/html-variants
scribble/latex-variants
"utils.ss"
(for-label scheme/base))
@(define (nested . str)
(make-blockquote #f (flow-paragraphs (decode-flow str))))
@(define (fake-title . str) (apply bold str))
@title[#:tag "config"]{Extending and Configuring Scribble Output}
@ -18,66 +18,87 @@ extend or configure Scribble fall into two groups:
@itemize[
@item{You may need to drop into the back-end ``language'' of CSS or
Tex to create a specific output effect. For this kind of
extension, you will mostly likely attach a @scheme[`(css
,_file)] or @scheme[`(tex ,_file)] style to a @scheme[section]
and then use a string defined in the @scheme[_file] as an
@scheme[element] or @tech{block} style. This kind of extension
is described in @secref["extra-style"].}
Latex to create a specific output effect. For this kind of
extension, you will mostly likely attach a
@scheme[css-addition] or @scheme[tex-addition] @tech{variant}
to style, where the addition implements the style name. This
kind of extension is described in @secref["extra-style"].}
@item{You may need to produce a document whose page layout is
different from the PLT Scheme documentation style. For that
kind of configuration, you will most likely run the
@exec{scribble} command-line tool and supply flags like
@DFlag{prefix} or @DPFlag{style}. This kind of configuration
is described in @secref["config-style"].}
kind of configuration, you can run the @exec{scribble} command-line
tool and supply flags like @DFlag{prefix} or @DPFlag{style}, or
you can associate a @scheme[html-defaults] or
@scheme[latex-defaults] @tech{variant} to the main document's
style. This kind of configuration is described in
@secref["config-style"].}
]
@; ------------------------------------------------------------
@section[#:tag "extra-style"
#:style `((css "inbox.css") (tex "inbox.tex"))]{Adding a Style}
#:style (make-style #f (list (make-css-addition "inbox.css")
(make-tex-addition "inbox.tex")))
]{Implementing Styles}
When a string is uses as a style in an @scheme[element],
@scheme[styled-paragraph], @scheme[table],
@scheme[styled-itemization], @scheme[blockquote], or @scheme[compound-paragraph], it corresponds to
a CSS class for HTML output or a Tex macro/environment for Latex
output. In Latex output, the string is used as a command name for a
@scheme[styled-paragraph] and an environment name for a
@scheme[table], @scheme[itemization], @scheme[blockquote], or @scheme[compound-paragraph], except
that a @scheme[blockquote] or @scheme[compound-paragraph] style name that starts with @litchar{\} is
used (sans @litchar{\}) as a command instead of an environment.
In addition, for an itemization, the style string is
suffixed with @scheme["Item"] and used as a CSS class or Tex macro
name to use for the itemization's items (in place of @tt{item} in the
case of Latex).
Scribble includes a number of predefined styles that are used by the
exports of @scheme[scribble/manual], but they are not generally
intended for direct use. For now, use them or redefine them at your
own risk.
When a string is uses as a style in an @scheme[element],
a @scheme[multiarg-element], @scheme[paragraph], @scheme[table],
@scheme[itemization], @scheme[nested-flow], or
@scheme[compound-paragraph], it corresponds to a CSS class for HTML
output or a Latex macro/environment for Latex output. In Latex output,
the string is used as a command name for a @scheme[paragraph]
and an environment name for a @scheme[table], @scheme[itemization],
@scheme[nested-flow], or @scheme[compound-paragraph]; the if style has
a @scheme['commad] @tech{variant} for a @scheme[nested-flow] or
@scheme[compound-paragraph], then the style name is used as a command
instead of an environment. In addition, for an itemization, the style
string is suffixed with @scheme["Item"] and used as a CSS class or Latex
macro name to use for the itemization's items (in place of @tt{item}
in the case of Latex).
To add a mapping from your own style name to a CSS configuration, add
a @scheme[`(css ,_file)] style (in a list of styles) to an enclosing
@scheme[part]. To map a style name to a Tex macro (or Latex
environment), add a @scheme[`(tex ,_file)] style to an enclosing part.
a @scheme[css-addition] structure instance to a style's @tech{variant}
list. To map a style name to a Latex macro or environment, add a
scheme[tex-addition] structure instance. A @scheme[css-addition] or
@scheme[tex-addition] is normally associated with the style whose name
is implemented by the adition, but it can also be added to the style
for an enclosing part.
Scribble includes a number of predefined styles that are used by the
exports of @scheme[scribble/base]. You can use them or redefine
them. The styles are specified by @filepath{scribble.css} and
@filepath{scribble.tex} in the @filepath{scribble} collection.
The styles used by @schememodname[scribble/manual] are implemented by
@filepath{scheme.css} and @filepath{scheme.tex} in the
@filepath{scribble} collection. Other libraries, such as
@schememodname[scriblib/autobib], similarly implement styles through files
that are associated by @scheme[css-addition] and @scheme[tex-addition]
@tech{variants}.
To avoid collisions with future additions to Scribble, start your
style name with an uppercase letter that is not @litchar{S}. An
uppercase letter helps to avoid collisions with macros defined by
Latex packages, and future styles needed by @scheme[scribble/manual]
will start with @litchar{S}.
Latex packages, and future styles needed by @schememodname[scribble/base] and
@schememodname[scribble/manual] will start with @litchar{S}.
For example, a Scribble document
@verbatim[#:indent 2]|{
#lang scribble/doc
@(require manual)
#lang scribble/manual
@(require scribble/core
scribble/html-variants
scribble/latex-variants)
@title[#:style `((css "inbox.css") (tex "inbox.tex"))]{Quantum Pet}
(define inbox-style
(make-style "InBox"
(list (make-css-addition "inbox.css")
(make-tex-addition "inbox.tex"))))
Do not open: @elem[#:style "InBox"]{Cat}
@title{Quantum Pet}
Do not open: @elem[#:style inbox-style]{Cat}
}|
combined with an @filepath{inbox.css} that contains
@ -97,7 +118,7 @@ and an @filepath{inbox.tex} that contains
generates
@nested{
@nested[#:style 'inset]{
@fake-title{Quantum Pet}
Do not open: @elem[#:style "InBox"]{Cat}
@ -107,38 +128,87 @@ generates
@section[#:tag "config-style"]{Configuring Output}
Scribble's output is configured in two layers:
The implementation of styles used by libraries depends to some degree
on separately configurable parameters, and configuration is also
possible by replacing style implementations. Latex output is more
configurable in the former way, since a document class determines a
set of page-layout and font properties that are used by other
commands. The style-replacement kind of configuration corresponds to
re-defining Latex macros or overriding CSS class attributes. When
@exec{setup-plt} builds PDF documentation, it uses both kinds of
configuration to produce a standard layout for PLT Scheme manuals;
that is, it selects a particular page layout, and it replaces some
@schememodname[scheme/base] styles.
Two kinds of files implement the two kinds of configuration:
@itemize[
@item{A prefix determines the @tt{DOCTYPE} line for HTML output or
the @tt{documentclass} configuration (and perhaps some addition
package uses or other configuration) for Latex output. The
default prefix is @filepath{scribble-prefix.html} or
@filepath{scribble-prefix.tex} in the @filepath{scribble}
@item{A @deftech{prefix file} determines the @tt{DOCTYPE} line for
HTML output or the @tt{documentclass} configuration (and
perhaps some addition package uses or other configurations) for
Latex output.
The default prefix files are @filepath{scribble-prefix.html}
and @filepath{scribble-prefix.tex} in the @filepath{scribble}
collection.}
@item{Style definitions for all of the ``built-in'' styles used by
@scheme[scribble/manual] (as described in
@secref["extra-style"]). The default style definitions are
@filepath{scribble.css} or @filepath{scribble.tex} in the
@filepath{scribble} collection.}
@item{A @deftech{style file} refines the implementation of styles
nused in the document---typically just the ``built-in'' styles
used by @schememodname[scribble/base].
The default style files, @filepath{scribble-style.css} and
@filepath{scribble-style.tex} in the @filepath{scribble}
collection, change no style implementations.}
]
When using the @exec{scribble} command-line utility:
For a given configuration of output, typically a particular prefix
file works with a particular style file. Some prefix or style files
may be more reusable. For now, reading the default files is the best
way to understand how they interact. A prefix and/or style file may
also require extra accomanying files; for example, a prefix file for
Latex mode may require a corresponding Latex class file. The default
prefix and style files require no extra files.
When rendering a document through the @exec{scribble} command-line
tool, use flags to select a prefix file, style file, and additional
accompanying files:
@itemize[
@item{Replace the prefix using the @as-index{@DFlag{prefix}} flag.}
@item{Select the prefix file using the @as-index{@DFlag{prefix}}
flag. (Selecting the prefix file also cancels the default list
of accompanying files, if any.)}
@item{Replace the style definitions using the
@as-index{@DFlag{style}} flag.}
@item{Replace the style file using the @as-index{@DFlag{style}}
flag. Add additional style definitions and re-definitions using
the @as-index{@DPFlag{style}} flag.}
@item{Add style definitions (that can override earlier ones)
using the @as-index{@DPFlag{style}} flag.}
@item{Add additional accompanying files with @as-index{@DFlag{extra}}.}
]
For now, reading the default files is the best way to understand how
they interact.
When using the @exec{scribble} command-line utility, a document can
declare its default style, prefix, and extra files through a
@scheme[html-defaults] and/or @scheme[latex-defaults] style
@tech{variant}. In particular, when using the @exec{scribble}
command-line tool to generate Latex or PDF a document whose main part
is implemented with @scheme[#, @hash-lang[] #,
@schememodname[scribble/manual]], the result has the standard PLT
Scheme manual configuration, because @schememodname[scribble/manual]
associates a @scheme[latex-defaults] @tech{variant} with the exported
document. The @schememodname[scribble/sigplan] language similarly
associates a default configuration with an exported document. As
libraries imported with @scheme[require], however,
@schememodname[scribble/manual] and @schememodname[scribble/sigplan]
simply implement new styles in a composable way.
Whether or not a document has a default prefix- and style-file
configuration through a style @tech{variant}, the defaults can be
overridden using @exec{scribble} command-line flags. Furthermore,
languages like @schememodname[scribble/manual] and
@schememodname[scribble/sigplan] add a @scheme[html-defaults] and/or
@scheme[latex-defaults] @tech{variant} to a main-document part only if
it does not already have such a variant added through the
@scheme[#:style] argument of @scheme[title].

1153
collects/scribblings/scribble/core.scrbl Normal file
View File

File diff suppressed because it is too large Load Diff

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

@ -14,7 +14,7 @@ At the @tech{flow} level, decoding recognizes a blank line as a
@tech{paragraph} separator. Blocks and paragraphs without blank lines
in between are collected into a @tech{compound paragraph}.
At the @tech{paragraph}-content level, decoding makes just a few
At the @tech{content} level, decoding makes just a few
special text conversions:
@itemize[
@ -44,6 +44,29 @@ that in
the @litchar{``apple''} argument is decoded to use fancy quotes, and
then it is bolded.
@defproc[(pre-flow? [v any/c]) boolean?]{
Returns @scheme[#t] if @scheme[v] is a @deftech{pre-flow} value: a
string or other non-list @scheme[content], a @scheme[block?], or a
@scheme[splice] containing a list of @tech{pre-flow} values; otherwise
returns @scheme[#f].
Pre-flow is decoded into a @tech{flow} (i.e., a list of @tech{blocks})
by functions like @scheme[decode] and @scheme[decode-flow].}
@defproc[(pre-content? [v any/c]) boolean?]{
Returns @scheme[#t] if @scheme[v] is a @deftech{pre-content} value: a
string or other non-list @scheme[content], or a @scheme[splice]
containing a list of @tech{pre-content} values; otherwise returns
@scheme[#f].
Pre-content is decoded into @tech{content} by functions like
@scheme[decode-content] and @scheme[decode-paragraph].}
@defproc[(decode [lst list?]) part?]{
Decodes a document, producing a part. In @scheme[lst], instances of
@ -74,7 +97,7 @@ parsing.
}
@defproc[(decode-flow [lst list?]) flow?]{
@defproc[(decode-flow [lst (listof pre-flow?)]) flow?]{
Decodes a flow. A sequence of two or more newlines separated only by
whitespace counts is parsed as a paragraph separator. In @scheme[lst],
@ -84,7 +107,7 @@ the enclosing flow.
}
@defproc[(decode-compound-paragraph [lst list?]) block?]{
@defproc[(decode-compound-paragraph [lst (listof pre-flow?)]) block?]{
Decodes a compound paragraph. If the compound paragraph contains a
single block, the block is returned without a
@ -92,26 +115,26 @@ single block, the block is returned without a
}
@defproc[(decode-paragraph [lst list?]) paragraph?]{
@defproc[(decode-paragraph [lst (listof pre-content?)]) paragraph?]{
Decodes a paragraph.
}
@defproc[(decode-content [lst list?]) list?]{
@defproc[(decode-content [lst (listof pre-content?)]) list?]{
Decodes a sequence of elements.
Decodes @tech{content}.
}
@defproc[(decode-elements [lst list?]) list?]{
@defproc[(decode-elements [lst (listof pre-content?)]) list?]{
An alias for @scheme[decode-content].
}
@defproc[(decode-string [s string?]) list?]{
@defproc[(decode-string [s string?]) (listof content?)]{
Decodes a single string to produce a list of elements.
Decodes a single string to produce @tech{content}.
}
@ -127,7 +150,7 @@ otherwise.
[tags (listof string?)]
[version (or/c string? false/c)]
[style any/c]
[content list?])]{
[content content?])]{
See @scheme[decode] and @scheme[decode-part]. The @scheme[tag-prefix]
and @scheme[style] fields are propagated to the resulting
@ -139,7 +162,7 @@ and @scheme[style] fields are propagated to the resulting
[tag-prefix (or/c false/c string?)]
[tags (listof string?)]
[style any/c]
[title list?])]{
[title content?])]{
Like @scheme[title-decl], but for a sub-part. See @scheme[decode] and
@scheme[decode-part].

5
collects/scribblings/scribble/doclang.scrbl
View File

@ -1,6 +1,5 @@
#lang scribble/doc
@(require scribble/manual
"utils.ss")
#lang scribble/manual
@(require "utils.ss")
@title[#:tag "doclang"]{Document Language}

7
collects/scribblings/scribble/generic.scrbl Normal file
View File

@ -0,0 +1,7 @@
#lang scribble/manual
@(require "utils.ss")
@title[#:tag "generic-prose"]{General Documents}
@include-section["base.scrbl"]
@include-section["other.scrbl"]

13
collects/scribblings/scribble/getting-started.scrbl Normal file
View File

@ -0,0 +1,13 @@
#lang scribble/manual
@title[#:tag "getting-started" #:style 'toc]{Getting Started}
No matter what you want to do with Scribble, it's best to start with
an introduction on producing HTML and PDF documents in
@secref["how-to-paper"]. The end of the chapter, @secref["roadmap"],
offers advice on where to go afterward depending on your goals.
@local-table-of-contents[]
@include-section["how-to-paper.scrbl"]
@include-section["how-to.scrbl"]

622
collects/scribblings/scribble/how-to-paper.scrbl Normal file
View File

@ -0,0 +1,622 @@
#lang scribble/doc
@(require scribble/manual
scribble/bnf
"utils.ss")
@(define (sample . text) (nested #:style 'inset (apply verbatim text)))
@(define (result . text) (apply nested #:style 'inset text))
@title[#:tag "how-to-paper"]{How to Scribble Documents}
This chapter demonstrates the basics of generating stand-alone HTML
and PDF (through Latex) documents with Scribble.
@section[#:tag "first-example"]{A First Example}
Create a file @filepath{mouse.scrbl} with this content:
@sample|{
#lang scribble/base
@title{On the Cookie-Eating Habits of Mice}
If you give a mouse a cookie, he's going to ask for a
glass of milk.
}|
The first line's @scheme[#, @hash-lang[] #,
@schememodname[scribble/base]] indicates that the file implements a
Scribble document. The document starts in ``text mode,'' and the
@litchar["@"] character escapes to operators like @scheme[title],
where the curly braces return to text mode for the arguments to the
operator. The rest is document content.
Now run the @exec{scribble} command-line program, specifying a mode
for the kind of document that you want as output:
@itemize[
@item{Run
@commandline{scribble --pdf mouse.scrbl}
to generate PDF as @filepath{mouse.pdf}. This will
work only if you have @exec{pdflatex} installed.
If you'd like to see the intermediate Latex, try
@commandline{scribble --latex mouse.scrbl}
to generate @filepath{mouse.tex}.}
@item{Run
@commandline{scribble --html mouse.scrbl}
to generate HTML as @filepath{mouse.html}. You may
notice that the apostrophe in ``he's'' turned into a
curly apostrophe.}
@item{Run
@commandline{scribble --htmls mouse.scrbl}
to generate HTML as @filepath{mouse/index.html}.
Sub-sections (which we add next) will appear as separate
HTML files in the @filepath{mouse} directory.}
]
@section{Multiple Sections}
Add more text to @filepath{mouse.scrbl} so that it looks like this:
@sample|{
#lang scribble/base
@title{On the Cookie-Eating Habits of Mice}
If you give a mouse a cookie, he's going to ask for a
glass of milk.
@section{The Consequences of Milk}
That ``squeak'' was the mouse asking for milk. Let's
suppose that you give him some in a big glass.
He's a small mouse. The glass is too big---way too
big. So, he'll probably ask you for a straw. You might as
well give it to him.
@section{Not the Last Straw}
For now, to handle the milk moustache, it's enough to give
him a napkin. But it doesn't end there... oh, no.
}|
Now, after the first paragraph of the paper, we have two
sub-sections, each created by calling @scheme[section] to
generate a sub-section declaration. The first sub-section has
two paragraphs. The second section, as initiated by the result
of the second @scheme[section] call, has a single paragraph.
Run the @exec{scribble} command(s) from @secref["first-example"]
again. You may notice the curly double-quotes in the output; in PDF
output, the @litchar{---} turned into an em-dash. For HTML, it turned
into a en-dash with surrounding spaces, which is a typical convention
for em-dashes in HTML.
@;----------------------------------------
@section{Splitting the Document Source}
As a document grows larger, it's better to split sections into
separate source files. The @scheme[include-section] operation
incorporates a document defined by a @filepath{.scrbl} file into a
larger document.
To split the example document into multiple files, change
@filepath{mouse.scrbl} to just
@sample|{
#lang scribble/base
@title{On the Cookie-Eating Habits of Mice}
If you give a mouse a cookie, he's going to ask for a
glass of milk.
@include-section["milk.scrbl"]
@include-section["straw.scrbl"]
}|
Create @filepath{milk.scrbl} and @filepath{straw.scrbl} in the same
directory as @filepath{mouse.scrbl}. In @filepath{milk.scrbl}, put
@sample|{
#lang scribble/base
@title{The Consequences of Milk}
That ``squeak'' was the mouse asking for milk...
}|
and in @filepath{straw.scbl}, put
@sample|{
#lang scribble/base
@title{Not the Last Straw}
For now, to handle the milk moustache, ...
}|
Notice that the new files both start with @hash-lang[], like the
original document, and the @scheme[section]s from the original
document become @scheme[title]s in the new documents. Both
@filepath{milk.scrbl} and @filepath{straw.scrbl} are documents in
their own right with their own titles, and they can be individually
rendered using @exec{scribble}. Running @exec{scribble} on
@filepath{mouse.scrbl}, meanwhile, incorporates the smaller documents
into one document that is the same as before.
@; ----------------------------------------
@section{Document Styles}
Scribble currently supports only one from of HTML output. You can
replace the @filepath{scribble.css} file for the generated pages, and
that's about it. (We expect to add more styles in the future.)
For Latex-based PDF output, Scribble includes support for
multiple page-layout configurations. The @filepath{mouse.scrbl}
example so far uses the default Latex style. If you plan on submitting
the paper to a workshop on programming languages, then---well, you
probably need a different topic. But you can start making the current
content look right by changing the first line to
@sample|{
#lang scribble/sigplan
}|
If you're instead working toward PLT Scheme library documentation,
try changing the first line to
@sample|{
#lang scribble/manual
}|
which produces output with a separate title page, initial content on
that page (intended as a brief orientation to the document), and
top-level sections turned into chapters that each start on a new page.
If you have split the document into multiple files, the first line of
the main document file determines the output format.
Using @schememodname[scribble/sigplan] or
@schememodname[scribble/manual] does not change the rendered HTML for
a document---aside from @schememodname[scribble/manual] adding a
version number---but it changes the set of bindings available in the
document body. For example, with @schememodname[scribble/sigplan], the
introductory text can be marked as an abstract:
@sample|{
#lang scribble/sigplan
@title{On the Cookie-Eating Habits of Mice}
@abstract{If you give a mouse a cookie, he's going to
ask for a glass of milk.}
@section{The Consequences of Milk}
....}|
When rendered as HTML, the abstract shows up as an inset paragraph. If
you try to use @scheme[abstract] with the
@schememodname[scribble/base] or @schememodname[scribble/manual]
language, then you get an error, because @scheme[abstract] is not
defined.
When a document is implemented across multiple files, changing the
language of the man document can set the style for all of the parts,
but it does not introduce bindings into the other part files. For
example, if you change the language of @filepath{mouse.scrbl} to
@schememodname[scribble/sigplan], then @scheme[abstract] becomes
available in @filepath{mouse.scrbl} but not in @filepath{milk.scrbl}
or @filepath{straw.scrbl}. In other words, operator names are
lexically scoped.
@; ----------------------------------------
@section{More Functions}
The @schememodname[scribble/sigplan] and
@schememodname[scribble/manual] languages are supersets of the
@schememodname[scribble/base] language, which provides a collection of
basic operations. Many of the operations are style variations that you
can apply to text:
@sample|{
He's a @smaller{small mouse}. The glass is too
@larger{big}---@bold{way @larger{too @larger{big}}}. So, he'll
@italic{probably} ask you for a straw.
}|
which renders as
@result{
He's a @smaller{small mouse}. The glass is too
@larger{big}---@bold{way @larger{too @larger{big}}}. So, he'll
@italic{probably} ask you for a straw.
}
As you would expect, calls to functions like @scheme[smaller],
@scheme[larger], and @scheme[bold] can be nested in other calls. They
can also be nested within calls to @scheme[title] or @scheme[section]:
@sample|{
@section{@italic{Not} the Last Straw}
}|
The @scheme[centered] operation centers a flow of text:
@sample|{
If a mouse eats all your cookies, put up a sign that says
@centerline{
@bold{Cookies Wanted}
@italic{Chocolate chip preferred!}
}
and see if anyone brings you more.
}|
which renders as
@result{
If a mouse eats all your cookies, put up a sign that says
@centerline{
@bold{Cookies Wanted}
@italic{Chocolate chip preferred!}
}
and see if anyone brings you more.
}
The @scheme[margin-note] operation is used in a similar way, but the
rendered text is moved to the margins.
@margin-note{If you use @scheme[margin-note], then the content shows
up over here.}
The @scheme[itemlist] operation creates a sequence of bulleted text,
where the @scheme[item] operation groups text to appear in a single
bullet. The @scheme[itemlist] operation is different from the others
that we have seen before, because it only accepts values produced by
@scheme[item] instead of arbitrary text. This difference is reflected
in the use of @litchar{[}...@litchar{]} for the arguments to
@scheme[itemlist] instead of @litchar["{"]...@litchar["}"]:
@sample|{
@centered{@bold{Notice to Mice}}
@itemlist[@item{We have cookies for you.}
@item{If you want to eat a cookie,
you must bring your own straw.}]
}|
which renders as
@result{
@centered{@bold{Notice to Mice}}
@itemlist[@item{We have cookies for you.}
@item{If you want to eat a cookie,
you must bring your own straw.}]
}
@; ----------------------------------------
@section{Text Mode vs. Scheme Mode for Arguments}
When @litchar{[}...@litchar{]} sounds the arguments of an
operation, the argument expressions are in Scheme mode rather than
text mode. Even in Scheme mode, @litchar["@"] can be used to apply
operations; once the @"@" syntax is enabled through a
language like @schememodname[scribble/base] (as opposed to
@schememodname[scheme]), it behaves the same in both Scheme mode and
text mode.
One advantage of using Scheme mode for the arguments to
@scheme[itemlist] is that we can pass a keyword-tagged optional
argument to @scheme[itemlist]. In particular, if you want a list with
numbers instead of bullets, supply the @scheme['ordered] style to
@scheme[itemlist] using the @scheme[#:style] keyword:
@sample|{
@itemlist[#:style 'ordered
@item{Eat cookie.}
@item{Drink milk.}
@item{Wipe mouth.}
@item{...}]
}|
An operation doesn't care whether it's used with
@litchar{[}...@litchar{]} or @litchar["{"]...@litchar["}"]. Roughly,
@litchar["{"]...@litchar["}"] forms an argument that is a
string. (Only roughly, though. Newlines or uses of @litchar["@"]
within @litchar["{"]...@litchar["}"] complicate the picture, and we'll
get back to that soon.) So,
@sample|{
@italic{Yummy!}
}|
is equivalent to
@sample|{
@italic["Yummy!"]
}|
which is equivalent to the Scheme expression
@schemeblock[
(italic "Yummy!")
]
These equivalences explain why Scribble functions are documented in
Scheme notation. If you're reading this in HTML format, you can click
@scheme[italic] above to access its documentation. The documentation
won't completely make sense, yet, because it will be the end of this
chapter.
What if you want to provide arguments in text mode, but you also want
to supply other optional arguments? You can use both
@litchar{[}...@litchar{]} and @litchar["{"]...@litchar["}"] for an
operation, as long as the @litchar{[}...@litchar{]} is first, and as
long as no character separate the closing @litchar{]} from the
opening @litchar["{"]. For example, calling @scheme[italic] is the
same as using @scheme[elem] with the @scheme['italic] style:
@sample|{
@elem[#:style 'italic]{Yummy!}
}|
You can also @emph{omit} both @litchar{[}...@litchar{]} and
@litchar["{"]...@litchar["}"]. In that case, the Scheme expression
after @litchar["@"] is used directly instead of applied as an
operation. For example,
@sample|{
1 plus 2 is @(number->string (+ 1 2)).
}|
renders as
@result{
1 plus 2 is @(number->string (+ 1 2)).
}
The call to @scheme[number->string] is needed because a naked number
is not valid as document content.
@; ----------------------------------------
@section[#:tag "how-to:reader"]{The @"@" Syntax}
The @"@" notation provided by Scribble is just another way of
writing Scheme expressions. Scribble documents could be constructed
using normal Scheme notation, without using @"@" at all, but
that would be inconvenient for most purposes. The @"@"
notation makes dealing with textual content much easier.
Whether in text mode or Scheme mode, @litchar["@"] in a document
provides an escape to Scheme mode. The basic syntax of @litchar["@"] is
@schemeblock[
@#,BNF-seq[@litchar["@"]
@nonterm{cmd}
@litchar{[} @kleenestar{@nonterm{datum}} @litchar{]}
@litchar["{"] @nonterm{text-body} @litchar["}"]]
]
where all three parts after @litchar["@"] are optional, but at least
one must be present. No spaces are allowed between
@itemize[
@item{@litchar["@"] and @nonterm{cmd}, @litchar{[}, or @litchar["{"]}
@item{@nonterm{cmd} and @litchar{[} or @litchar["{"]; or}
@item{@litchar{]} and @litchar["{"].}
]
A @nonterm{cmd} or @nonterm{datum} is normal Scheme notation, while a
@nonterm{text-body} is itself in text mode. A @nonterm{cmd} obviously
must not start with @litchar{[} or @litchar["{"], even though Scheme
forms could otherwise start with those characters.
The expansion of just @litchar["@"]@nonterm{cmd} into Scheme code is
@schemeblock[
@#,nonterm{cmd}
]
When either @litchar{[} @litchar{]} or @litchar["{"] @litchar["}"]
are used, the expansion is
@schemeblock[
(@#,nonterm{cmd} @#,kleenestar{@nonterm{datum}} @#,kleenestar{@nonterm{parsed-body}})
]
where @kleenestar{@nonterm{parsed-body}} is the parse result of the
@nonterm{text-body}. The @kleenestar{@nonterm{parsed-body}} part often
turns out to be a sequence of Scheme strings.
In practice, the @nonterm{cmd} is normally a Scheme identifier that is
bound to a procedure or syntactic form. If the procedure or form
expects further text to typeset, then @litchar["{"]...@litchar["}"]
supplies the text. If the form expects other data, typically
@litchar{[}...@litchar{]} is used to surround Scheme arguments,
instead. Even if an operation's argument is a string, if the string is
not used as content text (but instead used as, say, a hyperlink
label), then the string is typically provided through
@litchar{[}...@litchar{]} instead of @litchar["{"]...@litchar["}"].
Sometimes, both @litchar{[}...@litchar{]} and
@litchar["{"]...@litchar["}"] are used, where the former surround
Scheme arguments that precede text to typeset. Finally, if a form is a
purely Scheme-level form with not typeset result, such as a
@scheme[require] to import more operations, then typically just
@litchar["@"] is used.
For example the text-mode stream
@sample|{
@(require scriblib/figure)
@section[#:tag "poetry"]{Of Mice and Cookies}
See @secref["milk"].
@section[#:tag "milk"]{@italic{Important} Things About Milk}
@figure["straw" @elem{A straw}]{@image["straw.png"]}
}|
is equivalent to the Scheme-mode sequence
@schemeblock[
(require scriblib/figure) "\n"
"\n"
(section #:tag "poetry" "Of Mice and Cookies") "\n"
"See " (secref "milk") "." "\n"
"\n"
(section #:tag "milk" (italic "Important") " Things About Milk") "\n"
(figure "straw" (elem "A straw") (image "straw.png")) "\n"
]
Besides showing how different argument conventions are used for
different operations, the above example illustrates how whitespace is
preserved in the Scheme form of a text-mode stream---including
newlines preserved as their own strings. Notice how the second
@scheme[section] gets two arguments for its content, since the
argument content for @scheme[section] in the source stream includes
both the use of an operator and additional text. When an operation
like @scheme[section] or @scheme[italic] accepts content to typeset,
it normally accepts an arbitrary number of arguments that together
form the content.
For more information on the syntax of @litchar["@"], see
@secref["reader"]. The full syntax includes a few more details, such
as brackets like @litchar["|{"]...@litchar["}|"] for text-mode
arguments while disabling @litchar["@"] between the brackets.
@; ----------------------------------------
@section{Decoding Sequences}
In a document that starts @scheme[#, @hash-lang[] #,
@schememodname[scribble/base]], the top level is a text-mode stream,
just like the @nonterm{text-body} in a @litchar["@"] form. As
illustrated in the previous section, such a top-level sequence
corresponds to a mixture of Scheme-mode strings and operation
applications. There's an implicit operation, @scheme[decode], that
wraps the whole document to consume this mixture of strings and other
values and turn them into a document description.
The @scheme[decode] operation implements @defterm{flow decoding},
which takes a document stream and breaks it up into sections and
paragraphs. Blank lines delimit paragraphs, and the results of
operations like @scheme[title] and @scheme[section] generate ``here's
the title'' or ``a new section starts here'' declarations that are
recognized by @scheme[decode].
A different but related @defterm{content decoding} takes place within
a paragraph or section title. Content decoding is responsible for
converting @litchar{---} to an em-dash or for converting @litchar{"}
and @litchar{'} to suitable curly quotes.
The decoding process for document's stream is ultimately determined by
the @hash-lang[] line that starts the document. The @schememodname[scribble/base],
@schememodname[scribble/manual], and @schememodname[scribble/sigplan]
languages all use the same @scheme[decode] operation. The
@schememodname[scribble/text] language, however, acts more like a
plain-text preprocessor and it does not perform any such decoding
rules. (For more on @schememodname[scribble/text], see
@secref["preprocessor"].)
@margin-note{More precisely, languages like
@schememodname[scribble/base] apply @scheme[decode] only after
lifting out all definitions and imports from the document
stream.}
When the flow decoder is used, after it breaks the input stream into
paragraphs, it applies content decoding to strings within the
paragraph. When content is wrapped with an operation, however, content
decoding does not apply automatically. An operation is responsible for
calling a content or flow decoder as it sees fit. Most operations call
the decoder; for example, @scheme[italic], @scheme[bold],
@scheme[smaller], etc., all decode their arguments. Similarly,
@scheme[title] and @scheme[section] decode the given content for the
title or section name. The @scheme[literal] and @scheme[verbatim]
operators, however, do not decode the given strings. For example,
@sample|{
@verbatim{---}
}|
renders as
@result{
@verbatim{---}
}
Don't confuse decoding with the expansion of @"@"
notation. The source form
@sample|{
@verbatim{@(number->string (+ 1 2))}
}|
renders as
@result{
@verbatim{@(number->string (+ 1 2))}
}
because the source is equivalent to
@sample|{
(verbatim (number->string (+ 1 2)))
}|
where @scheme[(number->string (+ 1 2))] is evaluated to produce the
argument to @scheme[verbatim]. The @litchar["|{"]...@litchar["}|"]
style of brackets is often used with @scheme[verbatim], because
@litchar["|{"]...@litchar["}|"] disables @"@" notation for
arguments. For example,
@sample|{
@verbatim|{@(number->string (+ 1 2))}|
}|
renders as
@result{
@verbatim|{@(number->string (+ 1 2))}|
}
@; ----------------------------------------
@section[#:tag "roadmap"]{The Big Picture and Next Steps}
Although it may not look like it, @filepath{mouse.scrbl} is a Scheme
program. You could run it directly in DrScheme or with MzScheme, the
latter like this:
@commandline{mzscheme mouse.scrbl}
If you do that though, nothing much seems to happen. As a program
module, @filepath{mouse.scrbl} builds a document description and
exports it as @scheme[doc], but exporting a binding is not a visible
operation. The @exec{scribble} tool runs @filepath{mouse.scrbl} to get
the exported description, and then it uses the description to generate
an output document.
Despite a suspicious lack of parentheses compared to most Scheme
programs, and despite the fact that running @filepath{mouse.scrbl} by
itself has no apparent effect, it's important to understand that
@filepath{mouse.scrbl} is a Scheme program. @emph{Data is code.}
Scribble tools vary in the kinds of documents they transform and
generate, but all share the twin principles of @"@" notation
for convenience and data-as-code for expressiveness.
If your immediate goal is to document a PLT Scheme library or write
literate programs, continue with @secref["how-to-doc"]. If you are more
interested in producing documents unrelated to PLT Scheme, move on to
the main documentation at @secref["generic-prose"], and then read
@secref["internals"] when you need more power. If you are interested
in text preprocessing, go instead to @secref["preprocessor"].

209
collects/scribblings/scribble/how-to.scrbl
View File

@ -3,20 +3,19 @@
scribble/bnf
"utils.ss")
@title{How to Scribble Documentation}
@title[#:tag "how-to-doc"]{How to Scribble PLT Scheme Documentation}
Although the @exec{scribble} command-line utility generates output
from a Scribble document (run @exec{scribble -h} for more
information), documentation of PLT Scheme libraries is normally built
by @exec{setup-plt}. This chapter emphasizes the @exec{setup-plt}
approach, which more automatically supports links across
documents.
from a Scribble document, documentation of PLT Scheme libraries is
normally built by @exec{setup-plt}. This chapter emphasizes the
@exec{setup-plt} approach, which more automatically supports links
across documents.
@margin-note{See @secref["config"] for information on using the
@margin-note{See @secref["how-to-paper"] for information on using the
@exec{scribble} command-line utility.}
@;----------------------------------------
@section[#:tag "getting-started"]{Getting Started}
@section[#:tag "setting-up"]{Setting Up Documentation}
To document a collection or @|PLaneT| package:
@ -30,20 +29,17 @@ To document a collection or @|PLaneT| package:
@item{Start @filepath{manual.scrbl} like this:
@verbatim[#:indent 2]|{
#lang scribble/doc
@(require scribble/manual)
#lang scribble/manual
@title{My Library}
Welcome to my documentation: @scheme[(list 'testing 1 2 3)].
}|
The first line starts the file in ``text'' mode, and
introduces the @litchar["@"] syntax to use Scheme bindings.
The second line introduces bindings like @scheme[title] and
@scheme[scheme] for writing PLT Scheme documentation. The
@scheme[title] call (using @litchar["@"]) produces a title
declaration in the text stream.}
The first line starts the file in ``text'' mode and selects
the PLT Scheme manual output format.
It also introduces bindings like @scheme[title] and
@scheme[scheme] for writing PLT Scheme documentation.}
@item{Add the following entry to your collect or package's
@filepath{info.ss}:
@ -82,105 +78,19 @@ To document a collection or @|PLaneT| package:
]
@; ----------------------------------------
@section[#:tag "how-to:reader"]{Document Syntax}
Whether in ``text'' mode or Scheme mode, @litchar["@"] in a document
provides an escape to Scheme mode. The syntax of @litchar["@"] is
@schemeblock[
@#,BNF-seq[@litchar["@"]
@nonterm{cmd}
@litchar{[} @kleenestar{@nonterm{datum}} @litchar{]}
@litchar["{"] @nonterm{text-body} @litchar["}"]]
]
where all three parts after @litchar["@"] are optional, but at least
one must be present. No spaces are allowed between
@itemize[
@item{@litchar["@"] and @nonterm{cmd}, @litchar{[}, or @litchar["{"]}
@item{@nonterm{cmd} and @litchar{[} or @litchar["{"]; or}
@item{@litchar{]} and @litchar["{"].}
]
A @nonterm{cmd} or @nonterm{datum} is a Scheme datum, while a
@nonterm{text-body} is itself in text mode.
The expansion of @litchar["@"]@nonterm{cmd} into Scheme code is
@schemeblock[
@#,nonterm{cmd}
]
When either @litchar{[} @litchar{]} or @litchar["{"] @litchar["}"]
are used, the expansion is
@schemeblock[
(@#,nonterm{cmd} @#,kleenestar{@nonterm{datum}} @#,kleenestar{@nonterm{parsed-body}})
]
where @kleenestar{@nonterm{parsed-body}} is the parse result of the
@nonterm{text-body}. The @kleenestar{@nonterm{parsed-body}} part often
turns out to be a sequence of Scheme strings.
In practice, the @nonterm{cmd} is normally a Scheme identifier that is
bound to a procedure or syntactic form. If the procedure or form
expects further text to typeset, then @litchar["{"] @litchar["}"]
supplies the text. If the form expects other data, typically
@litchar{[} @litchar{]} is used to surround Scheme arguments,
instead. Sometimes, both @litchar{[} @litchar{]} and @litchar["{"]
@litchar["}"] are used, where the former surround Scheme arguments
that precede text to typeset.
Thus,
@verbatim[#:indent 2]|{
@(require scribble/manual)
@title{My Library}
@scheme[(list 'testing 1 2 3)]
@section[#:tag "here"]{You Are Here}
}|
means
@schemeblock[
(require scribble/manual)
(title "My Library")
(scheme (list 'testing 1 2 3))
(section #:tag "here" "You Are Here")
]
For more information on the syntax of @litchar["@"], see
@secref["reader"].
In a document that starts @hash-lang[] @schememodname[scribble/doc],
the top level is a text-mode sequence, as the @nonterm{text-body} in a
@litchar["@"] form. The parsed sequence is further
decoded to turn it into a hierarchy of sections and paragraphs. For
example, a linear sequence of @scheme[section] declarations with
interleaved text is turned into a list of @scheme[part] instances with
all text assigned to a particular part. See @secref["layers"] for more
information on these layers.
@; ----------------------------------------
@section[#:tag "scheme-hyperlinks"]{Scheme Typesetting and Hyperlinks}
In the document source at the start of this chapter
(@secref["getting-started"]), the Scheme expression
(@secref["setting-up"]), the Scheme expression
@scheme[(#,(schemeidfont "list") 'testing 1 2 3)] is typeset properly,
but the @schemeidfont{list} identifier is not hyperlinked to the usual
definition. To cause @schemeidfont{list} to be hyperlinked, extend the
definition. To cause @schemeidfont{list} to be hyperlinked, add a
@scheme[require] form like this:
@schemeblock[
(require scribble/manual
(for-label #,(schememodname scheme)))
]
@verbatim[#:indent 2]|{
@(require (for-label scheme))
}|
This @scheme[require] with @scheme[for-label] declaration introduces a
document-time binding for each export of the @schememodname[scheme]
@ -197,9 +107,8 @@ document. Such links require no information about where and how a
binding is documented elsewhere:
@verbatim[#:indent 2]|{
#lang scribble/doc
@(require scribble/manual
(for-label scheme))
#lang scribble/manual
@(require (for-label scheme))
@title{My Library}
@ -212,9 +121,8 @@ so it ignores the source formatting of the expression. The
and it preserves the expression's formatting from the document source.
@verbatim[#:indent 2]|{
#lang scribble/doc
@(require scribble/manual
(for-label scheme))
#lang scribble/manual
@(require (for-label scheme))
@title{My Library}
@ -242,9 +150,8 @@ hyperlink with text other than the section title.
The following example illustrates section hyperlinks:
@verbatim[#:indent 2]|{
#lang scribble/doc
@(require scribble/manual
(for-label scheme))
#lang scribble/manual
@(require (for-label scheme))
@title{My Library}
@ -281,9 +188,8 @@ following example links to a section in the PLT Scheme reference
manual:
@verbatim[#:indent 2]|{
#lang scribble/doc
@(require scribble/manual
(for-label scheme))
#lang scribble/manual
@(require (for-label scheme))
@(define ref-src
'(lib "scribblings/reference/reference.scrbl"))
@ -336,9 +242,8 @@ following:
@; [Eli] This is also using `my-lib/helper' which doesn't work with
@; planet libraries
@verbatim[#:indent 2]|{
#lang scribble/doc
@(require scribble/manual
(for-label scheme
#lang scribble/manual
@(require (for-label scheme
"helper.ss"))
@title{My Library}
@ -408,9 +313,8 @@ from the previous section, @filepath{helper.ss} must be imported both
via @scheme[require-for-label] and @scheme[require]:
@verbatim[#:indent 2]|{
#lang scribble/doc
@(require scribble/manual
scribble/eval ; <--- added
#lang scribble/manual
@(require scribble/eval ; <--- added
"helper.ss" ; <--- added
(for-label scheme
"helper.ss"))
@ -432,58 +336,6 @@ via @scheme[require-for-label] and @scheme[require]:
]}
}|
@;----------------------------------------
@section{Splitting the Document Source}
In general, a @filepath{.scrbl} file produces a @techlink{part}. A part
produced by a document's main source (as specified in the
@filepath{info.ss} file) represents the whole document. The
@scheme[include-section] procedure can be used to incorporate a part
as a sub-part of the enclosing part.
In @filepath{manual.scrbl}:
@verbatim[#:indent 2]|{
#lang scribble/doc
@(require scribble/manual)
@title{My Library}
@defmodule[my-lib/helper]{The @schememodname[my-lib/helper]
module---now with extra cows!}
@include-section["cows.scrbl"]
@include-section["aardvarks.scrbl"]
}|
In @filepath{cows.scrbl}:
@verbatim[#:indent 2]|{
#lang scribble/doc
@(require scribble/manual)
@title{Cows}
Wherever they go, it's a quite a show.
}|
In @filepath{aardvarks.scrbl}:
@verbatim[#:indent 2]|{
#lang scribble/doc
@(require scribble/manual
(for-label scheme
"helper.ss"))
@title{Aardvarks}
@defproc[(my-helper [lst list?])
(listof (not/c (one-of/c 'cow)))]{
Replaces each @scheme['cow] in @scheme[lst] with
@scheme['aardvark].}
}|
@;----------------------------------------
@section{Multi-Page Sections}
@ -500,8 +352,7 @@ sub-sections.
Revising @filepath{cows.scrbl} from the previous section:
@verbatim[#:indent 2]|{
#lang scribble/doc
@(require scribble/manual)
#lang scribble/manual
@title[#:style '(toc)]{Cows}

16
collects/scribblings/scribble/internals.scrbl Normal file
View File

@ -0,0 +1,16 @@
#lang scribble/manual
@(require "utils.ss")
@title[#:tag "internals" #:style 'toc]{Low-Level Scribble}
@local-table-of-contents[]
@include-section["layers.scrbl"]
@include-section["reader.scrbl"]
@include-section["core.scrbl"]
@include-section["renderer.scrbl"]
@include-section["decode.scrbl"]
@include-section["doclang.scrbl"]
@include-section["docreader.scrbl"]
@include-section["xref.scrbl"]
@include-section["config.scrbl"]

45
collects/scribblings/scribble/layers.scrbl
View File

@ -16,14 +16,34 @@ and instead use the document-generation structure directly.
A Scribble document normally starts
@schememod[
scribble/manual
]
but it could also start
@schememod[
scribble/base
]
or
@schememod[
scribble/doc
]
Besides making the file a module, this declaration selects the
Scribble reader (instead of the usual Scheme reader), and it starts
the body of the file in ``text'' mode. The reader layer mostly leaves
text alone, but @litchar["@"] forms escape to S-expression mode.
The last one introduces the smallest number of typesetting bindings in
the document body. Using @schememodname[scribble/base] after
@hash-lang[] is the same as using @schememodname[scribble/doc] plus
@scheme[(require scribble/base)], and using
@schememodname[scribble/manual] after @hash-lang[] is the same as using
@schememodname[scribble/doc] plus @scheme[(require scribble/manual)].
Besides making the file a module, each of the @hash-lang[]
declarations selects the Scribble reader (instead of the usual Scheme
reader), and it starts the body of the file in ``text'' mode. The
reader layer mostly leaves text alone, but @litchar["@"] forms escape
to S-expression mode.
A module written as
@ -150,10 +170,10 @@ Working roughly from the bottom up, the Scribble layers are:
syntax of Scheme with @"@"-forms for conveniently embedding a
mixin of text and escapes. See @secref["reader"].}
@item{@schememodname[scribble/struct]: A set of document datatypes
@item{@schememodname[scribble/core]: A set of document datatypes
and utilities that define the basic layout and processing of a
document. For example, the @scheme[part] datatype is defined in
this layer. See @secref["struct"].}
this layer. See @secref["core"].}
@item{@schememodname[scribble/base-render] with
@schememodname[scribble/html-render],
@ -165,7 +185,7 @@ Working roughly from the bottom up, the Scribble layers are:
@item{@schememodname[scribble/decode]: Processes a stream of text,
section-start markers, etc. to produce instances of the
@schememodname[scribble/struct] datatypes. See
@schememodname[scribble/core] datatypes. See
@secref["decode"].}
@item{@schememodname[scribble/doclang]: A language to be used for the
@ -177,19 +197,22 @@ Working roughly from the bottom up, the Scribble layers are:
@schememodname[scribble/reader] with
@schememodname[scribble/doclang]. See @secref["docreader"].}
@item{@schememodname[scribble/basic]: A library of basic document
@item{@schememodname[scribble/base]: A library of basic document
operators---such as @scheme[title], @scheme[section], and
@scheme[secref]---for use with @schememodname[scribble/decode]
and a renderer. See @secref["basic"].}
and a renderer. This library name also can be used as a
language, where it combines @schememodname[scribble/doc] with
the exports of @schememodname[scribble/base]. See
@secref["base"].}
@item{@schememodname[scribble/scheme]: A library of functions for
typesetting Scheme code. See @secref["scheme"]. These functions
are not normally used directly, but instead through
are not normally used directly, but instead used through
@schememodname[scribble/manual].}
@item{@schememodname[scribble/manual]: A library of functions for
writing PLT Scheme documentation; re-exports
@schememodname[scribble/basic]. Also, the
@schememodname[scribble/base]. Also, the
@schememodname[scribble/manual-struct] library provides types
for index-entry descriptions created by functions in
@schememodname[scribble/manual]. See @secref["manual"].}

22
collects/scribblings/scribble/lp.scrbl
View File

@ -1,12 +1,18 @@
#lang scribble/doc
@(require scribble/manual
scribble/struct
scribble/core
scribble/html-variants
scribble/latex-variants
scheme/runtime-path
(prefix-in lp-ex: "lp-ex-doc.scrbl")
"utils.ss"
(for-label scribble/lp-include scribble/lp))
@title[#:tag "lp" #:style `((css "lp.css") (tex "lp.tex")) ]{Literate Programming}
@title[#:tag "lp"
#:style (make-style #f
(list (make-css-addition "lp.css")
(make-tex-addition "lp.tex")))
]{Literate Programming}
Programs written using @schememodname[scribble/lp] are simultaneously
two things: a program and a document describing the program.
@ -43,9 +49,9 @@ function @scheme[f] that squares its argument, and the documentation
is ignored. When it is included with @scheme[lp-include], it looks
like this:
@(make-blockquote
"LPBoxed"
(flow-paragraphs (part-flow lp-ex:doc)))
@(make-nested-flow
(make-style "LPBoxed" null)
(part-blocks lp-ex:doc))
@section{@schememodname[scribble/lp] Language}
@ -73,7 +79,11 @@ provides core support for literate programming.}
@section{@schememodname[scribble/lp-include] Module}
@defmodule[scribble/lp-include]{}
@defmodule[scribble/lp-include]{The
@schememodname[scribble/lp-include] library is normally used within a
Scribble document---that is, a module that starts with something like
@scheme[#, @hash-lang[] scribble/base] or @scheme[#, @hash-lang[]
scribble/manual], instead of @scheme[#, @hash-lang[] scheme].}
@defform[(lp-include filename)]{
Includes the source of @scheme[filename] as the typeset version of the literate

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

@ -11,14 +11,20 @@
@defmodule[scribble/manual]{The @schememodname[scribble/manual]
library provides all of @schememodname[scribble/basic] plus additional
functions, including many that are relatively specific to writing PLT
Scheme documentation.
functions, including all of @scheme[scribble/base] plus many others
that are relatively specific to writing PLT Scheme documentation.
The @schememodname[scribble/manual] name can also be used as a
language with @hash-lang[]. It acts like the
@schememodname[scribble/doc] language, except that the
@schememodname[scribble/manual] library is also required into
the module.}
@schememodname[scribble/manual] library is also required into the
module.
In addition, @scheme[#, @hash-lang[] #, @schememodname[scribble/manual]]
associates a @scheme[latex-defaults] style @tech{variant} with its
@scheme[doc] export to select the default PLT Scheme manual style for
Latex rendering---unless a style is supplied to @scheme[title] that
already includes a @scheme[latex-defaults] @tech{variant}.}
@local-table-of-contents[]
@ -163,12 +169,6 @@ representation of literal text. Use this when you have to talk about
the individual characters in a stream of text, as as when documenting
a reader extension.}
@defproc[(verbatim [#:indent indent integer? 0] [str string?] ...)
flow-element?]{Typesets @scheme[str]
as a table/paragraph in typewriter font with the linebreaks specified
by newline characters in @scheme[str]. ``Here strings'' are often
useful with @scheme[verbatim].}
@defproc[(schemefont [pre-content any/c] ...) element?]{Typesets
@tech{decode}d @scheme[pre-content] as uncolored, unhyperlinked
Scheme. This procedure is useful for typesetting things like
@ -819,8 +819,8 @@ as a member of the signature named by @scheme[sig-id].}
@; ------------------------------------------------------------------------
@section[#:tag "doc-strings"]{Various String Forms}
@defproc[(emph [pre-content any/c] ...) element?]{Typesets the
@tech{decode}d @scheme[pre-content] with emphasis (e.g., in italic).}
@defproc[(aux-elem [pre-content any/c] ...) element?]{
Like @scheme[elem], but adds an @scheme['aux] style @tech{variant}.}
@defproc[(defterm [pre-content any/c] ...) element?]{Typesets the
@tech{decode}d @scheme[pre-content] as a defined term (e.g., in
@ -862,101 +862,28 @@ font with a leading @litchar{+}).}
@tech{decode}d @scheme[pre-content] a long @litchar{+} flag (e.g., in
typewriter font with two leading @litchar{+}s).}
@defproc[(math [pre-content any/c] ...) element?]{The @tech{decode}d
@scheme[pre-content] is further transformed:
@itemize[
@item{Any immediate @scheme['rsquo] is converted to @scheme['prime].}
@item{Parentheses and sequences of decimal digits in immediate
strings are left as-is, but any other immediate string is
italicized.}
]
Extensions to @scheme[math] are likely, such as recognizing @litchar{_}
and @litchar{^} for subscripts and superscripts.}
@; ------------------------------------------------------------------------
@section[#:tag "section-links"]{Links}
@defproc[(secref [tag string?]
[#:doc module-path (or/c module-path? false/c) #f]
[#:tag-prefixes prefixes (or/c (listof string?) false/c) #f]
[#:underline? underline? any/c #t])
element?]{
Inserts the hyperlinked title of the section tagged @scheme[tag], but
@schemeidfont{aux-element} items in the title content are omitted in the
hyperlink label.
If @scheme[#:doc module-path] is provided, the @scheme[tag] refers to
a tag with a prefix determined by @scheme[module-path]. When
@exec{setup-plt} renders documentation, it automatically adds a tag
prefix to the document based on the source module. Thus, for example,
to refer to a section of the PLT Scheme reference,
@scheme[module-path] would be @scheme['(lib
"scribblings/reference/reference.scrbl")].
The @scheme[#:tag-prefixes prefixes] argument similarly supports
selecting a particular section as determined by a path of tag
prefixes. When a @scheme[#:doc] argument is provided, then
@scheme[prefixes] should trace a path of tag-prefixed subsections to
reach the @scheme[tag] section. When @scheme[#:doc] is not provided,
the @scheme[prefixes] path is relative to any enclosing section (i.e.,
the youngest ancestor that produces a match).
If @scheme[underline?] is @scheme[#f], then the hyperlink is rendered
in HTML without an underline.}
@defproc[(seclink [tag string?]
[#:doc module-path (or/c module-path? false/c) #f]
[#:tag-prefixes prefixes (or/c (listof string?) false/c) #f]
[#:underline? underline? any/c #t]
[pre-content any/c] ...) element?]{
Like @scheme[secref], but the link label is the @tech{decode}d
@scheme[pre-content] instead of the target section's name.}
@defproc[(other-manual [module-path module-path?]
[#:underline? underline? any/c #t])
element?]{
Like @scheme[secref] for the document's implicit @scheme["top"]
tag. Use this function to refer to a whole manual instead of
@scheme[secref], in case a special style in the future is used for
manual titles.}
See also @secref["base-links"].
@defproc[(schemelink [id symbol?] [pre-content any/c] ...) element?]{
The @tech{decode}d @scheme[pre-content] is hyperlinked to the definition
of @scheme[id].}
@defproc[(link [url string?] [pre-content any/c] ...
[#:underline? underline? any/c #t]
[#:style style any/c (if underline? #f "plainlink")])
[#:underline? underline? any/c #t]
[#:style style (or/c style? string? symbol? #f) (if underline? #f "plainlink")])
element?]{
The @tech{decode}d @scheme[pre-content] is hyperlinked to
@scheme[url]. If @scheme[style] is not supplied, then
@scheme[underline?] determines how the link is rendered.}
An alias of @scheme[hyperlink] for backward compatibility.}
@defproc[(other-manual [module-path module-path?]
[#:underline? underline? any/c #t])
element?]{
@defproc[(elemtag [t tag?] [pre-content any/c] ...) element?]{
The tag @scheme[t] refers to the content form of
@scheme[pre-content].}
@defproc[(elemref [t tag?] [pre-content any/c] ...
[#:underline? underline? any/c #t]) element?]{
The @tech{decode}d @scheme[pre-content] is hyperlinked to @scheme[t],
which is normally defined using @scheme[elemtag].}
An alias of @scheme[other-doc] for backward compatibility.}
@defproc[(deftech [pre-content any/c] ...
[#:style? style? any/c #t]) element?]{
@ -1022,6 +949,8 @@ the link.}
@; ------------------------------------------------------------------------
@section[#:tag "manual-indexing"]{Indexing}
See also @secref["base-indexing"].
@defform[(indexed-scheme datum ...)]{
A combination of @scheme[scheme] and @scheme[as-index], with the
@ -1055,28 +984,13 @@ key for the index iterm does not include quotes.}
combination of @scheme[envvar] and @scheme[as-index].}
@; ------------------------------------------------------------------------
@section{Images}
@defproc[(image [filename-relative-to-source string?]
[pre-element any/c] ...)
flow-element?]{
Creates a centered image from the given relative source path. The
@tech{decode}d @scheme[pre-content] serves as the alternate text for
contexts where the image cannot be displayed.
The path is relative to the current directory, which is set by
@exec{setup-plt} and @exec{scribble} to the directory of the main
document file.
When generating Latex output, if the filename has a @filepath{.gif}
suffix, then the suffix is changed to @filepath{.png} (so a PNG file
must exist in addition to the GIF file).}
@section[#:tag "manual-images"]{Images}
@defproc[(image/plain [filename-relative-to-source string?]
[pre-element any/c] ...)
element?]{
Like @scheme[image], but the result is an element to appear inline in
a paragraph.}
An alias for @scheme[image] for backward compatibility.}
@; ------------------------------------------------------------------------
@section{Bibliography}
@ -1160,15 +1074,31 @@ that is hyperlinked to an explanation.}
@defthing[undefined-const element?]{Returns an element for @|undefined-const|.}
@defproc[(centerline [pre-flow any/c] ...) table?]{Produces a
centered table with the @scheme[pre-flow] parsed by
@scheme[decode-flow].}
@defproc[(commandline [pre-content any/c] ...) paragraph?]{Produces
an inset command-line example (e.g., in typewriter font).}
@defproc[(margin-note [pre-content any/c] ...) blockquote?]{Produces
a @tech{blockquote} to be typeset in the margin instead of inlined.}
@defproc[(centerline [pre-flow pre-flow?] ...) nested-flow?]{
An alias for @scheme[centered] for backward compatibility.}
@defproc[(math [pre-content any/c] ...) element?]{The @tech{decode}d
@scheme[pre-content] is further transformed:
@itemize[
@item{Any immediate @scheme['rsquo] is converted to @scheme['prime].}
@item{Parentheses and sequences of decimal digits in immediate
strings are left as-is, but any other immediate string is
italicized.}
@item{When @litchar{_} appears before a non-empty sequence of numbers
and letters, the sequence is typeset as a subscript.}
@item{When @litchar{^} appears before a non-empty sequence of numbers
and letters, the sequence is typeset as a superscript.}
]}
@; ------------------------------------------------------------------------
@section[#:tag "index-entries"]{Index-Entry Descriptions}

26
collects/scribblings/scribble/other.scrbl Normal file
View File

@ -0,0 +1,26 @@
#lang scribble/manual
@(require "utils.ss"
(for-label scribble/sigplan))
@title{More Document Styles}
In addition to @schememodname[scribble/base] and
@schememodname[scribble/manual], Scribble provides a few extra
document styles as a convenience.
@section{SIGPLAN Paper Format}
@defmodulelang[scribble/sigplan]{The @schememodname[scribble/sigplan]
language is like @schememodname[scribble/manual], but configured with
Latex style defaults to use the @filepath{sigplanconf.cls} class
file that is included with Scribble.}
@defidform[preprint]{
Enables the @tt{preprint} option. Use @scheme[preprint] only on the
same line as @hash-lang[], with only whitespace between
@schememodname[scribble/sigplan] and @scheme[preprint]:
@verbatim[#:indent 2]|{
#lang scribble/sigplan @preprint
}|}

13
collects/scribblings/scribble/plt.scrbl Normal file
View File

@ -0,0 +1,13 @@
#lang scribble/manual
@(require "utils.ss")
@title[#:tag "plt-manuals" #:style 'toc]{PLT Scheme Manuals}
@local-table-of-contents[]
@include-section["manual.scrbl"]
@include-section["scheme.scrbl"]
@include-section["eval.scrbl"]
@include-section["srcdoc.scrbl"]
@include-section["bnf.scrbl"]
@include-section["compat.scrbl"]

9
collects/scribblings/scribble/preprocessor.scrbl
View File

@ -1,12 +1,17 @@
#lang scribble/doc
@(require scribble/manual scribble/struct "utils.ss"
@(require scribble/manual
scribble/core scribble/html-variants scribble/latex-variants
"utils.ss"
(for-label scheme/base
;; FIXME: need to get this in
;; scribble/text
))
@initialize-tests
@title[#:tag "preprocessor"]{Text Preprocessor}
@title[#:tag "preprocessor"
#:style (make-style #f (list (make-tex-addition "shaded.tex")
(make-css-addition "shaded.css")))
]{Text Preprocessing}
@defmodulelang[scribble/text]{The @schememodname[scribble/text]
language provides everything from @scheme[scheme/base] with a few

2
collects/scribblings/scribble/reader.scrbl
View File

@ -440,7 +440,7 @@ of the text. This works for @litchar["@"] too:
}===|
@;--------------------------------------------------------------------
@subsubsub*section{Alternative Body Syntax}
@subsubsub*section[#:tag "alt-body-syntax"]{Alternative Body Syntax}
In addition to the above, there is an alternative syntax for the body,
one that specifies a new marker for its end: use @litchar["|{"] for

28
collects/scribblings/scribble/scheme.scrbl
View File

@ -69,7 +69,7 @@ Like @scheme[to-paragraph], but @scheme[prefix1] is prefixed onto the
first line, @scheme[prefix] is prefix to any subsequent line, and
@scheme[suffix] is added to the end. The @scheme[prefix1],
@scheme[prefix], and @scheme[suffix] arguments are used as
@tech{elements}, except that if @scheme[suffix] is a list of elements,
@tech{content}, except that if @scheme[suffix] is a list of elements,
it is added to the end on its own line.}
@ -152,3 +152,29 @@ Provided @scheme[for-syntax]; like @scheme[make-element-id-transformer] for
a transformer that produces @scheme[sym] typeset as a variable (like
@scheme[schemevarfont])---unless it appears under quote or quasiquote,
in which case @scheme[sym] is typeset as a symbol.}
@deftogether[(
@defthing[output-color style?]
@defthing[input-color style?]
@defthing[input-background-color style?]
@defthing[no-color style?]
@defthing[reader-color style?]
@defthing[result-color style?]
@defthing[keyword-color style?]
@defthing[comment-color style?]
@defthing[paren-color style?]
@defthing[meta-color style?]
@defthing[value-color style?]
@defthing[symbol-color style?]
@defthing[variable-color style?]
@defthing[opt-color style?]
@defthing[error-color style?]
@defthing[syntax-link-color style?]
@defthing[value-link-color style?]
@defthing[module-color style?]
@defthing[module-link-color style?]
@defthing[block-color style?]
@defthing[highlighted-color style?]
)]{
Styles that are used for coloring Scheme programs, results, and I/O.}

38
collects/scribblings/scribble/scribble.scrbl
View File

@ -1,19 +1,15 @@
#lang scribble/doc
@(require scribble/manual
scribble/bnf
#lang scribble/manual
@(require scribble/bnf
"utils.ss")
@title{@bold{Scribble}: PLT Documentation Tool}
@title{@bold{Scribble}: PLT Documentation Tools}
@author["Matthew Flatt" "Eli Barzilay"]
Scribble is a collection of tools for creating prose documents,
especially those that document libraries, and especially for HTML and
PDF (via LaTeX) output. More generally, it is useful for cases where
you need to deal with Scheme code that is rich in textual content: it
has a syntactic extension for writing almost free-form text and a tool
for using the scribble syntax for preprocessing text files with
embedded Scheme code.
Scribble is a collection of tools for creating ASCII, HTML, and
Latex/PDF documents with PLT Scheme. Suitable uses include the
creation of papers, books, literate programs, preprocessed text, and
PLT Scheme library documentation.
This document itself is written using Scribble. At the time that it
was written, its source was available at
@ -24,23 +20,11 @@ starting with the @filepath{scribble.scrbl} file.
@table-of-contents[]
@; ------------------------------------------------------------------------
@include-section["how-to.scrbl"]
@include-section["layers.scrbl"]
@include-section["reader.scrbl"]
@include-section["struct.scrbl"]
@include-section["renderer.scrbl"]
@include-section["decode.scrbl"]
@include-section["doclang.scrbl"]
@include-section["docreader.scrbl"]
@include-section["basic.scrbl"]
@include-section["scheme.scrbl"]
@include-section["manual.scrbl"]
@include-section["eval.scrbl"]
@include-section["srcdoc.scrbl"]
@include-section["bnf.scrbl"]
@include-section["getting-started.scrbl"]
@include-section["generic.scrbl"]
@include-section["plt.scrbl"]
@include-section["lp.scrbl"]
@include-section["xref.scrbl"]
@include-section["preprocessor.scrbl"]
@include-section["config.scrbl"]
@include-section["internals.scrbl"]
@index-section[]

5
collects/scribblings/scribble/shaded.css Normal file
View File

@ -0,0 +1,5 @@
.Shaded {
width: 100%;
background-color: #E8E8FF;
}

5
collects/scribblings/scribble/shaded.tex Normal file
View File

@ -0,0 +1,5 @@
\newenvironment{Shaded}{}{}
\newcommand{\Short}[1]{\begin{minipage}[c]{6ex}#1\end{minipage}}
\newcommand{\Medium}[1]{\begin{minipage}[c]{20ex}#1\end{minipage}}

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

File diff suppressed because it is too large Load Diff

39
collects/scribblings/scribble/utils.ss
View File

@ -1,6 +1,7 @@
#lang scheme/base
(require scribble/struct
(require scribble/core
scribble/html-variants
scribble/manual
(prefix-in scheme: scribble/scheme)
(prefix-in scribble: scribble/reader))
@ -15,25 +16,27 @@
[(_ mod ...) (begin (bounce-for-label mod) ...)]))
(bounce-for-label (all-except scheme (link) ())
scribble/struct
scribble/core
scribble/base-render
scribble/decode
scribble/manual
scribble/scheme
scribble/html-variants
scribble/latex-variants
scribble/eval
scribble/bnf)
(provide scribble-examples litchar/lines)
(define (as-flow e)
(make-flow (list (if (block? e) e (make-paragraph (list e))))))
(if (block? e) e (make-paragraph plain (list e))))
(define (litchar/lines . strs)
(let ([strs (regexp-split #rx"\n" (apply string-append strs))])
(if (= 1 (length strs))
(litchar (car strs))
(make-table
#f
plain
(map (lambda (s) ; the nbsp is needed for IE
(list (as-flow (if (string=? s "") 'nbsp (litchar s)))))
strs)))))
@ -69,7 +72,7 @@
p)]))
(define (scribble-examples . lines)
(define reads-as (make-paragraph (list spacer "reads as" spacer)))
(define reads-as (make-paragraph plain (list spacer "reads as" spacer)))
(let* ([lines (apply string-append lines)]
[p (open-input-string lines)])
(port-count-lines! p)
@ -87,7 +90,7 @@
(cdr (apply append (map (lambda (x) (list #f x)) r)))
r)])
(make-table
#f
plain
(map (lambda (x)
(let ([@expr (if x (litchar/lines (car x)) "")]
[sexpr (if x
@ -122,9 +125,10 @@
(list (as-flow (make-element 'newline '())))
(list (as-flow (make-element 'tt (str->elts str))))))
(define (small-attr attr)
(make-with-attributes attr '([style . "font-size: 82%;"])))
(make-style attr (list
(make-attributes '([style . "font-size: 82%;"])))))
(define (make-box strs)
(make-table (small-attr 'boxed) (map make-line strs)))
(make-table (small-attr "Shaded") (map make-line strs)))
(define filenames (map car more))
(define indent (let ([d (- max-textsample-width
(for*/fold ([m 0])
@ -138,16 +142,20 @@
;; Note: the font-size property is reset for every table, so we need it
;; everywhere there's text, and they don't accumulate for nested tables
(values
(make-table (make-with-attributes
'([alignment right left] [valignment top top])
'())
(make-table
(make-style #f
(list (make-table-columns (list (make-style (if (null? filenames)
"Short"
"Medium")
'(right top))
(make-style #f '(left top))))))
(cons (list (as-flow (make-table (small-attr #f)
(list (list (as-flow indent)))))
(as-flow (make-box strs1)))
(map (lambda (file strs)
(let* ([file (make-element 'tt (list file ":" 'nbsp))]
[file (list (make-element 'italic (list file)))])
(list (as-flow (make-element '(bg-color 232 232 255) file))
(list (as-flow (make-element (make-style #f (list (make-background-color-variant '(232 232 255)))) file))
(as-flow (make-box strs)))))
filenames strsm)))
(make-box strs2)))
@ -155,8 +163,11 @@
(define (textsample line in-text out-text more)
(define-values (box1 box2)
(textsample-verbatim-boxes line in-text out-text more))
(make-table '([alignment left left left] [valignment center center center])
(list (map as-flow (list box1 (make-paragraph '(nbsp rarr nbsp)) box2)))))
(make-table
(make-style #f (list (make-table-columns (list (make-style #f '(left vcenter))
(make-style "Short" '(left vcenter))
(make-style #f '(left vcenter))))))
(list (map as-flow (list box1 (make-paragraph plain '(nbsp rarr nbsp)) box2)))))
(define-for-syntax tests-ids #f)

6
collects/scriblib/autobib.css
View File

@ -1,5 +1,9 @@
.SBibliography p {
.AutoBibliography p {
padding-left: 1em;
text-indent: -1em;
}
.AutoBibliography td {
vertical-align: text-top;
}

122
collects/scriblib/autobib.ss
View File

@ -1,21 +1,29 @@
#lang at-exp scheme/base
(require scribble/manual
scribble/struct
scribble/core
scribble/decode
scheme/string)
scribble/html-variants
scribble/latex-variants
scheme/string
setup/main-collects)
(provide autobib-style-extras
define-cite
(provide define-cite
make-bib in-bib (rename-out [auto-bib? bib?])
proceedings-location journal-location book-location
techrpt-location dissertation-location
author-name org-author-name authors other-authors editor)
(define (autobib-style-extras)
(define autobib-style-extras
(let ([abs (lambda (s)
(build-path (collection-path "scriblib") s))])
`((css ,(abs "autobib.css")) (tex ,(abs "autobib.tex")))))
(path->main-collects-relative
(build-path (collection-path "scriblib") s)))])
(list
(make-css-addition (abs "autobib.css"))
(make-tex-addition (abs "autobib.tex")))))
(define bib-table-style (make-style "AutoBibliography" autobib-style-extras))
(define bibentry-style (make-style "Autobibentry" autobib-style-extras))
(define-struct auto-bib (author date entry-element key specific))
(define-struct bib-group (ht))
@ -57,48 +65,46 @@
[bibs (sort (hash-map (bib-group-ht group)
(lambda (k v) k))
author<?)])
(make-unnumbered-part
(make-part
#f
`((part ,tag))
'("Bibliography")
'()
(make-style #f '(unnumbered))
null
(make-flow
(list
(make-table
"SBibliography"
(map (lambda (k)
(list
(make-flow
(list
(make-paragraph
(list
(make-collect-element
#f
(list (make-target-element
#f
(list (auto-bib-entry-element k))
`(autobib ,(auto-bib-key k))))
(lambda (ci)
(collect-put! ci
`(autobib-cite ,(auto-bib-key k))
(make-element
#f
(list
(author-element-cite (auto-bib-author k))
" "
(auto-bib-date k))))
(collect-put! ci
`(autobib-inline ,(auto-bib-key k))
(make-element
#f
(list
(author-element-cite (auto-bib-author k))
'nbsp
"("
(auto-bib-date k)
")")))))))))))
bibs))))
(list
(make-table
bib-table-style
(map (lambda (k)
(list
(make-paragraph
plain
(list
(make-collect-element
#f
(list (make-target-element
#f
(list (auto-bib-entry-element k))
`(autobib ,(auto-bib-key k))))
(lambda (ci)
(collect-put! ci
`(autobib-cite ,(auto-bib-key k))
(make-element
#f
(list
(author-element-cite (auto-bib-author k))
" "
(auto-bib-date k))))
(collect-put! ci
`(autobib-inline ,(auto-bib-key k))
(make-element
#f
(list
(author-element-cite (auto-bib-author k))
'nbsp
"("
(auto-bib-date k)
")")))))))))
bibs)))
null)))
(define-syntax-rule (define-cite ~cite citet generate-bibliography)
@ -112,7 +118,7 @@
(gen-bib tag group))))
(define (ends-in-punc? e)
(regexp-match? #rx"[.!?,]$" (element->string e)))
(regexp-match? #rx"[.!?,]$" (content->string e)))
(define (make-bib #:title title
#:author [author #f]
@ -125,7 +131,7 @@
[(author-element? author) author]
[else (parse-author author)])]
[elem (make-element
"bibentry"
bibentry-style
(append
(if author
`(,author
@ -144,13 +150,13 @@
(if location
`(" " ,@(decode-content (list location)) ,(if date "," "."))
null)
(if date `(" " ,@(decode-content (list date)) ".") null)
(if date `(" " ,@(decode-content (list (to-string date))) ".") null)
(if url `(" " ,(link url (make-element 'url (list url)))) null)))])
(make-auto-bib
(or author (org-author-name title))
date
(to-string date)
elem
(element->string elem)
(content->string elem)
"")))
(define (in-bib bib where)
@ -164,7 +170,7 @@
(define (parse-author a)
(if (author-element? a)
a
(let* ([s (element->string a)]
(let* ([s (content->string a)]
[m (regexp-match #rx"^(.*) ([A-Za-z]+)$" s)])
(make-author-element
#f
@ -183,13 +189,13 @@
#:volume [volume #f])
(let* ([s @elem{In @italic{@elem{Proc. @|location|}}}]
[s (if series
@elem{@|s|, @|series|}
@elem{@|s|, @(format "~a" series)}
s)]
[s (if volume
@elem{@|s| volume @|volume|}
@elem{@|s| volume @(format "~a" volume)}
s)]
[s (if pages
@elem{@|s|, pp. @(car pages)--@(cadr pages)}
@elem{@|s|, pp. @(to-string (car pages))--@(to-string (cadr pages))}
s)])
s))
@ -200,13 +206,13 @@
#:volume [volume #f])
(let* ([s @italic{@|location|}]
[s (if volume
@elem{@|s| @|volume|}
@elem{@|s| @(to-string volume)}
s)]
[s (if number
@elem{@|s|(@|number|)}
@elem{@|s|(@(to-string number))}
s)]
[s (if pages
@elem{@|s|, pp. @(car pages)--@(cadr pages)}
@elem{@|s|, pp. @(to-string (car pages))--@(to-string (cadr pages))}
s)])
s))
@ -301,3 +307,5 @@
'(" (Ed.)"))
(author-element-names name)
(author-element-cite name))))
(define (to-string v) (format "~a" v))

4
collects/scriblib/autobib.tex
View File

@ -1,3 +1,3 @@
\renewenvironment{SBibliography}{\begin{small}}{\end{small}}
\renewcommand{\bibentry}[1]{\hspace{0.05\linewidth}\parbox[t]{0.95\linewidth}{\parindent=-0.05\linewidth#1\vspace{1.0ex}}}
\newenvironment{AutoBibliography}{\begin{small}}{\end{small}}
\newcommand{\Autobibentry}[1]{\hspace{0.05\linewidth}\parbox[t]{0.95\linewidth}{\parindent=-0.05\linewidth#1\vspace{1.0ex}}}

49
collects/scriblib/figure.ss
View File

@ -1,58 +1,67 @@
#lang scheme/base
(require scribble/manual
scribble/struct
scribble/core
scribble/decode
scribble/html-variants
scribble/latex-variants
setup/main-collects
"private/counter.ss")
(provide figure
figure*
figure**
Figure-target
Figure-ref
figure-style-extras)
Figure-ref)
(define (figure-style-extras)
(define figure-style-extras
(let ([abs (lambda (s)
(build-path (collection-path "scriblib") s))])
`((css ,(abs "figure.css")) (tex ,(abs "figure.tex")))))
(list (make-css-addition (abs "figure.css"))
(make-tex-addition (abs "figure.tex")))))
(define centerfigure-style (make-style "Centerfigure" figure-style-extras))
(define figureinside-style (make-style "FigureInside" figure-style-extras))
(define legend-style (make-style "Legend" figure-style-extras))
(define centerfiguremulti-style (make-style "CenterfigureMulti" figure-style-extras))
(define centerfiguremultiwide-style (make-style "CenterfigureMultiWide" figure-style-extras))
(define (figure tag caption . content)
(make-blockquote
"Centerfigure"
(make-nested-flow
centerfigure-style
(list
(make-blockquote
"FigureInside"
(make-nested-flow
figureinside-style
(append
(flow-paragraphs
(decode-flow content))
(decode-flow content)
(list
(make-paragraph
plain
(list
(make-element "Legend"
(make-element legend-style
(list* (Figure-target tag) ": "
(decode-content (list caption))))))))))))
(define (*figure style tag caption content)
(make-blockquote
(make-nested-flow
style
(list
(make-blockquote
"FigureInside"
(make-nested-flow
figureinside-style
(append
(flow-paragraphs
(decode-flow content))
(decode-flow content)
(list
(make-paragraph
plain
(list
(make-element "Legend"
(make-element legend-style
(list* (Figure-target tag) ": "
(decode-content (list caption))))))))))))
(define (figure* tag caption . content)
(*figure "CenterfigureMulti" tag caption content))
(*figure centerfiguremulti-style tag caption content))
(define (figure** tag caption . content)
(*figure "CenterfigureMultiWide" tag caption content))
(*figure centerfiguremultiwide-style tag caption content))
(define figures (new-counter "figure"))
(define (Figure-target tag)

2
collects/scriblib/figure.tex
View File

@ -12,4 +12,4 @@
\newenvironment{CenterfigureMulti}{\begin{figure*}\centering}{\end{figure*}}
\newenvironment{CenterfigureMultiWide}{\begin{CenterfigureMulti}}{\end{CenterfigureMulti}}
\newenvironment{Centerfigure}{\begin{figure}\centering}{\end{figure}}
\newenvironment{FigureInside}{\begin{list}{}{\leftmargin=0pt\parsep=\FigOrigskip}\item}{\end{list}}
\newenvironment{FigureInside}{\begin{list}{}{\leftmargin=0pt\topsep=0pt\parsep=\FigOrigskip\partopsep=0pt}\item}{\end{list}}

17
collects/scriblib/gui-eval.ss
View File

@ -1,7 +1,7 @@
#lang scheme/base
(require scribble/eval
scribble/struct
scribble/core
scribble/scheme
scheme/class
scheme/file
@ -127,13 +127,14 @@
(send dc clear)
(((gui-eval 'make-pict-drawer) v) dc 0 0)
(send bm save-file fn 'png)
(make-element #f (list (make-element (make-image-file
;; For HTML output, .pdf is automatically changed to .png.
;; Be sure to use a string rather than a path, because
;; it gets recorded in "exprs.dat".
(path->string (path-replace-suffix fn #".pdf"))
1.0)
(list "[image]"))))))]
(make-image-element
#f
(list "[image]")
;; Be sure to use a string rather than a path, because
;; it gets recorded in "exprs.dat".
(path->string (path-replace-suffix fn #""))
'(".pdf" ".png")
1.0)))]
[(pair? v) (cons (fixup-picts (car v))
(fixup-picts (cdr v)))]
[(serializable? v) v]