.

original commit: ba22fdb97715e737cc3de9f6b2d42ee6ff8e142c

collects/framework/private/text.ss

@@ -13,6 +13,7 @@ WARNING: printf is rebound in the body of the unit to always
 	   "sig.ss"
 	   "../gui-utils.ss"
 	   (lib "mred-sig.ss" "mred")
+           (lib "interactive-value-port.ss" "mrlib")
 	   (lib "list.ss")
 	   (lib "etc.ss"))
   (provide text@)
@@ -1043,7 +1044,7 @@ WARNING: printf is rebound in the body of the unit to always
             (unless err-port (error 'get-err-port "not ready"))
             err-port)
           (define/public-final (get-value-port)
-            (unless err-port (error 'get-value-port "not ready"))
+            (unless value-port (error 'get-value-port "not ready"))
             value-port)
 
           ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -1375,7 +1376,15 @@ WARNING: printf is rebound in the body of the unit to always
                                                  always-evt
                                                  (make-write-bytes-proc value-style)
                                                  out-close-proc
-                                                 (make-write-special-proc value-style)))))
+                                                 (make-write-special-proc value-style)))
+              (let ([install-handlers
+                     (λ (port)
+                       (set-interactive-print-handler port)
+                       (set-interactive-write-handler port)
+                       (set-interactive-display-handler port))])
+                (install-handlers out-port)
+                (install-handlers err-port)
+                (install-handlers value-port))))
 
           ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
           ;;

collects/mrlib/interactive-value-port.ss

@@ -0,0 +1,73 @@
+
+(module interactive-value-port mzscheme
+  (require (lib "pretty.ss")
+           (lib "mred.ss" "mred")
+           (lib "class.ss")
+           "syntax-browser.ss")
+  (provide set-interactive-display-handler
+           set-interactive-write-handler
+           set-interactive-print-handler)
+  
+  (define pp-parameters
+    (parameterize ([pretty-print-columns 'infinity]
+                   [pretty-print-size-hook
+                    (λ (value display? port)
+                      (cond
+                        [(is-a? value snip%) 1]
+                        ;[(use-number-snip? value) 1]
+                        [(syntax? value) 1]
+                        [else #f]))]
+                   [pretty-print-print-hook
+                    (λ (value display? port)
+                      (cond
+                        [(is-a? value snip%)
+                         (write-special value port)
+                         1]
+                        #;
+                        [(use-number-snip? value)
+                         (write-special
+                          (number-snip:make-repeating-decimal-snip value #f)
+                          port)
+                         1]
+                        [(syntax? value)
+                         (write-special (render-syntax/snip value))]
+                        [else (void)]))])
+      (current-parameterization)))
+
+  (define op (current-output-port))
+  (define (oprintf . x) (apply fprintf op x))
+  
+  (define (set-interactive-display-handler port)
+    (let ([original-port-display-handler (port-display-handler port)])
+      (port-display-handler
+       port
+       (λ (val port)
+         (cond
+           [(string? val) (original-port-display-handler val port)]
+           [else
+            (do-printing pretty-display val port)])))))
+  
+  (define (set-interactive-write-handler port)
+    (port-write-handler
+     port
+     (λ (val port)
+       (do-printing pretty-print val port))))
+  
+  (define (set-interactive-print-handler port)
+    (port-print-handler
+     port
+     (λ (val port)
+       (do-printing pretty-print val port))))
+            
+  (define (use-number-snip? x)
+    (and #f
+         (number? x)
+         (exact? x)
+         (real? x)
+         (not (integer? x))))
+  
+  (define (do-printing pretty value port)
+    (call-with-parameterization 
+     pp-parameters
+     (λ ()
+       (pretty value port)))))

collects/mrlib/syntax-browser.ss

@@ -15,7 +15,7 @@ needed to really make this work:
            (lib "match.ss")
            (lib "string.ss"))
   
-  (provide render-syntax/snip render-syntax/window)
+  (provide render-syntax/snip render-syntax/window snip-class)
   
   (define (render-syntax/window syntax)
     (let ([es (render-syntax/snip syntax)])
@@ -37,10 +37,10 @@ needed to really make this work:
           (make-object syntax-snip% (unmarshall-syntax (read-from-string (bytes->string/utf-8 str))))))
       (super-instantiate ())))
   
-  (define syntax-snipclass (make-object syntax-snipclass%))
-  (send syntax-snipclass set-version 1)
-  (send syntax-snipclass set-classname "drscheme:syntax-snipclass%")
-  (send (get-the-snip-class-list) add syntax-snipclass)
+  (define snip-class (make-object syntax-snipclass%))
+  (send snip-class set-version 1)
+  (send snip-class set-classname (format "~s" '(lib "syntax-browser.ss" "mrlib")))
+  (send (get-the-snip-class-list) add snip-class)
   
   (define-struct range (obj start end))
 
@@ -339,7 +339,7 @@ needed to really make this work:
       (hide-details)
       
       (inherit set-snipclass)
-      (set-snipclass syntax-snipclass)))
+      (set-snipclass snip-class)))
   
   (define black-style-delta (make-object style-delta% 'change-normal-color))
   (define green-style-delta (make-object style-delta%))