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

scribble mrlib docs

Browse Source 
svn: r8165

original commit: 5890eedeb4301b5016247ac98a34c39655d40225
This commit is contained in:
Matthew Flatt 2007-12-30 22:46:20 +00:00
parent 95ecb101d1
commit 12f7e3c037
2 changed files with 80 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
collects/scribble/manual-struct.ss
View File

@ -14,7 +14,8 @@
[(struct-index-desc exported-index-desc) ()] [(struct-index-desc exported-index-desc) ()]
[(form-index-desc exported-index-desc) ()] [(form-index-desc exported-index-desc) ()]
[(class-index-desc exported-index-desc) ()] [(class-index-desc exported-index-desc) ()]
[(interface-index-desc exported-index-desc) ()]) [(interface-index-desc exported-index-desc) ()]
[(mixin-index-desc exported-index-desc) ()])

106
collects/scribble/manual.ss
View File

@ -83,6 +83,8 @@
(make-shaped-parens s val) (make-shaped-parens s val)
s)) s))
(define-code schemeblockelem to-element)
(define-code scheme to-element unsyntax keep-s-expr add-sq-prop) (define-code scheme to-element unsyntax keep-s-expr add-sq-prop)
(define-code SCHEME to-element UNSYNTAX keep-s-expr add-sq-prop) (define-code SCHEME to-element UNSYNTAX keep-s-expr add-sq-prop)
(define-code schemeresult to-element/result unsyntax keep-s-expr add-sq-prop) (define-code schemeresult to-element/result unsyntax keep-s-expr add-sq-prop)
@ -874,7 +876,7 @@
dots1] dots1]
[(eq? (arg-id arg) '...) [(eq? (arg-id arg) '...)
dots0] dots0]
[else (arg-id arg)])] [else (to-element (arg-id arg))])]
[e (if (arg-ends-optional? arg) [e (if (arg-ends-optional? arg)
(make-element #f (list e "]")) (make-element #f (list e "]"))
e)] e)]
@ -1084,7 +1086,7 @@
tagged) tagged)
(if (null? args) (if (null? args)
(list (list
(schemeparenfont (make-string (add1 (prototype-depth prototype)) #\)))) (schemeparenfont (make-string (prototype-depth prototype) #\))))
(apply (apply
append append
(map (map
@ -1812,6 +1814,8 @@
defclass/title defclass/title
definterface definterface
definterface/title definterface/title
defmixin
defmixin/title
defconstructor defconstructor
defconstructor/make defconstructor/make
defconstructor*/make defconstructor*/make
@ -1824,7 +1828,7 @@
(define-syntax-parameter current-class #f) (define-syntax-parameter current-class #f)
(define-struct decl (name super intfs mk-head body)) (define-struct decl (name super intfs ranges mk-head body))
(define-struct constructor (def)) (define-struct constructor (def))
(define-struct meth (name mode desc def)) (define-struct meth (name mode desc def))
(define-struct spec (def)) (define-struct spec (def))
@ -1949,7 +1953,7 @@
(decode-flow (decode-flow
(build-body decl (decl-body decl)))))))))) (build-body decl (decl-body decl))))))))))
(define (*class-doc stx-id super intfs whole-page? make-index-desc) (define (*class-doc kind stx-id super intfs ranges whole-page? make-index-desc)
(let ([spacer (hspace 1)]) (let ([spacer (hspace 1)])
(make-table (make-table
'boxed 'boxed
@ -1976,33 +1980,43 @@
tag) tag)
(car content))) (car content)))
spacer ":" spacer spacer ":" spacer
(if super (case kind
(scheme class?) [(class) (scheme class?)]
(scheme interface?)))))))) [(interface) (scheme interface?)]
[(mixin) (schemeblockelem (class? . -> . class?))])))))))
(if super (if super
(list (list
(list (make-flow (list (make-flow
(list (list
(t (hspace 2) "superclass:" spacer (to-element super)))))) (t (hspace 2) "superclass:" spacer (to-element super))))))
null) null)
(if (null? intfs) (let ([show-intfs
null (lambda (intfs range?)
(list (if (null? intfs)
(list null
(make-flow (list
(list (list
(make-table #f (make-flow
(cons (list
(list (make-flow (list (make-paragraph (list (hspace 2) (make-table #f
(if super (cons
"implements:" (list (make-flow (list (make-paragraph (list (hspace 2)
"extends:") (case kind
spacer)))) [(interface) "implements:"]
(make-flow (list (make-paragraph (list (to-element (car intfs))))))) [(class) "extends:"]
(map (lambda (i) [(mixin)
(list (make-flow (list (make-paragraph (list spacer)))) (if range?
(make-flow (list (make-paragraph (list (to-element i))))))) "result implements:"
(cdr intfs))))))))))))) "argument extends/implements:")])
spacer))))
(make-flow (list (make-paragraph (list (to-element (car intfs)))))))
(map (lambda (i)
(list (make-flow (list (make-paragraph (list spacer))))
(make-flow (list (make-paragraph (list (to-element i)))))))
(cdr intfs))))))))))])
(append
(show-intfs intfs #f)
(show-intfs ranges #t)))))))
(define-syntax *defclass (define-syntax *defclass
(syntax-rules () (syntax-rules ()
@ -2012,11 +2026,14 @@
(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) ...)
null
(lambda (whole-page?) (lambda (whole-page?)
(list (list
(*class-doc (quote-syntax/loc name) (*class-doc 'class
(quote-syntax/loc name)
(quote-syntax super) (quote-syntax super)
(list (quote-syntax intf) ...) (list (quote-syntax intf) ...)
null
whole-page? whole-page?
make-class-index-desc))) make-class-index-desc)))
(list body ...))))])) (list body ...))))]))
@ -2039,11 +2056,14 @@
(make-decl (quote-syntax/loc name) (make-decl (quote-syntax/loc name)
#f #f
(list (quote-syntax/loc intf) ...) (list (quote-syntax/loc intf) ...)
null
(lambda (whole-page?) (lambda (whole-page?)
(list (list
(*class-doc (quote-syntax/loc name) (*class-doc 'interface
(quote-syntax/loc name)
#f #f
(list (quote-syntax intf) ...) (list (quote-syntax intf) ...)
null
whole-page? whole-page?
make-interface-index-desc))) make-interface-index-desc)))
(list body ...))))])) (list body ...))))]))
@ -2058,6 +2078,36 @@
[(_ name (intf ...) body ...) [(_ name (intf ...) body ...)
(*definterface *include-class/title name (intf ...) body ...)])) (*definterface *include-class/title name (intf ...) body ...)]))
(define-syntax *defmixin
(syntax-rules ()
[(_ *include-class name (domain ...) (range ...) body ...)
(*include-class
(syntax-parameterize ([current-class (quote-syntax name)])
(make-decl (quote-syntax/loc name)
#f
(list (quote-syntax/loc domain) ...)
(list (quote-syntax/loc range) ...)
(lambda (whole-page?)
(list
(*class-doc 'mixin
(quote-syntax/loc name)
#f
(list (quote-syntax domain) ...)
(list (quote-syntax range) ...)
whole-page?
make-mixin-index-desc)))
(list body ...))))]))
(define-syntax defmixin
(syntax-rules ()
[(_ name (domain ...) (range ...) body ...)
(*defmixin *include-class name (domain ...) (range ...) body ...)]))
(define-syntax defmixin/title
(syntax-rules ()
[(_ name (domain ...) (range ...) body ...)
(*defmixin *include-class/title name (domain ...) (range ...) body ...)]))
(define-syntax (defconstructor*/* stx) (define-syntax (defconstructor*/* stx)
(syntax-case stx () (syntax-case stx ()
[(_ mode ((arg ...) ...) desc ...) [(_ mode ((arg ...) ...) desc ...)
@ -2176,7 +2226,7 @@
(let loop ([search (get d ri ctag)]) (let loop ([search (get d ri ctag)])
(cond (cond
[(null? search) [(null? search)
(make-element #f "<method not found>")] (list (make-element #f '("<method not found>")))]
[(not (car search)) [(not (car search))
(loop (cdr search))] (loop (cdr search))]
[else [else