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

added docs for the gui-utils and the textual preferences to the framework

Browse Source 
svn: r9503

original commit: d07eff8bceb5d1b07deb074d1e180f3f9ba713d7
This commit is contained in:
Robby Findler 2008-04-27 14:57:09 +00:00
parent 0bf3ac8457
commit 187b1ae2e8
1 changed files with 51 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

64
collects/scribble/srcdoc.ss
View File

@ -55,23 +55,45 @@
(lambda (stx) (lambda (stx)
(syntax-case stx () (syntax-case stx ()
[(_ id contract desc) [(_ id contract desc)
(with-syntax ([((arg ...) result) (with-syntax ([(header result)
(syntax-case #'contract (->d -> values) (syntax-case #'contract (->d -> values)
[(->d (req ...) () (values [name res] ...)) [(->d (req ...) () (values [name res] ...))
#'((req ...) (values res ...))] #'((id req ...) (values res ...))]
[(->d (req ...) () [name res]) [(->d (req ...) () [name res])
#'((req ...) res)] #'((id req ...) res)]
[(-> result) [(->d (req ...) () #:rest rest rest-ctc [name res])
#'(() result)] #'((id req ... [rest rest-ctc] (... ...)) res)]
[else [(->d (req ...) (one more ...) whatever)
(raise-syntax-error (raise-syntax-error
#f #f
"unsupported procedure contract form (no argument names)" (format "unsupported ->d contract form for ~a, optional arguments non-empty, must use proc-doc/names"
(syntax->datum #'id))
stx
#'contract)]
[(->d whatever ...)
(raise-syntax-error
#f
(format "unsupported ->d contract form for ~a" (syntax->datum #'id))
stx
#'contract)]
[(-> result)
#'((id) result)]
[(-> whatever ...)
(raise-syntax-error
#f
(format "unsupported -> contract form for ~a, must use proc-doc/names if there are arguments"
(syntax->datum #'id))
stx
#'contract)]
[(id whatever ...)
(raise-syntax-error
#f
(format "unsupported ~a contract form (unable to synthesize argument names)" (syntax->datum #'id))
stx stx
#'contract)])]) #'contract)])])
(values (values
#'[id contract] #'[id contract]
#'(defproc (id arg ...) result . desc) #'(defproc header result . desc)
#'(scribble/manual)))]))) #'(scribble/manual)))])))
(define-provide/doc-transformer proc-doc/names (define-provide/doc-transformer proc-doc/names
@ -79,7 +101,7 @@
(syntax-case stx () (syntax-case stx ()
[(_ id contract names desc) [(_ id contract names desc)
(with-syntax ([header (with-syntax ([header
(syntax-case #'(contract names) (->d -> values) (syntax-case #'(contract names) (->d -> values case->)
[((-> ctcs ... result) (arg-names ...)) [((-> ctcs ... result) (arg-names ...))
(begin (begin
(unless (= (length (syntax->list #'(ctcs ...))) (unless (= (length (syntax->list #'(ctcs ...)))
@ -102,6 +124,11 @@
[((case-> (-> doms ... rng) ...) [((case-> (-> doms ... rng) ...)
((args ...) ...)) ((args ...) ...))
(begin (begin
(unless (= (length (syntax->list #'((doms ...) ...)))
(length (syntax->list #'((args ...) ...))))
(raise-syntax-error #f
"number of cases and number of arg lists do not have the same size"
stx))
(for-each (for-each
(λ (doms args) (λ (doms args)
(unless (= (length (syntax->list doms)) (unless (= (length (syntax->list doms))
@ -125,7 +152,18 @@
(lambda (stx) (lambda (stx)
(syntax-case stx (parameter/c) (syntax-case stx (parameter/c)
[(_ id (parameter/c contract) arg-id desc) [(_ id (parameter/c contract) arg-id desc)
(values (begin
#'[id (parameter/c contract)] (unless (identifier? #'arg-id)
#'(defparam id arg-id contract . desc) (raise-syntax-error 'parameter/doc
#'(scribble/manual))]))) "expected an identifier"
stx
#'arg-id))
(unless (identifier? #'id)
(raise-syntax-error 'parameter/doc
"expected an identifier"
stx
#'id))
(values
#'[id (parameter/c contract)]
#'(defparam id arg-id contract . desc)
#'(scribble/manual)))])))