added current-pretty-printer

collects/redex/gui.rkt

@@ -97,6 +97,13 @@
  [light-text-color (parameter/c (or/c string? (is-a?/c color%)))]
  [initial-font-size (parameter/c number?)]
  [initial-char-width (parameter/c (or/c number? (-> any/c number?)))])
-         
-(provide reduction-steps-cutoff
-         default-pretty-printer)
+
+(provide/contract 
+ [reduction-steps-cutoff (parameter/c exact-nonnegative-integer?)]
+ [default-pretty-printer
+   (-> any/c output-port? exact-nonnegative-integer? (is-a?/c text%) 
+       void?)]
+ [current-pretty-printer
+  (parameter/c 
+   (-> any/c output-port? exact-nonnegative-integer? (is-a?/c text%) 
+       void?))])

collects/redex/private/size-snip.rkt

@@ -9,6 +9,7 @@
          size-editor-snip%
          size-text%
          default-pretty-printer
+         current-pretty-printer
          initial-char-width
          resizing-pasteboard-mixin
          get-user-char-width)
@@ -38,6 +39,8 @@
                        (display ",'hole" op)]))])
     (pretty-print v port)))
 
+(define current-pretty-printer (make-parameter default-pretty-printer))
+
 (define reflowing-snip<%>
   (interface ()
     reflow-program))

collects/redex/private/stepper.rkt

@@ -50,10 +50,10 @@ todo:
   (define updown-label (pick-label "↕" "^"))
   (define back-label (pick-label "↩" "<-"))
   
-  (define (stepper red term [pp default-pretty-printer])
+  (define (stepper red term [pp (current-pretty-printer)])
     (stepper/seed red (list term) pp))
   
-  (define (stepper/seed red seed [pp default-pretty-printer])
+  (define (stepper/seed red seed [pp (current-pretty-printer)])
     (define term (car seed))
     ;; all-nodes-ht : hash[sexp -o> (is-a/c node%)]
     (define all-nodes-ht (make-hash))

collects/redex/private/traces.rkt

@@ -130,7 +130,7 @@
 (define (traces/ps reductions pre-exprs filename
                    #:multiple? [multiple? #f] 
                    #:pred [pred (λ (x) #t)] 
-                   #:pp [pp default-pretty-printer] 
+                   #:pp [pp (current-pretty-printer)] 
                    #:racket-colors? [racket-colors? #t]
                    #:scheme-colors? [scheme-colors? racket-colors?]
                    #:colors [colors '()]
@@ -241,7 +241,7 @@
 (define (traces reductions pre-exprs 
                 #:multiple? [multiple? #f] 
                 #:pred [pred (λ (x) #t)] 
-                #:pp [pp default-pretty-printer] 
+                #:pp [pp (current-pretty-printer)] 
                 #:colors [colors '()]
                 #:racket-colors? [racket-colors? #t]
                 #:scheme-colors? [scheme-colors? racket-colors?]

collects/redex/redex.scrbl

@@ -1458,7 +1458,7 @@ exploring reduction sequences.
                  [#:pp pp
                        (or/c (any -> string)
                              (any output-port number (is-a?/c text%) -> void))
-                       default-pretty-printer]
+                       (current-pretty-printer)]
                  [#:colors colors 
                   (listof 
                    (cons/c string? 
@@ -1577,7 +1577,7 @@ inserted into the editor by this library have a
                     [#:pp pp
                           (or/c (any -> string)
                                 (any output-port number (is-a?/c text%) -> void))
-                          default-pretty-printer]
+                          (current-pretty-printer)]
                     [#:colors colors 
                               (listof 
                                (cons/c string?
@@ -1607,7 +1607,7 @@ just before the PostScript is created with the graph pasteboard.
                   [t any/c] 
                   [pp (or/c (any -> string)
                             (any output-port number (is-a?/c text%) -> void))
-                      default-pretty-printer])
+                      (current-pretty-printer)])
           void?]{
 
 This function opens a stepper window for exploring the
@@ -1622,7 +1622,7 @@ The @racket[pp] argument is the same as to the
                        [seed (cons/c any/c (listof any/c))]
                        [pp (or/c (any -> string)
                                  (any output-port number (is-a?/c text%) -> void))
-                           default-pretty-printer])
+                           (current-pretty-printer)])
          void?]{
 
 Like @racket[stepper], this function opens a stepper window, but it
@@ -1748,7 +1748,16 @@ the color used to fill the arrowhead and the text colors control the
 color used to draw the label on the edge.
 }
 
-@defproc[(default-pretty-printer [v any] [port output-port] [width number] [text (is-a?/c text%)]) void?]{
+@defparam[current-pretty-printer pp (-> any/c
+                                        output-port?
+                                        exact-nonnegative-integer?
+                                        (is-a?/c text%)
+                                        void?)]{
+  A parameter that is used by the graphics tools to render
+  expressions. Defaults to @racket[default-pretty-printer].
+}
+                                                                       
+@defproc[(default-pretty-printer [v any/c] [port output-port?] [width exact-nonnegative-integer?] [text (is-a?/c text%)]) void?]{
 
 This is the default value of @racket[pp] used by @racket[traces] and
 @racket[stepper] and it uses