branch: externals/eglot
commit 44e9647ea63b9706437e9562b9847f520e47fb8d
Author: João Távora <joaotav...@gmail.com>
Commit: João Távora <joaotav...@gmail.com>
Simplify JSONRPC connection shutdown
* eglot.el (eglot--process): Delete.
(eglot-shutdown): Use jsonrpc-shutdown.
(eglot--on-shutdown): Simplify.
(eglot-reconnect): Simplify.
(eglot--connect): Simplify.
* jsonrpc-tests.el (jsonrpc--with-emacsrpc-fixture): Simplify.
* jsonrpc.el (jsonrpc-process-type, jsonrpc-running-p)
(jsonrpc-shutdown): New methods.
* eglot-tests.el (auto-reconnect): Use jsonrpc--process.
(eglot--call-with-dirs-and-files): Use jsonrpc-running-p.
---
eglot-tests.el | 10 ++++------
eglot.el | 29 ++++++++++-------------------
jsonrpc-tests.el | 12 ++----------
jsonrpc.el | 22 ++++++++++++++++++++++
4 files changed, 38 insertions(+), 35 deletions(-)
diff --git a/eglot-tests.el b/eglot-tests.el
index a78069f..d085532 100644
--- a/eglot-tests.el
+++ b/eglot-tests.el
@@ -68,8 +68,7 @@
(unwind-protect
(let ((eglot-autoreconnect nil))
(mapc #'eglot-shutdown
- (cl-remove-if-not (lambda (server) (process-live-p
(eglot--process server)))
- new-servers)))
+ (cl-remove-if-not #'jsonrpc-running-p new-servers)))
(mapc #'kill-buffer (mapcar #'jsonrpc--events-buffer new-servers))
(dolist (buf new-buffers) ;; have to save otherwise will get prompted
(with-current-buffer buf (save-buffer) (kill-buffer)))
@@ -217,13 +216,12 @@ Pass TIMEOUT to `eglot--with-timeout'."
;; In 1.2 seconds > `eglot-autoreconnect' kill servers. We
;; should have a automatic reconnection.
(run-with-timer 1.2 nil (lambda () (delete-process
- (eglot--process server))))
- (while (process-live-p (eglot--process server))
- (accept-process-output nil 0.5))
+ (jsonrpc--process server))))
+ (while (jsonrpc-running-p server) (accept-process-output nil 0.5))
(should (jsonrpc-current-connection))
;; Now try again too quickly
(setq server (jsonrpc-current-connection))
- (let ((proc (eglot--process server)))
+ (let ((proc (jsonrpc--process server)))
(run-with-timer 0.5 nil (lambda () (delete-process proc)))
(while (process-live-p proc) (accept-process-output nil 0.5)))
(should (not (jsonrpc-current-connection))))))))
diff --git a/eglot.el b/eglot.el
index e1592ab..cdb1c5b 100644
--- a/eglot.el
+++ b/eglot.el
@@ -203,11 +203,6 @@ lasted more than that many seconds."
(defvar eglot--servers-by-project (make-hash-table :test #'equal)
"Keys are projects. Values are lists of processes.")
-;; HACK: Do something to fix this in the jsonrpc API or here, but in
-;; the meantime concentrate the hack here.
-(defalias 'eglot--process 'jsonrpc--process
- "An abuse of `jsonrpc--process', a jsonrpc.el internal.")
-
(defun eglot-shutdown (server &optional _interactive)
"Politely ask SERVER to quit.
Forcefully quit it if it doesn't respond. Don't leave this
@@ -218,16 +213,15 @@ function with the server still running."
(progn
(setf (eglot--shutdown-requested server) t)
(jsonrpc-request server :shutdown nil :timeout 3)
- ;; this one is supposed to always fail, hence ignore-errors
+ ;; this one is supposed to always fail, because it asks the
+ ;; server to exit itself. Hence ignore-errors.
(ignore-errors (jsonrpc-request server :exit nil :timeout 1)))
;; Turn off `eglot--managed-mode' where appropriate.
(dolist (buffer (eglot--managed-buffers server))
(with-current-buffer buffer (eglot--managed-mode-onoff server -1)))
- (while (progn (accept-process-output nil 0.1)
- (not (eq (eglot--shutdown-requested server) :sentinel-done)))
- (eglot--warn "Sentinel for %s still hasn't run, brutally deleting it!"
- (eglot--process server))
- (delete-process (eglot--process server)))))
+ ;; Now ask jsonrpc.el to shutdown server (which in normal
+ ;; conditions should return immediately).
+ (jsonrpc-shutdown server)))
(defun eglot--on-shutdown (server)
"Called by jsonrpc.el when SERVER is already dead."
@@ -243,7 +237,7 @@ function with the server still running."
(delq server
(gethash (eglot--project server) eglot--servers-by-project)))
(cond ((eglot--shutdown-requested server)
- (setf (eglot--shutdown-requested server) :sentinel-done))
+ t)
((not (eglot--inhibit-autoreconnect server))
(eglot--warn "Reconnecting after unexpected server exit.")
(eglot-reconnect server))
@@ -337,8 +331,7 @@ INTERACTIVE is t if called interactively."
(let* ((nickname (file-name-base (directory-file-name
(car (project-roots project)))))
(current-server (jsonrpc-current-connection))
- (live-p (and current-server
- (process-live-p (eglot--process current-server)))))
+ (live-p (and current-server (jsonrpc-running-p current-server))))
(if (and live-p
interactive
(y-or-n-p "[eglot] Live process found, reconnect instead? "))
@@ -360,7 +353,7 @@ managing `%s' buffers in project `%s'."
"Reconnect to SERVER.
INTERACTIVE is t if called interactively."
(interactive (list (jsonrpc-current-connection-or-lose) t))
- (when (process-live-p (eglot--process server))
+ (when (jsonrpc-running-p server)
(ignore-errors (eglot-shutdown server interactive)))
(eglot--connect (eglot--project server)
(eglot--major-mode server)
@@ -421,9 +414,7 @@ appeases checkdoc, that's all."
(jsonrpc-request
server
:initialize
- (list :processId (unless (eq (process-type
- (eglot--process server))
- 'network)
+ (list :processId (unless (eq (jsonrpc-process-type server)
'network)
(emacs-pid))
:rootPath (expand-file-name
(car (project-roots project)))
@@ -446,7 +437,7 @@ appeases checkdoc, that's all."
(setf (eglot--inhibit-autoreconnect server)
(null eglot-autoreconnect)))))))
(setq success server))
- (unless (or success (not (process-live-p (eglot--process server))))
+ (when (and (not success) (jsonrpc-running-p server))
(eglot-shutdown server)))))
diff --git a/jsonrpc-tests.el b/jsonrpc-tests.el
index d59f1a0..9370d09 100644
--- a/jsonrpc-tests.el
+++ b/jsonrpc-tests.el
@@ -80,17 +80,9 @@
(when ,server
(kill-buffer (jsonrpc--events-buffer ,server))))
(unwind-protect
- (cl-loop do (delete-process (jsonrpc--process ,endpoint-sym))
- while (progn (accept-process-output nil 0.1)
- (not (jsonrpc--shutdown-complete-p
,endpoint-sym)))
- do (jsonrpc-message
- "test client is still running, waiting"))
+ (jsonrpc-shutdown ,endpoint-sym)
(unwind-protect
- (cl-loop do (delete-process (jsonrpc--process ,server))
- while (progn (accept-process-output nil 0.1)
- (not (jsonrpc--shutdown-complete-p
,server)))
- do (jsonrpc-message
- "test server is still running, waiting"))
+ (jsonrpc-shutdown ,server)
(cl-loop do (delete-process ,listen-server)
while (progn (accept-process-output nil 0.1)
(process-live-p ,listen-server))
diff --git a/jsonrpc.el b/jsonrpc.el
index d3aed36..d0c6066 100644
--- a/jsonrpc.el
+++ b/jsonrpc.el
@@ -51,6 +51,8 @@
;; using this transport scheme on top of JSONRPC, see for example the
;; Language Server Protocol
;; (https://microsoft.github.io/language-server-protocol/specification).
+;; `jsonrpc-process-connection' also implements `jsonrpc-shutdown',
+;; `jsonrpc-running-p'.
;;
;; Whatever the method used to obtain a `jsonrpc-connection', it is
;; given to `jsonrpc-notify', `jsonrpc-request' and
@@ -276,6 +278,7 @@ connection object, called when the process dies .")
(funcall error `(:code -1 :message "Server died"))))
(jsonrpc--request-continuations connection))
(jsonrpc-message "Server exited with status %s" (process-exit-status
proc))
+ (process-put proc 'jsonrpc-sentinel-done t)
(delete-process proc)
(funcall (jsonrpc--on-shutdown connection) connection)))))
@@ -471,6 +474,25 @@ originated."
json))
(jsonrpc-log-event connection message 'client)))
+(cl-defmethod jsonrpc-process-type ((conn jsonrpc-process-connection))
+ "Return the process-type of JSONRPC connection CONN"
+ (let ((proc (jsonrpc--process conn))) (and (process-live-p proc) proc)))
+
+(cl-defmethod jsonrpc-running-p ((conn jsonrpc-process-connection))
+ "Return non-nil if JSONRPC connection CONN is running."
+ (process-live-p (jsonrpc--process conn)))
+
+(cl-defmethod jsonrpc-shutdown ((conn jsonrpc-process-connection))
+ "Shutdown the JSONRPC connection CONN."
+ (cl-loop
+ with proc = (jsonrpc--process conn)
+ do
+ (delete-process proc)
+ (accept-process-output nil 0.1)
+ while (not (process-get proc 'jsonrpc-sentinel-done))
+ do (jsonrpc-warn
+ "Sentinel for %s still hasn't run, deleting it!" proc)))
+
(defun jsonrpc-forget-pending-continuations (connection)
"Stop waiting for responses from the current JSONRPC CONNECTION."
(interactive (list (jsonrpc-current-connection-or-lose)))
