Changeset 8648 in project


Ignore:
Timestamp:
02/23/08 09:38:59 (12 years ago)
Author:
felix winkelmann
Message:

applied Jim's print-width patch with fix for proper parameter use

File:
1 edited

Legend:

Unmodified
Added
Removed
  • chicken/trunk/library.scm

    r8361 r8648  
    27592759  (void) )
    27602760
    2761 (define current-print-length 0)
    2762 (define print-length-limit #f)
    2763 (define ##sys#print-exit #f)
     2761(define current-print-length (make-parameter 0))
     2762(define print-length-limit (make-parameter #f))
     2763(define ##sys#print-exit (make-parameter #f))
    27642764
    27652765(define ##sys#print
     
    27672767        [csp case-sensitive]
    27682768        [ksp keyword-style]
     2769        [cpp current-print-length]
    27692770        [string-append string-append] )
    27702771    (lambda (x readable port)
    27712772      (##sys#check-port-mode port #f)
    27722773      (let ([csp (csp)]
    2773             [ksp (ksp)] )
     2774            [ksp (ksp)]
     2775            [length-limit (print-length-limit)])
    27742776
    27752777        (define (outstr port str)
    2776           (if print-length-limit
     2778          (if length-limit
    27772779              (let* ((len (##sys#size str))
    2778                      (cpl (fx+ current-print-length len)) )
    2779                 (if (fx>= cpl print-length-limit)
     2780                     (cpp0 (cpp))
     2781                     (cpl (fx+ cpp0 len)) )
     2782                (if (fx>= cpl length-limit)
    27802783                    (cond ((fx> len 3)
    2781                            (let ((n (fx- print-length-limit current-print-length)))
     2784                           (let ((n (fx- length-limit cpp0)))
    27822785                             (when (fx> n 0) (outstr0 port (##sys#substring str 0 n)))
    27832786                             (outstr0 port "...") ) )
    27842787                          (else (outstr0 port str)) )
    27852788                    (outstr0 port str) )
    2786                 (set! current-print-length cpl) )
     2789                (cpp cpl) )
    27872790              (outstr0 port str) ) )
    27882791               
     
    27912794
    27922795        (define (outchr port chr)
    2793           (set! current-print-length (fx+ current-print-length 1))
    2794           (when (and print-length-limit (fx>= current-print-length print-length-limit))
    2795             (outstr0 port "...")
    2796             (##sys#print-exit #t) )
    2797           ((##sys#slot (##sys#slot port 2) 2) port chr) )
     2796          (let ((cpp0 (cpp)))
     2797            (cpp (fx+ cpp0 1))
     2798            (when (and length-limit (fx>= cpp0 length-limit))
     2799              (outstr0 port "...")
     2800              ((##sys#print-exit) #t) )
     2801            ((##sys#slot (##sys#slot port 2) 2) port chr) ) )
    27982802
    27992803        (define (specialchar? chr)
     
    29902994           (##sys#print #\> #f port) ] ) ) )
    29912995
    2992 (define ##sys#with-print-length-limit   ; this is not the least bit thread safe
     2996(define ##sys#with-print-length-limit
    29932997  (let ([call-with-current-continuation call-with-current-continuation])
    29942998    (lambda (limit thunk)
    29952999      (call-with-current-continuation
    29963000       (lambda (return)
    2997          (fluid-let ((print-length-limit limit)
    2998                      (##sys#print-exit return)
    2999                      (current-print-length 0) )
    3000            (thunk) ) ) ) ) ) )
     3001         (parameterize ((print-length-limit limit)
     3002                        (##sys#print-exit return)
     3003                        (current-print-length 0))
     3004           (thunk)))))))
    30013005
    30023006
Note: See TracChangeset for help on using the changeset viewer.