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 #,make-))
(c (quote-syntax #,?)) (c (quote-syntax #,?))
(list-immutable (list-immutable
#,@(map protect sels) #,@(map protect (reverse sels))
#,@(if super-info #,@(if super-info
(map protect (list-ref super-info 3)) (map protect (list-ref super-info 3))
(if super-expr (if super-expr

12
collects/big/lang.ss
View File

@ -1,16 +1,20 @@
(module lang mzscheme (module lang mzscheme
(require "define-struct.ss" (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-datum #%datum)
(rename new-lambda lambda) (rename new-lambda lambda)
(rename new-define define) (rename new-define define)
(rename new-app #%app) (rename new-app #%app)
(rename #%app #%plain-app)
(rename lambda #%plain-lambda)
make-keyword-procedure make-keyword-procedure
keyword-apply keyword-apply
procedure-keywords procedure-keywords
(rename define-struct* define-struct) (rename define-struct* define-struct)
struct-field-index)) struct-field-index))

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

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

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

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

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

@ -402,9 +402,9 @@
null null) null null)
(unbox codes)))] (unbox codes)))]
[code [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))) (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)]) [extra-paths (get-extra-imports filename code)])
(let ([sub-files (map (lambda (i) (normalize (resolve-module-path-index i filename))) (let ([sub-files (map (lambda (i) (normalize (resolve-module-path-index i filename)))
all-file-imports)] 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)) (unless (hash-table-get visited-hash-table module-name (λ () #f))
(async-channel-put progress-channel (format adding-file module-name)) (async-channel-put progress-channel (format adding-file module-name))
(hash-table-put! visited-hash-table module-name #t) (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)] (let ([requires (extract-filenames imports module-name)]
[syntax-requires (extract-filenames fs-imports module-name)] [syntax-requires (extract-filenames fs-imports module-name)]
[template-requires (extract-filenames ft-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 i ...) expr]
[(require-for-syntax i ...) expr] [(require-for-syntax i ...) expr]
[(require-for-template i ...) expr] [(require-for-template i ...) expr]
[(require-for-label i ...) expr]
;; No error possible (and no way to wrap) ;; No error possible (and no way to wrap)
[(provide i ...) expr] [(provide i ...) expr]
[(provide-for-syntax i ...) expr]
[(provide-for-label i ...) expr]
;; No error possible ;; No error possible
[(quote _) [(quote _)

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

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

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

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

2
collects/mzlib/class.ss
View File

@ -37,7 +37,7 @@
private public override augment private public override augment
pubment overment augride pubment overment augride
public-final override-final augment-final 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 rename-super rename-inner inherit inherit/super inherit/inner inherit-field
this super inner this super inner
super-make-object super-instantiate super-new super-make-object super-instantiate super-new

4
collects/mzlib/cm.ss
View File

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

1
collects/mzlib/for.ss
View File

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

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

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

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

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

83
collects/scribble/basic.ss
View File

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

116
collects/scribble/decode.ss
View File

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

2
collects/scribble/defreader.ss
View File

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

4
collects/scribble/doclang.ss
View File

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

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

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

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

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

211
collects/scribble/manual.ss
View File

@ -10,6 +10,8 @@
(lib "class.ss") (lib "class.ss")
(lib "stxparam.ss")) (lib "stxparam.ss"))
(require-for-syntax (lib "stxparam.ss")) (require-for-syntax (lib "stxparam.ss"))
(require-for-label (lib "lang.ss" "big")
(lib "class.ss"))
(provide (all-from "basic.ss")) (provide (all-from "basic.ss"))
@ -50,10 +52,24 @@
(define (to-element/id s) (define (to-element/id s)
(make-element "schemesymbol" (list (to-element/no-color 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) (if (symbol? s)
(make-just-context s ctx) (make-just-context s ctx)
s)) s))
(define (add-sq-prop s name val) (define (add-sq-prop s name val)
(if (eq? name 'paren-shape) (if (eq? name 'paren-shape)
(make-shaped-parens s val) (make-shaped-parens s val)
@ -158,9 +174,9 @@
(define (exec . str) (define (exec . str)
(make-element 'tt (decode-content str))) (make-element 'tt (decode-content str)))
(define (Flag . 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) (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) (define (envvar . str)
(make-element 'tt (decode-content str))) (make-element 'tt (decode-content str)))
(define (indexed-envvar . str) (define (indexed-envvar . str)
@ -198,8 +214,7 @@
(elem (method a b) " in " (scheme a))])) (elem (method a b) " in " (scheme a))]))
(define (*method sym id) (define (*method sym id)
(let ([tag (format "~a::~a" (let ([tag (method-tag (register-scheme-definition id #t)
(register-scheme-definition id)
sym)]) sym)])
(make-element (make-element
"schemesymbol" "schemesymbol"
@ -208,6 +223,9 @@
(list (symbol->string sym)) (list (symbol->string sym))
tag))))) tag)))))
(define (method-tag vtag sym)
(list 'meth
(format "~a::~a" (cadr vtag) sym)))
;; ---------------------------------------- ;; ----------------------------------------
@ -222,7 +240,7 @@
(provide deftech tech techlink) (provide deftech tech techlink)
(define (*tech make-elem style s) (define (*tech make-elem style doc s)
(let* ([c (decode-content s)] (let* ([c (decode-content s)]
[s (regexp-replace* #px"[-\\s]+" [s (regexp-replace* #px"[-\\s]+"
(regexp-replace (regexp-replace
@ -235,26 +253,27 @@
" ")]) " ")])
(make-elem style (make-elem style
c c
(format "tech-term:~a" s)))) (list 'tech (doc-prefix doc s)))))
(define (deftech . s) (define (deftech . s)
(let* ([e (apply defterm 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 (make-index-element #f
(list t) (list t)
(target-element-tag t) (target-element-tag t)
(list (element->string e)) (list (element->string e))
(list e)))) (list e))))
(define (tech . s) (define (tech #:doc [doc #f] . s)
(*tech make-link-element "techlink" s)) (*tech make-link-element "techlink" doc s))
(define (techlink . s) (define (techlink #:doc [doc #f] . s)
(*tech make-link-element #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 defform defform* defform/subs defform*/subs defform/none
defidform defidform
specform specform/subs specform specform/subs
@ -262,6 +281,33 @@
schemegrammar schemegrammar* schemegrammar schemegrammar*
var svar void-const undefined-const) 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 (define void-const
(schemeresultfont "#<void>")) (schemeresultfont "#<void>"))
(define undefined-const (define undefined-const
@ -309,8 +355,8 @@
[(_ [[(id arg ...) result] ...] desc ...) [(_ [[(id arg ...) result] ...] desc ...)
(defproc* #:mode procedure #:within #f [[(id arg ...) result] ...] desc ...)] (defproc* #:mode procedure #:within #f [[(id arg ...) result] ...] desc ...)]
[(_ #:mode m #:within cl [[(id arg ...) result] ...] desc ...) [(_ #:mode m #:within cl [[(id arg ...) result] ...] desc ...)
(*defproc 'm (quote-syntax cl) (*defproc 'm (quote-syntax/loc cl)
(list (quote-syntax id) ...) (list (quote-syntax/loc id) ...)
'[(id arg ...) ...] '[(id arg ...) ...]
(list (list (lambda () (arg-contract arg)) ...) ...) (list (list (lambda () (arg-contract arg)) ...) ...)
(list (lambda () (schemeblock0 result)) ...) (list (lambda () (schemeblock0 result)) ...)
@ -328,7 +374,7 @@
(define-syntax **defstruct (define-syntax **defstruct
(syntax-rules () (syntax-rules ()
[(_ name ([field field-contract] ...) immutable? transparent? desc ...) [(_ 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)) ...) '([field field-contract] ...) (list (lambda () (schemeblock0 field-contract)) ...)
#t #t (lambda () (list desc ...)))])) #t #t (lambda () (list desc ...)))]))
(define-syntax (defform*/subs stx) (define-syntax (defform*/subs stx)
@ -347,7 +393,7 @@
[spec-id [spec-id
(syntax-case #'spec () (syntax-case #'spec ()
[(name . rest) #'name])]) [(name . rest) #'name])])
#'(*defforms (quote-syntax spec-id) '(lit ...) #'(*defforms (quote-syntax/loc spec-id) '(lit ...)
'(spec spec1 ...) '(spec spec1 ...)
(list (lambda (x) (schemeblock0 new-spec)) (list (lambda (x) (schemeblock0 new-spec))
(lambda (ignored) (schemeblock0 spec1)) ...) (lambda (ignored) (schemeblock0 spec1)) ...)
@ -381,7 +427,7 @@
(define-syntax (defidform stx) (define-syntax (defidform stx)
(syntax-case stx () (syntax-case stx ()
[(_ spec-id desc ...) [(_ spec-id desc ...)
#'(*defforms (quote-syntax spec-id) null #'(*defforms (quote-syntax/loc spec-id) null
'(spec-id) '(spec-id)
(list (lambda (x) (make-paragraph (list x)))) (list (lambda (x) (make-paragraph (list x))))
null null
@ -440,7 +486,7 @@
(define-syntax defthing (define-syntax defthing
(syntax-rules () (syntax-rules ()
[(_ id result desc ...) [(_ 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 (define-syntax defparam
(syntax-rules () (syntax-rules ()
[(_ id arg contract desc ...) [(_ id arg contract desc ...)
@ -494,6 +540,27 @@
type-sym) 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 (define (*defproc mode within-id
stx-ids prototypes arg-contractss result-contracts content-thunk) stx-ids prototypes arg-contractss result-contracts content-thunk)
(let ([spacer (hspace 1)] (let ([spacer (hspace 1)]
@ -589,10 +656,10 @@
(hspace 1) (hspace 1)
(if first? (if first?
(let* ([mname (car prototype)] (let* ([mname (car prototype)]
[tag (format "~a::~a" [ctag (register-scheme-definition within-id #t)]
(register-scheme-definition within-id) [tag (method-tag ctag mname)]
mname)]
[content (list (*method mname within-id))]) [content (list (*method mname within-id))])
(if tag
(make-toc-target-element (make-toc-target-element
#f #f
(list (make-index-element #f (list (make-index-element #f
@ -600,13 +667,17 @@
tag tag
(list (symbol->string mname)) (list (symbol->string mname))
content)) content))
tag)) tag)
(car content)))
(*method (car prototype) within-id))))] (*method (car prototype) within-id))))]
[else [else
(if first? (if first?
(let ([tag (register-scheme-definition stx-id)] (let ([tag (register-scheme-definition stx-id #t)]
[content (list (to-element (make-just-context (car prototype) [content (list
stx-id)))]) (annote-exporting-library
(to-element (make-just-context (car prototype)
stx-id))))])
(if tag
(make-toc-target-element (make-toc-target-element
#f #f
(list (make-index-element #f (list (make-index-element #f
@ -614,9 +685,11 @@
tag tag
(list (symbol->string (car prototype))) (list (symbol->string (car prototype)))
content)) content))
tag)) tag)
(car content)))
(annote-exporting-library
(to-element (make-just-context (car prototype) (to-element (make-just-context (car prototype)
stx-id)))])] stx-id))))])]
[(flat-size) (+ (prototype-size (cdr prototype) + +) [(flat-size) (+ (prototype-size (cdr prototype) + +)
(element-width tagged))] (element-width tagged))]
[(short?) (or (flat-size . < . 40) [(short?) (or (flat-size . < . 40)
@ -799,7 +872,9 @@
(register-scheme-definition (register-scheme-definition
(datum->syntax-object stx-id (datum->syntax-object stx-id
(string->symbol (string->symbol
name)))]) name))
#t)])
(if tag
(inner-make-target-element (inner-make-target-element
#f #f
(list (list
@ -808,7 +883,8 @@
tag tag
(list name) (list name)
(list (schemeidfont (make-element "schemevaluelink" (list name)))))) (list (schemeidfont (make-element "schemevaluelink" (list name))))))
tag)) tag)
content))
(cdr wrappers)))) (cdr wrappers))))
(define (*defstruct stx-id name fields field-contracts immutable? transparent? content-thunk) (define (*defstruct stx-id name fields field-contracts immutable? transparent? content-thunk)
@ -826,9 +902,10 @@
(make-target-element* (make-target-element*
make-toc-target-element make-toc-target-element
stx-id stx-id
(annote-exporting-library
(to-element (if (pair? name) (to-element (if (pair? name)
(make-just-context (car name) stx-id) (make-just-context (car name) stx-id)
stx-id)) stx-id)))
(let ([name (if (pair? name) (let ([name (if (pair? name)
(car name) (car name)
name)]) name)])
@ -975,8 +1052,10 @@
(list (make-flow (list (make-flow
(list (list
(make-paragraph (make-paragraph
(list (let ([tag (register-scheme-definition stx-id)] (list (let ([tag (register-scheme-definition stx-id #t)]
[content (list (to-element (make-just-context name stx-id)))]) [content (list (annote-exporting-library
(to-element (make-just-context name stx-id))))])
(if tag
(make-toc-target-element (make-toc-target-element
#f #f
(list (make-index-element #f (list (make-index-element #f
@ -984,7 +1063,8 @@
tag tag
(list (symbol->string name)) (list (symbol->string name))
content)) content))
tag)) tag)
(car content)))
spacer ":" spacer spacer ":" spacer
(to-element result-contract)))))))) (to-element result-contract))))))))
(content-thunk)))) (content-thunk))))
@ -1026,15 +1106,20 @@
(make-paragraph (make-paragraph
(list (list
(to-element (to-element
`(,x `(,x . ,(cdr form)))))))
. ,(cdr form)))))))
(and kw-id (and kw-id
(eq? form (car forms)) (eq? form (car forms))
(let ([tag (register-scheme-form-definition kw-id)] (let ([tag (register-scheme-definition kw-id #t)]
[content (list (to-element (make-just-context (if (pair? form) [stag (register-scheme-form-definition kw-id)]
[content (list (annote-exporting-library
(to-element (make-just-context (if (pair? form)
(car form) (car form)
form) form)
kw-id)))]) kw-id))))])
(if tag
(make-toc-target-element
#f
(list
(make-toc-target-element (make-toc-target-element
#f #f
(if kw-id (if kw-id
@ -1044,7 +1129,9 @@
(list (symbol->string (syntax-e kw-id))) (list (symbol->string (syntax-e kw-id)))
content)) content))
content) content)
tag)))))))) tag))
stag)
(car content)))))))))
forms form-procs) forms form-procs)
(if (null? sub-procs) (if (null? sub-procs)
null null
@ -1156,17 +1243,25 @@
(make-paragraph (list (hspace 2) (apply tt s)))) (make-paragraph (list (hspace 2) (apply tt s))))
(define (elemtag t . body) (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) (define (elemref t . body)
(make-link-element #f (decode-content body) t)) (make-link-element #f (decode-content body) `(elem ,t)))
(provide elemtag elemref) (provide elemtag elemref)
(define (secref s) (define (doc-prefix doc s)
(make-link-element #f null `(part ,s))) (if doc
(define (seclink tag . s) (format "~a:~a"
(make-link-element #f (decode-content s) `(part ,tag))) (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) (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 (define-syntax schemelink
(syntax-rules () (syntax-rules ()
[(_ id . content) (*schemelink (quote-syntax id) 'id . content)])) [(_ id . content) (*schemelink (quote-syntax id) 'id . content)]))
@ -1261,7 +1356,7 @@
(define id val)))])) (define id val)))]))
(define-syntax (class-doc-info stx) (define-syntax (class-doc-info stx)
(syntax-case stx (object%) (syntax-case* stx (object%) module-label-identifier=?
[(_ object%) #'#f] [(_ object%) #'#f]
[(_ id) (class-id->class-doc-info-id #'id)])) [(_ id) (class-id->class-doc-info-id #'id)]))
@ -1357,18 +1452,22 @@
(list (make-flow (list (make-flow
(list (list
(make-paragraph (make-paragraph
(list (let ([tag (register-scheme-definition stx-id)] (list (let ([tag (register-scheme-definition stx-id #t)]
[content (list (to-element stx-id))]) [content (list (annote-exporting-library (to-element stx-id)))])
(if tag
((if whole-page? ((if whole-page?
make-page-target-element make-page-target-element
make-toc-target-element) make-toc-target-element)
#f #f
(if whole-page?
content ; title is already an index entry
(list (make-index-element #f (list (make-index-element #f
content content
tag tag
(list (symbol->string (syntax-e stx-id))) (list (symbol->string (syntax-e stx-id)))
content)) content)))
tag)) tag)
(car content)))
spacer ":" spacer spacer ":" spacer
(if super (if super
(scheme class?) (scheme class?)
@ -1403,12 +1502,12 @@
[(_ name super (intf ...) body ...) [(_ name super (intf ...) body ...)
(define-class-doc-info name (define-class-doc-info name
(syntax-parameterize ([current-class (quote-syntax name)]) (syntax-parameterize ([current-class (quote-syntax name)])
(register-class (quote-syntax name) (register-class (quote-syntax/loc name)
(class-doc-info super) (class-doc-info super)
(list (class-doc-info intf) ...) (list (class-doc-info intf) ...)
(lambda (whole-page?) (lambda (whole-page?)
(list (list
(*defclass (quote-syntax name) (*defclass (quote-syntax/loc name)
(quote-syntax super) (quote-syntax super)
(list (quote-syntax intf) ...) (list (quote-syntax intf) ...)
whole-page?))) whole-page?)))
@ -1419,12 +1518,12 @@
[(_ name (intf ...) body ...) [(_ name (intf ...) body ...)
(define-class-doc-info name (define-class-doc-info name
(syntax-parameterize ([current-class (quote-syntax name)]) (syntax-parameterize ([current-class (quote-syntax name)])
(register-class (quote-syntax name) (register-class (quote-syntax/loc name)
#f #f
(list (class-doc-info intf) ...) (list (class-doc-info intf) ...)
(lambda (whole-page?) (lambda (whole-page?)
(list (list
(*defclass (quote-syntax name) (*defclass (quote-syntax/loc name)
#f #f
(list (quote-syntax intf) ...) (list (quote-syntax intf) ...)
whole-page?))) whole-page?)))

13
collects/scribble/run.ss
View File

@ -82,8 +82,15 @@
[files (reverse (current-info-input-files))]) [files (reverse (current-info-input-files))])
(if (null? files) (if (null? files)
info 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))))]) (cdr files))))])
(send renderer render docs fns info)) (let ([r-info (send renderer resolve docs fns info)])
(send renderer render docs fns r-info)
(when (current-info-output-file) (when (current-info-output-file)
(send renderer save-info (current-info-output-file) info))))))) (let ([s (send renderer serialize-info r-info)])
(with-output-to-file (current-info-output-file)
(lambda ()
(write s))
'truncate/replace))))))))))

221
collects/scribble/scheme.ss
View File

@ -1,9 +1,10 @@
(module scheme mzscheme (module scheme (lib "lang.ss" "big")
(require "struct.ss" (require "struct.ss"
"basic.ss" "basic.ss"
(lib "class.ss") (lib "class.ss")
(lib "for.ss") (lib "for.ss")
(lib "modcollapse.ss" "syntax")) (lib "main-collects.ss" "setup")
(lib "modresolve.ss" "syntax"))
(provide define-code (provide define-code
to-element to-element
@ -33,13 +34,7 @@
(define opt-color "schemeopt") (define opt-color "schemeopt")
(define current-keyword-list (define current-keyword-list
;; This is temporary, until the MzScheme manual is filled in... (make-parameter null))
(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)))
(define current-variable-list (define current-variable-list
(make-parameter null)) (make-parameter null))
(define current-meta-list (define current-meta-list
@ -51,7 +46,76 @@
(define-struct spaces (pre cnt post)) (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)] (let* ([c (syntax-ize c 0)]
[content null] [content null]
[docs null] [docs null]
@ -80,6 +144,10 @@
[(and (element? v) [(and (element? v)
(= 1 (length (element-content v)))) (= 1 (length (element-content v))))
(sz-loop (car (element-content v)))] (sz-loop (car (element-content v)))]
[(element? v)
(element-width v)]
[(delayed-element? v)
(element-width v)]
[(spaces? v) [(spaces? v)
(+ (sz-loop (spaces-pre v)) (+ (sz-loop (spaces-pre v))
(spaces-cnt v) (spaces-cnt v)
@ -176,13 +244,6 @@
c) c)
(loop (cdr l) (loop (cdr l)
(cons (car l) prev))))])))))) (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) (define (no-fancy-chars s)
(cond (cond
[(eq? s 'rsquo) "'"] [(eq? s 'rsquo) "'"]
@ -359,65 +420,10 @@
(set! src-col (+ orig-col (syntax-span c)))))] (set! src-col (+ orig-col (syntax-span c)))))]
[else [else
(advance c init-line!) (advance c init-line!)
(let-values ([(s it? sub?) (typeset-atom c out color? quote-depth)
(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))) (set! src-col (+ src-col (or (syntax-span c) 1)))
#; #;
(hash-table-put! next-col-map src-col dest-col))]))) (hash-table-put! next-col-map src-col dest-col)])))
(out prefix1 #f) (out prefix1 #f)
(set! dest-col 0) (set! dest-col 0)
(hash-table-put! next-col-map init-col dest-col) (hash-table-put! next-col-map init-col dest-col)
@ -436,6 +442,25 @@
(make-table "schemeblock" (map list (reverse docs)))) (make-table "schemeblock" (map list (reverse docs))))
(make-sized-element #f (reverse content) dest-col)))) (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) (define (to-element c)
(typeset c #f "" "" "" #t)) (typeset c #f "" "" "" #t))
@ -457,11 +482,11 @@
(cond (cond
[(syntax? v) [(syntax? v)
(let ([mk `(,#'d->s (let ([mk `(,#'d->s
(quote-syntax ,v) (quote-syntax ,(datum->syntax-object v 'defcode))
,(syntax-case v (uncode) ,(syntax-case v (uncode)
[(uncode e) #'e] [(uncode e) #'e]
[else (stx->loc-s-expr (syntax-e v))]) [else (stx->loc-s-expr (syntax-e v))])
(list 'code '(code
,(syntax-line v) ,(syntax-line v)
,(syntax-column v) ,(syntax-column v)
,(syntax-position v) ,(syntax-position v)
@ -484,27 +509,43 @@
[(_ expr) #`(typeset-code #,(cvt #'expr))] [(_ expr) #`(typeset-code #,(cvt #'expr))]
[(_ expr (... ...)) [(_ expr (... ...))
#`(typeset-code #,(cvt #'(code:line 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) [(_ code typeset-code uncode)
#'(define-code code typeset-code uncode datum->syntax-object syntax-property)] #'(define-code code typeset-code uncode datum->syntax-object syntax-property)]
[(_ code typeset-code) #'(define-code code typeset-code unsyntax)])) [(_ 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) (unless (identifier? stx)
(error 'register-scheme-definition "not an identifier: ~e" (syntax-object->datum stx))) (error 'register-scheme-definition "not an identifier: ~e" (syntax-object->datum stx)))
(format "definition:~a" (let ([b (identifier-label-binding stx)])
(let ([b (identifier-binding stx)]) (if (or (not b)
(cond (eq? b 'lexical))
[(not b) (format "top:~a" (syntax-e stx))] (if warn-if-no-label?
[(eq? b 'lexical) (format "lexical:~a" (syntax-e stx))] (begin
[else (format "module:~a:~a" (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)) (if (module-path-index? (car b))
(collapse-module-path-index (car b) '(lib "ack.ss" "scribble")) (let ([p (resolve-module-path-index (car b) #f)])
(path->main-collects-relative p))
(car b)) (car b))
(cadr b))])))) (cadr b)))))
(define (register-scheme-form-definition stx) (define (register-scheme-definition stx [warn-if-no-label? #f])
(format "form~s" (register-scheme-definition stx))) `(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))) (define syntax-ize-hook (make-parameter (lambda (v col) #f)))
@ -551,7 +592,11 @@
(just-context-ctx v)))] (just-context-ctx v)))]
[(and (list? v) [(and (list? v)
(pair? 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))]) (let ([c (syntax-ize (cadr v) (+ col 1))])
(datum->syntax-object #f (datum->syntax-object #f
(list (syntax-ize (car v) col) (list (syntax-ize (car v) col)

4
collects/scribble/scribble.css
View File

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

226
collects/scribble/struct.ss
View File

@ -1,8 +1,56 @@
(module struct mzscheme (module struct (lib "lang.ss" "big")
(require (lib "contract.ss") (require (lib "contract.ss")
(lib "serialize.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) (provide provide-structs)
(define-syntax (provide-structs stx) (define-syntax (provide-structs stx)
@ -36,12 +84,12 @@
fields+cts)))))])) fields+cts)))))]))
(provide tag?) (provide tag?)
(define (tag? s) (or (string? s) (define (tag? s) (and (pair? s)
(and (pair? s)
(symbol? (car s)) (symbol? (car s))
(pair? (cdr s)) (pair? (cdr s))
(string? (cadr s)) (or (string? (cadr s))
(null? (cddr s))))) (generated-tag? (cadr s)))
(null? (cddr s))))
(provide flow-element?) (provide flow-element?)
(define (flow-element? p) (define (flow-element? p)
@ -52,21 +100,21 @@
(delayed-flow-element? p))) (delayed-flow-element? p)))
(provide-structs (provide-structs
[part ([tags (listof tag?)] [part ([tag-prefix (or/c false/c string?)]
[tags (listof tag?)]
[title-content (or/c false/c list?)] [title-content (or/c false/c list?)]
[collected-info (or/c false/c collected-info?)] [style any/c]
[to-collect list?] [to-collect list?]
[flow flow?] [flow flow?]
[parts (listof part?)])] [parts (listof part?)])]
[(styled-part part) ([style any/c])] [(unnumbered-part part) ()]
[(unnumbered-part styled-part) ()]
[flow ([paragraphs (listof flow-element?)])] [flow ([paragraphs (listof flow-element?)])]
[paragraph ([content list?])] [paragraph ([content list?])]
[(styled-paragraph paragraph) ([style any/c])] [(styled-paragraph paragraph) ([style any/c])]
[table ([style any/c] [table ([style any/c]
[flowss (listof (listof (or/c flow? (one-of/c 'cont))))])] [flowss (listof (listof (or/c flow? (one-of/c 'cont))))])]
[(auxiliary-table table) ()] [(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?)])] [itemization ([flows (listof flow?)])]
[blockquote ([style any/c] [blockquote ([style any/c]
[paragraphs (listof flow-element?)])] [paragraphs (listof flow-element?)])]
@ -81,6 +129,7 @@
[plain-seq (listof string?)] [plain-seq (listof string?)]
[entry-seq list?])] [entry-seq list?])]
[(aux-element element) ()] [(aux-element element) ()]
[(hover-element element) ([text string?])]
;; specific renders support other elements, especially strings ;; specific renders support other elements, especially strings
[collected-info ([number (listof (or/c false/c integer?))] [collected-info ([number (listof (or/c false/c integer?))]
@ -93,42 +142,28 @@
;; ---------------------------------------- ;; ----------------------------------------
;; Delayed element has special serialization support: ;; Delayed element has special serialization support:
(define-values (struct:delayed-element (define-struct delayed-element (resolve sizer plain)
make-delayed-element #:property
delayed-element? prop:serializable
delayed-element-ref
delayed-element-set!)
(make-struct-type 'delayed-element #f
3 1 #f
(list (cons prop:serializable
(make-serialize-info (make-serialize-info
(lambda (d) (lambda (d)
(unless (delayed-element-ref d 3) (let ([ri (current-serialize-resolve-info)])
(unless ri
(error 'serialize-delayed-element (error 'serialize-delayed-element
"cannot serialize a delayed element that was not resolved: ~e" "current-serialize-resolve-info not set"))
d)) (with-handlers ([exn:fail:contract?
(vector (delayed-element-ref d 3))) (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 #'deserialize-delayed-element
#f #f
(or (current-load-relative-directory) (current-directory))))))) (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))
(provide/contract (provide/contract
(struct delayed-element ([render (any/c part? any/c . -> . list?)] (struct delayed-element ([resolve (any/c part? resolve-info? . -> . list?)]
[sizer (-> any)] [sizer (-> any)]
[plain (-> any)]))) [plain (-> any)])))
@ -136,12 +171,90 @@
(define deserialize-delayed-element (define deserialize-delayed-element
(make-deserialize-info values values)) (make-deserialize-info values values))
(provide force-delayed-element) (provide delayed-element-content)
(define (force-delayed-element d renderer sec ht) (define (delayed-element-content e ri)
(or (delayed-element-ref d 3) (hash-table-get (resolve-info-delays ri) e))
(let ([v ((delayed-element-ref d 0) renderer sec ht)])
(delayed-element-set! d 3 v) (provide delayed-flow-element-flow-elements)
v))) (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 (define content->string
(case-lambda (case-lambda
[(c) (c->s c element->string)] [(c) (c->s c element->string)]
[(c renderer sec ht) (c->s c (lambda (e) [(c renderer sec ri) (c->s c (lambda (e)
(element->string e renderer sec ht)))])) (element->string e renderer sec ri)))]))
(define (c->s c do-elem) (define (c->s c do-elem)
(apply string-append (apply string-append
@ -171,12 +284,12 @@
[(rsquo) "'"] [(rsquo) "'"]
[(rarr) "->"] [(rarr) "->"]
[else (format "~s" c)])])] [else (format "~s" c)])])]
[(c renderer sec ht) [(c renderer sec ri)
(cond (cond
[(element? c) (content->string (element-content c) renderer sec ht)] [(element? c) (content->string (element-content c) renderer sec ri)]
[(delayed-element? c) [(delayed-element? c)
(content->string (force-delayed-element c renderer sec ht) (content->string (delayed-element-content c ri)
renderer sec ht)] renderer sec ri)]
[else (element->string c)])])) [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") #reader(lib "reader.ss" "scribble")
(module blurbs mzscheme (module blurbs (lib "lang.ss" "big")
(require (lib "struct.ss" "scribble") (require (lib "struct.ss" "scribble")
(lib "manual.ss" "scribble") (lib "manual.ss" "scribble")
(lib "scheme.ss" "scribble") (lib "scheme.ss" "scribble")
(lib "decode.ss" "scribble")) (lib "decode.ss" "scribble"))
(require-for-label (lib "mred.ss" "mred"))
(provide (all-defined-except p)) (provide (all-defined-except p))
@ -96,7 +97,7 @@ start/end @techlink{position} is incremented by @|what|.})
(define OVD (define OVD
@elem{The result is only valid when the editor is displayed (see @elem{The result is only valid when the editor is displayed (see
@secref["mr:tb:miaoverview"]).}) @secref["tb:miaoverview"]).})
(define (FCAX c details) (define (FCAX c details)
@elem{@|c|alling this method may force the recalculation of @techlink{location} @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 instead of lines (determined by both explicit newline
characters and automatic line-wrapping).}) characters and automatic line-wrapping).})
(define admindiscuss @secref["mr:editoradministrators"]) (define admindiscuss @secref["editoradministrators"])
(define ateoldiscuss @secref["mr:editoreol"]) (define ateoldiscuss @secref["editoreol"])
(define textdiscuss @secref["mr:editorflattened"]) (define textdiscuss @secref["editorflattened"])
(define clickbackdiscuss @secref["mr:editorclickback"]) (define clickbackdiscuss @secref["editorclickback"])
(define stylediscuss @secref["mr:editorstyles"]) (define stylediscuss @secref["editorstyles"])
(define timediscuss @secref["mr:editorcutandpastetime"]) (define timediscuss @secref["editorcutandpastetime"])
(define filediscuss @secref["mr:editorfileformat"]) (define filediscuss @secref["editorfileformat"])
(define editordatadiscuss @secref["mr:editordata"]) (define editordatadiscuss @secref["editordata"])
(define snipclassdiscuss @secref["mr:editorsnipclasses"]) (define snipclassdiscuss @secref["editorsnipclasses"])
(define togglediscuss @secref["mr:styledeltatoggle"]) (define togglediscuss @secref["styledeltatoggle"])
(define drawcaretdiscuss @secref["mr:drawcaretinfo"]) (define drawcaretdiscuss @secref["drawcaretinfo"])
(define eventspacediscuss @secref["mr:eventspaceinfo"]) (define eventspacediscuss @secref["eventspaceinfo"])
(define lockdiscuss @secref["mr:lockinfo"]) (define lockdiscuss @secref["lockinfo"])
(define mousekeydiscuss @secref["mr:mouseandkey"]) (define mousekeydiscuss @secref["mouseandkey"])
(define globaleditordatadiscuss @secref["mr:globaleditordata"]) (define globaleditordatadiscuss @secref["globaleditordata"])
(define geomdiscuss @secref["mr:containeroverview"]) (define geomdiscuss @secref["containeroverview"])
(define mrprefsdiscuss @secref["mr:mredprefs"]) (define mrprefsdiscuss @secref["mredprefs"])
(define seesniporderdiscuss (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) (define (clipboardtypes)
@elem{The @scheme[format] string is typically four capital letters. (Under @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]}} @item{@method[dc<%> end-doc]}}
@p{Attempts to use a drawing method outside of an active page raises an exception.}))) @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 (define DrawSizeNote @elem{Restrictions on the magnitude of
drawing coordinates are described with @scheme[dc<%>].}) 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 "class.ss"))
(all-from (lib "contract.ss")) (all-from (lib "contract.ss"))
(all-from "blurbs.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 "struct.ss" "scribble")
(lib "scheme.ss" "scribble") (lib "scheme.ss" "scribble")
(lib "manual.ss" "scribble")) (lib "manual.ss" "scribble"))
(require-for-label (lib "mred.ss" "mred"))
(provide diagram->table (provide diagram->table
short-windowing-diagram short-windowing-diagram
@ -31,7 +32,8 @@
[(regexp-match #rx"([^-a-zA-Z0-9]*)([-a-zA-Z0-9<%>]+)(.*)" line) [(regexp-match #rx"([^-a-zA-Z0-9]*)([-a-zA-Z0-9<%>]+)(.*)" line)
=> (lambda (m) => (lambda (m)
(append (loop (cadr 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))))] (loop (cadddr m))))]
[else (list (make-element 'tt (list line)))]))))))) [else (list (make-element 'tt (list line)))])))))))
(regexp-split #rx"[\r\n]+" d)))) (regexp-split #rx"[\r\n]+" d))))

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

@ -3,7 +3,7 @@
@require["common.ss"] @require["common.ss"]
@require["diagrams.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}), Drawing in MrEd requires a @deftech{device context} (@deftech{DC}),
which is an instance of the @scheme[dc<%>] interface. For example, 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]. This procedure is a load handler for use with @scheme[current-load].
The handler recognizes MrEd editor-format files (see 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 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 handler recognizes editor files by the first twelve characters of
the file: @litchar{WXME01}@nonterm{digit}@nonterm{digit}@litchar{ ## }. 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 To support streams that span MrEd versions, use
@scheme[write-editor-version] before this procedure. @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. end-edit-sequence] for the sub-editor.
See also @method[editor<%> refresh-delayed?] and @method[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. information about edit sequences and refresh requests.
If the @scheme[undoable?] flag is @scheme[#f], then the changes made 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 Calls @method[editor<%> on-display-size] unless the editor is
currently in an edit sequence or currently being refreshed. In the currently in an edit sequence or currently being refreshed. In the
latter cases, the call to @method[editor<%> on-display-size] is 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. information.
} }
@ -1853,7 +1853,7 @@ See also @method[editor<%> add-undo].
void?]{ void?]{
Repaints a region of the editor, generally called by an editor 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. edit sequences and refresh requests.
The @scheme[x], @scheme[y], @scheme[width], and @scheme[height] arguments specify 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[(lib "bnf.ss" "scribble")]
@require["common.ss"] @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 The editor toolbox provides a foundation for two common kinds of
applications: applications:
@ -154,7 +154,7 @@ Applications that use the editor classes typically derive new versions
(super-new))) (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 MrEd supports extensible and nestable editors by decomposing an editor
assembly into three functional parts: assembly into three functional parts:
@ -221,7 +221,7 @@ When an editor is drawn into a display, each snip and position has a
displayed. displayed.
@subsection[#:tag "mr:editoradministrators"]{Administrators} @subsection[#:tag "editoradministrators"]{Administrators}
Two extra layers of administration manage the @techlink{display}-editor and Two extra layers of administration manage the @techlink{display}-editor and
editor-snip connections. An editor never communicates directly with 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 editor's @method[editor<%> get-admin] method thus depends on the
context of the call. context of the call.
@subsection[#:tag "mr:editorstyles"]{Styles} @subsection[#:tag "editorstyles"]{Styles}
A @deftech{style}, an instance of the @scheme[style<%>] interface, A @deftech{style}, an instance of the @scheme[style<%>] interface,
parameterizes high-level display information that is common to all 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. 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 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 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 for saving files or cut-and-paste, these issues can be safely
ignored. ignored.
@subsubsection[#:tag "mr:editorsnipclasses"]{Snip Classes} @subsubsection[#:tag "editorsnipclasses"]{Snip Classes}
Each snip can be associated to a @deftech{snip class}. This ``class'' 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 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 it is inserted into the current eventspace's snip class list, and
loading or saving continues using the new class. 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 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 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 The editor file format provides for adding extra global data in
special header and footer sections. To save and load special header 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]. @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 Because an editor can force a line break even when there is no
carriage return item, a @techlink{position} alone does not always 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 is filled with @scheme[#t] if the position is ambiguous and it came
from a right-side location, or @scheme[#f] otherwise. 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 In plain text editors, there is a simple correlation between
@techlink{position}s and characters. In an @scheme[editor<%>] object, @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 Within a frame, only one object can contain the keyboard focus. This
property must be maintained when a frame contains multiple editors in 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. 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 Methods of @scheme[editor<%>] that use the clipboard --- including
@method[editor<%> copy], @method[editor<%> cut], @method[editor<%> @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. under X.
@section[#:tag "mr:editorclickback"]{Clickbacks} @section[#:tag "editorclickback"]{Clickbacks}
@deftech{Clickbacks} in a @scheme[text%] editor facilitate the @deftech{Clickbacks} in a @scheme[text%] editor facilitate the
creation of simple interactive objects, such as hypertext. A 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 file is saved, since a clickback will have an arbitrary procedure
associated with it. 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 Instances of @scheme[editor<%>] have three levels of internal
locking: 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 that modifies the editor in any way, even setting the selection
position, can trigger a read lock, flow lock, or write lock. 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 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 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") #reader(lib "docreader.ss" "scribble")
@require["common.ss"] @require["common.ss"]
@title[#:tag "mr:eventspace-funcs"]{Eventspaces} @title[#:tag "eventspace-funcs"]{Eventspaces}
@defproc[(make-eventspace) @defproc[(make-eventspace)
eventspace]{ eventspace]{
@ -139,7 +139,7 @@ A second (optional) boolean argument indicates whether the callback
any/c])]{ any/c])]{
\index{pause}\index{wait} \index{pause}\index{wait}
Yields control to event dispatching. See 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 A handler procedure invoked by the system during a call to
@scheme[yield] can itself call @scheme[yield], creating @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 sensitive to whether the current thread is a handler thread, instead
of the value of the @scheme[current-eventspace] parameter. 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 If @scheme[v] is an event in MzScheme's sense (not to be confused with
GUI event), @scheme[yield] blocks on @scheme[v] in the same way as 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 @scheme[sync], except that it may start a @scheme[sync] on @scheme[v]
start a @scheme[sync] on @scheme[v] multiple times (but it will complete multiple times (but it will complete a @scheme[sync] on @scheme[v] at
a @scheme[sync] on @scheme[v] at most one time). If the current thread most one time). If the current thread is the current eventspace's
is the current eventspace's handler thread, events are dispatched handler thread, events are dispatched until a @scheme[v] sync
until a @scheme[v] sync succeeds on a MrEd event boundary. For other succeeds on a MrEd event boundary. For other threads, calling
threads, calling @scheme[yield] with a MzScheme event is @scheme[yield] with a MzScheme event is equivalent to calling
equivalent to calling @scheme[sync]. In either case, the result is @scheme[sync]. In either case, the result is the same that of
the same that of @scheme[sync]; however, if a wrapper procedure is @scheme[sync]; however, if a wrapper procedure is associated with
associated with @scheme[v] via @scheme[handle-evt], it is not called in @scheme[v] via @scheme[handle-evt], it is not called in tail position
tail position with respect to the @scheme[yield]. with respect to the @scheme[yield].
Always use @scheme[(yield @scheme[v])] instead of a busy-wait loop. 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["common.ss"]
@require[(lib "bnf.ss" "scribble")] @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 This chapter describes how to set up face mappings for screen and
PostScript fonts via preferences (see @|mrprefsdiscuss|). The 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}, Building items names by concatenating @nonterm{dest}, @nonterm{type},
@nonterm{weight}, and @nonterm{style} can create a large number of preference @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["fonts" "PostScript"]
@section-index["PostScript fonts"] @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 Returns the built-in default face mapping for a particular font
family. The built-in default can be overridden via preferences, as 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]. 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 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 useful built-in mapping for every platform and device. (The built-in
mapping can be overridden through the user's preferences; see 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 face string, @scheme[the-font-name-directory] interprets the string
(in a platform-specific way) to generate a mapping for ``screen'' (in a platform-specific way) to generate a mapping for ``screen''
drawing (to a canvas's @scheme[dc<%>], a @scheme[bitmap-dc%], or a 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) The mapping for face names can be overridden (on all platforms)
through the user's preferences, as described in 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 Gets a PostScript font name for a font ID, weight, and style
combination. The PostScript font name is used both for the font name combination. The PostScript font name is used both for the font name
in PostScript output (sans character set) and as the @|AFM| file 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 See @scheme[font%] for information about @scheme[weight] and
@scheme[style]. @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 set the OpenGL context. See @scheme[gl-context<%>] for more
information on interference. information on interference.
The method accepts an alternate @tech{synchronizable event} for use The method accepts an alternate @tech[#:doc
while blocking for the context lock; see also @scheme[sync]. 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 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 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") #reader(lib "docreader.ss" "scribble")
@require["common.ss"] @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 This reference manual describes the MrEd GUI toolbox that is part of
PLT Scheme. See @secref["guide:mred"] in PLT Scheme. See @secref[#:doc '(lib "guide.scrbl" "scribblings"
@italic{@link["../guide/index.html"]{A Guide to PLT Scheme}} for an "guide") "mred"] in @italic{@link["../guide/index.html"]{A Guide to
introduction to MrEd. PLT Scheme}} for an introduction to MrEd.
The @scheme[(lib "mred")] module provides all of the class, interface, The @scheme[(lib "mred")] module provides all of the class, interface,
and procedure bindings defined in this manual. The 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 @item{The @deftech{windowing} toolbox, for implementing form-filling
GUI programs (such as a database query window) using buttons, menus, GUI programs (such as a database query window) using buttons, menus,
text fields, and events. The windowing toolbox is described in 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 @item{The @deftech{drawing} toolbox, for drawing pictures or
implementing dynamic GUI programs (such as a video game) using implementing dynamic GUI programs (such as a video game) using
drawing canvases, pens, and brushes. The drawing toolbox is 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 @item{The @deftech{editor} toolbox, for developing traditional text
editors, editors that mix text and graphics, or free-form layout editors, editors that mix text and graphics, or free-form layout
editors (such as a word processor, HTML editor, or icon-based file editors (such as a word processor, HTML editor, or icon-based file
browser). The editor toolbox is described in 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 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 @scheme[try-chain?] is @scheme[#f]; an exception is also raised, but
the exception handler cannot escape (see 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 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 key sequence both as a prefix and as a complete sequence raises an
exception, but the exception handler cannot escape (see 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 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 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?)]{ @defparam[current-ps-afm-file-paths paths (listof path?)]{
A parameter determines the list of paths that is used to find AFM 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?)]{ @defparam[current-ps-cmap-file-paths paths (listof path?)]{
A parameter that determines the list of paths that is used to find 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") #reader(lib "docreader.ss" "scribble")
@require["common.ss"] @require["common.ss"]
@title[#:tag "mr:mredprefs"]{Preferences} @title[#:tag "mredprefs"]{Preferences}
MrEd supports a number of preferences for global configuration. The MrEd supports a number of preferences for global configuration. The
MrEd preferences are stored in the common file reported by 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 @item{@ResourceFirst{controlFontSize} --- sets the font size for
control and menu labels (Windows, X); the font is the @scheme['system] control and menu labels (Windows, X); the font is the @scheme['system]
font, which can be configured as described in font, which can be configured as described in
@secref["mr:fontresources"].} @secref["fontresources"].}
@item{@ResourceFirst{defaultMenuPrefix} --- sets the prefix used by @item{@ResourceFirst{defaultMenuPrefix} --- sets the prefix used by
default for menu item shortcuts under X, one of @scheme['ctl], 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 In addition, preference names built from font face names can provide
or override default entries for the @scheme[font-name-directory<%>]; 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]{ any/c]{
The arguments are the same as the arguments to a procedure returned by 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 details. The result is also the same as the result from a
@scheme[read]-produced procedure. @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: To calculate lines, if the following are true:
@itemize{ @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} @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 within the @method[timer% notify] procedure to allow guaranteed event
processing. processing.
See @secref["mr:eventspaceinfo"] for more information about event See @secref["eventspaceinfo"] for more information about event
priorities. priorities.

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

@ -3,7 +3,7 @@
@require["common.ss"] @require["common.ss"]
@require["diagrams.ss"] @require["diagrams.ss"]
@title[#:tag "mr:windowing-overview"]{Windowing} @title[#:tag "windowing-overview"]{Windowing}
@section{Basic GUI Building Blocks} @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"])) (define frame (new frame% [label "Example"]))
(code:comment #, @t{Show the frame by calling its @method[top-level-window<%> show] method}) (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 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 After the user clicks @onscreen{Pause}, the entire frame becomes
unresponsive for five seconds; the system cannot dispatch more events unresponsive for five seconds; the system cannot dispatch more events
until the call to @scheme[sleep] returns. For more information about 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 In addition to dispatching events, the GUI classes also handle the
graphical layout of windows. Our example frame demonstrates a simple 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 For more information about window layout and containers, see
@secref["mr:containeroverview"]. @secref["containeroverview"].
@section{Core Windowing Classes} @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 @item{@scheme[editor-canvas%] --- an @deftech{editor canvas} is a
subwindow for displaying a text editor or pasteboard editor. The subwindow for displaying a text editor or pasteboard editor. The
@scheme[editor-canvas%] class is documented with the editor classes @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: @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 MrEd's geometry management makes it easy to design windows that look
right on all platforms, despite different graphical representations 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, The following subsections describe the container system in detail,
first discussing the attributes of a containee in 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 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 built-in vertical and horizontal containers, programmers can define
new types of containers as discussed in the final subsection, 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: 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 container is specified when the @tech{containee} is created, and the
parent cannot be changed. However, a @tech{containee} can be parent cannot be changed. However, a @tech{containee} can be
@tech{hidden} or @tech{deleted} within its parent, as described in @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 The @deftech{graphical minimum size} of a particular containee, as
reported by @method[area<%> get-graphical-min-size], depends on the 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. 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: 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 the container. A container's alignment is changed with the
@method[area-container<%> set-alignment] method. @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 Although nested horizontal and vertical containers can express most
layout patterns, a programmer can define a new type of container with 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. 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, 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 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"] @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 @index['("dialogs" "modal")]{When} a frame or dialog is created
without a parent, it is associated with the @tech{current eventspace} 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 top-level window and its descendants are always dispatched in the
window's eventspace. Every dialog is modal; a dialog's window's eventspace. Every dialog is modal; a dialog's
@method[dialog% show] method implicitly calls @scheme[yield] to @method[dialog% show] method implicitly calls @scheme[yield] to
handle events while the dialog is shown. (See also 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 dialogs.) Furthermore, when a modal dialog is shown, the system
disables all other top-level windows in the dialog's eventspace, but disables all other top-level windows in the dialog's eventspace, but
windows in other eventspaces are unaffected by the modal dialog. 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 call the timer's @method[timer% notify] method. Like a top-level
window, each timer is associated with a particular eventspace (the window, each timer is associated with a particular eventspace (the
@tech{current eventspace} as described in @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. queues the event in its eventspace.
@deftech{Explicitly queued events} are created with @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 dispatches by setting the event dispatch handler via the
@scheme[event-dispatch-handler] parameter. This parameter and other @scheme[event-dispatch-handler] parameter. This parameter and other
eventspace procedures are described in more detail in 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 When a new eventspace is created, a corresponding @deftech{handler
thread} is created for the eventspace. When the system dispatches an 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]. @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 Whenever a frame, dialog, or timer is created, it is associated with
the @deftech{current eventspace} as determined by the 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 When an eventspace is created, it is placed under the management of
the @tech{current custodian}. When a custodian shuts down an the @tech[#:doc reference-doc]{current custodian}. When a custodian
eventspace, all frames and dialogs associated with the eventspace are shuts down an eventspace, all frames and dialogs associated with the
destroyed (without calling @method[top-level-window<%> can-close?] eventspace are destroyed (without calling @method[top-level-window<%>
or @xmethod[top-level-window<%> on-close]), all timers in the can-close?] or @xmethod[top-level-window<%> on-close]), all timers
eventspace are stopped, and all enqueued callbacks are removed. in the eventspace are stopped, and all enqueued callbacks are
Attempting to create a new window, timer, or explicitly queued event removed. Attempting to create a new window, timer, or explicitly
in a shut-down eventspace raises the @scheme[exn:misc] exception. queued event in a shut-down eventspace raises the @scheme[exn:misc]
exception.
An eventspace is a @techlink{synchronizable event} (not to be confused An eventspace is a @techlink[#:doc reference-doc]{synchronizable
with a GUI event), so it can be used with @scheme[sync]. As a event} (not to be confused with a GUI event), so it can be used with
synchronizable event, an eventspace is in a blocking state when a @scheme[sync]. As a synchronizable event, an eventspace is in a
frame is visible, a timer is active, a callback is queued, or a blocking state when a frame is visible, a timer is active, a callback
@scheme[menu-bar%] is created with a @scheme['root] parent. (Note is queued, or a @scheme[menu-bar%] is created with a @scheme['root]
that the blocking state of an eventspace is unrelated to whether an parent. (Note that the blocking state of an eventspace is unrelated
event is ready for dispatching.) 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 Whenever the system dispatches an event, the call to the handler
procedure is wrapped so that full continuation jumps are not allowed 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[(lib "eval.ss" "scribble")]
@require["guide-utils.ss"] @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 An expression of the form
@ -39,14 +39,14 @@ arguments. A function's @idefterm{arity} is the number of arguments
that it accepts. 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 Some functions accept @defterm{keyword arguments} in addition to
by-position arguments. For that case, an @scheme[_arg] can be an by-position arguments. For that case, an @scheme[_arg] can be an
@scheme[_arg-keyword _arg-expr] sequence instead of just a @scheme[_arg-keyword _arg-expr] sequence instead of just a
@scheme[_arg-expr]: @scheme[_arg-expr]:
@guideother{@secref["guide:keywords"] introduces keywords.} @guideother{@secref["keywords"] introduces keywords.}
@specform/subs[ @specform/subs[
(_proc-expr _arg ...) (_proc-expr _arg ...)
@ -78,10 +78,10 @@ above call to @scheme[go] can be equivalently written
@schemeblock[(go #:mode 'fast "super.ss")] @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 The syntax for function calls supports any number of arguments, but a
specific call always specifies a fixed number of arguments. As 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[(lib "eval.ss" "scribble")]
@require["guide-utils.ss"] @require["guide-utils.ss"]
@title[#:tag "guide:begin"]{Sequencing} @title[#:tag "begin"]{Sequencing}
Scheme programmers prefer to write programs with as few side-effects Scheme programmers prefer to write programs with as few side-effects
as possible, since purely functional code is more easily tested and 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]} @section{Effects Before: @scheme[begin]}
@refalso["mz:begin"]{@scheme[begin]} @refalso["begin"]{@scheme[begin]}
A @scheme[begin] expression sequences expressions: 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 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]} @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] A @scheme[begin0] expression has the same syntax as a @scheme[begin]
expression: 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 The @scheme[when] form combines an @scheme[if]-style conditional with
sequencing for the ``then'' clause and no ``else'' clause: 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[(lib "eval.ss" "scribble")]
@require["guide-utils.ss"] @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 The context of an expression determines the meaning of identifiers
that appear in the expression. In particular, starting a module with 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 function that creates a pair, @scheme[car] refers to the function
that extracts the first element of a pair, and so on. 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.} identifiers.}
Forms like @scheme[define], @scheme[lambda], and @scheme[let] 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[(lib "eval.ss" "scribble")]
@require["guide-utils.ss"] @require["guide-utils.ss"]
@title[#:tag "guide:booleans"]{Booleans} @title[#:tag "booleans"]{Booleans}
Scheme has two distinguished constants to represent boolean values: Scheme has two distinguished constants to represent boolean values:
@scheme[#t] for true and @scheme[#f] for false. Uppercase @scheme[#t] for true and @scheme[#f] for false. Uppercase

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

@ -18,4 +18,4 @@ b
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[(lib "eval.ss" "scribble")]
@require["guide-utils.ss"] @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 A @defterm{byte} is an inexact integer between @scheme[0] and
@scheme[255], inclusive. The @scheme[byte?] predicate recognizes @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 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 instead of characters. Byte strings can be used in applications that
process pure ASCII instead of Unicode text. The printed and form of a process pure ASCII instead of Unicode text. The printed and form of a
byte string supports such uses in particular, because a byte string 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 @litchar{#}. Unprintable ASCII characters or non-ASCII bytes in the
byte string are written with octal notation. 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[ @examples[
#"Apple" #"Apple"
@ -37,7 +37,7 @@ b
] ]
The @scheme[display] form of a byte string writes its raw bytes to the 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 @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 encoding of the string to the current output port, since output is
ultimately defined in terms of bytes; @scheme[display] of a byte ultimately defined in terms of bytes; @scheme[display] of a byte
@ -72,4 +72,4 @@ arbitrary string encodings.
(bytes->string/utf-8 dest)) (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. reference, and @scheme[unchecked-go] remains protected.
In much the same way that the macro expander copies properties from a 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 the expander copies certificates from a transformer's input to its
output. Building on the previous example, output. Building on the previous example,
@ -81,11 +81,11 @@ to @scheme[unchecked-go].
When a protected identifier becomes inaccessible by direct reference When a protected identifier becomes inaccessible by direct reference
(i.e., when the current code inspector is changed so that it does not (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. 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] When the result of a macro expansion contains a @scheme[quote-syntax]
form, the macro expansion's certificate must be attached to the 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. that contains nested @scheme[define-values] forms.
The default application of certificates can be overridden by attaching 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 result syntax object of a macro transformer. If the property value is
@scheme['opaque], then the certificate is attached to the syntax @scheme['opaque], then the certificate is attached to the syntax
object and not its parts. If the property value is 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[(lib "eval.ss" "scribble")]
@require["guide-utils.ss"] @require["guide-utils.ss"]
@title[#:tag "guide:strings"]{Strings (Unicode)} @title[#:tag "strings"]{Strings (Unicode)}
A @defterm{string} is a fixed-length array of 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 where doublequote and backslash characters within the string are
escaped with backslashes. Other common string escapes are supported, escaped with backslashes. Other common string escapes are supported,
including @litchar["\\n"] for a linefeed, @litchar["\\r"] for a 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 (up to four digits). Unprintable characters in a string normally
shown with @litchar["\\u"] when the string is printed. 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 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. to the string-constant syntax used to print a string result.
@examples[ @examples[
@ -66,6 +66,6 @@ for an end user.
For working with plain ASCII, working with raw bytes, or For working with plain ASCII, working with raw bytes, or
encoding/decoding Unicode strings as bytes, use 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[(lib "eval.ss" "scribble")]
@require["guide-utils.ss"] @require["guide-utils.ss"]
@title[#:tag "guide:characters"]{Characters} @title[#:tag "characters"]{Characters}
A Scheme @defterm{character} corresponds to a Unicode @defterm{scalar A Scheme @defterm{character} corresponds to a Unicode @defterm{scalar
value}. Roughly, a scalar value is an unsigned integer whose 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 and linefeed characters print as @scheme[#\space] and
@scheme[#\newline], respectively. @scheme[#\newline], respectively.
@refdetails/gory["mz:parse-character"]{the syntax of characters} @refdetails/gory["parse-character"]{the syntax of characters}
@examples[ @examples[
(integer->char 65) (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 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. character-constant syntax used to print a character result.
@examples[ @examples[
@ -72,4 +72,4 @@ characters.
(eqv? #\a #\A) (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 makes no difference for evaluation, because methods are fully defined
before a class is instantiated. before a class is instantiated.
@section[#:tag "guide:methods"]{Methods} @section[#:tag "methods"]{Methods}
Each of the three @scheme[define/public] declarations in Each of the three @scheme[define/public] declarations in
@scheme[fish%] introduces a new method. The declaration uses the same @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[grow] implementation in @scheme[picky-fish%] uses
@scheme[super] to delegate to the superclass implementation. @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 Since @scheme[picky-fish%] declares no initialization arguments, any
initialization values supplied in @scheme[(new picky-fish% ...)] are 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 @scheme[size] value as the @scheme[size] initialization argument to
the superclass. 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 The two uses of @scheme[size] in @scheme[default-10-fish%] expose the
double life of class-member identifiers. When @scheme[size] is 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 addition, the @scheme[implementation?] predicate checks whether a
given class implements a given interface. 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 As in Java, a method in a @scheme[class] form can be specified as
@defterm{final}, which means that a subclass cannot override the @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 work~\cite{Super+Inner} motivates and explains these extensions and
their interleaving. 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 internal and external names. A member definition binds an internal
name locally, and this binding can be locally renamed. External name locally, and this binding can be locally renamed. External
names, in contrast, have global scope by default, and a member 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[(lib "eval.ss" "scribble")]
@require["guide-utils.ss"] @require["guide-utils.ss"]
@title[#:tag "guide:conditionals"]{Conditionals} @title[#:tag "conditionals"]{Conditionals}
Most functions used for branching, such as @scheme[<] and Most functions used for branching, such as @scheme[<] and
@scheme[string?], produce either @scheme[#t] or @scheme[#f]. Scheme's @scheme[string?], produce either @scheme[#t] or @scheme[#f]. Scheme's
@ -35,7 +35,7 @@ list:
@;------------------------------------------------------------------------ @;------------------------------------------------------------------------
@section{Simple Branching: @scheme[if]} @section{Simple Branching: @scheme[if]}
@refalso["mz:if"]{@scheme[if]} @refalso["if"]{@scheme[if]}
In an @scheme[if] form, 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 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) @scheme[_else-expr]; the latter is not optional. To perform (or skip)
side-effects based on a @scheme[_test-expr], use @scheme[when] or 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 Scheme's @scheme[and] and @scheme[or] are syntactic forms, rather than
functions. Unlike a function, the @scheme[and] and @scheme[or] forms 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[expr] is in tail position, which means that the above
@scheme[got-milk?] function runs in constant space. @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 The @scheme[cond] form chains a series of tests to select a result
expression. To a first approximation, the syntax of @scheme[cond] is expression. To a first approximation, the syntax of @scheme[cond] is
as follows: as follows:
@refalso["mz:if"]{@scheme[cond]} @refalso["if"]{@scheme[cond]}
@specform[(cond [test-expr expr ...+] @specform[(cond [test-expr expr ...+]
...)] ...)]

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

@ -3,7 +3,7 @@
@require[(lib "eval.ss" "scribble")] @require[(lib "eval.ss" "scribble")]
@require["guide-utils.ss"] @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 The @seclink["to-scheme"]{previous chapter} introduced some of
Scheme's built-in datatype: numbers, booleans, strings, lists, and 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[(lib "bnf.ss" "scribble")]
@require["guide-utils.ss"] @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] New datatypes are normally created with the @scheme[define-struct]
form, which is the topic of this chapter. The class-based object 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]} @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 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 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], Meanwhile, in addition to defining @scheme[_struct-id],
@scheme[define-struct] also defines a number of identifiers that are @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 @deftech{structure type descriptor}, which is a value that
represents the structure type as a first-class value (with represents the structure type as a first-class value (with
@scheme[#:super], as discussed later in @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[#f] are not valid coordinates for the obvious uses of
@scheme[posn] instances. Enforcing constraints on field values, such @scheme[posn] instances. Enforcing constraints on field values, such
as requiring them to be numbers, is normally the job of a contract, as 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 An extended form of @scheme[define-struct] can be used to define a
@defterm{structure subtype}, which is a structure type that extends an @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 With a structure type definition like
@ -164,7 +164,7 @@ library cannot manipulate the data in the structure except as allowed
by the library. 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 The full syntax of @scheme[define-struct] supports many options, both
at the structure-type level and at the level of individual fields: 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)]{ @specspecsubform[(code:line #:inspector inspector-expr)]{
Controls reflective access to structure instances, as discussed 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)]{ @specspecsubform[(code:line #:auto-value auto-expr)]{
@ -327,4 +327,4 @@ times.
(add-bigger-fish (add-bigger-fish null)) (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["guide-utils.ss"]
@require[(lib "string.ss")] @require[(lib "string.ss")]
@title[#:tag "guide:define"]{Definitions: @scheme[define]} @title[#:tag "define"]{Definitions: @scheme[define]}
A basic definition has the form 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 A Scheme expression normally produces a single result, but some
expressions can produce multiple results. For example, expressions can produce multiple results. For example,
@ -176,10 +176,10 @@ surname
A @scheme[define] form (that is not a function shorthand) is A @scheme[define] form (that is not a function shorthand) is
equivalent to a @scheme[define-values] form with a single @scheme[_id]. 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 When the grammar for a syntactic form specifies @scheme[_body], then
the corresponding form can be either a definition or an expression. 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 easily translated to an equivalent @scheme[letrec] form (as introduced
in the next section). However, other definition forms can appear as a in the next section). However, other definition forms can appear as a
@scheme[_body], including @scheme[define-values], @scheme[define-struct] (see @scheme[_body], including @scheme[define-values], @scheme[define-struct] (see
@secref["guide:define-struct"]) or @scheme[define-syntax] (see @secref["define-struct"]) or @scheme[define-syntax] (see
@secref["guide:macros"]). @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["guide-utils.ss"]
@require[(lib "for.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 The @scheme[for] family of syntactic forms support iteration over
@defterm{sequences}. Lists, vectors, strings, byte strings, input @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 Before details on the variations of @scheme[for], though, it's best to
see the kinds of sequence generators that make interesting examples. 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 The @scheme[in-range] function generates a sequence of numbers, given
an optional starting number (which defaults to @scheme[0]), a number 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)) (display i))
] ]
@refdetails["mz:sequences"]{sequences} @refdetails["sequences"]{sequences}
@section{@scheme[for] and @scheme[for*]} @section{@scheme[for] and @scheme[for*]}
@ -290,7 +290,7 @@ the same facility with nested iterations:
(list book chapter)) (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 The @scheme[for/fold] form generalizes the way to combine iteration
results. Its syntax is slightly different than the syntax of 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 should indicate the performance benefits of using it directly in
a @scheme[for] @scheme[_clause]. 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[] @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 This chapter (and the rest of the documentation) uses a slightly
different notation than the character-based grammars of the 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 sub-form; it will be parsed as either a local definition or an
expression. A @scheme[_body] can parse as a definition only if expression. A @scheme[_body] can parse as a definition only if
it is not preceded by any expression, and the last 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") (lib "eval.ss" "scribble")
"../icons.ss") "../icons.ss")
(require-for-label (lib "lang.ss" "big"))
(provide-for-label (all-from (lib "lang.ss" "big")))
(provide Quick MzScheme HtDP (provide Quick MzScheme HtDP
tool tool
moreguide moreguide
@ -13,13 +16,11 @@
refalso refalso
refdetails refdetails
refdetails/gory refdetails/gory
refsecref) refsecref
ext-refsecref)
(define Quick (define Quick
(italic (link "../quick/index.html" "An Introduction to PLT Scheme with Pictures"))) (italic (secref #:doc '(lib "quick.scrbl" "scribblings" "quick") "top")))
(define MzScheme
(italic (link "../reference/index.html" "PLT Scheme Reference")))
(define HtDP (define HtDP
(italic (link "http://www.htdp.org" "How to Design Programs"))) (italic (link "http://www.htdp.org" "How to Design Programs")))
@ -42,7 +43,7 @@
(define (refdetails* tag what . s) (define (refdetails* tag what . s)
(apply margin-note (apply margin-note
(decode-content (append (list magnify (refsecref tag)) (decode-content (append (list magnify (ext-refsecref tag))
(list what) (list what)
s s
(list "."))))) (list ".")))))
@ -57,4 +58,10 @@
(apply refdetails* tag " documents the fine points of " s)) (apply refdetails* tag " documents the fine points of " s))
(define (refsecref 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[(lib "eval.ss" "scribble")]
@require["guide-utils.ss"] @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 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 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"] @include-section["io.scrbl"]
@; ---------------------------------------------------------------------- @; ----------------------------------------------------------------------
@section[#:tag "guide:contracts"]{Contracts} @section[#:tag "contracts"]{Contracts}
In the reference manual, the documentation for each procedure In the reference manual, the documentation for each procedure
describes the acceptable arguments and the result of the 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} @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"] @include-section["macros.scrbl"]
@ -97,9 +104,9 @@ of an expression to the values for the clause:
@; ---------------------------------------------------------------------- @; ----------------------------------------------------------------------
@section[#:tag "memory-management"]{Memory Management} @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} @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, @deftech{MrEd} is both a library and an executable. As a library,
@scheme[(lib "mred/mred.ss")] provides class, interface, and function @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") (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 A hash table can optionally retain its keys @defterm{weakly}, so each
mapping is retained only so long as the key is retained elsewhere. 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 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 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 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). addition to the implicit pairing of the hash table).
@examples[ @examples[
@ -68,4 +68,4 @@ addition to the implicit pairing of the hash table).
(eval:alts (hash-table-count ht) 0) (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)))))] (make-flow (list b)))))]
@interaction-eval[(print-hash-table #t)] @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 Scheme @defterm{port} represents an input or output stream, such as
a file, a terminal, a TCP connection, or an in-memory string. More 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 The current-port functions actually @tech{parameters}, which means
that their values can be set with @scheme[parameterize]. that their values can be set with @scheme[parameterize].
@moreguide["guide:parameters"]{parameters} @moreguide["parameters"]{parameters}
@examples[ @examples[
(let ([s (open-output-string)]) (let ([s (open-output-string)])
@ -181,7 +181,7 @@ that their values can be set with @scheme[parameterize].
@; ---------------------------------------------------------------------- @; ----------------------------------------------------------------------
@section{Reading and Writing Scheme Data} @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: ways to print an instance of a built-in value:
@itemize{ @itemize{

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

@ -3,13 +3,13 @@
@require[(lib "eval.ss" "scribble")] @require[(lib "eval.ss" "scribble")]
@require["guide-utils.ss"] @require["guide-utils.ss"]
@title[#:tag "guide:keywords"]{Keywords} @title[#:tag "keywords"]{Keywords}
A @defterm{keyword} value is similar to a symbol (see 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{#:}. @litchar{#:}.
@refdetails/gory["mz:parse-keyword"]{the syntax of keywords} @refdetails/gory["parse-keyword"]{the syntax of keywords}
@examples[ @examples[
(string->keyword "apple") (string->keyword "apple")

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

@ -3,7 +3,7 @@
@require[(lib "eval.ss" "scribble")] @require[(lib "eval.ss" "scribble")]
@require["guide-utils.ss"] @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 A @scheme[lambda] expression creates a function. In the simplest
case, a @scheme[lambda] expression has the form 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 Functions with a @scheme[_rest-id] often use @scheme[apply] to call
another function that accepts any number of arguments. another function that accepts any number of arguments.
@guideother{@secref["guide:apply"] describes @scheme[apply].} @guideother{@secref["apply"] describes @scheme[apply].}
@defexamples[ @defexamples[
(define max-mag (define max-mag
@ -129,14 +129,14 @@ and every following @scheme[_arg-id] must have a default as well.
(greet "Adam") (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 A @scheme[lambda] form can declare an argument to be passed by
keyword, instead of position. Keyword arguments can be mixed with keyword, instead of position. Keyword arguments can be mixed with
by-position arguments, and default-value expressions can be supplied by-position arguments, and default-value expressions can be supplied
for either kind of argument: for either kind of argument:
@guideother{@secref["guide:keyword-args"] introduces function @guideother{@secref["keyword-args"] introduces function
calls with keywords.} calls with keywords.}
@specform/subs[ @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 and then all by-position arguments from an application as the
remaining by-position arguments. remaining by-position arguments.
@guideother{@secref["guide:apply"] inroduces @scheme[keyword-apply].} @guideother{@secref["apply"] inroduces @scheme[keyword-apply].}
@defexamples[ @defexamples[
(define (trace-wrap f) (define (trace-wrap f)
@ -197,7 +197,7 @@ remaining by-position arguments.
((trace-wrap greet) "John" #:hi "Howdy") ((trace-wrap greet) "John" #:hi "Howdy")
] ]
@refdetails["mz:lambda"]{function expressions} @refdetails["lambda"]{function expressions}
@;------------------------------------------------------------------------ @;------------------------------------------------------------------------
@section{Arity-Sensitive Functions: @scheme[case-lambda]} @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[(lib "eval.ss" "scribble")]
@require["guide-utils.ss"] @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, Although internal @scheme[define]s can be used for local binding,
Scheme provides three forms that give the programmer more 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]} @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 A @scheme[let] form binds a set of identifiers, each to the result of
some expression, for use in the @scheme[let] body: 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*]} @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]: 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]} @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]: 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]} @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 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[let-values], @scheme[let*-values], and
@scheme[letrec-values] bind multiple results locally. @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 provides a general @defterm{list compherension} form
@scheme[for/list], which builds a list by iterating through @scheme[for/list], which builds a list by iterating through
@defterm{sequences}. List comprehensions and related iteration forms @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} @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. 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 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 @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[(lib "eval.ss" "scribble")]
@require["guide-utils.ss"] @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[] @local-table-of-contents[]

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

@ -3,7 +3,7 @@
@require[(lib "eval.ss" "scribble")] @require[(lib "eval.ss" "scribble")]
@require["guide-utils.ss"] @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 The space of module names is distinct from the space of normal Scheme
definitions. Indeed, since modules typically reside in files, the definitions. Indeed, since modules typically reside in files, the
@ -62,4 +62,4 @@ big
] ]
We discuss more forms of module reference later in 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[(lib "eval.ss" "scribble")]
@require["guide-utils.ss"] @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 A @deftech{module path} is a reference to a module, as used with
@scheme[require] or as the @scheme[_initial-module-path] in a @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 value of @scheme[(current-load-relative-directory)], which is set
while loading a file.) 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 Like a plain-string @scheme[rel-path], but the elements of
@scheme[rel-path] refer to @tech{collection}s and @scheme[rel-path] refer to @tech{collection}s and
sub-@tech{collections}, instead of directories and sub-directories. A 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. installation-specific locations.
An example of this form is @scheme[(lib "big/lang.ss")], which is 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[(lib "eval.ss" "scribble")]
@require["guide-utils.ss"] @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 By default, all of a module's definitions are private to the
module. The @scheme[provide] form specifies definitions to be made 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 ...)]{} @specform[(provide provide-spec ...)]{}
A @scheme[provide] form can only appear at @tech{module level}. A @scheme[provide] form can only appear at module level (i.e., in the
Specifying multiple @scheme[_provide-spec]s in a single immediate body of a @scheme[module]). Specifying multiple
@scheme[require] is exactly the same as using multiple @scheme[_provide-spec]s in a single @scheme[require] is exactly the
@scheme[provide]s each with a single @scheme[_provide-spec]. 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 Each identifier can be exported at most once from a module across all
@scheme[provide]s within the module. More precisely, the external name @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[(lib "eval.ss" "scribble")]
@require["guide-utils.ss"] @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 The @scheme[require] form imports from another module. A
@scheme[require] form can appear within a module, in which case it @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 In its simplest form, a @scheme[_require-spec] is a
@scheme[module-path] (as defined in the previous section, @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 by @scheme[require] are determined by @scheme[provide] declarations
within each module referenced by each @scheme[module-path]. 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[(lib "eval.ss" "scribble")]
@require["guide-utils.ss"] @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 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 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]. @scheme[require], @scheme[define], and @scheme[provide].
For example, the @file{cake.ss} example of the 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[ @schemeblock[
(module cake (lib "big/lang.ss") (module cake (lib "big/lang.ss")

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

@ -3,7 +3,7 @@
@require[(lib "eval.ss" "scribble")] @require[(lib "eval.ss" "scribble")]
@require["guide-utils.ss"] @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 Scheme definitions and expressions are normally written inside of a
module. Although a @tech{REPL} evaluates definitions and expressions outside 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[(lib "eval.ss" "scribble")]
@require["guide-utils.ss"] @require["guide-utils.ss"]
@title[#:tag "guide:numbers"]{Numbers} @title[#:tag "numbers"]{Numbers}
A Scheme @defterm{number} is either exact or inexact: 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 @litchar{#x} specificy binary, octal, and hexadecimal
interprertation of digits. interprertation of digits.
@refdetails/gory["mz:parse-number"]{the syntax of numbers} @refdetails/gory["parse-number"]{the syntax of numbers}
@examples[ @examples[
0.5 0.5
@ -146,4 +146,4 @@ can only approximate @scheme[1/10]:
(inexact->exact 0.1) (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"))) '((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[(lib "eval.ss" "scribble")]
@require["guide-utils.ss"] @require["guide-utils.ss"]
@title[#:tag "guide:paths"]{Paths} @title[#:tag "paths"]{Paths}
A @defterm{path} encapsulates a filesystem path that (potentially) A @defterm{path} encapsulates a filesystem path that (potentially)
names a file or directory. Although paths can be converted to and from 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 trickier, because path elements like @file{aux} can have special
meanings. 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 Use procedures like @scheme[split-path] and @scheme[build-path] to
deconstruct and construct paths. When you must manipulate the name of 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[(lib "eval.ss" "scribble")]
@require["guide-utils.ss"] @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: 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], @scheme[quote]. The shorthand applies even within the @scheme[_datum],
so it can produce a list containing @scheme[quote]. so it can produce a list containing @scheme[quote].
@refdetails["mz:parse-quote"]{the @schemevalfont{'} shorthand} @refdetails["parse-quote"]{the @schemevalfont{'} shorthand}
@examples[ @examples[
'apple 'apple

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

@ -3,6 +3,6 @@
@require[(lib "eval.ss" "scribble")] @require[(lib "eval.ss" "scribble")]
@require["guide-utils.ss"] @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. 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"))] @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!]: Assign to a variable using @scheme[set!]:
@ -166,7 +166,7 @@ the program.
@;------------------------------------------------------------------------ @;------------------------------------------------------------------------
@section{Multiple Values: @scheme[set!-values]} @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, The @scheme[set!-values] form assigns to multiple variables at once,
given an expression that produces an appropriate number of values: 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 @defterm{Numbers} are written in the usual way, including fractions
and imagnary numbers: and imagnary numbers:
@moreguide["guide:numbers"]{numbers} @moreguide["numbers"]{numbers}
@schemeblock[ @schemeblock[
1 1.0 1 1.0
@ -25,7 +25,7 @@ and imagnary numbers:
false. In conditionals, however, all non-@scheme[#f] values are false. In conditionals, however, all non-@scheme[#f] values are
treated as true. treated as true.
@moreguide["guide:booleans"]{booleans} @moreguide["booleans"]{booleans}
@defterm{Strings} are written between doublequotes. Within a string, @defterm{Strings} are written between doublequotes. Within a string,
backslash is an escaping character; for example, a backslash followed 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 for an unescaped doublequote or backslash, any Unicode character can
appear in a string constant. appear in a string constant.
@moreguide["guide:strings"]{strings} @moreguide["strings"]{strings}
@schemeblock[ @schemeblock[
"hello world" "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 A definition of the form
@moreguide["guide:define"]{definitions} @moreguide["define"]{definitions}
@schemeblock[#, @val-defn-stx] @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 Scheme's syntax for identifiers is especially liberal. Excluding the
special characters special characters
@moreguide["guide:binding"]{identifiers} @moreguide["binding"]{identifiers}
@t{ @t{
@hspace[2] @litchar{(} @litchar{)} @litchar{[} @litchar{]} @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 applications} in more traditional Scheme terminology. The syntax of a
function call is function call is
@moreguide["guide:application"]{function calls} @moreguide["application"]{function calls}
@schemeblock[ @schemeblock[
#, app-expr-stx #, app-expr-stx
@ -242,7 +242,7 @@ The next simplest kind of expression is an @scheme[if] conditional:
#, if-expr-stx #, if-expr-stx
] ]
@moreguide["guide:conditionals"]{conditionals} @moreguide["conditionals"]{conditionals}
The first @nonterm{expr} is always evaluted. If it produces a The first @nonterm{expr} is always evaluted. If it produces a
non-@scheme[#f] value, then the second @nonterm{expr} is 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 provides more readable shortcuts through the @scheme[and] and
@scheme[or] forms, which work with any number of expressions: @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[ @schemeblock[
#, and-expr-stx #, 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: The shorthand for a sequence of tests is the @scheme[cond] form:
@moreguide["guide:cond"]{@scheme[cond]} @moreguide["cond"]{@scheme[cond]}
@schemeblock[ @schemeblock[
#, cond-expr-stx #, 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 actual syntax of a function call allows an arbitrary
expression for the function, instead of just an @nonterm{id}: expression for the function, instead of just an @nonterm{id}:
@moreguide["guide:application"]{function calls} @moreguide["application"]{function calls}
@schemeblock[ @schemeblock[
#, app2-expr-stx #, 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 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 numbers. Instead of writing @scheme[(+ 1 2)], you'd have to write
@moreguide["guide:lambda"]{@scheme[lambda]} @moreguide["lambda"]{@scheme[lambda]}
@interaction[ @interaction[
(define a 1) (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 Scheme. In the body of a function, definitions can appear before the
body expressions: body expressions:
@moreguide["guide:intdefs"]{local (internal) definitions} @moreguide["intdefs"]{local (internal) definitions}
@schemeblock[ @schemeblock[
#, fun-defn2-stx #, 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 position. Also, @scheme[let] binds many identifiers at once, instead
of requiring a separate @scheme[define] for each identifier. 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[ @schemeblock[
#, let-expr-stx #, let-expr-stx

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

@ -3,7 +3,7 @@
@require[(lib "eval.ss" "scribble")] @require[(lib "eval.ss" "scribble")]
@require["guide-utils.ss"] @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. A @defterm{symbol} is an atomic value that prints like an identifier.
An expression that starts with @litchar{'} and continues with an 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") (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 The @scheme[display] form of a symbol is the same as the corresponding
string. 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 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 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 for its content, which means that identifiers and parenthesized
forms in a vector constant represent symbols and lists. 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[ @examples[
(eval:alts #, @schemevalfont{#("a" "b" "c")} #("a" "b" "c")) (eval:alts #, @schemevalfont{#("a" "b" "c")} #("a" "b" "c"))
@ -55,4 +55,4 @@ well as lists.
(vector->list #("three" "blind" "mice")))) (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") (module info (lib "infotab.ss" "setup")
(define name "Scribblings") (define name "Scribblings"))
(define post-install-collection "doc-installer.ss"))

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 () () "art gallery") (0 () 0 () () "art gallery")
(0 () 0 () () (c! circle c! 10)) (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)) (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)) (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")) (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))) (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 () () (c! define c! c c! (c! circle c! 10)))
(0 () 0 () () (void)) (0 () 0 () () (void))
(0 () 0 () () (c! define c! r c! (c! rectangle c! 10 c! 20))) (0 () 0 () () (c! define c! r c! (c! rectangle c! 10 c! 20)))
(0 () 0 () () (void)) (0 () 0 () () (void))
(0 () 0 () () r) (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)) (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)) (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 () () (c! define c! (c! square c! n) c! (c! filled-rectangle c! n c! n)))
(0 () 0 () () (void)) (0 () 0 () () (void))
(0 () 0 () () (c! square c! 10)) (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 () () (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 () () (void))
(0 () 0 () () (c! four c! (c! circle c! 10))) (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 () () (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 () () (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"))) (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 () () (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 () () (void))
(0 () 0 () () (c! checkerboard c! (c! square c! 10))) (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) (0 () 0 () () circle)
(1 (((lib "struct.ss" "scribble") . deserialize-info:element-v0)) 0 () () (0 #f (c! (u . "#<procedure: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 () () (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 () () (void))
(0 () 0 () () (c! series c! circle)) (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)) (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))))) (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 () () (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 () () (void))
(0 () 0 () () (c! rgb-series c! circle)) (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)) (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 () () (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 () () (void))
(0 () 0 () () (c! series c! (c! rgb-maker c! circle))) (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))) (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! list c! "red" c! "green" c! "blue"))
(0 () 0 () () (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))) (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 () () (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 () () (void))
(0 () 0 () () (c! rainbow c! (c! square c! 5))) (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)))) (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 () () (c! require c! (c! lib c! "flash.ss" c! "texpict")))
(0 () 0 () () (void)) (0 () 0 () () (void))
(0 () 0 () () (c! filled-flash c! 40 c! 30)) (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 () () (c! require c! (c! planet c! "random.ss" c! (c! "schematics" c! "random.plt" c! 1 c! 0))))
(0 () 0 () () (void)) (0 () 0 () () (void))
(0 () 0 () () (c! random-gaussian)) (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 () () (c! require c! (c! lib c! "code.ss" c! "slideshow")))
(0 () 0 () () (void)) (0 () 0 () () (void))
(0 () 0 () () (c! code c! (c! circle c! 10))) (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 () () (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 () () (void))
(0 () 0 () () (c! pict+code c! (c! circle c! 10))) (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 () () (c! require c! (c! lib c! "class.ss" c! "mzlib") c! (c! lib c! "mred.ss" c! "mred")))
(0 () 0 () () (void)) (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)))))) (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% ...)")))) (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"))) (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% ...)")))) (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)) (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 . "quick/images/img29.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/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 ;; This one needs to be relative, because it ends up in the
;; exprs.dat file: ;; 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: ;; This one can be absolute:
(define exprs-dat-file (build-path (collection-path "scribblings") (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") #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. @bold{This reference describes a potential future version of PLT Scheme.
It does not match the current implementation.} It does not match the current implementation.}
@ -14,6 +15,11 @@
@require["slideshow-doc.ss"] @require["slideshow-doc.ss"]
@require["slideshow-code-doc.ss"] @require["slideshow-code-doc.ss"]
@require["mred-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] @require-for-syntax[mzscheme]
@define[filled-flash (lambda args (apply (eval 'filled-flash) args))] @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 and it's worthwhile for everyone who works on those products to know
about @scheme[code]. 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}, this document}. You'll see that it starts with @schemefont{#module},
but otherwise doesn't look a lot like Scheme; nevertheless, we build 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 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")) (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 Each canvas stratches to fill an equal portion of the frame, because
that's how a frame manages its children by default. 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. with an extensive set of libraries and tools.
To start learning about the full PLT Scheme language and tools in 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