added pretty-print-parameters to control how pretty printing happens for terms

This commit is contained in:
Robby Findler 2010-09-26 16:37:47 -05:00
parent 827679e9db
commit f87aa7ec61
4 changed files with 55 additions and 31 deletions

View File

@ -103,6 +103,7 @@
[default-pretty-printer [default-pretty-printer
(-> any/c output-port? exact-nonnegative-integer? (is-a?/c text%) (-> any/c output-port? exact-nonnegative-integer? (is-a?/c text%)
void?)] void?)]
[pretty-print-parameters (parameter/c (-> (-> any) any))]
[current-pretty-printer [current-pretty-printer
(parameter/c (parameter/c
(-> any/c output-port? exact-nonnegative-integer? (is-a?/c text%) (-> any/c output-port? exact-nonnegative-integer? (is-a?/c text%)

View File

@ -4,7 +4,8 @@
mrlib/graph mrlib/graph
scheme/pretty scheme/pretty
scheme/class scheme/class
framework) framework
"size-snip.rkt")
(provide show-differences find-differences) (provide show-differences find-differences)
@ -90,8 +91,10 @@
;; render-sexp/colors : sexp ht text -> void ;; render-sexp/colors : sexp ht text -> void
(define (render-sexp/colors sexp to-color text columns) (define (render-sexp/colors sexp to-color text columns)
(let ([start '()]) (let ([start '()])
((pretty-print-parameters)
(λ ()
(parameterize ([pretty-print-columns columns]) (parameterize ([pretty-print-columns columns])
(pretty-print sexp (open-output-text-editor text))) (pretty-print sexp (open-output-text-editor text)))))
(for-each (for-each
(λ (p) (send text highlight-range (car p) (cdr p) (send the-color-database find-color "NavajoWhite"))) (λ (p) (send text highlight-range (car p) (cdr p) (send the-color-database find-color "NavajoWhite")))
to-color) to-color)
@ -121,6 +124,8 @@
(set! pending-bytes (bytes)))) (set! pending-bytes (bytes))))
1])) 1]))
void)]) void)])
((pretty-print-parameters)
(λ ()
(parameterize ([pretty-print-columns columns] (parameterize ([pretty-print-columns columns]
[pretty-print-remap-stylable [pretty-print-remap-stylable
(λ (val) (λ (val)
@ -146,7 +151,7 @@
(flush-output port) (flush-output port)
(set! to-color (cons (cons (car start) position) to-color)) (set! to-color (cons (cons (car start) position) to-color))
(set! start (cdr start))))]) (set! start (cdr start))))])
(pretty-print sexp counting-port)) (pretty-print sexp counting-port))))
to-color)) to-color))
;; does a map-like operation, but if the list is dotted, flattens the results into an actual list. ;; does a map-like operation, but if the list is dotted, flattens the results into an actual list.

View File

@ -10,6 +10,7 @@
size-text% size-text%
default-pretty-printer default-pretty-printer
current-pretty-printer current-pretty-printer
pretty-print-parameters
initial-char-width initial-char-width
resizing-pasteboard-mixin resizing-pasteboard-mixin
get-user-char-width) get-user-char-width)
@ -22,6 +23,8 @@
[(number? cw/proc) cw/proc] [(number? cw/proc) cw/proc]
[else (cw/proc expr)])) [else (cw/proc expr)]))
(define pretty-print-parameters (make-parameter (λ (thunk) (thunk))))
(define (default-pretty-printer v port w spec) (define (default-pretty-printer v port w spec)
(parameterize ([pretty-print-columns w] (parameterize ([pretty-print-columns w]
[pretty-print-size-hook [pretty-print-size-hook
@ -37,7 +40,9 @@
(display "hole" op)] (display "hole" op)]
[(eq? val 'hole) [(eq? val 'hole)
(display ",'hole" op)]))]) (display ",'hole" op)]))])
(pretty-print v port))) ((pretty-print-parameters)
(λ ()
(pretty-print v port)))))
(define current-pretty-printer (make-parameter default-pretty-printer)) (define current-pretty-printer (make-parameter default-pretty-printer))

View File

@ -1748,6 +1748,17 @@ the color used to fill the arrowhead and the text colors control the
color used to draw the label on the edge. color used to draw the label on the edge.
} }
@defparam[pretty-print-parameters f (-> (-> any/c) any/c)]{
A parameter that is used to set other @racket[pretty-print]
parameters.
Specifically, whenever @racket[default-pretty-printer] prints
something it calls @racket[f] with a thunk that does the actual
printing. Thus, @racket[f] can adjust @racket[pretty-print]'s
parameters to adjust how printing happens.
}
@defparam[current-pretty-printer pp (-> any/c @defparam[current-pretty-printer pp (-> any/c
output-port? output-port?
exact-nonnegative-integer? exact-nonnegative-integer?
@ -1763,6 +1774,8 @@ This is the default value of @racket[pp] used by @racket[traces] and
@racket[stepper] and it uses @racket[stepper] and it uses
@racket[pretty-print]. @racket[pretty-print].
This function uses the value of @racket[pretty-print-parameters] to adjust how it prints.
It sets the @racket[pretty-print-columns] parameter to It sets the @racket[pretty-print-columns] parameter to
@racket[width], and it sets @racket[pretty-print-size-hook] @racket[width], and it sets @racket[pretty-print-size-hook]
and @racket[pretty-print-print-hook] to print holes and the and @racket[pretty-print-print-hook] to print holes and the