+ CASE-RETURNED-VIA from mainzelm added

+ RETURNED-VIA alias for RETURNED-VIA? added

scheme/httpd/surflets/packages.scm

@@ -186,7 +186,9 @@
 
 	  make-address
 	  make-annotated-address
+	  returned-via
 	  returned-via?
+	  (case-returned-via :syntax)
 	  make-callback
 
 	  set-surflet-data!

scheme/httpd/surflets/surflets.scm

@@ -1,5 +1,6 @@
 ;; utilities for surflet
-;; Copyright 2002, Andreas Bernauer
+;; Copyright 2002,2003, Andreas Bernauer
+;; Copyright 2003, Martin Gasbichler
 
 (define (send-html/suspend html-tree-maker)
   (send/suspend 
@@ -670,7 +671,7 @@
 	(error "annotated-address: unknown message/bad argument(s)" 
 	       message (address-name address)))))))
 
-(define (returned-via? return-object bindings)
+(define (returned-via return-object bindings)
   (if (input-field? return-object)
       (input-field-binding return-object bindings)
       ;; We assume we have a return-address-object instead.
@@ -683,3 +684,25 @@
 		#t)))
 	 (else #f)))))
 
+;; It depends on the object, if returned-via returns only boolean
+;; values or string values as well. So let us have both names.
+(define returned-via? returned-via)
+
+;; This is from Martin Gasbichler
+(define-syntax case-returned-via
+  (syntax-rules (else)
+    ((case-returned-via (%bindings ...) clauses ...)
+     (let ((bindings (%bindings ...)))
+       (case-returned-via bindings clauses ...)))
+    ((case-returned-via bindings (else body ...))
+     (begin body ...))
+    ((case-returned-via bindings
+                        ((%return-object ...) %body ...))
+     (if (or (returned-via? %return-object bindings) ...)
+         (begin %body ...)))
+    ((case-returned-via bindings
+                        ((%return-object ...) %body ...)
+                        %clause %clauses ...)
+     (if (or (returned-via? %return-object bindings) ...)
+         (begin %body ...) 
+         (case-returned-via bindings %clause %clauses ...)))))