Addresses may now be annotated with arbitrary values (including, but not

limited to strings).
For this purpose, the ADDRESS object uses an internal storage that is freed
as soon the ADDRESS object is freed.
admin-surflets.scm shows an example.

scheme/httpd/surflets/addresses.scm

@@ -1,7 +1,7 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; return address
 
-;; generates an unique return-addres
+;; generates an unique return-address
 ;; may be used like 
 ;; (let ((address (make-address)))
 ;;   (send-html/suspend 
@@ -10,22 +10,40 @@
 ;;       (url (address new-url) "Click here to get more")...)                
 
 (define-record-type address :address
-  (really-make-address name annotated?)
+  (make-address-constructor name annotated? annotations)
-  (name real-address-name)
+  (name address-name)
-  (annotated? real-address-annotated?))
+  (annotated? address-annotated?)
+  (annotations address-annotations set-address-annotations!))
+
+(define (really-make-address name annotated?)
+  (if annotated?
+      (make-address-constructor name annotated? #f)
+      (make-address-constructor name annotated? '())))
+
+(define (address-add-annotation! address annotation)
+  (let ((index (generate-unique-name "val")))
+    (set-address-annotations! address
+			      (cons (cons index annotation)
+				    (address-annotations address)))
+    index))
+
+(define (address-annotation address index)
+  (cond 
+   ((assoc index (address-annotations address)) => cdr)
+   (else #f)))
 
 (define (make-address)
-  (let ((address (really-make-address
+  (let ((address (really-make-address 
 		  (generate-unique-name "return") #f)))
     (lambda (message)
       (cond
        ((string? message)
-	(string-append message "?" (real-address-name address) "="))
+	(string-append message "?" (address-name address) "="))
        ((eq? message 'address)
 	address)
        (else
 	(error "address: unknown message/bad argument" 
-	       message (real-address-name address)))))))
+	       message (address-name address)))))))
 
 (define (make-annotated-address)
   (let ((address (really-make-address 
@@ -35,14 +53,13 @@
       (cond
        ((and (string? message)
 	     (<= (length annotation) 1))
-	(let ((escaped-annotation 
+	(let ((index (if (null? annotation)
-	       (if (null? annotation)
+			 (address-add-annotation! address "")
-		   ""
+			 (address-add-annotation! address (car annotation)))))
-		   (escape-uri (car annotation)))))
+	  (string-append message "?" (address-name address)
-	  (string-append message "?" (real-address-name address)
+			 "=" index)))
-			 "=" escaped-annotation)))
        ((eq? message 'address)
 	address)
        (else
 	(error "annotated-address: unknown message/bad argument(s)" 
-	       message (real-address-name address)))))))
+	       message (address-name address)))))))

scheme/httpd/surflets/packages.scm

@@ -314,8 +314,10 @@
 (define-interface surflets/addresses-interface
   (export make-address
 	  make-annotated-address
-	  real-address-name
+	  address-name
-	  real-address-annotated?))
+	  address-annotated?
+;	  address-add-annotation!
+	  address-annotation))
 
 ;; Returned-via (dispatcher for input-fields and intelligent
 ;; addresses)

scheme/httpd/surflets/returned-via.scm

@@ -5,10 +5,10 @@
       ;; We assume we have a return-address-object instead.
       (let ((address (return-object 'address)))
 	(cond 
-	 ((assoc (real-address-name address) bindings) =>
+	 ((assoc (address-name address) bindings) =>
 	  (lambda (pair)
-	    (if (real-address-annotated? address)
+	    (if (address-annotated? address)
-		(unescape-uri (cdr pair))
+		(address-annotation address (cdr pair))
 		#t)))
 	 (else #f)))))
 

scheme/httpd/surflets/web-server/root/surflets/admin-surflets.scm

@@ -226,25 +226,30 @@
 	   (url ,(make-callback show-sessions) "session table overview."))))
 
     (define (no-more-than-one-session title header1 sessions req)
-      (send-html 
+      (let* ((address (make-annotated-address))
-       `(html (title ,title) 
+	     (req (send-html/suspend
-	      (body (h1 "SUrflet Administration")
+		   (lambda (k-url)
-		    (p "Currently, you may only view the continuations of "
+		     `(html 
-		       "one session at a time. This will be changed in "
+		       (title ,title) 
-		       "future revisions. Sorry for any inconvenience.")
+		       (body 
-		    (p "You may choose to go back to the " 
+			(h1 "SUrflet Administration")
-		       (url ,(make-callback show-sessions) 
+			(p "Currently, you may only view the continuations of "
-			    "sessions administration page")
+			   "one session at a time. This will be changed in "
-		       " where you can select one session"
+			   "future revisions. Sorry for any inconvenience.")
-		       " or select one session from your chosen sessions:" (br)
+			(p "You may choose to go back to the " 
-		       (ul
+			   (url ,(make-callback show-sessions) 
-			,@(map (lambda (session)
+				"sessions administration page")
-				 `(li (url ,(make-callback 
+			   " where you can select one session"
-					     (lambda (req)
+			   " or select one session from your chosen sessions:" (br)
-					       (show-continuations (list session) req)))
+			   (ul
-					   ,(session-surflet-name (cdr session))
+			    ,@(map (lambda (session)
-					   " (" ,(car session) ")")))
+				     `(li (url ,(address k-url session)
-			       sessions)))))))
+					       ,(session-surflet-name (cdr session))
+					       " (" ,(car session) ")")))
+				   sessions))))))))
+	     (bindings (get-bindings req))
+	     (chosen-session (returned-via address bindings)))
+	(show-continuations (list chosen-session) req)))
       
     (define (continuation-id<? entry1 entry2)
       (< (car entry1) (car entry2)))