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

371.2

Browse Source 
svn: r7263
This commit is contained in:
Matthew Flatt 2007-09-02 17:39:32 +00:00
parent 00306ec289
commit e4cbc4e6a9
230 changed files with 11179 additions and 7861 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/big/define-struct.ss
View File

@ -379,7 +379,7 @@
(c (quote-syntax #,make-))
(c (quote-syntax #,?))
(list-immutable
#,@(map protect sels)
#,@(map protect (reverse sels))
#,@(if super-info
(map protect (list-ref super-info 3))
(if super-expr

12
collects/big/lang.ss
View File

@ -1,16 +1,20 @@
(module lang mzscheme
(require "define-struct.ss"
"new-lambda.ss")
"new-lambda.ss"
(lib "contract.ss")
(lib "for.ss"))
(provide (all-from-except mzscheme #%datum lambda define #%app define-struct)
(provide (all-from (lib "contract.ss"))
(all-from (lib "for.ss"))
(all-from-except mzscheme #%datum lambda define #%app define-struct)
(rename new-datum #%datum)
(rename new-lambda lambda)
(rename new-define define)
(rename new-app #%app)
(rename #%app #%plain-app)
(rename lambda #%plain-lambda)
make-keyword-procedure
keyword-apply
procedure-keywords
(rename define-struct* define-struct)
struct-field-index))

4
collects/big/new-lambda.ss
View File

@ -488,8 +488,8 @@
;; cannot be used to compute the default).
(define-syntax let-maybe
(syntax-rules (required)
[(_ () () () () () () body)
(let () body)]
[(_ () () () () () () . body)
(let () . body)]
[(_ ([id ignore #:plain] . more) kw-args kw-arg?s opt-args opt-arg?s (req-id . req-ids) . body)
(let ([id req-id])
(let-maybe more kw-args kw-arg?s opt-args opt-arg?s req-ids . body))]

12
collects/compiler/compiler-unit.ss
View File

@ -220,9 +220,15 @@
(lambda ()
(parameterize ([current-load-relative-directory dir])
;; Compile the collection files via make-collection
(let ([sses (filter
extract-base-filename/ss
(directory-list))])
(let ([sses (append
;; Find all .ss/.scm files:
(filter
extract-base-filename/ss
(directory-list))
;; Add specified doc sources:
(map car (info
'scribblings
(lambda () null))))])
(let ([filtered-sses
(remove*
(map string->path

4
collects/compiler/embed-unit.ss
View File

@ -402,9 +402,9 @@
null null)
(unbox codes)))]
[code
(let-values ([(imports fs-imports ft-imports) (module-compiled-imports code)])
(let-values ([(imports fs-imports ft-imports fl-imports) (module-compiled-imports code)])
(let ([all-file-imports (filter (lambda (x) (not (symbol? x)))
(append imports fs-imports ft-imports))]
(append imports fs-imports ft-imports fl-imports))]
[extra-paths (get-extra-imports filename code)])
(let ([sub-files (map (lambda (i) (normalize (resolve-module-path-index i filename)))
all-file-imports)]

2
collects/drscheme/private/module-overview.ss
View File

@ -941,7 +941,7 @@
(unless (hash-table-get visited-hash-table module-name (λ () #f))
(async-channel-put progress-channel (format adding-file module-name))
(hash-table-put! visited-hash-table module-name #t)
(let-values ([(imports fs-imports ft-imports) (module-compiled-imports module-code)])
(let-values ([(imports fs-imports ft-imports fl-imports) (module-compiled-imports module-code)])
(let ([requires (extract-filenames imports module-name)]
[syntax-requires (extract-filenames fs-imports module-name)]
[template-requires (extract-filenames ft-imports module-name)])

3
collects/errortrace/stacktrace.ss
View File

@ -420,8 +420,11 @@
[(require i ...) expr]
[(require-for-syntax i ...) expr]
[(require-for-template i ...) expr]
[(require-for-label i ...) expr]
;; No error possible (and no way to wrap)
[(provide i ...) expr]
[(provide-for-syntax i ...) expr]
[(provide-for-label i ...) expr]
;; No error possible
[(quote _)

72
collects/macro-debugger/model/deriv-parser.ss
View File

@ -57,8 +57,8 @@
;; Entry point
(productions
(Expansion
[(EE/Lifts) $1]
[(EE/Lifts/Interrupted) $1]))
[(start EE/Lifts) $2]
[(start EE/Lifts/Interrupted) $2]))
(productions/I
@ -106,7 +106,10 @@
;; Evaluation
(Eval
[() #f])
(#:no-wrap)
[() #f]
[(start (? EE) (? Eval)) #f]
[(start (? CheckImmediateMacro) (? Eval)) #f])
;; Expansion of an expression to primitive form
;; CheckImmediateMacro Answer = Derivation (I)
@ -150,18 +153,19 @@
(#:no-wrap)
(#:skipped null)
[() null]
[((? LocalAction) (? LocalActions)) (cons $1 $2)])
[((? LocalAction) (? LocalActions)) (cons $1 $2)]
[((? NotReallyLocalAction) (? LocalActions)) $2])
(LocalAction
(#:no-wrap)
[(enter-local local-pre (? EE) local-post exit-local)
(make-local-expansion $1 $5 $2 $4 #f $3)]
[(enter-local phase-up local-pre (? EE) local-post exit-local)
(make-local-expansion $1 $6 $3 $5 #t $4)]
[(enter-local/expr local-pre (? EE) local-post exit-local/expr)
(make-local-expansion/expr $1 (car $5) $2 $4 #f (cdr $5) $3)]
[(enter-local/expr local-pre phase-up (? EE) local-post exit-local/expr)
(make-local-expansion/expr $1 (car $6) $3 $5 #t (cdr $6) $4)]
[(enter-local local-pre start (? EE) local-post exit-local)
(make-local-expansion $1 $6 $2 $5 #f $4)]
[(enter-local phase-up local-pre start (? EE) local-post exit-local)
(make-local-expansion $1 $7 $3 $6 #t $5)]
[(enter-local/expr local-pre start (? EE) local-post exit-local/expr)
(make-local-expansion/expr $1 (car $6) $2 $5 #f (cdr $6) $4)]
[(enter-local/expr local-pre phase-up start (? EE) local-post exit-local/expr)
(make-local-expansion/expr $1 (car $7) $3 $6 #t (cdr $7) $5)]
[(lift)
(make-local-lift (cdr $1) (car $1))]
[(lift-statement)
@ -169,6 +173,17 @@
[(phase-up (? EE/LetLifts))
(make-local-bind $2)])
(NotReallyLocalAction
(#:no-wrap)
;; called 'expand' (not 'local-expand') within transformer
[(start (? EE))
(make-local-expansion (lift/deriv-e1 $2)
(lift/deriv-e2 $2)
(lift/deriv-e1 $2)
(lift/deriv-e2 $2)
#f
$2)])
;; Multiple calls to local-expand
;; EEs Answer = (listof Derivation)
(EEs
@ -245,8 +260,8 @@
(#:args e1 e2 rs)
;; Multiple forms after language
;; #%module-begin tagging done automatically
[(prim-module ! (? EE 'body))
(make-p:module e1 e2 rs #f $3)]
[(prim-module ! (? Eval) (? EE 'body))
(make-p:module e1 e2 rs #f $4)]
;; One form after language ... macro that expands into #%module-begin
[(prim-module NoError next
@ -287,14 +302,14 @@
(ModulePass1/Prim
[(enter-prim prim-define-values ! exit-prim)
(make-p:define-values $1 $4 null #f)]
[(enter-prim prim-define-syntaxes ! phase-up (? EE/LetLifts) exit-prim)
(make-p:define-syntaxes $1 $6 null $5)]
[(enter-prim prim-require ! exit-prim)
(make-p:require $1 $4 null)]
[(enter-prim prim-require-for-syntax ! exit-prim)
(make-p:require-for-syntax $1 $4 null)]
[(enter-prim prim-require-for-template ! exit-prim)
(make-p:require-for-template $1 $4 null)]
[(enter-prim prim-define-syntaxes ! phase-up (? EE/LetLifts) (? Eval) exit-prim)
(make-p:define-syntaxes $1 $7 null $5)]
[(enter-prim prim-require ! (? Eval) exit-prim)
(make-p:require $1 $5 null)]
[(enter-prim prim-require-for-syntax ! (? Eval) exit-prim)
(make-p:require-for-syntax $1 $5 null)]
[(enter-prim prim-require-for-template ! (? Eval) exit-prim)
(make-p:require-for-template $1 $5 null)]
[(enter-prim prim-provide ! exit-prim)
(make-p:provide $1 $4 null)]
[()
@ -324,7 +339,7 @@
;; Definitions
(PrimDefineSyntaxes
(#:args e1 e2 rs)
[(prim-define-syntaxes ! (? EE/LetLifts))
[(prim-define-syntaxes ! (? EE/LetLifts) (? Eval))
(make-p:define-syntaxes e1 e2 rs $3)])
(PrimDefineValues
@ -439,15 +454,18 @@
(PrimRequire
(#:args e1 e2 rs)
[(prim-require !) (make-p:require e1 e2 rs)])
[(prim-require ! (? Eval))
(make-p:require e1 e2 rs)])
(PrimRequireForSyntax
(#:args e1 e2 rs)
[(prim-require-for-syntax !) (make-p:require-for-syntax e1 e2 rs)])
[(prim-require-for-syntax ! (? Eval))
(make-p:require-for-syntax e1 e2 rs)])
(PrimRequireForTemplate
(#:args e1 e2 rs)
[(prim-require-for-template !) (make-p:require-for-template e1 e2 rs)])
[(prim-require-for-template ! (? Eval))
(make-p:require-for-template e1 e2 rs)])
(PrimProvide
(#:args e1 e2 rs)
@ -500,7 +518,7 @@
;; BindSyntaxes Answer = Derivation
(BindSyntaxes
[(phase-up (? EE/LetLifts) ! Eval) $2])
[(phase-up (? EE/LetLifts) ! (? Eval)) $2])
;; NextBindSyntaxess Answer = (list-of Derivation)
(NextBindSyntaxess

4
collects/macro-debugger/model/deriv-tokens.ss
View File

@ -5,7 +5,8 @@
(provide (all-defined))
(define-tokens basic-tokens
(visit ; syntax
(start ; .
visit ; syntax
resolve ; identifier
next ; .
next-group ; .
@ -138,6 +139,7 @@
(138 . prim-expression)
(139 . ,token-enter-local/expr)
(140 . ,token-exit-local/expr)
(141 . ,token-start)
))
(define (tokenize sig-n val pos)

2
collects/mzlib/class.ss
View File

@ -37,7 +37,7 @@
private public override augment
pubment overment augride
public-final override-final augment-final
field init init-field
field init init-field init-rest
rename-super rename-inner inherit inherit/super inherit/inner inherit-field
this super inner
super-make-object super-instantiate super-new

4
collects/mzlib/cm.ss
View File

@ -25,12 +25,12 @@
(x (apply max x))))
(define (get-deps code path)
(let-values ([(imports fs-imports ft-imports) (module-compiled-imports code)])
(let-values ([(imports fs-imports ft-imports fl-imports) (module-compiled-imports code)])
(map path->bytes
(map (lambda (x)
(resolve-module-path-index x path))
;; Filter symbols:
(let loop ([l (append imports fs-imports ft-imports)])
(let loop ([l (append imports fs-imports ft-imports fl-imports)])
(cond
[(null? l) null]
[(symbol? (car l)) (loop (cdr l))]

1
collects/mzlib/for.ss
View File

@ -29,6 +29,7 @@
stop-after
(rename *in-indexed in-indexed)
sequence?
sequence-generate
define-sequence-syntax

3
collects/mzlib/private/class-internal.ss
View File

@ -42,7 +42,8 @@
public-final override-final augment-final
rename-super rename-inner inherit inherit-field
inherit/super inherit/inner
inspect)
inspect
init-rest)
(define-syntax provide-class-define-like-keyword
(syntax-rules ()

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

@ -11,7 +11,7 @@
(class object%
(init-field dest-dir)
(define/public (get-dest-directory)
dest-dir)
@ -42,210 +42,334 @@
[else (cons (car content)
(strip-aux (cdr content)))]))
;; ----------------------------------------
;; marshal info
(define/public (get-serialize-version)
1)
(define/public (serialize-info ri)
(parameterize ([current-serialize-resolve-info ri])
(serialize (collect-info-ht (resolve-info-ci ri)))))
(define/public (deserialize-info v ci)
(let ([ht (deserialize v)]
[in-ht (collect-info-ext-ht ci)])
(hash-table-for-each ht (lambda (k v)
(hash-table-put! in-ht k v)))))
(define/public (get-defined ci)
(hash-table-map (collect-info-ht ci) (lambda (k v) k)))
(define/public (get-undefined ri)
(hash-table-map (resolve-info-undef ri) (lambda (k v) k)))
;; ----------------------------------------
;; global-info collection
(define/public (save-info fn info)
(let ([s (serialize info)])
(with-output-to-file fn
(lambda ()
(write s))
'truncate/replace)))
(define/public (load-info fn info)
(let ([ht (deserialize (with-input-from-file fn read))])
(hash-table-for-each ht (lambda (k v)
(hash-table-put! info k v))))
info)
(define/public (collect ds fns)
(let ([ht (make-hash-table 'equal)])
(map (lambda (d)
(collect-part d #f ht null))
ds)
ht))
(let ([ci (make-collect-info (make-hash-table 'equal)
(make-hash-table 'equal)
(make-hash-table)
(make-hash-table)
"")])
(start-collect ds fns ci)
ci))
(define/public (collect-part d parent ht number)
(let ([p-ht (make-hash-table 'equal)])
(define/public (start-collect ds fns ci)
(map (lambda (d)
(collect-part d #f ci null))
ds))
(define/public (collect-part d parent ci number)
(let ([p-ci (make-collect-info (make-hash-table 'equal)
(collect-info-ext-ht ci)
(collect-info-parts ci)
(collect-info-tags ci)
(if (part-tag-prefix d)
(string-append (collect-info-gen-prefix ci)
(part-tag-prefix d)
":")
(collect-info-gen-prefix ci)))])
(when (part-title-content d)
(collect-content (part-title-content d) p-ht))
(collect-part-tags d p-ht number)
(collect-content (part-to-collect d) p-ht)
(collect-flow (part-flow d) p-ht)
(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)
(let loop ([parts (part-parts d)]
[pos 1])
(unless (null? parts)
(let ([s (car parts)])
(collect-part s d p-ht
(collect-part s d p-ci
(cons (if (unnumbered-part? s)
#f
pos)
number))
(loop (cdr parts)
(if (unnumbered-part? s) pos (add1 pos))))))
(set-part-collected-info! d (make-collected-info
number
parent
p-ht))
(hash-table-for-each p-ht
(lambda (k v)
(hash-table-put! ht k v)))))
(hash-table-put! (collect-info-parts ci)
d
(make-collected-info
number
parent
(collect-info-ht p-ci)))
(let ([prefix (part-tag-prefix d)])
(hash-table-for-each (collect-info-ht p-ci)
(lambda (k v)
(when (cadr k)
(hash-table-put! (collect-info-ht ci)
(if prefix
(convert-key prefix k)
k)
v)))))))
(define/public (collect-part-tags d ht number)
(define/private (convert-key prefix k)
(case (car k)
[(part tech)
(if (string? (cadr k))
(list (car k)
(string-append prefix
":"
(cadr k)))
k)]
[(index-entry)
(let ([v (convert-key prefix (cadr k))])
(if (eq? v (cadr k))
k
(list 'index-entry v)))]
[else k]))
(define/public (collect-part-tags d ci number)
(for-each (lambda (t)
(hash-table-put! ht `(part ,t) (list (part-title-content d) number)))
(hash-table-put! (collect-info-ht ci)
(generate-tag t ci)
(list (or (part-title-content d) '("???"))
number)))
(part-tags d)))
(define/public (collect-content c ht)
(define/public (collect-content c ci)
(for-each (lambda (i)
(collect-element i ht))
(collect-element i ci))
c))
(define/public (collect-paragraph p ht)
(collect-content (paragraph-content p) ht))
(define/public (collect-paragraph p ci)
(collect-content (paragraph-content p) ci))
(define/public (collect-flow p ht)
(define/public (collect-flow p ci)
(for-each (lambda (p)
(collect-flow-element p ht))
(collect-flow-element p ci))
(flow-paragraphs p)))
(define/public (collect-flow-element p ht)
(define/public (collect-flow-element p ci)
(cond
[(table? p) (collect-table p ht)]
[(itemization? p) (collect-itemization p ht)]
[(blockquote? p) (collect-blockquote p ht)]
[(table? p) (collect-table p ci)]
[(itemization? p) (collect-itemization p ci)]
[(blockquote? p) (collect-blockquote p ci)]
[(delayed-flow-element? p) (void)]
[else (collect-paragraph p ht)]))
[else (collect-paragraph p ci)]))
(define/public (collect-table i ht)
(define/public (collect-table i ci)
(for-each (lambda (d) (when (flow? d)
(collect-flow d ht)))
(collect-flow d ci)))
(apply append (table-flowss i))))
(define/public (collect-itemization i ht)
(for-each (lambda (d) (collect-flow d ht))
(define/public (collect-itemization i ci)
(for-each (lambda (d) (collect-flow d ci))
(itemization-flows i)))
(define/public (collect-blockquote i ht)
(for-each (lambda (d) (collect-flow-element d ht))
(define/public (collect-blockquote i ci)
(for-each (lambda (d) (collect-flow-element d ci))
(blockquote-paragraphs i)))
(define/public (collect-element i ht)
(define/public (collect-element i ci)
(when (target-element? i)
(collect-target-element i ht))
(collect-target-element i ci))
(when (index-element? i)
(collect-index-element i ht))
(collect-index-element i ci))
(when (collect-element? i)
((collect-element-collect i) ci))
(when (element? i)
(for-each (lambda (e)
(collect-element e ht))
(collect-element e ci))
(element-content i))))
(define/public (collect-target-element i ht)
(hash-table-put! ht (target-element-tag i) (list i)))
(define/public (collect-target-element i ci)
(collect-put! ci
(generate-tag (target-element-tag i) ci)
(list i)))
(define/public (collect-index-element i ht)
(hash-table-put! ht `(index-entry ,(index-element-tag i))
(list (index-element-plain-seq i)
(index-element-entry-seq i))))
(define/public (collect-index-element i ci)
(collect-put! ci
`(index-entry ,(generate-tag (index-element-tag i) ci))
(list (index-element-plain-seq i)
(index-element-entry-seq i))))
(define/public (lookup part ht key)
(let ([v (hash-table-get (if part
(collected-info-info (part-collected-info part))
ht)
key
#f)])
(or v
(and part
(lookup (collected-info-parent
(part-collected-info part))
ht
key)))))
;; ----------------------------------------
;; global-info resolution
(define/public (resolve ds fns ci)
(let ([ri (make-resolve-info ci
(make-hash-table)
(make-hash-table 'equal))])
(start-resolve ds fns ri)
ri))
(define/public (start-resolve ds fns ri)
(map (lambda (d)
(resolve-part d ri))
ds))
(define/public (resolve-part d ri)
(when (part-title-content d)
(resolve-content (part-title-content d) d ri))
(resolve-flow (part-flow d) d ri)
(for-each (lambda (p)
(resolve-part p ri))
(part-parts d)))
(define/public (resolve-content c d ri)
(for-each (lambda (i)
(resolve-element i d ri))
c))
(define/public (resolve-paragraph p d ri)
(resolve-content (paragraph-content p) d ri))
(define/public (resolve-flow p d ri)
(for-each (lambda (p)
(resolve-flow-element p d ri))
(flow-paragraphs p)))
(define/public (resolve-flow-element 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)]
[(delayed-flow-element? p)
(let ([v ((delayed-flow-element-resolve p) this d ri)])
(hash-table-put! (resolve-info-delays ri) p v)
(resolve-flow-element v d ri))]
[else (resolve-paragraph p d ri)]))
(define/public (resolve-table i d ri)
(for-each (lambda (f) (when (flow? f)
(resolve-flow f d ri)))
(apply append (table-flowss i))))
(define/public (resolve-itemization i d ri)
(for-each (lambda (f) (resolve-flow f d ri))
(itemization-flows i)))
(define/public (resolve-blockquote i d ri)
(for-each (lambda (f) (resolve-flow-element f d ri))
(blockquote-paragraphs i)))
(define/public (resolve-element i d ri)
(cond
[(delayed-element? i)
(resolve-content (or (hash-table-get (resolve-info-delays ri)
i
#f)
(let ([v ((delayed-element-resolve i) this d ri)])
(hash-table-put! (resolve-info-delays ri)
i
v)
v))
d ri)]
[(element? i)
(cond
[(link-element? i)
(let-values ([(dest ext?) (resolve-get/where d ri (link-element-tag i))])
(when ext?
(hash-table-put! (resolve-info-undef ri)
(tag-key (link-element-tag i) ri)
#t)))])
(for-each (lambda (e)
(resolve-element e d ri))
(element-content i))]))
;; ----------------------------------------
;; render methods
(define/public (render ds fns ht)
(define/public (render ds fns ri)
(map (lambda (d fn)
(printf " [Output to ~a]\n" fn)
(with-output-to-file fn
(lambda ()
(render-one d ht fn))
(render-one d ri fn))
'truncate/replace))
ds
fns))
(define/public (render-one d ht fn)
(render-part d ht))
(define/public (render-one d ri fn)
(render-part d ri))
(define/public (render-part d ht)
(define/public (render-part d ri)
(list
(when (part-title-content d)
(render-content (part-title-content d) d ht))
(render-flow (part-flow d) d ht)
(map (lambda (s) (render-part s ht))
(render-content (part-title-content d) d ri))
(render-flow (part-flow d) d ri)
(map (lambda (s) (render-part s ri))
(part-parts d))))
(define/public (render-content c part ht)
(define/public (render-content c part ri)
(apply append
(map (lambda (i)
(render-element i part ht))
(render-element i part ri))
c)))
(define/public (render-paragraph p part ht)
(render-content (paragraph-content p) part ht))
(define/public (render-paragraph p part ri)
(render-content (paragraph-content p) part ri))
(define/public (render-flow p part ht)
(define/public (render-flow p part ri)
(apply append
(map (lambda (p)
(render-flow-element p part ht))
(render-flow-element p part ri))
(flow-paragraphs p))))
(define/public (render-flow-element p part ht)
(define/public (render-flow-element p part ri)
(cond
[(table? p) (if (auxiliary-table? p)
(render-auxiliary-table p part ht)
(render-table p part ht))]
[(itemization? p) (render-itemization p part ht)]
[(blockquote? p) (render-blockquote p part ht)]
[(delayed-flow-element? p) (render-flow-element
((delayed-flow-element-render p) this part ht)
part ht)]
[else (render-paragraph p part ht)]))
(render-auxiliary-table p part ri)
(render-table p part ri))]
[(itemization? p) (render-itemization p part ri)]
[(blockquote? p) (render-blockquote p part ri)]
[(delayed-flow-element? p)
(render-flow-element (delayed-flow-element-flow-elements p ri) part ri)]
[else (render-paragraph p part ri)]))
(define/public (render-auxiliary-table i part ht)
(define/public (render-auxiliary-table i part ri)
null)
(define/public (render-table i part ht)
(define/public (render-table i part ri)
(map (lambda (d) (if (flow? i)
(render-flow d part ht)
(render-flow d part ri)
null))
(apply append (table-flowss i))))
(define/public (render-itemization i part ht)
(map (lambda (d) (render-flow d part ht))
(define/public (render-itemization i part ri)
(map (lambda (d) (render-flow d part ri))
(itemization-flows i)))
(define/public (render-blockquote i part ht)
(map (lambda (d) (render-flow-element d part ht))
(define/public (render-blockquote i part ri)
(map (lambda (d) (render-flow-element d part ri))
(blockquote-paragraphs i)))
(define/public (render-element i part ht)
(define/public (render-element i part ri)
(cond
[(and (link-element? i)
(null? (element-content i)))
(let ([v (lookup part ht (link-element-tag i))])
(let ([v (resolve-get part ri (link-element-tag i))])
(if v
(render-content (strip-aux (car v)) part ht)
(render-content (list "[missing]") part ht)))]
(render-content (strip-aux (car v)) part ri)
(render-content (list "[missing]") part ri)))]
[(element? i)
(render-content (element-content i) part ht)]
(render-content (element-content i) part ri)]
[(delayed-element? i)
(render-content (force-delayed-element i this part ht) part ht)]
(render-content (delayed-element-content i ri) part ri)]
[else
(render-other i part ht)]))
(render-other i part ri)]))
(define/public (render-other i part ht)
(define/public (render-other i part ri)
(list i))
;; ----------------------------------------
@ -280,34 +404,32 @@
;; ----------------------------------------
(define/private (do-table-of-contents part ht delta quiet)
(make-table #f (render-toc part
(+ delta
(length (collected-info-number
(part-collected-info part))))
#t
quiet)))
(define/private (do-table-of-contents part ri delta quiet)
(make-table #f (generate-toc part
ri
(+ delta
(length (collected-info-number
(part-collected-info part ri))))
#t
quiet)))
(define/public (table-of-contents part ht)
(do-table-of-contents part ht -1 not))
(define/public (table-of-contents part ri)
(do-table-of-contents part ri -1 not))
(define/public (local-table-of-contents part ht)
(table-of-contents part ht))
(define/public (local-table-of-contents part ri)
(table-of-contents part ri))
(define/public (quiet-table-of-contents part ht)
(do-table-of-contents part ht 1 (lambda (x) #t)))
(define/public (quiet-table-of-contents part ri)
(do-table-of-contents part ri 1 (lambda (x) #t)))
(define/private (render-toc part base-len skip? quiet)
(let ([number (collected-info-number (part-collected-info part))])
(define/private (generate-toc part ri base-len skip? quiet)
(let ([number (collected-info-number (part-collected-info part ri))])
(let ([subs
(if (quiet (and (styled-part? part)
(let ([st(styled-part-style part)])
(or (eq? 'quiet st)
(and (list? st) (memq 'quiet st))))
(if (quiet (and (part-style? part 'quiet)
(not (= base-len (sub1 (length number))))))
(apply
append
(map (lambda (p) (render-toc p base-len #f quiet)) (part-parts part)))
(map (lambda (p) (generate-toc p ri base-len #f quiet)) (part-parts part)))
null)])
(if skip?
subs
@ -324,8 +446,8 @@
(format-number number
(list
(make-element 'hspace '(" "))))
(part-title-content part))
`(part ,(car (part-tags part)))))))))
(or (part-title-content part) '("???")))
(car (part-tags part))))))))
subs)])
(if (and (= 1 (length number))
(or (not (car number))

81
collects/scribble/basic.ss
View File

@ -4,7 +4,9 @@
"struct.ss"
"config.ss"
(lib "list.ss")
(lib "class.ss"))
(lib "class.ss")
(lib "main-collects.ss" "setup")
(lib "modresolve.ss" "syntax"))
(provide title
section
@ -18,21 +20,41 @@
(content->string content)
"_"))
(define (title #:tag [tag #f] #:style [style #f] . str)
(define (prefix->string p)
(and p
(if (string? p)
p
(module-path-prefix->string p))))
(define (title #:tag [tag #f] #:tag-prefix [prefix #f] #:style [style #f] . str)
(let ([content (decode-content str)])
(make-title-decl (or tag (gen-tag content)) style content)))
(make-title-decl (prefix->string prefix)
`((part ,(or tag (gen-tag content))))
style
content)))
(define (section #:tag [tag #f] #:style [style #f] . str)
(define (section #:tag [tag #f] #:tag-prefix [prefix #f] #:style [style #f] . str)
(let ([content (decode-content str)])
(make-part-start 0 (or tag (gen-tag content)) style content)))
(make-part-start 0 (prefix->string prefix)
`((part ,(or tag (gen-tag content))))
style
content)))
(define (subsection #:tag [tag #f] . str)
(define (subsection #:tag [tag #f] #:tag-prefix [prefix #f] . str)
(let ([content (decode-content str)])
(make-part-start 1 (or tag (gen-tag content)) #f content)))
(make-part-start 1
(prefix->string prefix)
`((part ,(or tag (gen-tag content))))
#f
content)))
(define (subsubsection #:tag [tag #f] . str)
(define (subsubsection #:tag [tag #f] #:tag-prefix [prefix #f] . str)
(let ([content (decode-content str)])
(make-part-start 2 (or tag (gen-tag content)) #f content)))
(make-part-start 2
(prefix->string prefix)
`((part ,(or tag (gen-tag content))))
#f
content)))
(define (subsubsub*section #:tag [tag #f] . str)
(let ([content (decode-content str)])
@ -47,6 +69,14 @@
;; ----------------------------------------
(provide module-path-prefix->string)
(define (module-path-prefix->string p)
(format "~a" (path->main-collects-relative
(resolve-module-path p #f))))
;; ----------------------------------------
(provide itemize item item?)
(define (itemize . items)
@ -124,19 +154,16 @@
(define (section-index . elems)
(make-part-index-decl (map element->string elems) elems))
(define (gen-target)
(format "index:~s:~s" (current-inexact-milliseconds) (gensym)))
(define (record-index word-seq element-seq tag content)
(make-index-element
#f
(list (make-target-element #f content tag))
tag
(list (make-target-element #f content `(idx ,tag)))
`(idx ,tag)
word-seq
element-seq))
(define (index* word-seq content-seq . s)
(let ([key (gen-target)])
(let ([key (make-generated-tag)])
(record-index word-seq
content-seq
key
@ -149,7 +176,7 @@
(apply index* word-seq word-seq s)))
(define (as-index . s)
(let ([key (gen-target)]
(let ([key (make-generated-tag)]
[content (decode-content s)])
(record-index (list (content->string content))
(list (make-element #f content))
@ -158,18 +185,21 @@
(define (index-section tag)
(make-unnumbered-part
(and tag (list tag))
(list "Index")
#f
`((part , (or tag
(make-generated-tag))))
'("Index")
'index
null
(make-flow (list (make-delayed-flow-element
(lambda (renderer sec ht)
(lambda (renderer sec ri)
(let ([l null])
(hash-table-for-each
(collected-info-info
(part-collected-info
(collected-info-parent
(part-collected-info sec))))
(part-collected-info sec ri))
ri))
(lambda (k v)
(if (and (pair? k)
(eq? 'index-entry (car k)))
@ -204,8 +234,7 @@
(commas (caddr i))
(car i))))))))
l))))))))
null
'index))
null))
;; ----------------------------------------
@ -214,13 +243,13 @@
(define (table-of-contents)
(make-delayed-flow-element
(lambda (renderer part ht)
(send renderer table-of-contents part ht))))
(lambda (renderer part ri)
(send renderer table-of-contents part ri))))
(define (local-table-of-contents)
(make-delayed-flow-element
(lambda (renderer part ht)
(send renderer local-table-of-contents part ht)))))
(lambda (renderer part ri)
(send renderer local-table-of-contents part ri)))))

184
collects/scribble/decode.ss
View File

@ -13,16 +13,19 @@
whitespace?)
(provide-structs
[title-decl ([tag any/c]
[title-decl ([tag-prefix (or/c false/c string?)]
[tags (listof tag?)]
[style any/c]
[content list?])]
[part-start ([depth integer?]
[tag (or/c false/c string?)]
[tag-prefix (or/c false/c string?)]
[tags (listof tag?)]
[style any/c]
[title list?])]
[splice ([run list?])]
[part-index-decl ([plain-seq (listof string?)]
[entry-seq list?])])
[entry-seq list?])]
[part-collect-decl ([element element?])])
(define (decode-string s)
(let loop ([l '((#rx"---" mdash)
@ -52,39 +55,42 @@
null
(list (decode-paragraph (reverse (skip-whitespace accum))))))
(define (decode-flow* l keys tag style title part-depth)
(let loop ([l l][next? #f][keys keys][accum null][title title][tag tag][style style])
(define (decode-flow* l keys colls tag-prefix tags style title part-depth)
(let loop ([l l][next? #f][keys keys][colls colls][accum null][title title][tag-prefix tag-prefix][tags tags][style style])
(cond
[(null? l)
(let ([tags (map (lambda (k)
(format "secindex:~a:~a" (current-inexact-milliseconds) (gensym)))
keys)]
[tag (or tag (format "sec:~a:~a" (current-inexact-milliseconds) (gensym)))])
(make-styled-part (cons tag
tags)
title
#f
(let ([l (map (lambda (k tag)
(make-index-element
#f
null
`(part ,tag)
(part-index-decl-plain-seq k)
(part-index-decl-entry-seq k)))
keys tags)])
(if title
(cons (make-index-element
#f
null
`(part ,tag)
(list (regexp-replace #px"^(?:A|An|The)\\s" (content->string title)
""))
(list (make-element #f title)))
l)
l))
(make-flow (decode-accum-para accum))
null
style))]
(let ([k-tags (map (lambda (k)
`(idx ,(make-generated-tag)))
keys)]
[tags (if (null? tags)
(list `(part ,(make-generated-tag)))
tags)])
(make-part tag-prefix
(append tags k-tags)
title
style
(let ([l (map (lambda (k tag)
(make-index-element
#f
null
tag
(part-index-decl-plain-seq k)
(part-index-decl-entry-seq k)))
keys k-tags)])
(append
(if title
(cons (make-index-element
#f
null
(car tags)
(list (regexp-replace #px"^(?:A|An|The)\\s" (content->string title)
""))
(list (make-element #f title)))
l)
l)
colls))
(make-flow (decode-accum-para accum))
null))]
[(title-decl? (car l))
(unless part-depth
(error 'decode
@ -94,34 +100,35 @@
(error 'decode
"found extra title: ~v"
(car l)))
(loop (cdr l) next? keys accum
(loop (cdr l) next? keys colls accum
(title-decl-content (car l))
(title-decl-tag (car l))
(title-decl-tag-prefix (car l))
(title-decl-tags (car l))
(title-decl-style (car l)))]
[(flow-element? (car l))
(let ([para (decode-accum-para accum)]
[part (decode-flow* (cdr l) keys tag style title part-depth)])
(make-styled-part (part-tags part)
(part-title-content part)
(part-collected-info part)
(part-to-collect part)
(make-flow (append para
(list (car l))
(flow-paragraphs (part-flow part))))
(part-parts part)
(styled-part-style part)))]
[part (decode-flow* (cdr l) keys colls tag-prefix tags style title part-depth)])
(make-part (part-tag-prefix part)
(part-tags part)
(part-title-content part)
(part-style part)
(part-to-collect part)
(make-flow (append para
(list (car l))
(flow-paragraphs (part-flow part))))
(part-parts part)))]
[(part? (car l))
(let ([para (decode-accum-para accum)]
[part (decode-flow* (cdr l) keys tag style title part-depth)])
(make-styled-part (part-tags part)
(part-title-content part)
(part-collected-info part)
(part-to-collect part)
(make-flow (append para
(flow-paragraphs
(part-flow part))))
(cons (car l) (part-parts part))
(styled-part-style part)))]
[part (decode-flow* (cdr l) keys colls tag-prefix tags style title part-depth)])
(make-part (part-tag-prefix part)
(part-tags part)
(part-title-content part)
(part-style part)
(part-to-collect part)
(make-flow (append para
(flow-paragraphs
(part-flow part))))
(cons (car l) (part-parts part))))]
[(and (part-start? (car l))
(or (not part-depth)
((part-start-depth (car l)) . <= . part-depth)))
@ -138,54 +145,57 @@
(part? (car l))))
(let ([para (decode-accum-para accum)]
[s (decode-styled-part (reverse s-accum)
(part-start-tag s)
(part-start-tag-prefix s)
(part-start-tags s)
(part-start-style s)
(part-start-title s)
(add1 part-depth))]
[part (decode-flow* l keys tag style title part-depth)])
(make-styled-part (part-tags part)
(part-title-content part)
(part-collected-info part)
(part-to-collect part)
(make-flow para)
(cons s (part-parts part))
(styled-part-style part)))
[part (decode-flow* l keys colls tag-prefix tags style title part-depth)])
(make-part (part-tag-prefix part)
(part-tags part)
(part-title-content part)
(part-style part)
(part-to-collect part)
(make-flow para)
(cons s (part-parts part))))
(if (splice? (car l))
(loop (append (splice-run (car l)) (cdr l)) s-accum)
(loop (cdr l) (cons (car l) s-accum))))))]
[(splice? (car l))
(loop (append (splice-run (car l)) (cdr l)) next? keys accum title tag style)]
[(null? (cdr l)) (loop null #f keys (cons (car l) accum) title tag style)]
(loop (append (splice-run (car l)) (cdr l)) next? keys colls accum title tag-prefix tags style)]
[(null? (cdr l)) (loop null #f keys colls (cons (car l) accum) title tag-prefix tags style)]
[(part-index-decl? (car l))
(loop (cdr l) next? (cons (car l) keys) accum title tag style)]
(loop (cdr l) next? (cons (car l) keys) colls accum title tag-prefix tags style)]
[(part-collect-decl? (car l))
(loop (cdr l) next? keys (cons (part-collect-decl-element (car l)) colls) accum title tag-prefix tags style)]
[(and (pair? (cdr l))
(splice? (cadr l)))
(loop (cons (car l) (append (splice-run (cadr l)) (cddr l))) next? keys accum title tag style)]
(loop (cons (car l) (append (splice-run (cadr l)) (cddr l))) next? keys colls accum title tag-prefix tags style)]
[(line-break? (car l))
(if next?
(loop (cdr l) #t keys accum title tag style)
(loop (cdr l) #t keys colls accum title tag-prefix tags style)
(let ([m (match-newline-whitespace (cdr l))])
(if m
(let ([part (loop m #t keys null title tag style)])
(make-styled-part (part-tags part)
(part-title-content part)
(part-collected-info part)
(part-to-collect part)
(make-flow (append (decode-accum-para accum)
(flow-paragraphs (part-flow part))))
(part-parts part)
(styled-part-style part)))
(loop (cdr l) #f keys (cons (car l) accum) title tag style))))]
[else (loop (cdr l) #f keys (cons (car l) accum) title tag style)])))
(let ([part (loop m #t keys colls null title tag-prefix tags style)])
(make-part (part-tag-prefix part)
(part-tags part)
(part-title-content part)
(part-style part)
(part-to-collect part)
(make-flow (append (decode-accum-para accum)
(flow-paragraphs (part-flow part))))
(part-parts part)))
(loop (cdr l) #f keys colls (cons (car l) accum) title tag-prefix tags style))))]
[else (loop (cdr l) #f keys colls (cons (car l) accum) title tag-prefix tags style)])))
(define (decode-part l tag title depth)
(decode-flow* l null tag #f title depth))
(define (decode-part l tags title depth)
(decode-flow* l null null #f tags #f title depth))
(define (decode-styled-part l tag style title depth)
(decode-flow* l null tag style title depth))
(define (decode-styled-part l tag-prefix tags style title depth)
(decode-flow* l null null tag-prefix tags style title depth))
(define (decode-flow l)
(part-flow (decode-flow* l null #f #f #f #f)))
(part-flow (decode-flow* l null null #f null #f #f #f)))
(define (match-newline-whitespace l)
(cond
@ -207,7 +217,7 @@
(loop (cdr l)))))
(define (decode l)
(decode-part l #f #f 0))
(decode-part l null #f 0))
(define (decode-paragraph l)
(make-paragraph

2
collects/scribble/defreader.ss
View File

@ -19,6 +19,6 @@
(string->symbol (path->string (path-replace-suffix name #""))))
'page)]
[id 'doc])
`(module ,name mzscheme
`(module ,name (lib "lang.ss" "big")
. ,body))))

4
collects/scribble/doclang.ss
View File

@ -43,7 +43,8 @@
(kernel-form-identifier-list #'here)
(syntax->list #'(provide
require
require-for-syntax))))])
require-for-syntax
require-for-label))))])
(syntax-case expanded (begin)
[(begin body1 ...)
#`(doc-begin m-id exprs body1 ... . body)]
@ -53,6 +54,7 @@
(syntax->list #'(require
provide
require-for-syntax
require-for-label
define-values
define-syntaxes
define-for-syntaxes))))

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

@ -5,6 +5,8 @@
(lib "file.ss")
(lib "list.ss")
(lib "runtime-path.ss")
(lib "main-doc.ss" "setup")
(lib "main-collects.ss" "setup")
(prefix xml: (lib "xml.ss" "xml")))
(provide render-mixin
render-multi-mixin)
@ -15,12 +17,25 @@
(define current-subdirectory (make-parameter #f))
(define current-output-file (make-parameter #f))
(define current-top-part (make-parameter #f))
(define on-separate-page (make-parameter #t))
(define next-separate-page (make-parameter #f))
(define collecting-sub (make-parameter 0))
(define current-no-links (make-parameter #f))
(define extra-breaking? (make-parameter #f))
(define (path->relative p)
(let ([p (path->main-doc-relative p)])
(if (path? p)
(path->main-collects-relative p)
p)))
(define (relative->path p)
(let ([p (main-doc-relative->path p)])
(if (path? p)
p
(main-collects-relative->path p))))
;; ----------------------------------------
;; main mixin
@ -33,58 +48,57 @@
get-dest-directory
format-number
strip-aux
lookup
quiet-table-of-contents)
(define/override (get-suffix) #".html")
;; ----------------------------------------
(define/override (collect ds fns)
(let ([ht (make-hash-table 'equal)])
(map (lambda (d fn)
(parameterize ([current-output-file fn])
(collect-part d #f ht null)))
ds
fns)
ht))
(define/override (start-collect ds fns ci)
(map (lambda (d fn)
(parameterize ([current-output-file fn]
[current-top-part d])
(collect-part d #f ci null)))
ds
fns))
(define/public (part-whole-page? p ht)
(let ([dest (lookup p ht `(part ,(car (part-tags p))))])
(define/public (part-whole-page? p ri)
(let ([dest (resolve-get p ri (car (part-tags p)))])
(caddr dest)))
(define/public (current-part-whole-page?)
#f)
(define/public (current-part-whole-page? d)
(eq? d (current-top-part)))
(define/override (collect-part-tags d ht number)
(define/override (collect-part-tags d ci number)
(for-each (lambda (t)
(hash-table-put! ht
`(part ,t)
(list (current-output-file)
(part-title-content d)
(current-part-whole-page?))))
(let ([key (generate-tag t ci)])
(collect-put! ci
key
(list (path->relative (current-output-file))
(or (part-title-content d)
'("???"))
(current-part-whole-page? d)
(format "~a" key)))))
(part-tags d)))
(define/override (collect-target-element i ht)
(hash-table-put! ht
(target-element-tag i)
(list (current-output-file)
#f
(page-target-element? i))))
(define/override (collect-target-element i ci)
(let ([key (generate-tag (target-element-tag i) ci)])
(collect-put! ci
key
(list (path->relative (current-output-file))
#f
(page-target-element? i)
(format "~a" key)))))
;; ----------------------------------------
(define/private (reveal-subparts? p)
(and (styled-part? p)
(let ([s (styled-part-style p)])
(or (eq? s 'reveal)
(and (list? s)
(memq 'reveal s))))))
(define/public (render-toc-view d ht)
(part-style? p 'reveal))
(define/public (render-toc-view d ri)
(let-values ([(top mine)
(let loop ([d d][mine d])
(let ([p (collected-info-parent (part-collected-info d))])
(let ([p (collected-info-parent (part-collected-info d ri))])
(if p
(loop p (if (reveal-subparts? d)
mine
@ -95,7 +109,7 @@
(div ((class "tocviewtitle"))
(a ((href "index.html")
(class "tocviewlink"))
,@(render-content (part-title-content top) d ht)))
,@(render-content (or (part-title-content top) '("???")) d ri)))
(div nbsp)
(table
((class "tocviewlist")
@ -107,24 +121,24 @@
(td
((align "right"))
,@(if show-number?
(format-number (collected-info-number (part-collected-info p))
(format-number (collected-info-number (part-collected-info p ri))
'((tt nbsp)))
'("-" nbsp)))
(td
(a ((href ,(let ([dest (lookup p ht `(part ,(car (part-tags p))))])
(a ((href ,(let ([dest (resolve-get p ri (car (part-tags p)))])
(format "~a~a~a"
(from-root (car dest)
(from-root (relative->path (car dest))
(get-dest-directory))
(if (caddr dest)
""
"#")
(if (caddr dest)
""
`(part ,(car (part-tags p)))))))
(cadddr dest)))))
(class ,(if (eq? p mine)
"tocviewselflink"
"tocviewlink")))
,@(render-content (part-title-content p) d ht))))))
,@(render-content (or (part-title-content p) '("???")) d ri))))))
(let loop ([l (map (lambda (v) (cons v #t)) (part-parts top))])
(cond
[(null? l) null]
@ -133,92 +147,101 @@
(part-parts (caar l)))
(cdr l))))]
[else (cons (car l) (loop (cdr l)))])))))
,@(if (ormap (lambda (p) (part-whole-page? p ht)) (part-parts d))
null
(let ([ps (cdr
(let flatten ([d d])
(cons d
(apply
append
(letrec ([flow-targets
(lambda (flow)
(apply append (map flow-element-targets (flow-paragraphs flow))))]
[flow-element-targets
(lambda (e)
(cond
[(table? e) (table-targets e)]
[(paragraph? e) (para-targets e)]
[(itemization? e)
(apply append (map flow-targets (itemization-flows e)))]
[(blockquote? e)
(apply append (map flow-element-targets (blockquote-paragraphs e)))]
[(delayed-flow-element? e)
null]))]
[para-targets
(lambda (para)
(let loop ([c (paragraph-content para)])
(cond
[(empty? c) null]
[else (let ([a (car c)])
(cond
[(toc-target-element? a)
(cons a (loop (cdr c)))]
[(element? a)
(append (loop (element-content a))
(loop (cdr c)))]
[(delayed-element? a)
(loop (cons (force-delayed-element a this d ht)
(cdr c)))]
[else
(loop (cdr c))]))])))]
[table-targets
(lambda (table)
(apply append
(map (lambda (flows)
(apply append (map (lambda (f)
(if (eq? f 'cont)
null
(flow-targets f)))
flows)))
(table-flowss table))))])
(apply append (map flow-element-targets (flow-paragraphs (part-flow d)))))
(map flatten (part-parts d))))))])
(if (null? ps)
null
`((div ((class "tocsub"))
(div ((class "tocsubtitle"))
"On this page:")
(table
((class "tocsublist")
(cellspacing "0"))
,@(map (lambda (p)
(parameterize ([current-no-links #t]
[extra-breaking? #t])
`(tr
(td
,@(if (part? p)
`((span ((class "tocsublinknumber"))
,@(format-number (collected-info-number (part-collected-info p))
'((tt nbsp)))))
'(""))
(a ((href ,(if (part? p)
(let ([dest (lookup p ht `(part ,(car (part-tags p))))])
(format "#~a"
`(part ,(car (part-tags p)))))
(format "#~a" (target-element-tag p))))
(class ,(if (part? p)
"tocsubseclink"
"tocsublink")))
,@(if (part? p)
(render-content (part-title-content p) d ht)
(render-content (element-content p) d ht)))))))
ps)))))))
,@(render-onthispage-contents d ri top)
,@(apply append
(map (lambda (t)
(render-table t d ht))
(render-table t d ri))
(filter auxiliary-table? (flow-paragraphs (part-flow d)))))))))
(define/public (render-one-part d ht fn number)
(define/private (render-onthispage-contents d ri top)
(if (ormap (lambda (p) (part-whole-page? p ri))
(part-parts d))
null
(let* ([nearly-top? (lambda (d)
(eq? top (collected-info-parent (part-collected-info d ri))))]
[ps ((if (nearly-top? d) values cdr)
(let flatten ([d d])
(apply
append
;; don't include the section if it's in the TOC
(if (nearly-top? d)
null
(list d))
;; get internal targets:
(letrec ([flow-targets
(lambda (flow)
(apply append (map flow-element-targets (flow-paragraphs flow))))]
[flow-element-targets
(lambda (e)
(cond
[(table? e) (table-targets e)]
[(paragraph? e) (para-targets e)]
[(itemization? e)
(apply append (map flow-targets (itemization-flows e)))]
[(blockquote? e)
(apply append (map flow-element-targets (blockquote-paragraphs e)))]
[(delayed-flow-element? e)
null]))]
[para-targets
(lambda (para)
(let loop ([c (paragraph-content para)])
(cond
[(empty? c) null]
[else (let ([a (car c)])
(cond
[(toc-target-element? a)
(cons a (loop (cdr c)))]
[(element? a)
(append (loop (element-content a))
(loop (cdr c)))]
[(delayed-element? a)
(loop (cons (delayed-element-content a ri)
(cdr c)))]
[else
(loop (cdr c))]))])))]
[table-targets
(lambda (table)
(apply append
(map (lambda (flows)
(apply append (map (lambda (f)
(if (eq? f 'cont)
null
(flow-targets f)))
flows)))
(table-flowss table))))])
(apply append (map flow-element-targets (flow-paragraphs (part-flow d)))))
(map flatten (part-parts d)))))])
(if (null? ps)
null
`((div ((class "tocsub"))
(div ((class "tocsubtitle"))
"On this page:")
(table
((class "tocsublist")
(cellspacing "0"))
,@(map (lambda (p)
(parameterize ([current-no-links #t]
[extra-breaking? #t])
`(tr
(td
,@(if (part? p)
`((span ((class "tocsublinknumber"))
,@(format-number (collected-info-number
(part-collected-info p ri))
'((tt nbsp)))))
'(""))
(a ((href ,(if (part? p)
(format "#~a" (tag-key (car (part-tags p)) ri))
(format "#~a" (tag-key (target-element-tag p) ri))))
(class ,(if (part? p)
"tocsubseclink"
"tocsublink")))
,@(if (part? p)
(render-content (or (part-title-content p) '("???")) d ri)
(render-content (element-content p) d ri)))))))
ps))))))))
(define/public (render-one-part d ri fn number)
(parameterize ([current-output-file fn])
(let ([xpr `(html ()
(head
@ -226,32 +249,28 @@
(content "text-html; charset=utf-8")))
,@(let ([c (part-title-content d)])
(if c
`((title ,@(format-number number '(nbsp)) ,(content->string c this d ht)))
`((title ,@(format-number number '(nbsp)) ,(content->string c this d ri)))
null))
(link ((rel "stylesheet")
(type "text/css")
(href "scribble.css")
(title "default"))))
(body ,@(render-toc-view d ht)
(div ((class "main")) ,@(render-part d ht))))])
(body ,@(render-toc-view d ri)
(div ((class "main")) ,@(render-part d ri))))])
(install-file scribble-css)
(xml:write-xml/content (xml:xexpr->xml xpr)))))
(define/override (render-one d ht fn)
(render-one-part d ht fn null))
(define/override (render-one d ri fn)
(render-one-part d ri fn null))
(define/override (render-part d ht)
(let ([number (collected-info-number (part-collected-info d))])
(define/override (render-part d ri)
(let ([number (collected-info-number (part-collected-info d ri))])
`(,@(if (and (not (part-title-content d))
(null? number))
null
(if (and (styled-part? d)
(let ([s (styled-part-style d)])
(or (eq? s 'hidden)
(and (list? s)
(memq 'hidden s)))))
(if (part-style? d 'hidden)
(map (lambda (t)
`(a ((name ,(format "~a" `(part ,t))))))
`(a ((name ,(format "~a" (tag-key t ri))))))
(part-tags d))
`((,(case (length number)
[(0) 'h2]
@ -260,21 +279,21 @@
[else 'h5])
,@(format-number number '((tt nbsp)))
,@(map (lambda (t)
`(a ((name ,(format "~a" `(part ,t))))))
`(a ((name ,(format "~a" (tag-key t ri))))))
(part-tags d))
,@(if (part-title-content d)
(render-content (part-title-content d) d ht)
(render-content (part-title-content d) d ri)
null)))))
,@(render-flow* (part-flow d) d ht #f)
,@(render-flow* (part-flow d) d ri #f)
,@(let loop ([pos 1]
[secs (part-parts d)])
(if (null? secs)
null
(append
(render-part (car secs) ht)
(render-part (car secs) ri)
(loop (add1 pos) (cdr secs))))))))
(define/private (render-flow* p part ht special-last?)
(define/private (render-flow* p part ri special-last?)
;; Wrap each table with <p>, except for a trailing table
;; when `special-last?' is #t
(let loop ([f (flow-paragraphs p)])
@ -283,71 +302,78 @@
[(and (table? (car f))
(or (not special-last?)
(not (null? (cdr f)))))
(cons `(p ,@(render-flow-element (car f) part ht))
(cons `(p ,@(render-flow-element (car f) part ri))
(loop (cdr f)))]
[else
(append (render-flow-element (car f) part ht)
(append (render-flow-element (car f) part ri)
(loop (cdr f)))])))
(define/override (render-flow p part ht)
(render-flow* p part ht #t))
(define/override (render-flow p part ri)
(render-flow* p part ri #t))
(define/override (render-paragraph p part ht)
(define/override (render-paragraph p part ri)
`((p ,@(if (styled-paragraph? p)
`(((class ,(styled-paragraph-style p))))
null)
,@(super render-paragraph p part ht))))
,@(super render-paragraph p part ri))))
(define/override (render-element e part ht)
(define/override (render-element e part ri)
(cond
[(hover-element? e)
`((span ((title ,(hover-element-text e))) ,@(render-plain-element e part ri)))]
[(target-element? e)
`((a ((name ,(target-element-tag e))))
,@(render-plain-element e part ht))]
`((a ((name ,(format "~a" (tag-key (target-element-tag e) ri)))))
,@(render-plain-element e part ri))]
[(and (link-element? e)
(not (current-no-links)))
(parameterize ([current-no-links #t])
(let ([dest (lookup part ht (link-element-tag e))])
(let ([dest (resolve-get part ri (link-element-tag e))])
(if dest
`((a ((href ,(format "~a~a~a"
(from-root (car dest)
(from-root (relative->path (car dest))
(get-dest-directory))
(if (caddr dest)
""
"#")
(if (caddr dest)
""
(link-element-tag e))))
(cadddr dest))))
,@(if (string? (element-style e))
`((class ,(element-style e)))
null))
,@(if (null? (element-content e))
(render-content (strip-aux (cadr dest)) part ht)
(render-content (element-content e) part ht))))
(begin (fprintf (current-error-port) "Undefined link: ~s~n" (link-element-tag e)) ; XXX Add source info
`((font ((class "badlink"))
,@(if (null? (element-content e))
`(,(format "~s" (link-element-tag e)))
(render-plain-element e part ht))))))))]
[else (render-plain-element e part ht)]))
(render-content (strip-aux (cadr dest)) part ri)
(render-content (element-content e) part ri))))
(begin
(when #f
(fprintf (current-error-port)
"Undefined link: ~s~n"
(tag-key (link-element-tag e) ri)))
`((font ((class "badlink"))
,@(if (null? (element-content e))
`(,(format "~s" (tag-key (link-element-tag e) ri)))
(render-plain-element e part ri))))))))]
[else (render-plain-element e part ri)]))
(define/private (render-plain-element e part ht)
(define/private (render-plain-element e part ri)
(let ([style (and (element? e)
(element-style e))])
(cond
[(symbol? style)
(case style
[(italic) `((i ,@(super render-element e part ht)))]
[(bold) `((b ,@(super render-element e part ht)))]
[(tt) `((tt ,@(super render-element e part ht)))]
[(sf) `((b (font ([size "-1"][face "Helvetica"]) ,@(super render-element e part ht))))]
[(subscript) `((sub ,@(super render-element e part ht)))]
[(superscript) `((sup ,@(super render-element e part ht)))]
[(italic) `((i ,@(super render-element e part ri)))]
[(bold) `((b ,@(super render-element e part ri)))]
[(tt) `((tt ,@(super render-element e part ri)))]
[(no-break) `((span ([class "nobreak"]) ,@(super render-element e part ri)))]
[(sf) `((b (font ([size "-1"][face "Helvetica"]) ,@(super render-element e part ri))))]
[(subscript) `((sub ,@(super render-element e part ri)))]
[(superscript) `((sup ,@(super render-element e part ri)))]
[(hspace) `((span ([class "hspace"])
,@(let ([str (content->string (element-content e))])
(map (lambda (c) 'nbsp) (string->list str)))))]
[else (error 'html-render "unrecognized style symbol: ~e" style)])]
[(string? style)
`((span ([class ,style]) ,@(super render-element e part ht)))]
`((span ([class ,style]) ,@(super render-element e part ri)))]
[(and (pair? style)
(eq? (car style) 'show-color))
`((font ((style ,(format "background-color: ~a"
@ -357,16 +383,16 @@
(cdr style))))))
(tt nbsp nbsp nbsp nbsp nbsp))
nbsp
,@(super render-element e part ht))]
,@(super render-element e part ri))]
[(target-url? style)
(if (current-no-links)
(super render-element e part ht)
(super render-element e part ri)
(parameterize ([current-no-links #t])
`((a ((href ,(target-url-addr style))) ,@(super render-element e part ht)))))]
`((a ((href ,(target-url-addr style))) ,@(super render-element e part ri)))))]
[(image-file? style) `((img ((src ,(install-file (image-file-path style))))))]
[else (super render-element e part ht)])))
[else (super render-element e part ri)])))
(define/override (render-table t part ht)
(define/override (render-table t part ri)
`((table ((cellspacing "0")
,@(case (table-style t)
[(boxed) '((class "boxed"))]
@ -423,36 +449,36 @@
[(eq? 'cont (car ds)) (loop (+ n 1) (cdr ds))]
[else n])))))
null))
,@(render-flow d part ht))
,@(render-flow d part ri))
(loop (cdr ds) (cdr as) (cdr vas)))))))))
(table-flowss t)
(cdr (or (and (list? (table-style t))
(assoc 'row-styles (or (table-style t) null)))
(cons #f (map (lambda (x) #f) (table-flowss t)))))))))
(define/override (render-blockquote t part ht)
(define/override (render-blockquote t part ri)
`((blockquote ,@(if (string? (blockquote-style t))
`(((class ,(blockquote-style t))))
null)
,@(apply append
(map (lambda (i)
(render-flow-element i part ht))
(render-flow-element i part ri))
(blockquote-paragraphs t))))))
(define/override (render-itemization t part ht)
(define/override (render-itemization t part ri)
`((ul
,@(map (lambda (flow)
`(li ,@(render-flow flow part ht)))
`(li ,@(render-flow flow part ri)))
(itemization-flows t)))))
(define/override (render-other i part ht)
(define/override (render-other i part ri)
(cond
[(string? i) (let ([m (and (extra-breaking?)
(regexp-match-positions #rx":" i))])
(if m
(list* (substring i 0 (cdar m))
`(span ((class "mywbr")) " ")
(render-other (substring i (cdar m)) part ht))
(render-other (substring i (cdar m)) part ri))
(list i)))]
[(eq? i 'mdash) `(" " ndash " ")]
[(eq? i 'hline) `((hr))]
@ -470,7 +496,9 @@
(class %
(inherit render-one
render-one-part
render-content)
render-content
part-whole-page?
format-number)
(define/override (get-suffix) #"")
@ -479,10 +507,16 @@
(current-subdirectory))
(super get-dest-directory)))
(define/private (derive-filename d ht)
(define/private (derive-filename d)
(let ([fn (format "~a.html" (regexp-replace*
"[^-a-zA-Z0-9_=]"
(format "~a" (car (part-tags d)))
(let ([s (cadr (car (part-tags d)))])
(if (string? s)
s
(if (part-title-content d)
(content->string (part-title-content d))
;; last-ditch effort to make up a unique name:
(format "???~a" (eq-hash-code d)))))
"_"))])
(when ((string-length fn) . >= . 48)
(error "file name too long (need a tag):" fn))
@ -493,28 +527,25 @@
(build-path fn "index.html"))
fns)))
(define/override (current-part-whole-page?)
(define/override (current-part-whole-page? d)
((collecting-sub) . <= . 2))
(define/private (toc-part? d)
(and (styled-part? d)
(let ([st (styled-part-style d)])
(or (eq? 'toc st)
(and (list? st) (memq 'toc st))))))
(part-style? d 'toc))
(define/override (collect-part d parent ht number)
(define/override (collect-part d parent ci number)
(let ([prev-sub (collecting-sub)])
(parameterize ([collecting-sub (if (toc-part? d)
1
(add1 prev-sub))])
(if (= 1 prev-sub)
(let ([filename (derive-filename d ht)])
(let ([filename (derive-filename d)])
(parameterize ([current-output-file (build-path (path-only (current-output-file))
filename)])
(super collect-part d parent ht number)))
(super collect-part d parent ht number)))))
(super collect-part d parent ci number)))
(super collect-part d parent ci number)))))
(define/override (render ds fns ht)
(define/override (render ds fns ri)
(map (lambda (d fn)
(printf " [Output to ~a/index.html]\n" fn)
(unless (directory-exists? fn)
@ -523,7 +554,7 @@
(let ([fn (build-path fn "index.html")])
(with-output-to-file fn
(lambda ()
(render-one d ht fn))
(render-one d ri fn))
'truncate/replace))))
ds
fns))
@ -538,8 +569,8 @@
(inherit render-table)
(define/private (find-siblings d)
(let ([parent (collected-info-parent (part-collected-info d))])
(define/private (find-siblings d ri)
(let ([parent (collected-info-parent (part-collected-info d ri))])
(let loop ([l (if parent
(part-parts parent)
(if (null? (part-parts d))
@ -552,12 +583,12 @@
(cadr l)))]
[else (loop (cdr l) (car l))]))))
(define/private (part-parent d)
(collected-info-parent (part-collected-info d)))
(define/private (part-parent d ri)
(collected-info-parent (part-collected-info d ri)))
(define/private (navigation d ht)
(let ([parent (part-parent d)])
(let*-values ([(prev next) (find-siblings d)]
(define/private (navigation d ri)
(let ([parent (part-parent d ri)])
(let*-values ([(prev next) (find-siblings d ri)]
[(prev) (if prev
(let loop ([prev prev])
(if (and (toc-part? prev)
@ -575,17 +606,17 @@
parent
(toc-part? parent))
(let-values ([(prev next)
(find-siblings parent)])
(find-siblings parent ri)])
next)]
[else next])]
[(index) (let loop ([d d])
(let ([p (part-parent d)])
(let ([p (part-parent d ri)])
(if p
(loop p)
(let ([subs (part-parts d)])
(and (pair? subs)
(let ([d (car (last-pair subs))])
(and (equal? '("Index") (part-title-content d))
(and (part-style? d 'index)
d)))))))])
`(,@(render-table (make-table
'at-left
@ -614,9 +645,9 @@
(make-link-element
#f
index-content
`(part ,(car (part-tags index))))))))))
(car (part-tags index)))))))))
null))))
d ht)
d ri)
,@(render-table (make-table
'at-right
(list
@ -628,7 +659,7 @@
(make-element
(if parent
(make-target-url (if prev
(derive-filename prev ht)
(derive-filename prev)
"index.html"))
"nonavigation")
prev-content)
@ -637,34 +668,34 @@
(if parent
(make-target-url
(if (toc-part? parent)
(derive-filename parent ht)
(derive-filename parent)
"index.html"))
"nonavigation")
up-content)
sep-element
(make-element
(if next
(make-target-url (derive-filename next ht))
(make-target-url (derive-filename next))
"nonavigation")
next-content))))))))
d
ht)))))
ri)))))
(define/override (render-part d ht)
(let ([number (collected-info-number (part-collected-info d))])
(define/override (render-part d ri)
(let ([number (collected-info-number (part-collected-info d ri))])
(cond
[(and (not (on-separate-page))
(or (= 1 (length number))
(next-separate-page)))
;; Render as just a link, and put the actual
;; content in a new file:
(let* ([filename (derive-filename d ht)]
(let* ([filename (derive-filename d)]
[full-path (build-path (path-only (current-output-file))
filename)])
(parameterize ([on-separate-page #t])
(with-output-to-file full-path
(lambda ()
(render-one-part d ht full-path number))
(render-one-part d ri full-path number))
'truncate/replace)
null))]
[else
@ -673,14 +704,14 @@
[on-separate-page #f])
(if sep?
;; Navigation bars;
`(,@(navigation d ht)
`(,@(navigation d ri)
(p nbsp)
,@(super render-part d ht)
,@(super render-part d ri)
(p nbsp)
,@(navigation d ht)
,@(navigation d ri)
(p nbsp))
;; Normal section render
(super render-part d ht))))])))
(super render-part d ri))))])))
(super-new)))

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

@ -18,13 +18,12 @@
render-flow-element
render-content
install-file
format-number
lookup)
format-number)
(define (define-color s s2)
(printf "\\newcommand{\\~a}[1]{{\\mytexttt{\\color{~a}{#1}}}}\n" s s2))
(define/override (render-one d ht fn)
(define/override (render-one d ri fn)
(printf "\\documentclass{article}\n")
(printf "\\parskip=10pt%\n")
(printf "\\parindent=0pt%\n")
@ -75,17 +74,16 @@
(printf "\\begin{document}\n\\sloppy\n")
(when (part-title-content d)
(printf "\\title{")
(render-content (part-title-content d) d ht)
(render-content (part-title-content d) d ri)
(printf "}\\maketitle\n"))
(render-part d ht)
(render-part d ri)
(printf "\\end{document}\n"))
(define/override (render-part d ht)
(let ([number (collected-info-number (part-collected-info d))])
(define/override (render-part d ri)
(let ([number (collected-info-number (part-collected-info d ri))])
(when (and (part-title-content d)
(pair? number))
(when (and (styled-part? d)
(eq? 'index (styled-part-style d)))
(when (part-style? d 'index)
(printf "\\twocolumn\n\\parskip=0pt\n\\addcontentsline{toc}{section}{Index}\n"))
(printf "\\~a~a{"
(case (length number)
@ -97,20 +95,19 @@
(not (car number)))
"*"
""))
(render-content (part-title-content d) d ht)
(render-content (part-title-content d) d ri)
(printf "}")
(when (and (styled-part? d)
(eq? 'index (styled-part-style d)))
(when (part-style? d 'index)
(printf "\n\n")))
(for-each (lambda (t)
(printf "\\label{t:~a}" (t-encode `(part ,t))))
(printf "\\label{t:~a}" (t-encode (tag-key t ri))))
(part-tags d))
(render-flow (part-flow d) d ht)
(for-each (lambda (sec) (render-part sec ht))
(render-flow (part-flow d) d ri)
(for-each (lambda (sec) (render-part sec ri))
(part-parts d))
null))
(define/override (render-paragraph p part ht)
(define/override (render-paragraph p part ri)
(printf "\n\n")
(let ([margin? (and (styled-paragraph? p)
(equal? "refpara" (styled-paragraph-style p)))])
@ -118,28 +115,35 @@
(printf "\\marginpar{\\footnotesize "))
(if (toc-paragraph? p)
(printf "\\newpage \\tableofcontents \\newpage")
(super render-paragraph p part ht))
(super render-paragraph p part ri))
(when margin?
(printf "}")))
(printf "\n\n")
null)
(define/override (render-element e part ht)
(define/override (render-element e 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)))])
(parameterize ([show-link-page-numbers #f])
(when (target-element? e)
(printf "\\label{t:~a}" (t-encode (target-element-tag e))))
(printf "\\label{t:~a}" (t-encode (tag-key (target-element-tag e) ri))))
(when part-label?
(printf "\\S")
(render-content (let ([dest (lookup part ht (link-element-tag e))])
(render-content (let ([dest (resolve-get part ri (link-element-tag e))])
(if dest
(format-number (cadr dest) null)
(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
ht)
ri)
(printf " ``"))
(let ([style (and (element? e)
(element-style e))]
@ -147,7 +151,7 @@
(printf "{\\~a{" s)
(parameterize ([rendering-tt (or tt?
(rendering-tt))])
(super render-element e part ht))
(super render-element e part ri))
(printf "}}"))])
(cond
[(symbol? style)
@ -155,6 +159,7 @@
[(italic) (wrap e "textit" #f)]
[(bold) (wrap e "textbf" #f)]
[(tt) (wrap e "mytexttt" #t)]
[(nobreak) (super render-element e part ri)]
[(sf) (wrap e "textsf" #f)]
[(subscript) (wrap e "textsub" #f)]
[(superscript) (wrap e "textsuper" #f)]
@ -170,12 +175,12 @@
[(image-file? style)
(let ([fn (install-file (image-file-path style))])
(printf "\\includegraphics{~a}" fn))]
[else (super render-element e part ht)])))
[else (super render-element e part ri)])))
(when part-label?
(printf "''"))
(when (and (link-element? e)
(show-link-page-numbers))
(printf ", \\pageref{t:~a}" (t-encode (link-element-tag e))))
(printf ", \\pageref{t:~a}" (t-encode (tag-key (link-element-tag e) ri))))
null))
(define/private (t-encode s)
@ -192,7 +197,7 @@
(format "x~x" (char->integer c))]))
(string->list (format "~s" s)))))
(define/override (render-table t part ht)
(define/override (render-table t part ri)
(let* ([boxed? (eq? 'boxed (table-style t))]
[index? (eq? 'index (table-style t))]
[inline? (and (not boxed?)
@ -262,7 +267,7 @@
[else n]))])
(unless (= cnt 1)
(printf "\\multicolumn{~a}{l}{" cnt))
(render-flow (car flows) part ht)
(render-flow (car flows) part ri)
(unless (= cnt 1)
(printf "}"))
(unless (null? (list-tail flows cnt))
@ -284,25 +289,25 @@
""))))))
null)
(define/override (render-itemization t part ht)
(define/override (render-itemization t part ri)
(printf "\n\n\\begin{itemize}\n")
(for-each (lambda (flow)
(printf "\n\n\\item ")
(render-flow flow part ht))
(render-flow flow part ri))
(itemization-flows t))
(printf "\n\n\\end{itemize}\n")
null)
(define/override (render-blockquote t part ht)
(define/override (render-blockquote t part ri)
(printf "\n\n\\begin{quote}\n")
(parameterize ([current-table-mode (list "blockquote" t)])
(for-each (lambda (e)
(render-flow-element e part ht))
(render-flow-element e part ri))
(blockquote-paragraphs t)))
(printf "\n\n\\end{quote}\n")
null)
(define/override (render-other i part ht)
(define/override (render-other i part ri)
(cond
[(string? i) (display-protected i)]
[(symbol? i) (display
@ -362,11 +367,11 @@
;; ----------------------------------------
(define/override (table-of-contents sec ht)
(define/override (table-of-contents sec ri)
;; FIXME: isn't local to the section
(make-toc-paragraph null))
(define/override (local-table-of-contents part ht)
(define/override (local-table-of-contents part ri)
(make-paragraph null))
;; ----------------------------------------

317
collects/scribble/manual.ss
View File

@ -10,6 +10,8 @@
(lib "class.ss")
(lib "stxparam.ss"))
(require-for-syntax (lib "stxparam.ss"))
(require-for-label (lib "lang.ss" "big")
(lib "class.ss"))
(provide (all-from "basic.ss"))
@ -50,10 +52,24 @@
(define (to-element/id s)
(make-element "schemesymbol" (list (to-element/no-color s))))
(define (keep-s-expr ctx s v)
(define-syntax (keep-s-expr stx)
(syntax-case stx ()
[(_ ctx s srcloc)
(let ([sv (syntax-e #'s)])
(if (or (number? sv)
(boolean? sv)
(and (pair? sv)
(identifier? (car sv))
(module-identifier=? #'cons (car sv))))
;; We know that the context is irrelvant
#'s
;; Context may be relevant:
#'(*keep-s-expr s ctx)))]))
(define (*keep-s-expr s ctx)
(if (symbol? s)
(make-just-context s ctx)
s))
(define (add-sq-prop s name val)
(if (eq? name 'paren-shape)
(make-shaped-parens s val)
@ -158,9 +174,9 @@
(define (exec . str)
(make-element 'tt (decode-content str)))
(define (Flag . str)
(make-element 'tt (cons "-" (decode-content str))))
(make-element 'no-break (list (make-element 'tt (cons "-" (decode-content str))))))
(define (DFlag . str)
(make-element 'tt (cons "--" (decode-content str))))
(make-element 'no-break (list (make-element 'tt (cons "--" (decode-content str))))))
(define (envvar . str)
(make-element 'tt (decode-content str)))
(define (indexed-envvar . str)
@ -198,9 +214,8 @@
(elem (method a b) " in " (scheme a))]))
(define (*method sym id)
(let ([tag (format "~a::~a"
(register-scheme-definition id)
sym)])
(let ([tag (method-tag (register-scheme-definition id #t)
sym)])
(make-element
"schemesymbol"
(list (make-link-element
@ -208,6 +223,9 @@
(list (symbol->string sym))
tag)))))
(define (method-tag vtag sym)
(list 'meth
(format "~a::~a" (cadr vtag) sym)))
;; ----------------------------------------
@ -222,7 +240,7 @@
(provide deftech tech techlink)
(define (*tech make-elem style s)
(define (*tech make-elem style doc s)
(let* ([c (decode-content s)]
[s (regexp-replace* #px"[-\\s]+"
(regexp-replace
@ -235,26 +253,27 @@
" ")])
(make-elem style
c
(format "tech-term:~a" s))))
(list 'tech (doc-prefix doc s)))))
(define (deftech . s)
(let* ([e (apply defterm s)]
[t (*tech make-target-element #f (list e))])
[t (*tech make-target-element #f #f (list e))])
(make-index-element #f
(list t)
(target-element-tag t)
(list (element->string e))
(list e))))
(define (tech . s)
(*tech make-link-element "techlink" s))
(define (tech #:doc [doc #f] . s)
(*tech make-link-element "techlink" doc s))
(define (techlink . s)
(*tech make-link-element #f s))
(define (techlink #:doc [doc #f] . s)
(*tech make-link-element #f doc s))
;; ----------------------------------------
(provide defproc defproc* defstruct defthing defparam defboolparam
(provide declare-exporting
defproc defproc* defstruct defthing defparam defboolparam
defform defform* defform/subs defform*/subs defform/none
defidform
specform specform/subs
@ -262,6 +281,33 @@
schemegrammar schemegrammar*
var svar void-const undefined-const)
(define-syntax declare-exporting
(syntax-rules ()
[(_ lib ...) (*declare-exporting '(lib ...))]))
(define (*declare-exporting libs)
(make-part-collect-decl
(make-collect-element #f
null
(lambda (ri)
(collect-put! ri '(exporting-libraries #f)libs)))))
(define-syntax (quote-syntax/loc stx)
(syntax-case stx ()
[(_ id)
(with-syntax ([loc
(let ([s #'id])
(list (syntax-source s)
(syntax-line s)
(syntax-column s)
(syntax-position s)
(syntax-span s)))])
#'(let ([s (quote-syntax id)])
(datum->syntax-object s
(syntax-e s)
'loc
s)))]))
(define void-const
(schemeresultfont "#<void>"))
(define undefined-const
@ -304,13 +350,13 @@
(syntax-rules ()
[(_ (id arg ...) result desc ...)
(defproc* [[(id arg ...) result]] desc ...)]))
(define-syntax defproc*
(define-syntax defproc*
(syntax-rules ()
[(_ [[(id arg ...) result] ...] desc ...)
(defproc* #:mode procedure #:within #f [[(id arg ...) result] ...] desc ...)]
[(_ #:mode m #:within cl [[(id arg ...) result] ...] desc ...)
(*defproc 'm (quote-syntax cl)
(list (quote-syntax id) ...)
(*defproc 'm (quote-syntax/loc cl)
(list (quote-syntax/loc id) ...)
'[(id arg ...) ...]
(list (list (lambda () (arg-contract arg)) ...) ...)
(list (lambda () (schemeblock0 result)) ...)
@ -328,7 +374,7 @@
(define-syntax **defstruct
(syntax-rules ()
[(_ name ([field field-contract] ...) immutable? transparent? desc ...)
(*defstruct (quote-syntax name) 'name
(*defstruct (quote-syntax/loc name) 'name
'([field field-contract] ...) (list (lambda () (schemeblock0 field-contract)) ...)
#t #t (lambda () (list desc ...)))]))
(define-syntax (defform*/subs stx)
@ -347,7 +393,7 @@
[spec-id
(syntax-case #'spec ()
[(name . rest) #'name])])
#'(*defforms (quote-syntax spec-id) '(lit ...)
#'(*defforms (quote-syntax/loc spec-id) '(lit ...)
'(spec spec1 ...)
(list (lambda (x) (schemeblock0 new-spec))
(lambda (ignored) (schemeblock0 spec1)) ...)
@ -381,7 +427,7 @@
(define-syntax (defidform stx)
(syntax-case stx ()
[(_ spec-id desc ...)
#'(*defforms (quote-syntax spec-id) null
#'(*defforms (quote-syntax/loc spec-id) null
'(spec-id)
(list (lambda (x) (make-paragraph (list x))))
null
@ -440,7 +486,7 @@
(define-syntax defthing
(syntax-rules ()
[(_ id result desc ...)
(*defthing (quote-syntax id) 'id (quote-syntax result) (lambda () (list desc ...)))]))
(*defthing (quote-syntax/loc id) 'id (quote-syntax result) (lambda () (list desc ...)))]))
(define-syntax defparam
(syntax-rules ()
[(_ id arg contract desc ...)
@ -494,6 +540,27 @@
type-sym)
""))))
(define (annote-exporting-library e)
(make-delayed-element
(lambda (render p ri)
(let ([from (resolve-get p ri '(exporting-libraries #f))])
(if (and from
(pair? from))
(list (make-hover-element
#f
(list e)
(string-append
"Provided from: "
(let loop ([from from])
(if (null? (cdr from))
(format "~s" (car from))
(format "~s, ~a"
(car from)
(loop (cdr from))))))))
(list e))))
(lambda () e)
(lambda () e)))
(define (*defproc mode within-id
stx-ids prototypes arg-contractss result-contracts content-thunk)
(let ([spacer (hspace 1)]
@ -589,34 +656,40 @@
(hspace 1)
(if first?
(let* ([mname (car prototype)]
[tag (format "~a::~a"
(register-scheme-definition within-id)
mname)]
[ctag (register-scheme-definition within-id #t)]
[tag (method-tag ctag mname)]
[content (list (*method mname within-id))])
(make-toc-target-element
#f
(list (make-index-element #f
content
tag
(list (symbol->string mname))
content))
tag))
(if tag
(make-toc-target-element
#f
(list (make-index-element #f
content
tag
(list (symbol->string mname))
content))
tag)
(car content)))
(*method (car prototype) within-id))))]
[else
(if first?
(let ([tag (register-scheme-definition stx-id)]
[content (list (to-element (make-just-context (car prototype)
stx-id)))])
(make-toc-target-element
#f
(list (make-index-element #f
content
tag
(list (symbol->string (car prototype)))
content))
tag))
(to-element (make-just-context (car prototype)
stx-id)))])]
(let ([tag (register-scheme-definition stx-id #t)]
[content (list
(annote-exporting-library
(to-element (make-just-context (car prototype)
stx-id))))])
(if tag
(make-toc-target-element
#f
(list (make-index-element #f
content
tag
(list (symbol->string (car prototype)))
content))
tag)
(car content)))
(annote-exporting-library
(to-element (make-just-context (car prototype)
stx-id))))])]
[(flat-size) (+ (prototype-size (cdr prototype) + +)
(element-width tagged))]
[(short?) (or (flat-size . < . 40)
@ -799,16 +872,19 @@
(register-scheme-definition
(datum->syntax-object stx-id
(string->symbol
name)))])
(inner-make-target-element
#f
(list
(make-index-element #f
(list content)
tag
(list name)
(list (schemeidfont (make-element "schemevaluelink" (list name))))))
tag))
name))
#t)])
(if tag
(inner-make-target-element
#f
(list
(make-index-element #f
(list content)
tag
(list name)
(list (schemeidfont (make-element "schemevaluelink" (list name))))))
tag)
content))
(cdr wrappers))))
(define (*defstruct stx-id name fields field-contracts immutable? transparent? content-thunk)
@ -826,9 +902,10 @@
(make-target-element*
make-toc-target-element
stx-id
(to-element (if (pair? name)
(make-just-context (car name) stx-id)
stx-id))
(annote-exporting-library
(to-element (if (pair? name)
(make-just-context (car name) stx-id)
stx-id)))
(let ([name (if (pair? name)
(car name)
name)])
@ -975,16 +1052,19 @@
(list (make-flow
(list
(make-paragraph
(list (let ([tag (register-scheme-definition stx-id)]
[content (list (to-element (make-just-context name stx-id)))])
(make-toc-target-element
#f
(list (make-index-element #f
content
tag
(list (symbol->string name))
content))
tag))
(list (let ([tag (register-scheme-definition stx-id #t)]
[content (list (annote-exporting-library
(to-element (make-just-context name stx-id))))])
(if tag
(make-toc-target-element
#f
(list (make-index-element #f
content
tag
(list (symbol->string name))
content))
tag)
(car content)))
spacer ":" spacer
(to-element result-contract))))))))
(content-thunk))))
@ -1026,25 +1106,32 @@
(make-paragraph
(list
(to-element
`(,x
. ,(cdr form)))))))
`(,x . ,(cdr form)))))))
(and kw-id
(eq? form (car forms))
(let ([tag (register-scheme-form-definition kw-id)]
[content (list (to-element (make-just-context (if (pair? form)
(car form)
form)
kw-id)))])
(make-toc-target-element
#f
(if kw-id
(list (make-index-element #f
content
tag
(list (symbol->string (syntax-e kw-id)))
content))
content)
tag))))))))
(let ([tag (register-scheme-definition kw-id #t)]
[stag (register-scheme-form-definition kw-id)]
[content (list (annote-exporting-library
(to-element (make-just-context (if (pair? form)
(car form)
form)
kw-id))))])
(if tag
(make-toc-target-element
#f
(list
(make-toc-target-element
#f
(if kw-id
(list (make-index-element #f
content
tag
(list (symbol->string (syntax-e kw-id)))
content))
content)
tag))
stag)
(car content)))))))))
forms form-procs)
(if (null? sub-procs)
null
@ -1156,17 +1243,25 @@
(make-paragraph (list (hspace 2) (apply tt s))))
(define (elemtag t . body)
(make-target-element #f (decode-content body) t))
(make-target-element #f (decode-content body) `(elem ,t)))
(define (elemref t . body)
(make-link-element #f (decode-content body) t))
(make-link-element #f (decode-content body) `(elem ,t)))
(provide elemtag elemref)
(define (secref s)
(make-link-element #f null `(part ,s)))
(define (seclink tag . s)
(make-link-element #f (decode-content s) `(part ,tag)))
(define (doc-prefix doc s)
(if doc
(format "~a:~a"
(module-path-prefix->string doc)
s)
s))
(define (secref s #:doc [doc #f])
(make-link-element #f null `(part ,(doc-prefix doc s))))
(define (seclink tag #:doc [doc #f] . s)
(make-link-element #f (decode-content s) `(part ,(doc-prefix doc tag))))
(define (*schemelink stx-id id . s)
(make-link-element #f (decode-content s) (register-scheme-definition stx-id)))
(make-link-element #f (decode-content s) (or (register-scheme-definition stx-id)
(format "--UNDEFINED:~a--" (syntax-e stx-id)))))
(define-syntax schemelink
(syntax-rules ()
[(_ id . content) (*schemelink (quote-syntax id) 'id . content)]))
@ -1261,7 +1356,7 @@
(define id val)))]))
(define-syntax (class-doc-info stx)
(syntax-case stx (object%)
(syntax-case* stx (object%) module-label-identifier=?
[(_ object%) #'#f]
[(_ id) (class-id->class-doc-info-id #'id)]))
@ -1357,18 +1452,22 @@
(list (make-flow
(list
(make-paragraph
(list (let ([tag (register-scheme-definition stx-id)]
[content (list (to-element stx-id))])
((if whole-page?
make-page-target-element
make-toc-target-element)
#f
(list (make-index-element #f
content
tag
(list (symbol->string (syntax-e stx-id)))
content))
tag))
(list (let ([tag (register-scheme-definition stx-id #t)]
[content (list (annote-exporting-library (to-element stx-id)))])
(if tag
((if whole-page?
make-page-target-element
make-toc-target-element)
#f
(if whole-page?
content ; title is already an index entry
(list (make-index-element #f
content
tag
(list (symbol->string (syntax-e stx-id)))
content)))
tag)
(car content)))
spacer ":" spacer
(if super
(scheme class?)
@ -1403,12 +1502,12 @@
[(_ name super (intf ...) body ...)
(define-class-doc-info name
(syntax-parameterize ([current-class (quote-syntax name)])
(register-class (quote-syntax name)
(register-class (quote-syntax/loc name)
(class-doc-info super)
(list (class-doc-info intf) ...)
(lambda (whole-page?)
(list
(*defclass (quote-syntax name)
(*defclass (quote-syntax/loc name)
(quote-syntax super)
(list (quote-syntax intf) ...)
whole-page?)))
@ -1419,12 +1518,12 @@
[(_ name (intf ...) body ...)
(define-class-doc-info name
(syntax-parameterize ([current-class (quote-syntax name)])
(register-class (quote-syntax name)
(register-class (quote-syntax/loc name)
#f
(list (class-doc-info intf) ...)
(lambda (whole-page?)
(list
(*defclass (quote-syntax name)
(*defclass (quote-syntax/loc name)
#f
(list (quote-syntax intf) ...)
whole-page?)))

17
collects/scribble/run.ss
View File

@ -67,7 +67,7 @@
(when dir
(make-directory* dir))
(let ([renderer (new ((current-render-mixin) render% )
(let ([renderer (new ((current-render-mixin) render%)
[dest-dir dir])])
(let* ([fns (map (lambda (fn)
(let-values ([(base name dir?) (split-path fn)])
@ -82,8 +82,15 @@
[files (reverse (current-info-input-files))])
(if (null? files)
info
(loop (send renderer load-info (car files) info)
(loop (let ([s (with-input-from-file (car files) read)])
(send renderer deserialize-info s info)
info)
(cdr files))))])
(send renderer render docs fns info))
(when (current-info-output-file)
(send renderer save-info (current-info-output-file) info)))))))
(let ([r-info (send renderer resolve docs fns info)])
(send renderer render docs fns r-info)
(when (current-info-output-file)
(let ([s (send renderer serialize-info r-info)])
(with-output-to-file (current-info-output-file)
(lambda ()
(write s))
'truncate/replace))))))))))

237
collects/scribble/scheme.ss
View File

@ -1,9 +1,10 @@
(module scheme mzscheme
(module scheme (lib "lang.ss" "big")
(require "struct.ss"
"basic.ss"
(lib "class.ss")
(lib "for.ss")
(lib "modcollapse.ss" "syntax"))
(lib "main-collects.ss" "setup")
(lib "modresolve.ss" "syntax"))
(provide define-code
to-element
@ -33,13 +34,7 @@
(define opt-color "schemeopt")
(define current-keyword-list
;; This is temporary, until the MzScheme manual is filled in...
(make-parameter null #;'(require
provide
new send else => and or
define-syntax syntax-rules define-struct
quasiquote unquote unquote-splicing
syntax quasisyntax unsyntax unsyntax-splicing)))
(make-parameter null))
(define current-variable-list
(make-parameter null))
(define current-meta-list
@ -51,7 +46,76 @@
(define-struct spaces (pre cnt post))
(define (typeset c multi-line? prefix1 prefix suffix color?)
(define (literalize-spaces i)
(let ([m (regexp-match-positions #rx" +" i)])
(if m
(make-spaces (literalize-spaces (substring i 0 (caar m)))
(- (cdar m) (caar m))
(literalize-spaces (substring i (cdar m))))
i)))
(define (typeset-atom c out color? quote-depth)
(let-values ([(s it? sub?)
(let ([c (syntax-e c)])
(let ([s (format "~s" c)])
(if (and (symbol? c)
((string-length s) . > . 1)
(char=? (string-ref s 0) #\_))
(values (substring s 1) #t #f)
(values s #f #f))))]
[(is-var?) (and (identifier? c)
(memq (syntax-e c) (current-variable-list)))])
(if (or (element? (syntax-e c))
(delayed-element? (syntax-e c)))
(out (syntax-e c) #f)
(out (if (and (identifier? c)
color?
(quote-depth . <= . 0)
(not (or it? is-var?)))
(let ([tag (register-scheme c)])
(if tag
(make-delayed-element
(lambda (renderer sec ri)
(let* ([vtag `(def ,tag)]
[stag `(form ,tag)]
[sd (resolve-get sec ri stag)])
(list
(cond
[sd
(make-link-element "schemesyntaxlink" (list s) stag)]
[else
(make-link-element "schemevaluelink" (list s) vtag)]))))
(lambda () s)
(lambda () s))
s))
(literalize-spaces s))
(cond
[(positive? quote-depth) value-color]
[(let ([v (syntax-e c)])
(or (number? v)
(string? v)
(bytes? v)
(char? v)
(regexp? v)
(byte-regexp? v)
(boolean? v)))
value-color]
[(identifier? c)
(cond
[is-var?
variable-color]
[(and (identifier? c)
(memq (syntax-e c) (current-keyword-list)))
keyword-color]
[(and (identifier? c)
(memq (syntax-e c) (current-meta-list)))
meta-color]
[it? variable-color]
[else symbol-color])]
[else paren-color])
(string-length s)))))
(define (gen-typeset c multi-line? prefix1 prefix suffix color?)
(let* ([c (syntax-ize c 0)]
[content null]
[docs null]
@ -80,6 +144,10 @@
[(and (element? v)
(= 1 (length (element-content v))))
(sz-loop (car (element-content v)))]
[(element? v)
(element-width v)]
[(delayed-element? v)
(element-width v)]
[(spaces? v)
(+ (sz-loop (spaces-pre v))
(spaces-cnt v)
@ -176,13 +244,6 @@
c)
(loop (cdr l)
(cons (car l) prev))))]))))))
(define (literalize-spaces i)
(let ([m (regexp-match-positions #rx" +" i)])
(if m
(make-spaces (literalize-spaces (substring i 0 (caar m)))
(- (cdar m) (caar m))
(literalize-spaces (substring i (cdar m))))
i)))
(define (no-fancy-chars s)
(cond
[(eq? s 'rsquo) "'"]
@ -359,65 +420,10 @@
(set! src-col (+ orig-col (syntax-span c)))))]
[else
(advance c init-line!)
(let-values ([(s it? sub?)
(let ([c (syntax-e c)])
(let ([s (format "~s" c)])
(if (and (symbol? c)
((string-length s) . > . 1)
(char=? (string-ref s 0) #\_))
(values (substring s 1) #t #f)
(values s #f #f))))]
[(is-var?) (and (identifier? c)
(memq (syntax-e c) (current-variable-list)))])
(if (element? (syntax-e c))
(out (syntax-e c) #f)
(out (if (and (identifier? c)
color?
(quote-depth . <= . 0)
(not (or it? is-var?)))
(make-delayed-element
(lambda (renderer sec ht)
(let* ([vtag (register-scheme-definition c)]
[stag (register-scheme-form-definition c)]
[vd (hash-table-get ht vtag #f)]
[sd (hash-table-get ht stag #f)])
(list
(cond
[sd
(make-link-element "schemesyntaxlink" (list s) stag)]
[vd
(make-link-element "schemevaluelink" (list s) vtag)]
[else s]))))
(lambda () s)
(lambda () s))
(literalize-spaces s))
(cond
[(positive? quote-depth) value-color]
[(or (number? (syntax-e c))
(string? (syntax-e c))
(bytes? (syntax-e c))
(char? (syntax-e c))
(regexp? (syntax-e c))
(byte-regexp? (syntax-e c))
(boolean? (syntax-e c)))
value-color]
[(identifier? c)
(cond
[is-var?
variable-color]
[(and (identifier? c)
(memq (syntax-e c) (current-keyword-list)))
keyword-color]
[(and (identifier? c)
(memq (syntax-e c) (current-meta-list)))
meta-color]
[it? variable-color]
[else symbol-color])]
[else paren-color])
(string-length s)))
(set! src-col (+ src-col (or (syntax-span c) 1)))
#;
(hash-table-put! next-col-map src-col dest-col))])))
(typeset-atom c out color? quote-depth)
(set! src-col (+ src-col (or (syntax-span c) 1)))
#;
(hash-table-put! next-col-map src-col dest-col)])))
(out prefix1 #f)
(set! dest-col 0)
(hash-table-put! next-col-map init-col dest-col)
@ -436,6 +442,25 @@
(make-table "schemeblock" (map list (reverse docs))))
(make-sized-element #f (reverse content) dest-col))))
(define (typeset c multi-line? prefix1 prefix suffix color?)
(let* ([c (syntax-ize c 0)]
[s (syntax-e c)])
(if (or multi-line?
(eq? 'code:blank s)
(pair? s)
(vector? s)
(box? s)
(null? s)
(hash-table? s))
(gen-typeset c multi-line? prefix1 prefix suffix color?)
(typeset-atom c
(case-lambda
[(elem color)
(make-sized-element (and color? color) (list elem) (or (syntax-span c) 1))]
[(elem color len)
(make-sized-element (and color? color) (list elem) len)])
color? 0))))
(define (to-element c)
(typeset c #f "" "" "" #t))
@ -457,15 +482,15 @@
(cond
[(syntax? v)
(let ([mk `(,#'d->s
(quote-syntax ,v)
(quote-syntax ,(datum->syntax-object v 'defcode))
,(syntax-case v (uncode)
[(uncode e) #'e]
[else (stx->loc-s-expr (syntax-e v))])
(list 'code
,(syntax-line v)
,(syntax-column v)
,(syntax-position v)
,(syntax-span v)))])
'(code
,(syntax-line v)
,(syntax-column v)
,(syntax-position v)
,(syntax-span v)))])
(let ([prop (syntax-property v 'paren-shape)])
(if prop
`(,#'stx-prop ,mk 'paren-shape ,prop)
@ -484,27 +509,43 @@
[(_ expr) #`(typeset-code #,(cvt #'expr))]
[(_ expr (... ...))
#`(typeset-code #,(cvt #'(code:line expr (... ...))))])))]
[(_ code typeset-code uncode d->s)
#'(define-code code typeset-code uncode d->s syntax-property)]
[(_ code typeset-code uncode)
#'(define-code code typeset-code uncode datum->syntax-object syntax-property)]
[(_ code typeset-code) #'(define-code code typeset-code unsyntax)]))
(define (register-scheme-definition stx)
(define (register-scheme stx [warn-if-no-label? #f])
(unless (identifier? stx)
(error 'register-scheme-definition "not an identifier: ~e" (syntax-object->datum stx)))
(format "definition:~a"
(let ([b (identifier-binding stx)])
(cond
[(not b) (format "top:~a" (syntax-e stx))]
[(eq? b 'lexical) (format "lexical:~a" (syntax-e stx))]
[else (format "module:~a:~a"
(if (module-path-index? (car b))
(collapse-module-path-index (car b) '(lib "ack.ss" "scribble"))
(car b))
(cadr b))]))))
(let ([b (identifier-label-binding stx)])
(if (or (not b)
(eq? b 'lexical))
(if warn-if-no-label?
(begin
(fprintf (current-error-port)
"~a\n"
;; Call raise-syntax-error to capture error message:
(with-handlers ([exn:fail:syntax? (lambda (exn)
(exn-message exn))])
(raise-syntax-error 'WARNING
"no for-label binding of identifier"
stx)))
(format ":NOLABEL:~a" (syntax-e stx)))
#f)
(format ":~a:~a"
(if (module-path-index? (car b))
(let ([p (resolve-module-path-index (car b) #f)])
(path->main-collects-relative p))
(car b))
(cadr b)))))
(define (register-scheme-form-definition stx)
(format "form~s" (register-scheme-definition stx)))
(define (register-scheme-definition stx [warn-if-no-label? #f])
`(def ,(register-scheme stx warn-if-no-label?)))
(define (register-scheme-form-definition stx [warn-if-no-label? #f])
`(form ,(register-scheme stx warn-if-no-label?)))
(define syntax-ize-hook (make-parameter (lambda (v col) #f)))
@ -551,7 +592,11 @@
(just-context-ctx v)))]
[(and (list? v)
(pair? v)
(memq (car v) '(quote unquote unquote-splicing)))
(memq (let ([s (car v)])
(if (just-context? s)
(just-context-val s)
s))
'(quote unquote unquote-splicing)))
(let ([c (syntax-ize (cadr v) (+ col 1))])
(datum->syntax-object #f
(list (syntax-ize (car v) col)

4
collects/scribble/scribble.css
View File

@ -140,6 +140,10 @@
text-decoration: none;
}
.nobreak {
white-space: nowrap;
}
.title {
font-size: 200%;
font-weight: normal;

242
collects/scribble/struct.ss
View File

@ -1,8 +1,56 @@
(module struct mzscheme
(module struct (lib "lang.ss" "big")
(require (lib "contract.ss")
(lib "serialize.ss"))
;; ----------------------------------------
(define-struct collect-info (ht ext-ht parts tags gen-prefix))
(define-struct resolve-info (ci delays undef))
(define (part-collected-info part ri)
(hash-table-get (collect-info-parts (resolve-info-ci ri))
part))
(define (collect-put! ci key val)
(hash-table-put! (collect-info-ht ci)
key
val))
(define (resolve-get/where part ri key)
(let ([key (tag-key key ri)])
(let ([v (hash-table-get (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
(let ([v (hash-table-get (collect-info-ext-ht (resolve-info-ci ri))
key
#f)])
(values v #t))]))))
(define (resolve-get part ri key)
(let-values ([(v ext?) (resolve-get/where part ri key)])
v))
(provide
(struct collect-info (ht ext-ht parts tags gen-prefix))
(struct resolve-info (ci delays undef))
part-collected-info
collect-put!
resolve-get
resolve-get/where)
;; ----------------------------------------
(provide provide-structs)
(define-syntax (provide-structs stx)
@ -36,12 +84,12 @@
fields+cts)))))]))
(provide tag?)
(define (tag? s) (or (string? s)
(and (pair? s)
(symbol? (car s))
(pair? (cdr s))
(string? (cadr s))
(null? (cddr s)))))
(define (tag? s) (and (pair? s)
(symbol? (car s))
(pair? (cdr s))
(or (string? (cadr s))
(generated-tag? (cadr s)))
(null? (cddr s))))
(provide flow-element?)
(define (flow-element? p)
@ -52,21 +100,21 @@
(delayed-flow-element? p)))
(provide-structs
[part ([tags (listof tag?)]
[part ([tag-prefix (or/c false/c string?)]
[tags (listof tag?)]
[title-content (or/c false/c list?)]
[collected-info (or/c false/c collected-info?)]
[style any/c]
[to-collect list?]
[flow flow?]
[parts (listof part?)])]
[(styled-part part) ([style any/c])]
[(unnumbered-part styled-part) ()]
[(unnumbered-part part) ()]
[flow ([paragraphs (listof flow-element?)])]
[paragraph ([content list?])]
[(styled-paragraph paragraph) ([style any/c])]
[table ([style any/c]
[flowss (listof (listof (or/c flow? (one-of/c 'cont))))])]
[(auxiliary-table table) ()]
[delayed-flow-element ([render (any/c part? any/c . -> . flow-element?)])]
[delayed-flow-element ([resolve (any/c part? resolve-info? . -> . flow-element?)])]
[itemization ([flows (listof flow?)])]
[blockquote ([style any/c]
[paragraphs (listof flow-element?)])]
@ -81,6 +129,7 @@
[plain-seq (listof string?)]
[entry-seq list?])]
[(aux-element element) ()]
[(hover-element element) ([text string?])]
;; specific renders support other elements, especially strings
[collected-info ([number (listof (or/c false/c integer?))]
@ -89,46 +138,32 @@
[target-url ([addr string?])]
[image-file ([path path-string?])])
;; ----------------------------------------
;; Delayed element has special serialization support:
(define-values (struct:delayed-element
make-delayed-element
delayed-element?
delayed-element-ref
delayed-element-set!)
(make-struct-type 'delayed-element #f
3 1 #f
(list (cons prop:serializable
(make-serialize-info
(lambda (d)
(unless (delayed-element-ref d 3)
(error 'serialize-delayed-element
"cannot serialize a delayed element that was not resolved: ~e"
d))
(vector (delayed-element-ref d 3)))
#'deserialize-delayed-element
#f
(or (current-load-relative-directory) (current-directory)))))))
(define-syntax delayed-element (list-immutable #'struct:delayed-element
#'make-delayed-element
#'delayed-element?
(list-immutable #'delayed-element-plain
#'delayed-element-sizer
#'delayed-element-render)
(list-immutable #'set-delayed-element-plain!
#'set-delayed-element-sizer!
#'set-delayed-element-render!)
#t))
(define delayed-element-render (make-struct-field-accessor delayed-element-ref 0))
(define delayed-element-sizer (make-struct-field-accessor delayed-element-ref 1))
(define delayed-element-plain (make-struct-field-accessor delayed-element-ref 2))
(define set-delayed-element-render! (make-struct-field-mutator delayed-element-set! 0))
(define set-delayed-element-sizer! (make-struct-field-mutator delayed-element-set! 1))
(define set-delayed-element-plain! (make-struct-field-mutator delayed-element-set! 2))
(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?); ~a"
(exn-message exn)))])
(vector
(make-element #f (delayed-element-content d ri))))))
#'deserialize-delayed-element
#f
(or (current-load-relative-directory) (current-directory))))
(provide/contract
(struct delayed-element ([render (any/c part? any/c . -> . list?)]
(struct delayed-element ([resolve (any/c part? resolve-info? . -> . list?)]
[sizer (-> any)]
[plain (-> any)])))
@ -136,12 +171,90 @@
(define deserialize-delayed-element
(make-deserialize-info values values))
(provide force-delayed-element)
(define (force-delayed-element d renderer sec ht)
(or (delayed-element-ref d 3)
(let ([v ((delayed-element-ref d 0) renderer sec ht)])
(delayed-element-set! d 3 v)
v)))
(provide delayed-element-content)
(define (delayed-element-content e ri)
(hash-table-get (resolve-info-delays ri) e))
(provide delayed-flow-element-flow-elements)
(define (delayed-flow-element-flow-elements p ri)
(hash-table-get (resolve-info-delays ri) p))
(provide current-serialize-resolve-info)
(define current-serialize-resolve-info (make-parameter #f))
;; ----------------------------------------
(define-struct (collect-element element) (collect)
#:property
prop:serializable
(make-serialize-info
(lambda (d)
(vector (collect-element-collect 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 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-table-get (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 generated-tag ()))
(provide deserialize-generated-tag)
(define deserialize-generated-tag
(make-deserialize-info values values))
(provide generate-tag tag-key)
(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-table-get tags t #f)
(let ([key (format "gentag:~a~a"
(collect-info-gen-prefix ci)
(hash-table-count tags))])
(hash-table-put! tags t key)
key)))))
tg))
(define (tag-key tg ri)
(if (generated-tag? (cadr tg))
(list (car tg)
(hash-table-get (collect-info-tags
(resolve-info-ci ri))
(cadr tg)))
tg))
;; ----------------------------------------
@ -151,8 +264,8 @@
(define content->string
(case-lambda
[(c) (c->s c element->string)]
[(c renderer sec ht) (c->s c (lambda (e)
(element->string e renderer sec ht)))]))
[(c renderer sec ri) (c->s c (lambda (e)
(element->string e renderer sec ri)))]))
(define (c->s c do-elem)
(apply string-append
@ -171,12 +284,12 @@
[(rsquo) "'"]
[(rarr) "->"]
[else (format "~s" c)])])]
[(c renderer sec ht)
[(c renderer sec ri)
(cond
[(element? c) (content->string (element-content c) renderer sec ht)]
[(element? c) (content->string (element-content c) renderer sec ri)]
[(delayed-element? c)
(content->string (force-delayed-element c renderer sec ht)
renderer sec ht)]
(content->string (delayed-element-content c ri)
renderer sec ri)]
[else (element->string c)])]))
;; ----------------------------------------
@ -226,5 +339,14 @@
;; ----------------------------------------
(provide part-style?)
(define (part-style? p s)
(let ([st (part-style p)])
(or (eq? s st)
(and (list? st) (memq s st)))))
;; ----------------------------------------
)

16
collects/scribblings/core.ss
View File

@ -1,16 +0,0 @@
(module core mzscheme
(require "to-html.ss"
(prefix ref: "reference/reference.scrbl")
(prefix guide: "guide/guide.scrbl"))
(provide build)
(define (build)
(to-html #t #t
(list ref:doc
guide:doc)
(list "reference"
"guide"))))

17
collects/scribblings/doc-installer.ss
View File

@ -1,17 +0,0 @@
(module doc-installer mzscheme
(require (lib "dirs.ss" "setup")
(prefix core: "core.ss")
(prefix quick: "quick.ss")
(prefix scribble: "scribble.ss")
(prefix gui: "gui.ss"))
(provide post-installer)
(define post-installer
(lambda (path)
(let ([doc (find-doc-dir)])
(when doc
(core:build)
(quick:build)
(scribble:build)
(gui:build))))))

11
collects/scribblings/gui.ss
View File

@ -1,11 +0,0 @@
(module gui mzscheme
(require "to-html.ss"
(prefix gui: "gui/gui.scrbl"))
(provide build)
(define (build)
(to-html #t #f
(list gui:doc)
(list "gui"))))

45
collects/scribblings/gui/blurbs.ss
View File

@ -1,9 +1,10 @@
#reader(lib "reader.ss" "scribble")
(module blurbs mzscheme
(module blurbs (lib "lang.ss" "big")
(require (lib "struct.ss" "scribble")
(lib "manual.ss" "scribble")
(lib "scheme.ss" "scribble")
(lib "decode.ss" "scribble"))
(require-for-label (lib "mred.ss" "mred"))
(provide (all-defined-except p))
@ -96,7 +97,7 @@ start/end @techlink{position} is incremented by @|what|.})
(define OVD
@elem{The result is only valid when the editor is displayed (see
@secref["mr:tb:miaoverview"]).})
@secref["tb:miaoverview"]).})
(define (FCAX c details)
@elem{@|c|alling this method may force the recalculation of @techlink{location}
@ -119,28 +120,28 @@ information@|details|, even if the editor currently has delayed refreshing (see
instead of lines (determined by both explicit newline
characters and automatic line-wrapping).})
(define admindiscuss @secref["mr:editoradministrators"])
(define ateoldiscuss @secref["mr:editoreol"])
(define textdiscuss @secref["mr:editorflattened"])
(define clickbackdiscuss @secref["mr:editorclickback"])
(define stylediscuss @secref["mr:editorstyles"])
(define timediscuss @secref["mr:editorcutandpastetime"])
(define filediscuss @secref["mr:editorfileformat"])
(define editordatadiscuss @secref["mr:editordata"])
(define snipclassdiscuss @secref["mr:editorsnipclasses"])
(define togglediscuss @secref["mr:styledeltatoggle"])
(define drawcaretdiscuss @secref["mr:drawcaretinfo"])
(define eventspacediscuss @secref["mr:eventspaceinfo"])
(define lockdiscuss @secref["mr:lockinfo"])
(define mousekeydiscuss @secref["mr:mouseandkey"])
(define globaleditordatadiscuss @secref["mr:globaleditordata"])
(define admindiscuss @secref["editoradministrators"])
(define ateoldiscuss @secref["editoreol"])
(define textdiscuss @secref["editorflattened"])
(define clickbackdiscuss @secref["editorclickback"])
(define stylediscuss @secref["editorstyles"])
(define timediscuss @secref["editorcutandpastetime"])
(define filediscuss @secref["editorfileformat"])
(define editordatadiscuss @secref["editordata"])
(define snipclassdiscuss @secref["editorsnipclasses"])
(define togglediscuss @secref["styledeltatoggle"])
(define drawcaretdiscuss @secref["drawcaretinfo"])
(define eventspacediscuss @secref["eventspaceinfo"])
(define lockdiscuss @secref["lockinfo"])
(define mousekeydiscuss @secref["mouseandkey"])
(define globaleditordatadiscuss @secref["globaleditordata"])
(define geomdiscuss @secref["mr:containeroverview"])
(define geomdiscuss @secref["containeroverview"])
(define mrprefsdiscuss @secref["mr:mredprefs"])
(define mrprefsdiscuss @secref["mredprefs"])
(define seesniporderdiscuss
@elem{See @secref["mr:tb:miaoverview"] for information about snip order in pasteboards.})
@elem{See @secref["tb:miaoverview"] for information about snip order in pasteboards.})
(define (clipboardtypes)
@elem{The @scheme[format] string is typically four capital letters. (Under
@ -159,7 +160,9 @@ information@|details|, even if the editor currently has delayed refreshing (see
@item{@method[dc<%> end-doc]}}
@p{Attempts to use a drawing method outside of an active page raises an exception.})))
(define SeeMzParam @elem{(see @secref["mz:parameters"])})
(define reference-doc '(lib "reference.scrbl" "scribblings" "reference"))
(define SeeMzParam @elem{(see @secref[#:doc reference-doc "parameters"])})
(define DrawSizeNote @elem{Restrictions on the magnitude of
drawing coordinates are described with @scheme[dc<%>].})

8
collects/scribblings/gui/common.ss
View File

@ -11,6 +11,12 @@
(all-from (lib "class.ss"))
(all-from (lib "contract.ss"))
(all-from "blurbs.ss")
(all-from "../reference/mz.ss")))
(all-from "../reference/mz.ss"))
(require-for-label (lib "mred.ss" "mred")
(lib "class.ss")
(lib "lang.ss" "big"))
(provide-for-label (all-from (lib "mred.ss" "mred"))
(all-from (lib "class.ss"))
(all-from (lib "lang.ss" "big"))))

4
collects/scribblings/gui/diagrams.ss
View File

@ -3,6 +3,7 @@
(lib "struct.ss" "scribble")
(lib "scheme.ss" "scribble")
(lib "manual.ss" "scribble"))
(require-for-label (lib "mred.ss" "mred"))
(provide diagram->table
short-windowing-diagram
@ -31,7 +32,8 @@
[(regexp-match #rx"([^-a-zA-Z0-9]*)([-a-zA-Z0-9<%>]+)(.*)" line)
=> (lambda (m)
(append (loop (cadr m))
(list (to-element (string->symbol (caddr m))))
(list (to-element (make-just-context (string->symbol (caddr m))
#'here)))
(loop (cadddr m))))]
[else (list (make-element 'tt (list line)))])))))))
(regexp-split #rx"[\r\n]+" d))))

2
collects/scribblings/gui/draw-overview.scrbl
View File

@ -3,7 +3,7 @@
@require["common.ss"]
@require["diagrams.ss"]
@title[#:tag "mr:drawing-overview"]{Drawing}
@title[#:tag "drawing-overview"]{Drawing}
Drawing in MrEd requires a @deftech{device context} (@deftech{DC}),
which is an instance of the @scheme[dc<%>] interface. For example,

6
collects/scribblings/gui/editor-funcs.scrbl
View File

@ -350,9 +350,9 @@ If @scheme[raise-errors?] is true, then an error in reading triggers an
This procedure is a load handler for use with @scheme[current-load].
The handler recognizes MrEd editor-format files (see
@secref["mr:editorfileformat"]) and decodes them for loading. It is
@secref["editorfileformat"]) and decodes them for loading. It is
normally installed as MrEd starts (see
@secref["mr:startupsequence"]).
@secref[#:doc reference-doc "running-sa"]).
The handler recognizes editor files by the first twelve characters of
the file: @litchar{WXME01}@nonterm{digit}@nonterm{digit}@litchar{ ## }.
@ -412,7 +412,7 @@ One or more editors can be written to the stream by calling the
To support streams that span MrEd versions, use
@scheme[write-editor-version] before this procedure.
See also @secref["mr:editorfileformat"].
See also @secref["editorfileformat"].
}

6
collects/scribblings/gui/editor-intf.scrbl
View File

@ -205,7 +205,7 @@ When an editor contains other editors, using @method[editor<%>
end-edit-sequence] for the sub-editor.
See also @method[editor<%> refresh-delayed?] and @method[editor<%>
in-edit-sequence?], and see @secref["mr:editorthreads"] for
in-edit-sequence?], and see @secref["editorthreads"] for
information about edit sequences and refresh requests.
If the @scheme[undoable?] flag is @scheme[#f], then the changes made
@ -1322,7 +1322,7 @@ If automatic wrapping is enabled (see @method[editor<%> auto-wrap] )
Calls @method[editor<%> on-display-size] unless the editor is
currently in an edit sequence or currently being refreshed. In the
latter cases, the call to @method[editor<%> on-display-size] is
delegated to another thread; see @secref["mr:editorthreads"] for more
delegated to another thread; see @secref["editorthreads"] for more
information.
}
@ -1853,7 +1853,7 @@ See also @method[editor<%> add-undo].
void?]{
Repaints a region of the editor, generally called by an editor
administrator. See @secref["mr:editorthreads"] for information about
administrator. See @secref["editorthreads"] for information about
edit sequences and refresh requests.
The @scheme[x], @scheme[y], @scheme[width], and @scheme[height] arguments specify

30
collects/scribblings/gui/editor-overview.scrbl
View File

@ -2,7 +2,7 @@
@require[(lib "bnf.ss" "scribble")]
@require["common.ss"]
@title[#:tag "mr:editor-overview"]{Editor}
@title[#:tag "editor-overview"]{Editor}
The editor toolbox provides a foundation for two common kinds of
applications:
@ -154,7 +154,7 @@ Applications that use the editor classes typically derive new versions
(super-new)))
]
@section[#:tag "mr:tb:miaoverview"]{Editor Structure and Terminology}
@section[#:tag "tb:miaoverview"]{Editor Structure and Terminology}
MrEd supports extensible and nestable editors by decomposing an editor
assembly into three functional parts:
@ -221,7 +221,7 @@ When an editor is drawn into a display, each snip and position has a
displayed.
@subsection[#:tag "mr:editoradministrators"]{Administrators}
@subsection[#:tag "editoradministrators"]{Administrators}
Two extra layers of administration manage the @techlink{display}-editor and
editor-snip connections. An editor never communicates directly with
@ -259,7 +259,7 @@ When an editor is displayed by multiple canvases, one of the canvases'
editor's @method[editor<%> get-admin] method thus depends on the
context of the call.
@subsection[#:tag "mr:editorstyles"]{Styles}
@subsection[#:tag "editorstyles"]{Styles}
A @deftech{style}, an instance of the @scheme[style<%>] interface,
parameterizes high-level display information that is common to all
@ -336,7 +336,7 @@ See @xmethod[text% get-styles-sticky] for more information about the
style of inserted text.
@section[#:tag "mr:editorfileformat"]{File Format}
@section[#:tag "editorfileformat"]{File Format}
To allow editor content to be saved to a file, the editor classes
implement a special file format. (The format is used when cutting and
@ -412,7 +412,7 @@ Snip classes, snip data, and snip data classes solve problems related
for saving files or cut-and-paste, these issues can be safely
ignored.
@subsubsection[#:tag "mr:editorsnipclasses"]{Snip Classes}
@subsubsection[#:tag "editorsnipclasses"]{Snip Classes}
Each snip can be associated to a @deftech{snip class}. This ``class''
is not a class description in the programmer's language; it is an
@ -435,7 +435,7 @@ If a snip class's name is of the form @scheme["(lib ...)"], then the
it is inserted into the current eventspace's snip class list, and
loading or saving continues using the new class.
@subsubsection[#:tag "mr:editordata"]{Editor Data}
@subsubsection[#:tag "editordata"]{Editor Data}
While a snip belongs to an editor, the editor may store extra
information about a snip in some specialized way. When the snip is to
@ -475,7 +475,7 @@ To store and load information about a snip or region in an editor:
}
@subsection[#:tag "mr:globaleditordata"]{Global Data: Headers and Footers}
@subsection[#:tag "globaleditordata"]{Global Data: Headers and Footers}
The editor file format provides for adding extra global data in
special header and footer sections. To save and load special header
@ -517,7 +517,7 @@ See also @method[editor<%> write-headers-to-file] and
@method[editor<%> write-headers-to-file].
@section[#:tag "mr:editoreol"]{End of Line Ambiguity}
@section[#:tag "editoreol"]{End of Line Ambiguity}
Because an editor can force a line break even when there is no
carriage return item, a @techlink{position} alone does not always
@ -539,7 +539,7 @@ For this reason, @techlink{position}-setting and
is filled with @scheme[#t] if the position is ambiguous and it came
from a right-side location, or @scheme[#f] otherwise.
@section[#:tag "mr:editorflattened"]{Flattened Text}
@section[#:tag "editorflattened"]{Flattened Text}
In plain text editors, there is a simple correlation between
@techlink{position}s and characters. In an @scheme[editor<%>] object,
@ -568,7 +568,7 @@ Text can be extracted from an editor in either of two forms:
}
@section[#:tag "mr:drawcaretinfo"]{Caret Ownership}
@section[#:tag "drawcaretinfo"]{Caret Ownership}
Within a frame, only one object can contain the keyboard focus. This
property must be maintained when a frame contains multiple editors in
@ -609,7 +609,7 @@ The @scheme['show-inactive-caret] display mode is useful for showing
its selection.
@section[#:tag "mr:editorcutandpastetime"]{Cut and Paste Time Stamps}
@section[#:tag "editorcutandpastetime"]{Cut and Paste Time Stamps}
Methods of @scheme[editor<%>] that use the clipboard --- including
@method[editor<%> copy], @method[editor<%> cut], @method[editor<%>
@ -627,7 +627,7 @@ If the time stamp is 0, it defaults to the current time. Using 0 as the
under X.
@section[#:tag "mr:editorclickback"]{Clickbacks}
@section[#:tag "editorclickback"]{Clickbacks}
@deftech{Clickbacks} in a @scheme[text%] editor facilitate the
creation of simple interactive objects, such as hypertext. A
@ -647,7 +647,7 @@ Note that there is no attempt to save clickback information when a
file is saved, since a clickback will have an arbitrary procedure
associated with it.
@section[#:tag "mr:lockinfo"]{Internal Editor Locks}
@section[#:tag "lockinfo"]{Internal Editor Locks}
Instances of @scheme[editor<%>] have three levels of internal
locking:
@ -693,7 +693,7 @@ Methods that report @techlink{location}-independent information about an
that modifies the editor in any way, even setting the selection
position, can trigger a read lock, flow lock, or write lock.
@section[#:tag "mr:editorthreads"]{Editors and Threads}
@section[#:tag "editorthreads"]{Editors and Threads}
An editor is not tied to any particular thread or eventspace, except
to the degree that it is displayed in a canvas (which has an

28
collects/scribblings/gui/eventspace-funcs.scrbl
View File

@ -1,7 +1,7 @@
#reader(lib "docreader.ss" "scribble")
@require["common.ss"]
@title[#:tag "mr:eventspace-funcs"]{Eventspaces}
@title[#:tag "eventspace-funcs"]{Eventspaces}
@defproc[(make-eventspace)
eventspace]{
@ -139,7 +139,7 @@ A second (optional) boolean argument indicates whether the callback
any/c])]{
\index{pause}\index{wait}
Yields control to event dispatching. See
@secref["mr:eventspaceinfo"] for details.
@secref["eventspaceinfo"] for details.
A handler procedure invoked by the system during a call to
@scheme[yield] can itself call @scheme[yield], creating
@ -180,18 +180,18 @@ Evaluating @scheme[(yield 'wait)] is thus similar to
sensitive to whether the current thread is a handler thread, instead
of the value of the @scheme[current-eventspace] parameter.
If @scheme[v] is an event in MzScheme's sense (not to be confused with a
GUI event), @scheme[yield] blocks on @scheme[v] in the same way as
MzScheme's \Mzhyperref{@scheme[sync]}{mz:sync}, except that it may
start a @scheme[sync] on @scheme[v] multiple times (but it will complete
a @scheme[sync] on @scheme[v] at most one time). If the current thread
is the current eventspace's handler thread, events are dispatched
until a @scheme[v] sync succeeds on a MrEd event boundary. For other
threads, calling @scheme[yield] with a MzScheme event is
equivalent to calling @scheme[sync]. In either case, the result is
the same that of @scheme[sync]; however, if a wrapper procedure is
associated with @scheme[v] via @scheme[handle-evt], it is not called in
tail position with respect to the @scheme[yield].
If @scheme[v] is an event in MzScheme's sense (not to be confused with
a GUI event), @scheme[yield] blocks on @scheme[v] in the same way as
@scheme[sync], except that it may start a @scheme[sync] on @scheme[v]
multiple times (but it will complete a @scheme[sync] on @scheme[v] at
most one time). If the current thread is the current eventspace's
handler thread, events are dispatched until a @scheme[v] sync
succeeds on a MrEd event boundary. For other threads, calling
@scheme[yield] with a MzScheme event is equivalent to calling
@scheme[sync]. In either case, the result is the same that of
@scheme[sync]; however, if a wrapper procedure is associated with
@scheme[v] via @scheme[handle-evt], it is not called in tail position
with respect to the @scheme[yield].
Always use @scheme[(yield @scheme[v])] instead of a busy-wait loop.
}

6
collects/scribblings/gui/font-config.scrbl
View File

@ -2,7 +2,7 @@
@require["common.ss"]
@require[(lib "bnf.ss" "scribble")]
@title[#:tag "mr:fontresources"]{Font Configuration}
@title[#:tag "fontresources"]{Font Configuration}
This chapter describes how to set up face mappings for screen and
PostScript fonts via preferences (see @|mrprefsdiscuss|). The
@ -50,7 +50,7 @@ The value of the preference is parsed as described in
@; ------------------------------------------------------------------------
@section[#:tag "mr:exampleresources"]{Wildcards}
@section[#:tag "exampleresources"]{Wildcards}
Building items names by concatenating @nonterm{dest}, @nonterm{type},
@nonterm{weight}, and @nonterm{style} can create a large number of preference
@ -319,7 +319,7 @@ Internal preferences for Mac OS X only:
@; ------------------------------------------------------------------------
@section[#:tag "mr:postscriptfonts"]{PostScript Fonts}
@section[#:tag "postscriptfonts"]{PostScript Fonts}
@section-index["fonts" "PostScript"]
@section-index["PostScript fonts"]

2
collects/scribblings/gui/font-funcs.scrbl
View File

@ -19,7 +19,7 @@ Returns a list of font face names available on the current system. If
Returns the built-in default face mapping for a particular font
family. The built-in default can be overridden via preferences, as
described in @secref["mr:fontresources"].
described in @secref["fontresources"].
See @scheme[font%] for information about @scheme[family].

6
collects/scribblings/gui/font-name-directory-intf.scrbl
View File

@ -35,7 +35,7 @@ To extract mapping information from @scheme[the-font-name-directory],
For a family without a face string, the corresponding font ID has a
useful built-in mapping for every platform and device. (The built-in
mapping can be overridden through the user's preferences; see
@secref["mr:fontresources"] for information.) For a family with a
@secref["fontresources"] for information.) For a family with a
face string, @scheme[the-font-name-directory] interprets the string
(in a platform-specific way) to generate a mapping for ``screen''
drawing (to a canvas's @scheme[dc<%>], a @scheme[bitmap-dc%], or a
@ -93,7 +93,7 @@ Under Windows and Mac OS X, a face name is interpreted simply as a
The mapping for face names can be overridden (on all platforms)
through the user's preferences, as described in
@secref["mr:fontresources"].
@secref["fontresources"].
@ -159,7 +159,7 @@ Font ID are useful only as mapping indices for
Gets a PostScript font name for a font ID, weight, and style
combination. The PostScript font name is used both for the font name
in PostScript output (sans character set) and as the @|AFM| file
name; see also @secref["mr:postscriptfonts"].
name; see also @secref["postscriptfonts"].
See @scheme[font%] for information about @scheme[weight] and
@scheme[style].

5
collects/scribblings/gui/gl-context-intf.scrbl
View File

@ -53,8 +53,9 @@ The lock prevents interference among OpenGL-using threads. If a
set the OpenGL context. See @scheme[gl-context<%>] for more
information on interference.
The method accepts an alternate @tech{synchronizable event} for use
while blocking for the context lock; see also @scheme[sync].
The method accepts an alternate @tech[#:doc
reference-doc]{synchronizable event} for use while blocking for the
context lock; see also @scheme[sync].
The result of the method call is the result of the thunk if it is
called, or the result of the alternate event if it is chosen instead

11
collects/scribblings/gui/gui.scrbl
View File

@ -1,12 +1,15 @@
#reader(lib "docreader.ss" "scribble")
@require["common.ss"]
@title{PLT Scheme GUI: MrEd}
@title[#:tag-prefix '(lib "gui.scrbl" "scribblings" "gui")
#:tag "top"]{PLT Scheme GUI: MrEd}
@declare-exporting[(lib "mred")]
This reference manual describes the MrEd GUI toolbox that is part of
PLT Scheme. See @secref["guide:mred"] in
@italic{@link["../guide/index.html"]{A Guide to PLT Scheme}} for an
introduction to MrEd.
PLT Scheme. See @secref[#:doc '(lib "guide.scrbl" "scribblings"
"guide") "mred"] in @italic{@link["../guide/index.html"]{A Guide to
PLT Scheme}} for an introduction to MrEd.
The @scheme[(lib "mred")] module provides all of the class, interface,
and procedure bindings defined in this manual. The

6
collects/scribblings/gui/guide.scrbl
View File

@ -11,18 +11,18 @@ For documentation purposes, the MrEd toolbox is organized into three
@item{The @deftech{windowing} toolbox, for implementing form-filling
GUI programs (such as a database query window) using buttons, menus,
text fields, and events. The windowing toolbox is described in
@secref["mr:windowing-overview"].}
@secref["windowing-overview"].}
@item{The @deftech{drawing} toolbox, for drawing pictures or
implementing dynamic GUI programs (such as a video game) using
drawing canvases, pens, and brushes. The drawing toolbox is
described in @secref["mr:drawing-overview"].}
described in @secref["drawing-overview"].}
@item{The @deftech{editor} toolbox, for developing traditional text
editors, editors that mix text and graphics, or free-form layout
editors (such as a word processor, HTML editor, or icon-based file
browser). The editor toolbox is described in
@secref["mr:editor-overview"].}
@secref["editor-overview"].}
}

4
collects/scribblings/gui/info.ss Normal file
View File

@ -0,0 +1,4 @@
(module info (lib "infotab.ss" "setup")
(define name "Scribblings: GUI")
(define scribblings '(("gui.scrbl" (multi-page main-doc)))))

4
collects/scribblings/gui/keymap-class.scrbl
View File

@ -83,7 +83,7 @@ If @scheme[try-chain?] is not @scheme[#f], keymaps chained to this one
are searched for the function name. If the function is not found and
@scheme[try-chain?] is @scheme[#f]; an exception is also raised, but
the exception handler cannot escape (see
@secref["mr:evtcontjump"]).
@secref["evtcontjump"]).
}
@ -327,7 +327,7 @@ Examples:
A call to @method[keymap% map-function] that would map a particular
key sequence both as a prefix and as a complete sequence raises an
exception, but the exception handler cannot escape (see
@secref["mr:evtcontjump"]).
@secref["evtcontjump"]).
A function name does not have to be mapped to a handler before input
states are mapped to the name; the handler is dispatched by name at

4
collects/scribblings/gui/post-script-funcs.scrbl
View File

@ -6,14 +6,14 @@
@defparam[current-ps-afm-file-paths paths (listof path?)]{
A parameter determines the list of paths that is used to find AFM
files. See @secref["mr:postscriptfonts"] for more information.
files. See @secref["postscriptfonts"] for more information.
}
@defparam[current-ps-cmap-file-paths paths (listof path?)]{
A parameter that determines the list of paths that is used to find
CMap files. See @secref["mr:postscriptfonts"] for more information.
CMap files. See @secref["postscriptfonts"] for more information.
}

6
collects/scribblings/gui/prefs.scrbl
View File

@ -1,7 +1,7 @@
#reader(lib "docreader.ss" "scribble")
@require["common.ss"]
@title[#:tag "mr:mredprefs"]{Preferences}
@title[#:tag "mredprefs"]{Preferences}
MrEd supports a number of preferences for global configuration. The
MrEd preferences are stored in the common file reported by
@ -22,7 +22,7 @@ The following are the (case-sensitive) preference names used by MrEd:
@item{@ResourceFirst{controlFontSize} --- sets the font size for
control and menu labels (Windows, X); the font is the @scheme['system]
font, which can be configured as described in
@secref["mr:fontresources"].}
@secref["fontresources"].}
@item{@ResourceFirst{defaultMenuPrefix} --- sets the prefix used by
default for menu item shortcuts under X, one of @scheme['ctl],
@ -82,4 +82,4 @@ The following are the (case-sensitive) preference names used by MrEd:
In addition, preference names built from font face names can provide
or override default entries for the @scheme[font-name-directory<%>];
see @secref["mr:fontresources"] for information.
see @secref["fontresources"] for information.

3
collects/scribblings/gui/readable-snip-intf.scrbl
View File

@ -16,7 +16,8 @@ A @scheme[readable-snip<%>] object is treated specially by the port
any/c]{
The arguments are the same as the arguments to a procedure returned by
a custom input port's @scheme[read]; see @secref["mz:customport"] for
a custom input port's @scheme[read]; see @secref[#:doc '(lib
"reference.scrbl" "scribblings" "reference") "customport"] for
details. The result is also the same as the result from a
@scheme[read]-produced procedure.

2
collects/scribblings/gui/text-class.scrbl
View File

@ -1228,7 +1228,7 @@ If the line starts with invisible @techlink{item}s and @scheme[visible?] is not
To calculate lines, if the following are true:
@itemize{
@item{the editor is not displayed (see @secref["mr:tb:miaoverview"]),}
@item{the editor is not displayed (see @secref["tb:miaoverview"]),}
@item{a maximum width is set for the editor, and}

2
collects/scribblings/gui/timer-class.scrbl
View File

@ -18,7 +18,7 @@ Timers have a relatively high priority in the event queue. Thus, if
within the @method[timer% notify] procedure to allow guaranteed event
processing.
See @secref["mr:eventspaceinfo"] for more information about event
See @secref["eventspaceinfo"] for more information about event
priorities.

73
collects/scribblings/gui/win-overview.scrbl
View File

@ -3,7 +3,7 @@
@require["common.ss"]
@require["diagrams.ss"]
@title[#:tag "mr:windowing-overview"]{Windowing}
@title[#:tag "windowing-overview"]{Windowing}
@section{Basic GUI Building Blocks}
@ -18,7 +18,7 @@ MrEd's windowing toolbox provides the basic building blocks of GUI
(define frame (new frame% [label "Example"]))
(code:comment #, @t{Show the frame by calling its @method[top-level-window<%> show] method})
(send frame top-level-window::show #t)
(send frame #,(:: top-level-window<%> show) #t)
]
The built-in classes provide various mechanisms for handling GUI
@ -103,7 +103,7 @@ The system dispatches GUI events sequentially; that is, after invoking
After the user clicks @onscreen{Pause}, the entire frame becomes
unresponsive for five seconds; the system cannot dispatch more events
until the call to @scheme[sleep] returns. For more information about
event dispatching, see @secref["mr:eventspaceinfo"].
event dispatching, see @secref["eventspaceinfo"].
In addition to dispatching events, the GUI classes also handle the
graphical layout of windows. Our example frame demonstrates a simple
@ -128,7 +128,7 @@ In addition to dispatching events, the GUI classes also handle the
]
For more information about window layout and containers, see
@secref["mr:containeroverview"].
@secref["containeroverview"].
@section{Core Windowing Classes}
@ -180,7 +180,7 @@ The fundamental graphical element in MrEd's windowing toolbox is an
@item{@scheme[editor-canvas%] --- an @deftech{editor canvas} is a
subwindow for displaying a text editor or pasteboard editor. The
@scheme[editor-canvas%] class is documented with the editor classes
in @secref["mr:editor-overview"].}
in @secref["editor-overview"].}
@item{@deftech{Controls} --- containees that the user can manipulate:
@ -318,7 +318,7 @@ system:
@; ------------------------------------------------------------------------
@section[#:tag "mr:containeroverview"]{Geometry Management}
@section[#:tag "containeroverview"]{Geometry Management}
MrEd's geometry management makes it easy to design windows that look
right on all platforms, despite different graphical representations
@ -385,15 +385,15 @@ As the example demonstrates, a stretchable container grows to fill its
The following subsections describe the container system in detail,
first discussing the attributes of a containee in
@secref["mr:containees"], and then describing
@secref["containees"], and then describing
the attributes of a container in
@secref["mr:containers"]. In addition to the
@secref["containers"]. In addition to the
built-in vertical and horizontal containers, programmers can define
new types of containers as discussed in the final subsection,
@secref["mr:new-containers"].
@secref["new-containers"].
@subsection[#:tag "mr:containees"]{Containees}
@subsection[#:tag "containees"]{Containees}
Each @tech{containee}, or child, has the following properties:
@ -414,7 +414,7 @@ A @tech{container} arranges its children based on these four
container is specified when the @tech{containee} is created, and the
parent cannot be changed. However, a @tech{containee} can be
@tech{hidden} or @tech{deleted} within its parent, as described in
@secref["mr:containers"].
@secref["containers"].
The @deftech{graphical minimum size} of a particular containee, as
reported by @method[area<%> get-graphical-min-size], depends on the
@ -462,7 +462,7 @@ In practice, the @tech{requested minimum size} and @tech{margin} of a
containee, depending on the visual effect desired by the programmer.
@subsection[#:tag "mr:containers"]{Containers}
@subsection[#:tag "containers"]{Containers}
A container has the following properties:
@ -573,7 +573,7 @@ The alignment specification for a container determines how it
the container. A container's alignment is changed with the
@method[area-container<%> set-alignment] method.
@subsection[#:tag "mr:new-containers"]{Defining New Types of Containers}
@subsection[#:tag "new-containers"]{Defining New Types of Containers}
Although nested horizontal and vertical containers can express most
layout patterns, a programmer can define a new type of container with
@ -613,7 +613,7 @@ The widths and heights for both the input and output include the
placing the control.
@section[#:tag "mr:mouseandkey"]{Mouse and Keyboard Events}
@section[#:tag "mouseandkey"]{Mouse and Keyboard Events}
Whenever the user moves the mouse, clicks or releases a mouse button,
or presses a key on the keyboard, an event is generated for some
@ -698,7 +698,7 @@ Controls, such as buttons and list boxes, handle keyboard and mouse
@; ------------------------------------------------------------------------
@section[#:tag "mr:eventspaceinfo"]{Event Dispatching and Eventspaces}
@section[#:tag "eventspaceinfo"]{Event Dispatching and Eventspaces}
@section-index["events" "dispatching"]
@ -754,12 +754,12 @@ In MrEd, an @deftech{eventspace} is a context for processing GUI
@index['("dialogs" "modal")]{When} a frame or dialog is created
without a parent, it is associated with the @tech{current eventspace}
as described in @secref["mr:currenteventspace"]. Events for a
as described in @secref["currenteventspace"]. Events for a
top-level window and its descendants are always dispatched in the
window's eventspace. Every dialog is modal; a dialog's
@method[dialog% show] method implicitly calls @scheme[yield] to
handle events while the dialog is shown. (See also
@secref["mr:espacethreads"] for information about threads and modal
@secref["espacethreads"] for information about threads and modal
dialogs.) Furthermore, when a modal dialog is shown, the system
disables all other top-level windows in the dialog's eventspace, but
windows in other eventspaces are unaffected by the modal dialog.
@ -783,7 +783,7 @@ In addition to events corresponding to user and windowing actions,
call the timer's @method[timer% notify] method. Like a top-level
window, each timer is associated with a particular eventspace (the
@tech{current eventspace} as described in
@secref["mr:currenteventspace"]) when it is created, and the timer
@secref["currenteventspace"]) when it is created, and the timer
queues the event in its eventspace.
@deftech{Explicitly queued events} are created with
@ -817,10 +817,10 @@ Although a programmer has no direct control over the order in which
dispatches by setting the event dispatch handler via the
@scheme[event-dispatch-handler] parameter. This parameter and other
eventspace procedures are described in more detail in
@secref["mr:eventspace-funcs"].
@secref["eventspace-funcs"].
@subsection[#:tag "mr:espacethreads"]{Eventspaces and Threads}
@subsection[#:tag "espacethreads"]{Eventspaces and Threads}
When a new eventspace is created, a corresponding @deftech{handler
thread} is created for the eventspace. When the system dispatches an
@ -840,7 +840,7 @@ When a handler thread shows a dialog, the dialog's @method[dialog%
@scheme[semaphore-wait].
@subsection[#:tag "mr:currenteventspace"]{Creating and Setting the Eventspace}
@subsection[#:tag "currenteventspace"]{Creating and Setting the Eventspace}
Whenever a frame, dialog, or timer is created, it is associated with
the @deftech{current eventspace} as determined by the
@ -858,23 +858,24 @@ The @scheme[make-eventspace] procedure creates a new
]
When an eventspace is created, it is placed under the management of
the @tech{current custodian}. When a custodian shuts down an
eventspace, all frames and dialogs associated with the eventspace are
destroyed (without calling @method[top-level-window<%> can-close?]
or @xmethod[top-level-window<%> on-close]), all timers in the
eventspace are stopped, and all enqueued callbacks are removed.
Attempting to create a new window, timer, or explicitly queued event
in a shut-down eventspace raises the @scheme[exn:misc] exception.
the @tech[#:doc reference-doc]{current custodian}. When a custodian
shuts down an eventspace, all frames and dialogs associated with the
eventspace are destroyed (without calling @method[top-level-window<%>
can-close?] or @xmethod[top-level-window<%> on-close]), all timers
in the eventspace are stopped, and all enqueued callbacks are
removed. Attempting to create a new window, timer, or explicitly
queued event in a shut-down eventspace raises the @scheme[exn:misc]
exception.
An eventspace is a @techlink{synchronizable event} (not to be confused
with a GUI event), so it can be used with @scheme[sync]. As a
synchronizable event, an eventspace is in a blocking state when a
frame is visible, a timer is active, a callback is queued, or a
@scheme[menu-bar%] is created with a @scheme['root] parent. (Note
that the blocking state of an eventspace is unrelated to whether an
event is ready for dispatching.)
An eventspace is a @techlink[#:doc reference-doc]{synchronizable
event} (not to be confused with a GUI event), so it can be used with
@scheme[sync]. As a synchronizable event, an eventspace is in a
blocking state when a frame is visible, a timer is active, a callback
is queued, or a @scheme[menu-bar%] is created with a @scheme['root]
parent. (Note that the blocking state of an eventspace is unrelated
to whether an event is ready for dispatching.)
@subsection[#:tag "mr:evtcontjump"]{Exceptions and Continuation Jumps}
@subsection[#:tag "evtcontjump"]{Exceptions and Continuation Jumps}
Whenever the system dispatches an event, the call to the handler
procedure is wrapped so that full continuation jumps are not allowed

10
collects/scribblings/guide/apply.scrbl
View File

@ -3,7 +3,7 @@
@require[(lib "eval.ss" "scribble")]
@require["guide-utils.ss"]
@title[#:tag "guide:application"]{Function Calls@aux-elem{ (Procedure Applications)}}
@title[#:tag "application"]{Function Calls@aux-elem{ (Procedure Applications)}}
An expression of the form
@ -39,14 +39,14 @@ arguments. A function's @idefterm{arity} is the number of arguments
that it accepts.
@;------------------------------------------------------------------------
@section[#:tag "guide:keyword-args"]{Keyword Arguments}
@section[#:tag "keyword-args"]{Keyword Arguments}
Some functions accept @defterm{keyword arguments} in addition to
by-position arguments. For that case, an @scheme[_arg] can be an
@scheme[_arg-keyword _arg-expr] sequence instead of just a
@scheme[_arg-expr]:
@guideother{@secref["guide:keywords"] introduces keywords.}
@guideother{@secref["keywords"] introduces keywords.}
@specform/subs[
(_proc-expr _arg ...)
@ -78,10 +78,10 @@ above call to @scheme[go] can be equivalently written
@schemeblock[(go #:mode 'fast "super.ss")]
@refdetails["mz:application"]{procedure applications}
@refdetails["application"]{procedure applications}
@;------------------------------------------------------------------------
@section[#:tag "guide:apply"]{The @scheme[apply] Function}
@section[#:tag "apply"]{The @scheme[apply] Function}
The syntax for function calls supports any number of arguments, but a
specific call always specifies a fixed number of arguments. As a

12
collects/scribblings/guide/begin.scrbl
View File

@ -3,7 +3,7 @@
@require[(lib "eval.ss" "scribble")]
@require["guide-utils.ss"]
@title[#:tag "guide:begin"]{Sequencing}
@title[#:tag "begin"]{Sequencing}
Scheme programmers prefer to write programs with as few side-effects
as possible, since purely functional code is more easily tested and
@ -14,7 +14,7 @@ display, opening a graphical window, or manipulating a file on disk.
@;------------------------------------------------------------------------
@section{Effects Before: @scheme[begin]}
@refalso["mz:begin"]{@scheme[begin]}
@refalso["begin"]{@scheme[begin]}
A @scheme[begin] expression sequences expressions:
@ -64,12 +64,12 @@ positions, instead of forming an expression, the content of
]
This splicing behavior is mainly useful for macros, as we discuss
later in @secref["guide:macros"].
later in @secref["macros"].
@;------------------------------------------------------------------------
@section{Effects After: @scheme[begin0]}
@refalso["mz:begin"]{@scheme[begin0]}
@refalso["begin"]{@scheme[begin0]}
A @scheme[begin0] expression has the same syntax as a @scheme[begin]
expression:
@ -93,9 +93,9 @@ computation produces an unknown number of results.
]
@;------------------------------------------------------------------------
@section[#:tag "guide:when+unless"]{Effects If...: @scheme[when] and @scheme[unless]}
@section[#:tag "when+unless"]{Effects If...: @scheme[when] and @scheme[unless]}
@refalso["mz:when+unless"]{@scheme[when] and @scheme[unless]}
@refalso["when+unless"]{@scheme[when] and @scheme[unless]}
The @scheme[when] form combines an @scheme[if]-style conditional with
sequencing for the ``then'' clause and no ``else'' clause:

4
collects/scribblings/guide/binding.scrbl
View File

@ -3,7 +3,7 @@
@require[(lib "eval.ss" "scribble")]
@require["guide-utils.ss"]
@title[#:tag "guide:binding"]{Identifiers and Binding}
@title[#:tag "binding"]{Identifiers and Binding}
The context of an expression determines the meaning of identifiers
that appear in the expression. In particular, starting a module with
@ -16,7 +16,7 @@ start with the meaning described here: @scheme[cons] refers to the
function that creates a pair, @scheme[car] refers to the function
that extracts the first element of a pair, and so on.
@guideother{@secref["guide:symbols"] introduces the syntax of
@guideother{@secref["symbols"] introduces the syntax of
identifiers.}
Forms like @scheme[define], @scheme[lambda], and @scheme[let]

2
collects/scribblings/guide/booleans.scrbl
View File

@ -3,7 +3,7 @@
@require[(lib "eval.ss" "scribble")]
@require["guide-utils.ss"]
@title[#:tag "guide:booleans"]{Booleans}
@title[#:tag "booleans"]{Booleans}
Scheme has two distinguished constants to represent boolean values:
@scheme[#t] for true and @scheme[#f] for false. Uppercase

2
collects/scribblings/guide/boxes.scrbl
View File

@ -18,4 +18,4 @@ b
b
]
@refdetails["mz:boxes"]{boxes and box procedures}
@refdetails["boxes"]{boxes and box procedures}

10
collects/scribblings/guide/byte-strings.scrbl
View File

@ -3,7 +3,7 @@
@require[(lib "eval.ss" "scribble")]
@require["guide-utils.ss"]
@title[#:tag "guide:bytestrings"]{Bytes and Byte Strings}
@title[#:tag "bytestrings"]{Bytes and Byte Strings}
A @defterm{byte} is an inexact integer between @scheme[0] and
@scheme[255], inclusive. The @scheme[byte?] predicate recognizes
@ -15,7 +15,7 @@ numbers that represent bytes.
]
A @defterm{byte string} is similar to a string---see
@secref["guide:strings"]---but its content is a sequence of bytes
@secref["strings"]---but its content is a sequence of bytes
instead of characters. Byte strings can be used in applications that
process pure ASCII instead of Unicode text. The printed and form of a
byte string supports such uses in particular, because a byte string
@ -23,7 +23,7 @@ prints like the ASCII decoding of the byte string, but prefixed with a
@litchar{#}. Unprintable ASCII characters or non-ASCII bytes in the
byte string are written with octal notation.
@refdetails/gory["mz:parse-string"]{the syntax of byte strings}
@refdetails/gory["parse-string"]{the syntax of byte strings}
@examples[
#"Apple"
@ -37,7 +37,7 @@ b
]
The @scheme[display] form of a byte string writes its raw bytes to the
current output port (see @secref["guide:i/o"]). Technically,
current output port (see @secref["i/o"]). Technically,
@scheme[display] of a normal (i.e,. character) string prints the UTF-8
encoding of the string to the current output port, since output is
ultimately defined in terms of bytes; @scheme[display] of a byte
@ -72,4 +72,4 @@ arbitrary string encodings.
(bytes->string/utf-8 dest))
]
@refdetails["mz:bytestrings"]{byte strings and byte-string procedures}
@refdetails["bytestrings"]{byte strings and byte-string procedures}

8
collects/scribblings/guide/certificates.scrbl
View File

@ -59,7 +59,7 @@ these certifications, the macro expander rejects the local-binding
reference, and @scheme[unchecked-go] remains protected.
In much the same way that the macro expander copies properties from a
syntax transformer's input to its output (see @secref["mz:stxprops"]),
syntax transformer's input to its output (see @refsecref["stxprops"]),
the expander copies certificates from a transformer's input to its
output. Building on the previous example,
@ -81,11 +81,11 @@ to @scheme[unchecked-go].
When a protected identifier becomes inaccessible by direct reference
(i.e., when the current code inspector is changed so that it does not
control the module's invocation; see @secref["mz:modprotect"]), the
control the module's invocation; see @refsecref["modprotect"]), the
protected identifier is treated like an unexported identifier.
@;------------------------------------------------------------------------
@section[#:tag "mz:stxinactivecerts"]{Certificate Propagation}
@section[#:tag "stxinactivecerts"]{Certificate Propagation}
When the result of a macro expansion contains a @scheme[quote-syntax]
form, the macro expansion's certificate must be attached to the
@ -239,7 +239,7 @@ handling recursively, in case a macro produces a @scheme[begin] form
that contains nested @scheme[define-values] forms.
The default application of certificates can be overridden by attaching
a @scheme['certify-mode] property (see @secref["mz:stxprops"]) to the
a @scheme['certify-mode] property (see @refsecref["stxprops"]) to the
result syntax object of a macro transformer. If the property value is
@scheme['opaque], then the certificate is attached to the syntax
object and not its parts. If the property value is

12
collects/scribblings/guide/char-strings.scrbl
View File

@ -3,10 +3,10 @@
@require[(lib "eval.ss" "scribble")]
@require["guide-utils.ss"]
@title[#:tag "guide:strings"]{Strings (Unicode)}
@title[#:tag "strings"]{Strings (Unicode)}
A @defterm{string} is a fixed-length array of
@seclink["guide:characters"]{characters}. It prints using doublequotes,
@seclink["characters"]{characters}. It prints using doublequotes,
where doublequote and backslash characters within the string are
escaped with backslashes. Other common string escapes are supported,
including @litchar["\\n"] for a linefeed, @litchar["\\r"] for a
@ -15,10 +15,10 @@ to three octal digits, and hexadimal escapes with @litchar["\\u"]
(up to four digits). Unprintable characters in a string normally
shown with @litchar["\\u"] when the string is printed.
@refdetails/gory["mz:parse-string"]{the syntax of strings}
@refdetails/gory["parse-string"]{the syntax of strings}
The @scheme[display] procedure directly writes the characters of a
string to the current output port (see @secref["guide:i/o"]), in contrast
string to the current output port (see @secref["i/o"]), in contrast
to the string-constant syntax used to print a string result.
@examples[
@ -66,6 +66,6 @@ for an end user.
For working with plain ASCII, working with raw bytes, or
encoding/decoding Unicode strings as bytes, use
@seclink["guide:bytestrings"]{byte strings}.
@seclink["bytestrings"]{byte strings}.
@refdetails["mz:strings"]{strings and string procedures}
@refdetails["strings"]{strings and string procedures}

8
collects/scribblings/guide/chars.scrbl
View File

@ -3,7 +3,7 @@
@require[(lib "eval.ss" "scribble")]
@require["guide-utils.ss"]
@title[#:tag "guide:characters"]{Characters}
@title[#:tag "characters"]{Characters}
A Scheme @defterm{character} corresponds to a Unicode @defterm{scalar
value}. Roughly, a scalar value is an unsigned integer whose
@ -26,7 +26,7 @@ number. A few characters are printed specially; for example, the space
and linefeed characters print as @scheme[#\space] and
@scheme[#\newline], respectively.
@refdetails/gory["mz:parse-character"]{the syntax of characters}
@refdetails/gory["parse-character"]{the syntax of characters}
@examples[
(integer->char 65)
@ -38,7 +38,7 @@ and linefeed characters print as @scheme[#\space] and
]
The @scheme[display] procedure directly writes a character to the
current output port (see @secref["guide:i/o"]), in contrast to the
current output port (see @secref["i/o"]), in contrast to the
character-constant syntax used to print a character result.
@examples[
@ -72,4 +72,4 @@ characters.
(eqv? #\a #\A)
]
@refdetails["mz:characters"]{characters and character procedures}
@refdetails["characters"]{characters and character procedures}

12
collects/scribblings/guide/class.scrbl
View File

@ -95,7 +95,7 @@ avoid imperative assignment. The relative order of method declarations
makes no difference for evaluation, because methods are fully defined
before a class is instantiated.
@section[#:tag "guide:methods"]{Methods}
@section[#:tag "methods"]{Methods}
Each of the three @scheme[define/public] declarations in
@scheme[fish%] introduces a new method. The declaration uses the same
@ -196,7 +196,7 @@ overridden method via a @scheme[super] call. For example, the
@scheme[grow] implementation in @scheme[picky-fish%] uses
@scheme[super] to delegate to the superclass implementation.
@section[#:tag "guide:initargs"]{Initialization Arguments}
@section[#:tag "initargs"]{Initialization Arguments}
Since @scheme[picky-fish%] declares no initialization arguments, any
initialization values supplied in @scheme[(new picky-fish% ...)] are
@ -235,7 +235,7 @@ In this example, the @scheme[super-new] call propagates its own
@scheme[size] value as the @scheme[size] initialization argument to
the superclass.
@section[#:tag "guide:intnames"]{Internal and External Names}
@section[#:tag "intnames"]{Internal and External Names}
The two uses of @scheme[size] in @scheme[default-10-fish%] expose the
double life of class-member identifiers. When @scheme[size] is the
@ -298,7 +298,7 @@ checks whether the object's class implements the interface. In
addition, the @scheme[implementation?] predicate checks whether a
given class implements a given interface.
@section[#:tag "guide:inner"]{Final, Augment, and Inner}
@section[#:tag "inner"]{Final, Augment, and Inner}
As in Java, a method in a @scheme[class] form can be specified as
@defterm{final}, which means that a subclass cannot override the
@ -324,9 +324,9 @@ and makes the overriding implementation augmentable. Our earlier
work~\cite{Super+Inner} motivates and explains these extensions and
their interleaving.
@section[#:tag "guide:extnames"]{Controlling the Scope of External Names}
@section[#:tag "extnames"]{Controlling the Scope of External Names}
As noted in @secref["guide:intnames"], class members have both
As noted in @secref["intnames"], class members have both
internal and external names. A member definition binds an internal
name locally, and this binding can be locally renamed. External
names, in contrast, have global scope by default, and a member

16
collects/scribblings/guide/cond.scrbl
View File

@ -3,7 +3,7 @@
@require[(lib "eval.ss" "scribble")]
@require["guide-utils.ss"]
@title[#:tag "guide:conditionals"]{Conditionals}
@title[#:tag "conditionals"]{Conditionals}
Most functions used for branching, such as @scheme[<] and
@scheme[string?], produce either @scheme[#t] or @scheme[#f]. Scheme's
@ -35,7 +35,7 @@ list:
@;------------------------------------------------------------------------
@section{Simple Branching: @scheme[if]}
@refalso["mz:if"]{@scheme[if]}
@refalso["if"]{@scheme[if]}
In an @scheme[if] form,
@ -48,12 +48,12 @@ evaluated. Otherwise, @scheme[_else-expr] is evaluated.
An @scheme[if] form must have both an @scheme[_then-expr] and an
@scheme[_else-expr]; the latter is not optional. To perform (or skip)
side-effects based on a @scheme[_test-expr], use @scheme[when] or
@scheme[unless], which we describe later in @secref["guide:begin"].
@scheme[unless], which we describe later in @secref["begin"].
@;------------------------------------------------------------------------
@section[#:tag "guide:and+or"]{Combining Tests: @scheme[and] and @scheme[or]}
@section[#:tag "and+or"]{Combining Tests: @scheme[and] and @scheme[or]}
@refalso["mz:if"]{@scheme[and] and @scheme[or]}
@refalso["if"]{@scheme[and] and @scheme[or]}
Scheme's @scheme[and] and @scheme[or] are syntactic forms, rather than
functions. Unlike a function, the @scheme[and] and @scheme[or] forms
@ -90,16 +90,16 @@ the @scheme[and] or @scheme[or] result. Therefore, the last
@scheme[expr] is in tail position, which means that the above
@scheme[got-milk?] function runs in constant space.
@guideother{@secref["guide:tail-recursion"] introduces tail calls and tail positions.}
@guideother{@secref["tail-recursion"] introduces tail calls and tail positions.}
@;------------------------------------------------------------------------
@section[#:tag "guide:cond"]{Chaining Tests: @scheme[cond]}
@section[#:tag "cond"]{Chaining Tests: @scheme[cond]}
The @scheme[cond] form chains a series of tests to select a result
expression. To a first approximation, the syntax of @scheme[cond] is
as follows:
@refalso["mz:if"]{@scheme[cond]}
@refalso["if"]{@scheme[cond]}
@specform[(cond [test-expr expr ...+]
...)]

2
collects/scribblings/guide/data.scrbl
View File

@ -3,7 +3,7 @@
@require[(lib "eval.ss" "scribble")]
@require["guide-utils.ss"]
@title[#:tag "guide:datatypes" #:style 'toc]{Built-In Datatypes}
@title[#:tag "datatypes" #:style 'toc]{Built-In Datatypes}
The @seclink["to-scheme"]{previous chapter} introduced some of
Scheme's built-in datatype: numbers, booleans, strings, lists, and

22
collects/scribblings/guide/define-struct.scrbl
View File

@ -4,9 +4,9 @@
@require[(lib "bnf.ss" "scribble")]
@require["guide-utils.ss"]
@title[#:tag "guide:define-struct"]{Programmer-Defined Datatypes}
@title[#:tag "define-struct"]{Programmer-Defined Datatypes}
@refalso["mz:structures"]{structure types}
@refalso["structures"]{structure types}
New datatypes are normally created with the @scheme[define-struct]
form, which is the topic of this chapter. The class-based object
@ -17,7 +17,7 @@ implemented in terms of structure types.
@; ------------------------------------------------------------
@section{Simple Structure Types: @scheme[define-struct]}
@refalso["mz:define-struct"]{@scheme[define-struct]}
@refalso["define-struct"]{@scheme[define-struct]}
To a first approximation, the syntax of @scheme[define-struct] is
@ -35,7 +35,7 @@ posn
]
We explain one use of the @scheme[_struct-id] binding in the next
section, @secref["guide:struct-subtypes"].
section, @secref["struct-subtypes"].
Meanwhile, in addition to defining @scheme[_struct-id],
@scheme[define-struct] also defines a number of identifiers that are
@ -78,7 +78,7 @@ built from @scheme[_struct-id] and the @scheme[_field-id]s:
@deftech{structure type descriptor}, which is a value that
represents the structure type as a first-class value (with
@scheme[#:super], as discussed later in
@secref["guide:struct-options"]).}
@secref["struct-options"]).}
}
@ -89,10 +89,10 @@ instance of @scheme[posn], even though @scheme["apple"] and
@scheme[#f] are not valid coordinates for the obvious uses of
@scheme[posn] instances. Enforcing constraints on field values, such
as requiring them to be numbers, is normally the job of a contract, as
discussed later in @secref["guide:contracts"].
discussed later in @secref["contracts"].
@; ------------------------------------------------------------
@section[#:tag "guide:struct-subtypes"]{Structure Subtypes}
@section[#:tag "struct-subtypes"]{Structure Subtypes}
An extended form of @scheme[define-struct] can be used to define a
@defterm{structure subtype}, which is a structure type that extends an
@ -126,7 +126,7 @@ p
]
@; ------------------------------------------------------------
@section[#:tag "guide:trans-struct"]{Opaque versus Transparent Stucture Types}
@section[#:tag "trans-struct"]{Opaque versus Transparent Stucture Types}
With a structure type definition like
@ -164,7 +164,7 @@ library cannot manipulate the data in the structure except as allowed
by the library.
@; ------------------------------------------------------------
@section[#:tag "guide:struct-options"]{More Structure Type Options}
@section[#:tag "struct-options"]{More Structure Type Options}
The full syntax of @scheme[define-struct] supports many options, both
at the structure-type level and at the level of individual fields:
@ -198,7 +198,7 @@ A @scheme[_struct-option] always starts with a keyword:
@specspecsubform[(code:line #:inspector inspector-expr)]{
Controls reflective access to structure instances, as discussed
in the previous section (@secref["guide:trans-struct"]).
in the previous section (@secref["trans-struct"]).
}
@specspecsubform[(code:line #:auto-value auto-expr)]{
@ -327,4 +327,4 @@ times.
(add-bigger-fish (add-bigger-fish null))
]
@refdetails["mz:structures"]{structure types}
@refdetails["structures"]{structure types}

14
collects/scribblings/guide/define.scrbl
View File

@ -4,7 +4,7 @@
@require["guide-utils.ss"]
@require[(lib "string.ss")]
@title[#:tag "guide:define"]{Definitions: @scheme[define]}
@title[#:tag "define"]{Definitions: @scheme[define]}
A basic definition has the form
@ -127,7 +127,7 @@ for each @scheme[_head] in the definition, where the innermost
@;------------------------------------------------------------------------
@section[#:tag "guide:multiple-values"]{Multiple Values and @scheme[define-values]}
@section[#:tag "multiple-values"]{Multiple Values and @scheme[define-values]}
A Scheme expression normally produces a single result, but some
expressions can produce multiple results. For example,
@ -176,10 +176,10 @@ surname
A @scheme[define] form (that is not a function shorthand) is
equivalent to a @scheme[define-values] form with a single @scheme[_id].
@refdetails["mz:define"]{definitions}
@refdetails["define"]{definitions}
@;------------------------------------------------------------------------
@section[#:tag "guide:intdefs"]{Internal Definitions}
@section[#:tag "intdefs"]{Internal Definitions}
When the grammar for a syntactic form specifies @scheme[_body], then
the corresponding form can be either a definition or an expression.
@ -240,7 +240,7 @@ A sequence of internal definitions using just @scheme[define] is
easily translated to an equivalent @scheme[letrec] form (as introduced
in the next section). However, other definition forms can appear as a
@scheme[_body], including @scheme[define-values], @scheme[define-struct] (see
@secref["guide:define-struct"]) or @scheme[define-syntax] (see
@secref["guide:macros"]).
@secref["define-struct"]) or @scheme[define-syntax] (see
@secref["macros"]).
@refdetails/gory["mz:intdef-body"]{internal definitions}
@refdetails/gory["intdef-body"]{internal definitions}

10
collects/scribblings/guide/for.scrbl
View File

@ -4,7 +4,7 @@
@require["guide-utils.ss"]
@require[(lib "for.ss")]
@title[#:tag "guide:for"]{Iterations and Comprehensions}
@title[#:tag "for"]{Iterations and Comprehensions}
The @scheme[for] family of syntactic forms support iteration over
@defterm{sequences}. Lists, vectors, strings, byte strings, input
@ -55,7 +55,7 @@ iterations can be included along with bindings.
Before details on the variations of @scheme[for], though, it's best to
see the kinds of sequence generators that make interesting examples.
@section[#:tag "guide:sequences"]{Sequence Constructors}
@section[#:tag "sequences"]{Sequence Constructors}
The @scheme[in-range] function generates a sequence of numbers, given
an optional starting number (which defaults to @scheme[0]), a number
@ -115,7 +115,7 @@ code generation; see @secref["for-performance"] for more information.
(display i))
]
@refdetails["mz:sequences"]{sequences}
@refdetails["sequences"]{sequences}
@section{@scheme[for] and @scheme[for*]}
@ -290,7 +290,7 @@ the same facility with nested iterations:
(list book chapter))
]
@section[#:tag "guide:for/fold"]{@scheme[for/fold] and @scheme[for*/fold]}
@section[#:tag "for/fold"]{@scheme[for/fold] and @scheme[for*/fold]}
The @scheme[for/fold] form generalizes the way to combine iteration
results. Its syntax is slightly different than the syntax of
@ -438,4 +438,4 @@ set of sequence values. The documentation for a sequence constructor
should indicate the performance benefits of using it directly in
a @scheme[for] @scheme[_clause].
@refdetails["mz:for"]{iterations and comprehensions}
@refdetails["for"]{iterations and comprehensions}

4
collects/scribblings/guide/forms.scrbl
View File

@ -12,7 +12,7 @@ additional basic forms.
@local-table-of-contents[]
@section[#:tag "guide:syntax-notation"]{Notation}
@section[#:tag "syntax-notation"]{Notation}
This chapter (and the rest of the documentation) uses a slightly
different notation than the character-based grammars of the
@ -42,7 +42,7 @@ convention implicitly defines the meaning of many meta-variables:
sub-form; it will be parsed as either a local definition or an
expression. A @scheme[_body] can parse as a definition only if
it is not preceded by any expression, and the last
@scheme[_body] must be an expression; see also @secref["guide:intdefs"].}
@scheme[_body] must be an expression; see also @secref["intdefs"].}
}

21
collects/scribblings/guide/guide-utils.ss
View File

@ -6,6 +6,9 @@
(lib "eval.ss" "scribble")
"../icons.ss")
(require-for-label (lib "lang.ss" "big"))
(provide-for-label (all-from (lib "lang.ss" "big")))
(provide Quick MzScheme HtDP
tool
moreguide
@ -13,13 +16,11 @@
refalso
refdetails
refdetails/gory
refsecref)
refsecref
ext-refsecref)
(define Quick
(italic (link "../quick/index.html" "An Introduction to PLT Scheme with Pictures")))
(define MzScheme
(italic (link "../reference/index.html" "PLT Scheme Reference")))
(italic (secref #:doc '(lib "quick.scrbl" "scribblings" "quick") "top")))
(define HtDP
(italic (link "http://www.htdp.org" "How to Design Programs")))
@ -42,7 +43,7 @@
(define (refdetails* tag what . s)
(apply margin-note
(decode-content (append (list magnify (refsecref tag))
(decode-content (append (list magnify (ext-refsecref tag))
(list what)
s
(list ".")))))
@ -57,4 +58,10 @@
(apply refdetails* tag " documents the fine points of " s))
(define (refsecref s)
(make-element #f (list (secref s) " in " MzScheme))))
(secref #:doc '(lib "reference.scrbl" "scribblings" "reference") s))
(define (ext-refsecref s)
(make-element #f (list (refsecref s) " in " MzScheme)))
(define MzScheme
(italic (refsecref "top"))))

17
collects/scribblings/guide/guide.scrbl
View File

@ -3,7 +3,8 @@
@require[(lib "eval.ss" "scribble")]
@require["guide-utils.ss"]
@title{A Guide to PLT Scheme}
@title[#:tag-prefix '(lib "guide.scrbl" "scribblings" "guide")
#:tag "top"]{A Guide to PLT Scheme}
This guide is intended for programmers who are new to Scheme, new to PLT
Scheme, or new to some part of PLT Scheme. It assumes
@ -36,7 +37,7 @@ precise details to @|MzScheme| and other reference manuals.
@include-section["io.scrbl"]
@; ----------------------------------------------------------------------
@section[#:tag "guide:contracts"]{Contracts}
@section[#:tag "contracts"]{Contracts}
In the reference manual, the documentation for each procedure
describes the acceptable arguments and the result of the procedure
@ -79,6 +80,12 @@ of an expression to the values for the clause:
@; ----------------------------------------------------------------------
@section[#:tag "threads"]{Threads}
@subsection[#:tag "parameters"]{Parameters}
A @deftech{parameter} holds a kind of global option. For example,
there is a parameter that determines the default destination for
printed output.
@; ----------------------------------------------------------------------
@include-section["macros.scrbl"]
@ -97,9 +104,9 @@ of an expression to the values for the clause:
@; ----------------------------------------------------------------------
@section[#:tag "memory-management"]{Memory Management}
@subsection[#:tag "guide:weakboxes"]{Weak Boxes}
@subsection[#:tag "weakboxes"]{Weak Boxes}
@subsection[#:tag "guide:ephemerons"]{Ephemerons}
@subsection[#:tag "ephemerons"]{Ephemerons}
@; ----------------------------------------------------------------------
@section[#:tag "performance"]{Performance}
@ -121,7 +128,7 @@ constant propagation, constant folding, and inlining optimizations.
@; ----------------------------------------------------------------------
@section[#:tag "guide:mred"]{Graphical User Interfaces@aux-elem{ (GUIs)}}
@section[#:tag "mred"]{Graphical User Interfaces@aux-elem{ (GUIs)}}
@deftech{MrEd} is both a library and an executable. As a library,
@scheme[(lib "mred/mred.ss")] provides class, interface, and function

6
collects/scribblings/guide/hash-tables.scrbl
View File

@ -33,7 +33,7 @@ key--value pair. Literal hash tables are immutable.
(hash-table-get ht "apple")
]
@refdetails/gory["mz:parse-hashtable"]{the syntax of hash table literals}
@refdetails/gory["parse-hashtable"]{the syntax of hash table literals}
A hash table can optionally retain its keys @defterm{weakly}, so each
mapping is retained only so long as the key is retained elsewhere.
@ -49,7 +49,7 @@ Beware that even a weak hash table retains its values strongly, as
long as the corresponding key is accessible. This creates a catch-22
dependency when a value refers back to its key, so that the mapping is
retained permanently. To break the cycle, map the key to an
@seclink["guide:ephemerons"]{ephemeron} that pairs the value with its key (in
@seclink["ephemerons"]{ephemeron} that pairs the value with its key (in
addition to the implicit pairing of the hash table).
@examples[
@ -68,4 +68,4 @@ addition to the implicit pairing of the hash table).
(eval:alts (hash-table-count ht) 0)
]
@refdetails["mz:hashtables"]{hash tables and hash-table procedures}
@refdetails["hashtables"]{hash tables and hash-table procedures}

3
collects/scribblings/guide/info.ss Normal file
View File

@ -0,0 +1,3 @@
(module info (lib "infotab.ss" "setup")
(define name "Scribblings: Guide")
(define scribblings '(("guide.scrbl" (multi-page main-doc)))))

6
collects/scribblings/guide/io.scrbl
View File

@ -12,7 +12,7 @@
(make-flow (list b)))))]
@interaction-eval[(print-hash-table #t)]
@title[#:tag "guide:i/o" #:style 'toc]{Input and Output}
@title[#:tag "i/o" #:style 'toc]{Input and Output}
A Scheme @defterm{port} represents an input or output stream, such as
a file, a terminal, a TCP connection, or an in-memory string. More
@ -167,7 +167,7 @@ stdout in purple, and output written to stderr in red italics.
The current-port functions actually @tech{parameters}, which means
that their values can be set with @scheme[parameterize].
@moreguide["guide:parameters"]{parameters}
@moreguide["parameters"]{parameters}
@examples[
(let ([s (open-output-string)])
@ -181,7 +181,7 @@ that their values can be set with @scheme[parameterize].
@; ----------------------------------------------------------------------
@section{Reading and Writing Scheme Data}
As noted throughout @secref["guide:datatypes"], Scheme provides two
As noted throughout @secref["datatypes"], Scheme provides two
ways to print an instance of a built-in value:
@itemize{

6
collects/scribblings/guide/keywords.scrbl
View File

@ -3,13 +3,13 @@
@require[(lib "eval.ss" "scribble")]
@require["guide-utils.ss"]
@title[#:tag "guide:keywords"]{Keywords}
@title[#:tag "keywords"]{Keywords}
A @defterm{keyword} value is similar to a symbol (see
@secref["guide:symbols"]), but its printed form is prefixed with
@secref["symbols"]), but its printed form is prefixed with
@litchar{#:}.
@refdetails/gory["mz:parse-keyword"]{the syntax of keywords}
@refdetails/gory["parse-keyword"]{the syntax of keywords}
@examples[
(string->keyword "apple")

12
collects/scribblings/guide/lambda.scrbl
View File

@ -3,7 +3,7 @@
@require[(lib "eval.ss" "scribble")]
@require["guide-utils.ss"]
@title[#:tag "guide:lambda"]{Functions@aux-elem{ (Procedures)}: @scheme[lambda]}
@title[#:tag "lambda"]{Functions@aux-elem{ (Procedures)}: @scheme[lambda]}
A @scheme[lambda] expression creates a function. In the simplest
case, a @scheme[lambda] expression has the form
@ -51,7 +51,7 @@ into a list bound to @scheme[_rest-id].
Functions with a @scheme[_rest-id] often use @scheme[apply] to call
another function that accepts any number of arguments.
@guideother{@secref["guide:apply"] describes @scheme[apply].}
@guideother{@secref["apply"] describes @scheme[apply].}
@defexamples[
(define max-mag
@ -129,14 +129,14 @@ and every following @scheme[_arg-id] must have a default as well.
(greet "Adam")
]
@section[#:tag "guide:lambda-keywords"]{Declaring Keyword Arguments}
@section[#:tag "lambda-keywords"]{Declaring Keyword Arguments}
A @scheme[lambda] form can declare an argument to be passed by
keyword, instead of position. Keyword arguments can be mixed with
by-position arguments, and default-value expressions can be supplied
for either kind of argument:
@guideother{@secref["guide:keyword-args"] introduces function
@guideother{@secref["keyword-args"] introduces function
calls with keywords.}
@specform/subs[
@ -186,7 +186,7 @@ through parallel lists in the first two (by-position) arguments,
and then all by-position arguments from an application as the
remaining by-position arguments.
@guideother{@secref["guide:apply"] inroduces @scheme[keyword-apply].}
@guideother{@secref["apply"] inroduces @scheme[keyword-apply].}
@defexamples[
(define (trace-wrap f)
@ -197,7 +197,7 @@ remaining by-position arguments.
((trace-wrap greet) "John" #:hi "Howdy")
]
@refdetails["mz:lambda"]{function expressions}
@refdetails["lambda"]{function expressions}
@;------------------------------------------------------------------------
@section{Arity-Sensitive Functions: @scheme[case-lambda]}

12
collects/scribblings/guide/let.scrbl
View File

@ -3,7 +3,7 @@
@require[(lib "eval.ss" "scribble")]
@require["guide-utils.ss"]
@title[#:tag "guide:let"]{Local Binding}
@title[#:tag "let"]{Local Binding}
Although internal @scheme[define]s can be used for local binding,
Scheme provides three forms that give the programmer more
@ -13,7 +13,7 @@ control over bindings: @scheme[let], @scheme[let*], and
@;------------------------------------------------------------------------
@section{Parallel Binding: @scheme[let]}
@refalso["mz:let"]{@scheme[let]}
@refalso["let"]{@scheme[let]}
A @scheme[let] form binds a set of identifiers, each to the result of
some expression, for use in the @scheme[let] body:
@ -69,7 +69,7 @@ evaluated in order, even though the bindings are delayed until all
@;------------------------------------------------------------------------
@section{Sequential Binding: @scheme[let*]}
@refalso["mz:let"]{@scheme[let*]}
@refalso["let"]{@scheme[let*]}
The syntax of @scheme[let*] is the same as @scheme[let]:
@ -104,7 +104,7 @@ In other words, a @scheme[let*] form is equivalent to nested
@;------------------------------------------------------------------------
@section{Recursive Binding: @scheme[letrec]}
@refalso["mz:let"]{@scheme[letrec]}
@refalso["let"]{@scheme[letrec]}
The syntax of @scheme[letrec] is also the same as @scheme[let]:
@ -163,10 +163,10 @@ an @scheme[_id] is referenced before its value is ready, the result is
@; ----------------------------------------
@section{Multiple Values: @scheme[let-values], @scheme[let*-values], @scheme[letrec-values]}
@refalso["mz:let"]{multiple-value binding forms}
@refalso["let"]{multiple-value binding forms}
In the same way that @scheme[define-values] binds multiple
results in a definition (see @secref["guide:multiple-values"]),
results in a definition (see @secref["multiple-values"]),
@scheme[let-values], @scheme[let*-values], and
@scheme[letrec-values] bind multiple results locally.

4
collects/scribblings/guide/lists.scrbl
View File

@ -110,7 +110,7 @@ list loops.
Scheme provides a general @defterm{list compherension} form
@scheme[for/list], which builds a list by iterating through
@defterm{sequences}. List comprehensions and related iteration forms
are described in see @secref["guide:for"].
are described in see @secref["for"].
@;------------------------------------------------------------------------
@section{List Iteration from Scratch}
@ -183,7 +183,7 @@ consider reading @|HtDP|. If you are merely suspicious of the use
of recursive calls instead of a looping construct, then read on.
@;------------------------------------------------------------------------
@section[#:tag "guide:tail-recursion"]{Tail Recursion}
@section[#:tag "tail-recursion"]{Tail Recursion}
Both the @scheme[my-length] and @scheme[my-map] functions run in
@math{O(n)} time for a list of length @math{n}. This is easy to see by

2
collects/scribblings/guide/macros.scrbl
View File

@ -3,7 +3,7 @@
@require[(lib "eval.ss" "scribble")]
@require["guide-utils.ss"]
@title[#:tag "guide:macros" #:style 'toc]{Syntactic Extension@aux-elem{ (Macros)}}
@title[#:tag "macros" #:style 'toc]{Syntactic Extension@aux-elem{ (Macros)}}
@local-table-of-contents[]

4
collects/scribblings/guide/module-basics.scrbl
View File

@ -3,7 +3,7 @@
@require[(lib "eval.ss" "scribble")]
@require["guide-utils.ss"]
@title[#:tag "guide:module-basics"]{Module Basics}
@title[#:tag "module-basics"]{Module Basics}
The space of module names is distinct from the space of normal Scheme
definitions. Indeed, since modules typically reside in files, the
@ -62,4 +62,4 @@ big
]
We discuss more forms of module reference later in
@secref["guide:module-paths"].
@secref["module-paths"].

6
collects/scribblings/guide/module-paths.scrbl
View File

@ -3,7 +3,7 @@
@require[(lib "eval.ss" "scribble")]
@require["guide-utils.ss"]
@title[#:tag "guide:module-paths"]{Module Paths}
@title[#:tag "module-paths"]{Module Paths}
A @deftech{module path} is a reference to a module, as used with
@scheme[require] or as the @scheme[_initial-module-path] in a
@ -40,7 +40,7 @@ to the current directory. (More precisely, the path is relative to the
value of @scheme[(current-load-relative-directory)], which is set
while loading a file.)
@secref["guide:module-basics"] shows examples using relative paths.
@secref["module-basics"] shows examples using relative paths.
}
@; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@ -50,7 +50,7 @@ while loading a file.)
Like a plain-string @scheme[rel-path], but the elements of
@scheme[rel-path] refer to @tech{collection}s and
sub-@tech{collections}, instead of directories and sub-directories. A
collection is represented by a directory in one of several
@deftech{collection} is represented by a directory in one of several
installation-specific locations.
An example of this form is @scheme[(lib "big/lang.ss")], which is

11
collects/scribblings/guide/module-provide.scrbl
View File

@ -3,7 +3,7 @@
@require[(lib "eval.ss" "scribble")]
@require["guide-utils.ss"]
@title[#:tag "guide:module-provide"]{Exports: @scheme[provide]}
@title[#:tag "module-provide"]{Exports: @scheme[provide]}
By default, all of a module's definitions are private to the
module. The @scheme[provide] form specifies definitions to be made
@ -11,10 +11,11 @@ available where the module is @scheme[require]d.
@specform[(provide provide-spec ...)]{}
A @scheme[provide] form can only appear at @tech{module level}.
Specifying multiple @scheme[_provide-spec]s in a single
@scheme[require] is exactly the same as using multiple
@scheme[provide]s each with a single @scheme[_provide-spec].
A @scheme[provide] form can only appear at module level (i.e., in the
immediate body of a @scheme[module]). Specifying multiple
@scheme[_provide-spec]s in a single @scheme[require] is exactly the
same as using multiple @scheme[provide]s each with a single
@scheme[_provide-spec].
Each identifier can be exported at most once from a module across all
@scheme[provide]s within the module. More precisely, the external name

4
collects/scribblings/guide/module-require.scrbl
View File

@ -3,7 +3,7 @@
@require[(lib "eval.ss" "scribble")]
@require["guide-utils.ss"]
@title[#:tag "guide:module-require"]{Imports: @scheme[require]}
@title[#:tag "module-require"]{Imports: @scheme[require]}
The @scheme[require] form imports from another module. A
@scheme[require] form can appear within a module, in which case it
@ -32,7 +32,7 @@ The allowed shape of a @scheme[_require-spec] is defined recursively:
In its simplest form, a @scheme[_require-spec] is a
@scheme[module-path] (as defined in the previous section,
@secref["guide:module-paths"]). In this case, the bindings introduced
@secref["module-paths"]). In this case, the bindings introduced
by @scheme[require] are determined by @scheme[provide] declarations
within each module referenced by each @scheme[module-path].

2
collects/scribblings/guide/module-set.scrbl
View File

@ -3,7 +3,7 @@
@require[(lib "eval.ss" "scribble")]
@require["guide-utils.ss"]
@title[#:tag "guide:module-set"]{Assignment and Redefinition}
@title[#:tag "module-set"]{Assignment and Redefinition}
The use of @scheme[set!] on variables defined within a module is
limited to the body of the defining module. That is, a module is

2
collects/scribblings/guide/module-syntax.scrbl
View File

@ -38,7 +38,7 @@ supplies most of the bindings described in this guide, including
@scheme[require], @scheme[define], and @scheme[provide].
For example, the @file{cake.ss} example of the
@seclink["guide:module-basics"]{previous section} could be written as
@seclink["module-basics"]{previous section} could be written as
@schemeblock[
(module cake (lib "big/lang.ss")

2
collects/scribblings/guide/modules.scrbl
View File

@ -3,7 +3,7 @@
@require[(lib "eval.ss" "scribble")]
@require["guide-utils.ss"]
@title[#:tag "guide:modules" #:style 'toc]{Modules}
@title[#:tag "modules" #:style 'toc]{Modules}
Scheme definitions and expressions are normally written inside of a
module. Although a @tech{REPL} evaluates definitions and expressions outside

6
collects/scribblings/guide/numbers.scrbl
View File

@ -3,7 +3,7 @@
@require[(lib "eval.ss" "scribble")]
@require["guide-utils.ss"]
@title[#:tag "guide:numbers"]{Numbers}
@title[#:tag "numbers"]{Numbers}
A Scheme @defterm{number} is either exact or inexact:
@ -53,7 +53,7 @@ or inexact number. The prefixes @litchar{#b}, @litchar{#o}, and
@litchar{#x} specificy binary, octal, and hexadecimal
interprertation of digits.
@refdetails/gory["mz:parse-number"]{the syntax of numbers}
@refdetails/gory["parse-number"]{the syntax of numbers}
@examples[
0.5
@ -146,4 +146,4 @@ can only approximate @scheme[1/10]:
(inexact->exact 0.1)
]
@refdetails["mz:numbers"]{numbers and number procedures}
@refdetails["numbers"]{numbers and number procedures}

2
collects/scribblings/guide/pairs.scrbl
View File

@ -86,4 +86,4 @@ iterate through the lists elements:
'((when "3:30") (where "Florida") (who "Mickey")))
]
@refdetails["mz:pairs"]{pairs and lists}
@refdetails["pairs"]{pairs and lists}

4
collects/scribblings/guide/paths.scrbl
View File

@ -3,7 +3,7 @@
@require[(lib "eval.ss" "scribble")]
@require["guide-utils.ss"]
@title[#:tag "guide:paths"]{Paths}
@title[#:tag "paths"]{Paths}
A @defterm{path} encapsulates a filesystem path that (potentially)
names a file or directory. Although paths can be converted to and from
@ -45,7 +45,7 @@ named @file{~}. Windows path manipulation, furthermore, is far
trickier, because path elements like @file{aux} can have special
meanings.
@refdetails/gory["mz:windows-path"]{Windows filesystem paths}
@refdetails/gory["windows-path"]{Windows filesystem paths}
Use procedures like @scheme[split-path] and @scheme[build-path] to
deconstruct and construct paths. When you must manipulate the name of

6
collects/scribblings/guide/quote.scrbl
View File

@ -3,9 +3,9 @@
@require[(lib "eval.ss" "scribble")]
@require["guide-utils.ss"]
@title[#:tag "guide:quote"]{Quoting: @scheme[quote] and @schemevalfont{'}}
@title[#:tag "quote"]{Quoting: @scheme[quote] and @schemevalfont{'}}
@refalso["mz:quote"]{@scheme[quote]}
@refalso["quote"]{@scheme[quote]}
The @scheme[quote] form produces a constant:
@ -59,7 +59,7 @@ and this shorthand is almost always used instead of
@scheme[quote]. The shorthand applies even within the @scheme[_datum],
so it can produce a list containing @scheme[quote].
@refdetails["mz:parse-quote"]{the @schemevalfont{'} shorthand}
@refdetails["parse-quote"]{the @schemevalfont{'} shorthand}
@examples[
'apple

2
collects/scribblings/guide/regexps-data.scrbl
View File

@ -3,6 +3,6 @@
@require[(lib "eval.ss" "scribble")]
@require["guide-utils.ss"]
@title[#:tag "guide:regexp-literals"]{Regexps}
@title[#:tag "regexp-literals"]{Regexps}
A @defterm{regexp} is a pattern for regular-expression matching.

6
collects/scribblings/guide/set.scrbl
View File

@ -5,9 +5,9 @@
@interaction-eval[(require (lib "for.ss"))]
@title[#:tag "guide:set!"]{Assignment: @scheme[set!]}
@title[#:tag "set!"]{Assignment: @scheme[set!]}
@refalso["mz:set!"]{@scheme[set!]}
@refalso["set!"]{@scheme[set!]}
Assign to a variable using @scheme[set!]:
@ -166,7 +166,7 @@ the program.
@;------------------------------------------------------------------------
@section{Multiple Values: @scheme[set!-values]}
@refalso["mz:set!"]{@scheme[set!-values]}
@refalso["set!"]{@scheme[set!-values]}
The @scheme[set!-values] form assigns to multiple variables at once,
given an expression that produces an appropriate number of values:

6
collects/scribblings/guide/simple-data.scrbl
View File

@ -12,7 +12,7 @@ in color), value expression are shown in green.
@defterm{Numbers} are written in the usual way, including fractions
and imagnary numbers:
@moreguide["guide:numbers"]{numbers}
@moreguide["numbers"]{numbers}
@schemeblock[
1 1.0
@ -25,7 +25,7 @@ and imagnary numbers:
false. In conditionals, however, all non-@scheme[#f] values are
treated as true.
@moreguide["guide:booleans"]{booleans}
@moreguide["booleans"]{booleans}
@defterm{Strings} are written between doublequotes. Within a string,
backslash is an escaping character; for example, a backslash followed
@ -33,7 +33,7 @@ by a doublequote includes a little doublequote in the string. Except
for an unescaped doublequote or backslash, any Unicode character can
appear in a string constant.
@moreguide["guide:strings"]{strings}
@moreguide["strings"]{strings}
@schemeblock[
"hello world"

20
collects/scribblings/guide/simple-syntax.scrbl
View File

@ -62,7 +62,7 @@ a sequence as an element for repetition.
A definition of the form
@moreguide["guide:define"]{definitions}
@moreguide["define"]{definitions}
@schemeblock[#, @val-defn-stx]
@ -166,7 +166,7 @@ source's indentation information to suggest where it might be missing.
Scheme's syntax for identifiers is especially liberal. Excluding the
special characters
@moreguide["guide:binding"]{identifiers}
@moreguide["binding"]{identifiers}
@t{
@hspace[2] @litchar{(} @litchar{)} @litchar{[} @litchar{]}
@ -198,7 +198,7 @@ We have already seen many function calls---or @defterm{procedure
applications} in more traditional Scheme terminology. The syntax of a
function call is
@moreguide["guide:application"]{function calls}
@moreguide["application"]{function calls}
@schemeblock[
#, app-expr-stx
@ -242,7 +242,7 @@ The next simplest kind of expression is an @scheme[if] conditional:
#, if-expr-stx
]
@moreguide["guide:conditionals"]{conditionals}
@moreguide["conditionals"]{conditionals}
The first @nonterm{expr} is always evaluted. If it produces a
non-@scheme[#f] value, then the second @nonterm{expr} is
@ -293,7 +293,7 @@ but these kinds of nested @scheme[if]s are difficult to read. Scheme
provides more readable shortcuts through the @scheme[and] and
@scheme[or] forms, which work with any number of expressions:
@moreguide["guide:and+or"]{@scheme[and] and @scheme[or]}
@moreguide["and+or"]{@scheme[and] and @scheme[or]}
@schemeblock[
#, and-expr-stx
@ -332,7 +332,7 @@ tests, each with its own result:
The shorthand for a sequence of tests is the @scheme[cond] form:
@moreguide["guide:cond"]{@scheme[cond]}
@moreguide["cond"]{@scheme[cond]}
@schemeblock[
#, cond-expr-stx
@ -380,7 +380,7 @@ In our earlier grammar of function calls, we oversimplified. The
actual syntax of a function call allows an arbitrary
expression for the function, instead of just an @nonterm{id}:
@moreguide["guide:application"]{function calls}
@moreguide["application"]{function calls}
@schemeblock[
#, app2-expr-stx
@ -414,7 +414,7 @@ a procedure'' error like this one.
Programming in Scheme would be tedious if you had to name all of your
numbers. Instead of writing @scheme[(+ 1 2)], you'd have to write
@moreguide["guide:lambda"]{@scheme[lambda]}
@moreguide["lambda"]{@scheme[lambda]}
@interaction[
(define a 1)
@ -522,7 +522,7 @@ It's time to retract another simplification in our grammar of
Scheme. In the body of a function, definitions can appear before the
body expressions:
@moreguide["guide:intdefs"]{local (internal) definitions}
@moreguide["intdefs"]{local (internal) definitions}
@schemeblock[
#, fun-defn2-stx
@ -552,7 +552,7 @@ advantage of @scheme[let] is that it can be used in any expression
position. Also, @scheme[let] binds many identifiers at once, instead
of requiring a separate @scheme[define] for each identifier.
@moreguide["guide:intdefs"]{@scheme[let] and @scheme[let*]}
@moreguide["intdefs"]{@scheme[let] and @scheme[let*]}
@schemeblock[
#, let-expr-stx

6
collects/scribblings/guide/symbols.scrbl
View File

@ -3,7 +3,7 @@
@require[(lib "eval.ss" "scribble")]
@require["guide-utils.ss"]
@title[#:tag "guide:symbols"]{Symbols}
@title[#:tag "symbols"]{Symbols}
A @defterm{symbol} is an atomic value that prints like an identifier.
An expression that starts with @litchar{'} and continues with an
@ -59,7 +59,7 @@ special characters or that might otherwise look like numbers.
(string->symbol "6")
]
@refdetails/gory["mz:parse-symbol"]{the syntax of symbols}
@refdetails/gory["parse-symbol"]{the syntax of symbols}
The @scheme[display] form of a symbol is the same as the corresponding
string.
@ -83,4 +83,4 @@ confused with any other value.
]
@refdetails["mz:symbols"]{symbols}
@refdetails["symbols"]{symbols}

2
collects/scribblings/guide/truth.scrbl
View File

@ -182,7 +182,7 @@ Beware, however, that the @tech{REPL}'s printer recognizes the symbol
]
@;------------------------------------------------------------------------
@section[#:tag "guide:lists-and-syntax"]{Lists and Scheme Syntax}
@section[#:tag "lists-and-syntax"]{Lists and Scheme Syntax}
Now that you know the truth about pairs and lists, and now that you've
seen @scheme[quote], you're ready to understand the main way in which

4
collects/scribblings/guide/vectors.scrbl
View File

@ -16,7 +16,7 @@ expression. Also, a vector as an expression implicitly quotes the
forms for its content, which means that identifiers and parenthesized
forms in a vector constant represent symbols and lists.
@refdetails/gory["mz:parse-vector"]{the syntax of vectors}
@refdetails/gory["parse-vector"]{the syntax of vectors}
@examples[
(eval:alts #, @schemevalfont{#("a" "b" "c")} #("a" "b" "c"))
@ -55,4 +55,4 @@ well as lists.
(vector->list #("three" "blind" "mice"))))
]
@refdetails["mz:vectors"]{vectors and vector procedures}
@refdetails["vectors"]{vectors and vector procedures}

3
collects/scribblings/info.ss
View File

@ -1,3 +1,2 @@
(module info (lib "infotab.ss" "setup")
(define name "Scribblings")
(define post-install-collection "doc-installer.ss"))
(define name "Scribblings"))

11
collects/scribblings/quick.ss
View File

@ -1,11 +0,0 @@
(module quick mzscheme
(require "to-html.ss"
(prefix quick: "quick/quick.scrbl"))
(provide build)
(define (build)
(to-html #f #f
(list quick:doc)
(list "quick"))))

52
collects/scribblings/quick/images/exprs.dat
View File

@ -3,87 +3,87 @@
(0 () 0 () () "art gallery")
(0 () 0 () () "art gallery")
(0 () 0 () () (c! circle c! 10))
(2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c! (0 (1 (u . "quick/images/img0.png")) (c! "[image]")))))
(2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c! (0 (1 (u . "images/img0.png")) (c! "[image]")))))
(0 () 0 () () (c! rectangle c! 10 c! 20))
(2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c! (0 (1 (u . "quick/images/img1.png")) (c! "[image]")))))
(2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c! (0 (1 (u . "images/img1.png")) (c! "[image]")))))
(0 () 0 () () (c! circle c! 10 c! 20))
(1 (((lib "quick/exn.ss" "scribblings") . deserialize-info:mr-exn-v0)) 0 () () (0 "procedure circle: expects 1 argument, given 2: 10 20"))
(0 () 0 () () (c! hc-append c! (c! circle c! 10) c! (c! rectangle c! 10 c! 20)))
(2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c! (0 (1 (u . "quick/images/img2.png")) (c! "[image]")))))
(2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c! (0 (1 (u . "images/img2.png")) (c! "[image]")))))
(0 () 0 () () (c! define c! c c! (c! circle c! 10)))
(0 () 0 () () (void))
(0 () 0 () () (c! define c! r c! (c! rectangle c! 10 c! 20)))
(0 () 0 () () (void))
(0 () 0 () () r)
(2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c! (0 (1 (u . "quick/images/img3.png")) (c! "[image]")))))
(2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c! (0 (1 (u . "images/img3.png")) (c! "[image]")))))
(0 () 0 () () (c! hc-append c! c c! r))
(2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c! (0 (1 (u . "quick/images/img4.png")) (c! "[image]")))))
(2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c! (0 (1 (u . "images/img4.png")) (c! "[image]")))))
(0 () 0 () () (c! hc-append c! 20 c! c c! r c! c))
(2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c! (0 (1 (u . "quick/images/img5.png")) (c! "[image]")))))
(2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c! (0 (1 (u . "images/img5.png")) (c! "[image]")))))
(0 () 0 () () (c! define c! (c! square c! n) c! (c! filled-rectangle c! n c! n)))
(0 () 0 () () (void))
(0 () 0 () () (c! square c! 10))
(2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c! (0 (1 (u . "quick/images/img6.png")) (c! "[image]")))))
(2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c! (0 (1 (u . "images/img6.png")) (c! "[image]")))))
(0 () 0 () () (c! define c! (c! four c! p) c! (c! define c! two-p c! (c! hc-append c! p c! p)) c! (c! vc-append c! two-p c! two-p)))
(0 () 0 () () (void))
(0 () 0 () () (c! four c! (c! circle c! 10)))
(2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c! (0 (1 (u . "quick/images/img7.png")) (c! "[image]")))))
(2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c! (0 (1 (u . "images/img7.png")) (c! "[image]")))))
(0 () 0 () () (c! define c! (c! checker c! p1 c! p2) c! (c! let c! (c! (c! p12 c! (c! hc-append c! p1 c! p2)) c! (c! p21 c! (c! hc-append c! p2 c! p1))) c! (c! vc-append c! p12 c! p21))))
(0 () 0 () () (void))
(0 () 0 () () (c! checker c! (c! colorize c! (c! square c! 10) c! "red") c! (c! colorize c! (c! square c! 10) c! "black")))
(2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c! (0 (1 (u . "quick/images/img8.png")) (c! "[image]")))))
(2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c! (0 (1 (u . "images/img8.png")) (c! "[image]")))))
(0 () 0 () () (c! define c! (c! checkerboard c! p) c! (c! let* c! (c! (c! rp c! (c! colorize c! p c! "red")) c! (c! bp c! (c! colorize c! p c! "black")) c! (c! c c! (c! checker c! rp c! bp)) c! (c! c4 c! (c! four c! c))) c! (c! four c! c4))))
(0 () 0 () () (void))
(0 () 0 () () (c! checkerboard c! (c! square c! 10)))
(2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c! (0 (1 (u . "quick/images/img9.png")) (c! "[image]")))))
(2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c! (0 (1 (u . "images/img9.png")) (c! "[image]")))))
(0 () 0 () () circle)
(1 (((lib "struct.ss" "scribble") . deserialize-info:element-v0)) 0 () () (0 #f (c! (u . "#<procedure:circle>"))))
(0 () 0 () () (c! define c! (c! series c! mk) c! (c! hc-append c! 4 c! (c! mk c! 5) c! (c! mk c! 10) c! (c! mk c! 20))))
(0 () 0 () () (void))
(0 () 0 () () (c! series c! circle))
(2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c! (0 (1 (u . "quick/images/img10.png")) (c! "[image]")))))
(2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c! (0 (1 (u . "images/img10.png")) (c! "[image]")))))
(0 () 0 () () (c! series c! square))
(2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c! (0 (1 (u . "quick/images/img11.png")) (c! "[image]")))))
(2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c! (0 (1 (u . "images/img11.png")) (c! "[image]")))))
(0 () 0 () () (c! series c! (c! lambda c! (c! size) c! (c! checkerboard c! (c! square c! size)))))
(2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c! (0 (1 (u . "quick/images/img12.png")) (c! "[image]")))))
(2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c! (0 (1 (u . "images/img12.png")) (c! "[image]")))))
(0 () 0 () () (c! define c! (c! rgb-series c! mk) c! (c! vc-append c! (c! series c! (c! lambda c! (c! sz) c! (c! colorize c! (c! mk c! sz) c! "red"))) c! (c! series c! (c! lambda c! (c! sz) c! (c! colorize c! (c! mk c! sz) c! "green"))) c! (c! series c! (c! lambda c! (c! sz) c! (c! colorize c! (c! mk c! sz) c! "blue"))))))
(0 () 0 () () (void))
(0 () 0 () () (c! rgb-series c! circle))
(2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c! (0 (1 (u . "quick/images/img13.png")) (c! "[image]")))))
(2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c! (0 (1 (u . "images/img13.png")) (c! "[image]")))))
(0 () 0 () () (c! rgb-series c! square))
(2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c! (0 (1 (u . "quick/images/img14.png")) (c! "[image]")))))
(2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c! (0 (1 (u . "images/img14.png")) (c! "[image]")))))
(0 () 0 () () (c! define c! (c! rgb-maker c! mk) c! (c! lambda c! (c! sz) c! (c! vc-append c! (c! colorize c! (c! mk c! sz) c! "red") c! (c! colorize c! (c! mk c! sz) c! "green") c! (c! colorize c! (c! mk c! sz) c! "blue")))))
(0 () 0 () () (void))
(0 () 0 () () (c! series c! (c! rgb-maker c! circle)))
(2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c! (0 (1 (u . "quick/images/img15.png")) (c! "[image]")))))
(2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c! (0 (1 (u . "images/img15.png")) (c! "[image]")))))
(0 () 0 () () (c! series c! (c! rgb-maker c! square)))
(2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c! (0 (1 (u . "quick/images/img16.png")) (c! "[image]")))))
(2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c! (0 (1 (u . "images/img16.png")) (c! "[image]")))))
(0 () 0 () () (c! list c! "red" c! "green" c! "blue"))
(0 () 0 () () (c! "red" c! "green" c! "blue"))
(0 () 0 () () (c! list c! (c! circle c! 10) c! (c! square c! 10)))
(2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 1 ("[image]") () (c! (0 #f (c! (0 (1 (u . "quick/images/img17.png")) (c! (? . 0))))) c! (0 #f (c! (0 (1 (u . "quick/images/img18.png")) (c! (? . 0)))))))
(2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 1 ("[image]") () (c! (0 #f (c! (0 (1 (u . "images/img17.png")) (c! (? . 0))))) c! (0 #f (c! (0 (1 (u . "images/img18.png")) (c! (? . 0)))))))
(0 () 0 () () (c! define c! (c! rainbow c! p) c! (c! map c! (c! lambda c! (c! color) c! (c! colorize c! p c! color)) c! (c! list c! "red" c! "orange" c! "yellow" c! "green" c! "blue" c! "purple"))))
(0 () 0 () () (void))
(0 () 0 () () (c! rainbow c! (c! square c! 5)))
(2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 1 ("[image]") () (c! (0 #f (c! (0 (1 (u . "quick/images/img19.png")) (c! (? . 0))))) c! (0 #f (c! (0 (1 (u . "quick/images/img20.png")) (c! (? . 0))))) c! (0 #f (c! (0 (1 (u . "quick/images/img21.png")) (c! (? . 0))))) c! (0 #f (c! (0 (1 (u . "quick/images/img22.png")) (c! (? . 0))))) c! (0 #f (c! (0 (1 (u . "quick/images/img23.png")) (c! (? . 0))))) c! (0 #f (c! (0 (1 (u . "quick/images/img24.png")) (c! (? . 0)))))))
(2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 1 ("[image]") () (c! (0 #f (c! (0 (1 (u . "images/img19.png")) (c! (? . 0))))) c! (0 #f (c! (0 (1 (u . "images/img20.png")) (c! (? . 0))))) c! (0 #f (c! (0 (1 (u . "images/img21.png")) (c! (? . 0))))) c! (0 #f (c! (0 (1 (u . "images/img22.png")) (c! (? . 0))))) c! (0 #f (c! (0 (1 (u . "images/img23.png")) (c! (? . 0))))) c! (0 #f (c! (0 (1 (u . "images/img24.png")) (c! (? . 0)))))))
(0 () 0 () () (c! apply c! vc-append c! (c! rainbow c! (c! square c! 5))))
(2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c! (0 (1 (u . "quick/images/img25.png")) (c! "[image]")))))
(2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c! (0 (1 (u . "images/img25.png")) (c! "[image]")))))
(0 () 0 () () (c! require c! (c! lib c! "flash.ss" c! "texpict")))
(0 () 0 () () (void))
(0 () 0 () () (c! filled-flash c! 40 c! 30))
(2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c! (0 (1 (u . "quick/images/img26.png")) (c! "[image]")))))
(2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c! (0 (1 (u . "images/img26.png")) (c! "[image]")))))
(0 () 0 () () (c! require c! (c! planet c! "random.ss" c! (c! "schematics" c! "random.plt" c! 1 c! 0))))
(0 () 0 () () (void))
(0 () 0 () () (c! random-gaussian))
(0 () 0 () () 0.7386912134436788)
(0 () 0 () () 0.9050686838895684)
(0 () 0 () () (c! require c! (c! lib c! "code.ss" c! "slideshow")))
(0 () 0 () () (void))
(0 () 0 () () (c! code c! (c! circle c! 10)))
(2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c! (0 (1 (u . "quick/images/img27.png")) (c! "[image]")))))
(2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c! (0 (1 (u . "images/img27.png")) (c! "[image]")))))
(0 () 0 () () (c! define-syntax c! pict+code c! (c! syntax-rules c! () c! (c! (c! pict+code c! expr) c! (c! hc-append c! 10 c! expr c! (c! code c! expr))))))
(0 () 0 () () (void))
(0 () 0 () () (c! pict+code c! (c! circle c! 10)))
(2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c! (0 (1 (u . "quick/images/img28.png")) (c! "[image]")))))
(2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c! (0 (1 (u . "images/img28.png")) (c! "[image]")))))
(0 () 0 () () (c! require c! (c! lib c! "class.ss" c! "mzlib") c! (c! lib c! "mred.ss" c! "mred")))
(0 () 0 () () (void))
(0 () 0 () () (c! define c! f c! (c! new c! frame% c! (c! label c! "My Art") c! (c! width c! 300) c! (c! height c! 300) c! (c! alignment c! (c! quote c! (c! center c! center))))))
@ -98,5 +98,5 @@
(1 (((lib "struct.ss" "scribble") . deserialize-info:element-v0)) 0 () () (0 #f (c! (u . "#2(struct:object:canvas% ...)"))))
(0 () 0 () () (c! add-drawing c! (c! colorize c! (c! filled-flash c! 50 c! 30) c! "yellow")))
(1 (((lib "struct.ss" "scribble") . deserialize-info:element-v0)) 0 () () (0 #f (c! (u . "#2(struct:object:canvas% ...)"))))
(0 () 0 () () (c! scale c! (c! bitmap c! "quick/art.png") c! 0.5))
(2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c! (0 (1 (u . "quick/images/img29.png")) (c! "[image]")))))
(0 () 0 () () (c! scale c! (c! bitmap c! "art.png") c! 0.5))
(2 (((lib "struct.ss" "scribble") . deserialize-info:element-v0) ((lib "struct.ss" "scribble") . deserialize-info:image-file-v0)) 0 () () (0 #f (c! (0 (1 (u . "images/img29.png")) (c! "[image]")))))

3
collects/scribblings/quick/info.ss Normal file
View File

@ -0,0 +1,3 @@
(module info (lib "infotab.ss" "setup")
(define name "Scribblings: Quick")
(define scribblings '(("quick.scrbl" (main-doc)))))

2
collects/scribblings/quick/mreval.ss
View File

@ -34,7 +34,7 @@
;; This one needs to be relative, because it ends up in the
;; exprs.dat file:
(define img-dir "quick/images") ; relative to scribbles dir
(define img-dir "images") ; relative to src dir
;; This one can be absolute:
(define exprs-dat-file (build-path (collection-path "scribblings")

15
collects/scribblings/quick/quick.scrbl
View File

@ -1,6 +1,7 @@
#reader(lib "docreader.ss" "scribble")
@title{An Introduction to PLT Scheme with Pictures}
@title[#:tag-prefix '(lib "quick.scrbl" "scribblings" "quick")
#:tag "top"]{An Introduction to PLT Scheme with Pictures}
@bold{This reference describes a potential future version of PLT Scheme.
It does not match the current implementation.}
@ -14,6 +15,11 @@
@require["slideshow-doc.ss"]
@require["slideshow-code-doc.ss"]
@require["mred-doc.ss"]
@require-for-label[(lib "lang.ss" "big")]
@require-for-label[(lib "mred.ss" "mred")]
@require-for-label[(lib "class.ss")]
@require-for-syntax[mzscheme]
@define[filled-flash (lambda args (apply (eval 'filled-flash) args))]
@ -485,7 +491,7 @@ constantly giving talks and writing papers that involve Scheme code,
and it's worthwhile for everyone who works on those products to know
about @scheme[code].
In fact, you might want to take a look at the @link["quick/quick.scrbl"]{source of
In fact, you might want to take a look at the @link["quick.scrbl"]{source of
this document}. You'll see that it starts with @schemefont{#module},
but otherwise doesn't look a lot like Scheme; nevertheless, we build
this document by running its source as a PlT Scheme program. We have
@ -545,7 +551,7 @@ picture into a canvas:
(add-drawing (colorize (filled-flash 50 30) "yellow"))
]
@centerline{@mr-interaction-eval-show[(scale (bitmap "quick/art.png") 0.5)]}
@centerline{@mr-interaction-eval-show[(scale (bitmap "art.png") 0.5)]}
Each canvas stratches to fill an equal portion of the frame, because
that's how a frame manages its children by default.
@ -568,4 +574,5 @@ way that Scheme is often described---PLT Scheme offers a rich language
with an extensive set of libraries and tools.
To start learning about the full PLT Scheme language and tools in
depth, move on to @link["../guide/index.html"]{A Guide to PLT Scheme}.
depth, move on to @italic[@secref[#:doc '(lib "guide.scrbl"
"scribblings" "guide") "top"]].

Some files were not shown because too many files have changed in this diff Show More