byte input widget

scheme/httpd/surflets/web-server/root/htdocs/index.html

@@ -11,6 +11,7 @@
       <li><a href="servlet/add.scm">Adding (version 1)</a></li>
       <li><a href="servlet/add2.scm">Adding (version 2)</a></li>
       <li><a href="servlet/calculate.scm">Simple Calculator</a></li>
+      <li><a href="servlet/byte-input.scm">Byte Input Widget</a></li>
 <!--       <li><a href=/servlet/test.scm>A test servlet</a></li> -->
       <li><a href=index.html>This file</a></li>
     </ul>
@@ -20,7 +21,7 @@
     <hr>
     <!-- Created: Thu Aug 22 16:44:16 CEST 2002 -->
     <!-- hhmts start -->
-Last modified: Fri Sep 27 17:34:58 CEST 2002
+Last modified: Fri Sep 27 19:34:15 CEST 2002
 <!-- hhmts end -->
   </body>
 </html>

scheme/httpd/surflets/web-server/root/surflets/byte-input.scm

@@ -0,0 +1,64 @@
+(define-structure plugin plugin-interface
+  (open servlets
+	httpd-request
+	handle-fatal-error
+	url
+	scsh
+	scheme)
+  (begin
+
+    ;; This uses callbacks.
+
+    (define (make-byte-input-fields bits)
+      (let ((checkboxes 
+	     (reverse
+	      (let loop ((count 0)
+			 (order 1))
+		(if (= count bits)
+		    '()
+		    (cons 
+		     (make-checkbox-input-field (number->string order))
+		     (loop (+ 1 count)
+			   (* 2 order))))))))
+	(make-upper-input-field
+	 (lambda (bindings)
+	   (let loop ((sum 0)
+		      (checkboxes checkboxes))
+	     (if (null? checkboxes)
+		 sum
+		 (loop (+ sum (string->number
+			       (call-with-current-continuation
+				(lambda (exit)
+				  (with-fatal-error-handler
+				   (lambda (condition decline)
+				     (exit "0"))
+				   (input-field-value (car checkboxes) bindings))))))
+		       (cdr checkboxes)))))
+	 checkboxes)))
+
+    (define byte-input-fields (make-byte-input-fields 8))
+
+    (define (show-result result)
+      (send-html
+       `(html (title "Result")
+	      (body 
+	       (h2 "Result")
+	       (p "You've entered " ,result)))))
+
+    (define (get-byte-input)
+      (let* ((req (send-html/suspend
+		   (lambda (new-url)
+		     `(html (title "Byte Input Widget")
+			    (body 
+			     (h1 "Byte Input Widget")
+			     (servlet-form ,new-url
+					   ,byte-input-fields
+					   ,(make-submit-button)))))))
+	     (bindings (form-query (http-url:search (request:url req)))))
+	(input-field-value byte-input-fields bindings)))
+
+    (define (main req)
+      (show-result (get-byte-input)))
+      
+
+    ))