bkyk8rc3zvpnsf5inmcqq4n3k98cv6hj-my-site-hyper-literate-git.test.suzanne.soy-0.0.1

commit 302ea79cd544e275226b51978ffc3deb6027830d
parent 786d6dce575b21d76c5c430288a68a445662dfe9
Author: Matthew Flatt <mflatt@racket-lang.org>
Date:   Mon, 10 Dec 2007 17:59:26 +0000

split part of scheme/file into scheme/path, document them

svn: r7938

original commit: ca5a7c5560ee5eb26252c239dbf33f672a9749ac

Diffstat:
M
collects/scribble/base-render.ss
 | 
3
++-
M
collects/scribble/html-render.ss
 | 
1
+
M
collects/scribble/manual.ss
 | 
35
++++++++++++++++++++++++++++-------
M
collects/setup/scribble-index.ss
 | 
2
+-

4 files changed, 32 insertions(+), 9 deletions(-)
diff --git a/collects/scribble/base-render.ss b/collects/scribble/base-render.ss
@@ -3,7 +3,8 @@
   (require "struct.ss"
            mzlib/class
            mzlib/serialize
-           scheme/file)
+           scheme/file
+           scheme/path)
 
   (provide render%)
 
diff --git a/collects/scribble/html-render.ss b/collects/scribble/html-render.ss
@@ -2,6 +2,7 @@
 (module html-render scheme/base
   (require "struct.ss"
            scheme/class
+           scheme/path
            scheme/file
            mzlib/runtime-path
            setup/main-doc
diff --git a/collects/scribble/manual.ss b/collects/scribble/manual.ss
@@ -510,6 +510,23 @@
         "bad argument form"
         #'arg)]))
 
+  (define-syntax (arg-default stx)
+    (syntax-case stx (... ...+ _...superclass-args...)
+      [(_ [id contract])
+       (identifier? #'id)
+       #'#f]
+      [(_ [id contract val])
+       (identifier? #'id)
+       #'(schemeblock0 val)]
+      [(_ [kw id contract])
+       (keyword? (syntax-e #'kw))
+       #'#f]
+      [(_ [kw id contract val])
+       (keyword? (syntax-e #'kw))
+       #'(schemeblock0 val)]
+      [else
+       #'#f]))
+
   (define-syntax defproc 
     (syntax-rules ()
       [(_ (id arg ...) result desc ...)
@@ -523,6 +540,7 @@
                  (list (quote-syntax/loc id) ...)
                  '[(id arg ...) ...] 
                  (list (list (lambda () (arg-contract arg)) ...) ...)
+                 (list (list (lambda () (arg-default arg)) ...) ...)
                  (list (lambda () (schemeblock0 result)) ...)
                  (lambda () (list desc ...)))]))
   (define-syntax defstruct
@@ -745,7 +763,7 @@
         (or (get-exporting-libraries render part ri) null)))))
     
   (define (*defproc mode within-id
-                    stx-ids prototypes arg-contractss result-contracts content-thunk)
+                    stx-ids prototypes arg-contractss arg-valss result-contracts content-thunk)
     (let ([spacer (hspace 1)]
           [has-optional? (lambda (arg)
                            (and (pair? arg)
@@ -803,7 +821,7 @@
            (apply 
             append
             (map 
-             (lambda (stx-id prototype arg-contracts result-contract first?)
+             (lambda (stx-id prototype arg-contracts arg-vals result-contract first?)
                (let*-values ([(required optional more-required)
                               (let loop ([a (cdr prototype)][r-accum null])
                                 (if (or (null? a)
@@ -992,7 +1010,7 @@
                                               (list end)))))
                       null)
                   (apply append
-                         (map (lambda (v arg-contract)
+                         (map (lambda (v arg-contract arg-val)
                                 (cond
                                  [(pair? v)
                                   (let* ([v (if (keyword? (car v)) 
@@ -1001,8 +1019,9 @@
                                          [arg-cont (arg-contract)]
                                          [base-len (+ 5 (string-length (symbol->string (car v)))
                                                       (flow-element-width arg-cont))]
+                                         [arg-val (and arg-val (arg-val))]
                                          [def-len (if (has-optional? v)
-                                                      (string-length (format "~a" (caddr v)))
+                                                      (flow-element-width arg-val)
                                                       0)]
                                          [base-list
                                           (list
@@ -1028,7 +1047,7 @@
                                                (to-flow spacer)
                                                (to-flow "=")
                                                (to-flow spacer)
-                                               (to-flow (to-element (caddr v)))))))
+                                               (make-flow (list arg-val))))))
                                            (make-table-if-necessary
                                             "argcontract"
                                             (list
@@ -1039,14 +1058,16 @@
                                                   (list (to-flow spacer)
                                                         (to-flow "=")
                                                         (to-flow spacer)
-                                                        (to-flow (to-element (caddr v))))
+                                                        (make-flow (list arg-val)))
                                                   null)))))))))]
                                  [else null]))
                               (cdr prototype)
-                              arg-contracts)))))
+                              arg-contracts
+                              arg-vals)))))
              stx-ids
              prototypes
              arg-contractss
+             arg-valss
              result-contracts
              (let loop ([ps prototypes][accum null])
                (cond
diff --git a/collects/setup/scribble-index.ss b/collects/setup/scribble-index.ss
@@ -9,7 +9,7 @@
          setup/getinfo
          setup/dirs
          mzlib/serialize
-         scheme/file)
+         scheme/path)
 
 (provide load-xref
          xref-render