From: João Távora Date: Fri, 25 May 2018 23:29:50 +0000 (+0100) Subject: Merge branch use-eieio-server-defclass into jsonrpc-refactor X-Git-Tag: emacs-29.0.90~1616^2~524^2~4^2~489^2~14 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=5e767fb73c95643c3d6c5864e9ece0cb166f14b6;p=emacs.git Merge branch use-eieio-server-defclass into jsonrpc-refactor --- 5e767fb73c95643c3d6c5864e9ece0cb166f14b6 diff --cc lisp/progmodes/eglot.el index 020e352c440,3d363444405..132833112d5 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@@ -93,86 -112,153 +109,127 @@@ lasted more than that many seconds. :type '(choice (boolean :tag "Whether to inhibit autoreconnection") (integer :tag "Number of seconds"))) + + ;;; API (WORK-IN-PROGRESS!) + ;;; -(defmacro eglot--obj (&rest what) ++(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)) + -(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)))) - + (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)))) + - -;;; 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 ++(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) - (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) + (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) - (status - :documentation "List (STATUS SERIOUS-P) representing server problems/status." - :initform `(:unknown nil) :accessor eglot--status) + (inhibit-autoreconnect + :documentation "Generalized boolean inhibiting auto-reconnection if true." + :initarg :inhibit-autoreconnect :accessor eglot--inhibit-autoreconnect) - (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) + (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.") + -(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))) + +;;; Process management - (defvar eglot--processes-by-project (make-hash-table :test #'equal) ++(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)) @@@ -181,31 -267,59 +238,8 @@@ (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'." @@@ -221,8 -335,10 +255,11 @@@ (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 :): ") (prompt (cond (current-prefix-arg base-prompt) @@@ -244,14 -360,15 +281,14 @@@ (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 @@@ -268,106 -385,375 +305,119 @@@ prefix args, also prompts for MANAGED-M 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 \":\" 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))))) ;;; Helpers @@@ -435,7 -821,7 +485,7 @@@ If optional MARKER, return a marker ins (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) @@@ -460,8 -846,6 +510,8 @@@ If optional MARKERS, make markers. 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) @@@ -475,8 -859,6 +525,8 @@@ #'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) @@@ -505,15 -887,15 +555,21 @@@ (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)))) @@@ -551,16 -932,19 +607,17 @@@ Uses THING, FACE, DEFS and PREPEND. (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"))) @@@ -568,7 -952,7 +625,7 @@@ `("/" ,(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 @@@ -578,11 -962,10 +635,10 @@@ '((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 "] "))) @@@ -590,7 -973,27 +646,8 @@@ ;;; 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)) @@@ -612,15 -1015,17 +669,17 @@@ '("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 @@@ -659,34 -1064,35 +718,35 @@@ THINGS are either registrations or unre (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." @@@ -725,6 -1131,6 +785,13 @@@ (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 @@@ -757,7 -1154,7 +824,7 @@@ Records START, END and PRE-CHANGE-LENGT (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)))) @@@ -766,9 -1163,9 +833,9 @@@ (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 @@@ -778,45 -1175,45 +845,45 @@@ (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)))) @@@ -856,7 -1253,7 +923,7 @@@ DUMMY is ignored (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) @@@ -873,10 -1269,10 +940,10 @@@ :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))) @@@ -891,11 -1287,11 +958,11 @@@ (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))) @@@ -908,43 -1304,41 +975,43 @@@ (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)))) @@@ -969,8 -1363,8 +1036,8 @@@ (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*") @@@ -1015,8 -1409,8 +1082,8 @@@ "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 @@@ -1026,52 -1420,47 +1093,52 @@@ "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) @@@ -1085,10 -1473,10 +1152,10 @@@ (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) @@@ -1153,9 -1541,9 +1220,9 @@@ Proceed? (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)) @@@ -1177,8 -1565,8 +1244,8 @@@ (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) @@@ -1204,26 -1592,23 +1271,23 @@@ ;;; 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)))))