diff --git a/contrib/swank-repl.lisp b/contrib/swank-repl.lisp index ee4312649..210118f7d 100644 --- a/contrib/swank-repl.lisp +++ b/contrib/swank-repl.lisp @@ -204,8 +204,16 @@ This is an optimized way for Lisp to deliver output to Emacs." (add-hook *connection-closed-hook* 'update-redirection-after-close) (typecase conn (multithreaded-connection - (setf (mconn.repl-thread conn) - (spawn-repl-thread conn "repl-thread")))) + (if swank::*main-thread* + (send swank::*main-thread* + (list :run-on-main-thread + (lambda () + (shiftf (mconn.repl-thread conn) + swank::*main-thread* nil) + (with-bindings *default-worker-thread-bindings* + (repl-loop conn))))) + (setf (mconn.repl-thread conn) + (spawn-repl-thread conn "repl-thread"))))) (list (package-name *package*) (package-string-for-prompt *package*))))) diff --git a/swank.lisp b/swank.lisp index ab7e2146d..f959d1f2f 100644 --- a/swank.lisp +++ b/swank.lisp @@ -735,7 +735,9 @@ e.g.: (restart-loop (http-request url) (use-value (new) (setq url new)))" (ecase style (:spawn (initialize-multiprocessing (lambda () - (spawn #'serve-loop :name (format nil "Swank ~s" port))))) + (if dont-close + (spawn #'serve-loop :name (format nil "Swank ~s" port)) + (serve-loop))))) ((:fd-handler :sigio) (note) (add-fd-handler socket #'serve)) @@ -757,14 +759,29 @@ first." (sleep 5) (create-server :port port :style style :dont-close dont-close)) + +(defvar *main-thread* nil) + (defun accept-connections (socket style dont-close) - (unwind-protect - (let ((client (accept-connection socket :external-format nil - :buffering t))) - (authenticate-client client) - (serve-requests (make-connection socket client style))) - (unless dont-close - (%stop-server :socket socket)))) + (let (connection) + (unwind-protect + (let ((client (accept-connection socket :external-format nil + :buffering t))) + (authenticate-client client) + (when (and (not dont-close) + (eq style :spawn)) + (setf *main-thread* (current-thread))) + (serve-requests (setf connection (make-connection socket client style)))) + (unless dont-close + (%stop-server :socket socket) + (when (eq style :spawn) + (with-connection (connection) + (loop + (dcase (wait-for-event `(:run-on-main-thread _)) + ((:run-on-main-thread function) + (funcall function) + (unless *main-thread* + (return))))))))))) (defun authenticate-client (stream) (let ((secret (slime-secret))) @@ -875,11 +892,11 @@ The processing is done in the extent of the toplevel restart." (wait-for-event `(or (:emacs-rex . _) (:emacs-channel-send . _)) timeout) - (when timeout? (return)) - (dcase event - ((:emacs-rex &rest args) (apply #'eval-for-emacs args)) - ((:emacs-channel-send channel (selector &rest args)) - (channel-send channel selector args)))))) + (when timeout? (return)) + (dcase event + ((:emacs-rex &rest args) (apply #'eval-for-emacs args)) + ((:emacs-channel-send channel (selector &rest args)) + (channel-send channel selector args)))))) (defun current-socket-io () (connection.socket-io *emacs-connection*))