[slime-cvs] CVS slime

[CVS User sboukarev]

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

Modified Files:
	ChangeLog swank.lisp 
Log Message:
* swank.lisp (interrupt-worker-thread): Solve *send-counter*
binding problem.
find-worker-thread: Merge with `thread-for-evaluation'.


--- /project/slime/cvsroot/slime/ChangeLog	2012/11/11 09:31:07	1.2366
+++ /project/slime/cvsroot/slime/ChangeLog	2012/11/11 20:00:33	1.2367
@@ -1,3 +1,9 @@
+2012-11-11  Stas Boukarev  <stassats at gmail.com>
+
+	* swank.lisp (interrupt-worker-thread): Solve *send-counter*
+	binding problem.
+	find-worker-thread: Merge with `thread-for-evaluation'.
+
 2012-11-11  Helmut Eller  <heller at common-lisp.net>
 
 	* slime.el ([test] find-definition.3): Mark as expected to fail.
--- /project/slime/cvsroot/slime/swank.lisp	2012/11/02 08:14:42	1.795
+++ /project/slime/cvsroot/slime/swank.lisp	2012/11/11 20:00:33	1.796
@@ -997,23 +997,25 @@
    (sleep *auto-flush-interval*)))
 
 ;; FIXME: drop dependency on find-repl-thread
-;; FIXME: and don't add and any more 
-(defun find-worker-thread (connection id)
+(defun thread-for-evaluation (connection id &key find-existing)
+  "Find or create a thread to evaluate the next request."
   (etypecase id
     ((member t)
      (etypecase connection
-       (multithreaded-connection (or (car (mconn.active-threads connection))
-                                     (find-repl-thread connection)))
+       (multithreaded-connection
+        (if find-existing
+            (or (car (mconn.active-threads connection))
+                (find-repl-thread connection))
+            (spawn-worker-thread connection)))
        (singlethreaded-connection (current-thread))))
-    ((member :repl-thread) 
+    ((member :repl-thread)
      (find-repl-thread connection))
     (fixnum
      (find-thread id))))
 
-;; FIXME: the else branch does look like it was written by someone who
-;; doesn't know what he is doeing.
 (defun interrupt-worker-thread (connection id)
-  (let ((thread (find-worker-thread connection id)))
+  (let ((thread (thread-for-evaluation connection id
+                                       :find-existing t)))
     (log-event "interrupt-worker-thread: ~a ~a~%" id thread)
     (if thread
         (etypecase connection
@@ -1024,22 +1026,10 @@
                                (invoke-or-queue-interrupt #'simple-break))))
           (singlethreaded-connection
            (simple-break)))
-        (let ((*send-counter* 0)) ;; shouldn't be necessary, but it is
-          (send-to-emacs (list :debug-condition (current-thread-id)
-                               (format nil "Thread with id ~a not found" 
-                                       id)))))))
-
-(defun thread-for-evaluation (connection id)
-  "Find or create a thread to evaluate the next request."
-  (etypecase id
-    ((member t)
-     (etypecase connection
-       (multithreaded-connection (spawn-worker-thread connection))
-       (singlethreaded-connection (current-thread))))
-    ((member :repl-thread)
-     (find-repl-thread connection))
-    (fixnum
-     (find-thread id))))
+        (encode-message (list :debug-condition (current-thread-id)
+                              (format nil "Thread with id ~a not found" 
+                                      id))
+                        (current-socket-io)))))
 
 (defun spawn-worker-thread (connection)
   (spawn (lambda ()