;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 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-record-type address :address
  (really-make-address name annotated?)
  (name real-address-name)
  (annotated? real-address-annotated?))

(define (make-address)
  (let ((address (really-make-address
		  (generate-unique-name "return") #f)))
    (lambda (message)
      (cond
       ((string? message)
	(string-append message "?" (real-address-name address) "="))
       ((eq? message 'address)
	address)
       (else
	(error "address: unknown message/bad argument" 
	       message (real-address-name address)))))))

(define (make-annotated-address)
  (let ((address (really-make-address 
		  (generate-unique-name "return")
		  #t)))
    (lambda (message . annotation)
      (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)))
       ((eq? message 'address)
	address)
       (else
	(error "annotated-address: unknown message/bad argument(s)" 
	       message (real-address-name address)))))))