12345678910111213141516171819202122232425262728293031323334353637383940 |
- ;; Pretty print SXML
- (import (scheme base)
- (scheme write))
- (define (all-but-last-pair p)
- (if (pair? p)
- (reverse (cdr (reverse p)))
- '()))
- (define (last-pair p)
- (let loop ((in p))
- (if (pair? (cdr in))
- (loop (cdr in))
- in)))
- (define (pretty-print-sxml s port)
- (pretty-print-sxml-handler s port 0 #f))
- (define (pretty-print-sxml-handler s port level last-one?)
- (display (make-string level #\space) port)
- (cond
- ((list? s)
- (case (length s)
- ((1 2) (write s port))
- (else
- (display "(" port)
- (write (car s) port)
- (newline port)
- (for-each (lambda (s)
- (pretty-print-sxml-handler s port (+ level 1) #f))
- (all-but-last-pair (cdr s)))
- (pretty-print-sxml-handler (car (last-pair s)) port (+ level 1) #t)
- (display ")" port)))
- (if (not last-one?)
- (newline port)))
- (else
- (write s port))))
|