9595145d79
I picked "#<image>" not because I think it is a good way to print, but just so that there is something there to be easily changed later, when someone who has an opinion decides to change it.
73 lines
2.6 KiB
Racket
73 lines
2.6 KiB
Racket
#lang racket/base
|
|
(require mzlib/pconvert
|
|
racket/pretty
|
|
lang/private/set-result
|
|
mrlib/image-core
|
|
racket/snip
|
|
racket/class)
|
|
|
|
(provide configure)
|
|
|
|
(define (configure options)
|
|
;; Set print-convert options:
|
|
(booleans-as-true/false #t)
|
|
(constructor-style-printing #t)
|
|
(abbreviate-cons-as-list (memq 'abbreviate-cons-as-list options))
|
|
(current-print-convert-hook
|
|
(let ([ph (current-print-convert-hook)])
|
|
(lambda (val basic sub)
|
|
(cond
|
|
[(equal? val set!-result) '(void)]
|
|
[(is-image? val) val]
|
|
[else (ph val basic sub)]))))
|
|
(use-named/undefined-handler
|
|
(lambda (x)
|
|
(and (memq 'use-function-output-syntax options)
|
|
(procedure? x)
|
|
(object-name x))))
|
|
(named/undefined-handler
|
|
(lambda (x)
|
|
(string->symbol
|
|
(format "function:~a" (object-name x)))))
|
|
;; Set pretty-print options:
|
|
(pretty-print-show-inexactness #t)
|
|
(pretty-print-exact-as-decimal #t)
|
|
(define img-str "#<image>")
|
|
(define (is-image? val)
|
|
(or (is-a? val image%) ;; 2htdp/image
|
|
(is-a? val image-snip%))) ;; literal image constant
|
|
(show-sharing (memq 'show-sharing options))
|
|
|
|
;; Set print handlers to use print-convert and pretty-write:
|
|
(define (set-handlers thunk)
|
|
(parameterize ([pretty-print-print-hook
|
|
(let ([oh (pretty-print-print-hook)])
|
|
(λ (val display? port)
|
|
(if (and (not (port-writes-special? port))
|
|
(is-image? val))
|
|
(begin (display img-str port)
|
|
(string-length img-str))
|
|
(oh val display? port))))]
|
|
[pretty-print-size-hook
|
|
(let ([oh (pretty-print-size-hook)])
|
|
(λ (val display? port)
|
|
(if (and (not (port-writes-special? port))
|
|
(is-image? val))
|
|
(string-length img-str)
|
|
(oh val display? port))))])
|
|
(thunk)))
|
|
(current-print
|
|
(lambda (v)
|
|
(unless (void? v)
|
|
(define converted (print-convert v))
|
|
(set-handlers
|
|
(λ () (pretty-write converted))))))
|
|
(let ([orig (global-port-print-handler)])
|
|
(global-port-print-handler
|
|
(lambda (val port [depth 0])
|
|
(parameterize ([global-port-print-handler orig])
|
|
(let ([val (print-convert val)])
|
|
(parameterize ([pretty-print-columns 'infinity])
|
|
(set-handlers
|
|
(λ () (pretty-write val port))))))))))
|