;;; xml generation from xexprs

(define (xexpr->string xexpr)
  (cond ((eq? (car xexpr) 'xml-pi)
	 (string-append "<?" (cadr xexpr) "?>"))
	((eq? (car xexpr) 'xml-decl)
	 (string-append "<!" (cadr xexpr) ">"))
	((null? (cddr xexpr))
	 (string-append
	   "<" (symbol->string (car xexpr))
	   (xexpr-attrs->string (cadr xexpr)) "/>"))
	(else
	  (string-append
	    "<" (symbol->string (car xexpr))
	    (xexpr-attrs->string (cadr xexpr)) ">"
	    (xexpr-contents->string (cddr xexpr))
	    "</" (symbol->string (car xexpr)) ">"))))

(define (xexpr-or-string->string x)
  (if (string? x) (xml-quote x) (xexpr->string x)))

(define (xexpr-contents->string xl)
  (apply string-append (map xexpr-or-string->string xl)))

(define (xexpr-attrs->string attrs)
  (apply string-append (map xexpr-attr->string attrs)))

(define (xexpr-attr->string attr)
  (string-append
    " " (symbol->string (car attr))
    "=\"" (xml-quote (cadr attr)) "\""))

(define (xml-quote str)
  (apply string-append (map xml-quote-char (string->list str))))

(define (xml-quote-char ch)
  (cond ((assv ch '((#\& "&amp;") (#\< "&lt;") (#\> "&gt;") (#\" "&quot;")))
	 => cadr)
	(else (string ch))))