commit 8de414b74fb8d352747cac4b9c596d7a7b0afbb7
parent 33d0774fea69d9cb8ce28ee97381673fb6612d1d
Author: Matthew Flatt <mflatt@racket-lang.org>
Date: Fri, 22 Jun 2007 05:59:42 +0000
change scribble to use new-lambda and new-struct, and correlate definitions and uses via lexical binding
svn: r6714
original commit: 7de23b6373ac5d88c54350a847a41bedd3516a2d
Diffstat:
9 files changed, 266 insertions(+), 192 deletions(-)
diff --git a/collects/scribble/basic.ss b/collects/scribble/basic.ss
@@ -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))
diff --git a/collects/scribble/doclang.ss b/collects/scribble/doclang.ss
@@ -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 ----------------------------------------
diff --git a/collects/scribble/eval.ss b/collects/scribble/eval.ss
@@ -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 ()
diff --git a/collects/scribble/html-render.ss b/collects/scribble/html-render.ss
@@ -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))
diff --git a/collects/scribble/manual.ss b/collects/scribble/manual.ss
@@ -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
- (apply string-append
- (map symbol->string (car wrappers))))))
+ (register-scheme-definition
+ (datum->syntax-object stx-id
+ (string->symbol
+ (apply string-append
+ (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,22 +584,25 @@
(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)
- (list (list (make-flow (list (make-paragraph (list (tt 'nbsp))))))
- (list (make-flow (list (apply *schemerawgrammar
- (map (lambda (f) (f)) sub)))))))
- sub-procs))))
+ (if (null? sub-procs)
+ null
+ (list (list (make-flow (list (make-paragraph (list (tt 'nbsp))))))
+ (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)
(parameterize ([current-variable-list
(append (let loop ([form (cons (if has-kw? (cdr form) form)
@@ -610,41 +629,47 @@
(if form-thunk
(form-thunk)
(make-paragraph (list (to-element form)))))))
- (apply
- append
- (map (lambda (sub)
- (list (list (make-flow (list (make-paragraph (list (tt 'nbsp))))))
- (list (make-flow (list (apply *schemerawgrammar
- (map (lambda (f) (f)) sub)))))))
- sub-procs))))
+ (if (null? sub-procs)
+ null
+ (list (list (make-flow (list (make-paragraph (list (tt 'nbsp))))))
+ (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)))))])
- (apply append
- (map
- (lambda (nonterm clauses)
- (cons
- (list (to-flow nonterm)
- empty-line
- (to-flow "=")
- empty-line
- (make-flow (list (car clauses))))
- (map (lambda (clause)
- (list empty-line
- empty-line
- (to-flow "|")
- empty-line
- (make-flow (list clause))))
- (cdr clauses))))
- nonterms clauseses)))))
-
- (define (*schemerawgrammar nonterm clause1 . clauses)
- (*schemerawgrammars (list nonterm) (list (cons clause1 clauses))))
+ (cdr
+ (apply append
+ (map
+ (lambda (nonterm clauses)
+ (list*
+ (list empty-line empty-line empty-line empty-line empty-line)
+ (list (to-flow nonterm)
+ empty-line
+ (to-flow "=")
+ empty-line
+ (make-flow (list (car clauses))))
+ (map (lambda (clause)
+ (list empty-line
+ empty-line
+ (to-flow "|")
+ empty-line
+ (make-flow (list clause))))
+ (cdr clauses))))
+ nonterms clauseses))))))
+
+ (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
diff --git a/collects/scribble/scheme.ss b/collects/scribble/scheme.ss
@@ -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)))
diff --git a/collects/scribble/scribble.css b/collects/scribble/scribble.css
@@ -184,6 +184,10 @@
background-color: #ddddff;
}
+ .specgrammar {
+ float: right;
+ }
+
.hspace {
font-family: Courier; font-size: 80%;
}
diff --git a/collects/scribblings/scribble/eval.scrbl b/collects/scribblings/scribble/eval.scrbl
@@ -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.}
diff --git a/collects/scribblings/scribble/manual.scrbl b/collects/scribblings/scribble/manual.scrbl
@@ -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 ...)]{
+
+Like @scheme[defform], but for multiple forms using the same
+@scheme[id].}
-@defform[(defform/subs (id . datum)
- ([nonterm-id clause-datum ...+] ...)
- pre-flow ...)]{
+@defform/subs[(defform/subs maybe-literals (id . datum)
+ ([nonterm-id clause-datum ...+] ...)
+ 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 ...))])]{
+
+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 ...)]{
-@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
+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}
