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].} @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?]{ string?]{
Like @racket[pretty-print], except that it returns a string containing Like @racket[pretty-print], except that it returns a string containing
the pretty-printed value, rather than sending the output to a port. the pretty-printed value, rather than sending the output to a port.
The optional argument @racket[columns] argument is used to 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?]{ @defproc[(pretty-print-handler [v any/c]) void?]{

View File

@ -425,7 +425,35 @@
'(1 2 3 4 5)))]) '(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-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-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. ;; Print as a fraction.
(number->string x)))))))])) (number->string x)))))))]))
(define pretty-format (define (pretty-format t [w (pretty-print-columns)] #:mode [mode 'print])
(case-lambda (parameterize ([pretty-print-columns w])
[(t) (pretty-format t (pretty-print-columns))] (let ([op (open-output-string)])
[(t w) ((case mode
(parameterize ([pretty-print-columns w]) [(print) pretty-print]
(let ([op (open-output-string)]) [(write) pretty-write]
(pretty-print t op) [(display) pretty-display]
(let ([s (get-output-string op)]) [else (raise-argument-error 'pretty-format "(or/c 'print 'write display)" mode)])
(if (eq? w 'infinity) t op)
s (let ([s (get-output-string op)])
(substring s 0 (- (string-length s) 1))))))])) (if (eq? w 'infinity)
s
(substring s 0 (- (string-length s) 1)))))))
) )