diff --git a/collects/framework/private/preferences.ss b/collects/framework/private/preferences.ss
index 3784c52f..5fcfe10a 100644
--- a/collects/framework/private/preferences.ss
+++ b/collects/framework/private/preferences.ss
@@ -1,3 +1,4 @@
+
 (module preferences mzscheme
   (require (lib "string-constant.ss" "string-constants")
            (lib "unitsig.ss")
@@ -23,19 +24,19 @@
       (define default-preferences-filename
         (build-path (collection-path "defaults") "prefs.ss"))
       
-  ;; preferences : sym -o> (union marshalled pref)
+      ;; preferences : sym -o> (union marshalled pref)
       (define preferences (make-hash-table))
       
-  ;; marshall-unmarshall : sym -o> un/marshall
+      ;; marshall-unmarshall : sym -o> un/marshall
       (define marshall-unmarshall (make-hash-table))
       
-  ;; callbacks : sym -o> (listof (sym TST -> boolean))
+      ;; callbacks : sym -o> (listof (sym TST -> boolean))
       (define callbacks (make-hash-table))
       
-  ;; saved-defaults : sym -o> (union marshalled pref)
+      ;; saved-defaults : sym -o> (union marshalled pref)
       (define saved-defaults (make-hash-table))
       
-  ;; defaults : sym -o> default
+      ;; defaults : sym -o> default
       (define defaults (make-hash-table))
       
       (define-struct un/marshall (marshall unmarshall))
@@ -69,25 +70,32 @@
                                         (exn-message exn)
                                         (format "~s" exn)))))))))
       
-      (define get-callbacks
-        (lambda (p)
-          (hash-table-get callbacks
-                          p
-                          (lambda () null))))
+      ;; get-callbacks : sym -> (listof (-> void))
+      (define (get-callbacks p)
+        (hash-table-get callbacks
+                        p
+                        (lambda () null)))
       
-      (define add-callback
-        (lambda (p callback)
-          (hash-table-put! callbacks p (append (get-callbacks p) (list callback)))
-          (lambda ()
-            (hash-table-put!
-             callbacks
-             p
-             (let loop ([callbacks (get-callbacks p)])
-               (cond
-                 [(null? callbacks) null]
-                 [else (if (eq? (car callbacks) callback)
-                           (loop (cdr callbacks))
-                           (cons (car callbacks) (loop (cdr callbacks))))]))))))
+      ;; add-callback : sym (-> void) -> void
+      (define (add-callback p callback)
+        (hash-table-put! callbacks p 
+                         (append 
+                          (hash-table-get callbacks p (lambda () null))
+                          (list callback)))
+        (lambda ()
+          (hash-table-put!
+           callbacks
+           p
+           (let loop ([callbacks (hash-table-get callbacks p (lambda () null))])
+             (cond
+               [(null? callbacks) null]
+               [else 
+                (let ([callback (car callbacks)])
+                  (cond
+                    [(eq? callback callback)
+                     (loop (cdr callbacks))]
+                    [else
+                     (cons (car callbacks) (loop (cdr callbacks)))]))])))))
       
       (define check-callbacks
         (lambda (p value)
@@ -154,7 +162,7 @@
            defaults
            (lambda (p v) (set p v)))))
       
-  ;; set-default : (sym TST (TST -> boolean) -> void
+      ;; set-default : (sym TST (TST -> boolean) -> void
       (define (set-default p in-default-value checker)
         (let* ([default-value
                 (let/ec k
@@ -258,9 +266,9 @@
                             (parse-pref (car pre-pref) (cadr pre-pref))
                             (err input (string-constant expected-list-of-length2))))
                       (loop (cdr input)))))))))
-
       
-  ;; read-from-file-to-ht : string hash-table -> void
+      
+      ;; read-from-file-to-ht : string hash-table -> void
       (define (read-from-file-to-ht filename ht)
         (let* ([parse-pref
                 (lambda (p marshalled)
@@ -270,9 +278,9 @@
                       [unmarshall-struct
                        (set p ((un/marshall-unmarshall unmarshall-struct) marshalled))]
                       
-		 ;; in this case, assume that no marshalling/unmarshalling 
-		 ;; is going to take place with the pref, since an unmarshalled 
-		 ;; pref was already there.
+                      ;; in this case, assume that no marshalling/unmarshalling 
+                      ;; is going to take place with the pref, since an unmarshalled 
+                      ;; pref was already there.
                       [(pref? ht-pref)
                        (set p marshalled)]
                       
@@ -286,21 +294,21 @@
           (when (file-exists? filename)
             (for-each-pref-in-file parse-pref filename))))
       
-  ;; read : -> void
+      ;; read : -> void
       (define (-read)
         (read-from-file-to-ht (prefs-file:get-preferences-filename) preferences))
       
       
-  ;; read in the saved defaults. These should override the
-  ;; values used with set-default.
+      ;; read in the saved defaults. These should override the
+      ;; values used with set-default.
       (read-from-file-to-ht default-preferences-filename saved-defaults)
       
       
-  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-  ;;;                                                 ;;;
-  ;;;               preferences dialog                ;;;
-  ;;;                                                 ;;;
-  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+      ;;;                                                 ;;;
+      ;;;               preferences dialog                ;;;
+      ;;;                                                 ;;;
+      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
       
       
       (define-struct ppanel (title container panel))
diff --git a/collects/framework/private/scheme.ss b/collects/framework/private/scheme.ss
index a87a7d90..4c9ba2f2 100644
--- a/collects/framework/private/scheme.ss
+++ b/collects/framework/private/scheme.ss
@@ -37,12 +37,86 @@
       ;;                                                                  ;;
       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+      (define (set-box/f! b v) (when (box? b) (set-box! b v)))
+
       (define sexp-snip%
         (class snip%
+          (field [sizing-text "(   )"])
           (define/override (draw dc x y left top right bottom dx dy draw-caret)
-            (void))
-          (define/override (get-extent dc x y w h descent space lspace rspace)
-            (void))))
+            (send dc draw-text sizing-text x y)
+            (let-values ([(lpw lph lpa lpd) (send dc get-text-extent "(")]
+                         [(rpw rph rpa rpd) (send dc get-text-extent ")")]
+                         [(sw sh sa sd) (send dc get-text-extent sizing-text)])
+              (let* ([dtw (- sw lpw rpw)]
+                     [dot-start (+ x lpw)]
+                     [dt1x (+ dot-start (* dtw 1/5))]
+                     [dt2x (+ dot-start (* dtw 1/2))]
+                     [dt3x (+ dot-start (* dtw 4/5))]
+                     [dty (/ sh 2)])
+                (send dc draw-rectangle dt1x dty 2 2)
+                (send dc draw-rectangle dt2x dty 2 2)
+                (send dc draw-rectangle dt3x dty 2 2))))
+
+          (define/override (get-extent dc x y wb hb descentb spaceb lspaceb rspaceb)
+            (let-values ([(w h d a) (send dc get-text-extent sizing-text)])
+              (set-box/f! wb w)
+              (set-box/f! hb h)
+              (set-box/f! descentb d)
+              (set-box/f! spaceb a)
+              (set-box/f! lspaceb 0)
+              (set-box/f! rspaceb 0)))
+          (super-instantiate ())
+          (inherit set-snipclass)
+          (set-snipclass sexp-snipclass)))
+      
+      (define sexp-snipclass%
+        (class snip-class%
+          (define/override (read in)
+            (make-object sexp-snip%))
+          (super-instantiate ())))
+      
+      (define sexp-snipclass (make-object sexp-snipclass%))
+      (send sexp-snipclass set-classname "drscheme:sexp-snip")
+      (send sexp-snipclass set-version 0)
+      (send (get-the-snip-class-list) add sexp-snipclass)
+      
+      ;; leave this for next version...
+      '(keymap:add-to-right-button-menu
+       (let ([old (keymap:add-to-right-button-menu)])
+         (lambda (menu text event)
+           (old menu text event)
+           (when (is-a? text -text<%>)
+             (let* ([pos 
+                     (call-with-values
+                      (lambda ()
+                        (send text dc-location-to-editor-location
+                              (send event get-x)
+                              (send event get-y)))
+                      (lambda (x y)
+                        (send text find-position x y)))]
+                    [char (send text get-character pos)]
+                    [left? (memq char '(#\( #\{ #\[))]
+                    [right? (memq char '(#\) #\} #\]))])
+               (when (or left? right?)
+                 (let* ([other-pos (if left?
+                                       (send text get-forward-sexp pos)
+                                       (send text get-backward-sexp (+ pos 1)))])
+                   (when other-pos
+                     (let ([left-pos (min pos other-pos)]
+                           [right-pos (max pos other-pos)])
+                       (instantiate separator-menu-item% ()
+                         (parent menu))
+                       (instantiate menu-item% ()
+                         (parent menu)
+                         (label "Collapse sexp")
+                         (callback (lambda (item evt) 
+                                     (collapse-from text left-pos right-pos)))))))))))))
+      
+      (define (collapse-from text left-pos right-pos)
+        (send text begin-edit-sequence)
+        (send text delete left-pos right-pos)
+        (send text insert (make-object sexp-snip%) left-pos left-pos)
+        (send text end-edit-sequence))
       
       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
       ;;                                                                  ;;
diff --git a/collects/framework/private/text.ss b/collects/framework/private/text.ss
index c41bfb43..c31b47b3 100644
--- a/collects/framework/private/text.ss
+++ b/collects/framework/private/text.ss
@@ -1,3 +1,4 @@
+
 (module text mzscheme
   (require (lib "string-constant.ss" "string-constants")
            (lib "unitsig.ss")