-(define-module (ice-9 pretty-print))
-
-(export pretty-print)
+;;;; -*-scheme-*-
+;;;;
+;;;; Copyright (C) 2001 Free Software Foundation, Inc.
+;;;;
+;;;; This program is free software; you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation; either version 2, or (at your option)
+;;;; any later version.
+;;;;
+;;;; This program is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with this software; see the file COPYING. If not, write to
+;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
+;;;; Boston, MA 02111-1307 USA
+;;;;
+;;;; As a special exception, the Free Software Foundation gives permission
+;;;; for additional uses of the text contained in its release of GUILE.
+;;;;
+;;;; The exception is that, if you link the GUILE library with other files
+;;;; to produce an executable, this does not by itself cause the
+;;;; resulting executable to be covered by the GNU General Public License.
+;;;; Your use of that executable is in no way restricted on account of
+;;;; linking the GUILE library code into it.
+;;;;
+;;;; This exception does not however invalidate any other reasons why
+;;;; the executable file might be covered by the GNU General Public License.
+;;;;
+;;;; This exception applies only to the code released by the
+;;;; Free Software Foundation under the name GUILE. If you copy
+;;;; code from other Free Software Foundation releases into a copy of
+;;;; GUILE, as the General Public License permits, the exception does
+;;;; not apply to the code that you add in this way. To avoid misleading
+;;;; anyone as to the status of such modified files, you must delete
+;;;; this exception notice from them.
+;;;;
+;;;; If you write modifications of your own for GUILE, it is your choice
+;;;; whether to permit this exception to apply to your modifications.
+;;;; If you do not wish that, delete this exception notice.
+;;;;
+(define-module (ice-9 pretty-print)
+ :use-module (ice-9 optargs)
+ :export (pretty-print))
;; From SLIB.
(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))))
((#\newline) "newline")
(else (make-string 1 obj)))
(out "#\\" col))))
- ((input-port? obj) (out "#[input-port]" col))
- ((output-port? obj) (out "#[output-port]" col))
- ((eof-object? obj) (out "#[eof-object]" col))
- (else (out "#[unknown]" col))))
+ (else (out (object->string obj) col))))
(define (pp obj col)
(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)))
(pr obj col 0 pp-expr))
+ (out per-line-prefix 0)
(if width
(out genwrite:newline-str (pp obj 0))
- (wr obj 0)))
+ (wr obj 0))
+ ;; Return `unspecified'
+ (if #f #f))
; (reverse-string-append l) = (apply string-append (reverse l))
(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 . opts)
+ "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.
+
+Instead of with a keyword argument, you can also specify the output
+port directly after OBJ, like (pretty-print OBJ PORT)."
+ (if (pair? opts)
+ (if (keyword? (car opts))
+ (apply pretty-print-with-keys obj opts)
+ (apply pretty-print-with-keys obj #:port (car opts) (cdr opts)))
+ (pretty-print-with-keys obj)))
+
+(define* (pretty-print-with-keys obj
+ #:key
+ (port (current-output-port))
+ (width 79)
+ (display? #f)
+ (per-line-prefix ""))
+ (generic-write obj display?
+ (- width (string-length per-line-prefix))
+ per-line-prefix
+ (lambda (s) (display s port) #t)))
HCoop / bpt / guile.git / blobdiff