added pretty-print-parameters to control how pretty printing happens for terms
This commit is contained in:
Robby Findler
parent
827679e9db
commit
f87aa7ec61
|
|
@ -103,6 +103,7 @@
|
|||
[default-pretty-printer
|
||||
(-> any/c output-port? exact-nonnegative-integer? (is-a?/c text%)
|
||||
void?)]
|
||||
[pretty-print-parameters (parameter/c (-> (-> any) any))]
|
||||
[current-pretty-printer
|
||||
(parameter/c
|
||||
(-> any/c output-port? exact-nonnegative-integer? (is-a?/c text%)
|
||||
|
|
|
|||
|
|
@ -4,7 +4,8 @@
|
|||
mrlib/graph
|
||||
scheme/pretty
|
||||
scheme/class
|
||||
framework)
|
||||
framework
|
||||
"size-snip.rkt")
|
||||
|
||||
(provide show-differences find-differences)
|
||||
|
||||
|
|
@ -90,8 +91,10 @@
|
|||
;; render-sexp/colors : sexp ht text -> void
|
||||
(define (render-sexp/colors sexp to-color text columns)
|
||||
(let ([start '()])
|
||||
(parameterize ([pretty-print-columns columns])
|
||||
(pretty-print sexp (open-output-text-editor text)))
|
||||
((pretty-print-parameters)
|
||||
(λ ()
|
||||
(parameterize ([pretty-print-columns columns])
|
||||
(pretty-print sexp (open-output-text-editor text)))))
|
||||
(for-each
|
||||
(λ (p) (send text highlight-range (car p) (cdr p) (send the-color-database find-color "NavajoWhite")))
|
||||
to-color)
|
||||
|
|
@ -121,32 +124,34 @@
|
|||
(set! pending-bytes (bytes))))
|
||||
1]))
|
||||
void)])
|
||||
(parameterize ([pretty-print-columns columns]
|
||||
[pretty-print-remap-stylable
|
||||
(λ (val)
|
||||
(and (wrap? val)
|
||||
(symbol? (wrap-content val))
|
||||
(wrap-content val)))]
|
||||
[pretty-print-size-hook
|
||||
(λ (val dsp? port)
|
||||
(if (wrap? val)
|
||||
(string-length (format "~s" (wrap-content val)))
|
||||
#f))]
|
||||
[pretty-print-print-hook
|
||||
(λ (val dsp? port)
|
||||
(write (wrap-content val) port))]
|
||||
[pretty-print-pre-print-hook
|
||||
(λ (obj port)
|
||||
(when (hash-ref diff-ht obj #f)
|
||||
(flush-output port)
|
||||
(set! start (cons position start))))]
|
||||
[pretty-print-post-print-hook
|
||||
(λ (obj port)
|
||||
(when (hash-ref diff-ht obj #f)
|
||||
(flush-output port)
|
||||
(set! to-color (cons (cons (car start) position) to-color))
|
||||
(set! start (cdr start))))])
|
||||
(pretty-print sexp counting-port))
|
||||
((pretty-print-parameters)
|
||||
(λ ()
|
||||
(parameterize ([pretty-print-columns columns]
|
||||
[pretty-print-remap-stylable
|
||||
(λ (val)
|
||||
(and (wrap? val)
|
||||
(symbol? (wrap-content val))
|
||||
(wrap-content val)))]
|
||||
[pretty-print-size-hook
|
||||
(λ (val dsp? port)
|
||||
(if (wrap? val)
|
||||
(string-length (format "~s" (wrap-content val)))
|
||||
#f))]
|
||||
[pretty-print-print-hook
|
||||
(λ (val dsp? port)
|
||||
(write (wrap-content val) port))]
|
||||
[pretty-print-pre-print-hook
|
||||
(λ (obj port)
|
||||
(when (hash-ref diff-ht obj #f)
|
||||
(flush-output port)
|
||||
(set! start (cons position start))))]
|
||||
[pretty-print-post-print-hook
|
||||
(λ (obj port)
|
||||
(when (hash-ref diff-ht obj #f)
|
||||
(flush-output port)
|
||||
(set! to-color (cons (cons (car start) position) to-color))
|
||||
(set! start (cdr start))))])
|
||||
(pretty-print sexp counting-port))))
|
||||
to-color))
|
||||
|
||||
;; does a map-like operation, but if the list is dotted, flattens the results into an actual list.
|
||||
|
|
|
|||
|
|
@ -10,6 +10,7 @@
|
|||
size-text%
|
||||
default-pretty-printer
|
||||
current-pretty-printer
|
||||
pretty-print-parameters
|
||||
initial-char-width
|
||||
resizing-pasteboard-mixin
|
||||
get-user-char-width)
|
||||
|
|
@ -22,6 +23,8 @@
|
|||
[(number? cw/proc) cw/proc]
|
||||
[else (cw/proc expr)]))
|
||||
|
||||
(define pretty-print-parameters (make-parameter (λ (thunk) (thunk))))
|
||||
|
||||
(define (default-pretty-printer v port w spec)
|
||||
(parameterize ([pretty-print-columns w]
|
||||
[pretty-print-size-hook
|
||||
|
|
@ -37,7 +40,9 @@
|
|||
(display "hole" op)]
|
||||
[(eq? val 'hole)
|
||||
(display ",'hole" op)]))])
|
||||
(pretty-print v port)))
|
||||
((pretty-print-parameters)
|
||||
(λ ()
|
||||
(pretty-print v port)))))
|
||||
|
||||
(define current-pretty-printer (make-parameter default-pretty-printer))
|
||||
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
}
|
||||
|
||||
@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
|
||||
output-port?
|
||||
exact-nonnegative-integer?
|
||||
|
|
@ -1761,7 +1772,9 @@ color used to draw the label on the edge.
|
|||
|
||||
This is the default value of @racket[pp] used by @racket[traces] and
|
||||
@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
|
||||
@racket[width], and it sets @racket[pretty-print-size-hook]
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user