add #:newline? argument to pretty-printing functions

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
+line length. Whenever the pretty-printer starts a new line,
-value has been printed with @racket[#f] as the line number and with the
+@racket[proc] is called with the new line's number (where the first
-length of the last line. Whenever the pretty-printer starts a new
+new line is numbered @racket[1]) and the just-finished line's length.
-line, @racket[proc] is called with the new line's number (where the
+The destination-columns argument to @racket[proc] is always
-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

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
 

racket/collects/racket/pretty.rkt

@@ -209,19 +209,20 @@
 (define make-pretty-print
   (lambda (name display? as-qq?)
     (letrec ([pretty-print
-              (case-lambda 
+              (lambda (obj [port (current-output-port)] [qq-depth 0] #:newline? [newline? #t])
-               [(obj port qq-depth)
                 (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
@@ -234,20 +235,16 @@
                                  (pretty-print-depth)
                                  (lambda (o display?)
                                    (size-hook o display? port)))
-                  (void))]
+                  (void)))])
-               [(obj port) (pretty-print obj port 0)]
-               [(obj) (pretty-print obj (current-output-port))])])
       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
+                         (lambda (v [o (current-output-port)] #:newline? [n? #t])
-                          [(v) (pp v)]
+                           (pp v o #:newline? n?))))
-                          [(v o) (pp v o)])))
 (define pretty-write   (let ([pp (make-pretty-print 'pretty-write #f #f)])
-                       (case-lambda
+                         (lambda (v [o (current-output-port)] #:newline? [n? #t])
-                        [(v) (pp v)]
+                           (pp v o #:newline? n?))))
-                        [(v o) (pp v o)])))
 
 (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))))
+  (when newline?
     (let-values ([(l col p) (port-next-location pport)])
-    ((printing-port-print-line pport) #f col width)))
+      ((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)])
+         [else (raise-argument-error 'pretty-format "(or/c 'print 'write 'display)" mode)])
-       t op)
+       t op #:newline? #f)
-      (let ([s (get-output-string op)])
+      (get-output-string op))))
-        (if (eq? w 'infinity)
-            s
-            (substring s 0 (- (string-length s) 1)))))))