Add a mode argument to pretty-format.

... which controls whether it uses `print`, `write` or `display`.

Obsoletes most of `unstable/pretty`.
This commit is contained in:
Vincent St-Amour 2015-09-07 15:27:45 -05:00
parent 3963f30070
commit d705e928ac
3 changed files with 51 additions and 14 deletions

View File

@ -54,14 +54,21 @@ Same as @racket[pretty-print], but @racket[v] is printed like
@racket[display] instead of like @racket[print].}
@defproc[(pretty-format [v any/c] [columns exact-nonnegative-integer? (pretty-print-columns)])
@defproc[(pretty-format [v any/c] [columns exact-nonnegative-integer? (pretty-print-columns)]
[#:mode mode (or/c 'print 'write 'display) 'print])
string?]{
Like @racket[pretty-print], except that it returns a string containing
the pretty-printed value, rather than sending the output to a port.
The optional argument @racket[columns] argument is used to
parameterize @racket[pretty-print-columns].}
parameterize @racket[pretty-print-columns].
The keyword argument @racket[mode] controls whether printing is done like
either @racket[pretty-print] (the default), @racket[pretty-write] or
@racket[pretty-display].
@history[#:changed "6.2.900.15" @elem{Added a @racket[mode] argument.}]}
@defproc[(pretty-print-handler [v any/c]) void?]{

View File

@ -425,7 +425,35 @@
'(1 2 3 4 5)))])
(try-print pretty-print val 10 "(list\n (DUO\n '(a\n b\n c\n d\n e)\n '(1\n 2\n 3\n 4\n 5)))\n")
(try-print pretty-write val 10 "((DUO\n (a\n b\n c\n d\n e)\n (1\n 2\n 3\n 4\n 5)))\n")
(try-print pretty-display val 10 "((DUO\n (a\n b\n c\n d\n e)\n (1\n 2\n 3\n 4\n 5)))\n"))))
(try-print pretty-display val 10 "((DUO\n (a\n b\n c\n d\n e)\n (1\n 2\n 3\n 4\n 5)))\n")))
(test "(DUO 1 2)"
pretty-format (duo 1 2) 40 #:mode 'print)
(test "(DUO 1 2)"
pretty-format (duo 1 2) 40 #:mode 'write)
(test "(DUO 1 2)"
pretty-format (duo 1 2) 40 #:mode 'display)
(test "(DUO \"a\" 'b)"
pretty-format (duo "a" 'b) #:mode 'print 40)
(test "(DUO \"a\" b)"
pretty-format (duo "a" 'b) #:mode 'write 40)
(test "(DUO a b)"
pretty-format (duo "a" 'b) #:mode 'display 40)
(test "(DUO\n \"abcdefghijklmno\"\n 'b)"
pretty-format (duo "abcdefghijklmno" 'b) 20 #:mode 'print)
(test "(DUO\n \"abcdefghijklmno\"\n b)"
pretty-format (duo "abcdefghijklmno" 'b) 20 #:mode 'write)
(test "(DUO\n abcdefghijklmno\n b)"
pretty-format (duo "abcdefghijklmno" 'b) 20 #:mode 'display)
(test "(list\n (DUO\n \"abcdefghijklmno\"\n 'b))"
pretty-format (list (duo "abcdefghijklmno" 'b)) 20 #:mode 'print)
(test "((DUO\n \"abcdefghijklmno\"\n b))"
pretty-format (list (duo "abcdefghijklmno" 'b)) 20 #:mode 'write)
(test "((DUO\n abcdefghijklmno\n b))"
pretty-format (list (duo "abcdefghijklmno" 'b)) 20 #:mode 'display))
;; ----------------------------------------

View File

@ -1622,17 +1622,19 @@
;; Print as a fraction.
(number->string x)))))))]))
(define pretty-format
(case-lambda
[(t) (pretty-format t (pretty-print-columns))]
[(t w)
(define (pretty-format t [w (pretty-print-columns)] #:mode [mode 'print])
(parameterize ([pretty-print-columns w])
(let ([op (open-output-string)])
(pretty-print t op)
((case mode
[(print) pretty-print]
[(write) pretty-write]
[(display) pretty-display]
[else (raise-argument-error 'pretty-format "(or/c 'print 'write display)" mode)])
t op)
(let ([s (get-output-string op)])
(if (eq? w 'infinity)
s
(substring s 0 (- (string-length s) 1))))))]))
(substring s 0 (- (string-length s) 1)))))))
)