scsh-conservatory
/
sunet
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

More example files for the surflet howto.

This commit is contained in:
interp 2004-01-15 03:47:39 +00:00
parent 721fee4e07
commit 25e03fe5e4
5 changed files with 173 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
scheme/httpd/surflets/web-server/root/surflets/howto/annotate-error.scm Executable file
View File

@ -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 "."))))))
))

28
scheme/httpd/surflets/web-server/root/surflets/howto/callback.scm Executable file
View File

@ -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)))))
))

31
scheme/httpd/surflets/web-server/root/surflets/howto/dispatch-annotated.scm Executable file
View File

@ -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)))))
))

31
scheme/httpd/surflets/web-server/root/surflets/howto/dispatch.scm Executable file
View File

@ -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)))))
))

46
scheme/httpd/surflets/web-server/root/surflets/howto/nibble-input.scm Executable file
View File

@ -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 "."))))))
))