suzanne.soy/hyper-literate
1
0
Fork 0
Code Issues 4 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

v3.99.0.2

Browse Source 
svn: r7706

original commit: 39cedb62edf9258b051a22a29a90be9c6841956f
This commit is contained in:
Matthew Flatt 2007-11-13 12:40:00 +00:00
parent 3b4f787f35
commit b134592f8f
27 changed files with 500 additions and 432 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,9 +1,9 @@
(module base-render mzscheme (module base-render scheme/base
(require "struct.ss" (require "struct.ss"
(lib "class.ss") mzlib/class
(lib "serialize.ss") mzlib/serialize
(lib "file.ss")) scheme/file)
(provide render%) (provide render%)
@ -290,9 +290,9 @@
(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
#:exists 'truncate/replace
(lambda () (lambda ()
(render-one d ri fn)) (render-one d ri fn))))
'truncate/replace))
ds ds
fns)) fns))

41
collects/scribble/basic.ss
View File

@ -1,12 +1,13 @@
(module basic (lib "lang.ss" "big") (module basic scheme/base
(require "decode.ss" (require "decode.ss"
"struct.ss" "struct.ss"
"config.ss" "config.ss"
(lib "list.ss") mzlib/list
(lib "class.ss") mzlib/class
(lib "main-collects.ss" "setup") setup/main-collects
(lib "modresolve.ss" "syntax")) syntax/modresolve
(for-syntax scheme/base))
(provide title (provide title
section section
@ -26,17 +27,22 @@
p p
(module-path-prefix->string p)))) (module-path-prefix->string p))))
(define (convert-tag tag content)
(if (list? tag)
(apply append (map (lambda (t) (convert-tag t content)) tag))
`((part ,(or tag (gen-tag content))))))
(define (title #:tag [tag #f] #:tag-prefix [prefix #f] #:style [style #f] . str) (define (title #:tag [tag #f] #:tag-prefix [prefix #f] #:style [style #f] . str)
(let ([content (decode-content str)]) (let ([content (decode-content str)])
(make-title-decl (prefix->string prefix) (make-title-decl (prefix->string prefix)
`((part ,(or tag (gen-tag content)))) (convert-tag tag content)
style style
content))) content)))
(define (section #:tag [tag #f] #:tag-prefix [prefix #f] #:style [style #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 0 (prefix->string prefix) (make-part-start 0 (prefix->string prefix)
`((part ,(or tag (gen-tag content)))) (convert-tag tag content)
style style
content))) content)))
@ -44,7 +50,7 @@
(let ([content (decode-content str)]) (let ([content (decode-content str)])
(make-part-start 1 (make-part-start 1
(prefix->string prefix) (prefix->string prefix)
`((part ,(or tag (gen-tag content)))) (convert-tag tag content)
#f #f
content))) content)))
@ -52,7 +58,7 @@
(let ([content (decode-content str)]) (let ([content (decode-content str)])
(make-part-start 2 (make-part-start 2
(prefix->string prefix) (prefix->string prefix)
`((part ,(or tag (gen-tag content)))) (convert-tag tag content)
#f #f
content))) content)))
@ -60,12 +66,13 @@
(let ([content (decode-content str)]) (let ([content (decode-content str)])
(make-paragraph (list (make-element 'bold content))))) (make-paragraph (list (make-element 'bold content)))))
(define-syntax include-section (define-syntax (include-section stx)
(syntax-rules () (syntax-case stx ()
[(_ mod) [(_ mod)
(begin (with-syntax ([mod (syntax-local-introduce #'mod)])
(require (only mod doc)) #'(begin
doc)])) (require (only-in mod doc))
doc))]))
;; ---------------------------------------- ;; ----------------------------------------
@ -201,9 +208,9 @@
(part-collected-info sec ri)) (part-collected-info sec ri))
ri)) ri))
(lambda (k v) (lambda (k v)
(if (and (pair? k) (when (and (pair? k)
(eq? 'index-entry (car k))) (eq? 'index-entry (car k)))
(set! l (cons (cons (cadr k) v) l))))) (set! l (cons (cons (cadr k) v) l)))))
(let ([l (sort (let ([l (sort
l l
(lambda (a b) (lambda (a b)

22
collects/scribble/doclang.ss
View File

@ -1,19 +1,19 @@
(module doclang (lib "lang.ss" "big") (module doclang scheme/base
(require "struct.ss" (require "struct.ss"
"decode.ss" "decode.ss"
(lib "kw.ss")) (for-syntax scheme/base
(require-for-syntax (lib "kerncase.ss" "syntax")) syntax/kerncase))
(provide (all-from-except (lib "lang.ss" "big") #%module-begin) (provide (except-out (all-from-out scheme/base) #%module-begin)
(rename *module-begin #%module-begin)) (rename-out [*module-begin #%module-begin]))
;; Module wrapper ---------------------------------------- ;; Module wrapper ----------------------------------------
(define-syntax (*module-begin stx) (define-syntax (*module-begin stx)
(syntax-case stx () (syntax-case stx ()
[(_ id exprs . body) [(_ id exprs . body)
#'(#%plain-module-begin #'(#%module-begin
(doc-begin id exprs . body))])) (doc-begin id exprs . body))]))
(define-syntax (doc-begin stx) (define-syntax (doc-begin stx)
@ -40,21 +40,17 @@
(let ([expanded (local-expand #'body1 (let ([expanded (local-expand #'body1
'module 'module
(append (append
(kernel-form-identifier-list #'here) (kernel-form-identifier-list)
(syntax->list #'(provide (syntax->list #'(provide
require require))))])
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)]
[(id . rest) [(id . rest)
(and (identifier? #'id) (and (identifier? #'id)
(ormap (lambda (kw) (module-identifier=? #'id kw)) (ormap (lambda (kw) (free-identifier=? #'id kw))
(syntax->list #'(require (syntax->list #'(require
provide provide
require-for-syntax
require-for-label
define-values define-values
define-syntaxes define-syntaxes
define-for-syntaxes)))) define-for-syntaxes))))

15
collects/scribble/docreader.ss
View File

@ -1,15 +1,14 @@
(module docreader mzscheme (module docreader scheme/base
(require (prefix scribble: "reader.ss") (require (prefix-in scribble: "reader.ss"))
(lib "kw.ss"))
(provide (rename *read read) (provide (rename-out [*read read])
(rename *read-syntax read-syntax)) (rename-out [*read-syntax read-syntax]))
(define/kw (*read #:optional [inp (current-input-port)]) (define (*read [inp (current-input-port)])
(wrap inp (scribble:read-inside inp))) (wrap inp (scribble:read-inside inp)))
(define/kw (*read-syntax #:optional src [port (current-input-port)]) (define (*read-syntax [src #f] [port (current-input-port)])
(wrap port (scribble:read-inside-syntax src port))) (wrap port (scribble:read-inside-syntax src port)))
(define (wrap port body) (define (wrap port body)
@ -19,7 +18,7 @@
(string->symbol (path->string (path-replace-suffix name #"")))) (string->symbol (path->string (path-replace-suffix name #""))))
'page)] 'page)]
[id 'doc]) [id 'doc])
`(module ,name (lib "doclang.ss" "scribble") `(module ,name scribble/doclang
(#%module-begin (#%module-begin
,id () ,id ()
. ,body))))) . ,body)))))

48
collects/scribble/eval.ss
View File

@ -1,12 +1,12 @@
(module eval (lib "lang.ss" "big") (module eval scheme/base
(require "manual.ss" (require "manual.ss"
"struct.ss" "struct.ss"
"scheme.ss" "scheme.ss"
"decode.ss" "decode.ss"
(lib "class.ss") scheme/file
(lib "file.ss") mzlib/string
(lib "string.ss")) (for-syntax scheme/base))
(provide interaction (provide interaction
interaction-eval interaction-eval
@ -33,6 +33,17 @@
(define maxlen 60) (define maxlen 60)
(namespace-require 'scheme/base)
(define (literal-string style s)
(let ([m (regexp-match #rx"^(.*)( +)(.*)$" s)])
(if m
(make-element #f
(list (literal-string style (cadr m))
(hspace (string-length (caddr m)))
(literal-string style (cadddr m))))
(make-element style (list s)))))
(define (format-output str style) (define (format-output str style)
(if (string=? "" str) (if (string=? "" str)
null null
@ -48,14 +59,14 @@
(make-paragraph (make-paragraph
(list (list
(hspace 2) (hspace 2)
(span-class style (car s)))) (literal-string style (car s))))
(make-table (make-table
#f #f
(map (lambda (s) (map (lambda (s)
(list (make-flow (list (make-paragraph (list (make-flow (list (make-paragraph
(list (list
(hspace 2) (hspace 2)
(span-class style s))))))) (literal-string style s)))))))
s)))))))))) s))))))))))
(define (interleave title expr-paras val-list+outputs) (define (interleave title expr-paras val-list+outputs)
@ -145,11 +156,12 @@
=> (lambda (v) v)] => (lambda (v) v)]
[(string? v) (install ht v (string-copy v))] [(string? v) (install ht v (string-copy v))]
[(bytes? v) (install ht v (bytes-copy v))] [(bytes? v) (install ht v (bytes-copy v))]
[(pair? v) (let ([p (cons #f #f)]) [(pair? v) (cons (copy-value (car v) ht)
(hash-table-put! ht v p) (copy-value (cdr v) ht))]
(set-car! p (copy-value (car v) ht)) [(mpair? v) (let ([p (mcons #f #f)])
(set-cdr! p (copy-value (cdr v) ht)) (set-mcar! p (copy-value (mcar v) ht))
p)] (set-mcdr! p (copy-value (mcdr v) ht))
p)]
[(vector? v) (let ([v2 (make-vector (vector-length v))]) [(vector? v) (let ([v2 (make-vector (vector-length v))])
(hash-table-put! ht v v2) (hash-table-put! ht v v2)
(let loop ([i (vector-length v2)]) (let loop ([i (vector-length v2)])
@ -169,12 +181,12 @@
[((code:comment . _) . rest) [((code:comment . _) . rest)
(strip-comments #'rest)] (strip-comments #'rest)]
[(a . b) [(a . b)
(datum->syntax-object stx (datum->syntax stx
(cons (strip-comments #'a) (cons (strip-comments #'a)
(strip-comments #'b)) (strip-comments #'b))
stx stx
stx stx
stx)] stx)]
[code:blank #'(void)] [code:blank #'(void)]
[else stx])) [else stx]))
@ -187,7 +199,7 @@
(let ([s (strip-comments s)]) (let ([s (strip-comments s)])
(syntax-case s (module) (syntax-case s (module)
[(module . _rest) [(module . _rest)
(syntax-object->datum s)] (syntax->datum s)]
[_else s])))) [_else s]))))
list))) list)))

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

@ -1,13 +1,14 @@
(module html-render mzscheme (module html-render scheme/base
(require "struct.ss" (require "struct.ss"
(lib "class.ss") scheme/class
(lib "file.ss") scheme/file
(lib "list.ss") mzlib/runtime-path
(lib "runtime-path.ss") setup/main-doc
(lib "main-doc.ss" "setup") setup/main-collects
(lib "main-collects.ss" "setup") mzlib/list
(prefix xml: (lib "xml.ss" "xml"))) (prefix-in xml: xml/xml)
(for-syntax scheme/base))
(provide render-mixin (provide render-mixin
render-multi-mixin) render-multi-mixin)
@ -210,7 +211,7 @@
(lambda (para) (lambda (para)
(let loop ([c (paragraph-content para)]) (let loop ([c (paragraph-content para)])
(cond (cond
[(empty? c) null] [(null? c) null]
[else (let ([a (car c)]) [else (let ([a (car c)])
(cond (cond
[(toc-target-element? a) [(toc-target-element? a)
@ -280,7 +281,8 @@
(href "scribble.css") (href "scribble.css")
(title "default")))) (title "default"))))
(body ,@(render-toc-view d ri) (body ,@(render-toc-view d ri)
(div ((class "main")) ,@(render-part d ri))))]) (div ((class "maincolumn"))
(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)))))
@ -577,9 +579,9 @@
(parameterize ([current-subdirectory (file-name-from-path fn)]) (parameterize ([current-subdirectory (file-name-from-path fn)])
(let ([fn (build-path fn "index.html")]) (let ([fn (build-path fn "index.html")])
(with-output-to-file fn (with-output-to-file fn
#:exists 'truncate/replace
(lambda () (lambda ()
(render-one d ri fn)) (render-one d ri fn))))))
'truncate/replace))))
ds ds
fns)) fns))
@ -718,9 +720,9 @@
filename)]) filename)])
(parameterize ([on-separate-page #t]) (parameterize ([on-separate-page #t])
(with-output-to-file full-path (with-output-to-file full-path
#:exists 'truncate/replace
(lambda () (lambda ()
(render-one-part d ri full-path number)) (render-one-part d ri full-path number)))
'truncate/replace)
null))] null))]
[else [else
(let ([sep? (on-separate-page)]) (let ([sep? (on-separate-page)])

2
collects/scribble/info.ss
View File

@ -1,4 +1,4 @@
(module info (lib "infotab.ss" "setup") (module info setup/infotab
(define name "Scribble") (define name "Scribble")
(define blurb '("MzScheme extensions for writing text.")) (define blurb '("MzScheme extensions for writing text."))
(define mzscheme-launcher-names '("scribble")) (define mzscheme-launcher-names '("scribble"))

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

@ -1,7 +1,7 @@
(module latex-render mzscheme (module latex-render scheme/base
(require "struct.ss" (require "struct.ss"
(lib "class.ss")) mzlib/class)
(provide render-mixin) (provide render-mixin)
(define current-table-mode (make-parameter #f)) (define current-table-mode (make-parameter #f))

229
collects/scribble/manual.ss
View File

@ -1,20 +1,20 @@
(module manual (lib "lang.ss" "big") (module manual scheme/base
(require "decode.ss" (require "decode.ss"
"struct.ss" "struct.ss"
"scheme.ss" "scheme.ss"
"config.ss" "config.ss"
"basic.ss" "basic.ss"
(lib "string.ss") mzlib/string
(lib "list.ss") scheme/class
(lib "class.ss") scheme/stxparam
(lib "stxparam.ss") mzlib/serialize
(lib "serialize.ss")) (for-syntax scheme/base)
(require-for-syntax (lib "stxparam.ss")) (for-label scheme/base
(require-for-label (lib "lang.ss" "big") scheme/class))
(lib "class.ss"))
(provide (all-from "basic.ss")) (provide (all-from-out "basic.ss")
unsyntax)
(provide PLaneT) (provide PLaneT)
(define PLaneT "PLaneT") (define PLaneT "PLaneT")
@ -42,9 +42,9 @@
(define-syntax (schememod stx) (define-syntax (schememod stx)
(syntax-case stx () (syntax-case stx ()
[(_ lang rest ...) [(_ lang rest ...)
(with-syntax ([modtag (datum->syntax-object (with-syntax ([modtag (datum->syntax
#'here #'here
`(unsyntax (schemefont ,(format "#module ~a" (syntax-e #'lang)))) `(unsyntax (schemefont ,(format "#lang ~a" (syntax-e #'lang))))
#'lang)]) #'lang)])
#'(schemeblock modtag rest ...))])) #'(schemeblock modtag rest ...))]))
@ -61,7 +61,7 @@
(boolean? sv) (boolean? sv)
(and (pair? sv) (and (pair? sv)
(identifier? (car sv)) (identifier? (car sv))
(module-identifier=? #'cons (car sv)))) (free-identifier=? #'cons (car sv))))
;; We know that the context is irrelvant ;; We know that the context is irrelvant
#'s #'s
;; Context may be relevant: ;; Context may be relevant:
@ -124,11 +124,26 @@
[else (format "~s" s)])]) [else (format "~s" s)])])
(index* (list k) (list e) e))) (index* (list k) (list e) e)))
(provide schemeblock SCHEMEBLOCK (define-syntax define-/form
schemeblock0 SCHEMEBLOCK0 (syntax-rules ()
[(_ id base)
(define-syntax (id stx)
(syntax-case stx ()
[(_ a)
(with-syntax ([ellipses (datum->syntax #'a
'(... ...))])
#'(let ([ellipses #f])
(base a)))]))]))
(define-/form schemeblock0/form schemeblock0)
(define-/form schemeblock/form schemeblock)
(define-/form scheme/form scheme)
(provide schemeblock SCHEMEBLOCK schemeblock/form
schemeblock0 SCHEMEBLOCK0 schemeblock0/form
schemeinput schemeinput
schememod schememod
scheme schemeresult schemeid schememodname scheme scheme/form schemeresult schemeid schememodname
indexed-scheme indexed-scheme
litchar litchar
verbatim) verbatim)
@ -136,7 +151,7 @@
(provide onscreen menuitem defterm (provide onscreen menuitem defterm
schemefont schemevalfont schemeresultfont schemeidfont schemefont schemevalfont schemeresultfont schemeidfont
schemeparenfont schemekeywordfont schememetafont schememodfont schemeparenfont schemekeywordfont schememetafont schememodfont
file exec envvar Flag DFlag filepath exec envvar Flag DFlag
indexed-file indexed-envvar indexed-file indexed-envvar
link procedure link procedure
idefterm) idefterm)
@ -166,10 +181,10 @@
(make-element "schememod" (decode-content str))) (make-element "schememod" (decode-content str)))
(define (schemekeywordfont . str) (define (schemekeywordfont . str)
(make-element "schemekeyword" (decode-content str))) (make-element "schemekeyword" (decode-content str)))
(define (file . str) (define (filepath . str)
(make-element 'tt (append (list "\"") (decode-content str) (list "\"")))) (make-element 'tt (append (list "\"") (decode-content str) (list "\""))))
(define (indexed-file . str) (define (indexed-file . str)
(let* ([f (apply file str)] (let* ([f (apply filepath str)]
[s (element->string f)]) [s (element->string f)])
(index* (list (substring s 1 (sub1 (string-length s)))) (list f) f))) (index* (list (substring s 1 (sub1 (string-length s)))) (list f) f)))
(define (exec . str) (define (exec . str)
@ -202,7 +217,7 @@
;; ---------------------------------------- ;; ----------------------------------------
(provide method xmethod (rename method ::)) (provide method xmethod (rename-out [method ::]))
(define-syntax method (define-syntax method
(syntax-rules () (syntax-rules ()
@ -234,8 +249,10 @@
(provide margin-note) (provide margin-note)
(define (margin-note . c) (define (margin-note . c)
(make-styled-paragraph (list (make-element "refcontent" (make-styled-paragraph (list (make-element "refcolumn"
c)) (list
(make-element "refcontent"
c))))
"refpara")) "refpara"))
;; ---------------------------------------- ;; ----------------------------------------
@ -280,6 +297,7 @@
defidform defidform
specform specform/subs specform specform/subs
specsubform specsubform/subs specspecsubform specspecsubform/subs specsubform/inline specsubform specsubform/subs specspecsubform specspecsubform/subs specsubform/inline
defsubform
schemegrammar schemegrammar* schemegrammar schemegrammar*
var svar void-const undefined-const) var svar void-const undefined-const)
@ -305,10 +323,10 @@
(syntax-position s) (syntax-position s)
(syntax-span s)))]) (syntax-span s)))])
#'(let ([s (quote-syntax id)]) #'(let ([s (quote-syntax id)])
(datum->syntax-object s (datum->syntax s
(syntax-e s) (syntax-e s)
'loc 'loc
s)))])) s)))]))
(define void-const (define void-const
(schemeresultfont "#<void>")) (schemeresultfont "#<void>"))
@ -365,14 +383,14 @@
(lambda () (list desc ...)))])) (lambda () (list desc ...)))]))
(define-syntax defstruct (define-syntax defstruct
(syntax-rules () (syntax-rules ()
[(_ name fields #:immutable #:inspector #f desc ...) [(_ name fields #:mutable #:inspector #f desc ...)
(**defstruct name fields #t #t desc ...)]
[(_ name fields #:immutable desc ...)
(**defstruct name fields #t #f desc ...)]
[(_ name fields #:inspector #f desc ...)
(**defstruct name fields #f #t desc ...)] (**defstruct name fields #f #t desc ...)]
[(_ name fields #:mutable desc ...)
(**defstruct name fields #f #f desc ...)]
[(_ name fields #:inspector #f desc ...)
(**defstruct name fields #t #t desc ...)]
[(_ name fields desc ...) [(_ name fields desc ...)
(**defstruct name fields #f #f desc ...)])) (**defstruct name fields #t #f desc ...)]))
(define-syntax **defstruct (define-syntax **defstruct
(syntax-rules () (syntax-rules ()
[(_ name ([field field-contract] ...) immutable? transparent? desc ...) [(_ name ([field field-contract] ...) immutable? transparent? desc ...)
@ -385,23 +403,23 @@
(with-syntax ([new-spec (with-syntax ([new-spec
(syntax-case #'spec () (syntax-case #'spec ()
[(name . rest) [(name . rest)
(datum->syntax-object #'spec (datum->syntax #'spec
(cons (cons
(datum->syntax-object #'here (datum->syntax #'here
'(unsyntax x) '(unsyntax x)
#'name) #'name)
#'rest) #'rest)
#'spec)])] #'spec)])]
[spec-id [spec-id
(syntax-case #'spec () (syntax-case #'spec ()
[(name . rest) #'name])]) [(name . rest) #'name])])
#'(*defforms (quote-syntax/loc spec-id) '(lit ...) #'(*defforms (quote-syntax/loc spec-id) '(lit ...)
'(spec spec1 ...) '(spec spec1 ...)
(list (lambda (x) (schemeblock0 new-spec)) (list (lambda (x) (schemeblock0/form new-spec))
(lambda (ignored) (schemeblock0 spec1)) ...) (lambda (ignored) (schemeblock0/form spec1)) ...)
'((non-term-id non-term-form ...) ...) '((non-term-id non-term-form ...) ...)
(list (list (lambda () (scheme non-term-id)) (list (list (lambda () (scheme non-term-id))
(lambda () (schemeblock0 non-term-form)) (lambda () (schemeblock0/form non-term-form))
...) ...)
...) ...)
(lambda () (list desc ...))))] (lambda () (list desc ...))))]
@ -423,7 +441,7 @@
(syntax-case stx () (syntax-case stx ()
[(_ spec desc ...) [(_ spec desc ...)
#'(*defforms #f null #'(*defforms #f null
'(spec) (list (lambda (ignored) (schemeblock0 spec))) '(spec) (list (lambda (ignored) (schemeblock0/form spec)))
null null null null
(lambda () (list desc ...)))])) (lambda () (list desc ...)))]))
(define-syntax (defidform stx) (define-syntax (defidform stx)
@ -435,19 +453,22 @@
null null
null null
(lambda () (list desc ...)))])) (lambda () (list desc ...)))]))
(define-syntax (defsubform stx)
(syntax-case stx ()
[(_ . rest) #'(into-blockquote (defform . rest))]))
(define-syntax specsubform (define-syntax specsubform
(syntax-rules () (syntax-rules ()
[(_ #:literals (lit ...) spec desc ...) [(_ #:literals (lit ...) spec desc ...)
(*specsubform 'spec #f '(lit ...) (lambda () (schemeblock0 spec)) null null (lambda () (list desc ...)))] (*specsubform 'spec #f '(lit ...) (lambda () (schemeblock0/form spec)) null null (lambda () (list desc ...)))]
[(_ spec desc ...) [(_ spec desc ...)
(*specsubform 'spec #f null (lambda () (schemeblock0 spec)) null null (lambda () (list desc ...)))])) (*specsubform 'spec #f null (lambda () (schemeblock0/form spec)) null null (lambda () (list desc ...)))]))
(define-syntax specsubform/subs (define-syntax specsubform/subs
(syntax-rules () (syntax-rules ()
[(_ #:literals (lit ...) spec ([non-term-id non-term-form ...] ...) desc ...) [(_ #:literals (lit ...) spec ([non-term-id non-term-form ...] ...) desc ...)
(*specsubform 'spec #f '(lit ...) (lambda () (schemeblock0 spec)) (*specsubform 'spec #f '(lit ...) (lambda () (schemeblock0/form spec))
'((non-term-id non-term-form ...) ...) '((non-term-id non-term-form ...) ...)
(list (list (lambda () (scheme non-term-id)) (list (list (lambda () (scheme non-term-id))
(lambda () (schemeblock0 non-term-form)) (lambda () (schemeblock0/form non-term-form))
...) ...)
...) ...)
(lambda () (list desc ...)))] (lambda () (list desc ...)))]
@ -464,18 +485,18 @@
(define-syntax specform (define-syntax specform
(syntax-rules () (syntax-rules ()
[(_ #:literals (lit ...) spec desc ...) [(_ #:literals (lit ...) spec desc ...)
(*specsubform 'spec #t '(lit ...) (lambda () (schemeblock0 spec)) null null (lambda () (list desc ...)))] (*specsubform 'spec #t '(lit ...) (lambda () (schemeblock0/form spec)) null null (lambda () (list desc ...)))]
[(_ spec desc ...) [(_ spec desc ...)
(*specsubform 'spec #t null (lambda () (schemeblock0 spec)) null null (lambda () (list desc ...)))])) (*specsubform 'spec #t null (lambda () (schemeblock0/form spec)) null null (lambda () (list desc ...)))]))
(define-syntax specform/subs (define-syntax specform/subs
(syntax-rules () (syntax-rules ()
[(_ #:literals (lit ...) spec ([non-term-id non-term-form ...] ...) desc ...) [(_ #:literals (lit ...) spec ([non-term-id non-term-form ...] ...) desc ...)
(*specsubform 'spec #t (*specsubform 'spec #t
'(lit ...) '(lit ...)
(lambda () (schemeblock0 spec)) (lambda () (schemeblock0/form spec))
'((non-term-id non-term-form ...) ...) '((non-term-id non-term-form ...) ...)
(list (list (lambda () (scheme non-term-id)) (list (list (lambda () (scheme non-term-id))
(lambda () (schemeblock0 non-term-form)) (lambda () (schemeblock0/form non-term-form))
...) ...)
...) ...)
(lambda () (list desc ...)))] (lambda () (list desc ...)))]
@ -501,7 +522,7 @@
(syntax-rules () (syntax-rules ()
[(_ #:literals (lit ...) id clause ...) (*schemegrammar '(lit ...) [(_ #:literals (lit ...) id clause ...) (*schemegrammar '(lit ...)
'(id clause ...) '(id clause ...)
(lambda () (list (list (scheme id) (schemeblock0 clause) ...))))] (lambda () (list (list (scheme id) (schemeblock0/form clause) ...))))]
[(_ id clause ...) (schemegrammar #:literals () id clause ...)])) [(_ id clause ...) (schemegrammar #:literals () id clause ...)]))
(define-syntax schemegrammar* (define-syntax schemegrammar*
(syntax-rules () (syntax-rules ()
@ -509,7 +530,7 @@
'(id ... clause ... ...) '(id ... clause ... ...)
(lambda () (lambda ()
(list (list
(list (scheme id) (schemeblock0 clause) ...) ...)))] (list (scheme id) (schemeblock0/form clause) ...) ...)))]
[(_ [id clause ...] ...) (schemegrammar #:literals () [id clause ...] ...)])) [(_ [id clause ...] ...) (schemegrammar #:literals () [id clause ...] ...)]))
(define-syntax var (define-syntax var
(syntax-rules () (syntax-rules ()
@ -518,6 +539,13 @@
(syntax-rules () (syntax-rules ()
[(_ id) (*var 'id)])) [(_ id) (*var 'id)]))
(define (into-blockquote s)
(cond
[(splice? s)
(make-blockquote "leftindent" (flow-paragraphs (decode-flow (splice-run s))))]
[else
(make-blockquote "leftindent" (list s))]))
(define (make-table-if-necessary style content) (define (make-table-if-necessary style content)
(if (= 1 (length content)) (if (= 1 (length content))
(let ([paras (apply append (map flow-paragraphs (car content)))]) (let ([paras (apply append (map flow-paragraphs (car content)))])
@ -879,9 +907,9 @@
(map symbol->string (car wrappers)))] (map symbol->string (car wrappers)))]
[tag [tag
(register-scheme-definition (register-scheme-definition
(datum->syntax-object stx-id (datum->syntax stx-id
(string->symbol (string->symbol
name)) name))
#t)]) #t)])
(if tag (if tag
(inner-make-target-element (inner-make-target-element
@ -937,9 +965,9 @@
values values
(map (lambda (f) (map (lambda (f)
(if (and (pair? (car f)) (if (and (pair? (car f))
(memq '#:immutable (car f))) (memq '#:mutable (car f)))
#f (list 'set- name '- (field-name f) '!)
(list 'set- name '- (field-name f) '!))) #f))
fields)))))))]) fields)))))))])
(if (pair? name) (if (pair? name)
(to-element (list just-name (to-element (list just-name
@ -1010,11 +1038,11 @@
e))))) e)))))
(loop (cdr fields)))))) (loop (cdr fields))))))
(cond (cond
[(and immutable? transparent?) [(and (not immutable?) transparent?)
(list (list
(list (to-flow spacer) (list (to-flow spacer)
(to-flow spacer) (to-flow spacer)
(to-flow (to-element '#:immutable)) (to-flow (to-element '#:mutable))
'cont 'cont
'cont) 'cont)
(list (to-flow spacer) (list (to-flow spacer)
@ -1027,13 +1055,13 @@
(schemeparenfont ")")))) (schemeparenfont ")"))))
'cont 'cont
'cont))] 'cont))]
[immutable? [(not immutable?)
(list (list
(list (to-flow spacer) (list (to-flow spacer)
(to-flow spacer) (to-flow spacer)
(to-flow (make-element (to-flow (make-element
#f #f
(list (to-element '#:immutable) (list (to-element '#:mutable)
(schemeparenfont ")")))) (schemeparenfont ")"))))
'cont 'cont
'cont))] 'cont))]
@ -1117,7 +1145,7 @@
(loop (cdr form)))] (loop (cdr form)))]
[else null]))) [else null])))
forms))] forms))]
[current-meta-list '(... ...+)]) [current-meta-list '(... ...+)])
(make-splice (make-splice
(cons (cons
(make-table (make-table
@ -1329,21 +1357,21 @@
"[...]" "[...]"
#; #;
(make-bibliography-element (make-bibliography-element
#f #f
(list "[...]") (list "[...]")
key key
(list (string-append (list (string-append
(content->string (list author)) (content->string (list author))
", " ", "
(content->string (list title)))) (content->string (list title))))
(list (make-element #f (list author (list (make-element #f (list author
", " ", "
title title
", " ", "
date date
". " ". "
location location
"."))))) ".")))))
;; ---------------------------------------- ;; ----------------------------------------
@ -1444,7 +1472,8 @@
(list (symbol->string (syntax-e (decl-name decl)))) (list (symbol->string (syntax-e (decl-name decl))))
tag))) tag)))
(and (decl-super decl) (and (decl-super decl)
(not (module-label-identifier=? #'object% (decl-super decl))) (not (free-label-identifier=? (quote-syntax object%)
(decl-super decl)))
(register-scheme-definition (decl-super decl))) (register-scheme-definition (decl-super decl)))
(map register-scheme-definition (decl-intfs decl)) (map register-scheme-definition (decl-intfs decl))
(map (lambda (m) (map (lambda (m)
@ -1545,17 +1574,17 @@
(syntax-rules () (syntax-rules ()
[(_ *include-class name super (intf ...) body ...) [(_ *include-class name super (intf ...) body ...)
(*include-class (*include-class
(syntax-parameterize ([current-class (quote-syntax name)]) (syntax-parameterize ([current-class (quote-syntax name)])
(make-decl (quote-syntax/loc name) (make-decl (quote-syntax/loc name)
(quote-syntax/loc super) (quote-syntax/loc super)
(list (quote-syntax/loc intf) ...) (list (quote-syntax/loc intf) ...)
(lambda (whole-page?) (lambda (whole-page?)
(list (list
(*class-doc (quote-syntax/loc name) (*class-doc (quote-syntax/loc name)
(quote-syntax super) (quote-syntax super)
(list (quote-syntax intf) ...) (list (quote-syntax intf) ...)
whole-page?))) whole-page?)))
(list body ...))))])) (list body ...))))]))
(define-syntax defclass (define-syntax defclass
(syntax-rules () (syntax-rules ()
@ -1598,15 +1627,15 @@
[(_ mode ((arg ...) ...) desc ...) [(_ mode ((arg ...) ...) desc ...)
(let ([n (syntax-parameter-value #'current-class)]) (let ([n (syntax-parameter-value #'current-class)])
(with-syntax ([name n] (with-syntax ([name n]
[result (datum->syntax-object #f [result (datum->syntax #f
(list (list
(datum->syntax-object #'is-a?/c (datum->syntax #'is-a?/c
'is-a?/c 'is-a?/c
(list 'src 1 1 2 1)) (list 'src 1 1 2 1))
(datum->syntax-object n (datum->syntax n
(syntax-e n) (syntax-e n)
(list 'src 1 3 4 1))) (list 'src 1 3 4 1)))
(list 'src 1 0 1 5))] (list 'src 1 0 1 5))]
[(((kw ...) ...) ...) (map (lambda (ids) [(((kw ...) ...) ...) (map (lambda (ids)
(map (lambda (arg) (map (lambda (arg)
(if (and (pair? (syntax-e arg)) (if (and (pair? (syntax-e arg))

4
collects/scribble/run.ss
View File

@ -91,6 +91,6 @@
(when (current-info-output-file) (when (current-info-output-file)
(let ([s (send renderer serialize-info r-info)]) (let ([s (send renderer serialize-info r-info)])
(with-output-to-file (current-info-output-file) (with-output-to-file (current-info-output-file)
#:exists 'truncate/replace
(lambda () (lambda ()
(write s)) (write s))))))))))))
'truncate/replace))))))))))

143
collects/scribble/scheme.ss
View File

@ -1,10 +1,11 @@
(module scheme (lib "lang.ss" "big") (module scheme scheme/base
(require "struct.ss" (require "struct.ss"
"basic.ss" "basic.ss"
(lib "class.ss") mzlib/class
(lib "for.ss") mzlib/for
(lib "main-collects.ss" "setup") setup/main-collects
(lib "modresolve.ss" "syntax")) syntax/modresolve
(for-syntax scheme/base))
(provide define-code (provide define-code
to-element to-element
@ -19,8 +20,8 @@
current-variable-list current-variable-list
current-meta-list current-meta-list
(struct shaped-parens (val shape)) (struct-out shaped-parens)
(struct just-context (val ctx))) (struct-out just-context))
(define no-color "schemeplain") (define no-color "schemeplain")
(define reader-color "schemereader") (define reader-color "schemereader")
@ -219,29 +220,29 @@
[else (let ([p2 (syntax-position (car l))]) [else (let ([p2 (syntax-position (car l))])
(if (and p2 (if (and p2
(p2 . > . (syntax-position a))) (p2 . > . (syntax-position a)))
(datum->syntax-object c (datum->syntax c
(append (append
(reverse prev) (reverse prev)
(list (list
(datum->syntax-object (datum->syntax
a a
(let ([val? (positive? quote-depth)]) (let ([val? (positive? quote-depth)])
(make-sized-element (make-sized-element
(if val? value-color #f) (if val? value-color #f)
(list (list
(make-element (if val? value-color paren-color) '(". ")) (make-element (if val? value-color paren-color) '(". "))
(typeset a #f "" "" "" (not val?)) (typeset a #f "" "" "" (not val?))
(make-element (if val? value-color paren-color) '(" ."))) (make-element (if val? value-color paren-color) '(" .")))
(+ (syntax-span a) 4))) (+ (syntax-span a) 4)))
(list (syntax-source a) (list (syntax-source a)
(syntax-line a) (syntax-line a)
(- (syntax-column a) 2) (- (syntax-column a) 2)
(- (syntax-position a) 2) (- (syntax-position a) 2)
(+ (syntax-span a) 4)) (+ (syntax-span a) 4))
a)) a))
l) l)
c c
c) c)
(loop (cdr l) (loop (cdr l)
(cons (car l) prev))))])))))) (cons (car l) prev))))]))))))
(define (no-fancy-chars s) (define (no-fancy-chars s)
@ -257,7 +258,7 @@
(eq? (syntax-e (car (syntax-e c))) 'code:comment)) (eq? (syntax-e (car (syntax-e c))) 'code:comment))
(advance c init-line!) (advance c init-line!)
(out "; " comment-color) (out "; " comment-color)
(let ([v (syntax-object->datum (cadr (syntax->list c)))]) (let ([v (syntax->datum (cadr (syntax->list c)))])
(if (paragraph? v) (if (paragraph? v)
(map (lambda (v) (map (lambda (v)
(let ([v (no-fancy-chars v)]) (let ([v (no-fancy-chars v)])
@ -289,7 +290,7 @@
(let ([l (syntax->list c)] (let ([l (syntax->list c)]
[h? highlight?]) [h? highlight?])
(unless (and l (= 2 (length l))) (unless (and l (= 2 (length l)))
(error "bad code:redex: ~e" (syntax-object->datum c))) (error "bad code:redex: ~e" (syntax->datum c)))
(advance c init-line!) (advance c init-line!)
(set! src-col (syntax-column (cadr l))) (set! src-col (syntax-column (cadr l)))
(hash-table-put! next-col-map src-col dest-col) (hash-table-put! next-col-map src-col dest-col)
@ -304,7 +305,7 @@
(set! src-col (+ src-col 1)) (set! src-col (+ src-col 1))
(hash-table-put! next-col-map src-col dest-col) (hash-table-put! next-col-map src-col dest-col)
((loop init-line! quote-depth) ((loop init-line! quote-depth)
(datum->syntax-object #'here 'quote (car (syntax-e c)))) (datum->syntax #'here 'quote (car (syntax-e c))))
(for-each (loop init-line! (add1 quote-depth)) (for-each (loop init-line! (add1 quote-depth))
(cdr (syntax->list c))) (cdr (syntax->list c)))
(out ")" (if (positive? quote-depth) value-color paren-color)) (out ")" (if (positive? quote-depth) value-color paren-color))
@ -482,7 +483,7 @@
(cond (cond
[(syntax? v) [(syntax? v)
(let ([mk `(,#'d->s (let ([mk `(,#'d->s
(quote-syntax ,(datum->syntax-object v 'defcode)) (quote-syntax ,(datum->syntax 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))])
@ -504,7 +505,7 @@
[(null? v) 'null] [(null? v) 'null]
[else `(quote ,v)])) [else `(quote ,v)]))
(define (cvt s) (define (cvt s)
(datum->syntax-object #'here (stx->loc-s-expr s) #f)) (datum->syntax #'here (stx->loc-s-expr s) #f))
(syntax-case stx () (syntax-case stx ()
[(_ expr) #`(typeset-code #,(cvt #'expr))] [(_ expr) #`(typeset-code #,(cvt #'expr))]
[(_ expr (... ...)) [(_ expr (... ...))
@ -512,13 +513,13 @@
[(_ code typeset-code uncode d->s) [(_ code typeset-code uncode d->s)
#'(define-code code typeset-code uncode d->s syntax-property)] #'(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 syntax-property)]
[(_ code typeset-code) #'(define-code code typeset-code unsyntax)])) [(_ code typeset-code) #'(define-code code typeset-code unsyntax)]))
(define (register-scheme stx [warn-if-no-label? #f]) (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->datum stx)))
(let ([b (identifier-label-binding stx)]) (let ([b (identifier-label-binding stx)])
(if (or (not b) (if (or (not b)
(eq? b 'lexical)) (eq? b 'lexical))
@ -535,10 +536,10 @@
(format ":NOLABEL:~a" (syntax-e stx))) (format ":NOLABEL:~a" (syntax-e stx)))
#f) #f)
(format ":~a:~a" (format ":~a:~a"
(if (module-path-index? (car b)) (let ([p (resolve-module-path-index (car b) #f)])
(let ([p (resolve-module-path-index (car b) #f)]) (if (path? p)
(path->main-collects-relative p)) (path->main-collects-relative p)
(car b)) p))
(cadr b))))) (cadr b)))))
(define (register-scheme/invent stx warn-if-no-label?) (define (register-scheme/invent stx warn-if-no-label?)
@ -589,11 +590,11 @@
(shaped-parens-shape v))] (shaped-parens-shape v))]
[(just-context? v) [(just-context? v)
(let ([s (syntax-ize (just-context-val v) col)]) (let ([s (syntax-ize (just-context-val v) col)])
(datum->syntax-object (just-context-ctx v) (datum->syntax (just-context-ctx v)
(syntax-e s) (syntax-e s)
s s
s s
(just-context-ctx v)))] (just-context-ctx v)))]
[(and (list? v) [(and (list? v)
(pair? v) (pair? v)
(memq (let ([s (car v)]) (memq (let ([s (car v)])
@ -602,11 +603,11 @@
s)) s))
'(quote unquote unquote-splicing))) '(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 #f
(list (syntax-ize (car v) col) (list (syntax-ize (car v) col)
c) c)
(list #f 1 col (+ 1 col) (list #f 1 col (+ 1 col)
(+ 1 (syntax-span c)))))] (+ 1 (syntax-span c)))))]
[(or (list? v) [(or (list? v)
(vector? v)) (vector? v))
(let* ([vec-sz (if (vector? v) (let* ([vec-sz (if (vector? v)
@ -621,30 +622,30 @@
(let ([i (syntax-ize (car v) col)]) (let ([i (syntax-ize (car v) col)])
(cons i (cons i
(loop (+ col 1 (syntax-span i)) (cdr v))))))]) (loop (+ col 1 (syntax-span i)) (cdr v))))))])
(datum->syntax-object #f (datum->syntax #f
(if (vector? v) (if (vector? v)
(short-list->vector v l) (short-list->vector v l)
l) l)
(list #f 1 col (+ 1 col) (list #f 1 col (+ 1 col)
(+ 2 (+ 2
vec-sz vec-sz
(if (zero? (length l)) (if (zero? (length l))
0 0
(sub1 (length l))) (sub1 (length l)))
(apply + (map syntax-span l)))))))] (apply + (map syntax-span l)))))))]
[(pair? v) [(pair? v)
(let* ([a (syntax-ize (car v) (+ col 1))] (let* ([a (syntax-ize (car v) (+ col 1))]
[sep (if (pair? (cdr v)) 0 3)] [sep (if (pair? (cdr v)) 0 3)]
[b (syntax-ize (cdr v) (+ col 1 (syntax-span a) sep))]) [b (syntax-ize (cdr v) (+ col 1 (syntax-span a) sep))])
(datum->syntax-object #f (datum->syntax #f
(cons a b) (cons a b)
(list #f 1 col (+ 1 col) (list #f 1 col (+ 1 col)
(+ 2 sep (syntax-span a) (syntax-span b)))))] (+ 2 sep (syntax-span a) (syntax-span b)))))]
[(box? v) [(box? v)
(let ([a (syntax-ize (unbox v) (+ col 2))]) (let ([a (syntax-ize (unbox v) (+ col 2))])
(datum->syntax-object #f (datum->syntax #f
(box a) (box a)
(list #f 1 col (+ 1 col) (list #f 1 col (+ 1 col)
(+ 2 (syntax-span a)))))] (+ 2 (syntax-span a)))))]
[else [else
(datum->syntax-object #f v (list #f 1 col (+ 1 col) 1))]))) (datum->syntax #f v (list #f 1 col (+ 1 col) 1))])))

61
collects/scribble/scribble.css
View File

@ -2,7 +2,6 @@
body { body {
color: black; color: black;
background-color: #ffffff; background-color: #ffffff;
font-family: Times;
} }
table td { table td {
@ -10,44 +9,58 @@
padding-right: 0; padding-right: 0;
} }
.maincolumn {
font-family: "Courier", monospace; font-size: 13px;
width: 43em;
margin-right: -40em;
margin-left: 15em;
}
.main { .main {
width: 35em; font-family: serif; font-size: 16px;
margin-left: 12em;
text-align: left; text-align: left;
} }
.refpara { .refpara {
font-family: "Courier", monospace; font-size: 13px;
position: relative; position: relative;
float: right; float: right;
left: 1em; left: 1em;
top: -1em; top: -1em;
height: 0em; height: 0em;
width: 10em; width: 13em;
margin: 0em -10em 0em 0em; margin: 0em -13em 0em 0em;
} }
.refcontent { .refcolumn {
background-color: #F5F5DC; background-color: #F5F5DC;
display: block; display: block;
position: relative; position: relative;
width: 10em; width: 13em;
font-size: 85%; font-size: 85%;
border: 0.5em solid #F5F5DC; border: 0.5em solid #F5F5DC;
} }
.refcontent {
font-family: serif; font-size: 13px;
}
.tocset { .tocset {
font-family: "Courier", monospace; font-size: 13px;
position: relative; position: relative;
float: left; float: left;
width: 10em; width: 12.5em;
margin-right: 2em; margin-right: 2em;
} }
.tocview { .tocview {
font-family: serif; font-size: 16px;
text-align: left; text-align: left;
background-color: #F5F5DC; background-color: #F5F5DC;
} }
.tocsub { .tocsub {
font-family: serif; font-size: 16px;
margin-top: 1em; margin-top: 1em;
text-align: left; text-align: left;
background-color: #DCF5F5; background-color: #DCF5F5;
@ -227,6 +240,10 @@
list-style-type: upper-alpha; list-style-type: upper-alpha;
} }
tt {
font-family: "Courier", monospace; font-size: 13px;
}
i { i {
font-family: serif; font-family: serif;
} }
@ -277,10 +294,10 @@
} }
.hspace { .hspace {
font-family: Courier; font-size: 80%; font-family: "Courier", monospace; font-size: 13px;
} }
.smaller { .small {
font-size: 80%; font-size: 80%;
} }
@ -295,7 +312,7 @@
.schemeinput { .schemeinput {
color: brown; color: brown;
background-color: #eeeeee; background-color: #eeeeee;
font-family: Courier; font-size: 80%; font-family: "Courier", monospace; font-size: 13px;
} }
.schemeinputbg { .schemeinputbg {
@ -303,22 +320,22 @@
} }
.schemereader { .schemereader {
font-family: Courier; font-size: 80%; font-family: "Courier", monospace; font-size: 13px;
} }
.schemeparen { .schemeparen {
color: #843c24; color: #843c24;
font-family: Courier; font-size: 80%; font-family: "Courier", monospace; font-size: 13px;
} }
.schememeta { .schememeta {
color: #262680; color: #262680;
font-family: Courier; font-size: 80%; font-family: "Courier", monospace; font-size: 13px;
} }
.schememod { .schememod {
color: black; color: black;
font-family: Courier; font-size: 80%; font-family: "Courier", monospace; font-size: 13px;
} }
.schemeopt { .schemeopt {
@ -328,7 +345,7 @@
.schemekeyword { .schemekeyword {
color: black; color: black;
font-weight: bold; font-weight: bold;
font-family: Courier; font-size: 80%; font-family: "Courier", monospace; font-size: 13px;
} }
.schemeerror { .schemeerror {
@ -339,12 +356,12 @@
.schemevariable { .schemevariable {
color: #262680; color: #262680;
font-style: italic; font-style: italic;
font-family: Courier; font-size: 80%; font-family: "Courier", monospace; font-size: 13px;
} }
.schemesymbol { .schemesymbol {
color: #262680; color: #262680;
font-family: Courier; font-size: 80%; font-family: "Courier", monospace; font-size: 13px;
} }
.schemevaluelink { .schemevaluelink {
@ -374,22 +391,22 @@
.schemeresult { .schemeresult {
color: #0000af; color: #0000af;
font-family: Courier; font-size: 80%; font-family: "Courier", monospace; font-size: 13px;
} }
.schemestdout { .schemestdout {
color: #960096; color: #960096;
font-family: Courier; font-size: 80%; font-family: "Courier", monospace; font-size: 13px;
} }
.schemecomment { .schemecomment {
color: #c2741f; color: #c2741f;
font-family: Courier; font-size: 80%; font-family: "Courier", monospace; font-size: 13px;
} }
.schemevalue { .schemevalue {
color: #228b22; color: #228b22;
font-family: Courier; font-size: 80%; font-family: "Courier", monospace; font-size: 13px;
} }
.imageleft { .imageleft {

19
collects/scribble/struct.ss
View File

@ -1,7 +1,8 @@
(module struct (lib "lang.ss" "big") (module struct scheme/base
(require (lib "contract.ss") (require mzlib/serialize
(lib "serialize.ss")) scheme/contract
(for-syntax scheme/base))
;; ---------------------------------------- ;; ----------------------------------------
@ -50,8 +51,8 @@
v)) v))
(provide (provide
(struct collect-info (ht ext-ht parts tags gen-prefix)) (struct-out collect-info)
(struct resolve-info (ci delays undef)) (struct-out resolve-info)
part-collected-info part-collected-info
collect-put! collect-put!
resolve-get resolve-get
@ -72,11 +73,11 @@
(letrec ([get-fields (lambda (super-id) (letrec ([get-fields (lambda (super-id)
(ormap (lambda (id fields+cts) (ormap (lambda (id fields+cts)
(if (identifier? id) (if (identifier? id)
(and (module-identifier=? id super-id) (and (free-identifier=? id super-id)
fields+cts) fields+cts)
(syntax-case id () (syntax-case id ()
[(my-id next-id) [(my-id next-id)
(module-identifier=? #'my-id super-id) (free-identifier=? #'my-id super-id)
#`[#,@(get-fields #'next-id) #`[#,@(get-fields #'next-id)
#,@fields+cts]] #,@fields+cts]]
[_else #f]))) [_else #f])))
@ -151,6 +152,7 @@
;; Delayed element has special serialization support: ;; Delayed element has special serialization support:
(define-struct delayed-element (resolve sizer plain) (define-struct delayed-element (resolve sizer plain)
#:mutable
#:property #:property
prop:serializable prop:serializable
(make-serialize-info (make-serialize-info
@ -193,6 +195,7 @@
;; ---------------------------------------- ;; ----------------------------------------
(define-struct (collect-element element) (collect) (define-struct (collect-element element) (collect)
#:mutable
#:property #:property
prop:serializable prop:serializable
(make-serialize-info (make-serialize-info
@ -235,7 +238,7 @@
(or (current-load-relative-directory) (current-directory)))) (or (current-load-relative-directory) (current-directory))))
(provide (provide
(struct generated-tag ())) (struct-out generated-tag))
(provide deserialize-generated-tag) (provide deserialize-generated-tag)
(define deserialize-generated-tag (define deserialize-generated-tag

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

@ -1,7 +1,7 @@
#reader(lib "docreader.ss" "scribble") #lang scribble/doc
@require[(lib "manual.ss" "scribble")] @require[scribble/manual]
@require["utils.ss"] @require["utils.ss"]
@require-for-syntax[mzscheme] @require[(for-syntax scheme/base)]
@define-syntax[def-section-like @define-syntax[def-section-like
(syntax-rules () (syntax-rules ()
@ -21,7 +21,7 @@
@title[#:tag "basic"]{Basic Document Forms} @title[#:tag "basic"]{Basic Document Forms}
The @file{basic.ss} libraryprovides functions and forms that can be The @filepath{basic.ss} libraryprovides functions and forms that can be
used from code written either in Scheme or with @elem["@"] used from code written either in Scheme or with @elem["@"]
expressions. For example, the @scheme[title] and @scheme[italic] expressions. For example, the @scheme[title] and @scheme[italic]
functions might be called from Scheme as functions might be called from Scheme as
@ -40,7 +40,7 @@ EOS
Although the procedures are mostly design to be used from @elem["@"] Although the procedures are mostly design to be used from @elem["@"]
mode, they are easier to document in Scheme mode (partly because we mode, they are easier to document in Scheme mode (partly because we
have Scribble's @file{scheme.ss} and @file{manual.ss}). have Scribble's @filepath{scheme.ss} and @filepath{manual.ss}).
@; ------------------------------------------------------------------------ @; ------------------------------------------------------------------------

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

@ -1,13 +1,13 @@
#reader(lib "docreader.ss" "scribble") #lang scribble/doc
@require[(lib "manual.ss" "scribble")] @require[scribble/manual]
@require["utils.ss"] @require["utils.ss"]
@title[#:tag "decode"]{Text Decoder} @title[#:tag "decode"]{Text Decoder}
The @file{decode.ss} library helps you write document content in a The @filepath{decode.ss} library helps you write document content in a
natural way---more like plain text, except for @litchar["@"] escapes. natural way---more like plain text, except for @litchar["@"] escapes.
Roughly, it processes a stream of strings to produces instances of the Roughly, it processes a stream of strings to produces instances of the
@file{struct.ss} datatypes (see @secref["struct"]). @filepath{struct.ss} datatypes (see @secref["struct"]).
At the flow level, decoding recognizes a blank line as a paragraph At the flow level, decoding recognizes a blank line as a paragraph
separator. At the paragraph-content level, decoding makes just a few separator. At the paragraph-content level, decoding makes just a few

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

@ -1,14 +1,14 @@
#reader(lib "docreader.ss" "scribble") #lang scribble/doc
@require[(lib "manual.ss" "scribble")] @require[scribble/manual]
@require["utils.ss"] @require["utils.ss"]
@title[#:tag "doclang"]{Document Module Language} @title[#:tag "doclang"]{Document Module Language}
The @file{doclang.ss} module is suitable for use as a module The @filepath{doclang.ss} module is suitable for use as a module
language. It provides everything from @scheme[mzscheme], except that language. It provides everything from @scheme[mzscheme], except that
it replaces the @scheme[#%module-begin] form. it replaces the @scheme[#%module-begin] form.
The @file{doclang.ss} @scheme[#%module-begin] essentially packages the The @filepath{doclang.ss} @scheme[#%module-begin] essentially packages the
body of the module into a call to @scheme[decode], binds the result to body of the module into a call to @scheme[decode], binds the result to
@scheme[doc], and exports @scheme[doc]. @scheme[doc], and exports @scheme[doc].

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

@ -1,13 +1,13 @@
#reader(lib "docreader.ss" "scribble") #lang scribble/doc
@require[(lib "manual.ss" "scribble")] @require[scribble/manual]
@require[(lib "bnf.ss" "scribble")] @require[scribble/bnf]
@require["utils.ss"] @require["utils.ss"]
@title[#:tag "docreader"]{Document Reader} @title[#:tag "docreader"]{Document Reader}
The @file{docreader.ss} module is suitable for use with The @filepath{docreader.ss} module is suitable for use with
@schemefont{#reader} at the beginning of a file. It reads the entire @schemefont{#reader} at the beginning of a file. It reads the entire
file with @scheme[read-inside-syntax] from Scribble's file with @scheme[read-inside-syntax] from Scribble's
@file{reader.ss}, and then wraps the result with @scheme[(module #, @filepath{reader.ss}, and then wraps the result with @scheme[(module #,
@nonterm{name} (lib "doclang.ss" "scribble") ...)], where @nonterm{name} (lib "doclang.ss" "scribble") ...)], where
@nonterm{name} is derived from the enclosing file's name. @nonterm{name} is derived from the enclosing file's name.

6
collects/scribblings/scribble/eval.scrbl
View File

@ -1,10 +1,10 @@
#reader(lib "docreader.ss" "scribble") #lang scribble/doc
@require[(lib "manual.ss" "scribble")] @require[scribble/manual]
@require["utils.ss"] @require["utils.ss"]
@title[#:tag "eval"]{Evaluation and Examples} @title[#:tag "eval"]{Evaluation and Examples}
The @file{eval.ss} library provides utilities for evaluating code at The @filepath{eval.ss} library provides utilities for evaluating code at
document-build time and incorporating the results in the document, document-build time and incorporating the results in the document,
especially to show example uses of defined procedures and syntax. especially to show example uses of defined procedures and syntax.

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

@ -1,6 +1,6 @@
#lang scribble/doc #lang scribble/doc
@require[(lib "manual.ss" "scribble") @require[scribble/manual
(lib "bnf.ss" "scribble")] scribble/bnf]
@require["utils.ss"] @require["utils.ss"]
@title{How to Scribble Documentation} @title{How to Scribble Documentation}
@ -13,13 +13,13 @@ To document a collection or @|PLaneT| package:
@itemize{ @itemize{
@item{Create a file in your collection or planet package with the @item{Create a file in your collection or planet package with the
file extension @file{.scrbl}. The remainder of these file extension @filepath{.scrbl}. The remainder of these
instructions assume that the file is called @file{manual.scrbl}.} instructions assume that the file is called @filepath{manual.scrbl}.}
@item{Start @file{manual.scrbl} like this: @item{Start @filepath{manual.scrbl} like this:
@verbatim[#<<EOS @verbatim[#<<EOS
#lang scribble/doc #lang scribble/doc
@begin[(require (lib "manual.ss" "scribble"))] @begin[(require scribble/manual)]
@title{My Library} @title{My Library}
@ -35,7 +35,7 @@ EOS
declaration in the text stream.} declaration in the text stream.}
@item{Add the following entry to your collect or package's @item{Add the following entry to your collect or package's
@file{info.ss}: @filepath{info.ss}:
@schemeblock[ @schemeblock[
(define scribblings '(("manual.scrbl" ()))) (define scribblings '(("manual.scrbl" ())))
@ -52,7 +52,7 @@ EOS
collection name to limit the build process to the collection.} collection name to limit the build process to the collection.}
@item{The generated documentation is @item{The generated documentation is
@file{compiled/doc/manual/index.html} within the collection or @filepath{compiled/doc/manual/index.html} within the collection or
@|PLaneT| package directory.} @|PLaneT| package directory.}
} }
@ -143,11 +143,11 @@ hyperlinked to the usual definition. To cause @schemeidfont{list} to
be hyperlinked, add the following to the @tt["@begin"] body: be hyperlinked, add the following to the @tt["@begin"] body:
@schemeblock[ @schemeblock[
(require-for-label (lib "big.ss" "lang")) (require (for-label (lib "scheme")))
] ]
This @scheme[require-for-label] declaration introduces a document-time This @scheme[require] with @scheme[for-label] declaration introduces a
binding for each export of the @scheme[(lib "big.ss" "lang")] document-time binding for each export of the @scheme[(lib "scheme")]
module. When the document is built, the @scheme[scheme] form detects module. When the document is built, the @scheme[scheme] form detects
the binding for @scheme[list], and so it generates a reference to the the binding for @scheme[list], and so it generates a reference to the
specification of @scheme[list]. The setup process detects the specification of @scheme[list]. The setup process detects the
@ -155,15 +155,15 @@ reference, and it finds the matching specification in the existing
documentation, and it ultimately directs the hyperlink to that documentation, and it ultimately directs the hyperlink to that
specification. specification.
Hyperlinks based on @scheme[require-for-label] and @scheme[scheme] are Hyperlinks based on @scheme[for-label] and @scheme[scheme] are the
the preferred mechanism for linking to information outside of a single preferred mechanism for linking to information outside of a single
document. Such links require no information about where and how a document. Such links require no information about where and how a
binding is documented elsewhere: binding is documented elsewhere:
@verbatim[#<<EOS @verbatim[#<<EOS
#lang scribble/doc #lang scribble/doc
@begin[(require (lib "manual.ss" "scribble")) @begin[(require scribble/manual
(require-for-label (lib "lang.ss" "big"))] (for-label (lib "scheme")))]
@title{My Library} @title{My Library}
@ -178,8 +178,8 @@ and it preserves the expression's formatting from the document source.
@verbatim[#<<EOS @verbatim[#<<EOS
#lang scribble/doc #lang scribble/doc
@begin[(require (lib "manual.ss" "scribble")) @begin[(require scribble/manual
(require-for-label (lib "lang.ss" "big"))] (for-label (lib "scheme"))]
@title{My Library} @title{My Library}
@ -209,8 +209,8 @@ The following example illustrates section hyperlinks:
@verbatim[#<<EOS @verbatim[#<<EOS
#lang scribble/doc #lang scribble/doc
@begin[(require (lib "manual.ss" "scribble")) @begin[(require scribble/manual
(require-for-label (lib "lang.ss" "big"))] (for-label (lib "scheme")))]
@title{My Library} @title{My Library}
@ -232,7 +232,7 @@ EOS
] ]
Since the page is so short, it the hyperlinks are more effective if Since the page is so short, it the hyperlinks are more effective if
you change the @file{info.ss} file to add the @scheme['multi-file] you change the @filepath{info.ss} file to add the @scheme['multi-file]
flag: flag:
@schemeblock[ @schemeblock[
@ -249,10 +249,10 @@ manual:
@verbatim[#<<EOS @verbatim[#<<EOS
#lang scribble/doc #lang scribble/doc
@begin[(require (lib "manual.ss" "scribble")) @begin[(require scribble/manual
(require-for-label (lib "lang.ss" "big")) (for-label (lib "scheme")))
(define ref-src (define ref-src
'(lib "reference.scrbl" "scribblings" "reference"))] '(lib "scribblings/reference/reference.scrbl"))]
@title{My Library} @title{My Library}
@ -275,16 +275,16 @@ and they declare hyperlink targets for @scheme[scheme]-based
hyperlinks. hyperlinks.
To document a @scheme[my-helper] procedure that is exported by To document a @scheme[my-helper] procedure that is exported by
@file{helper.ss} in the collection that contains @file{manual.scrbl}, @filepath{helper.ss} in the collection that contains @filepath{manual.scrbl},
first use @scheme[require-for-label] to import the binding information first use @scheme[require-for-label] to import the binding information
of @file{helper.ss}. Then use @scheme[defproc] to document the of @filepath{helper.ss}. Then use @scheme[defproc] to document the
procedure: procedure:
@verbatim[#<<EOS @verbatim[#<<EOS
#lang scribble/doc #lang scribble/doc
@begin[(require (lib "manual.ss" "scribble")) @begin[(require scribble/manual
(require-for-label (lib "lang.ss" "big") (for-label (lib "scheme")
"helper.ss")] "helper.ss"))]
@title{My Library} @title{My Library}
@ -326,7 +326,7 @@ generates:
@item{If you use @scheme[my-helper] in any documentation now, as long @item{If you use @scheme[my-helper] in any documentation now, as long
as that documentation source also has a as that documentation source also has a
@scheme[require-for-label] of @file{my-helper.ss}, then the @scheme[require-for-label] of @filepath{my-helper.ss}, then the
reference is hyperlinked to the definition above.} reference is hyperlinked to the definition above.}
} }
@ -337,7 +337,7 @@ on forms to document Scheme bindings.
@; ---------------------------------------- @; ----------------------------------------
@section{Showing Scheme Examples} @section{Showing Scheme Examples}
The @scheme[examples] form from @scheme[(lib "eval.ss" "scribble")] The @scheme[examples] form from @scheme[scribble/eval]
helps you generate examples in your documentation. @bold{Warning:} the helps you generate examples in your documentation. @bold{Warning:} the
@scheme[examples] form is especially likely to change or be replaced. @scheme[examples] form is especially likely to change or be replaced.
@ -345,16 +345,16 @@ To use @scheme[examples], the procedures to document must be suitable
for use at documentation time; in fact, @scheme[examples] uses for use at documentation time; in fact, @scheme[examples] uses
bindings introduced into the document source by bindings introduced into the document source by
@scheme[require]. Thus, to generate examples using @scheme[my-helper] @scheme[require]. Thus, to generate examples using @scheme[my-helper]
from the previous section, then @file{helper.ss} must be imported both from the previous section, then @filepath{helper.ss} must be imported both
via @scheme[require-for-label] and @scheme[require]: via @scheme[require-for-label] and @scheme[require]:
@verbatim[#<<EOS @verbatim[#<<EOS
#lang scribble/doc #lang scribble/doc
@begin[(require (lib "manual.ss" "scribble") @begin[(require scribble/manual
(lib "eval.ss" "scribble") ; <--- added scribble/eval ; <--- added
"helper.ss") ; <--- added "helper.ss" ; <--- added
(require-for-label (lib "lang.ss" "big") (for-label (lib "scheme")
"helper.ss")] "helper.ss"))]
@title{My Library} @title{My Library}
@ -374,17 +374,17 @@ EOS
@;---------------------------------------- @;----------------------------------------
@section{Splitting the Document Source} @section{Splitting the Document Source}
In general, a @file{.scrbl} file produces a @techlink{part}. A part In general, a @filepath{.scrbl} file produces a @techlink{part}. A part
produced by a document's main source (as specified in the produced by a document's main source (as specified in the
@scheme{info.ss} file) represents the whole document. The @scheme{info.ss} file) represents the whole document. The
@scheme[include-section] procedure can be used to incorporate a part @scheme[include-section] procedure can be used to incorporate a part
as a sub-part of the enclosing part. as a sub-part of the enclosing part.
In @file{manual.scrbl}: In @filepath{manual.scrbl}:
@verbatim[#<<EOS @verbatim[#<<EOS
#lang scribble/doc #lang scribble/doc
@begin[(require (lib "manual.ss" "scribble"))] @begin[(require scribble/manual)]
@title{My Library} @title{My Library}
@ -393,11 +393,11 @@ In @file{manual.scrbl}:
EOS EOS
] ]
In @file{cows.scrbl}: In @filepath{cows.scrbl}:
@verbatim[#<<EOS @verbatim[#<<EOS
#lang scribble/doc #lang scribble/doc
@begin[(require (lib "manual.ss" "scribble"))] @begin[(require scribble/manual)]
@title{Cows} @title{Cows}
@ -405,13 +405,13 @@ In @file{cows.scrbl}:
EOS EOS
] ]
In @file{aardvarks.scrbl}: In @filepath{aardvarks.scrbl}:
@verbatim[#<<EOS @verbatim[#<<EOS
#lang scribble/doc #lang scribble/doc
@begin[(require (lib "manual.ss" "scribble")) @begin[(require scribble/manual
(require-for-label (lib "lang.ss" "big") (for-label (lib "scheme")
"helper.ss")] "helper.ss"))]
@title{Aardvarks} @title{Aardvarks}
@ -437,11 +437,11 @@ for the enclosing section (as started by @scheme[title],
@scheme[local-table-of-contents] to generate hyperlinks to the @scheme[local-table-of-contents] to generate hyperlinks to the
sub-sections. sub-sections.
Revising @file{cows.scrbl} from the previous section: Revising @filepath{cows.scrbl} from the previous section:
@verbatim[#<<EOS @verbatim[#<<EOS
#lang scribble/doc #lang scribble/doc
@begin[(require (lib "manual.ss" "scribble"))] @begin[(require scribble/manual)]
@title[#:style '(toc)]{Cows} @title[#:style '(toc)]{Cows}
@ -455,9 +455,9 @@ Revising @file{cows.scrbl} from the previous section:
EOS EOS
] ]
To run this example, remember to change @file{info.ss} to add the To run this example, remember to change @filepath{info.ss} to add the
@scheme['multi-page] style. You may also want to add a call to @scheme['multi-page] style. You may also want to add a call to
@scheme[table-of-contents] in @file{manual.scrbl}. @scheme[table-of-contents] in @filepath{manual.scrbl}.
The difference between @scheme[table-of-contents] and The difference between @scheme[table-of-contents] and
@scheme[local-table-of-contents] is that the latter is ignored for @scheme[local-table-of-contents] is that the latter is ignored for

2
collects/scribblings/scribble/info.ss
View File

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

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

@ -1,11 +1,11 @@
#reader(lib "docreader.ss" "scribble") #lang scribble/doc
@require[(lib "manual.ss" "scribble")] @require[scribble/manual]
@require["utils.ss"] @require["utils.ss"]
@require-for-syntax[mzscheme] @require[(for-syntax scheme/base)]
@title[#:tag "manual"]{PLT Manual Forms} @title[#:tag "manual"]{PLT Manual Forms}
The @file{manual.ss} module provides all of @file{basic.ss}, and The @filepath{manual.ss} module provides all of @filepath{basic.ss}, and
more... more...
@; ------------------------------------------------------------------------ @; ------------------------------------------------------------------------
@ -352,9 +352,9 @@ Like @scheme[defproc], but for a non-procedure binding.}
([struct-name id ([struct-name id
(id super-id)] (id super-id)]
[flag-keywords code:blank [flag-keywords code:blank
#:immutable #:mutable
(code:line #:inspector #f) (code:line #:inspector #f)
(code:line #:immutable #:inspector #f)])]{ (code:line #:mutable #:inspector #f)])]{
Similar to @scheme[defform] or @scheme[defproc], but for a structure Similar to @scheme[defform] or @scheme[defproc], but for a structure
definition.} definition.}
@ -461,7 +461,7 @@ button.}
@defproc[(menuitem [menu-name string?] [item-name string?]) element?]{ @defproc[(menuitem [menu-name string?] [item-name string?]) element?]{
Typesets the given combination of a GUI's menu and item name.} Typesets the given combination of a GUI's menu and item name.}
@defproc[(file [pre-content any/c] ...) element?]{Typesets the given content @defproc[(filepath [pre-content any/c] ...) element?]{Typesets the given content
as a file name (e.g., in typewriter font and in in quotes).} as a file name (e.g., in typewriter font and in in quotes).}
@defproc[(exec [pre-content any/c] ...) element?]{Typesets the given content @defproc[(exec [pre-content any/c] ...) element?]{Typesets the given content

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

@ -1,9 +1,9 @@
#reader(lib "docreader.ss" "scribble") #lang scribble/doc
@require[(lib "manual.ss" "scribble")] @require[scribble/manual]
@require[(lib "bnf.ss" "scribble")] @require[scribble/bnf]
@require[(lib "eval.ss" "scribble")] @require[scribble/eval]
@require["utils.ss"] @require["utils.ss"]
@require-for-syntax[mzscheme] @require[(for-syntax scheme/base)]
@title[#:tag "reader"]{The Scribble Reader} @title[#:tag "reader"]{The Scribble Reader}
@ -24,12 +24,12 @@ meaning of these S-expressions depends on the rest of your own code.
A PLT Scheme manual more likely starts with A PLT Scheme manual more likely starts with
@schemeblock[ @schemeblock[
#, @schemefont{#reader(lib "docreader.ss" "scribble")} #, @schemefont{#lang scribble/doc}
] ]
which installs a reader, wraps the file content afterward into a which installs a reader, wraps the file content afterward into a
MzScheme module, and parses the body into a document using MzScheme module, and parses the body into a document using
@file{decode.ss}. See @secref["docreader"] for more information. @filepath{decode.ss}. See @secref["docreader"] for more information.
Another way to use the reader is to use the @scheme[use-at-readtable] Another way to use the reader is to use the @scheme[use-at-readtable]
function to switch the current readtable to a readtable that parses function to switch the current readtable to a readtable that parses
@ -721,7 +721,7 @@ an example of this.
@;-------------------------------------------------------------------- @;--------------------------------------------------------------------
@section{Interface} @section{Interface}
The @file{reader.ss} module provides functionality for advanced needs. The @filepath{reader.ss} module provides functionality for advanced needs.
@; The `with-scribble-read' trick below shadows `read' and @; The `with-scribble-read' trick below shadows `read' and
@; `read-syntax' with for-label bindings from the Scribble reader @; `read-syntax' with for-label bindings from the Scribble reader
@ -731,7 +731,7 @@ The @file{reader.ss} module provides functionality for advanced needs.
[(_) [(_)
(... (...
(begin (begin
(require-for-label (lib "reader.ss" "scribble")) (require (for-label scribble/reader))
@; *** Start reader-import section *** @; *** Start reader-import section ***
@defproc[(read [in input-port? (current-input-port)]) any]{} @defproc[(read [in input-port? (current-input-port)]) any]{}
@ -750,7 +750,7 @@ in reading.
These @schemeid[-inside] variants parse as if starting inside a These @schemeid[-inside] variants parse as if starting inside a
@litchar["@{"]...@litchar["}"], and they return a (syntactic) list. @litchar["@{"]...@litchar["}"], and they return a (syntactic) list.
Useful for implementing languages that are textual by default (see Useful for implementing languages that are textual by default (see
@file{docreader.ss} for example). @filepath{docreader.ss} for example).
} }
@defform[(make-at-readtable [keyword-args ...])]{ @defform[(make-at-readtable [keyword-args ...])]{

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

@ -1,7 +1,7 @@
#reader(lib "docreader.ss" "scribble") #lang scribble/doc
@require[(lib "manual.ss" "scribble")] @require[scribble/manual]
@require["utils.ss"] @require["utils.ss"]
@require-for-label[(lib "class.ss")] @require[(for-label scheme/class)]
@title[#:tag "renderer"]{Renderer} @title[#:tag "renderer"]{Renderer}
@ -13,11 +13,11 @@ tends to be format-independent, and it usually implemented completely
by the base renderer. The latter method generates the actual output, by the base renderer. The latter method generates the actual output,
which is naturally specific to a particular format. which is naturally specific to a particular format.
The @file{base-render.ss} module provides @scheme[render%], which The @filepath{base-render.ss} module provides @scheme[render%], which
implements the core of a renderer. The @file{html-renderer.ss}, implements the core of a renderer. The @filepath{html-renderer.ss},
@file{latex-renderer.ss}, and @file{text-renderer.ss} modules each @filepath{latex-renderer.ss}, and @filepath{text-renderer.ss} modules each
provide @scheme[renderer-mixin] to extend the base. The provide @scheme[renderer-mixin] to extend the base. The
@file{html-renderer.ss} module also provides @filepath{html-renderer.ss} module also provides
@scheme[multi-renderer-mixin] to produce multi-file HTML instead @scheme[multi-renderer-mixin] to produce multi-file HTML instead
instead of single-file HTML. instead of single-file HTML.
@ -26,9 +26,9 @@ to the renderers. For example, the @exec{scribble} command-line tool
might, in the future, extract rendering mixins from a document module might, in the future, extract rendering mixins from a document module
(in addition to the document proper). (in addition to the document proper).
See @file{base-render.ss} for more information about the methods of See @filepath{base-render.ss} for more information about the methods of
the renderer. Documents built with higher layers, such as the renderer. Documents built with higher layers, such as
@file{manual.ss}, generally do not call the render object's methods @filepath{manual.ss}, generally do not call the render object's methods
directly. directly.
@defclass[render% object% ()]{ @defclass[render% object% ()]{

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

@ -1,12 +1,12 @@
#lang scribble/doc #lang scribble/doc
@require[(lib "manual.ss" "scribble")] @require[scribble/manual]
@require[(lib "bnf.ss" "scribble")] @require[scribble/bnf]
@require["utils.ss"] @require["utils.ss"]
@title[#:tag-prefix '(lib "scribble.scrbl" "scribblings" "scribble") @title[#:tag-prefix '(lib "scribblings/scribble/scribble.scrbl")
#:tag "top"]{PLT Scribble} #:tag "top"]{PLT Scribble}
The @file{scribble} collection provides libraries that can be used to The @filepath{scribble} collection provides libraries that can be used to
create documents from Scheme. create documents from Scheme.
@table-of-contents[] @table-of-contents[]
@ -26,51 +26,51 @@ The layers are:
@itemize{ @itemize{
@item{@file{reader.ss}: a reader that extends the syntax of Scheme @item{@filepath{reader.ss}: a reader that extends the syntax of Scheme
with @"@"-forms for conveniently embedding a mixin of text and with @"@"-forms for conveniently embedding a mixin of text and
escapes. See @secref["reader"].} escapes. See @secref["reader"].}
@item{@file{struct.ss}: a set of document datatypes and utilities @item{@filepath{struct.ss}: a set of document datatypes and utilities
that define the basic layout and processing of a document. See that define the basic layout and processing of a document. See
@secref["struct"].} @secref["struct"].}
@item{@file{base-render.ss} with @file{html-render.ss}, @item{@filepath{base-render.ss} with @filepath{html-render.ss},
@file{latex-render.ss}, or @file{text-render.ss}: A base @filepath{latex-render.ss}, or @filepath{text-render.ss}: A base
renderer and mixins that generate documents in various formats renderer and mixins that generate documents in various formats
from instances of the @file{struct.ss} datatypes. See from instances of the @filepath{struct.ss} datatypes. See
@secref["renderer"].} @secref["renderer"].}
@item{@file{decode.ss}: Processes a stream of text, section-start @item{@filepath{decode.ss}: Processes a stream of text, section-start
markers, etc. to produce instances of the @file{struct.ss} markers, etc. to produce instances of the @filepath{struct.ss}
datatypes. See @secref["decode"].} datatypes. See @secref["decode"].}
@item{@file{doclang.ss}: to be used for the initial import of a @item{@filepath{doclang.ss}: to be used for the initial import of a
module; processes the module top level through module; processes the module top level through
@file{decode.ss}, and otherwise provides all of @filepath{decode.ss}, and otherwise provides all of
@schememodname[big]. See @secref["doclang"].} @schememodname[big]. See @secref["doclang"].}
@item{@file{docreader.ss}: a reader that is meant to tbe used to @item{@filepath{docreader.ss}: a reader that is meant to tbe used to
process an entire file; it essentially combines process an entire file; it essentially combines
@file{reader.ss} with @file{doclang.ss}. See @filepath{reader.ss} with @filepath{doclang.ss}. See
@secref["docreader"].} @secref["docreader"].}
@item{@file{basic.ss}: a library of basic document operators---such @item{@filepath{basic.ss}: a library of basic document operators---such
as @scheme[title], @scheme[section], and @scheme[secref]---for as @scheme[title], @scheme[section], and @scheme[secref]---for
use with @file{decode.ss} and a renderer. See use with @filepath{decode.ss} and a renderer. See
@secref["basic"].} @secref["basic"].}
@item{@file{scheme.ss}: a library of support functions for @item{@filepath{scheme.ss}: a library of support functions for
typesetting Scheme code.} typesetting Scheme code.}
@item{@file{manual.ss}: a library of support functions for writing @item{@filepath{manual.ss}: a library of support functions for writing
PLT Scheme documentation; re-exports @file{basic.ss}. See PLT Scheme documentation; re-exports @filepath{basic.ss}. See
@secref["manual"].} @secref["manual"].}
@item{@file{eval.ss}: a library of support functions for ealuating @item{@filepath{eval.ss}: a library of support functions for ealuating
code at document-build time, especially for showing code at document-build time, especially for showing
examples. See @secref["eval"].} examples. See @secref["eval"].}
@item{@file{bnf.ss}: a library of support functions for writing @item{@filepath{bnf.ss}: a library of support functions for writing
grammars.} grammars.}
} }
@ -80,7 +80,7 @@ exports a @scheme{struct.ss}-based document, generating output with a
specified renderer. More specifically, the executable installs a specified renderer. More specifically, the executable installs a
renderer, loads the specified modules and extracts the @scheme[doc] renderer, loads the specified modules and extracts the @scheme[doc]
export of each (which must be an instance of @scheme[section] from export of each (which must be an instance of @scheme[section] from
@file{struct.ss}), and renders each. Use @exec{scribble -h} for more @filepath{struct.ss}), and renders each. Use @exec{scribble -h} for more
information. information.
@; ------------------------------------------------------------------------ @; ------------------------------------------------------------------------

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

@ -1,5 +1,5 @@
#reader(lib "docreader.ss" "scribble") #lang scribble/doc
@require[(lib "manual.ss" "scribble")] @require[scribble/manual]
@require["utils.ss"] @require["utils.ss"]
@title[#:tag "struct"]{Document Structures And Processing} @title[#:tag "struct"]{Document Structures And Processing}

4
collects/scribblings/scribble/style.scrbl
View File

@ -1,5 +1,5 @@
#reader(lib "docreader.ss" "scribble") #lang scribble/doc
@require[(lib "manual.ss" "scribble")] @require[scribble/manual]
@require["utils.ss"] @require["utils.ss"]
@title[#:tag "reference-style"]{Style Guide} @title[#:tag "reference-style"]{Style Guide}

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

@ -1,27 +1,29 @@
(module utils mzscheme (module utils scheme/base
(require (lib "struct.ss" "scribble") (require scribble/struct
(lib "manual.ss" "scribble") scribble/manual
(prefix scheme: (lib "scheme.ss" "scribble")) (prefix-in scheme: scribble/scheme)
(prefix scribble: (lib "reader.ss" "scribble")) (prefix-in scribble: scribble/reader))
(lib "string.ss"))
(define-syntax bounce-for-label (define-syntax bounce-for-label
(syntax-rules () (syntax-rules (all-except)
[(_ (all-except mod (id ...) (id2 ...)))
(begin
(require (for-label (except-in mod id ...)))
(provide (for-label (except-out (all-from-out mod) id2 ...))))]
[(_ mod) (begin [(_ mod) (begin
(require-for-label mod) (require (for-label mod))
(provide-for-label (all-from mod)))] (provide (for-label (all-from-out mod))))]
[(_ mod ...) (begin (bounce-for-label mod) ...)])) [(_ mod ...) (begin (bounce-for-label mod) ...)]))
(bounce-for-label (lib "lang.ss" "big") (bounce-for-label (all-except scheme (link) ())
(lib "struct.ss" "scribble") scribble/struct
(lib "base-render.ss" "scribble") scribble/base-render
(lib "decode.ss" "scribble") scribble/decode
(lib "basic.ss" "scribble") scribble/manual
(lib "manual.ss" "scribble") scribble/scheme
(lib "scheme.ss" "scribble") scribble/eval
(lib "eval.ss" "scribble") scribble/bnf)
(lib "bnf.ss" "scribble"))
(provide scribble-examples litchar/lines) (provide scribble-examples litchar/lines)
@ -56,7 +58,7 @@
[accum null]) [accum null])
(cond (cond
[(null? e) [(null? e)
(datum->syntax-object (datum->syntax
p p
(reverse accum) (reverse accum)
(list (syntax-source p) (list (syntax-source p)
@ -77,7 +79,7 @@
(or second next-pos) (or second next-pos)
(cons v accum)))]))] (cons v accum)))]))]
[else [else
(datum->syntax-object (datum->syntax
p p
(syntax-e p) (syntax-e p)
(list (syntax-source p) (list (syntax-source p)
@ -101,9 +103,9 @@
(let ([str (substring lines p1 p2)]) (let ([str (substring lines p1 p2)])
(loop (cons (list str stx) r) (loop (cons (list str stx) r)
(or newlines? (regexp-match? #rx#"\n" str)))) (or newlines? (regexp-match? #rx#"\n" str))))
(let* ([r (reverse! r)] (let* ([r (reverse r)]
[r (if newlines? [r (if newlines?
(cdr (apply append! (map (lambda (x) (list #f x)) r))) (cdr (apply append (map (lambda (x) (list #f x)) r)))
r)]) r)])
(make-table (make-table
#f #f