From 778075ac2acfc18455f75f2c4d8f4c5fd09318d7 Mon Sep 17 00:00:00 2001
From: Eli Barzilay <eli@racket-lang.org>
Date: Sun, 9 Oct 2005 04:59:10 +0000
Subject: [PATCH] Add support for text boxes, xml boxes, and scheme boxes.

svn: r1030
---
 collects/handin-server/extra-utils.ss | 42 +++++++++++++++++++++------
 1 file changed, 33 insertions(+), 9 deletions(-)

diff --git a/collects/handin-server/extra-utils.ss b/collects/handin-server/extra-utils.ss
index 83eaa6dd7b..56f07b8e57 100644
--- a/collects/handin-server/extra-utils.ss
+++ b/collects/handin-server/extra-utils.ss
@@ -93,9 +93,10 @@
   ;; note that snip->text below already takes care of some snips
   (define (item->text x)
     (cond [(is-a? x snip%)
-           (format "{{~a}}" (or (send x get-text 0 (send x get-count) #t) x))]
+           (format "~a" (or (send x get-text 0 (send x get-count) #t) x))]
           [(special-comment? x)
            (format "#| ~a |#" (special-comment-value x))]
+          [(syntax? x) (syntax-object->datum x)]
           [else x]))
   (let-values ([(filter) (if (pair? filter) (car filter) item->text)]
                [(in out) (make-pipe 4096)])
@@ -146,9 +147,16 @@
               (display line) (newline) (loop (add1 n))))))
       (get-output-string (current-output-port)))))
 
-;; ---------------------------------------------
-;; This code will hack test boxes textualization
+;; ---------------------------------------------------------
+;; This code will hack textualization of test and text boxes
 
+(define (insert-to-editor editor . xs)
+  (for-each (lambda (x)
+              (send editor insert
+                    (if (string? x) x (make-object editor-snip% x))))
+            xs))
+
+;; support for "test-case-box%"
 (define test-sc
   (new (class snip-class%
          (define/override (read f)
@@ -174,16 +182,32 @@
       (send f get (box 0))) ; error-box
     (super-new)
     (set-snipclass test-sc)
-    (for-each (lambda (x)
-                (send (get-editor)
-                      insert (if (string? x) x (make-object editor-snip% x))))
-              (list "TEST:\n"
-                    "  expression: " to-test "\n"
-                    "  should be:  " expected "\n"))))
+    (insert-to-editor (get-editor)
+      "{{TEST:\n  expression: " to-test "\n  should be:  " expected "\n}}")))
 (send test-sc set-classname "test-case-box%")
 (send test-sc set-version 2)
 (send (get-the-snip-class-list) add test-sc)
 
+;; support for "text-box%"
+(define text-box-sc
+  (new (class snip-class%
+         (define/override (read f)
+           (let ([text (new text-box%)]) (send text read-from-file f) text))
+         (super-new))))
+(define text-box%
+  (class editor-snip%
+    (inherit set-snipclass get-editor)
+    (define text (new text%))
+    (define/public (read-from-file f)
+      (unless (eq? 1 (send text-box-sc reading-version f)) (error "BOOM"))
+      (send text read-from-file f))
+    (super-new)
+    (set-snipclass text-box-sc)
+    (insert-to-editor (get-editor) "{{TEXT: " text "}}")))
+(send text-box-sc set-classname "text-box%")
+(send text-box-sc set-version 2)
+(send (get-the-snip-class-list) add text-box-sc)
+
 ;; ============================================================================
 ;; Checker function