branch: elpa/slime
commit f079d8cdc007b02f40d61227203de3b15f118d89
Author: Stas Boukarev <stass...@gmail.com>
Commit: Stas Boukarev <stass...@gmail.com>
Experimental swank-repl:run-function-and-switch-to-new-thread
---
contrib/swank-repl.lisp | 14 +++++++++++++-
swank.lisp | 5 ++++-
2 files changed, 17 insertions(+), 2 deletions(-)
diff --git a/contrib/swank-repl.lisp b/contrib/swank-repl.lisp
index c05c4c0bb5..4f531fdcab 100644
--- a/contrib/swank-repl.lisp
+++ b/contrib/swank-repl.lisp
@@ -11,7 +11,8 @@
listener-get-value
create-repl
listener-save-value
- redirect-trace-output)
+ redirect-trace-output
+ run-function-and-switch-to-new-thread)
(:import-from
swank
@@ -153,6 +154,17 @@ INPUT OUTPUT IO REPL-RESULTS"
(setf (mconn.repl-thread connection)
'aborted))))
+(defun run-function-and-switch-to-new-thread (function)
+ (let ((connection *emacs-connection*))
+ (assert (typep connection 'multithreaded-connection))
+ (assert (eql (current-thread) (mconn.repl-thread connection)))
+ (setf (mconn.repl-thread connection)
+ (spawn-repl-thread connection "new-repl-thread"))
+ (send-to-emacs (list :return (current-thread)
+ `(:ok nil)
+ swank::*eval-continuation*))
+ (funcall function)))
+
;;;;; Redirection during requests
;;;
;;; We always redirect the standard streams to Emacs while evaluating
diff --git a/swank.lisp b/swank.lisp
index ac49b54731..a00fd210a2 100644
--- a/swank.lisp
+++ b/swank.lisp
@@ -1683,6 +1683,8 @@ Fall back to the current if no such package exists."
(*print-lines* (or *print-lines* ,lines)))
,@body))
+(defvar *eval-continuation* nil)
+
(defun eval-for-emacs (form buffer-package id)
"Bind *BUFFER-PACKAGE* to BUFFER-PACKAGE and evaluate FORM.
Return the result to the continuation ID.
@@ -1692,7 +1694,8 @@ Errors are trapped and invoke our debugger."
(let ((*buffer-package* (guess-buffer-package buffer-package))
(*buffer-readtable* (guess-buffer-readtable buffer-package))
(*pending-continuations* (cons id *pending-continuations*))
- (*pre-reply-hook* *pre-reply-hook*))
+ (*pre-reply-hook* *pre-reply-hook*)
+ (*eval-continuation* id))
(check-type *buffer-package* package)
(check-type *buffer-readtable* readtable)
;; APPLY would be cleaner than EVAL.
