From bbe4958a59c3ba01620474a806e878938ee8e57d Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Mon, 12 Sep 2011 09:56:43 -0500
Subject: [PATCH] fix the collapsed snipclass so that it cooperates with the
 wxme library and thus saved files with collapsed snips can be required in
 non-GUI contexts

original commit: 89ef65a7461a4b91cd3f0c28231f74c593f165ee
---
 .../framework/collapsed-snipclass-wxme.rkt    | 24 +++++++++++++
 collects/framework/collapsed-snipclass.rkt    |  8 ++++-
 .../private/collapsed-snipclass-helpers.rkt   | 34 ++++++++-----------
 collects/framework/private/scheme.rkt         |  3 +-
 4 files changed, 48 insertions(+), 21 deletions(-)
 create mode 100644 collects/framework/collapsed-snipclass-wxme.rkt

diff --git a/collects/framework/collapsed-snipclass-wxme.rkt b/collects/framework/collapsed-snipclass-wxme.rkt
new file mode 100644
index 00000000..dd2adbe7
--- /dev/null
+++ b/collects/framework/collapsed-snipclass-wxme.rkt
@@ -0,0 +1,24 @@
+#lang racket/base
+(require racket/class
+         racket/snip
+         wxme)
+
+(provide reader)
+
+(define what "collapsed-sexp")
+
+(define reader
+  (new (class* object% (snip-reader<%>)
+         (define/public (read-header version stream) (void))
+         (define/public (read-snip text-only? version stream)
+           (define left (send stream read-bytes what))
+           (define right (send stream read-bytes what))
+           (define count (send stream read-integer what))
+           (define snips
+             (for/list ([x (in-range 0 count)])
+               (define snip-class-name (bytes->string/utf-8 (send stream read-bytes what)))
+               (read-snip-from-port snip-class-name
+                                    'collapsed-snipclass-wxme.rkt
+                                    stream)))
+           (apply bytes-append snips))
+         (super-new))))
diff --git a/collects/framework/collapsed-snipclass.rkt b/collects/framework/collapsed-snipclass.rkt
index 0cb303cf..9eab2283 100644
--- a/collects/framework/collapsed-snipclass.rkt
+++ b/collects/framework/collapsed-snipclass.rkt
@@ -18,11 +18,17 @@
        #f
        (read (open-input-text-editor text))
        (list file line col pos 1)))
+    (define/override (copy)
+      (new simple-sexp-snip% 
+           [left-bracket left-bracket]
+           [right-bracket right-bracket]
+           [saved-snips saved-snips]))
     (super-new)))
 
 (define sexp-snipclass% (make-sexp-snipclass% simple-sexp-snip%))
 
 (define snip-class (make-object sexp-snipclass%))
-(send snip-class set-classname (format "~s" '(lib "collapsed-snipclass.ss" "framework")))
+(send snip-class set-classname (format "~s" '((lib "collapsed-snipclass.ss" "framework")
+                                              (lib "collapsed-snipclass-wxme.ss" "framework"))))
 (send snip-class set-version 0)
 (send (get-the-snip-class-list) add snip-class)
diff --git a/collects/framework/private/collapsed-snipclass-helpers.rkt b/collects/framework/private/collapsed-snipclass-helpers.rkt
index 34f7a3f2..bda8c33d 100644
--- a/collects/framework/private/collapsed-snipclass-helpers.rkt
+++ b/collects/framework/private/collapsed-snipclass-helpers.rkt
@@ -1,26 +1,22 @@
-#lang scheme/base
-(require scheme/gui/base
-         scheme/class)
+#lang racket/base
+(require racket/gui/base
+         racket/class)
 
 (provide make-sexp-snipclass%)
 
 (define (make-sexp-snipclass% sexp-snip%)
   (class snip-class%
     (define/override (read in)
-      (let* ([left-bracket (integer->char (bytes-ref (send in get-bytes) 0))]
-             [right-bracket (integer->char (bytes-ref (send in get-bytes) 0))]
-             [snip-count (send in get-exact)]
-             [saved-snips
-              (let loop ([n snip-count])
-                (cond
-                  [(zero? n) null]
-                  [else
-                   (let* ([classname (bytes->string/utf-8 (send in get-bytes))]
-                          [snipclass (send (get-the-snip-class-list) find classname)])
-                     (cons (send snipclass read in)
-                           (loop (- n 1))))]))])
-        (instantiate sexp-snip% ()
-          (left-bracket left-bracket)
-          (right-bracket right-bracket)
-          (saved-snips saved-snips))))
+      (define left-bracket (integer->char (bytes-ref (send in get-bytes) 0)))
+      (define right-bracket (integer->char (bytes-ref (send in get-bytes) 0)))
+      (define snip-count (send in get-exact))
+      (define saved-snips
+        (for/list ([in-range snip-count])
+          (define classname (bytes->string/utf-8 (send in get-bytes)))
+          (define snipclass (send (get-the-snip-class-list) find classname))
+          (send snipclass read in)))
+      (new sexp-snip%
+           [left-bracket left-bracket]
+           [right-bracket right-bracket]
+           [saved-snips saved-snips]))
     (super-new)))
diff --git a/collects/framework/private/scheme.rkt b/collects/framework/private/scheme.rkt
index f10ef10a..cb05887e 100644
--- a/collects/framework/private/scheme.rkt
+++ b/collects/framework/private/scheme.rkt
@@ -149,7 +149,8 @@
 
 ;; old snips (from old versions of drscheme) use this snipclass
 (define lib-snip-class (make-object sexp-snipclass%))
-(send lib-snip-class set-classname (format "~s" '(lib "collapsed-snipclass.ss" "framework")))
+(send lib-snip-class set-classname (format "~s" '((lib "collapsed-snipclass.ss" "framework")
+                                                  (lib "collapsed-snipclass-wxme.ss" "framework"))))
 (send lib-snip-class set-version 0)
 (send (get-the-snip-class-list) add lib-snip-class)