Add non-thunk version to with-lock.

Note: To follow naming conventions of scsh, the old with-lock is
renamed to with-lock*. The syntactic sugar version is with-lock now.

scheme/httpd/surflets/packages.scm

@@ -261,7 +261,8 @@
 	  load-structure))
 
 (define-interface with-locks-interface
-  (export with-lock))
+  (export with-lock*
+	  (with-lock :syntax)))
 
 ;; With the help of TYPED-OPTIONALS you can define a function
 ;; like (make-submit-button [string] args)

scheme/httpd/surflets/surflet-handler.scm

@@ -134,16 +134,15 @@
                                             (< (cdr p) (cdr q)))))
   (let lp ()
     (with-lock *session-table-lock*
-      (lambda ()
+      (let ((now (time)))
-        (let ((now (time)))
+	(let lp2 ()
-          (let lp2 ()
+	  (receive (session-id.time ignore) (search-tree-min *timeout-queue*)
-            (receive (session-id.time ignore) (search-tree-min *timeout-queue*)
+	    (if session-id.time
-              (if session-id.time
+		(if (<= (cdr session-id.time) now)
-                  (if (<= (cdr session-id.time) now)
+		    (let ((session-id (car session-id.time)))
-                      (let ((session-id (car session-id.time)))
+		      (table-set! *session-table* session-id #f)
-                        (table-set! *session-table* session-id #f)
+		      (pop-search-tree-min! *timeout-queue*)
-                        (pop-search-tree-min! *timeout-queue*)
+		      (lp2))))))))
-                        (lp2)))))))))
     (sleep 1000)
     (lp)))
 
@@ -322,13 +321,12 @@
 
 (define (really-session-adjust-timeout! session-id time-to-live)
   (with-lock *session-table-lock*
-    (lambda ()
+    (let ((session (table-ref *session-table* session-id)))
-      (let ((session (table-ref *session-table* session-id)))
+      (if session
-        (if session
+	  (timeout-queue-adjust-session-timeout!
-            (timeout-queue-adjust-session-timeout!
+	   session-id
-             session-id
+	   (+ (time) time-to-live))
-             (+ (time) time-to-live))
+	  (error "There is no session with this ID" session-id)))))
-            (error "There is no session with this ID" session-id))))))
 
 ;;; ADJUST-TIMEOUT!
 ;; Resets time-to-die of current session. The argument must be

scheme/httpd/surflets/with-locks.scm

@@ -1,6 +1,6 @@
 ;; From sunterlib
 
-(define (with-lock lock thunk)
+(define (with-lock* lock thunk)
   (dynamic-wind
    (lambda ()
      (obtain-lock lock))
@@ -8,3 +8,8 @@
    (lambda ()
      (release-lock lock))))
 
+(define-syntax with-lock
+  (syntax-rules ()
+    ((with-lock lock body ...)
+     (with-lock* lock (lambda () body ...)))))
+