From 860525b0115926430b40432896231d90c22c419e Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Mon, 29 Oct 2001 00:36:02 +0000
Subject: [PATCH] ...

original commit: 9ea39a5e390dd47c0980026c134f1527ea79c3e6
---
 collects/framework/private/scheme.ss | 41 ++++++++++++++++++++++++++--
 collects/framework/private/sig.ss    |  3 ++
 2 files changed, 41 insertions(+), 3 deletions(-)

diff --git a/collects/framework/private/scheme.ss b/collects/framework/private/scheme.ss
index 579db708..fda08e51 100644
--- a/collects/framework/private/scheme.ss
+++ b/collects/framework/private/scheme.ss
@@ -50,11 +50,25 @@
           (field [sizing-text (format "~a   ~a" left-bracket right-bracket)])
 
           (define/override (copy)
-            (instantiate sexp-snip% ()
+            (instantiate (get-sexp-snip-class) ()
               (left-bracket left-bracket)
               (right-bracket right-bracket)
               (saved-snips saved-snips)))
           
+          (define/override (write stream-out)
+            (send stream-out put (string left-bracket))
+            (send stream-out put (string right-bracket))
+            (send stream-out put (length saved-snips))
+            (let loop ([snips saved-snips])
+              (cond
+                [(null? snips) (void)]
+                [else
+                 (let* ([snip (car snips)]
+                        [snipclass (send snip get-snipclass)])
+                   (send stream-out put (send snipclass get-classname))
+                   (send snip write stream-out))
+                 (loop (cdr snips))])))
+          
           (define/override (draw dc x y left top right bottom dx dy draw-caret)
             (send dc draw-text sizing-text x y)
             (let-values ([(lpw lph lpa lpd) (send dc get-text-extent (string left-bracket))]
@@ -82,10 +96,31 @@
           (inherit set-snipclass)
           (set-snipclass sexp-snipclass)))
       
+      (define-values (get-sexp-snip-class set-sexp-snip-class)
+        (let ([cached-sexp-snip% sexp-snip%])
+          (values
+           (lambda () cached-sexp-snip%)
+           (lambda (_s%) (set! cached-sexp-snip% _s%)))))
+
       (define sexp-snipclass%
         (class snip-class%
           (define/override (read in)
-            (make-object sexp-snip%))
+            (let* ([left-bracket (string-ref (send in get-string) 0)]
+                   [right-bracket (string-ref (send in get-string) 0)]
+                   [snip-count (send in get-exact)]
+                   [saved-snips
+                    (let loop ([n snip-count])
+                      (cond
+                        [(zero? n) null]
+                        [else
+                         (let* ([classname (send in get-string)]
+                                [snipclass (send (get-the-snip-class-list) find classname)])
+                           (cons (send snipclass read in)
+                                 (loop (- n 1))))]))])
+              (instantiate (get-sexp-snip-class) ()
+                (left-bracket left-bracket)
+                (right-bracket right-bracket)
+                (saved-snips saved-snips))))
           (super-instantiate ())))
       
       (define sexp-snipclass (make-object sexp-snipclass%))
@@ -186,7 +221,7 @@
                             null]
                            [else (cons (send snip copy) (loop (send snip next)))]))])
             (send text delete left-pos right-pos)
-            (send text insert (instantiate sexp-snip% () 
+            (send text insert (instantiate (get-sexp-snip-class) () 
                                 (left-bracket left-bracket)
                                 (right-bracket right-bracket)
                                 (saved-snips snips))
diff --git a/collects/framework/private/sig.ss b/collects/framework/private/sig.ss
index f6dfaedb..1f9f3f08 100644
--- a/collects/framework/private/sig.ss
+++ b/collects/framework/private/sig.ss
@@ -287,6 +287,9 @@
 
      get-style-list
 
+     set-sexp-snip-class
+     get-sexp-snip-class
+
      get-keymap
      setup-keymap
      text-mixin