From da1bfdad733373dd6b3041946190c9799c96b171 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Tue, 29 May 2007 03:26:32 +0000
Subject: [PATCH] 370.2

svn: r6369

original commit: e9385a910eac5c2f84dccbe6d66fed0741200785
---
 collects/scribble/eval.ss   | 18 ++++++++++++++++--
 collects/scribble/manual.ss |  8 +++++---
 collects/scribble/scheme.ss | 12 ++++++++++++
 3 files changed, 33 insertions(+), 5 deletions(-)

diff --git a/collects/scribble/eval.ss b/collects/scribble/eval.ss
index 8244737c..d4af007d 100644
--- a/collects/scribble/eval.ss
+++ b/collects/scribble/eval.ss
@@ -17,6 +17,7 @@
            defs+int
            examples
            defexamples
+           as-examples
 
            current-int-namespace
            eval-example-string
@@ -150,6 +151,10 @@
                           (vector-set! v2 i (copy-value (vector-ref v i) ht))
                           (loop i))))
                     v2)]
+     [(box? v) (let ([v2 (box #f)])
+                 (hash-table-put! ht v v2)
+                 (set-box! v2 (copy-value (unbox v) ht))
+                 v2)]
      [else v]))
             
   (define (strip-comments s)
@@ -209,12 +214,15 @@
                      (make-paragraph null))))
 
   (define-syntax (schemedefinput* stx)
-    (syntax-case stx (eval-example-string define)
+    (syntax-case stx (eval-example-string define define-struct)
       [(_ (eval-example-string s))
        #'(schemeinput* (eval-example-string s))]
       [(_ (define . rest))
        (syntax-case stx ()
          [(_ e) #'(defspace (schemeblock e))])]
+      [(_ (define-struct . rest))
+       (syntax-case stx ()
+         [(_ e) #'(defspace (schemeblock e))])]
       [(_ (code:line (define . rest) . rest2))
        (syntax-case stx ()
          [(_ e) #'(defspace (schemeblock e))])]
@@ -266,5 +274,11 @@
   (define-syntax defexamples
     (syntax-rules ()
       [(_ e ...)
-       (titled-interaction example-title schemedefinput* e ...)])))
+       (titled-interaction example-title schemedefinput* e ...)]))
+
+  (define (as-examples t)
+    (make-table #f
+                (list
+                 (list example-title)
+                 (list (make-flow (list t)))))))
 
diff --git a/collects/scribble/manual.ss b/collects/scribble/manual.ss
index 9c1dd6c3..9781e0f2 100644
--- a/collects/scribble/manual.ss
+++ b/collects/scribble/manual.ss
@@ -54,10 +54,12 @@
     (let ([s (apply string-append
                     (map (lambda (s) (if (string=? s "\n") " " s))
                          strs))])
-      (let ([spaces (regexp-match-positions #rx"^ *" s)])
+      (let ([spaces (regexp-match-positions #rx"^ *" s)]
+            [end-spaces (regexp-match-positions #rx" *$" s)])
         (make-element "schemeinput" 
                       (list (hspace (cdar spaces))
-                            (make-element 'tt (list (substring s (cdar spaces)))))))))
+                            (make-element 'tt (list (substring s (cdar spaces) (caar end-spaces))))
+                            (hspace (- (cdar end-spaces) (caar end-spaces))))))))
 
   (define (verbatim s)
     (let ([strs (regexp-split #rx"\n" s)])
@@ -134,7 +136,7 @@
            var svar void-const)
 
   (define (void-const)
-    "void")
+    (schemefont "#<void>"))
 
   (define dots0
     (make-element #f (list "...")))
diff --git a/collects/scribble/scheme.ss b/collects/scribble/scheme.ss
index 2d0f57d1..68efc3ce 100644
--- a/collects/scribble/scheme.ss
+++ b/collects/scribble/scheme.ss
@@ -248,6 +248,12 @@
                    p-color)
               (set! src-col (+ src-col 1))
               (hash-table-put! col-map src-col dest-col))]
+           [(box? (syntax-e c))
+            (advance c init-line!)
+            (out "#&" value-color)
+            (set! src-col (+ src-col 2))
+            (hash-table-put! col-map src-col dest-col)
+            ((loop init-line! +inf.0) (unbox (syntax-e c)))]
            [(hash-table? (syntax-e c))
             (advance c init-line!)
             (let ([equal-table? (hash-table? (syntax-e c) 'equal)])
@@ -444,5 +450,11 @@
                               (cons a b)
                               (list #f 1 col (+ 1 col)
                                     (+ 2 sep (syntax-span a) (syntax-span b)))))]
+     [(box? v)
+      (let ([a (syntax-ize (unbox v) (+ col 2))])
+        (datum->syntax-object #f
+                              (box a)
+                              (list #f 1 col (+ 1 col)
+                                    (+ 2 (syntax-span a)))))]
      [else
       (datum->syntax-object #f v (list #f 1 col (+ 1 col) 1))])))