..

original commit: 3be7351c9070df86b8ceff66ee254668922703f2

collects/framework/collapsed-snipclass.ss

@@ -0,0 +1,31 @@
+(module collapsed-snipclass mzscheme
+  (require (lib "mred.ss" "mred")
+           (lib "class.ss")
+           "private/collapsed-snipclass-helpers.ss")
+  
+  (provide snip-class)
+
+  (define simple-sexp-snip%
+    (class* snip% (readable-snip<%>)
+      (init-field left-bracket right-bracket saved-snips)
+      (define/public (read-one-special index file line col pos)
+        (let ([text (make-object text%)])
+          (for-each
+           (lambda (s) (send text insert (send s copy)
+                             (send text last-position)
+                             (send text last-position)))
+           saved-snips)
+          (values (datum->syntax-object
+                   #f
+                   (read (open-input-text-editor text))
+                   (list file line col pos 1))
+                  1
+                  #t)))
+      (super-instantiate ())))
+  
+  (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-version 0)
+  (send (get-the-snip-class-list) add snip-class))

collects/framework/gui-utils.ss

@@ -635,7 +635,7 @@
   
   (define unsaved-warning
     (opt-lambda (filename action-anyway (can-save-now? #f) (parent #f))
-      (let* ([result (void)]
+      (let* ([result 'cancel]
              [unsaved-dialog%
               (class dialog%
                 (inherit show center)

collects/framework/private/collapsed-snipclass-helpers.ss

@@ -0,0 +1,27 @@
+(module collapsed-snipclass-helpers mzscheme
+  (require (lib "mred.ss" "mred")
+           (lib "class.ss"))
+  
+  (provide make-sexp-snipclass%)
+  
+  (define (make-sexp-snipclass% sexp-snip%)
+    (class snip-class%
+      (define/override (read in)
+        (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 sexp-snip% ()
+            (left-bracket left-bracket)
+            (right-bracket right-bracket)
+            (saved-snips saved-snips))))
+      (super-instantiate ()))))
+