92 lines
3.6 KiB
Racket
92 lines
3.6 KiB
Racket
(module interactive-value-port mzscheme
|
|
(require mzlib/pretty
|
|
mred
|
|
mzlib/class
|
|
"syntax-browser.rkt")
|
|
(provide set-interactive-display-handler
|
|
set-interactive-write-handler
|
|
set-interactive-print-handler)
|
|
|
|
(define op (current-output-port))
|
|
(define (oprintf . x) (apply fprintf op x))
|
|
|
|
(define (set-interactive-display-handler port)
|
|
(let ([original-port-display-handler (port-display-handler port)])
|
|
(port-display-handler
|
|
port
|
|
(λ (val port)
|
|
(cond
|
|
[(string? val) (original-port-display-handler val port)]
|
|
[else
|
|
(do-printing pretty-display val port)])))))
|
|
|
|
(define (set-interactive-write-handler port)
|
|
(port-write-handler
|
|
port
|
|
(λ (val port)
|
|
(do-printing pretty-print val port))))
|
|
|
|
(define (set-interactive-print-handler port)
|
|
(port-print-handler
|
|
port
|
|
(λ (val port)
|
|
(do-printing pretty-print val port))))
|
|
|
|
(define (use-number-snip? x)
|
|
(and #f
|
|
(number? x)
|
|
(exact? x)
|
|
(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 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)))
|
|
(newline op))
|
|
0)]
|
|
[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)
|
|
(cond
|
|
[(not (port-writes-special? port)) #f]
|
|
[(is-a? value snip%) 1]
|
|
;[(use-number-snip? value) 1]
|
|
[(syntax? value) 1]
|
|
[else #f]))]
|
|
[pretty-print-print-hook
|
|
(λ (value display? port)
|
|
(cond
|
|
[(is-a? value snip%)
|
|
(write-special value port)
|
|
1]
|
|
#;
|
|
[(use-number-snip? value)
|
|
(write-special
|
|
(number-snip:make-repeating-decimal-snip value #f)
|
|
port)
|
|
1]
|
|
[(syntax? value)
|
|
(write-special (render-syntax/snip value))]
|
|
[else (void)]))])
|
|
(pretty value port))))
|