(define processing-instruction-rule
  `(*PI* *preorder*
	 . ,(lambda (tag . elems)
	      `(,(string-append "<?" (symbol->string (car elems)) " ")
		,@(cdr elems)
		"?>"))))

(define doctype-rule
  `(*DOCTYPE* *preorder*
	      . ,(lambda (content . more)
		   `("<!DOCTYPE " ,@more ">"))))

(define xml-default-rule
  `(*default* . 
	      ,(lambda (tag . elems) 
		 (apply (entag tag) elems))))

(define (entag tag)
  (lambda elems
    (if (and (pair? elems) (pair? (car elems)) (eq? '@ (caar elems)))
        (list #\< tag (cdar elems)
          (if (pair? (cdr elems)) (list  #\> (cdr elems) "</" tag #\>)
              "/>"))
        (list #\< tag  
          (if (pair? elems) (list #\> elems "</" tag #\>) "/>")))))

(define comment-rule
  `(*COMMENT* *preorder* 
              . ,(lambda (tag . elems)
                   `("<!-- " ,@elems "-->"))))

(define xml-rules
  (list attribute-rule
	xml-default-rule
	processing-instruction-rule
	doctype-rule
	text-rule
	comment-rule
	url-rule
	plain-html-rule
	nbsp-rule))

(define (make-xml-reponse xml-string)
  (make-surflet-response
   (status-code ok)
   "text/xml"
   '(("Cache-Control" . "no-cache"))
   xml-string))

(define (send-xml/suspend xml-tree-maker)
  (send/suspend
   (lambda (k-url)
     (make-xml-reponse
      (sxml->string (xml-tree-maker k-url)
		    xml-rules)))))

(define (send-xml/finish xml-tree)
  (send
   (make-xml-reponse
    (sxml->string xml-tree xml-rules))))