Skip to content

Commit

Permalink
Close #68: Implement asynchronous server connection
Browse files Browse the repository at this point in the history
A new defcustom eglot-sync-connect controls this feature.  If it is t,
eglot should behave like previously, waiting synchronously for a
connection to be established, with the exception that there is now a
non-nil timeout set to eglot-connect-timeout, which defaults to 30
seconds.

eglot-connect is now considerably more complicated as it replicates
most of the work that jsonrpc-request does vis-a-vis handling errors,
timeouts and user quits..

* eglot-tests.el
(eglot--call-with-dirs-and-files): Simplify cleanup logic.
(slow-sync-connection-wait)
(slow-sync-connection-intime, slow-async-connection)
(slow-sync-error): New tests.

* eglot.el (eglot-sync-connect): New defcustom.
(eglot-ensure, eglot): Simplify.
(eglot--connect): Honour eglot-sync-connect.  Complicate
considerably.
(eglot-connect-timeout): New defcustom.
(Package-requires): Require jsonrpc 1.0.6
  • Loading branch information
joaotavora committed Aug 12, 2018
1 parent ae37c2a commit 83d7025
Show file tree
Hide file tree
Showing 2 changed files with 145 additions and 57 deletions.
64 changes: 56 additions & 8 deletions eglot-tests.el
Original file line number Diff line number Diff line change
Expand Up @@ -67,15 +67,10 @@
(setq cleanup-events-et-cetera-p t))
(unwind-protect
(let ((eglot-autoreconnect nil))
(mapc (lambda (server) (eglot-shutdown server nil nil t))
(mapc (lambda (server)
(eglot-shutdown
server nil nil (not cleanup-events-et-cetera-p)))
(cl-remove-if-not #'jsonrpc-running-p new-servers)))
(when cleanup-events-et-cetera-p
(cl-loop for serv in new-servers
do
(kill-buffer (process-get (jsonrpc--process serv)
'jsonrpc-stderr))
(kill-buffer (jsonrpc--events-buffer serv))
(kill-buffer (process-buffer (jsonrpc--process serv)))))
(eglot--message
"Killing project buffers %s, deleting %s, killing server %s"
(mapconcat #'buffer-name new-buffers ", ")
Expand Down Expand Up @@ -456,6 +451,59 @@ Pass TIMEOUT to `eglot--with-timeout'."
(should (eq server (eglot--current-server)))))
(setq python-mode-hook saved-python-mode-hook)))))

(ert-deftest slow-sync-connection-wait ()
"Connect with `eglot-sync-connect' set to t."
(skip-unless (executable-find "pyls"))
(eglot--with-dirs-and-files
'(("project" . (("something.py" . "import sys\nsys.exi"))))
(with-current-buffer
(eglot--find-file-noselect "project/something.py")
(let ((eglot-sync-connect t)
(eglot-server-programs
`((python-mode . ("sh" "-c" "sleep 1 && pyls")))))
(should (eglot--tests-connect 3))))))

(ert-deftest slow-sync-connection-intime ()
"Connect synchronously with `eglot-sync-connect' set to 2."
(skip-unless (executable-find "pyls"))
(eglot--with-dirs-and-files
'(("project" . (("something.py" . "import sys\nsys.exi"))))
(with-current-buffer
(eglot--find-file-noselect "project/something.py")
(let ((eglot-sync-connect 2)
(eglot-server-programs
`((python-mode . ("sh" "-c" "sleep 1 && pyls")))))
(should (eglot--tests-connect 3))))))

(ert-deftest slow-async-connection ()
"Connect asynchronously with `eglot-sync-connect' set to 2."
(skip-unless (executable-find "pyls"))
(eglot--with-dirs-and-files
'(("project" . (("something.py" . "import sys\nsys.exi"))))
(with-current-buffer
(eglot--find-file-noselect "project/something.py")
(let ((eglot-sync-connect 1)
(eglot-server-programs
`((python-mode . ("sh" "-c" "sleep 2 && pyls")))))
(should-not (apply #'eglot--connect (eglot--guess-contact)))
(eglot--with-timeout 3
(while (not (eglot--current-server))
(accept-process-output nil 0.2))
(should (eglot--current-server)))))))

(ert-deftest slow-sync-timeout ()
"Failed attempt at connection synchronously."
(skip-unless (executable-find "pyls"))
(eglot--with-dirs-and-files
'(("project" . (("something.py" . "import sys\nsys.exi"))))
(with-current-buffer
(eglot--find-file-noselect "project/something.py")
(let ((eglot-sync-connect t)
(eglot-connect-timeout 1)
(eglot-server-programs
`((python-mode . ("sh" "-c" "sleep 2 && pyls")))))
(should-error (apply #'eglot--connect (eglot--guess-contact)))))))

(provide 'eglot-tests)
;;; eglot-tests.el ends here

Expand Down
138 changes: 89 additions & 49 deletions eglot.el
Original file line number Diff line number Diff line change
Expand Up @@ -7,7 +7,7 @@
;; Maintainer: João Távora <[email protected]>
;; URL: https://github.com/joaotavora/eglot
;; Keywords: convenience, languages
;; Package-Requires: ((emacs "26.1") (jsonrpc "1.0.5"))
;; Package-Requires: ((emacs "26.1") (jsonrpc "1.0.6"))

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
Expand Down Expand Up @@ -140,6 +140,19 @@ lasted more than that many seconds."
:type '(choice (boolean :tag "Whether to inhibit autoreconnection")
(integer :tag "Number of seconds")))

(defcustom eglot-connect-timeout 30
"Number of seconds before timing out LSP connection attempts.
If nil, never time out."
:type 'number)

(defcustom eglot-sync-connect 3
"Control blocking of LSP connection attempts.
If t, block for `eglot-connect-timeout' seconds. A positive
integer number means block for that many seconds, and then wait
for the connection in the background. nil has the same meaning
as 0, i.e. don't block at all."
:type '(choice (boolean :tag "Whether to inhibit autoreconnection")
(integer :tag "Number of seconds")))

;;; API (WORK-IN-PROGRESS!)
;;;
Expand Down Expand Up @@ -259,9 +272,7 @@ running."
;; Now ask jsonrpc.el to shut down the server (which under normal
;; conditions should return immediately).
(jsonrpc-shutdown server (not preserve-buffers))
(unless preserve-buffers
(mapc #'kill-buffer
`(,(jsonrpc-events-buffer server) ,(jsonrpc-stderr-buffer server))))))
(unless preserve-buffers (kill-buffer (jsonrpc-events-buffer server)))))

(defun eglot--on-shutdown (server)
"Called by jsonrpc.el when SERVER is already dead."
Expand Down Expand Up @@ -399,15 +410,7 @@ INTERACTIVE is t if called interactively."
(y-or-n-p "[eglot] Live process found, reconnect instead? "))
(eglot-reconnect current-server interactive)
(when live-p (ignore-errors (eglot-shutdown current-server)))
(let ((server (eglot--connect managed-major-mode
project
class
contact)))
(eglot--message "Connected! Process `%s' now \
managing `%s' buffers in project `%s'."
(jsonrpc-name server) managed-major-mode
(eglot--project-nickname server))
server))))
(eglot--connect managed-major-mode project class contact))))

(defun eglot-reconnect (server &optional interactive)
"Reconnect to SERVER.
Expand All @@ -432,12 +435,7 @@ INTERACTIVE is t if called interactively."
(remove-hook 'post-command-hook #'maybe-connect nil)
(eglot--with-live-buffer buffer
(unless eglot--managed-mode
(let ((server (apply #'eglot--connect (eglot--guess-contact))))
(eglot--message
"Automatically started `%s' to manage `%s' buffers in project `%s'"
(jsonrpc-name server)
major-mode
(eglot--project-nickname server)))))))
(apply #'eglot--connect (eglot--guess-contact))))))
(when buffer-file-name
(add-hook 'post-command-hook #'maybe-connect 'append nil)))))

Expand Down Expand Up @@ -508,42 +506,84 @@ This docstring appeases checkdoc, that's all."
:request-dispatcher (funcall spread #'eglot-handle-request)
:on-shutdown #'eglot--on-shutdown
initargs))
success)
(cancelled nil)
(tag (make-symbol "connected-catch-tag")))
(setf (eglot--saved-initargs server) initargs)
(setf (eglot--project server) project)
(setf (eglot--project-nickname server) nickname)
(setf (eglot--major-mode server) managed-major-mode)
(setf (eglot--inferior-process server) autostart-inferior-process)
(push server (gethash project eglot--servers-by-project))
(run-hook-with-args 'eglot-connect-hook server)
;; Now start the handshake. To honour `eglot-sync-connect'
;; maybe-sync-maybe-async semantics we use `jsonrpc-async-request'
;; and mimic most of `jsonrpc-request'.
(unwind-protect
(cl-destructuring-bind (&key capabilities)
(jsonrpc-request
server
:initialize
(list :processId (unless (eq (jsonrpc-process-type server) 'network)
(emacs-pid))
:rootPath (expand-file-name default-directory)
:rootUri (eglot--path-to-uri default-directory)
:initializationOptions (eglot-initialization-options server)
:capabilities (eglot-client-capabilities server)))
(setf (eglot--capabilities server) capabilities)
(dolist (buffer (buffer-list))
(with-current-buffer buffer
(eglot--maybe-activate-editing-mode server)))
(jsonrpc-notify server :initialized `(:__dummy__ t))
(run-hook-with-args 'eglot-server-initialized-hook server)
(setf (eglot--inhibit-autoreconnect server)
(cond
((booleanp eglot-autoreconnect) (not eglot-autoreconnect))
((cl-plusp eglot-autoreconnect)
(run-with-timer eglot-autoreconnect nil
(lambda ()
(setf (eglot--inhibit-autoreconnect server)
(null eglot-autoreconnect)))))))
(setq success server))
(when (and (not success) (jsonrpc-running-p server))
(eglot-shutdown server)))))
(condition-case _quit
(let ((retval
(catch tag
(jsonrpc-async-request
server
:initialize
(list :processId (unless (eq (jsonrpc-process-type server)
'network)
(emacs-pid))
:rootPath (expand-file-name default-directory)
:rootUri (eglot--path-to-uri default-directory)
:initializationOptions (eglot-initialization-options
server)
:capabilities (eglot-client-capabilities server))
:success-fn
(jsonrpc-lambda (&key capabilities)
(unless cancelled
(push server
(gethash project eglot--servers-by-project))
(setf (eglot--capabilities server) capabilities)
(dolist (buffer (buffer-list))
(with-current-buffer buffer
(eglot--maybe-activate-editing-mode server)))
(jsonrpc-notify server :initialized `(:__dummy__ t))
(setf (eglot--inhibit-autoreconnect server)
(cond
((booleanp eglot-autoreconnect)
(not eglot-autoreconnect))
((cl-plusp eglot-autoreconnect)
(run-with-timer
eglot-autoreconnect nil
(lambda ()
(setf (eglot--inhibit-autoreconnect server)
(null eglot-autoreconnect)))))))
(run-hook-with-args 'eglot-connect-hook server)
(run-hook-with-args 'eglot-server-initialized-hook server)
(eglot--message
"Connected! Server `%s' now managing `%s' buffers \
in project `%s'."
(jsonrpc-name server) managed-major-mode
(eglot--project-nickname server))
(when tag (throw tag t))))
:timeout eglot-connect-timeout
:error-fn (jsonrpc-lambda (&key code message _data)
(unless cancelled
(jsonrpc-shutdown server)
(let ((msg (format "%s: %s" code message)))
(if tag (throw tag `(error . ,msg))
(eglot--error msg)))))
:timeout-fn (lambda ()
(unless cancelled
(jsonrpc-shutdown server)
(let ((msg (format "Timed out")))
(if tag (throw tag `(error . ,msg))
(eglot--error msg))))))
(cond ((numberp eglot-sync-connect)
(accept-process-output nil eglot-sync-connect))
(eglot-sync-connect
(while t (accept-process-output nil 30)))))))
(pcase retval
(`(error . ,msg) (eglot--error msg))
(`nil (eglot--message "Waiting in background for server `%s'"
(jsonrpc-name server))
nil)
(_ server)))
(quit (jsonrpc-shutdown server) (setq cancelled 'quit)))
(setq tag nil))))

(defun eglot--inferior-bootstrap (name contact &optional connect-args)
"Use CONTACT to start a server, then connect to it.
Expand Down

0 comments on commit 83d7025

Please sign in to comment.