Little patch to make (ice-9 pretty-print) more flexible

[Matthias Koeppe]

Recently I needed some pretty-printing facility, not quite as general
as the Common Lisp one, but a little more flexible than that of (ice-9
pretty-print).  In fact, almost everything I needed was there, yet not
nicely exported.  The new procedure PRETTY-PRINT-WITH-OPTIONS allows
specifying the line width, a per-line prefix and whether to use WRITE
or DISPLAY. 

Here's the patch.

2001-12-18  Matthias Koeppe  <address@hidden>

        * pretty-print.scm (pretty-print-with-options): New procedure.
        (pretty-print): Implement in terms of the former.

Index: pretty-print.scm
===================================================================
RCS file: /cvs/guile/guile-core/ice-9/pretty-print.scm,v
retrieving revision 1.5
diff -u -u -r1.5 pretty-print.scm
--- pretty-print.scm    21 Oct 2001 09:47:25 -0000      1.5
+++ pretty-print.scm    18 Dec 2001 21:26:22 -0000
@@ -42,7 +42,9 @@
 ;;;; If you do not wish that, delete this exception notice.
 ;;;; 
 (define-module (ice-9 pretty-print)
-  :export (pretty-print))
+  :use-module (ice-9 optargs)
+  :export (pretty-print
+          pretty-print-with-options))
 
 ;; From SLIB.
 
@@ -53,7 +55,7 @@
 
 (define genwrite:newline-str (make-string 1 #\newline))
 
-(define (generic-write obj display? width output)
+(define (generic-write obj display? width per-line-prefix output)
 
   (define (read-macro? l)
     (define (length1? l) (and (pair? l) (null? (cdr l))))
@@ -137,14 +139,16 @@
     (define (indent to col)
       (and col
            (if (< to col)
-             (and (out genwrite:newline-str col) (spaces to 0))
+             (and (out genwrite:newline-str col)
+                 (out per-line-prefix 0)
+                 (spaces to 0))
              (spaces (- to col) col))))
 
     (define (pr obj col extra pp-pair)
       (if (or (pair? obj) (vector? obj)) ; may have to split on multiple lines
         (let ((result '())
               (left (min (+ (- (- width col) extra) 1) max-expr-width)))
-          (generic-write obj display? #f
+          (generic-write obj display? #f ""
             (lambda (str)
               (set! result (cons str result))
               (set! left (- left (string-length str)))
@@ -287,6 +291,7 @@
 
     (pr obj col 0 pp-expr))
 
+  (out per-line-prefix 0)
   (if width
     (out genwrite:newline-str (pp obj 0))
     (wr obj 0))
@@ -313,8 +318,22 @@
   (rev-string-append l 0))
 
 ;"pp.scm" Pretty-Print
-(define (pretty-print obj . opt)
-  (let ((port (if (pair? opt) (car opt) (current-output-port))))
-    (generic-write obj #f 79
-                  (lambda (s) (display s port) #t))))
-
+(define* (pretty-print obj #:optional (port (current-output-port)))
+  "Pretty-print OBJ on PORT, which defaults to the current output port."
+  (pretty-print-with-options obj #:port port))
+
+(define* (pretty-print-with-options obj
+                                   #:key (port (current-output-port))
+                                   (width 79)
+                                   (display? #f)
+                                   (per-line-prefix ""))
+  "Pretty-print OBJ on PORT, which is a keyword argument defaulting to
+the current output port.  Formatting can be controlled by a number of
+keyword arguments: Each line in the output is preceded by the string
+PER-LINE-PREFIX, which is empty by default.  The output lines will be
+at most WIDTH characters wide; the default is 79.  If DISPLAY? is
+true, display rather than write representation will be used."
+  (generic-write obj display?
+                (- width (string-length per-line-prefix))
+                per-line-prefix
+                (lambda (s) (display s port) #t)))


-- 
Matthias Köppe -- http://www.math.uni-magdeburg.de/~mkoeppe