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

doc work

Browse Source 
svn: r6685

original commit: 1477c7ec1b7e062ae8d40554322a21df537f10e3
This commit is contained in:
Matthew Flatt 2007-06-18 06:34:41 +00:00
parent 028e28c5e5
commit 11e169f6c2
3 changed files with 32 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
collects/scribble/eval.ss
View File

@ -215,12 +215,15 @@
(list " "))) (list " ")))
(define-syntax (schemedefinput* stx) (define-syntax (schemedefinput* stx)
(syntax-case stx (eval-example-string define define-struct) (syntax-case stx (eval-example-string define define-values define-struct)
[(_ (eval-example-string s)) [(_ (eval-example-string s))
#'(schemeinput* (eval-example-string s))] #'(schemeinput* (eval-example-string s))]
[(_ (define . rest)) [(_ (define . rest))
(syntax-case stx () (syntax-case stx ()
[(_ e) #'(schemeblock+line e)])] [(_ e) #'(schemeblock+line e)])]
[(_ (define-values . rest))
(syntax-case stx ()
[(_ e) #'(schemeblock+line e)])]
[(_ (define-struct . rest)) [(_ (define-struct . rest))
(syntax-case stx () (syntax-case stx ()
[(_ e) #'(schemeblock+line e)])] [(_ e) #'(schemeblock+line e)])]

38
collects/scribble/manual.ss
View File

@ -213,7 +213,7 @@
(*defstruct 'name 'fields (lambda () (list desc ...)))])) (*defstruct 'name 'fields (lambda () (list desc ...)))]))
(define-syntax (defform*/subs stx) (define-syntax (defform*/subs stx)
(syntax-case stx () (syntax-case stx ()
[(_ [spec spec1 ...] ([non-term-id non-term-form ...] ...) desc ...) [(_ #:literals (lit ...) [spec spec1 ...] ([non-term-id non-term-form ...] ...) desc ...)
(with-syntax ([new-spec (with-syntax ([new-spec
(syntax-case #'spec () (syntax-case #'spec ()
[(name . rest) [(name . rest)
@ -224,7 +224,7 @@
#'name) #'name)
#'rest) #'rest)
#'spec)])]) #'spec)])])
#'(*defforms #t #'(*defforms #t '(lit ...)
'(spec spec1 ...) '(spec spec1 ...)
(list (lambda (x) (schemeblock0 new-spec)) (list (lambda (x) (schemeblock0 new-spec))
(lambda (ignored) (schemeblock0 spec1)) ...) (lambda (ignored) (schemeblock0 spec1)) ...)
@ -233,7 +233,9 @@
(lambda () (schemeblock0 non-term-form)) (lambda () (schemeblock0 non-term-form))
...) ...)
...) ...)
(lambda () (list desc ...))))])) (lambda () (list desc ...))))]
[(fm [spec spec1 ...] ([non-term-id non-term-form ...] ...) desc ...)
#'(fm #:literals () [spec spec1 ...] ([non-term-id non-term-form ...] ...) desc ...)]))
(define-syntax (defform* stx) (define-syntax (defform* stx)
(syntax-case stx () (syntax-case stx ()
[(_ [spec ...] desc ...) #'(defform*/subs [spec ...] () desc ...)])) [(_ [spec ...] desc ...) #'(defform*/subs [spec ...] () desc ...)]))
@ -242,41 +244,49 @@
[(_ spec desc ...) #'(defform*/subs [spec] () desc ...)])) [(_ spec desc ...) #'(defform*/subs [spec] () desc ...)]))
(define-syntax (defform/subs stx) (define-syntax (defform/subs stx)
(syntax-case stx () (syntax-case stx ()
[(_ #:literals lits spec subs desc ...) #'(defform*/subs #:literals lits [spec] subs desc ...)]
[(_ spec subs desc ...) #'(defform*/subs [spec] subs desc ...)])) [(_ spec subs desc ...) #'(defform*/subs [spec] subs desc ...)]))
(define-syntax (defform/none stx) (define-syntax (defform/none stx)
(syntax-case stx () (syntax-case stx ()
[(_ spec desc ...) [(_ spec desc ...)
#'(*defforms #f #'(*defforms #f null
'(spec) (list (lambda (ignored) (schemeblock0 spec))) '(spec) (list (lambda (ignored) (schemeblock0 spec)))
null null null null
(lambda () (list desc ...)))])) (lambda () (list desc ...)))]))
(define-syntax specsubform (define-syntax specsubform
(syntax-rules () (syntax-rules ()
[(_ #:literals (lit ...) spec desc ...)
(*specsubform 'spec #f '(lit ...) (lambda () (schemeblock0 spec)) null null (lambda () (list desc ...)))]
[(_ spec desc ...) [(_ spec desc ...)
(*specsubform 'spec #f (lambda () (schemeblock0 spec)) null null (lambda () (list desc ...)))])) (*specsubform 'spec #f null (lambda () (schemeblock0 spec)) null null (lambda () (list desc ...)))]))
(define-syntax specspecsubform (define-syntax specspecsubform
(syntax-rules () (syntax-rules ()
[(_ spec desc ...) [(_ spec desc ...)
(make-blockquote "leftindent" (list (specsubform spec desc ...)))])) (make-blockquote "leftindent" (list (specsubform spec desc ...)))]))
(define-syntax specform (define-syntax specform
(syntax-rules () (syntax-rules ()
[(_ #:literals (lit ...) spec desc ...)
(*specsubform 'spec #t '(lit ...) (lambda () (schemeblock0 spec)) null null (lambda () (list desc ...)))]
[(_ spec desc ...) [(_ spec desc ...)
(*specsubform 'spec #t (lambda () (schemeblock0 spec)) null null (lambda () (list desc ...)))])) (*specsubform 'spec #t null (lambda () (schemeblock0 spec)) null null (lambda () (list desc ...)))]))
(define-syntax specform/subs (define-syntax specform/subs
(syntax-rules () (syntax-rules ()
[(_ 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 ...)
(lambda () (schemeblock0 spec)) (lambda () (schemeblock0 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 non-term-form))
...) ...)
...) ...)
(lambda () (list desc ...)))])) (lambda () (list desc ...)))]
[(_ spec ([non-term-id non-term-form ...] ...) desc ...)
(specform/subs #:literals () spec ([non-term-id non-term-form ...] ...) desc ...)]))
(define-syntax specsubform/inline (define-syntax specsubform/inline
(syntax-rules () (syntax-rules ()
[(_ spec desc ...) [(_ spec desc ...)
(*specsubform 'spec #f #f null null (lambda () (list desc ...)))])) (*specsubform 'spec #f null #f null null (lambda () (list desc ...)))]))
(define-syntax defthing (define-syntax defthing
(syntax-rules () (syntax-rules ()
[(_ id result desc ...) [(_ id result desc ...)
@ -495,7 +505,7 @@
(define (meta-symbol? s) (memq s '(... ...+ ?))) (define (meta-symbol? s) (memq s '(... ...+ ?)))
(define (*defforms kw? forms form-procs subs sub-procs content-thunk) (define (*defforms kw? lits forms form-procs subs sub-procs content-thunk)
(parameterize ([current-variable-list (parameterize ([current-variable-list
(apply (apply
append append
@ -503,7 +513,8 @@
(let loop ([form (cons (if kw? (cdr form) form) (let loop ([form (cons (if kw? (cdr form) form)
subs)]) subs)])
(cond (cond
[(symbol? form) (if (meta-symbol? form) [(symbol? form) (if (or (meta-symbol? form)
(memq form lits))
null null
(list form))] (list form))]
[(pair? form) (append (loop (car form)) [(pair? form) (append (loop (car form))
@ -543,12 +554,13 @@
sub-procs)))) sub-procs))))
(content-thunk))))) (content-thunk)))))
(define (*specsubform form has-kw? form-thunk subs sub-procs content-thunk) (define (*specsubform form has-kw? lits form-thunk subs sub-procs content-thunk)
(parameterize ([current-variable-list (parameterize ([current-variable-list
(append (let loop ([form (cons (if has-kw? (cdr form) form) (append (let loop ([form (cons (if has-kw? (cdr form) form)
subs)]) subs)])
(cond (cond
[(symbol? form) (if (meta-symbol? form) [(symbol? form) (if (or (meta-symbol? form)
(memq form lits))
null null
(list form))] (list form))]
[(pair? form) (append (loop (car form)) [(pair? form) (append (loop (car form))

6
collects/scribble/scheme.ss
View File

@ -34,7 +34,7 @@
;; This is temporary, until the MzScheme manual is filled in... ;; This is temporary, until the MzScheme manual is filled in...
(make-parameter '(define require provide (make-parameter '(define require provide
define-values begin0 when unless define-values begin0 when unless
new send if cond begin else and or new send if cond begin else => and or
define-syntax syntax-rules define-struct define-syntax syntax-rules define-struct
quote quasiquote unquote unquote-splicing quote quasiquote unquote unquote-splicing
syntax quasisyntax unsyntax unsyntax-splicing syntax quasisyntax unsyntax unsyntax-splicing
@ -377,14 +377,14 @@
value-color] value-color]
[(identifier? c) [(identifier? c)
(cond (cond
[is-var?
variable-color]
[(and (identifier? c) [(and (identifier? c)
(memq (syntax-e c) (current-keyword-list))) (memq (syntax-e c) (current-keyword-list)))
keyword-color] keyword-color]
[(and (identifier? c) [(and (identifier? c)
(memq (syntax-e c) (current-meta-list))) (memq (syntax-e c) (current-meta-list)))
meta-color] meta-color]
[is-var?
variable-color]
[it? variable-color] [it? variable-color]
[else symbol-color])] [else symbol-color])]
[else paren-color]) [else paren-color])