[elpa] externals/eglot 44e9647 46/69: Simplify JSONRPC connection shutdown

[João Távora]

branch: externals/eglot
commit 44e9647ea63b9706437e9562b9847f520e47fb8d
Author: João Távora <address@hidden>
Commit: João Távora <address@hidden>

    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)))