Changeset 34147 in project


Ignore:
Timestamp:
05/31/17 22:50:33 (5 months ago)
Author:
kon
Message:

fix cond list

Location:
release/4/condition-utils
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/4/condition-utils/tags/1.4.1/condition-utils.scm

    r34146 r34147  
    179179  (print-error-message cnd port header)
    180180  ; Rest of the composite condition (if any)
    181   (write-condition-list
    182     (cdr (condition->list cnd))
    183     port
    184     (string-append (subheader-string header) ": "))
    185   ; show everything
     181  (write-condition-list (cdr (condition->list cnd)) port header)
     182  ; call-chain?
    186183  (and-let* ((chain ((condition-property-accessor 'exn 'call-chain #f) cnd)))
    187184    (write-call-chain chain port chain-header) )
    188185  ;
    189   (void))
     186  (void) )
    190187
    191188(define (write-condition cnd #!optional (port (current-output-port)) (header "Error"))
    192189  (display header port)
    193190  (display ": " port)
    194   (write-condition-list
    195     (condition->list cnd)
    196     port
    197     (string-append (subheader-string header) ": ")) )
     191  (write-condition-list (condition->list cnd) port header) )
    198192
    199193(define (write-call-chain chain port header)
     
    251245;;
    252246
    253 (define (subheader-string header)
    254   (string-append (make-string (fx- (string-length header) 1) #\space) "+") )
    255 
    256 ;;
    257 
    258 (define (write-condition-list cnd-lst port leader)
    259   (for-each
    260     (lambda (cnd-info)
    261       (let ((kind (car cnd-info) )
    262             (args (cdr cnd-info) ) )
    263         (display leader port)
    264         (display kind port)
    265         (display ":" port)
    266         (for-each
    267           (lambda (arg)
    268             (display " " port)
    269             (write arg port) )
    270           args)
    271         (newline port) ) )
    272     cnd-lst) )
     247(define (write-condition-list cnd-lst port header)
     248  (let ((leader (string-append (subheader-string header) ": ")))
     249    (for-each
     250      (lambda (cnd-info)
     251        (let ((kind (car cnd-info) )
     252              (args (cdr cnd-info) ) )
     253          (display leader port)
     254          (display kind port)
     255          (display ":" port)
     256          (for-each
     257            (lambda (arg)
     258              (display " " port)
     259              (write arg port) )
     260            args)
     261          (newline port) ) )
     262      cnd-lst) ) )
    273263
    274264;;
     
    290280    (newline port) ) )
    291281
     282;;
     283
     284(define (subheader-string header)
     285  (string-append (make-string (fx- (string-length header) 1) #\space) "+") )
     286
    292287) ;module condition-utils
  • release/4/condition-utils/trunk/condition-utils.scm

    r34146 r34147  
    179179  (print-error-message cnd port header)
    180180  ; Rest of the composite condition (if any)
    181   (write-condition-list
    182     (cdr (condition->list cnd))
    183     port
    184     (string-append (subheader-string header) ": "))
    185   ; show everything
     181  (write-condition-list (cdr (condition->list cnd)) port header)
     182  ; call-chain?
    186183  (and-let* ((chain ((condition-property-accessor 'exn 'call-chain #f) cnd)))
    187184    (write-call-chain chain port chain-header) )
    188185  ;
    189   (void))
     186  (void) )
    190187
    191188(define (write-condition cnd #!optional (port (current-output-port)) (header "Error"))
    192189  (display header port)
    193190  (display ": " port)
    194   (write-condition-list
    195     (condition->list cnd)
    196     port
    197     (string-append (subheader-string header) ": ")) )
     191  (write-condition-list (condition->list cnd) port header) )
    198192
    199193(define (write-call-chain chain port header)
     
    251245;;
    252246
    253 (define (subheader-string header)
    254   (string-append (make-string (fx- (string-length header) 1) #\space) "+") )
    255 
    256 ;;
    257 
    258 (define (write-condition-list cnd-lst port leader)
    259   (for-each
    260     (lambda (cnd-info)
    261       (let ((kind (car cnd-info) )
    262             (args (cdr cnd-info) ) )
    263         (display leader port)
    264         (display kind port)
    265         (display ":" port)
    266         (for-each
    267           (lambda (arg)
    268             (display " " port)
    269             (write arg port) )
    270           args)
    271         (newline port) ) )
    272     cnd-lst) )
     247(define (write-condition-list cnd-lst port header)
     248  (let ((leader (string-append (subheader-string header) ": ")))
     249    (for-each
     250      (lambda (cnd-info)
     251        (let ((kind (car cnd-info) )
     252              (args (cdr cnd-info) ) )
     253          (display leader port)
     254          (display kind port)
     255          (display ":" port)
     256          (for-each
     257            (lambda (arg)
     258              (display " " port)
     259              (write arg port) )
     260            args)
     261          (newline port) ) )
     262      cnd-lst) ) )
    273263
    274264;;
     
    290280    (newline port) ) )
    291281
     282;;
     283
     284(define (subheader-string header)
     285  (string-append (make-string (fx- (string-length header) 1) #\space) "+") )
     286
    292287) ;module condition-utils
Note: See TracChangeset for help on using the changeset viewer.