PROGRAM is called with ARGS and is expected to serve LSP requests
over the standard input/output channels.
--* A list (HOST PORT [ARGS...]) where HOST is a string and PORT is a
--positive integer number for connecting to a server via TCP.
++* A list (HOST PORT [ARGS...]) where HOST is a string and PORT is
++a positive integer number for connecting to a server via TCP.
Remaining ARGS are passed to `open-network-stream' for upgrading
--the connection with encryption, etc...
++the connection with encryption or other capabilities.
* A function of no arguments returning a connected process.
* A cons (CLASS-NAME . SPEC) where CLASS-NAME is a symbol
--designating a subclass of `eglot-lsp-server', for
++designating a subclass of symbol `eglot-lsp-server', for
representing experimental LSP servers. In this case SPEC is
interpreted as described above this point.")
(let ((b (cl-gensym)))
`(let ((,b ,buf)) (if (buffer-live-p ,b) (with-current-buffer ,b ,@body)))))
--(cl-defmacro eglot--lambda (cl-lambda-list &body body)
-- "Make a unary function of ARG, a plist-like JSON object.
--CL-LAMBDA-LIST destructures ARGS before running BODY."
-- (declare (indent 1) (debug (sexp &rest form)))
-- (let ((e (gensym "eglot--lambda-elem")))
-- `(lambda (,e) (apply (cl-function (lambda ,cl-lambda-list ,@body)) ,e))))
--
(cl-defmacro eglot--widening (&rest body)
"Save excursion and restriction. Widen. Then run BODY." (declare (debug t))
`(save-excursion (save-restriction (widen) ,@body)))
:documentation
"Represents a server. Wraps a process for LSP communication.")
-(cl-defmethod cl-print-object ((obj eglot-lsp-server) stream)
- (princ (format "#<%s: %s>" (eieio-object-class obj) (eglot--name obj)) stream))
+\f
+;;; Process management
+(defvar eglot--servers-by-project (make-hash-table :test #'equal)
+ "Keys are projects. Values are lists of processes.")
-(defun eglot--current-server ()
- "The current logical EGLOT process."
- (let* ((probe (or (project-current) `(transient . ,default-directory))))
- (cl-find major-mode (gethash probe eglot--servers-by-project)
- :key #'eglot--major-mode)))
+;; 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--current-server-or-lose ()
- "Return the current EGLOT process or error."
- (or (eglot--current-server) (eglot--error "No current EGLOT process")))
-
-(defun eglot--make-process (name contact)
- "Make a process object from CONTACT.
-NAME is used to name the the started process or connection.
-CONTACT is in `eglot'. Returns a process object."
- (let* ((stdout (format "*%s stdout*" name)) stderr
- (proc (cond
- ((processp contact) contact)
- ((integerp (cadr contact))
- (apply #'open-network-stream name stdout contact))
- (t (make-process
- :name name :command contact :buffer stdout
- :coding 'no-conversion :connection-type 'pipe
- :stderr (setq stderr (format "*%s stderr*" name)))))))
- (process-put proc 'eglot-stderr stderr)
- (set-process-buffer proc (get-buffer-create stdout))
- (set-marker (process-mark proc) (with-current-buffer stdout (point-min)))
- (set-process-filter proc #'eglot--process-filter)
- (set-process-sentinel proc #'eglot--process-sentinel)
- (with-current-buffer stdout
- (let ((inhibit-read-only t)) (erase-buffer) (read-only-mode t)))
- proc))
+(defun eglot-shutdown (server &optional _interactive)
+ "Politely ask SERVER to quit.
+Forcefully quit it if it doesn't respond. Don't leave this
+function with the server still running."
+ (interactive (list (jsonrpc-current-connection-or-lose) t))
+ (eglot--message "Asking %s politely to terminate" (jsonrpc-name server))
+ (unwind-protect
+ (progn
+ (setf (eglot--shutdown-requested server) t)
+ (jsonrpc-request server :shutdown nil :timeout 3)
+ ;; this one is supposed to always fail, 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)))))
+
+(defun eglot--on-shutdown (server)
+ "Called by jsonrpc.el when SERVER is already dead."
+ ;; Turn off `eglot--managed-mode' where appropriate.
+ (dolist (buffer (eglot--managed-buffers server))
+ (with-current-buffer buffer (eglot--managed-mode-onoff server -1)))
+ ;; Kill any expensive watches
+ (maphash (lambda (_id watches)
+ (mapcar #'file-notify-rm-watch watches))
+ (eglot--file-watches server))
+ ;; Sever the project/server relationship for `server'
+ (setf (gethash (eglot--project server) eglot--servers-by-project)
+ (delq server
+ (gethash (eglot--project server) eglot--servers-by-project)))
+ (cond ((eglot--shutdown-requested server)
+ (setf (eglot--shutdown-requested server) :sentinel-done))
+ ((not (eglot--inhibit-autoreconnect server))
+ (eglot--warn "Reconnecting after unexpected server exit.")
+ (eglot-reconnect server))
+ ((timerp (eglot--inhibit-autoreconnect server))
+ (eglot--warn "Not auto-reconnecting, last one didn't last long."))))
(defun eglot--all-major-modes ()
- "Return all know major modes."
+ "Return all known major modes."
(let ((retval))
(mapatoms (lambda (sym)
(when (plist-member (symbol-plist sym) 'derived-mode-parent)
(ignore-errors (funcall mode))
(insert string) (font-lock-ensure) (buffer-string))))
+ (defcustom eglot-ignored-server-capabilites (list)
+ "LSP server capabilities that Eglot could use, but won't.
+ You could add, for instance, the symbol
+ `:documentHighlightProvider' to prevent automatic highlighting
+ under cursor."
+ :type '(repeat symbol))
+
(defun eglot--server-capable (&rest feats)
"Determine if current server is capable of FEATS."
- (cl-loop for caps = (eglot--capabilities (jsonrpc-current-connection-or-lose))
- then (cadr probe)
- for feat in feats
- for probe = (plist-member caps feat)
- if (not probe) do (cl-return nil)
- if (eq (cadr probe) t) do (cl-return t)
- if (eq (cadr probe) :json-false) do (cl-return nil)
- finally (cl-return (or probe t))))
+ (unless (cl-some (lambda (feat)
+ (memq feat eglot-ignored-server-capabilites))
+ feats)
- (cl-loop for caps = (eglot--capabilities (eglot--current-server-or-lose))
++ (cl-loop for caps = (eglot--capabilities (jsonrpc-current-connection-or-lose))
+ then (cadr probe)
+ for feat in feats
+ for probe = (plist-member caps feat)
+ if (not probe) do (cl-return nil)
+ if (eq (cadr probe) t) do (cl-return t)
+ if (eq (cadr probe) :json-false) do (cl-return nil)
+ finally (cl-return (or probe t)))))
(defun eglot--range-region (range &optional markers)
"Return region (BEG . END) that represents LSP RANGE.
"Make an interactive lambda for calling WHAT from mode-line."
(lambda (event)
(interactive "e")
- (with-selected-window (posn-window (event-start event))
- (call-interactively what)
- (force-mode-line-update t))))
+ (let ((start (event-start event))) (with-selected-window (posn-window start)
+ (save-excursion
+ (goto-char (or (posn-point start)
+ (point)))
- (call-interactively what))))))
++ (call-interactively what)
++ (force-mode-line-update t))))))
(defun eglot--mode-line-props (thing face defs &optional prepend)
"Helper for function `eglot--mode-line-format'.
(or (cdr bounds) (point))
(completion-table-with-cache
(lambda (_ignored)
- (let* ((resp (eglot--request server
- :textDocument/completion
- (eglot--TextDocumentPositionParams)
- :textDocument/completion))
+ (let* ((resp (jsonrpc-request server
+ :textDocument/completion
+ (eglot--TextDocumentPositionParams)
+ :deferred :textDocument/completion))
(items (if (vectorp resp) resp (plist-get resp :items))))
(mapcar
- (eglot--lambda (&rest all &key label insertText &allow-other-keys)
+ (jsonrpc-lambda (&rest all &key label insertText &allow-other-keys)
(let ((insert (or insertText label)))
- (add-text-properties 0 1 all insert) insert))
+ (add-text-properties 0 1 all insert)
+ (put-text-property 0 1 'eglot--lsp-completion all insert)
+ insert))
items))))
:annotation-function
(lambda (obj)
(or (get-text-property 0 :sortText b) "")))))
:company-doc-buffer
(lambda (obj)
- (let ((documentation
- (or (get-text-property 0 :documentation obj)
- (and (eglot--server-capable :completionProvider
- :resolveProvider)
- (plist-get (jsonrpc-request server :completionItem/resolve
- (text-properties-at 0 obj))
- :documentation)))))
+ (let* ((documentation
+ (or (get-text-property 0 :documentation obj)
+ (and (eglot--server-capable :completionProvider
+ :resolveProvider)
+ (plist-get
- (eglot--request server :completionItem/resolve
- (get-text-property
- 0 'eglot--lsp-completion obj))
++ (jsonrpc-request server :completionItem/resolve
++ (get-text-property
++ 0 'eglot--lsp-completion obj))
+ :documentation)))))
(when documentation
(with-current-buffer (get-buffer-create " *eglot doc*")
(insert (eglot--format-markup documentation))
(unless (eglot--server-capable :renameProvider)
(eglot--error "Server can't rename!"))
(eglot--apply-workspace-edit
- (eglot--request (eglot--current-server-or-lose)
- :textDocument/rename `(,@(eglot--TextDocumentPositionParams)
- :newName ,newname))
+ (jsonrpc-request (jsonrpc-current-connection-or-lose)
+ :textDocument/rename `(,@(eglot--TextDocumentPositionParams)
+ :newName ,newname))
current-prefix-arg))
- (let* ((server (eglot--current-server-or-lose))
- (actions (eglot--request
+
+ (defun eglot-code-actions (&optional beg end)
+ "Get and offer to execute code actions between BEG and END."
+ (interactive
+ (let (diags)
+ (cond ((region-active-p) (list (region-beginning) (region-end)))
+ ((setq diags (flymake-diagnostics (point)))
+ (list (cl-reduce #'min (mapcar #'flymake-diagnostic-beg diags))
+ (cl-reduce #'max (mapcar #'flymake-diagnostic-end diags))))
+ (t (list (point-min) (point-max))))))
+ (unless (eglot--server-capable :codeActionProvider)
+ (eglot--error "Server can't execute code actions!"))
- (menu-items (mapcar (eglot--lambda (&key title command arguments)
++ (let* ((server (jsonrpc-current-connection-or-lose))
++ (actions (jsonrpc-request
+ server
+ :textDocument/codeAction
+ (list :textDocument (eglot--TextDocumentIdentifier)
+ :range (list :start (eglot--pos-to-lsp-position beg)
+ :end (eglot--pos-to-lsp-position end))
+ :context
+ `(:diagnostics
+ [,@(mapcar (lambda (diag)
+ (cdr (assoc 'eglot-lsp-diag
+ (eglot--diag-data diag))))
+ (flymake-diagnostics beg end))]))))
- (eglot--request server :workspace/executeCommand command-and-args)
++ (menu-items (mapcar (jsonrpc-lambda (&key title command arguments)
+ `(,title . (:command ,command :arguments ,arguments)))
+ actions))
+ (menu (and menu-items `("Eglot code actions:" ("dummy" ,@menu-items))))
+ (command-and-args
+ (and menu
+ (if (listp last-nonmenu-event)
+ (x-popup-menu last-nonmenu-event menu)
+ (let ((never-mind (gensym)) retval)
+ (setcdr (cadr menu)
+ (cons `("never mind..." . ,never-mind) (cdadr menu)))
+ (if (eq (setq retval (tmm-prompt menu)) never-mind)
+ (keyboard-quit)
+ retval))))))
+ (if command-and-args
++ (jsonrpc-request server :workspace/executeCommand command-and-args)
+ (eglot--message "No code actions here"))))
+
+
\f
;;; Dynamic registration
;;;
projects / emacs.git / commitdiff