From 25e03fe5e4a70a2d694a81a72a8978ac56df9a36 Mon Sep 17 00:00:00 2001 From: interp Date: Thu, 15 Jan 2004 03:47:39 +0000 Subject: [PATCH] More example files for the surflet howto. --- .../root/surflets/howto/annotate-error.scm | 37 +++++++++++++++ .../root/surflets/howto/callback.scm | 28 +++++++++++ .../surflets/howto/dispatch-annotated.scm | 31 +++++++++++++ .../root/surflets/howto/dispatch.scm | 31 +++++++++++++ .../root/surflets/howto/nibble-input.scm | 46 +++++++++++++++++++ 5 files changed, 173 insertions(+) create mode 100755 scheme/httpd/surflets/web-server/root/surflets/howto/annotate-error.scm create mode 100755 scheme/httpd/surflets/web-server/root/surflets/howto/callback.scm create mode 100755 scheme/httpd/surflets/web-server/root/surflets/howto/dispatch-annotated.scm create mode 100755 scheme/httpd/surflets/web-server/root/surflets/howto/dispatch.scm create mode 100755 scheme/httpd/surflets/web-server/root/surflets/howto/nibble-input.scm diff --git a/scheme/httpd/surflets/web-server/root/surflets/howto/annotate-error.scm b/scheme/httpd/surflets/web-server/root/surflets/howto/annotate-error.scm new file mode 100755 index 0000000..ae8b9d0 --- /dev/null +++ b/scheme/httpd/surflets/web-server/root/surflets/howto/annotate-error.scm @@ -0,0 +1,37 @@ +(define-structure surflet surflet-interface + (open surflets + handle-fatal-error + surflets/error + scheme-with-scsh) + (begin + (define (main req) + (let* ((select-input-field + (make-select + (map make-annotated-select-option + '("Icecream" "Chocolate" "Candy") + '(1.5 2.0 0.5)))) + (req (send-html/suspend + (lambda (k-url) + `(html + (head (title "Sweet Store")) + (body + (h1 "Your choice") + (surflet-form + ,k-url + (p "Select the sweet you want:" + ,select-input-field) + ,(make-submit-button))))))) + (bindings (get-bindings req)) + (cost (with-fatal-error-handler + (lambda (condition decline) + (send-error (status-code bad-request) + req + "No such option or internal error. + Please try again.") ) + (raw-input-field-value select-input-field bindings)))) + (send-html/finish + `(html (head (title "Receipt")) + (body + (h2 "Your receipt:") + (p "This costs you $" ,cost ".")))))) +)) diff --git a/scheme/httpd/surflets/web-server/root/surflets/howto/callback.scm b/scheme/httpd/surflets/web-server/root/surflets/howto/callback.scm new file mode 100755 index 0000000..e3de709 --- /dev/null +++ b/scheme/httpd/surflets/web-server/root/surflets/howto/callback.scm @@ -0,0 +1,28 @@ +(define-structure surflet surflet-interface + (open surflets + surflets/callbacks + scheme-with-scsh) + (begin + + (define (main req) + (let ((language (make-annotated-callback result-page))) + (send-html + `(html + (head (title "Multi-lingual")) + (body + (h2 "Select your language:") + (ul + (li (url ,(language "Hello, how are you?") + "English") + (li (url ,(language "Hallo, wie geht es Ihnen?") + "Deutsch"))))))))) + + (define (result-page req text) + (send-html/finish + `(html + (head (title "Greeting")) + (body + (h2 ,text))))) + + )) + diff --git a/scheme/httpd/surflets/web-server/root/surflets/howto/dispatch-annotated.scm b/scheme/httpd/surflets/web-server/root/surflets/howto/dispatch-annotated.scm new file mode 100755 index 0000000..272b5e7 --- /dev/null +++ b/scheme/httpd/surflets/web-server/root/surflets/howto/dispatch-annotated.scm @@ -0,0 +1,31 @@ +(define-structure surflet surflet-interface + (open surflets + scheme-with-scsh) + (begin + + (define (main req) + (let* ((language (make-annotated-address)) + (req (send-html/suspend + (lambda (k-url) + `(html + (head (title "Multi-lingual")) + (body + (h2 "Select your language:") + (ul + (li (url ,(language k-url "Hello, how are you?") + "English") + (li (url ,(language k-url "Hallo, wie geht es Ihnen?") + "Deutsch"))))))))) + (bindings (get-bindings req))) + (case-returned-via bindings + ((language) => result-page)))) + + (define (result-page text) + (send-html/finish + `(html + (head (title "Greeting")) + (body + (h2 ,text))))) + + )) + diff --git a/scheme/httpd/surflets/web-server/root/surflets/howto/dispatch.scm b/scheme/httpd/surflets/web-server/root/surflets/howto/dispatch.scm new file mode 100755 index 0000000..d21b35b --- /dev/null +++ b/scheme/httpd/surflets/web-server/root/surflets/howto/dispatch.scm @@ -0,0 +1,31 @@ +(define-structure surflet surflet-interface + (open surflets + scheme-with-scsh) + (begin + + (define (main req) + (let* ((english (make-address)) + (german (make-address)) + (req (send-html/suspend + (lambda (k-url) + `(html + (head (title "Multi-lingual")) + (body + (h2 "Select your language:") + (ul + (li (url ,(english k-url) "English") + (li (url ,(german k-url) "Deutsch"))))))))) + (bindings (get-bindings req))) + (case-returned-via bindings + ((english) (result-page "Hello, how are you?")) + ((german) (result-page "Hallo, wie geht es Ihnen?"))))) + + (define (result-page text) + (send-html/finish + `(html + (head (title "Greeting")) + (body + (h2 ,text))))) + + )) + diff --git a/scheme/httpd/surflets/web-server/root/surflets/howto/nibble-input.scm b/scheme/httpd/surflets/web-server/root/surflets/howto/nibble-input.scm new file mode 100755 index 0000000..4f13fab --- /dev/null +++ b/scheme/httpd/surflets/web-server/root/surflets/howto/nibble-input.scm @@ -0,0 +1,46 @@ +(define-structure surflet surflet-interface + (open surflets + surflets/my-input-fields + scheme-with-scsh) + (begin + + (define (make-nibble-input-fields) + (let ((checkboxes (list (make-annotated-checkbox 8) + (make-annotated-checkbox 4) + (make-annotated-checkbox 2) + (make-annotated-checkbox 1)))) + (make-multi-input-field + #f "nibble-input" + (lambda (input-field bindings) + (let loop ((sum 0) + (checkboxes checkboxes)) + (if (null? checkboxes) + sum + (loop (+ sum (or (input-field-value (car checkboxes) + bindings) + 0)) + (cdr checkboxes))))) + '() + (lambda (ignore) + checkboxes)))) + + (define nibble-input-field (make-nibble-input-fields)) + + (define (main req) + (let* ((req (send-html/suspend + (lambda (new-url) + `(html (title "Nibble Input Widget") + (body + (h1 "Nibble Input Widget") + (p "Enter your nibble (msb left):") + (surflet-form ,new-url + ,nibble-input-field + ,(make-submit-button))))))) + (bindings (get-bindings req)) + (number (input-field-value nibble-input-field bindings))) + (send-html + `(html (title "Result") + (body + (h2 "Result") + (p "You've entered " ,number ".")))))) + ))