suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

add #:newline? argument to pretty-printing functions

Browse Source
This commit is contained in:
AlexKnauth 2016-08-10 07:20:21 -05:00 committed by Robby Findler
parent 1af7ec7088
commit 1b1b400f91
3 changed files with 79 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
pkgs/racket-doc/scribblings/reference/pretty-print.scrbl
View File

@ -6,14 +6,16 @@
@note-lib[racket/pretty]
@defproc[(pretty-print [v any/c] [port output-port? (current-output-port)]
[quote-depth (or/c 0 1) 0])
[quote-depth (or/c 0 1) 0]
[#:newline? newline? boolean? #t])
void?]{
Pretty-prints the value @racket[v] using the same printed form as the
default @racket[print] mode, but with newlines and whitespace inserted
to avoid lines longer than @racket[(pretty-print-columns)], as
controlled by @racket[(pretty-print-current-style-table)]. The printed
form ends in a newline, unless the @racket[pretty-print-columns]
form ends in a newline by default, unless the @racket[newline?]
argument is supplied with false or the @racket[pretty-print-columns]
parameter is set to @racket['infinity]. When @racket[port] has line
counting enabled (see @secref["linecol"]), then printing is sensitive
to the column when printing starts---both for determining an initial
@ -39,15 +41,24 @@ to determine the target printing width, and use
function in the @racket[pretty-print-print-line] parameter can be
called appropriately). Use
@racket[make-tentative-pretty-print-output-port] to obtain a port for
tentative recursive prints (e.g., to check the length of the output).}
tentative recursive prints (e.g., to check the length of the output).
@defproc[(pretty-write [v any/c] [port output-port? (current-output-port)])
If the @racket[newline?] argument is ommitted or supplied with true,
the @racket[pretty-print-print-line] callback is called with false as
the first argument to print the last newline after the printed value.
If it is supplied with false, the @racket[pretty-print-print-line]
callback is not called after the printed value.
}
@defproc[(pretty-write [v any/c] [port output-port? (current-output-port)]
[#:newline? newline? boolean? #t])
void?]{
Same as @racket[pretty-print], but @racket[v] is printed like
@racket[write] instead of like @racket[print].}
@defproc[(pretty-display [v any/c] [port output-port? (current-output-port)])
@defproc[(pretty-display [v any/c] [port output-port? (current-output-port)]
[#:newline? newline? boolean? #t])
void?]{
Same as @racket[pretty-print], but @racket[v] is printed like
@ -243,15 +254,18 @@ beginning of the new line.
The @racket[proc] procedure is called before any characters are
printed with @racket[0] as the line number and @racket[0] as the old
line length; @racket[proc] is called after the last character of a
value has been printed with @racket[#f] as the line number and with the
length of the last line. Whenever the pretty-printer starts a new
line, @racket[proc] is called with the new line's number (where the
first new line is numbered @racket[1]) and the just-finished line's
length. The destination-columns argument to @racket[proc] is always
line length. Whenever the pretty-printer starts a new line,
@racket[proc] is called with the new line's number (where the first
new line is numbered @racket[1]) and the just-finished line's length.
The destination-columns argument to @racket[proc] is always
the total width of the destination printing area, or
@racket['infinity] if pretty-printed values are not broken into lines.
If the @racket[#:newline?] argument was ommitted or supplied with
true, @racket[proc] is also called after the last character of the
value has been printed, with @racket[#f] as the line number and with
the length of the last line.
The default @racket[proc] procedure prints a newline whenever the line
number is not @racket[0] and the column count is not
@racket['infinity], always returning @racket[0]. A custom

36
pkgs/racket-test-core/tests/racket/pretty.rktl
View File

@ -475,6 +475,42 @@
(test "#true" pretty-format #t)
(test "#false" pretty-format #f))
;; ----------------------------------------
;; check that pretty-print follows the
;; #:newline? argument
;; no #:newline? argument, tests the default
(let ([p (open-output-string)])
(parameterize ([current-output-port p]
[pretty-print-columns 40])
(pretty-print '(define (f xs)
(for/list ([x (in-list xs)])
(+ x 1)))))
(test "'(define (f xs)\n (for/list\n ((x (in-list xs)))\n (+ x 1)))\n"
get-output-string p))
;; #:newline? #t, same as the default
(let ([p (open-output-string)])
(parameterize ([current-output-port p]
[pretty-print-columns 40])
(pretty-print '(define (f xs)
(for/list ([x (in-list xs)])
(+ x 1)))
#:newline? #t))
(test "'(define (f xs)\n (for/list\n ((x (in-list xs)))\n (+ x 1)))\n"
get-output-string p))
;; #:newline? #f
(let ([p (open-output-string)])
(parameterize ([current-output-port p]
[pretty-print-columns 40])
(pretty-print '(define (f xs)
(for/list ([x (in-list xs)])
(+ x 1)))
#:newline? #f))
(test "'(define (f xs)\n (for/list\n ((x (in-list xs)))\n (+ x 1)))"
get-output-string p))
;; ----------------------------------------
;; check that an all-powerful inspector doesn't break the pretty printer internally

41
racket/collects/racket/pretty.rkt
View File

@ -209,19 +209,20 @@
(define make-pretty-print
(lambda (name display? as-qq?)
(letrec ([pretty-print
(case-lambda
[(obj port qq-depth)
(lambda (obj [port (current-output-port)] [qq-depth 0] #:newline? [newline? #t])
(unless (output-port? port)
(raise-argument-error name "output-port?" port))
(unless (or (equal? qq-depth 0)
(equal? qq-depth 1))
(raise-argument-error name "(or/c 0 1)" qq-depth))
(unless (boolean? newline?)
(raise-argument-error name "boolean?" newline?))
(let ([width (pretty-print-columns)]
[size-hook (pretty-print-size-hook)]
[print-hook (pretty-print-print-hook)]
[pre-hook (pretty-print-pre-print-hook)]
[post-hook (pretty-print-post-print-hook)])
(generic-write obj display?
(generic-write obj display? #:newline? newline?
width
(make-printing-port port
pre-hook
@ -229,25 +230,21 @@
print-hook
(pretty-print-print-line))
(print-graph) (print-struct) (print-hash-table)
(and (not display?) (print-vector-length)) (print-box)
(and (not display?) (print-vector-length)) (print-box)
(and (not display?) as-qq? (print-as-expression)) qq-depth
(pretty-print-depth)
(lambda (o display?)
(size-hook o display? port)))
(void))]
[(obj port) (pretty-print obj port 0)]
[(obj) (pretty-print obj (current-output-port))])])
(void)))])
pretty-print)))
(define pretty-print (make-pretty-print 'pretty-print #f #t))
(define pretty-display (let ([pp (make-pretty-print 'pretty-display #t #f)])
(case-lambda
[(v) (pp v)]
[(v o) (pp v o)])))
(define pretty-write (let ([pp (make-pretty-print 'pretty-write #f #f)])
(case-lambda
[(v) (pp v)]
[(v o) (pp v o)])))
(lambda (v [o (current-output-port)] #:newline? [n? #t])
(pp v o #:newline? n?))))
(define pretty-write (let ([pp (make-pretty-print 'pretty-write #f #f)])
(lambda (v [o (current-output-port)] #:newline? [n? #t])
(pp v o #:newline? n?))))
(define-struct mark (str def) #:mutable)
(define-struct hide (val))
@ -417,7 +414,7 @@
(define (generic-write obj display? width pport
print-graph? print-struct? print-hash-table? print-vec-length?
print-box? print-as-qq? qq-depth
depth size-hook)
depth size-hook #:newline? newline?)
(define pair-open (if (print-pair-curly-braces) "{" "("))
(define pair-close (if (print-pair-curly-braces) "}" ")"))
@ -1524,8 +1521,9 @@
(if (and width (not (eq? width 'infinity)))
(pp* pport obj depth display? qd)
(wr* pport obj depth display? qd))))
(let-values ([(l col p) (port-next-location pport)])
((printing-port-print-line pport) #f col width)))
(when newline?
(let-values ([(l col p) (port-next-location pport)])
((printing-port-print-line pport) #f col width))))
(define (look-in-style-table raw-head)
(let ([head (do-remap raw-head)])
@ -1629,12 +1627,9 @@
[(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)))))))
[else (raise-argument-error 'pretty-format "(or/c 'print 'write 'display)" mode)])
t op #:newline? #f)
(get-output-string op))))