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

got thru the docs for the framework's functions

Browse Source 
svn: r8983
This commit is contained in:
Robby Findler 2008-03-16 03:14:59 +00:00
parent 788adace20
commit 32d1534d90
3 changed files with 986 additions and 931 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
collects/framework/framework-docs.ss
View File

@ -7,19 +7,39 @@
(require "private/framework-exports.ss" (require "private/framework-exports.ss"
(for-syntax scheme/base) (for-syntax scheme/base)
scribble/decode
scribble/manual) scribble/manual)
(define-syntax (fw-doc-form stx) (define-syntax (fw-doc-form stx)
(syntax-case stx (->) (syntax-case stx (-> ->*)
[(_ id (-> a ... b) (arg ...) docs ...) [(_ id (-> a ... b) (arg ...) (docs ...))
#'(defproc (id (arg a) ...) #'(defproc (id (arg a) ...)
b)] b
docs ...)]
[(_ id b () docs ...) [(_ id (->* (mandatory-ctc ...) (optional-ctc ...) range)
#'(defthing id b)] ((mandatory-arg ...) ((optional-arg default) ...))
(docs ...))
#'(defproc (id (mandatory-arg mandatory-ctc) ...
(optional-arg optional-ctc default) ...)
range
docs ...)]
[(_ id ctc () (docs ...))
#'(defthing id ctc docs ...)]
[(_ id whatever ...) [(_ id whatever ...)
#'(defthing id any/c)])) (begin
(fprintf (current-error-port) "Cannot parse docs for ~a\n" (syntax->datum #'id))
#'(defthing id any/c))]))
(define-syntax (mapdesc stx)
(syntax-case stx ()
[(_ cmd events)
#'(make-splice (list (index (symbol->string 'cmd))
(symbol->string 'cmd)
" ("
(symbol->string 'events)
" events)"))]))
(define-syntax (export/docs stx) (define-syntax (export/docs stx)
(syntax-case stx () (syntax-case stx ()
@ -29,12 +49,12 @@
(define-syntax (conv/export/docs stx) (define-syntax (conv/export/docs stx)
(define-struct faux-stx (obj vec) #:prefab) (define-struct faux-stx (obj vec) #:prefab)
(syntax-case stx () (syntax-case stx ()
[(_ arg) [(id arg)
#`(export/docs #`(export/docs
#,@(let loop ([f-stx (syntax->datum #'arg)]) #,@(let loop ([f-stx (syntax->datum #'arg)])
(cond (cond
[(faux-stx? f-stx) [(faux-stx? f-stx)
(datum->syntax stx (datum->syntax #'id
(loop (faux-stx-obj f-stx)) (loop (faux-stx-obj f-stx))
(faux-stx-vec f-stx))] (faux-stx-vec f-stx))]
[(pair? f-stx) (cons (loop (car f-stx)) (loop (cdr f-stx)))] [(pair? f-stx) (cons (loop (car f-stx)) (loop (cdr f-stx)))]

1875
collects/framework/private/framework-exports.ss
View File

File diff suppressed because it is too large Load Diff

2
collects/scribblings/framework/framework.scrbl
View File

@ -9,4 +9,4 @@
@(defmodule framework/framework) @(defmodule framework/framework)
@(require framework/framework-docs) @(require framework/framework-docs)
@(def-fw-procs) @(def-fw-procs)