diff --git a/collects/redex/gui.rkt b/collects/redex/gui.rkt index 5f549ac329..75e02d80ea 100644 --- a/collects/redex/gui.rkt +++ b/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?))]) diff --git a/collects/redex/private/size-snip.rkt b/collects/redex/private/size-snip.rkt index a58250a513..f0a7bc9851 100644 --- a/collects/redex/private/size-snip.rkt +++ b/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)) diff --git a/collects/redex/private/stepper.rkt b/collects/redex/private/stepper.rkt index 1775d6b1c7..ddc628e8d7 100644 --- a/collects/redex/private/stepper.rkt +++ b/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)) diff --git a/collects/redex/private/traces.rkt b/collects/redex/private/traces.rkt index 912e8f7eeb..98812a45c7 100644 --- a/collects/redex/private/traces.rkt +++ b/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?] diff --git a/collects/redex/redex.scrbl b/collects/redex/redex.scrbl index 7788775cd0..0050387f20 100644 --- a/collects/redex/redex.scrbl +++ b/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