diff --git a/scheme/httpd/surflets/surflet-handler.scm b/scheme/httpd/surflets/surflet-handler.scm index 248c671..38da3d9 100644 --- a/scheme/httpd/surflets/surflet-handler.scm +++ b/scheme/httpd/surflets/surflet-handler.scm @@ -146,7 +146,10 @@ You can try starting at the beginning." (define (send/finish response) (instance-delete! (session-instance-id)) - response) + (shift unused response)) + +(define (send response) + (shift unsused response)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; access to instance-table diff --git a/scheme/httpd/surflets/utilities.scm b/scheme/httpd/surflets/utilities.scm new file mode 100644 index 0000000..375f776 --- /dev/null +++ b/scheme/httpd/surflets/utilities.scm @@ -0,0 +1,61 @@ +;; 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)))) + + + diff --git a/scheme/httpd/surflets/web-server/root/htdocs/index.html b/scheme/httpd/surflets/web-server/root/htdocs/index.html index 58ee6f4..3551c9a 100644 --- a/scheme/httpd/surflets/web-server/root/htdocs/index.html +++ b/scheme/httpd/surflets/web-server/root/htdocs/index.html @@ -8,6 +8,8 @@ Following files are available from here:
@@ -17,7 +19,7 @@