use DEFINE-RECORD-TYPE instead of DEFINE-RECORD

scheme/httpd/surflets/surflet-handler.scm

@@ -18,10 +18,15 @@
   (continuation-counter instance-continuation-counter)
   (servlet-data instance-servlet-data set-instance-servlet-data!))
 
-(define-record memo
-  (message 'kill)			;kill, killed, adjust-timeout
-  (value #f)
-  (new-memo #f))
+(define-record-type memo :memo
+  (make-memo message value new-memo)
+  memo?
+  (message memo:message set-memo:message) ;kill, killed, adjust-timeout
+  (value memo:value set-memo:value)
+  (new-memo memo:new-memo set-memo:new-memo))
+
+(define (make-default-memo)
+  (make-memo 'kill #f #f))
 
 ;; caller must do locking stuff
 (define (memo-killed! memo)
@@ -35,11 +40,17 @@
   (return-continuation really-session-return-continuation 
 		       set-session-return-continuation!))
 
-(define-record options
-  servlet-path
-  servlet-prefix
-  (cache-servlets? #t)
-  (instance-lifetime 600))		; in seconds
+(define-record-type options :options
+  (make-options servlet-path servlet-prefix cache-servlets? instance-lifetime)
+  options?
+  (servlet-path options:servlet-path set-options:servlet-path)
+  (servlet-prefix options:servlet-prefix set-options:servlet-prefix)
+  (cache-servlets? options:cache-servlets? set-options:cache-servlets?)
+  ;; instance lifetime is in seconds
+  (instance-lifetime options:instance-lifetime set-options:instance-lifetime))
+
+(define (make-default-options servlet-path servlet-prefix)
+  (make-options servlet-path servlet-prefix #t 600))
 
 (define *options* (make-preserved-thread-fluid #f))
 ;; preserved thread fluid because between different calls to
@@ -70,7 +81,7 @@
 
 ;; servlet-prefix gives virtual prefixed path to servlets
 (define (servlet-handler servlet-path servlet-prefix)
-  (set-thread-fluid! *options* (make-options servlet-path servlet-prefix))
+  (set-thread-fluid! *options* (make-default-options servlet-path servlet-prefix))
   (lambda (path req)
     (if (pair? path)			; need at least one element
 	(let ((request-method (request:method req))
@@ -111,7 +122,7 @@
     (obtain-lock *instance-table-lock*)
     ;; no access to instance table until new instance-id is saved
     (let ((instance-id (generate-new-table-id *instance-table*))
-	  (memo (make-memo)))
+	  (memo (make-default-memo)))
       (table-set! *instance-table* instance-id
 		  (make-instance path-string    ; used to make
 						; redirections to origin
@@ -285,7 +296,7 @@
   (obtain-lock *instance-table-lock*)
   (let* ((instance (table-ref *instance-table* instance-id))
 	 (memo (instance-memo instance))
-	 (new-memo (make-memo)))
+	 (new-memo (make-default-memo)))
     ;; Do it this way: new values and then new message
     (set-memo:value memo 
 		    (+ (time) 
@@ -296,6 +307,10 @@
     (set-memo:message memo 'adjust-timeout))
   (release-lock *instance-table-lock*))
 
+;; adjusts the timeout of the current instance
+(define (adjust-timeout)
+  (instance-adjust-timeout! (session-instance-id)))
+
 (define (reset-instance-table!)
   (with-fatal-error-handler
    (lambda (condtion decline)