mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-28 16:00:22 +02:00
Code Activity

pretty-print: allow max-expr-width to be set; recognize more keywords

Browse source 
* module/ice-9/pretty-print.scm (pretty-print): Add new keyword argument
  '#:max-expr-width'.

  (generic-write): Add new argument 'max-expr-width'.  Previously this
  was internally defined to the constant value 50.
This commit is contained in:
Mark H Weaver 2012-02-26 15:58:30 -05:00
parent 9120f130a8
commit 8c43b28a11
1 changed files with 9 additions and 7 deletions
Download patch file Download diff file Expand all files Collapse all files

16
module/ice-9/pretty-print.scm
View file

@ -1,6 +1,7 @@
;;;; -*- coding: utf-8; mode: scheme -*- ;;;; -*- coding: utf-8; mode: scheme -*-
;;;; ;;;;
;;;; Copyright (C) 2001, 2004, 2006, 2009, 2010 Free Software Foundation, Inc. ;;;; Copyright (C) 2001, 2004, 2006, 2009, 2010,
;;;; 2012 Free Software Foundation, Inc.
;;;; ;;;;
;;;; This library is free software; you can redistribute it and/or ;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public ;;;; modify it under the terms of the GNU Lesser General Public
@ -32,7 +33,8 @@
(define genwrite:newline-str (make-string 1 #\newline)) (define genwrite:newline-str (make-string 1 #\newline))
(define (generic-write obj display? width per-line-prefix output) (define (generic-write
obj display? width max-expr-width per-line-prefix output)
(define (read-macro? l) (define (read-macro? l)
(define (length1? l) (and (pair? l) (null? (cdr l)))) (define (length1? l) (and (pair? l) (null? (cdr l))))
@ -93,7 +95,7 @@
(if (or (pair? obj) (vector? obj)) ; may have to split on multiple lines (if (or (pair? obj) (vector? obj)) ; may have to split on multiple lines
(let ((result '()) (let ((result '())
(left (min (+ (- (- width col) extra) 1) max-expr-width))) (left (min (+ (- (- width col) extra) 1) max-expr-width)))
(generic-write obj display? #f "" (generic-write obj display? #f max-expr-width ""
(lambda (str) (lambda (str)
(set! result (cons str result)) (set! result (cons str result))
(set! left (- left (string-length str))) (set! left (- left (string-length str)))
@ -223,12 +225,10 @@
(define max-call-head-width 5) (define max-call-head-width 5)
(define max-expr-width 50)
(define (style head) (define (style head)
(case head (case head
((lambda let* letrec define define-public ((lambda lambda* let* letrec define define* define-public
define-syntax let-syntax letrec-syntax) define-syntax let-syntax letrec-syntax with-syntax)
pp-LAMBDA) pp-LAMBDA)
((if set!) pp-IF) ((if set!) pp-IF)
((cond) pp-COND) ((cond) pp-COND)
@ -273,6 +273,7 @@
#:key #:key
(port (or port* (current-output-port))) (port (or port* (current-output-port)))
(width 79) (width 79)
(max-expr-width 50)
(display? #f) (display? #f)
(per-line-prefix "")) (per-line-prefix ""))
"Pretty-print OBJ on PORT, which is a keyword argument defaulting to "Pretty-print OBJ on PORT, which is a keyword argument defaulting to
@ -286,6 +287,7 @@ Instead of with a keyword argument, you can also specify the output
port directly after OBJ, like (pretty-print OBJ PORT)." port directly after OBJ, like (pretty-print OBJ PORT)."
(generic-write obj display? (generic-write obj display?
(- width (string-length per-line-prefix)) (- width (string-length per-line-prefix))
max-expr-width
per-line-prefix per-line-prefix
(lambda (s) (display s port) #t))) (lambda (s) (display s port) #t)))