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?)
-  (name real-address-name)
-  (annotated? real-address-annotated?))
+  (make-address-constructor name annotated? annotations)
+  (name address-name)
+  (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 
-	       (if (null? annotation)
-		   ""
-		   (escape-uri (car annotation)))))
-	  (string-append message "?" (real-address-name address)
-			 "=" escaped-annotation)))
+	(let ((index (if (null? annotation)
+			 (address-add-annotation! address "")
+			 (address-add-annotation! address (car annotation)))))
+	  (string-append message "?" (address-name address)
+			 "=" index)))
        ((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
-	  real-address-annotated?))
+	  address-name
+	  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)
-		(unescape-uri (cdr pair))
+	    (if (address-annotated? address)
+		(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 
-       `(html (title ,title) 
-	      (body (h1 "SUrflet Administration")
-		    (p "Currently, you may only view the continuations of "
-		       "one session at a time. This will be changed in "
-		       "future revisions. Sorry for any inconvenience.")
-		    (p "You may choose to go back to the " 
-		       (url ,(make-callback show-sessions) 
-			    "sessions administration page")
-		       " where you can select one session"
-		       " or select one session from your chosen sessions:" (br)
-		       (ul
-			,@(map (lambda (session)
-				 `(li (url ,(make-callback 
-					     (lambda (req)
-					       (show-continuations (list session) req)))
-					   ,(session-surflet-name (cdr session))
-					   " (" ,(car session) ")")))
-			       sessions)))))))
+      (let* ((address (make-annotated-address))
+	     (req (send-html/suspend
+		   (lambda (k-url)
+		     `(html 
+		       (title ,title) 
+		       (body 
+			(h1 "SUrflet Administration")
+			(p "Currently, you may only view the continuations of "
+			   "one session at a time. This will be changed in "
+			   "future revisions. Sorry for any inconvenience.")
+			(p "You may choose to go back to the " 
+			   (url ,(make-callback show-sessions) 
+				"sessions administration page")
+			   " where you can select one session"
+			   " or select one session from your chosen sessions:" (br)
+			   (ul
+			    ,@(map (lambda (session)
+				     `(li (url ,(address k-url session)
+					       ,(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)))