commit 187b1ae2e8de12b4549c14cb75dc469c65740029
parent 0bf3ac84575752ad123eaa34292baf788663a1f5
Author: Robby Findler <robby@racket-lang.org>
Date: Sun, 27 Apr 2008 14:57:09 +0000
added docs for the gui-utils and the textual preferences to the framework
svn: r9503
original commit: d07eff8bceb5d1b07deb074d1e180f3f9ba713d7
Diffstat:
1 file changed, 50 insertions(+), 12 deletions(-)
diff --git a/collects/scribble/srcdoc.ss b/collects/scribble/srcdoc.ss
@@ -55,23 +55,45 @@
(lambda (stx)
(syntax-case stx ()
[(_ id contract desc)
- (with-syntax ([((arg ...) result)
+ (with-syntax ([(header result)
(syntax-case #'contract (->d -> values)
[(->d (req ...) () (values [name res] ...))
- #'((req ...) (values res ...))]
+ #'((id req ...) (values res ...))]
[(->d (req ...) () [name res])
- #'((req ...) res)]
+ #'((id req ...) res)]
+ [(->d (req ...) () #:rest rest rest-ctc [name res])
+ #'((id req ... [rest rest-ctc] (... ...)) res)]
+ [(->d (req ...) (one more ...) whatever)
+ (raise-syntax-error
+ #f
+ (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)
- #'(() result)]
- [else
+ #'((id) result)]
+ [(-> whatever ...)
(raise-syntax-error
#f
- "unsupported procedure contract form (no argument names)"
+ (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
#'contract)])])
(values
#'[id contract]
- #'(defproc (id arg ...) result . desc)
+ #'(defproc header result . desc)
#'(scribble/manual)))])))
(define-provide/doc-transformer proc-doc/names
@@ -79,7 +101,7 @@
(syntax-case stx ()
[(_ id contract names desc)
(with-syntax ([header
- (syntax-case #'(contract names) (->d -> values)
+ (syntax-case #'(contract names) (->d -> values case->)
[((-> ctcs ... result) (arg-names ...))
(begin
(unless (= (length (syntax->list #'(ctcs ...)))
@@ -102,6 +124,11 @@
[((case-> (-> doms ... rng) ...)
((args ...) ...))
(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
(λ (doms args)
(unless (= (length (syntax->list doms))
@@ -125,7 +152,18 @@
(lambda (stx)
(syntax-case stx (parameter/c)
[(_ id (parameter/c contract) arg-id desc)
- (values
- #'[id (parameter/c contract)]
- #'(defparam id arg-id contract . desc)
- #'(scribble/manual))])))
+ (begin
+ (unless (identifier? #'arg-id)
+ (raise-syntax-error 'parameter/doc
+ "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)))])))
