fixed some repl-printing related bugs that would make 'write' sensitive to pretty-print's parameters in drscheme's repl

svn: r18321

collects/drscheme/private/drsig.ss

@@ -283,6 +283,8 @@
    simple-settings->vector
    
    simple-module-based-language-config-panel
+   simple-module-based-language-convert-value
+   setup-printing-parameters
    
    add-snip-value
    setup-setup-values

collects/drscheme/private/language.ss

@@ -349,6 +349,8 @@
        settings
        width)))
   
+  (define default-pretty-print-current-style-table (pretty-print-current-style-table))
+  
   ;; setup-printing-parameters : (-> void) simple-settings number -> void
   (define (setup-printing-parameters thunk settings width)
     (let ([use-number-snip?
@@ -366,6 +368,19 @@
                                                 0)]
                      [pretty-print-pre-print-hook (λ (val port) (void))]
                      [pretty-print-post-print-hook (λ (val port) (void))]
+                     [pretty-print-exact-as-decimal #f]
+                     [pretty-print-depth #f]
+                     [pretty-print-.-symbol-without-bars #f]
+                     [pretty-print-show-inexactness #f]
+                     [pretty-print-abbreviate-read-macros #t]
+                     [pretty-print-current-style-table default-pretty-print-current-style-table]
+                     [pretty-print-remap-stylable (λ (x) #f)]
+                     [pretty-print-print-line
+                      (lambda (line port offset width)
+                        (when (and (number? width)
+                                   (not (eq? 0 line)))
+                          (newline port))
+                        0)]
                           
                      [pretty-print-columns width]
                      [pretty-print-size-hook

collects/drscheme/tool-lib.ss

@@ -26,7 +26,9 @@ all of the names in the tools library, for use defining keybindings
 
 (require/doc drscheme/private/ts scheme/base scribble/manual)
 
-(require/doc (for-label errortrace/errortrace-key))
+(require/doc (for-label errortrace/errortrace-key
+                        scheme/pretty 
+                        mzlib/pconvert))
 
 (define-values/invoke-unit/infer drscheme@)
 (provide-signature-elements drscheme:tool-cm^) ;; provide all of the classes & interfaces
@@ -1397,6 +1399,26 @@ all of the names in the tools library, for use defining keybindings
     @scheme[drscheme:language:create-module-based-stand-alone-executable], except that it creates a launcher instead of a
     stand-alone executable.})
  
+ (proc-doc/names
+  drscheme:language:simple-module-based-language-convert-value
+  (-> any/c drscheme:language:simple-settings? any/c)
+  (value settings)
+  @{Sets the @scheme[constructor-style-printing] and @scheme[show-sharing] 
+    parameters based on @scheme[settings] and sets @scheme[current-print-convert-hook]
+    to ignore snips and then uses @scheme[print-convert] on @scheme[value].
+    
+    Unless, of course, the @scheme[settings] argument has @scheme['write] in
+    the @scheme[simple-settings-printing-style] field, in which case it simply 
+    returns @scheme[value].})
+ 
+ (proc-doc/names
+  drscheme:language:setup-printing-parameters
+  (-> (-> any) drscheme:language:simple-settings? (or/c number? 'infinity) any)
+  (thunk settings width)
+  @{Sets all of the @scheme[pretty-print] and @scheme[print-convert] parameters
+    either to the defaults to values based on @scheme[settings]
+    and then invokes @scheme[thunk], returning what it returns.})
+ 
  (proc-doc/names
   drscheme:language:text/pos-text
   (drscheme:language:text/pos? . -> . (is-a?/c text%))

collects/lang/htdp-langs.ss

@@ -184,16 +184,31 @@
               (thunk)))
           
           (define/override (render-value/format value settings port width)
-            (set-printing-parameters
+            (teaching-language-render-value/format value settings port width))
-             settings
-             (lambda ()
-               (super render-value/format value settings port width))))
-          
           (define/override (render-value value settings port)
+            (teaching-language-render-value/format value settings port 'infinity))
+          
+          (define/private (teaching-language-render-value/format value settings port width)
+            ;; set drscheme's printing parameters
+            (drscheme:language:setup-printing-parameters
+             (λ ()
+               ;; then adjust the settings for the teaching languages
                (set-printing-parameters
                 settings
-             (lambda ()
+                (λ () 
-               (super render-value value settings port))))
+                  (let ([converted-value (drscheme:language:simple-module-based-language-convert-value value settings)])
+                    (cond
+                      [(drscheme:language:simple-settings-insert-newlines settings)
+                       (if (number? width)
+                           (parameterize ([pretty-print-columns width])
+                             (pretty-print converted-value port))
+                           (pretty-print converted-value port))]
+                      [else
+                       (parameterize ([pretty-print-columns 'infinity])
+                         (pretty-print converted-value port))
+                       (newline port)])))))
+             settings
+             width))
           
           (super-new)))
       

collects/mrlib/interactive-value-port.ss

@@ -40,8 +40,10 @@
          (real? x)
          (not (integer? x))))
 
+  (define default-pretty-print-current-style-table (pretty-print-current-style-table))
+
   (define (do-printing pretty value port)
-    (parameterize (;; these three handlers aren't used, but are set to override the user's settings
+    (parameterize (;; these handlers aren't used, but are set to override the user's settings
                    [pretty-print-print-line (λ (line-number op old-line dest-columns) 
                                                 (when (and (not (equal? line-number 0))
                                                            (not (equal? dest-columns 'infinity)))
@@ -50,6 +52,19 @@
                    [pretty-print-pre-print-hook (λ (val port) (void))]
                    [pretty-print-post-print-hook (λ (val port) (void))]
                    [pretty-print-columns 'infinity]
+                   [pretty-print-exact-as-decimal #f]
+                   [pretty-print-depth #f]
+                   [pretty-print-.-symbol-without-bars #f]
+                   [pretty-print-show-inexactness #f]
+                   [pretty-print-abbreviate-read-macros #t]
+                   [pretty-print-current-style-table default-pretty-print-current-style-table]
+                   [pretty-print-remap-stylable (λ (x) #f)]
+                   [pretty-print-print-line
+                    (lambda (line port offset width)
+                      (when (and (number? width)
+                                 (not (eq? 0 line)))
+                        (newline port))
+                      0)]
                    
                    [pretty-print-size-hook
                     (λ (value display? port)

collects/tests/drscheme/repl-test.ss

@@ -972,6 +972,21 @@ This produces an ACK message
            void
            void)
    
+   (mktest (format "~s\n~s"
+                   `(require scheme/pretty)
+                   `(parameterize ((pretty-print-exact-as-decimal #t)) (display 1/4)))
+           
+           ("1/4"
+            "1/4"
+            "1/4"
+            "1/4"
+            "1/4"
+            "1/4")
+           'interactions
+           #f
+           void
+           void)
+   
    (mktest
     (string-append
      "(define p (open-output-string))\n"