branch: elpa/slime
commit a1b8b5b51cc81c6c6f30b23c674772996c07cb18
Author: Stas Boukarev <stass...@gmail.com>
Commit: Stas Boukarev <stass...@gmail.com>
Fix disconnection.
---
swank.lisp | 14 +++++++++++---
1 file changed, 11 insertions(+), 3 deletions(-)
diff --git a/swank.lisp b/swank.lisp
index f959d1f2fe..f03e6e6547 100644
--- a/swank.lisp
+++ b/swank.lisp
@@ -761,6 +761,7 @@ first."
(defvar *main-thread* nil)
+(defvar *main-thread-used* nil)
(defun accept-connections (socket style dont-close)
(let (connection)
@@ -770,7 +771,8 @@ first."
(authenticate-client client)
(when (and (not dont-close)
(eq style :spawn))
- (setf *main-thread* (current-thread)))
+ (setf *main-thread* (current-thread)
+ *main-thread-used* nil))
(serve-requests (setf connection (make-connection socket client
style))))
(unless dont-close
(%stop-server :socket socket)
@@ -779,7 +781,10 @@ first."
(loop
(dcase (wait-for-event `(:run-on-main-thread _))
((:run-on-main-thread function)
- (funcall function)
+ (setf *main-thread-used* (current-thread))
+ (catch 'exit-to-main-thread
+ (funcall function))
+ (setf *main-thread-used* nil)
(unless *main-thread*
(return)))))))))))
@@ -1170,7 +1175,10 @@ event was found."
(when (and thread
(thread-alive-p thread)
(not (equal (current-thread) thread)))
- (ignore-errors (kill-thread thread))))))
+ (ignore-errors
+ (if (equal thread *main-thread-used*)
+ (interrupt-thread thread (lambda () (throw 'exit-to-main-thread
t)))
+ (kill-thread thread)))))))
;;;;;; Signal driven IO
