change scribble to use new-lambda and new-struct, and correlate definitions and uses via lexical binding
svn: r6714 original commit: 7de23b6373ac5d88c54350a847a41bedd3516a2d
This commit is contained in:
Matthew Flatt
parent
33d0774fea
commit
8de414b74f
|
|
@ -1,9 +1,8 @@
|
|||
|
||||
(module basic mzscheme
|
||||
(module basic (lib "new-lambda.ss" "scribblings")
|
||||
(require "decode.ss"
|
||||
"struct.ss"
|
||||
"config.ss"
|
||||
(lib "kw.ss")
|
||||
(lib "list.ss")
|
||||
(lib "class.ss"))
|
||||
|
||||
|
|
@ -19,23 +18,23 @@
|
|||
(content->string content)
|
||||
"_"))
|
||||
|
||||
(define/kw (title #:key [tag #f] [style #f] #:body str)
|
||||
(define (title #:tag [tag #f] #:style [style #f] . str)
|
||||
(let ([content (decode-content str)])
|
||||
(make-title-decl (or tag (gen-tag content)) style content)))
|
||||
|
||||
(define/kw (section #:key [tag #f] #:body str)
|
||||
(define (section #:tag [tag #f] . str)
|
||||
(let ([content (decode-content str)])
|
||||
(make-part-start 0 (or tag (gen-tag content)) content)))
|
||||
|
||||
(define/kw (subsection #:key [tag #f] #:body str)
|
||||
(define (subsection #:tag [tag #f] . str)
|
||||
(let ([content (decode-content str)])
|
||||
(make-part-start 1 (or tag (gen-tag content)) content)))
|
||||
|
||||
(define/kw (subsubsection #:key [tag #f] #:body str)
|
||||
(define (subsubsection #:tag [tag #f] . str)
|
||||
(let ([content (decode-content str)])
|
||||
(make-part-start 2 (or tag (gen-tag content)) content)))
|
||||
|
||||
(define/kw (subsubsub*section #:key [tag #f] #:body str)
|
||||
(define (subsubsub*section #:tag [tag #f] . str)
|
||||
(let ([content (decode-content str)])
|
||||
(make-paragraph (list (make-element 'bold content)))))
|
||||
|
||||
|
|
@ -50,7 +49,7 @@
|
|||
|
||||
(provide itemize item item?)
|
||||
|
||||
(define/kw (itemize #:body items)
|
||||
(define (itemize . items)
|
||||
(let ([items (filter (lambda (v) (not (whitespace? v))) items)])
|
||||
(for-each (lambda (v)
|
||||
(unless (an-item? v)
|
||||
|
|
@ -63,7 +62,7 @@
|
|||
(define-struct an-item (flow))
|
||||
(define (item? x) (an-item? x))
|
||||
|
||||
(define/kw (item #:body str)
|
||||
(define (item . str)
|
||||
(make-an-item (decode-flow str)))
|
||||
|
||||
;; ----------------------------------------
|
||||
|
|
@ -77,28 +76,28 @@
|
|||
(define (hspace n)
|
||||
(make-element 'hspace (list (make-string n #\space))))
|
||||
|
||||
(define/kw (elem #:body str)
|
||||
(define (elem . str)
|
||||
(make-element #f (decode-content str)))
|
||||
|
||||
(define/kw (aux-elem #:body s)
|
||||
(define (aux-elem . s)
|
||||
(make-aux-element #f (decode-content s)))
|
||||
|
||||
(define/kw (italic #:body str)
|
||||
(define (italic . str)
|
||||
(make-element 'italic (decode-content str)))
|
||||
|
||||
(define/kw (bold #:body str)
|
||||
(define (bold . str)
|
||||
(make-element 'bold (decode-content str)))
|
||||
|
||||
(define/kw (tt #:body str)
|
||||
(define (tt . str)
|
||||
(make-element 'tt (decode-content str)))
|
||||
|
||||
(define/kw (span-class classname #:body str)
|
||||
(define (span-class classname . str)
|
||||
(make-element classname (decode-content str)))
|
||||
|
||||
(define/kw (subscript #:body str)
|
||||
(define (subscript . str)
|
||||
(make-element 'subscript (decode-content str)))
|
||||
|
||||
(define/kw (superscript #:body str)
|
||||
(define (superscript . str)
|
||||
(make-element 'superscript (decode-content str)))
|
||||
|
||||
;; ----------------------------------------
|
||||
|
|
@ -116,20 +115,20 @@
|
|||
word-seq
|
||||
element-seq))
|
||||
|
||||
(define/kw (index* word-seq content-seq #:body s)
|
||||
(define (index* word-seq content-seq . s)
|
||||
(let ([key (gen-target)])
|
||||
(record-index word-seq
|
||||
content-seq
|
||||
key
|
||||
(decode-content s))))
|
||||
|
||||
(define/kw (index word-seq #:body s)
|
||||
(define (index word-seq . s)
|
||||
(let ([word-seq (if (string? word-seq)
|
||||
(list word-seq)
|
||||
word-seq)])
|
||||
(apply index* word-seq word-seq s)))
|
||||
|
||||
(define/kw (as-index #:body s)
|
||||
(define (as-index . s)
|
||||
(let ([key (gen-target)]
|
||||
[content (decode-content s)])
|
||||
(record-index (list (content->string content))
|
||||
|
|
|
|||
|
|
@ -1,11 +1,11 @@
|
|||
|
||||
(module doclang mzscheme
|
||||
(module doclang (lib "new-lambda.ss" "scribblings") ; <--- temporary
|
||||
(require "struct.ss"
|
||||
"decode.ss"
|
||||
(lib "kw.ss"))
|
||||
(require-for-syntax (lib "kerncase.ss" "syntax"))
|
||||
|
||||
(provide (all-from-except mzscheme #%module-begin)
|
||||
(provide (all-from-except (lib "new-lambda.ss" "scribblings") #%module-begin)
|
||||
(rename *module-begin #%module-begin))
|
||||
|
||||
;; Module wrapper ----------------------------------------
|
||||
|
|
|
|||
|
|
@ -26,7 +26,7 @@
|
|||
|
||||
scribble-eval-handler)
|
||||
|
||||
(define current-int-namespace (make-parameter (make-namespace)))
|
||||
(define current-int-namespace (make-parameter (current-namespace)))
|
||||
(define scribble-eval-handler (make-parameter (lambda (c? x) (eval x))))
|
||||
|
||||
(define image-counter 0)
|
||||
|
|
@ -108,17 +108,11 @@
|
|||
#f)))))))
|
||||
|
||||
(define (do-eval s)
|
||||
(cond
|
||||
[(and (list? s)
|
||||
(eq? 'code:line (car s))
|
||||
(= (length s) 3)
|
||||
(list? (caddr s))
|
||||
(eq? 'code:comment (caaddr s)))
|
||||
(do-eval (cadr s))]
|
||||
[(and (list? s)
|
||||
(eq? 'eval:alts (car s))
|
||||
(= (length s) 3))
|
||||
(do-eval (caddr s))]
|
||||
(syntax-case s (code:comment eval:alts)
|
||||
[(code:line v (code:comment . rest))
|
||||
(do-eval #'v)]
|
||||
[(eval:alts p e)
|
||||
(do-eval #'e)]
|
||||
[else
|
||||
(let ([o (open-output-string)])
|
||||
(parameterize ([current-output-port o])
|
||||
|
|
@ -160,17 +154,19 @@
|
|||
v2)]
|
||||
[else v]))
|
||||
|
||||
(define (strip-comments s)
|
||||
(cond
|
||||
[(and (pair? s)
|
||||
(pair? (car s))
|
||||
(eq? (caar s) 'code:comment))
|
||||
(strip-comments (cdr s))]
|
||||
[(pair? s)
|
||||
(cons (strip-comments (car s))
|
||||
(strip-comments (cdr s)))]
|
||||
[(eq? s 'code:blank) (void)]
|
||||
[else s]))
|
||||
(define (strip-comments stx)
|
||||
(syntax-case stx (code:comment code:blank)
|
||||
[((code:comment . _) . rest)
|
||||
(strip-comments #'rest)]
|
||||
[(a . b)
|
||||
(datum->syntax-object stx
|
||||
(cons (strip-comments #'a)
|
||||
(strip-comments #'b))
|
||||
stx
|
||||
stx
|
||||
stx)]
|
||||
[code:blank #'(void)]
|
||||
[else stx]))
|
||||
|
||||
|
||||
(define (do-plain-eval s catching-exns?)
|
||||
|
|
@ -181,7 +177,7 @@
|
|||
(syntax-rules ()
|
||||
[(_ e) (#%expression
|
||||
(begin (parameterize ([current-command-line-arguments #()])
|
||||
(do-plain-eval (quote e) #f))
|
||||
(do-plain-eval (quote-syntax e) #f))
|
||||
""))]))
|
||||
|
||||
|
||||
|
|
@ -193,7 +189,7 @@
|
|||
(syntax-rules ()
|
||||
[(_ e) (#%expression
|
||||
(parameterize ([current-command-line-arguments #()])
|
||||
(show-val (car (do-plain-eval (quote e) #f)))))]))
|
||||
(show-val (car (do-plain-eval (quote-syntax e) #f)))))]))
|
||||
|
||||
(define (eval-example-string s)
|
||||
(eval (read (open-input-string s))))
|
||||
|
|
@ -239,7 +235,7 @@
|
|||
[(_ t schemeinput* e ...)
|
||||
(interleave t
|
||||
(list (schemeinput* e) ...)
|
||||
(map do-eval (list (quote e) ...)))]))
|
||||
(map do-eval (list (quote-syntax e) ...)))]))
|
||||
|
||||
(define-syntax interaction
|
||||
(syntax-rules ()
|
||||
|
|
|
|||
|
|
@ -200,6 +200,11 @@
|
|||
[(at-right) '((align "right"))]
|
||||
[(at-left) '((align "left"))]
|
||||
[else null])
|
||||
,@(let ([a (and (list? (table-style t))
|
||||
(assoc 'style (table-style t)))])
|
||||
(if (and a (string? (cadr a)))
|
||||
`((class ,(cadr a)))
|
||||
null))
|
||||
,@(if (string? (table-style t))
|
||||
`((class ,(table-style t)))
|
||||
null))
|
||||
|
|
|
|||
|
|
@ -1,12 +1,11 @@
|
|||
|
||||
(module manual mzscheme
|
||||
(module manual (lib "new-lambda.ss" "scribblings")
|
||||
(require "decode.ss"
|
||||
"struct.ss"
|
||||
"scheme.ss"
|
||||
"config.ss"
|
||||
"basic.ss"
|
||||
(lib "string.ss")
|
||||
(lib "kw.ss")
|
||||
(lib "list.ss")
|
||||
(lib "class.ss"))
|
||||
|
||||
|
|
@ -46,7 +45,10 @@
|
|||
(define (to-element/id s)
|
||||
(make-element "schemesymbol" (list (to-element/no-color s))))
|
||||
|
||||
(define (keep-s-expr ctx s v) s)
|
||||
(define (keep-s-expr ctx s v)
|
||||
(if (symbol? s)
|
||||
(make-just-context s ctx)
|
||||
s))
|
||||
(define (add-sq-prop s name val)
|
||||
(if (eq? name 'paren-shape)
|
||||
(make-shaped-parens s val)
|
||||
|
|
@ -97,41 +99,41 @@
|
|||
link procedure
|
||||
idefterm)
|
||||
|
||||
(define/kw (onscreen #:body str)
|
||||
(define (onscreen . str)
|
||||
(make-element 'sf (decode-content str)))
|
||||
(define (menuitem menu item)
|
||||
(make-element 'sf (list menu "|" item)))
|
||||
(define/kw (defterm #:body str)
|
||||
(define (defterm . str)
|
||||
(make-element 'italic (decode-content str)))
|
||||
(define/kw (idefterm #:body str)
|
||||
(define (idefterm . str)
|
||||
(let ([c (decode-content str)])
|
||||
(make-element 'italic c)))
|
||||
(define/kw (schemefont #:body str)
|
||||
(define (schemefont . str)
|
||||
(apply tt str))
|
||||
(define/kw (schemevalfont #:body str)
|
||||
(define (schemevalfont . str)
|
||||
(make-element "schemevalue" (decode-content str)))
|
||||
(define/kw (schemeresultfont #:body str)
|
||||
(define (schemeresultfont . str)
|
||||
(make-element "schemeresult" (decode-content str)))
|
||||
(define/kw (schemeidfont #:body str)
|
||||
(define (schemeidfont . str)
|
||||
(make-element "schemesymbol" (decode-content str)))
|
||||
(define/kw (schemeparenfont #:body str)
|
||||
(define (schemeparenfont . str)
|
||||
(make-element "schemeparen" (decode-content str)))
|
||||
(define/kw (schememetafont #:body str)
|
||||
(define (schememetafont . str)
|
||||
(make-element "schememeta" (decode-content str)))
|
||||
(define/kw (schemekeywordfont #:body str)
|
||||
(define (schemekeywordfont . str)
|
||||
(make-element "schemekeyword" (decode-content str)))
|
||||
(define/kw (file #:body str)
|
||||
(define (file . str)
|
||||
(make-element 'tt (append (list "\"") (decode-content str) (list "\""))))
|
||||
(define/kw (exec #:body str)
|
||||
(define (exec . str)
|
||||
(make-element 'tt (decode-content str)))
|
||||
(define/kw (procedure #:body str)
|
||||
(define (procedure . str)
|
||||
(make-element "schemeresult" (append (list "#<procedure:") (decode-content str) (list ">"))))
|
||||
|
||||
(define/kw (link url #:body str)
|
||||
(define (link url . str)
|
||||
(make-element (make-target-url url) (decode-content str)))
|
||||
|
||||
(provide t)
|
||||
(define/kw (t #:body str)
|
||||
(define (t . str)
|
||||
(decode-paragraph str))
|
||||
|
||||
(provide schememodule)
|
||||
|
|
@ -151,7 +153,7 @@
|
|||
|
||||
;; ----------------------------------------
|
||||
|
||||
(provide deftech tech)
|
||||
(provide deftech tech techlink)
|
||||
|
||||
(define (*tech make-elem style s)
|
||||
(let* ([c (decode-content s)]
|
||||
|
|
@ -165,12 +167,15 @@
|
|||
c
|
||||
(format "tech-term:~a" s))))
|
||||
|
||||
(define/kw (deftech #:body s)
|
||||
(define (deftech . s)
|
||||
(*tech make-target-element #f (list (apply defterm s))))
|
||||
|
||||
(define/kw (tech #:body s)
|
||||
(define (tech . s)
|
||||
(*tech make-link-element "techlink" s))
|
||||
|
||||
(define (techlink . s)
|
||||
(*tech make-link-element #f s))
|
||||
|
||||
;; ----------------------------------------
|
||||
|
||||
(provide defproc defproc* defstruct defthing defform defform* defform/subs defform*/subs defform/none
|
||||
|
|
@ -218,21 +223,23 @@
|
|||
(define-syntax defproc
|
||||
(syntax-rules ()
|
||||
[(_ (id arg ...) result desc ...)
|
||||
(*defproc '[(id arg ...)]
|
||||
(*defproc (list (quote-syntax id))
|
||||
'[(id arg ...)]
|
||||
(list (list (lambda () (arg-contract arg)) ...))
|
||||
(list (lambda () (schemeblock0 result)))
|
||||
(lambda () (list desc ...)))]))
|
||||
(define-syntax defproc*
|
||||
(syntax-rules ()
|
||||
[(_ [[(id arg ...) result] ...] desc ...)
|
||||
(*defproc '[(id arg ...) ...]
|
||||
(*defproc (list (quote-syntax id) ...)
|
||||
'[(id arg ...) ...]
|
||||
(list (list (lambda () (arg-contract arg)) ...) ...)
|
||||
(list (lambda () (schemeblock0 result)) ...)
|
||||
(lambda () (list desc ...)))]))
|
||||
(define-syntax defstruct
|
||||
(syntax-rules ()
|
||||
[(_ name fields desc ...)
|
||||
(*defstruct 'name 'fields (lambda () (list desc ...)))]))
|
||||
(*defstruct (quote-syntax name) 'name 'fields (lambda () (list desc ...)))]))
|
||||
(define-syntax (defform*/subs stx)
|
||||
(syntax-case stx ()
|
||||
[(_ #:literals (lit ...) [spec spec1 ...] ([non-term-id non-term-form ...] ...) desc ...)
|
||||
|
|
@ -245,8 +252,11 @@
|
|||
'(unsyntax x)
|
||||
#'name)
|
||||
#'rest)
|
||||
#'spec)])])
|
||||
#'(*defforms #t '(lit ...)
|
||||
#'spec)])]
|
||||
[spec-id
|
||||
(syntax-case #'spec ()
|
||||
[(name . rest) #'name])])
|
||||
#'(*defforms (quote-syntax spec-id) '(lit ...)
|
||||
'(spec spec1 ...)
|
||||
(list (lambda (x) (schemeblock0 new-spec))
|
||||
(lambda (ignored) (schemeblock0 spec1)) ...)
|
||||
|
|
@ -260,6 +270,7 @@
|
|||
#'(fm #:literals () [spec spec1 ...] ([non-term-id non-term-form ...] ...) desc ...)]))
|
||||
(define-syntax (defform* stx)
|
||||
(syntax-case stx ()
|
||||
[(_ #:literals lits [spec ...] desc ...) #'(defform*/subs #:literals lits [spec ...] () desc ...)]
|
||||
[(_ [spec ...] desc ...) #'(defform*/subs [spec ...] () desc ...)]))
|
||||
(define-syntax (defform stx)
|
||||
(syntax-case stx ()
|
||||
|
|
@ -312,7 +323,7 @@
|
|||
(define-syntax defthing
|
||||
(syntax-rules ()
|
||||
[(_ id result desc ...)
|
||||
(*defthing 'id 'result (lambda () (list desc ...)))]))
|
||||
(*defthing (quote-syntax id) 'id 'result (lambda () (list desc ...)))]))
|
||||
(define-syntax schemegrammar
|
||||
(syntax-rules ()
|
||||
[(_ #:literals (lit ...) id clause ...) (*schemegrammar '(lit ...)
|
||||
|
|
@ -342,7 +353,7 @@
|
|||
(list (make-table style content))))
|
||||
(list (make-table style content))))
|
||||
|
||||
(define (*defproc prototypes arg-contractss result-contracts content-thunk)
|
||||
(define (*defproc stx-ids prototypes arg-contractss result-contracts content-thunk)
|
||||
(let ([spacer (hspace 1)]
|
||||
[has-optional? (lambda (arg)
|
||||
(and (pair? arg)
|
||||
|
|
@ -378,7 +389,7 @@
|
|||
(apply
|
||||
append
|
||||
(map
|
||||
(lambda (prototype arg-contracts result-contract first?)
|
||||
(lambda (stx-id prototype arg-contracts result-contract first?)
|
||||
(append
|
||||
(list
|
||||
(list (make-flow
|
||||
|
|
@ -403,7 +414,7 @@
|
|||
(make-target-element
|
||||
#f
|
||||
(list (to-element (car prototype)))
|
||||
(register-scheme-definition (car prototype)))
|
||||
(register-scheme-definition stx-id))
|
||||
(to-element (car prototype))))
|
||||
(map arg->elem required)
|
||||
(if (null? optional)
|
||||
|
|
@ -449,25 +460,29 @@
|
|||
[else null]))
|
||||
(cdr prototype)
|
||||
arg-contracts))))
|
||||
stx-ids
|
||||
prototypes
|
||||
arg-contractss
|
||||
result-contracts
|
||||
(cons #t (map (lambda (x) #f) (cdr prototypes))))))
|
||||
(content-thunk))))))
|
||||
|
||||
(define (make-target-element* content wrappers)
|
||||
(define (make-target-element* stx-id content wrappers)
|
||||
(if (null? wrappers)
|
||||
content
|
||||
(make-target-element*
|
||||
stx-id
|
||||
(make-target-element
|
||||
#f
|
||||
(list content)
|
||||
(register-scheme-definition (string->symbol
|
||||
(register-scheme-definition
|
||||
(datum->syntax-object stx-id
|
||||
(string->symbol
|
||||
(apply string-append
|
||||
(map symbol->string (car wrappers))))))
|
||||
(map symbol->string (car wrappers)))))))
|
||||
(cdr wrappers))))
|
||||
|
||||
(define (*defstruct name fields content-thunk)
|
||||
(define (*defstruct stx-id name fields content-thunk)
|
||||
(define spacer (hspace 1))
|
||||
(make-splice
|
||||
(cons
|
||||
|
|
@ -481,6 +496,7 @@
|
|||
(to-element
|
||||
`(,(schemeparenfont "struct")
|
||||
,(make-target-element*
|
||||
stx-id
|
||||
(to-element name)
|
||||
(let ([name (if (pair? name)
|
||||
(car name)
|
||||
|
|
@ -515,7 +531,7 @@
|
|||
fields)))
|
||||
(content-thunk))))
|
||||
|
||||
(define (*defthing name result-contract content-thunk)
|
||||
(define (*defthing stx-id name result-contract content-thunk)
|
||||
(define spacer (hspace 1))
|
||||
(make-splice
|
||||
(cons
|
||||
|
|
@ -528,19 +544,19 @@
|
|||
(list (make-target-element
|
||||
#f
|
||||
(list (to-element name))
|
||||
(register-scheme-definition name))
|
||||
(register-scheme-definition stx-id))
|
||||
spacer ":" spacer
|
||||
(to-element result-contract))))))))
|
||||
(content-thunk))))
|
||||
|
||||
(define (meta-symbol? s) (memq s '(... ...+ ?)))
|
||||
|
||||
(define (*defforms kw? lits forms form-procs subs sub-procs content-thunk)
|
||||
(define (*defforms kw-id lits forms form-procs subs sub-procs content-thunk)
|
||||
(parameterize ([current-variable-list
|
||||
(apply
|
||||
append
|
||||
(map (lambda (form)
|
||||
(let loop ([form (cons (if kw? (cdr form) form)
|
||||
(let loop ([form (cons (if kw-id (cdr form) form)
|
||||
subs)])
|
||||
(cond
|
||||
[(symbol? form) (if (or (meta-symbol? form)
|
||||
|
|
@ -568,20 +584,23 @@
|
|||
(to-element
|
||||
`(,x
|
||||
. ,(cdr form)))))))
|
||||
(and kw?
|
||||
(and kw-id
|
||||
(eq? form (car forms))
|
||||
(make-target-element
|
||||
#f
|
||||
(list (to-element (car form)))
|
||||
(register-scheme-form-definition (car form)))))))))
|
||||
(list (to-element (make-just-context (car form) kw-id)))
|
||||
(register-scheme-form-definition kw-id))))))))
|
||||
forms form-procs)
|
||||
(apply
|
||||
append
|
||||
(map (lambda (sub)
|
||||
(if (null? sub-procs)
|
||||
null
|
||||
(list (list (make-flow (list (make-paragraph (list (tt 'nbsp))))))
|
||||
(list (make-flow (list (apply *schemerawgrammar
|
||||
(map (lambda (f) (f)) sub)))))))
|
||||
sub-procs))))
|
||||
(list (make-flow (list (let ([l (map (lambda (sub)
|
||||
(map (lambda (f) (f)) sub))
|
||||
sub-procs)])
|
||||
(*schemerawgrammars
|
||||
"specgrammar"
|
||||
(map car l)
|
||||
(map cdr l))))))))))
|
||||
(content-thunk)))))
|
||||
|
||||
(define (*specsubform form has-kw? lits form-thunk subs sub-procs content-thunk)
|
||||
|
|
@ -610,25 +629,31 @@
|
|||
(if form-thunk
|
||||
(form-thunk)
|
||||
(make-paragraph (list (to-element form)))))))
|
||||
(apply
|
||||
append
|
||||
(map (lambda (sub)
|
||||
(if (null? sub-procs)
|
||||
null
|
||||
(list (list (make-flow (list (make-paragraph (list (tt 'nbsp))))))
|
||||
(list (make-flow (list (apply *schemerawgrammar
|
||||
(map (lambda (f) (f)) sub)))))))
|
||||
sub-procs))))
|
||||
(list (make-flow (list (let ([l (map (lambda (sub)
|
||||
(map (lambda (f) (f)) sub))
|
||||
sub-procs)])
|
||||
(*schemerawgrammars
|
||||
"specgrammar"
|
||||
(map car l)
|
||||
(map cdr l))))))))))
|
||||
(flow-paragraphs (decode-flow (content-thunk)))))))
|
||||
|
||||
(define (*schemerawgrammars nonterms clauseses)
|
||||
(define (*schemerawgrammars style nonterms clauseses)
|
||||
(make-table
|
||||
'((valignment baseline baseline baseline baseline baseline)
|
||||
(alignment right left center left left))
|
||||
`((valignment baseline baseline baseline baseline baseline)
|
||||
(alignment right left center left left)
|
||||
(style ,style))
|
||||
(let ([empty-line (make-flow (list (make-paragraph (list (tt 'nbsp)))))]
|
||||
[to-flow (lambda (i) (make-flow (list (make-paragraph (list i)))))])
|
||||
(cdr
|
||||
(apply append
|
||||
(map
|
||||
(lambda (nonterm clauses)
|
||||
(cons
|
||||
(list*
|
||||
(list empty-line empty-line empty-line empty-line empty-line)
|
||||
(list (to-flow nonterm)
|
||||
empty-line
|
||||
(to-flow "=")
|
||||
|
|
@ -641,10 +666,10 @@
|
|||
empty-line
|
||||
(make-flow (list clause))))
|
||||
(cdr clauses))))
|
||||
nonterms clauseses)))))
|
||||
nonterms clauseses))))))
|
||||
|
||||
(define (*schemerawgrammar nonterm clause1 . clauses)
|
||||
(*schemerawgrammars (list nonterm) (list (cons clause1 clauses))))
|
||||
(define (*schemerawgrammar style nonterm clause1 . clauses)
|
||||
(*schemerawgrammars style (list nonterm) (list (cons clause1 clauses))))
|
||||
|
||||
(define (*schemegrammar lits s-expr clauseses-thunk)
|
||||
(parameterize ([current-variable-list
|
||||
|
|
@ -657,7 +682,7 @@
|
|||
(loop (cdr form)))]
|
||||
[else null]))])
|
||||
(let ([l (clauseses-thunk)])
|
||||
(*schemerawgrammars (map car l) (map cdr l)))))
|
||||
(*schemerawgrammars #f (map car l) (map cdr l)))))
|
||||
|
||||
(define (*var id)
|
||||
(to-element (*var-sym id)))
|
||||
|
|
@ -668,26 +693,26 @@
|
|||
;; ----------------------------------------
|
||||
|
||||
(provide centerline)
|
||||
(define/kw (centerline #:body s)
|
||||
(define (centerline . s)
|
||||
(make-table 'centered (list (list (make-flow (list (decode-paragraph s)))))))
|
||||
|
||||
(provide commandline)
|
||||
(define/kw (commandline #:body s)
|
||||
(define (commandline . s)
|
||||
(make-paragraph (list (hspace 2) (apply tt s))))
|
||||
|
||||
|
||||
(define (secref s)
|
||||
(make-link-element #f null `(part ,s)))
|
||||
(define/kw (seclink tag #:body s)
|
||||
(define (seclink tag . s)
|
||||
(make-link-element #f (decode-content s) `(part ,tag)))
|
||||
(define/kw (*schemelink id #:body s)
|
||||
(make-link-element #f (decode-content s) (register-scheme-definition id)))
|
||||
(define (*schemelink stx-id id . s)
|
||||
(make-link-element #f (decode-content s) (register-scheme-definition stx-id)))
|
||||
(define-syntax schemelink
|
||||
(syntax-rules ()
|
||||
[(_ id . content) (*schemelink 'id . content)]))
|
||||
[(_ id . content) (*schemelink (quote-syntax id) 'id . content)]))
|
||||
(provide secref seclink schemelink)
|
||||
|
||||
(define/kw (pidefterm #:body s)
|
||||
(define (pidefterm . s)
|
||||
(let ([c (apply defterm s)])
|
||||
(index (string-append (content->string (element-content c)) "s")
|
||||
c)))
|
||||
|
|
@ -707,7 +732,7 @@
|
|||
;; ----------------------------------------
|
||||
|
||||
(provide math)
|
||||
(define/kw (math #:body s)
|
||||
(define (math . s)
|
||||
(let ([c (decode-content s)])
|
||||
(make-element #f (apply append
|
||||
(map (lambda (i)
|
||||
|
|
@ -727,7 +752,7 @@
|
|||
|
||||
(provide cite)
|
||||
|
||||
(define/kw (cite #:key key title author location date)
|
||||
(define (cite #:key key #:title title #:author author #:location location #:date date)
|
||||
"[...]"
|
||||
#;
|
||||
(make-bibliography-element
|
||||
|
|
|
|||
|
|
@ -2,7 +2,8 @@
|
|||
(require "struct.ss"
|
||||
"basic.ss"
|
||||
(lib "class.ss")
|
||||
(lib "for.ss"))
|
||||
(lib "for.ss")
|
||||
(lib "modcollapse.ss" "syntax"))
|
||||
|
||||
(provide define-code
|
||||
to-element
|
||||
|
|
@ -17,7 +18,8 @@
|
|||
current-variable-list
|
||||
current-meta-list
|
||||
|
||||
(struct shaped-parens (val shape)))
|
||||
(struct shaped-parens (val shape))
|
||||
(struct just-context (val ctx)))
|
||||
|
||||
(define no-color "schemeplain")
|
||||
(define reader-color "schemeplain")
|
||||
|
|
@ -32,13 +34,12 @@
|
|||
|
||||
(define current-keyword-list
|
||||
;; This is temporary, until the MzScheme manual is filled in...
|
||||
(make-parameter '(require
|
||||
(make-parameter null #;'(require
|
||||
provide
|
||||
new send else => and or
|
||||
define-syntax syntax-rules define-struct
|
||||
quote quasiquote unquote unquote-splicing
|
||||
syntax quasisyntax unsyntax unsyntax-splicing
|
||||
set! set!-values)))
|
||||
quasiquote unquote unquote-splicing
|
||||
syntax quasisyntax unsyntax unsyntax-splicing)))
|
||||
(define current-variable-list
|
||||
(make-parameter null))
|
||||
(define current-meta-list
|
||||
|
|
@ -353,8 +354,8 @@
|
|||
(not (or it? is-var?)))
|
||||
(make-delayed-element
|
||||
(lambda (renderer sec ht)
|
||||
(let* ([vtag (register-scheme-definition (syntax-e c))]
|
||||
[stag (register-scheme-form-definition (syntax-e c))]
|
||||
(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
|
||||
|
|
@ -431,7 +432,7 @@
|
|||
(cond
|
||||
[(syntax? v)
|
||||
(let ([mk `(,#'d->s
|
||||
#f
|
||||
(quote-syntax ,v)
|
||||
,(syntax-case v (uncode)
|
||||
[(uncode e) #'e]
|
||||
[else (stx->loc-s-expr (syntax-e v))])
|
||||
|
|
@ -463,11 +464,22 @@
|
|||
[(_ code typeset-code) #'(define-code code typeset-code unsyntax)]))
|
||||
|
||||
|
||||
(define (register-scheme-definition sym)
|
||||
(format "definition:~s" sym))
|
||||
(define (register-scheme-definition stx)
|
||||
(unless (identifier? stx)
|
||||
(error 'register-scheme-definition "not an identifier: ~e" (syntax-object->datum stx)))
|
||||
(format "definition:~s"
|
||||
(let ([b (identifier-binding stx)])
|
||||
(cond
|
||||
[(not b) (format "top:~a" (syntax-e stx))]
|
||||
[(eq? b 'lexical) (format "lexical:~a" (syntax-e stx))]
|
||||
[else (format "module:~a:~a"
|
||||
(if (module-path-index? (car b))
|
||||
(collapse-module-path-index (car b) '(lib "ack.ss" "scribble"))
|
||||
(car b))
|
||||
(cadr b))]))))
|
||||
|
||||
(define (register-scheme-form-definition sym)
|
||||
(format "formdefinition:~s" sym))
|
||||
(define (register-scheme-form-definition stx)
|
||||
(format "form~s" (register-scheme-definition stx)))
|
||||
|
||||
(define syntax-ize-hook (make-parameter (lambda (v col) #f)))
|
||||
|
||||
|
|
@ -495,6 +507,7 @@
|
|||
l))))
|
||||
|
||||
(define-struct shaped-parens (val shape))
|
||||
(define-struct just-context (val ctx))
|
||||
|
||||
(define (syntax-ize v col)
|
||||
(cond
|
||||
|
|
@ -504,6 +517,13 @@
|
|||
(syntax-property (syntax-ize (shaped-parens-val v) col)
|
||||
'paren-shape
|
||||
(shaped-parens-shape v))]
|
||||
[(just-context? v)
|
||||
(let ([s (syntax-ize (just-context-val v) col)])
|
||||
(datum->syntax-object (just-context-ctx v)
|
||||
(syntax-e s)
|
||||
s
|
||||
s
|
||||
(just-context-ctx v)))]
|
||||
[(and (list? v)
|
||||
(pair? v)
|
||||
(memq (car v) '(quote unquote unquote-splicing)))
|
||||
|
|
|
|||
|
|
@ -184,6 +184,10 @@
|
|||
background-color: #ddddff;
|
||||
}
|
||||
|
||||
.specgrammar {
|
||||
float: right;
|
||||
}
|
||||
|
||||
.hspace {
|
||||
font-family: Courier; font-size: 80%;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -10,24 +10,24 @@ especially to show example uses of defined procedures and syntax.
|
|||
|
||||
@defform[(interaction datum ...)]{Like @scheme[schemeinput], except
|
||||
that the result for each input @scheme[datum] is shown on the next
|
||||
line. The result is determined by evaluating the quoted form of the
|
||||
datum.
|
||||
line. The result is determined by evaluating the syntax-quoted form of
|
||||
the @scheme[datum].
|
||||
|
||||
Uses of @scheme[code:comment] and @schemeidfont{code:blank} are
|
||||
stipped from each @scheme[datum] before evaluation.
|
||||
|
||||
If a datum has the form @scheme[(#,(scheme code:line) #,(svar datum)
|
||||
(#,(scheme code:comment) ...))], then only the @svar[datum] is
|
||||
evaluated.
|
||||
If a @scheme[datum] has the form @scheme[(#,(scheme code:line)
|
||||
_code-datum (#,(scheme code:comment) ...))], then only
|
||||
@scheme[_code-datum] is evaluated.
|
||||
|
||||
If a datum has the form @scheme[(eval:alts #,(svar show-datum) #,(svar
|
||||
eval-datum))], then @svar[show-datum] is typeset, while
|
||||
@svar[eval-datum] is evaluated.}
|
||||
|
||||
@defform[(interaction-eval datum)]{Evaluates the quoted form of
|
||||
@defform[(interaction-eval datum)]{Evaluates the syntax-quoted form of
|
||||
each @scheme[datum] via @scheme[do-eval] and returns the empty string.}
|
||||
|
||||
@defform[(interaction-eval-show datum)]{Evaluates the quoted form of
|
||||
@defform[(interaction-eval-show datum)]{Evaluates the syntax-quoted form of
|
||||
@scheme[datum] and produces an element represeting the printed form of
|
||||
the result.}
|
||||
|
||||
|
|
|
|||
|
|
@ -14,7 +14,7 @@ more...
|
|||
@defform[(schemeblock datum ...)]{
|
||||
|
||||
Typesets the @scheme[datum] sequence as a table of Scheme code inset
|
||||
by two spaces. The source locations of the @scheme[datum]s determines
|
||||
by two spaces. The source locations of the @scheme[datum]s determine
|
||||
the generated layout. For example,
|
||||
|
||||
@schemeblock[
|
||||
|
|
@ -32,10 +32,13 @@ produces the output
|
|||
|
||||
with the @scheme[(loop (not x))] indented under @scheme[define],
|
||||
because that's the way it is idented the use of @scheme[schemeblock].
|
||||
|
||||
Furthermore, @scheme[define] is typeset as a keyword (bold and black)
|
||||
and as a hyperlink to @scheme[define]'s definition in the reference
|
||||
manual, because this document was built using information about the
|
||||
MzScheme manual. Similarly, @scheme[not] is a hyperlink to the its
|
||||
reference manual, and because the lexical binding of @scheme[define]
|
||||
(in the source) matches the lexical binding of the definition in the
|
||||
reference manual. Similarly, @scheme[not] is a hyperlink to the its
|
||||
definition in the reference manual.
|
||||
|
||||
Use @scheme[unsyntax] to escape back to an expression that produces an
|
||||
|
|
@ -127,7 +130,7 @@ useful with @scheme[verbatim].}
|
|||
|
||||
@defproc[(schemefont [pre-content any/c] ...) element?]{Typesets the given
|
||||
content as uncolored, unhyperlinked Scheme. This procedure is useful
|
||||
for typesetting thngs like @scheme{#module}, which are not
|
||||
for typesetting things like @scheme{#module}, which are not
|
||||
@scheme[read]able by themselves.}
|
||||
|
||||
@defproc[(schemevalfont [pre-content any/c] ...) element?]{Like
|
||||
|
|
@ -143,7 +146,7 @@ for typesetting thngs like @scheme{#module}, which are not
|
|||
@scheme[schemefont], but colored as a syntactic form name.}
|
||||
|
||||
@defproc[(procedure [pre-content any/c] ...) element?]{Typesets the given
|
||||
content as a procedure name in a REPL result (e.g., in typewrite font
|
||||
content as a procedure name in a REPL result (e.g., in typewriter font
|
||||
with a @schemefont{#<procedure:} prefix and @schemefont{>} suffix.).}
|
||||
|
||||
@defform[(var datum)]{Typesets @scheme[var] as an identifier that is
|
||||
|
|
@ -164,9 +167,9 @@ in a form definition.}
|
|||
pre-flow ...)]{
|
||||
|
||||
Produces a sequence of flow elements (encaptured in a @scheme[splice])
|
||||
to document a procedure named @scheme[id]. The
|
||||
@scheme[id] is registered so that @scheme[scheme]-typeset uses
|
||||
of the identifier are hyperlinked to this documentation.
|
||||
to document a procedure named @scheme[id]. The @scheme[id] is
|
||||
registered so that @scheme[scheme]-typeset uses of the identifier
|
||||
(with the same lexical binding) are hyperlinked to this documentation.
|
||||
|
||||
Each @scheme[arg-spec] must have one of the following forms:
|
||||
|
||||
|
|
@ -213,39 +216,54 @@ Like @scheme[defproc], but for multiple cases with the same
|
|||
@scheme[id]. }
|
||||
|
||||
|
||||
@defform[(defform (id . datum) pre-flow ...)]{Produces a
|
||||
a sequence of flow elements (encaptured in a @scheme[splice]) to
|
||||
document a syntatic form named by @scheme[id]. The
|
||||
@scheme[id] is registered so that @scheme[scheme]-typeset uses
|
||||
of the identifier are hyperlinked to this documentation.
|
||||
@defform/subs[(defform maybe-literals (id . datum) pre-flow ...)
|
||||
([maybe-literals code:blank
|
||||
(code:line #:literals (literal-id ...))])]{
|
||||
|
||||
Produces a a sequence of flow elements (encaptured in a
|
||||
@scheme[splice]) to document a syntatic form named by @scheme[id]. The
|
||||
@scheme[id] is registered so that @scheme[scheme]-typeset uses of the
|
||||
identifier (with the same lexical binding) are hyperlinked to this
|
||||
documentation.
|
||||
|
||||
The @scheme[pre-flow]s list is parsed as a flow that documents the
|
||||
procedure. In this description, a reference to any identifier in
|
||||
@scheme[datum] is typeset as a sub-form non-terminal.
|
||||
@scheme[datum] is typeset as a sub-form non-terminal. If
|
||||
@scheme[#:literals] clause is provided, however, instances of the
|
||||
@scheme[literal-id]s are typeset normally.
|
||||
|
||||
The typesetting of @scheme[(id . datum)] preserves the source
|
||||
layout, like @scheme[schemeblock], and unlike @scheme[defproc].}
|
||||
|
||||
@defform[(defform* [(id . datum) ..+] pre-flow ...)]{Like @scheme[defform],
|
||||
but for multiple forms using the same @scheme[id].}
|
||||
@defform[(defform* maybe-literals [(id . datum) ..+] pre-flow ...)]{
|
||||
|
||||
@defform[(defform/subs (id . datum)
|
||||
Like @scheme[defform], but for multiple forms using the same
|
||||
@scheme[id].}
|
||||
|
||||
@defform/subs[(defform/subs maybe-literals (id . datum)
|
||||
([nonterm-id clause-datum ...+] ...)
|
||||
pre-flow ...)]{
|
||||
pre-flow ...)
|
||||
([maybe-literals code:blank
|
||||
(code:line #:literals (literal-id ...))])]{
|
||||
Like @scheme[defform], but including an auxiliary grammar of
|
||||
non-terminals shown with the @scheme[id] form. Each
|
||||
@scheme[nonterm-id] is specified as being any of the corresponding
|
||||
@scheme[clause-datum]s, where the formatting of each
|
||||
@scheme[clause-datum] is preserved.}
|
||||
|
||||
@defform[(specform (id . datum) pre-flow ...)]{Like @scheme[defform],
|
||||
with without registering a definition, and with indenting on the left
|
||||
for both the specification and the @scheme[pre-flow]s.}
|
||||
@defform/subs[(specform maybe-literals (id . datum) pre-flow ...)
|
||||
([maybe-literals code:blank
|
||||
(code:line #:literals (literal-id ...))])]{
|
||||
|
||||
@defform[(specsubform datum pre-flow ...)]{Similar to
|
||||
@scheme[defform], but without any specific identifier being defined,
|
||||
and the table and flow are typeset indented. This form is intended for
|
||||
use when refining the syntax of a non-terminal used in a
|
||||
Like @scheme[defform], with without registering a definition, and with
|
||||
indenting on the left for both the specification and the
|
||||
@scheme[pre-flow]s.}
|
||||
|
||||
@defform[(specsubform maybe-literals datum pre-flow ...)]{
|
||||
|
||||
Similar to @scheme[defform], but without any specific identifier being
|
||||
defined, and the table and flow are typeset indented. This form is
|
||||
intended for use when refining the syntax of a non-terminal used in a
|
||||
@scheme[defform] or other @scheme[specsubform]. For example, it is
|
||||
used in the documentation for @scheme[defproc] in the itemization of
|
||||
possible shapes for @svar[arg-spec].
|
||||
|
|
@ -254,8 +272,9 @@ The @scheme[pre-flow]s list is parsed as a flow that documents the
|
|||
procedure. In this description, a reference to any identifier in
|
||||
@scheme[datum] is typeset as a sub-form non-terminal.}
|
||||
|
||||
@defform[(defthing id contract-expr-datum pre-flow ...)]{Like
|
||||
@scheme[defproc], but for a non-procedure binding.}
|
||||
@defform[(defthing id contract-expr-datum pre-flow ...)]{
|
||||
|
||||
Like @scheme[defproc], but for a non-procedure binding.}
|
||||
|
||||
@defform/subs[(defstruct struct-name ([field-name contract-expr-datum] ...)
|
||||
pre-flow ...)
|
||||
|
|
@ -265,13 +284,19 @@ procedure. In this description, a reference to any identifier in
|
|||
Similar to @scheme[defform] or @scheme[defproc], but for a structure
|
||||
definition.}
|
||||
|
||||
@defform/subs[(schemegrammar literals ? id clause-datum ...+)
|
||||
([literals (code:line #:literals (literal-id ...))])]{
|
||||
Creates a table to define the grammar of @scheme[id]. Each identifier mentioned
|
||||
in a @scheme[clause-datum] is typeset as a non-terminal, except for the
|
||||
identifiers listed as @scheme[literal-id]s, which are typeset as with
|
||||
@scheme[scheme].
|
||||
}
|
||||
@defform/subs[(schemegrammar maybe-literals id clause-datum ...+)
|
||||
([maybe-literals code:blank
|
||||
(code:line #:literals (literal-id ...))])]{
|
||||
|
||||
Creates a table to define the grammar of @scheme[id]. Each identifier
|
||||
mentioned in a @scheme[clause-datum] is typeset as a non-terminal,
|
||||
except for the identifiers listed as @scheme[literal-id]s, which are
|
||||
typeset as with @scheme[scheme].}
|
||||
|
||||
@defform[(schemegrammar* maybe-literals [id clause-datum ...+] ...)]{
|
||||
|
||||
Like @scheme[schemegrammar], but for typesetting multiple productions
|
||||
at once, aligned around the @litchar{=} and @litchar{|}.}
|
||||
|
||||
@; ------------------------------------------------------------------------
|
||||
@section{Various String Forms}
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user