[slime-cvs] CVS update: slime/swank.lisp

[Helmut Eller]

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv789

Modified Files:
	swank.lisp 
Log Message:
(*default-worker-thread-bindings*): New variable to initialize dynamic
variables in worker threads.
(spawn-worker-thread, call-with-bindings): New helper functions.
(thread-for-evaluation): Use them.
Date: Wed Jan 12 17:22:37 2005
Author: heller

Index: slime/swank.lisp
diff -u slime/swank.lisp:1.273 slime/swank.lisp:1.274
--- slime/swank.lisp:1.273	Mon Jan 10 20:34:31 2005
+++ slime/swank.lisp	Wed Jan 12 17:22:37 2005
@@ -447,6 +447,11 @@
 
 ;;;;;; Thread based communication
 
+(defvar *default-worker-thread-bindings* '()
+  "An alist to initialize dynamic variables in worker threads.  
+The list has the form ((VAR . VALUE) ...).  Each variable VAR will be
+bound to the corresponding VALUE.")
+
 (defvar *active-threads* '())
 
 (defun read-loop (control-thread input-stream connection)
@@ -487,11 +492,24 @@
   (let ((c *emacs-connection*))
     (etypecase id
       ((member t)
-       (spawn (lambda () (handle-request c)) :name "worker"))
+       (spawn-worker-thread c))
       ((member :repl-thread)
        (repl-thread c))
       (fixnum
        (find-thread id)))))
+
+(defun spawn-worker-thread (connection)
+  (spawn (lambda () 
+           (call-with-bindings *default-worker-thread-bindings*
+                               (lambda () 
+                                 (handle-request connection))))
+         :name "worker"))
+
+(defun call-with-bindings (alist fn)
+  (let ((vars (mapcar #'car alist))
+        (vals (mapcar #'cdr alist)))
+    (progv vars vals
+      (funcall fn))))
   
 (defun dispatch-event (event socket-io)
   "Handle an event triggered either by Emacs or within Lisp."