[elpa] externals/eglot 2f1d76d 03/69: Proper server shutdown when jrpc.el is used

[João Távora]

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

    Proper server shutdown when jrpc.el is used
    
    The shutdown hook can't be a buffer-local thing, it has
    to be a server property. Also, on shutdown in eglot.el,
    remember to first unmanage buffers and only then affect
    eglot--processes-by-project.
    
    * eglot.el (eglot--on-shutdown): reverse order of first
    two sexps.
    (eglot--connect): Pass a shutdown function to jrpc-connect
    (eglot--managed-mode): Don't use jrpc-server-moribund-hook
    (eglot--buffer-managed-p): Simplify. Use eglot--find-current-process.
---
 eglot.el | 59 ++++++++++++++++++++++++++++-------------------------------
 jrpc.el  | 24 +++++++++++++++---------
 2 files changed, 43 insertions(+), 40 deletions(-)

diff --git a/eglot.el b/eglot.el
index 934270c..f33a851 100644
--- a/eglot.el
+++ b/eglot.el
@@ -95,13 +95,14 @@ A list (ID WHAT DONE-P).")
 
 (defun eglot--on-shutdown (proc)
   ;; Turn off `eglot--managed-mode' where appropriate.
-  (setf (gethash (eglot--project proc) eglot--processes-by-project)
-        (delq proc
-              (gethash (eglot--project proc) eglot--processes-by-project)))
   (dolist (buffer (buffer-list))
     (with-current-buffer buffer
       (when (eglot--buffer-managed-p proc)
         (eglot--managed-mode -1))))
+  ;; Sever the project/process relationship for proc
+  (setf (gethash (eglot--project proc) eglot--processes-by-project)
+        (delq proc
+              (gethash (eglot--project proc) eglot--processes-by-project)))
   (cond ((eglot--moribund proc))
         ((not (eglot--inhibit-autoreconnect proc))
          (eglot--warn "Reconnecting unexpected server exit.")
@@ -267,7 +268,7 @@ INTERACTIVE is t if called interactively."
 
 (defun eglot--connect (project managed-major-mode name command
                                dont-inhibit)
-  (let ((proc (jrpc-connect name command "eglot--server-")))
+  (let ((proc (jrpc-connect name command "eglot--server-" 
#'eglot--on-shutdown)))
     (setf (eglot--project proc) project)
     (setf (eglot--major-mode proc)managed-major-mode)
     (push proc (gethash project eglot--processes-by-project))
@@ -326,11 +327,11 @@ INTERACTIVE is t if called interactively."
   "Convert point POS to LSP position."
   (save-excursion
     (jrpc-obj :line
-                ;; F!@(#*&#$)CKING OFF-BY-ONE
-                (1- (line-number-at-pos pos t))
-                :character
-                (- (goto-char (or pos (point)))
-                   (line-beginning-position)))))
+              ;; F!@(#*&#$)CKING OFF-BY-ONE
+              (1- (line-number-at-pos pos t))
+              :character
+              (- (goto-char (or pos (point)))
+                 (line-beginning-position)))))
 
 (defun eglot--lsp-position-to-point (pos-plist)
   "Convert LSP position POS-PLIST to Emacs point."
@@ -401,7 +402,6 @@ INTERACTIVE is t if called interactively."
    (eglot--managed-mode
     (add-hook 'jrpc-find-process-functions 'eglot--find-current-process nil t)
     (add-hook 'jrpc-ready-predicates 'eglot--server-ready-p nil t)
-    (add-hook 'jrpc-server-moribund-hook 'eglot--on-shutdown nil t)
     (add-hook 'after-change-functions 'eglot--after-change nil t)
     (add-hook 'before-change-functions 'eglot--before-change nil t)
     (add-hook 'flymake-diagnostic-functions 'eglot-flymake-backend nil t)
@@ -417,7 +417,6 @@ INTERACTIVE is t if called interactively."
    (t
     (remove-hook 'jrpc-find-process-functions 'eglot--find-current-process t)
     (remove-hook 'jrpc-ready-predicates 'eglot--server-ready-p t)
-    (remove-hook 'jrpc-server-moribund-hook 'eglot--on-shutdown t)
     (remove-hook 'flymake-diagnostic-functions 'eglot-flymake-backend t)
     (remove-hook 'after-change-functions 'eglot--after-change t)
     (remove-hook 'before-change-functions 'eglot--before-change t)
@@ -439,11 +438,9 @@ INTERACTIVE is t if called interactively."
 
 (defun eglot--buffer-managed-p (&optional proc)
   "Tell if current buffer can be managed by PROC."
-  (and buffer-file-name
-       (cond ((null proc) (jrpc-current-process))
-             (t (and (eq major-mode (eglot--major-mode proc))
-                     (let ((proj (project-current)))
-                       (and proj (equal proj (eglot--project proc)))))))))
+  (and buffer-file-name (let ((cur (eglot--find-current-process)))
+                          (or (and (null proc) cur)
+                              (and proc (eq proc cur))))))
 
 (defvar-local eglot--current-flymake-report-fn nil
   "Current flymake report function for this buffer")
@@ -585,12 +582,12 @@ Uses THING, FACE, DEFS and PREPEND."
                                               _code source message)
                      diag-spec
                    (eglot--with-lsp-range (beg end) range
-                                          (flymake-make-diagnostic 
(current-buffer)
-                                                                   beg end
-                                                                   (cond ((<= 
severity 1) :error)
-                                                                         ((= 
severity 2)  :warning)
-                                                                         (t    
           :note))
-                                                                   (concat 
source ": " message))))
+                     (flymake-make-diagnostic (current-buffer)
+                                              beg end
+                                              (cond ((<= severity 1) :error)
+                                                    ((= severity 2)  :warning)
+                                                    (t               :note))
+                                              (concat source ": " message))))
          into diags
          finally (cond (eglot--current-flymake-report-fn
                         (funcall eglot--current-flymake-report-fn diags)
@@ -657,18 +654,18 @@ Uses THING, FACE, DEFS and PREPEND."
   (append
    (eglot--VersionedTextDocumentIdentifier)
    (jrpc-obj :languageId
-               (if (string-match "\\(.*\\)-mode" (symbol-name major-mode))
-                   (match-string 1 (symbol-name major-mode))
-                 "unknown")
-               :text
-               (save-restriction
-                 (widen)
-                 (buffer-substring-no-properties (point-min) (point-max))))))
+             (if (string-match "\\(.*\\)-mode" (symbol-name major-mode))
+                 (match-string 1 (symbol-name major-mode))
+               "unknown")
+             :text
+             (save-restriction
+               (widen)
+               (buffer-substring-no-properties (point-min) (point-max))))))
 
 (defun eglot--TextDocumentPositionParams ()
   "Compute TextDocumentPositionParams."
   (jrpc-obj :textDocument (eglot--TextDocumentIdentifier)
-              :position (eglot--pos-to-lsp-position)))
+            :position (eglot--pos-to-lsp-position)))
 
 (defvar-local eglot--recent-changes nil
   "Recent buffer changes as collected by `eglot--before-change'.")
@@ -931,7 +928,7 @@ DUMMY is ignored"
 (defun eglot--hover-info (contents &optional range)
   (concat (and range
                (eglot--with-lsp-range (beg end) range
-                                      (concat (buffer-substring beg end)  ": 
")))
+                 (concat (buffer-substring beg end)  ": ")))
           (mapconcat #'eglot--format-markup
                      (append
                       (cond ((vectorp contents)
diff --git a/jrpc.el b/jrpc.el
index 91ad0ea..876f236 100644
--- a/jrpc.el
+++ b/jrpc.el
@@ -117,6 +117,11 @@ A list (WHAT SERIOUS-P).")
 (jrpc-define-process-var jrpc-contact nil
   "Method used to contact a server.")
 
+(jrpc-define-process-var jrpc--shutdown-hook nil
+  "Hook run when JSON-RPC server is dying.
+Run after running any error handlers for outstanding requests.
+Each hook function is passed the process object for the server.")
+
 (jrpc-define-process-var jrpc--deferred-actions
     (make-hash-table :test #'equal)
   "Actions deferred to when server is thought to be ready.")
@@ -159,7 +164,7 @@ CONTACT is as `jrpc-contact'.  Returns a process object."
   ;; the indenting of literal plists, i.e. is basically `list'
   `(list ,@what))
 
-(cl-defun jrpc-connect (name contact prefix)
+(cl-defun jrpc-connect (name contact prefix &optional on-shutdown)
   "Connect to JSON-RPC server hereafter known as NAME through CONTACT.
 
 NAME is a string naming the server.
@@ -172,23 +177,24 @@ PREFIX specifies how the server-invoked methods find 
their Elisp
 counterpart. If a server invokes method \"FooBar\" and PREFIX is
 \"fancy-mode-\", then the function `fancy-mode-FooBar' will be
 called with arguments (PROCESS [JSON]). JSON is either a plist of
-key-value pairs or, for JSON arrays, a non-list sequence."
+key-value pairs or, for JSON arrays, a non-list sequence.
+
+ON-SHUTDOWN, when non-nil, is a function called on server exit
+and passed the moribund process object.
+
+Returns a process object representing the server."
   (let* ((proc (jrpc--make-process name contact))
          (buffer (process-buffer proc)))
     (setf (jrpc-contact proc) contact
           (jrpc-name proc) name
-          (jrpc--method-prefix proc) prefix)
+          (jrpc--method-prefix proc) prefix
+          (jrpc--shutdown-hook proc) on-shutdown)
     (with-current-buffer buffer
       (let ((inhibit-read-only t))
         (erase-buffer)
         (read-only-mode t)
         proc))))
 
-(defvar jrpc-server-moribund-hook nil
-  "Hook run when JSON-RPC server is dying.
-Run after running any error handlers for outstanding requests.
-Each hook function is passed the process object for the server.")
-
 (defun jrpc--process-sentinel (proc change)
   "Called when PROC undergoes CHANGE."
   (jrpc-log-event proc `(:message "Process state changed" :change ,change))
@@ -208,7 +214,7 @@ Each hook function is passed the process object for the 
server.")
                      (funcall error :code -1 :message (format "Server died"))))
                  (jrpc--pending-continuations proc))
       (jrpc-message "Server exited with status %s" (process-exit-status proc))
-      (run-hook-with-args 'jrpc-server-moribund-hook proc)
+      (funcall (or (jrpc--shutdown-hook proc) #'identity) proc)
       (delete-process proc))))
 
 (defun jrpc--process-filter (proc string)