From 1b1b400f91484e1c82b5a5164fc908fc37ace95e Mon Sep 17 00:00:00 2001 From: AlexKnauth Date: Wed, 10 Aug 2016 07:20:21 -0500 Subject: [PATCH] add #:newline? argument to pretty-printing functions --- .../scribblings/reference/pretty-print.scrbl | 36 +++++++++++----- .../racket-test-core/tests/racket/pretty.rktl | 36 ++++++++++++++++ racket/collects/racket/pretty.rkt | 41 ++++++++----------- 3 files changed, 79 insertions(+), 34 deletions(-) diff --git a/pkgs/racket-doc/scribblings/reference/pretty-print.scrbl b/pkgs/racket-doc/scribblings/reference/pretty-print.scrbl index 4b557d49e1..df69bb527b 100644 --- a/pkgs/racket-doc/scribblings/reference/pretty-print.scrbl +++ b/pkgs/racket-doc/scribblings/reference/pretty-print.scrbl @@ -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 diff --git a/pkgs/racket-test-core/tests/racket/pretty.rktl b/pkgs/racket-test-core/tests/racket/pretty.rktl index 327c4a0b58..e991e47b65 100644 --- a/pkgs/racket-test-core/tests/racket/pretty.rktl +++ b/pkgs/racket-test-core/tests/racket/pretty.rktl @@ -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 diff --git a/racket/collects/racket/pretty.rkt b/racket/collects/racket/pretty.rkt index 9a03447055..850f509453 100644 --- a/racket/collects/racket/pretty.rkt +++ b/racket/collects/racket/pretty.rkt @@ -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))))