Function: eglot--connect
eglot--connect is a byte-compiled function defined in eglot.el.gz.
Signature
(eglot--connect MANAGED-MODES PROJECT CLASS CONTACT LANGUAGE-IDS)
Documentation
Connect to MANAGED-MODES, LANGUAGE-IDS, PROJECT, CLASS and CONTACT.
This docstring appeases checkdoc, that's all.
Source Code
;; Defined in /usr/src/emacs/lisp/progmodes/eglot.el.gz
(defun eglot--connect (managed-modes project class contact language-ids)
"Connect to MANAGED-MODES, LANGUAGE-IDS, PROJECT, CLASS and CONTACT.
This docstring appeases checkdoc, that's all."
(let* ((default-directory (project-root project))
(nickname (project-name project))
(readable-name
(progn
(unless (file-exists-p default-directory)
;; could happen because of bug#70724 or just because
(eglot--error "Project '%s' is gone!" nickname))
(format "EGLOT (%s/%s)" nickname managed-modes)))
server-info
(contact (if (functionp contact) (funcall contact) contact))
(initargs
(cond ((keywordp (car contact)) contact)
((integerp (cadr contact))
(setq server-info (list (format "%s:%s" (car contact)
(cadr contact))))
`(:process ,(lambda ()
(apply #'open-network-stream
readable-name nil
(car contact) (cadr contact)
(cddr contact)))))
((and (stringp (car contact))
(cl-find-if (lambda (x)
(or (eq x :autoport)
(eq (car-safe x) :autoport)))
contact))
(setq server-info (list "<inferior process>"))
`(:process ,(jsonrpc-autoport-bootstrap
readable-name
contact
:connect-args '(:noquery t))))
((stringp (car contact))
(let* ((probe (cl-position-if #'keywordp contact))
(more-initargs (and probe (cl-subseq contact probe)))
(contact (cl-subseq contact 0 probe)))
`(:process
,(lambda ()
(let ((default-directory default-directory)
;; bug#61350: Tramp turns on a feature
;; by default that can't (yet) handle
;; very much data so we turn it off
;; unconditionally -- just for our
;; process.
(tramp-use-ssh-controlmaster-options 'suppress)
(tramp-ssh-controlmaster-options
"-o ControlMaster=no -o ControlPath=none"))
(make-process
:name readable-name
:command (setq server-info (eglot--cmd contact))
:connection-type 'pipe
:coding 'utf-8-emacs-unix
:noquery t
:stderr (get-buffer-create
(format "*%s stderr*" readable-name))
:file-handler t)))
,@more-initargs)))))
(spread (lambda (fn) (lambda (server method params)
(let ((eglot--cached-server server))
(apply fn server method (append params nil))))))
(server
(apply
#'make-instance class
:name readable-name
:events-buffer-config eglot-events-buffer-config
:notification-dispatcher (funcall spread #'eglot-handle-notification)
:request-dispatcher (funcall spread #'eglot-handle-request)
:on-shutdown #'eglot--on-shutdown
initargs))
(canceled nil)
(tag (make-symbol "connected-catch-tag")))
(when server-info
(jsonrpc--debug server "Running language server: %s"
(string-join server-info " ")))
(setf (eglot--saved-initargs server) initargs)
(setf (eglot--project server) project)
(setf (eglot--project-nickname server) nickname)
(setf (eglot--languages server)
(cl-loop for m in managed-modes for l in language-ids
collect (cons m l)))
(run-hook-with-args 'eglot-server-initialized-hook server)
;; Now start the handshake. To honor `eglot-sync-connect'
;; maybe-sync-maybe-async semantics we use `jsonrpc-async-request'
;; and mimic most of `jsonrpc-request'.
(unwind-protect
(condition-case _quit
(let ((retval
(catch tag
(jsonrpc-async-request
server
:initialize
(list :processId
(unless (or eglot-withhold-process-id
(file-remote-p default-directory)
(eq (jsonrpc-process-type server)
'network))
(emacs-pid))
:clientInfo
(append
'(:name "Eglot")
(let ((v (and (functionp 'package-get-version)
(package-get-version))))
(and v (list :version v))))
;; Maybe turn trampy `/ssh:foo@bar:/path/to/baz.py'
;; into `/path/to/baz.py', so LSP groks it.
:rootPath (file-local-name
(expand-file-name default-directory))
:rootUri (eglot-path-to-uri default-directory)
:initializationOptions (eglot-initialization-options
server)
:capabilities (eglot-client-capabilities server)
:workspaceFolders (eglot-workspace-folders server))
:success-fn
(eglot--lambda ((InitializeResult) capabilities serverInfo)
(unless canceled
(push server
(gethash project eglot--servers-by-project))
(setf (eglot--capabilities server) capabilities)
(setf (eglot--server-info server) serverInfo)
(jsonrpc-notify server :initialized eglot--{})
(dolist (buffer (buffer-list))
(with-current-buffer buffer
;; No need to pass SERVER as an argument: it has
;; been registered in `eglot--servers-by-project',
;; so that it can be found (and cached) from
;; `eglot--maybe-activate-editing-mode' in any
;; managed buffer.
(eglot--maybe-activate-editing-mode)))
(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)
(eglot--message
"Connected! Server `%s' now managing `%s' buffers \
in project `%s'."
(or (plist-get serverInfo :name)
(jsonrpc-name server))
managed-modes
(eglot-project-nickname server))
(when tag (throw tag t))))
:timeout eglot-connect-timeout
:error-fn (eglot--lambda ((ResponseError) code message)
(unless canceled
(jsonrpc-shutdown server)
(let ((msg (format "%s: %s" code message)))
(if tag (throw tag `(error . ,msg))
(eglot--error msg)))))
:timeout-fn (lambda ()
(unless canceled
(jsonrpc-shutdown server)
(let ((msg (format "Timed out after %s seconds"
eglot-connect-timeout)))
(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 eglot-connect-timeout)))))))
(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 canceled 'quit)))
(setq tag nil))))