rp-helper/pretty-sxml.scm

;; 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))))