:type '(choice (boolean :tag "Whether to inhibit autoreconnection")
(integer :tag "Number of seconds")))
-(defmacro eglot--obj (&rest what)
+ \f
+ ;;; API (WORK-IN-PROGRESS!)
+ ;;;
-(cl-defgeneric eglot-server-ready-p (server what) ;; API
- "Tell if SERVER is ready for WHAT in current buffer.
-If it isn't, a deferrable `eglot--async-request' *will* be
-deferred to the future."
- (:method (_s _what) "Normally ready if no outstanding changes."
- (not (eglot--outstanding-edits-p))))
-
++(defmacro eglot--obj (&rest what)
+ "Make WHAT a JSON object suitable for `json-encode'."
+ (declare (debug (&rest form)))
+ ;; FIXME: not really API. Should it be?
+ ;; FIXME: maybe later actually do something, for now this just fixes
+ ;; the indenting of literal plists.
+ `(list ,@what))
+
-\f
-;;; Process management
-(defvar eglot--servers-by-project (make-hash-table :test #'equal)
- "Keys are projects. Values are lists of processes.")
-
-(defclass eglot-lsp-server ()
- ((process
- :documentation "Wrapped process object."
- :initarg :process :accessor eglot--process)
- (name
- :documentation "Readable name used for naming processes, buffers, etc..."
- :initarg :name :accessor eglot--name)
- (project-nickname
+ (cl-defgeneric eglot-handle-request (server method id &rest params)
+ "Handle SERVER's METHOD request with ID and PARAMS.")
+
+ (cl-defgeneric eglot-handle-notification (server method id &rest params)
+ "Handle SERVER's METHOD notification with PARAMS.")
+
+ (cl-defgeneric eglot-initialization-options (server)
+ "JSON object to send under `initializationOptions'"
+ (:method (_s) nil)) ; blank default
+
+ (cl-defgeneric eglot-client-capabilities (server)
+ "What the EGLOT LSP client supports for SERVER."
+ (:method (_s)
+ (eglot--obj
+ :workspace (eglot--obj
+ :applyEdit t
+ :workspaceEdit `(:documentChanges :json-false)
+ :didChangeWatchesFiles `(:dynamicRegistration t)
+ :symbol `(:dynamicRegistration :json-false))
+ :textDocument
+ (eglot--obj
+ :synchronization (eglot--obj
+ :dynamicRegistration :json-false
+ :willSave t :willSaveWaitUntil t :didSave t)
+ :completion `(:dynamicRegistration :json-false)
+ :hover `(:dynamicRegistration :json-false)
+ :signatureHelp `(:dynamicRegistration :json-false)
+ :references `(:dynamicRegistration :json-false)
+ :definition `(:dynamicRegistration :json-false)
+ :documentSymbol `(:dynamicRegistration :json-false)
+ :documentHighlight `(:dynamicRegistration :json-false)
+ :rename `(:dynamicRegistration :json-false)
+ :publishDiagnostics `(:relatedInformation :json-false))
+ :experimental (eglot--obj))))
+
- (pending-continuations
- :documentation "Map request ID's to (SUCCESS-FN ERROR-FN TIMEOUT-FN) triads."
- :initform (make-hash-table) :accessor eglot--pending-continuations)
- (events-buffer
- :documentation "Buffer holding a log of server-related events."
- :accessor eglot--events-buffer)
++(defclass eglot-lsp-server (jsonrpc-process-connection)
++ ((project-nickname
+ :documentation "Short nickname for the associated project."
+ :initarg :project-nickname :accessor eglot--project-nickname)
+ (major-mode
+ :documentation "Major mode symbol."
+ :initarg :major-mode :accessor eglot--major-mode)
- (status
- :documentation "List (STATUS SERIOUS-P) representing server problems/status."
- :initform `(:unknown nil) :accessor eglot--status)
+ (capabilities
+ :documentation "JSON object containing server capabilities."
+ :accessor eglot--capabilities)
+ (moribund
+ :documentation "Flag set when server is shutting down."
+ :accessor eglot--moribund)
+ (project
+ :documentation "Project associated with server."
+ :initarg :project :accessor eglot--project)
+ (spinner
+ :documentation "List (ID DOING-WHAT DONE-P) representing server progress."
+ :initform `(nil nil t) :accessor eglot--spinner)
- (contact
- :documentation "How server was started and how it can be re-started."
- :initarg :contact :accessor eglot--contact)
- (deferred-actions
- :documentation "Map (DEFERRED-ID BUF) to (FN TIMER).
-DEFERRED request from BUF is FN. It's sent later, not later than TIMER."
- :initform (make-hash-table :test #'equal) :accessor eglot--deferred-actions)
+ (inhibit-autoreconnect
+ :documentation "Generalized boolean inhibiting auto-reconnection if true."
+ :initarg :inhibit-autoreconnect :accessor eglot--inhibit-autoreconnect)
-(cl-defmethod cl-print-object ((obj eglot-lsp-server) stream)
- (princ (format "#<%s: %s>" (eieio-object-class obj) (eglot--name obj)) stream))
-
-(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)))
+ (file-watches
+ :documentation "Map ID to list of WATCHES for `didChangeWatchedFiles'."
+ :initform (make-hash-table :test #'equal) :accessor eglot--file-watches)
+ (managed-buffers
+ :documentation "List of buffers managed by server."
+ :initarg :managed-buffers :accessor eglot--managed-buffers))
+ :documentation
+ "Represents a server. Wraps a process for LSP communication.")
+
- (defvar eglot--processes-by-project (make-hash-table :test #'equal)
+\f
+;;; Process management
++(defvar eglot--servers-by-project (make-hash-table :test #'equal)
+ "Keys are projects. Values are lists of processes.")
- (jsonrpc-define-process-var eglot--major-mode nil
- "The major-mode this server is managing.")
-
- (jsonrpc-define-process-var eglot--capabilities :unreported
- "Holds list of capabilities that server reported")
-
- (jsonrpc-define-process-var eglot--project nil
- "The project the server belongs to.")
-
- (jsonrpc-define-process-var eglot--spinner `(nil nil t)
- "\"Spinner\" used by some servers.
- A list (ID WHAT DONE-P).")
-
- (jsonrpc-define-process-var eglot--moribund nil
- "Non-nil if server is about to exit")
-
- (jsonrpc-define-process-var eglot--inhibit-autoreconnect eglot-autoreconnect
- "If non-nil, don't autoreconnect on unexpected quit.")
-
- (jsonrpc-define-process-var eglot--file-watches (make-hash-table :test #'equal)
- "File system watches for the didChangeWatchedfiles thingy.")
-(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--on-shutdown (proc)
- "Called by jsonrpc.el when PROC is already dead."
-(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* ((buffer (get-buffer-create (format "*%s stdout*" name)))
- (proc (cond
- ((processp contact) contact)
- ((integerp (cadr contact))
- (apply #'open-network-stream name buffer contact))
- (t (make-process
- :name name
- :command contact
- :coding 'no-conversion
- :connection-type 'pipe
- :stderr (get-buffer-create (format "*%s stderr*" name)))))))
- (set-process-buffer proc buffer)
- (set-marker (process-mark proc) (with-current-buffer buffer (point-min)))
- (set-process-filter proc #'eglot--process-filter)
- (set-process-sentinel proc #'eglot--process-sentinel)
- (with-current-buffer buffer
- (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--moribund 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)))
++ (when (process-live-p (jsonrpc--process server))
++ (eglot--warn "Brutally deleting non-compliant server %s" (jsonrpc-name server))
++ (delete-process (jsonrpc--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 proc))
- (with-current-buffer buffer (eglot--managed-mode-onoff proc -1)))
++ (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 proc))
++ (eglot--file-watches server))
+ ;; 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))
++ (setf (gethash (eglot--project server) eglot--servers-by-project)
++ (delq server
++ (gethash (eglot--project server) eglot--servers-by-project)))
++ (cond ((eglot--moribund server))
++ ((not (eglot--inhibit-autoreconnect server))
+ (eglot--warn "Reconnecting after unexpected server exit.")
- (eglot-reconnect proc))
- ((timerp (eglot--inhibit-autoreconnect proc))
++ (eglot-reconnect server))
++ ((timerp (eglot--inhibit-autoreconnect server))
+ (eglot--warn "Not auto-reconnecting, last one didn't last long."))))
- (defun eglot-shutdown (proc &optional _interactive)
- "Politely ask the server PROC to quit.
- Forcefully quit it if it doesn't respond. Don't leave this
- function with the server still running. INTERACTIVE is t if
- called interactively."
- (interactive (list (jsonrpc-current-process-or-lose) t))
- (eglot--message "Asking %s politely to terminate" proc)
- (unwind-protect
- (progn
- (setf (eglot--moribund proc) t)
- (jsonrpc-request proc :shutdown nil :timeout 3)
- ;; this one should always fail, hence ignore-errors
- (ignore-errors (jsonrpc-request proc :exit nil)))
- ;; Turn off `eglot--managed-mode' where appropriate.
- (dolist (buffer (eglot--managed-buffers proc))
- (with-current-buffer buffer (eglot--managed-mode-onoff proc -1)))
- (when (process-live-p proc)
- (eglot--warn "Brutally deleting non-compliant %s" proc)
- (delete-process proc))))
-
- (defun eglot--find-current-process ()
- "The current logical EGLOT process."
- (let* ((probe (or (project-current) `(transient . ,default-directory))))
- (cl-find major-mode (gethash probe eglot--processes-by-project)
- :key #'eglot--major-mode)))
-
- (jsonrpc-define-process-var eglot--managed-buffers nil
- "Buffers managed by the server.")
-
- (defun eglot--project-short-name (project)
- "Give PROJECT a short name."
- (file-name-base (directory-file-name (car (project-roots project)))))
-
(defun eglot--all-major-modes ()
"Return all know major modes."
(let ((retval))
(push sym retval))))
retval))
- (defun eglot--client-capabilities ()
- "What the EGLOT LSP client supports."
- (jsonrpc-obj
- :workspace (jsonrpc-obj
- :applyEdit t
- :workspaceEdit `(:documentChanges :json-false)
- :didChangeWatchesFiles `(:dynamicRegistration t)
- :symbol `(:dynamicRegistration :json-false))
- :textDocument (jsonrpc-obj
- :synchronization (jsonrpc-obj
- :dynamicRegistration :json-false
- :willSave t :willSaveWaitUntil t :didSave t)
- :completion `(:dynamicRegistration :json-false)
- :hover `(:dynamicRegistration :json-false)
- :signatureHelp `(:dynamicRegistration :json-false)
- :references `(:dynamicRegistration :json-false)
- :definition `(:dynamicRegistration :json-false)
- :documentSymbol `(:dynamicRegistration :json-false)
- :documentHighlight `(:dynamicRegistration :json-false)
- :rename `(:dynamicRegistration :json-false)
- :publishDiagnostics `(:relatedInformation :json-false))
- :experimental (jsonrpc-obj)))
-(defvar eglot-connect-hook nil "Hook run after connecting in `eglot--connect'.")
-
-(defun eglot--connect (project managed-major-mode contact server-class)
- "Connect for PROJECT, MANAGED-MAJOR-MODE and CONTACT.
-INTERACTIVE is t if inside interactive call. Return an object of
-class SERVER-CLASS."
- (let* ((nickname (file-name-base (directory-file-name
- (car (project-roots project)))))
- (name (format "EGLOT (%s/%s)" nickname managed-major-mode))
- (proc (eglot--make-process
- name (if (functionp contact) (funcall contact) contact)))
- server connect-success)
- (setq server
- (make-instance
- (or server-class 'eglot-lsp-server)
- :process proc :major-mode managed-major-mode
- :project project :contact contact
- :name name :project-nickname nickname
- :inhibit-autoreconnect
- (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))))))))
- (push server (gethash project eglot--servers-by-project))
- (process-put proc 'eglot-server server)
- (unwind-protect
- (cl-destructuring-bind (&key capabilities)
- (eglot--request
- server
- :initialize
- (eglot--obj
- :processId (unless (eq (process-type proc) 'network) (emacs-pid))
- :capabilities (eglot-client-capabilities server)
- :rootPath (expand-file-name (car (project-roots project)))
- :rootUri (eglot--path-to-uri (car (project-roots project)))
- :initializationOptions (eglot-initialization-options server)))
- (setf (eglot--capabilities server) capabilities)
- (setf (eglot--status server) nil)
- (dolist (buffer (buffer-list))
- (with-current-buffer buffer
- (eglot--maybe-activate-editing-mode server)))
- (eglot--notify server :initialized (eglot--obj :__dummy__ t))
- (run-hook-with-args 'eglot-connect-hook server)
- (setq connect-success server))
- (unless (or connect-success
- (not (process-live-p proc)) (eglot--moribund server))
- (eglot-shutdown server)))))
--
(defvar eglot--command-history nil
- "History of COMMAND arguments to `eglot'.")
+ "History of CONTACT arguments to `eglot'.")
(defun eglot--interactive ()
"Helper for `eglot'."
(symbol-name guessed-mode) nil (symbol-name guessed-mode) nil)))
(t guessed-mode)))
(project (or (project-current) `(transient . ,default-directory)))
- (guessed (cdr (assoc managed-mode eglot-server-programs)))
- (program (and (listp guessed) (stringp (car guessed)) (car guessed)))
+ (guess (cdr (assoc managed-mode eglot-server-programs)))
- (class (and (consp guess) (symbolp (car guess))
- (prog1 (car guess) (setq guess (cdr guess)))))
++ (class (if (and (consp guess) (symbolp (car guess)))
++ (prog1 (car guess) (setq guess (cdr guess)))
++ 'eglot-lsp-server))
+ (program (and (listp guess) (stringp (car guess)) (car guess)))
(base-prompt "[eglot] Enter program to execute (or <host>:<port>): ")
(prompt
(cond (current-prefix-arg base-prompt)
(string-trim s))
(list (match-string 1 s) (string-to-number (match-string 2 s)))
(split-string-and-unquote s)))
- guessed)))
- (list managed-mode project contact t)))
+ guess)))
- (list managed-mode project contact class t)))
++ (list managed-mode project (cons class contact) t)))
;;;###autoload
-(defun eglot (managed-major-mode project command server-class
- &optional interactive)
+(defun eglot (managed-major-mode project contact &optional interactive)
"Manage a project with a Language Server Protocol (LSP) server.
--The LSP server is started (or contacted) via COMMAND. If this
++The LSP server is started (or contacted) via CONTACT. If this
operation is successful, current *and future* file buffers of
MANAGED-MAJOR-MODE inside PROJECT automatically become
\"managed\" by the LSP server, meaning information about their
PROJECT is a project instance as returned by `project-current'.
- CONTACT is a list of strings (COMMAND [ARGS...]) specifying how
- to start a server subprocess to connect to. If the second
- element in the list is an integer number instead of a string, the
- list is interpreted as (HOST PORT [PARAMETERS...]) to connect to
- an existing server via TCP, the remaining PARAMETERS being given
- as `open-network-stream's optional arguments. CONTACT can also
- be a function of no arguments returning a live connected process
- object.
-COMMAND is a list of strings, an executable program and
-optionally its arguments. If the first and only string in the
-list is of the form \"<host>:<port>\" it is taken as an
-indication to connect to a server instead of starting one. This
-is also know as the server's \"contact\".
++CONTACT specifies how to contact the server. It can be:
++
++* a list of strings (COMMAND [ARGS...]) specifying how
++to start a server subprocess to connect to.
++
++* A list with a string as the first element and an integer number
++as the second list is interpreted as (HOST PORT [PARAMETERS...])
++and connects to an existing server via TCP, with the remaining
++PARAMETERS being given as `open-network-stream's optional
++arguments.
- MANAGED-MAJOR-MODE is an Emacs major mode.
-SERVER-CLASS is a symbol naming a class that must inherit from
-`eglot-server', or nil to use the default server class.
++* A list (CLASS-SYM CONTACT...) where CLASS-SYM names the
++subclass of `eglot-server' used to create the server object. The
++remaining arguments are processed as described in the previous
++paragraphs.
++
++* A function of arguments returning arguments compatible with the
++previous description.
INTERACTIVE is t if called interactively."
(interactive (eglot--interactive))
- (let* ((short-name (eglot--project-short-name project)))
- (let ((current-process (jsonrpc-current-process)))
- (if (and (process-live-p current-process)
- interactive
- (y-or-n-p "[eglot] Live process found, reconnect instead? "))
- (eglot-reconnect current-process interactive)
- (when (process-live-p current-process)
- (eglot-shutdown current-process))
- (let ((proc (eglot--connect project
- (let ((current-server (eglot--current-server)))
- (if (and current-server
- (process-live-p (eglot--process current-server))
++ (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 (jsonrpc--process current-server)))))
++ (if (and live-p
+ interactive
+ (y-or-n-p "[eglot] Live process found, reconnect instead? "))
+ (eglot-reconnect current-server interactive)
- (when (and current-server
- (process-live-p (eglot--process current-server)))
- (eglot-shutdown current-server))
++ (when live-p (eglot-shutdown current-server))
+ (let ((server (eglot--connect project
managed-major-mode
- (format "%s/%s" short-name managed-major-mode)
- command
- server-class)))
- (eglot--message "Connected! Server `%s' now \
++ (format "%s/%s" nickname managed-major-mode)
++ nickname
+ contact)))
- (eglot--message "Connected! Process `%s' now \
++ (eglot--message "Connected! Process `%s' now \
managing `%s' buffers in project `%s'."
- proc managed-major-mode short-name)
- proc)))))
- (eglot--name server) managed-major-mode
- (eglot--project-nickname server))
++ (jsonrpc-name server) managed-major-mode
++ nickname)
+ server))))
- (defun eglot-reconnect (process &optional interactive)
- "Reconnect to PROCESS.
+ (defun eglot-reconnect (server &optional interactive)
+ "Reconnect to SERVER.
INTERACTIVE is t if called interactively."
- (interactive (list (jsonrpc-current-process-or-lose) t))
- (when (process-live-p process)
- (eglot-shutdown process interactive))
- (eglot--connect (eglot--project process)
- (eglot--major-mode process)
- (jsonrpc-name process)
- (jsonrpc-contact process))
- (interactive (list (eglot--current-server-or-lose) t))
- (when (process-live-p (eglot--process server))
++ (interactive (list (jsonrpc-current-connection-or-lose) t))
++ (when (process-live-p (jsonrpc--process server))
+ (eglot-shutdown server interactive))
+ (eglot--connect (eglot--project server)
+ (eglot--major-mode server)
- (eglot--contact server)
- (eieio-object-class server))
++ (jsonrpc-name server)
++ (eglot--project-nickname server)
++ (jsonrpc-contact server))
(eglot--message "Reconnected!"))
-(defun eglot--process-sentinel (proc change)
- "Called when PROC undergoes CHANGE."
- (let ((server (process-get proc 'eglot-server)))
- (eglot--log-event server `(:message "Process state changed" :change ,change))
- (when (not (process-live-p proc))
- (with-current-buffer (eglot-events-buffer server)
- (let ((inhibit-read-only t))
- (insert "\n----------b---y---e---b---y---e----------\n")))
- ;; Cancel outstanding timers and file system watches
- (maphash (lambda (_id triplet)
- (cl-destructuring-bind (_success _error timeout) triplet
- (cancel-timer timeout)))
- (eglot--pending-continuations server))
- (maphash (lambda (_id watches)
- (mapcar #'file-notify-rm-watch watches))
- (eglot--file-watches server))
- (unwind-protect
- ;; Call all outstanding error handlers
- (maphash (lambda (_id triplet)
- (cl-destructuring-bind (_success error _timeout) triplet
- (funcall error `(:code -1 :message "Server died"))))
- (eglot--pending-continuations server))
- ;; Turn off `eglot--managed-mode' where appropriate.
- (dolist (buffer (eglot--managed-buffers server))
- (with-current-buffer buffer (eglot--managed-mode-onoff server -1)))
- ;; Forget about the process-project relationship
- (setf (gethash (eglot--project server) eglot--servers-by-project)
- (delq server
- (gethash (eglot--project server) eglot--servers-by-project)))
- ;; Say last words
- (eglot--message "%s exited with status %s" (eglot--name server)
- (process-exit-status
- (eglot--process server)))
- (delete-process proc)
- ;; Consider autoreconnecting
- (cond ((eglot--moribund server))
- ((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 on didn't last long.")))))))
-
-(defun eglot--process-filter (proc string)
- "Called when new data STRING has arrived for PROC."
- (when (buffer-live-p (process-buffer proc))
- (with-current-buffer (process-buffer proc)
- (let ((inhibit-read-only t)
- (expected-bytes (process-get proc 'eglot-expected-bytes)))
- ;; Insert the text, advancing the process marker.
- ;;
- (save-excursion
- (goto-char (process-mark proc))
- (insert string)
- (set-marker (process-mark proc) (point)))
- ;; Loop (more than one message might have arrived)
- ;;
- (unwind-protect
- (let (done)
- (while (not done)
- (cond
- ((not expected-bytes)
- ;; Starting a new message
- ;;
- (setq expected-bytes
- (and (search-forward-regexp
- "\\(?:.*: .*\r\n\\)*Content-Length: \
-*\\([[:digit:]]+\\)\r\n\\(?:.*: .*\r\n\\)*\r\n"
- (+ (point) 100)
- t)
- (string-to-number (match-string 1))))
- (unless expected-bytes
- (setq done :waiting-for-new-message)))
- (t
- ;; Attempt to complete a message body
- ;;
- (let ((available-bytes (- (position-bytes (process-mark proc))
- (position-bytes (point)))))
- (cond
- ((>= available-bytes
- expected-bytes)
- (let* ((message-end (byte-to-position
- (+ (position-bytes (point))
- expected-bytes))))
- (unwind-protect
- (save-restriction
- (narrow-to-region (point) message-end)
- (let* ((json-object-type 'plist)
- (json-message (json-read)))
- ;; Process content in another buffer,
- ;; shielding buffer from tamper
- ;;
- (with-temp-buffer
- (eglot--server-receive
- (process-get proc 'eglot-server)
- json-message))))
- (goto-char message-end)
- (delete-region (point-min) (point))
- (setq expected-bytes nil))))
- (t
- ;; Message is still incomplete
- ;;
- (setq done :waiting-for-more-bytes-in-this-message))))))))
- ;; Saved parsing state for next visit to this filter
- ;;
- (process-put proc 'eglot-expected-bytes expected-bytes))))))
-
-(defun eglot-events-buffer (server &optional interactive)
- "Display events buffer for current LSP SERVER.
-INTERACTIVE is t if called interactively."
- (interactive (list (eglot--current-server-or-lose) t))
- (let* ((probe (eglot--events-buffer server))
- (buffer (or (and (buffer-live-p probe) probe)
- (let ((buffer (get-buffer-create
- (format "*%s events*"
- (eglot--name server)))))
- (with-current-buffer buffer
- (buffer-disable-undo)
- (read-only-mode t)
- (setf (eglot--events-buffer server) buffer))
- buffer))))
- (when interactive (display-buffer buffer))
- buffer))
-
-(defun eglot--log-event (server message &optional type)
- "Log an eglot-related event.
-SERVER is the current server. MESSAGE is a JSON-like plist.
-TYPE is a symbol saying if this is a client or server
-originated."
- (with-current-buffer (eglot-events-buffer server)
- (cl-destructuring-bind (&key method id error &allow-other-keys) message
- (let* ((inhibit-read-only t)
- (subtype (cond ((and method id) 'request)
- (method 'notification)
- (id 'reply)
- (t 'message)))
- (type
- (format "%s-%s" (or type :internal) subtype)))
- (goto-char (point-max))
- (let ((msg (format "%s%s%s:\n%s\n"
- type
- (if id (format " (id:%s)" id) "")
- (if error " ERROR" "")
- (pp-to-string message))))
- (when error
- (setq msg (propertize msg 'face 'error)))
- (insert-before-markers msg))))))
-
-(defun eglot--server-receive (server message)
- "Process MESSAGE from SERVER."
- (cl-destructuring-bind (&key method id params error result _jsonrpc) message
- (let* ((continuations (and id
- (not method)
- (gethash id (eglot--pending-continuations server)))))
- (eglot--log-event server message 'server)
- (when error (setf (eglot--status server) `(,error t)))
- (unless (or (null method)
- (keywordp method))
- (setq method (intern (format ":%s" method))))
- (cond ((and method id)
- (condition-case-unless-debug _err
- (apply #'eglot-handle-request server id method params)
- (cl-no-applicable-method
- (eglot--reply server id
- :error `(:code -32601 :message "Method unimplemented")))))
- (method
- (condition-case-unless-debug _err
- (apply #'eglot-handle-notification server method params)
- (cl-no-applicable-method
- (eglot--log-event
- server '(:error `(:message "Notification unimplemented"))))))
- (continuations
- (cancel-timer (cl-third continuations))
- (remhash id (eglot--pending-continuations server))
- (if error
- (funcall (cl-second continuations) error)
- (funcall (cl-first continuations) result)))
- (id
- (eglot--warn "Ooops no continuation for id %s" id)))
- (eglot--call-deferred server)
+(defalias 'eglot-events-buffer 'jsonrpc-events-buffer)
+
+(defvar eglot-connect-hook nil "Hook run after connecting in `eglot--connect'.")
+
- (defun eglot--dispatch (proc method id params)
++(defun eglot--dispatch (server method id params)
+ "Dispatcher passed to `jsonrpc-connect'.
- Builds a function from METHOD, passes it PROC, ID and PARAMS."
- (let* ((handler-sym (intern (format "eglot--server-%s" method))))
- (if (functionp handler-sym) ;; FIXME: fails if params is array, not object
- (apply handler-sym proc (append params (if id `(:id ,id))))
- (jsonrpc-reply proc id
- :error (jsonrpc-obj :code -32601 :message "Unimplemented")))
- (force-mode-line-update t)))
-
- (defun eglot--connect (project managed-major-mode name contact)
++Calls a function on SERVER, METHOD ID and PARAMS."
++ (let ((method (intern (format ":%s" method))))
++ (if id
++ (apply #'eglot-handle-request server id method params)
++ (apply #'eglot-handle-notification server method params)
+ (force-mode-line-update t))))
+
-(defun eglot--send (server message)
- "Send MESSAGE to SERVER (ID is optional)."
- (let ((json (json-encode message)))
- (process-send-string (eglot--process server)
- (format "Content-Length: %d\r\n\r\n%s"
- (string-bytes json) json))
- (eglot--log-event server message 'client)))
-
-(defvar eglot--next-request-id 0 "ID for next request.")
-
-(defun eglot--next-request-id ()
- "Compute the next id for a client request."
- (setq eglot--next-request-id (1+ eglot--next-request-id)))
-
-(defun eglot-forget-pending-continuations (server)
- "Stop waiting for responses from the current LSP SERVER."
- (interactive (list (eglot--current-server-or-lose)))
- (clrhash (eglot--pending-continuations server)))
-
-(defun eglot-clear-status (server)
- "Clear most recent error message from SERVER."
- (interactive (list (eglot--current-server-or-lose)))
- (setf (eglot--status server) nil)
- (force-mode-line-update t))
-
-(defun eglot--call-deferred (server)
- "Call SERVER's deferred actions, who may again defer themselves."
- (when-let ((actions (hash-table-values (eglot--deferred-actions server))))
- (eglot--log-event server `(:running-deferred ,(length actions)))
- (mapc #'funcall (mapcar #'car actions))))
-
-(cl-defmacro eglot--lambda (cl-lambda-list &body 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-defun eglot--async-request (server
- method
- params
- &rest args
- &key success-fn error-fn timeout-fn
- (timeout eglot-request-timeout)
- (deferred nil))
- "Make a request to SERVER expecting a reply later on.
-SUCCESS-FN and ERROR-FN are passed `:result' and `:error'
-objects, respectively. Wait TIMEOUT seconds for response or call
-nullary TIMEOUT-FN. If DEFERRED, maybe defer request to the
-future, or to never at all, in case a new request with identical
-DEFERRED and for the same buffer overrides it (however, if that
-happens, the original timeout keeps counting). Return a list (ID
-TIMER)."
- (let* ((id (eglot--next-request-id))
- (timer nil)
- (make-timer
- (lambda ( )
- (or timer
- (run-with-timer
- timeout nil
- (lambda ()
- (remhash id (eglot--pending-continuations server))
- (funcall (or timeout-fn
- (lambda ()
- (eglot--log-event
- server `(:timed-out ,method :id ,id
- :params ,params)))))))))))
- (when deferred
- (let* ((buf (current-buffer))
- (existing (gethash (list deferred buf)
- (eglot--deferred-actions server))))
- (when existing (setq existing (cadr existing)))
- (if (eglot-server-ready-p server deferred)
- (remhash (list deferred buf) (eglot--deferred-actions server))
- (eglot--log-event server `(:deferring ,method :id ,id :params ,params))
- (let* ((buf (current-buffer)) (point (point))
- (later (lambda ()
- (when (buffer-live-p buf)
- (with-current-buffer buf
- (save-excursion
- (goto-char point)
- (apply #'eglot--async-request server
- method params args)))))))
- (puthash (list deferred buf)
- (list later (setq timer (funcall make-timer)))
- (eglot--deferred-actions server))
- (cl-return-from eglot--async-request nil)))))
- ;; Really run it
- ;;
- (eglot--send server (eglot--obj :jsonrpc "2.0"
- :id id
- :method method
- :params params))
- (puthash id
- (list (or success-fn
- (eglot--lambda (&rest _ignored)
- (eglot--log-event
- server (eglot--obj :message "success ignored" :id id))))
- (or error-fn
- (eglot--lambda (&key code message &allow-other-keys)
- (setf (eglot--status server) `(,message t))
- server (eglot--obj :message "error ignored, status set"
- :id id :error code)))
- (setq timer (funcall make-timer)))
- (eglot--pending-continuations server))
- (list id timer)))
-
-(defun eglot--request (server method params &optional deferred)
- "Like `eglot--async-request' for SERVER, METHOD and PARAMS, but synchronous.
-Meaning only return locally if successful, otherwise exit non-locally.
-DEFERRED is passed to `eglot--async-request', which see."
- ;; HACK: A deferred sync request with outstanding changes is a bad
- ;; idea, since that might lead to the request never having a chance
- ;; to run, because idle timers don't run in `accept-process-output'.
- (when deferred (eglot--signal-textDocument/didChange))
- (let* ((done (make-symbol "eglot-catch")) id-and-timer
- (res
- (unwind-protect
- (catch done
- (setq
- id-and-timer
- (eglot--async-request
- server method params
- :success-fn (lambda (result) (throw done `(done ,result)))
- :timeout-fn (lambda () (throw done '(error "Timed out")))
- :error-fn (eglot--lambda (&key code message _data)
- (throw done `(error
- ,(format "Ooops: %s: %s" code message))))
- :deferred deferred))
- (while t (accept-process-output nil 30)))
- (pcase-let ((`(,id ,timer) id-and-timer))
- (when id (remhash id (eglot--pending-continuations server)))
- (when timer (cancel-timer timer))))))
- (when (eq 'error (car res)) (eglot--error (cadr res)))
- (cadr res)))
-
-(cl-defun eglot--notify (server method params)
- "Notify SERVER of something, don't expect a reply.e"
- (eglot--send server (eglot--obj :jsonrpc "2.0"
- :method method
- :params params)))
-
-(cl-defun eglot--reply (server id &key result error)
- "Reply to PROCESS's request ID with MESSAGE."
- (eglot--send
- server`(:jsonrpc "2.0" :id ,id
- ,@(when result `(:result ,result))
- ,@(when error `(:error ,error)))))
++(defun eglot--connect (project managed-major-mode name nickname contact)
++ "Connect to PROJECT, MANAGED-MAJOR-MODE, NAME.
++And NICKNAME and CONTACT."
+ (let* ((contact (if (functionp contact) (funcall contact) contact))
- (proc
++ (server
+ (jsonrpc-connect name contact #'eglot--dispatch #'eglot--on-shutdown))
+ success)
- (setf (eglot--project proc) project)
- (setf (eglot--major-mode proc)managed-major-mode)
- (push proc (gethash project eglot--processes-by-project))
- (run-hook-with-args 'eglot-connect-hook proc)
++ (setf (eglot--project server) project)
++ (setf (eglot--project-nickname server) nickname)
++ (setf (eglot--major-mode server) managed-major-mode)
++ (push server (gethash project eglot--servers-by-project))
++ (run-hook-with-args 'eglot-connect-hook server)
+ (unwind-protect
+ (cl-destructuring-bind (&key capabilities)
+ (jsonrpc-request
- proc
++ server
+ :initialize
- (jsonrpc-obj :processId (unless (eq (process-type proc)
++ (jsonrpc-obj :processId (unless (eq (process-type
++ (jsonrpc--process server))
+ 'network)
+ (emacs-pid))
+ :rootPath (expand-file-name
+ (car (project-roots project)))
+ :rootUri (eglot--path-to-uri
+ (car (project-roots project)))
- :initializationOptions []
- :capabilities (eglot--client-capabilities)))
- (setf (eglot--capabilities proc) capabilities)
- (setf (jsonrpc-status proc) nil)
++ :initializationOptions (eglot-initialization-options server)
++ :capabilities (eglot-client-capabilities server)))
++ (setf (eglot--capabilities server) capabilities)
++ (setf (jsonrpc-status server) nil)
+ (dolist (buffer (buffer-list))
+ (with-current-buffer buffer
- (eglot--maybe-activate-editing-mode proc)))
- (jsonrpc-notify proc :initialized (jsonrpc-obj :__dummy__ t))
- (setf (eglot--inhibit-autoreconnect proc)
++ (eglot--maybe-activate-editing-mode server)))
++ (jsonrpc-notify server :initialized (jsonrpc-obj :__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 proc)
++ (setf (eglot--inhibit-autoreconnect server)
+ (null eglot-autoreconnect)))))))
- (setq success proc))
- (unless (or success (not (process-live-p proc)) (eglot--moribund proc))
- (eglot-shutdown proc)))))
-
- (defun eglot--server-ready-p (_what _proc)
- "Tell if server of PROC ready for processing deferred WHAT."
- (not (eglot--outstanding-edits-p)))
++ (setq success server))
++ (unless (or success (not (process-live-p (jsonrpc--process server)))
++ (eglot--moribund server))
++ (eglot-shutdown server)))))
\f
;;; Helpers
(defun eglot--server-capable (&rest feats)
"Determine if current server is capable of FEATS."
- (cl-loop for caps = (eglot--capabilities (jsonrpc-current-process-or-lose))
- (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)
nil nil eglot-mode-map
(cond
(eglot--managed-mode
- (add-hook 'jsonrpc-find-process-functions 'eglot--find-current-process nil t)
++ (add-hook 'jsonrpc-find-connection-functions 'eglot--find-current-server nil t)
+ (add-hook 'jsonrpc-ready-predicates 'eglot--server-ready-p 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)
#'eglot-eldoc-function)
(add-function :around (local imenu-create-index-function) #'eglot-imenu))
(t
- (remove-hook 'jsonrpc-find-process-functions 'eglot--find-current-process t)
++ (remove-hook 'jsonrpc-find-connection-functions 'eglot--find-current-server t)
+ (remove-hook 'jsonrpc-ready-predicates 'eglot--server-ready-p 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)
(defvar-local eglot--current-flymake-report-fn nil
"Current flymake report function for this buffer")
- (defun eglot--maybe-activate-editing-mode (&optional proc)
++(defun eglot--find-current-server ()
++ "Find the current logical EGLOT server."
++ (let* ((probe (or (project-current) `(transient . ,default-directory))))
++ (cl-find major-mode (gethash probe eglot--servers-by-project)
++ :key #'eglot--major-mode)))
++
+ (defun eglot--maybe-activate-editing-mode (&optional server)
"Maybe activate mode function `eglot--managed-mode'.
- If PROC is supplied, do it only if BUFFER is managed by it. In
+ If SERVER is supplied, do it only if BUFFER is managed by it. In
that case, also signal textDocument/didOpen."
;; Called even when revert-buffer-in-progress-p
- (let* ((cur (and buffer-file-name (eglot--find-current-process)))
- (proc (or (and (null proc) cur) (and proc (eq proc cur) cur))))
- (when proc
- (eglot--managed-mode-onoff proc 1)
- (let* ((cur (and buffer-file-name (eglot--current-server)))
++ (let* ((cur (and buffer-file-name (eglot--find-current-server)))
+ (server (or (and (null server) cur) (and server (eq server cur) cur))))
+ (when server
+ (eglot--managed-mode-onoff server 1)
(eglot--signal-textDocument/didOpen)
(flymake-start)
(funcall (or eglot--current-flymake-report-fn #'ignore) nil))))
(defun eglot--mode-line-format ()
"Compose the EGLOT's mode-line."
- (pcase-let* ((proc (jsonrpc-current-process))
- (name (and (process-live-p proc) (jsonrpc-name proc)))
- (pending (and proc (length (jsonrpc-outstanding-request-ids proc))))
- (`(,_id ,doing ,done-p ,detail) (and proc (eglot--spinner proc)))
- (`(,status ,serious-p) (and proc (jsonrpc-status proc))))
- (pcase-let* ((server (eglot--current-server))
- (name (and
- server
- (eglot--project-nickname server)))
++ (pcase-let* ((server (jsonrpc-current-connection))
++ (nick (and server (eglot--project-nickname server)))
+ (pending (and server (hash-table-count
- (eglot--pending-continuations server))))
++ (jsonrpc--request-continuations server))))
+ (`(,_id ,doing ,done-p ,detail) (and server (eglot--spinner server)))
- (`(,status ,serious-p) (and server (eglot--status server))))
++ (`(,status ,serious-p) (and server (jsonrpc-status server))))
(append
`(,(eglot--mode-line-props "eglot" 'eglot-mode-line nil))
-- (when name
++ (when nick
`(":" ,(eglot--mode-line-props
-- name 'eglot-mode-line
++ nick'eglot-mode-line
'((mouse-1 eglot-events-buffer "go to events buffer")
(mouse-2 eglot-shutdown "quit server")
(mouse-3 eglot-reconnect "reconnect to server")))
`("/" ,(eglot--mode-line-props
"error" 'compilation-mode-line-fail
'((mouse-1 eglot-events-buffer "go to events buffer")
- (mouse-3 jrpc-clear-status "clear this status"))
- (mouse-3 eglot-clear-status "clear this status"))
++ (mouse-3 jsonrpc-clear-status "clear this status"))
(format "An error occured: %s\n" status))))
,@(when (and doing (not done-p))
`("/" ,(eglot--mode-line-props
'((mouse-1 eglot-events-buffer "go to events buffer")))))
,@(when (cl-plusp pending)
`("/" ,(eglot--mode-line-props
- (format "%d" pending) 'warning
+ (format "%d oustanding requests" pending) 'warning
'((mouse-1 eglot-events-buffer "go to events buffer")
- (mouse-3 jrpc-forget-pending-continuations
- "fahgettaboudit"))
- (mouse-3 eglot-clear-status "clear this status"))
-- (format "%d pending requests\n" pending)))))))))
++ (mouse-3 jsonrpc-forget-pending-continuations
++ "fahgettaboudit"))))))))))
(add-to-list 'mode-line-misc-info
`(eglot--managed-mode (" [" eglot--mode-line-format "] ")))
\f
;;; Protocol implementation (Requests, notifications, etc)
;;;
- (cl-defun eglot--server-window/showMessage (_process &key type message)
-(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 (eglot--current-server-or-lose) t))
- (eglot--message "Asking %s politely to terminate" (eglot--name server))
- (unwind-protect
- (let ((eglot-request-timeout 3))
- (setf (eglot--moribund server) t)
- (eglot--request server :shutdown nil)
- ;; this one is supposed to always fail, hence ignore-errors
- (ignore-errors (eglot--request server :exit nil)))
- ;; Turn off `eglot--managed-mode' where appropriate.
- (dolist (buffer (eglot--managed-buffers server))
- (with-current-buffer buffer (eglot--managed-mode-onoff server -1)))
- (when (process-live-p (eglot--process server))
- (eglot--warn "Brutally deleting non-compliant server %s" (eglot--name server))
- (delete-process (eglot--process server)))))
-
+ (cl-defmethod eglot-handle-notification
+ (_server (_method (eql :window/showMessage)) &key type message)
"Handle notification window/showMessage"
(eglot--message (propertize "Server reports (type=%s): %s"
'face (if (<= type 1) 'error))
'("OK"))
nil t (plist-get (elt actions 0) :title)))
(if reply
- (jsonrpc-reply process id :result (jsonrpc-obj :title reply))
- (jsonrpc-reply process id
- (eglot--reply server id :result (eglot--obj :title reply))
- (eglot--reply server id
- :error (eglot--obj :code -32800
- :message "User cancelled"))))))
++ (jsonrpc-reply server id :result (jsonrpc-obj :title reply))
++ (jsonrpc-reply server id
+ :error (jsonrpc-obj :code -32800
+ :message "User cancelled"))))))
- (cl-defun eglot--server-window/logMessage (_proc &key _type _message)
+ (cl-defmethod eglot-handle-notification
+ (_server (_method (eql :window/logMessage)) &key _type _message)
"Handle notification window/logMessage") ;; noop, use events buffer
- (cl-defun eglot--server-telemetry/event (_proc &rest _any)
+ (cl-defmethod eglot-handle-notification
+ (_server (_method (eql :telemetry/event)) &rest _any)
"Handle notification telemetry/event") ;; noop, use events buffer
(defvar-local eglot--unreported-diagnostics nil
(let (retval)
(unwind-protect
(setq retval (apply (intern (format "eglot--%s-%s" how method))
- proc :id id registerOptions))
+ server :id id registerOptions))
(unless (eq t (car retval))
(cl-return-from eglot--register-unregister
- (eglot--reply
+ (jsonrpc-reply
- proc jsonrpc-id
+ server jsonrpc-id
:error `(:code -32601 :message ,(or (cadr retval) "sorry")))))))))
- (jsonrpc-reply proc jsonrpc-id :result (jsonrpc-obj :message "OK")))
- (eglot--reply server jsonrpc-id :result (eglot--obj :message "OK")))
++ (jsonrpc-reply server jsonrpc-id :result (jsonrpc-obj :message "OK")))
- (cl-defun eglot--server-client/registerCapability
- (proc &key id registrations)
+ (cl-defmethod eglot-handle-request
+ (server id (_method (eql :client/registerCapability)) &key registrations)
"Handle server request client/registerCapability"
- (eglot--register-unregister proc id registrations 'register))
+ (eglot--register-unregister server id registrations 'register))
- (cl-defun eglot--server-client/unregisterCapability
- (proc &key id unregisterations) ;; XXX: Yeah, typo and all.. See spec...
+ (cl-defmethod eglot-handle-request
+ (server id (_method (eql :client/unregisterCapability))
+ &key unregisterations) ;; XXX: "unregisterations" (sic)
"Handle server request client/unregisterCapability"
- (eglot--register-unregister proc id unregisterations 'unregister))
+ (eglot--register-unregister server id unregisterations 'unregister))
- (cl-defun eglot--server-workspace/applyEdit
- (proc &key id _label edit)
+ (cl-defmethod eglot-handle-request
+ (server id (_method (eql :workspace/applyEdit)) &key _label edit)
"Handle server request workspace/applyEdit"
(condition-case err
(progn (eglot--apply-workspace-edit edit 'confirm)
- (jsonrpc-reply proc id :result `(:applied )))
- (error (jsonrpc-reply proc id
- (eglot--reply server id :result `(:applied )))
- (error (eglot--reply server id
- :result `(:applied :json-false)
- :error (eglot--obj :code -32001
- :message (format "%s" err))))))
++ (jsonrpc-reply server id :result `(:applied )))
++ (error (jsonrpc-reply server id
+ :result `(:applied :json-false)
- :error (jsonrpc-obj :code -32001
- :message (format "%s" err))))))
++ :error (eglot--obj :code -32001
++ :message (format "%s" err))))))
(defun eglot--TextDocumentIdentifier ()
"Compute TextDocumentIdentifier object for current buffer."
(cl-plusp (+ (length (car eglot--recent-changes))
(length (cdr eglot--recent-changes)))))
++(cl-defmethod jsonrpc-connection-ready-p ((_server eglot-lsp-server) _what)
++ "Tell if SERVER is ready for WHAT in current buffer.
++If it isn't, a deferrable `eglot--async-request' *will* be
++deferred to the future."
++ (and (cl-call-next-method)
++ (not (eglot--outstanding-edits-p))))
++
(defun eglot--before-change (start end)
"Hook onto `before-change-functions'.
Records START and END, crucially convert them into
(defun eglot--signal-textDocument/didChange ()
"Send textDocument/didChange to server."
(when (eglot--outstanding-edits-p)
- (let* ((proc (jsonrpc-current-process-or-lose))
- (let* ((server (eglot--current-server-or-lose))
++ (let* ((server (jsonrpc-current-connection-or-lose))
(sync-kind (eglot--server-capable :textDocumentSync))
(emacs-messup (/= (length (car eglot--recent-changes))
(length (cdr eglot--recent-changes))))
(eglot--warn "`eglot--recent-changes' messup: %s" eglot--recent-changes))
(save-restriction
(widen)
- (eglot--notify
+ (jsonrpc-notify
- proc :textDocument/didChange
+ server :textDocument/didChange
- (eglot--obj
+ (jsonrpc-obj
:textDocument
(eglot--VersionedTextDocumentIdentifier)
:contentChanges
(point-max))))
(cl-loop for (start-pos end-pos) across (car eglot--recent-changes)
for (len after-text) across (cdr eglot--recent-changes)
- vconcat `[,(eglot--obj :range (eglot--obj :start start-pos
- :end end-pos)
- :rangeLength len
- :text after-text)])))))
+ vconcat `[,(jsonrpc-obj :range (jsonrpc-obj :start start-pos
+ :end end-pos)
+ :rangeLength len
+ :text after-text)])))))
(setq eglot--recent-changes (cons [] []))
- (setf (eglot--spinner proc) (list nil :textDocument/didChange t))
+ (setf (eglot--spinner server) (list nil :textDocument/didChange t))
- (eglot--call-deferred server))))
+ ;; HACK!
- (jsonrpc--call-deferred proc))))
++ (jsonrpc--call-deferred server))))
(defun eglot--signal-textDocument/didOpen ()
"Send textDocument/didOpen to server."
(setq eglot--recent-changes (cons [] []))
- (eglot--notify
- (eglot--current-server-or-lose)
+ (jsonrpc-notify
- (jsonrpc-current-process-or-lose)
++ (jsonrpc-current-connection-or-lose)
:textDocument/didOpen `(:textDocument ,(eglot--TextDocumentItem))))
(defun eglot--signal-textDocument/didClose ()
"Send textDocument/didClose to server."
- (eglot--notify
- (eglot--current-server-or-lose)
+ (jsonrpc-notify
- (jsonrpc-current-process-or-lose)
++ (jsonrpc-current-connection-or-lose)
:textDocument/didClose `(:textDocument ,(eglot--TextDocumentIdentifier))))
(defun eglot--signal-textDocument/willSave ()
"Send textDocument/willSave to server."
- (let ((proc (jsonrpc-current-process-or-lose))
- (let ((server (eglot--current-server-or-lose))
++ (let ((server (jsonrpc-current-connection-or-lose))
(params `(:reason 1 :textDocument ,(eglot--TextDocumentIdentifier))))
- (jsonrpc-notify proc :textDocument/willSave params)
- (eglot--notify server :textDocument/willSave params)
- (ignore-errors
- (let ((eglot-request-timeout 0.5))
- (when (plist-get :willSaveWaitUntil
- (eglot--server-capable :textDocumentSync))
- (eglot--apply-text-edits
- (eglot--request server :textDocument/willSaveWaituntil params)))))))
++ (jsonrpc-notify server :textDocument/willSave params)
+ (when (eglot--server-capable :textDocumentSync :willSaveWaitUntil)
+ (ignore-errors
+ (eglot--apply-text-edits
- (jsonrpc-request proc :textDocument/willSaveWaituntil params
++ (jsonrpc-request server :textDocument/willSaveWaituntil params
+ :timeout 0.5))))))
(defun eglot--signal-textDocument/didSave ()
"Send textDocument/didSave to server."
- (eglot--notify
- (eglot--current-server-or-lose)
+ (jsonrpc-notify
- (jsonrpc-current-process-or-lose)
++ (jsonrpc-current-connection-or-lose)
:textDocument/didSave
- (eglot--obj
+ (jsonrpc-obj
;; TODO: Handle TextDocumentSaveRegistrationOptions to control this.
:text (buffer-substring-no-properties (point-min) (point-max))
:textDocument (eglot--TextDocumentIdentifier))))
(cl-defmethod xref-backend-identifier-completion-table ((_backend (eql eglot)))
(when (eglot--server-capable :documentSymbolProvider)
- (let ((proc (jsonrpc-current-process-or-lose))
- (let ((server (eglot--current-server-or-lose))
++ (let ((server (jsonrpc-current-connection-or-lose))
(text-id (eglot--TextDocumentIdentifier)))
(completion-table-with-cache
(lambda (string)
:locations (list location)
:kind kind
:containerName containerName))
- (jsonrpc-request proc
- (eglot--request server
- :textDocument/documentSymbol
- (eglot--obj
- :textDocument text-id))))
++ (jsonrpc-request server
+ :textDocument/documentSymbol
+ (jsonrpc-obj
+ :textDocument text-id))))
(all-completions string eglot--xref-known-symbols))))))
(cl-defmethod xref-backend-identifier-at-point ((_backend (eql eglot)))
(location-or-locations
(if rich-identifier
(get-text-property 0 :locations rich-identifier)
- (jsonrpc-request (jsonrpc-current-process-or-lose)
- (eglot--request (eglot--current-server-or-lose)
- :textDocument/definition
- (get-text-property
- 0 :textDocumentPositionParams identifier)))))
- (mapcar (eglot--lambda (&key uri range)
++ (jsonrpc-request (jsonrpc-current-connection-or-lose)
+ :textDocument/definition
+ (get-text-property
+ 0 :textDocumentPositionParams identifier)))))
+ (mapcar (jsonrpc-lambda (&key uri range)
(eglot--xref-make identifier uri (plist-get range :start)))
location-or-locations)))
(and rich (get-text-property 0 :textDocumentPositionParams rich))))))
(unless params
(eglot--error "Don' know where %s is in the workspace!" identifier))
- (mapcar (eglot--lambda (&key uri range)
- (eglot--xref-make identifier uri (plist-get range :start)))
- (eglot--request (eglot--current-server-or-lose)
- :textDocument/references
- (append
- params
- (eglot--obj :context
- (eglot--obj :includeDeclaration t)))))))
+ (mapcar
+ (jsonrpc-lambda (&key uri range)
+ (eglot--xref-make identifier uri (plist-get range :start)))
- (jsonrpc-request (jsonrpc-current-process-or-lose)
++ (jsonrpc-request (jsonrpc-current-connection-or-lose)
+ :textDocument/references
+ (append
+ params
+ (jsonrpc-obj :context
+ (jsonrpc-obj :includeDeclaration t)))))))
(cl-defmethod xref-backend-apropos ((_backend (eql eglot)) pattern)
(when (eglot--server-capable :workspaceSymbolProvider)
- (mapcar (eglot--lambda (&key name location &allow-other-keys)
- (cl-destructuring-bind (&key uri range) location
- (eglot--xref-make name uri (plist-get range :start))))
- (eglot--request (eglot--current-server-or-lose)
- :workspace/symbol
- (eglot--obj :query pattern)))))
+ (mapcar
+ (jsonrpc-lambda (&key name location &allow-other-keys)
+ (cl-destructuring-bind (&key uri range) location
+ (eglot--xref-make name uri (plist-get range :start))))
- (jsonrpc-request (jsonrpc-current-process-or-lose)
++ (jsonrpc-request (jsonrpc-current-connection-or-lose)
+ :workspace/symbol
+ (jsonrpc-obj :query pattern)))))
(defun eglot-completion-at-point ()
"EGLOT's `completion-at-point' function."
(let ((bounds (bounds-of-thing-at-point 'symbol))
- (proc (jsonrpc-current-process-or-lose)))
- (server (eglot--current-server-or-lose)))
++ (server (jsonrpc-current-connection-or-lose)))
(when (eglot--server-capable :completionProvider)
(list
(or (car bounds) (point))
(or (cdr bounds) (point))
(completion-table-with-cache
(lambda (_ignored)
- (let* ((resp (jsonrpc-request proc
- (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))
items))))
(or (get-text-property 0 :documentation obj)
(and (eglot--server-capable :completionProvider
:resolveProvider)
- (plist-get (jsonrpc-request proc :completionItem/resolve
- (plist-get (eglot--request server :completionItem/resolve
- (text-properties-at 0 obj))
++ (plist-get (jsonrpc-request server :completionItem/resolve
+ (text-properties-at 0 obj))
:documentation)))))
(when documentation
(with-current-buffer (get-buffer-create " *eglot doc*")
"Request \"hover\" information for the thing at point."
(interactive)
(cl-destructuring-bind (&key contents range)
- (jsonrpc-request (jsonrpc-current-process-or-lose) :textDocument/hover
- (eglot--request (eglot--current-server-or-lose) :textDocument/hover
- (eglot--TextDocumentPositionParams))
++ (jsonrpc-request (jsonrpc-current-connection-or-lose) :textDocument/hover
+ (eglot--TextDocumentPositionParams))
(when (seq-empty-p contents) (eglot--error "No hover info here"))
(with-help-window "*eglot help*"
(with-current-buffer standard-output
"EGLOT's `eldoc-documentation-function' function.
If SKIP-SIGNATURE, don't try to send textDocument/signatureHelp."
(let* ((buffer (current-buffer))
- (proc (jsonrpc-current-process-or-lose))
- (server (eglot--current-server-or-lose))
++ (server (jsonrpc-current-connection-or-lose))
(position-params (eglot--TextDocumentPositionParams))
sig-showing)
(cl-macrolet ((when-buffer-window
(&body body) `(when (get-buffer-window buffer)
(with-current-buffer buffer ,@body))))
(when (eglot--server-capable :signatureHelpProvider)
- (eglot--async-request
+ (jsonrpc-async-request
- proc :textDocument/signatureHelp position-params
+ server :textDocument/signatureHelp position-params
- :success-fn (eglot--lambda (&key signatures activeSignature
- activeParameter)
- (when-buffer-window
- (when (cl-plusp (length signatures))
- (setq sig-showing t)
- (eldoc-message (eglot--sig-info signatures
- activeSignature
- activeParameter)))))
+ :success-fn
+ (jsonrpc-lambda (&key signatures activeSignature
+ activeParameter)
+ (when-buffer-window
+ (when (cl-plusp (length signatures))
+ (setq sig-showing t)
+ (eldoc-message (eglot--sig-info signatures
+ activeSignature
+ activeParameter)))))
:deferred :textDocument/signatureHelp))
(when (eglot--server-capable :hoverProvider)
- (eglot--async-request
+ (jsonrpc-async-request
- proc :textDocument/hover position-params
+ server :textDocument/hover position-params
- :success-fn (eglot--lambda (&key contents range)
+ :success-fn (jsonrpc-lambda (&key contents range)
(unless sig-showing
- (setq eldoc-last-message (eglot--hover-info contents range))
+ ;; for eglot-tests.el's sake, set this unconditionally
+ (setq eldoc-last-message
+ (eglot--hover-info contents range))
(when-buffer-window (eldoc-message eldoc-last-message))))
:deferred :textDocument/hover))
(when (eglot--server-capable :documentHighlightProvider)
- (eglot--async-request
+ (jsonrpc-async-request
- proc :textDocument/documentHighlight position-params
+ server :textDocument/documentHighlight position-params
- :success-fn (lambda (highlights)
- (mapc #'delete-overlay eglot--highlights)
- (setq eglot--highlights
- (when-buffer-window
- (mapcar (eglot--lambda (&key range _kind)
- (pcase-let ((`(,beg ,end)
- (eglot--range-region range)))
- (let ((ov (make-overlay beg end)))
- (overlay-put ov 'face 'highlight)
- (overlay-put ov 'evaporate t)
- ov)))
- highlights))))
+ :success-fn
+ (lambda (highlights)
+ (mapc #'delete-overlay eglot--highlights)
+ (setq eglot--highlights
+ (when-buffer-window
+ (mapcar
+ (jsonrpc-lambda (&key range _kind)
+ (pcase-let ((`(,beg ,end)
+ (eglot--range-region range)))
+ (let ((ov (make-overlay beg end)))
+ (overlay-put ov 'face 'highlight)
+ (overlay-put ov 'evaporate t)
+ ov)))
+ highlights))))
:deferred :textDocument/documentHighlight))))
nil)
(cons (propertize name :kind (cdr (assoc kind eglot--kind-names)))
(eglot--lsp-position-to-point
(plist-get (plist-get location :range) :start))))
- (jsonrpc-request (jsonrpc-current-process-or-lose)
- (eglot--request (eglot--current-server-or-lose)
- :textDocument/documentSymbol
- (eglot--obj
- :textDocument (eglot--TextDocumentIdentifier))))))
++ (jsonrpc-request (jsonrpc-current-connection-or-lose)
+ :textDocument/documentSymbol
+ (jsonrpc-obj
+ :textDocument (eglot--TextDocumentIdentifier))))))
(append
(seq-group-by (lambda (e) (get-text-property 0 :kind (car e)))
entries)
(unless (eglot--server-capable :renameProvider)
(eglot--error "Server can't rename!"))
(eglot--apply-workspace-edit
- (jsonrpc-request (jsonrpc-current-process-or-lose)
- (eglot--request (eglot--current-server-or-lose)
- :textDocument/rename `(,@(eglot--TextDocumentPositionParams)
- ,@(eglot--obj :newName newname)))
++ (jsonrpc-request (jsonrpc-current-connection-or-lose)
+ :textDocument/rename `(,@(eglot--TextDocumentPositionParams)
+ ,@(jsonrpc-obj :newName newname)))
current-prefix-arg))
\f
(string-match (wildcard-to-regexp
(expand-file-name glob))
f))))
- (eglot--notify
+ (jsonrpc-notify
- proc :workspace/didChangeWatchedFiles
+ server :workspace/didChangeWatchedFiles
`(:changes ,(vector `(:uri ,(eglot--path-to-uri file)
:type ,(cl-case action
(created 1)
\f
;;; Rust-specific
;;;
- (defun eglot--rls-probably-ready-for-p (what proc)
- "Guess if the RLS running in PROC is ready for WHAT."
- (or (eq what :textDocument/completion) ; RLS normally ready for this
- ; one, even if building ;
- (pcase-let ((`(,_id ,what ,done ,_detail) (eglot--spinner proc)))
- (and (equal "Indexing" what) done))))
-
- ;;;###autoload
- (progn
- (add-hook 'rust-mode-hook 'eglot--setup-rls-idiosyncrasies)
- (defun eglot--setup-rls-idiosyncrasies ()
- "Prepare `eglot' to deal with RLS's special treatment."
- (add-hook 'jsonrpc-ready-predicates 'eglot--rls-probably-ready-for-p t t)))
-
- (cl-defun eglot--server-window/progress
- (process &key id done title message &allow-other-keys)
+ (defclass eglot-rls (eglot-lsp-server) () :documentation "Rustlang's RLS.")
+
-(cl-defmethod eglot-server-ready-p ((server eglot-rls) what)
++(cl-defmethod jsonrpc-connection-ready-p ((server eglot-rls) what)
+ "Except for :completion, RLS isn't ready until Indexing done."
+ (and (cl-call-next-method)
+ (or ;; RLS normally ready for this, even if building.
+ (eq :textDocument/completion what)
+ (pcase-let ((`(,_id ,what ,done ,_detail) (eglot--spinner server)))
+ (and (equal "Indexing" what) done)))))
+
+ (cl-defmethod eglot-handle-notification
+ ((server eglot-rls) (_method (eql :window/progress))
+ &key id done title message &allow-other-keys)
"Handle notification window/progress"
- (setf (eglot--spinner process) (list id title done message))
+ (setf (eglot--spinner server) (list id title done message))
(when (and (equal "Indexing" title) done)
- (dolist (buffer (eglot--managed-buffers process))
+ (dolist (buffer (eglot--managed-buffers server))
(with-current-buffer buffer
(funcall (or eglot--current-flymake-report-fn #'ignore)
eglot--unreported-diagnostics)))))
projects / emacs.git / commitdiff