;; utilities for plugin (servlets)
;; Copyright 2002, Andreas Bernauer

(define (send-html/suspend html-tree-maker)
  (send/suspend 
   (lambda (new-url)
     (make-usual-html-response
      (lambda (out options)
	(with-current-output-port* ; FIXME: will change in further revision
	 out
	 (lambda () (SXML->HTML (html-tree-maker new-url)))))))))

(define (send-html/finish html-tree)
  (do-sending send/finish html-tree))

(define (send-html html-tree)
  (do-sending send html-tree))

(define (do-sending sending-version html-tree)
  (sending-version
   (make-usual-html-response
    (lambda (out options)
      (with-current-output-port*		; FIXME: will change in further revision
       out
       (lambda () (SXML->HTML html-tree)))))))

(define (make-usual-html-response writer-proc)
  (make-response
   http-status/ok
   (status-code->text http-status/ok)
   (time)
   "text/html"
   '()
   (make-writer-body writer-proc)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; from cgi-script:
;;; Return the form data as an alist of decoded strings.
;;; So a query string like "button=on&reply=Oh,%20yes" becomes alist
;;;     (("button" . "on") ("reply" . "Oh, yes"))
;;; This only works for GET and POST methods.

(define form-query parse-html-form-query)

(define (extract-bindings bindings key)
  (let ((key (if (symbol? key) (symbol->string key) key)))
    (filter (lambda (binding) 
	      (equal? (car binding) key))
	    bindings)))

(define (extract-single-binding bindings key)
  (let ((key-bindings (extract-bindings bindings key)))
    (if (= 1 (length key-bindings))
	(cdar key-bindings)
	(error "extract-one-binding: more than one or zero bindings found"
	       (length key-bindings)
	       key bindings))))