raw, first cut of framework docs: just functions and just contracts so far

svn: r8976

collects/framework/framework-docs.ss

@@ -0,0 +1,44 @@
+#lang scheme/base
+
+(provide def-fw-procs)
+
+(require (for-label scheme/contract)
+         (for-label framework/framework))
+
+(require "private/framework-exports.ss"
+         (for-syntax scheme/base)
+         scribble/manual)
+
+(define-syntax (fw-doc-form stx)
+  (syntax-case stx (->)
+    [(_ id (-> a ... b) (arg ...) docs ...)
+     #'(defproc (id (arg a) ...)
+         b)]
+
+    [(_ id b () docs ...)
+     #'(defthing id b)]
+
+    [(_ id whatever ...)
+     #'(defthing id any/c)]))
+
+(define-syntax (export/docs stx)
+  (syntax-case stx ()
+    [(_ (id ctc argspec docs ...) ...)
+     #'(begin (fw-doc-form id ctc argspec docs ...) ...)]))
+
+(define-syntax (conv/export/docs stx)
+  (define-struct faux-stx (obj vec) #:prefab)
+  (syntax-case stx ()
+    [(_ arg)
+     #`(export/docs
+        #,@(let loop ([f-stx (syntax->datum #'arg)])
+             (cond
+               [(faux-stx? f-stx) 
+                (datum->syntax stx
+                               (loop (faux-stx-obj f-stx))
+                               (faux-stx-vec f-stx))]
+               [(pair? f-stx) (cons (loop (car f-stx)) (loop (cdr f-stx)))]
+               [else f-stx])))]))
+
+(define-syntax (def-fw-procs stx)
+  #'(framework-exports/srcloc-preserved conv/export/docs))

collects/scribblings/framework/framework.scrbl

@@ -4,6 +4,9 @@
 
 @title{@bold{Framework}: PLT GUI Application Framework}
 
-Nothing yet.
-
 @index-section[]
+
+@(defmodule framework/framework)
+
+@(require framework/framework-docs)
+@(def-fw-procs)