From 20ff8816a9ef5a7dec0310594b9b4e93d8a5eee7 Mon Sep 17 00:00:00 2001
From: interp <interp>
Date: Wed, 2 Oct 2002 20:28:39 +0000
Subject: [PATCH] + feature: return-addresses; lets servlets give more than one
 possible   address for the next step + plain-html: leaves given text
 untouched, like quote in scheme               don't call it quote, because it
 is too similar to the 	      HTML's tag <q> (that stands for 'quote')

---
 scheme/httpd/surflets/packages.scm |  3 +++
 scheme/httpd/surflets/surflets.scm | 39 +++++++++++++++++++++++++++---
 2 files changed, 39 insertions(+), 3 deletions(-)

diff --git a/scheme/httpd/surflets/packages.scm b/scheme/httpd/surflets/packages.scm
index caff3c1..25c7fac 100644
--- a/scheme/httpd/surflets/packages.scm
+++ b/scheme/httpd/surflets/packages.scm
@@ -158,6 +158,9 @@
 	  make-image-button
 	  input-field-value
 	  input-field-binding
+	  
+	  make-address
+	  returned-via?
 	  make-callback))
  
 (define-structure servlets servlets-interface
diff --git a/scheme/httpd/surflets/surflets.scm b/scheme/httpd/surflets/surflets.scm
index 96b71b4..e3b011d 100644
--- a/scheme/httpd/surflets/surflets.scm
+++ b/scheme/httpd/surflets/surflets.scm
@@ -149,12 +149,18 @@
 						 maybe-text
 						 URI)"</a>"))))
 
+(define plain-html-rule
+  `(plain-html
+    *preorder*
+    . ,(lambda (tag . text) text)))
+
 (define default-rules
  `(,attribute-rule
    (*default* 
     . ,(lambda (tag . elems) (apply (entag tag) elems)))
    ,text-rule
-   ,URL-rule))
+   ,URL-rule
+   ,plain-html-rule))
 
 (define (make-callback function)
   (call-with-current-continuation
@@ -214,11 +220,12 @@
 	  (input-field-name input-field))))
 
 ;; FIXME: consider creating small names
-(define generate-input-field-name
+(define generate-unique-name
   (let ((id 0))
     (lambda (type-string)
       (set! id (+ 1 id))
       (string-append type-string (number->string id)))))
+(define generate-input-field-name generate-unique-name)
 
 (define identity (lambda (a) a))
 
@@ -486,4 +493,30 @@
   (assoc (input-field-name input-field) bindings))
 
 (define (input-field-binding input-field bindings)
-  (real-input-field-binding (cadr input-field) bindings))
\ No newline at end of file
+  (real-input-field-binding (cadr input-field) bindings))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; return address
+
+;; generates an unique return-addres
+;; may be used like 
+;; (let ((address (make-address)))
+;;   (send-html/suspend 
+;;     (lambda (new-url)
+;;       ...
+;;       (URL (address new-url) "Click here to get more")...)                
+(define (make-address)
+  (let ((name (generate-unique-name "return")))
+    (lambda (message)
+      (cond
+       ((string? message)
+	(string-append message "?" name "="))
+       ((eq? message 'name)
+	name)
+       (else				;maybe we want more later...
+	(error "unknown message" message name))))))
+	
+
+(define (returned-via? return-address bindings)
+  (assoc (return-address 'name) bindings))
+