From: João Távora Date: Sun, 20 May 2018 14:07:23 +0000 (+0100) Subject: Heroically merge master into jsonrpc-refactor (using imerge) X-Git-Tag: emacs-29.0.90~1616^2~524^2~4^2~489^2~16 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=351eb7f4ce86dfca00074aad3db961e28bd6fda5;p=emacs.git Heroically merge master into jsonrpc-refactor (using imerge) --- 351eb7f4ce86dfca00074aad3db961e28bd6fda5 diff --cc lisp/progmodes/eglot.el index 907c98b2c08,9d7253af26d..41e57b4bb53 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@@ -111,59 -150,56 +111,64 @@@ lasted more than that many seconds. "\"Spinner\" used by some servers. A list (ID WHAT DONE-P).") -(eglot--define-process-var eglot--status `(:unknown nil) - "Status as declared by the server. -A list (WHAT SERIOUS-P).") +(jsonrpc-define-process-var eglot--moribund nil + "Non-nil if server is about to exit") -(eglot--define-process-var eglot--inhibit-autoreconnect eglot-autoreconnect +(jsonrpc-define-process-var eglot--inhibit-autoreconnect eglot-autoreconnect "If non-nil, don't autoreconnect on unexpected quit.") -(eglot--define-process-var eglot--contact nil - "Method used to contact a server.") +(jsonrpc-define-process-var eglot--file-watches (make-hash-table :test #'equal) + "File system watches for the didChangeWatchedfiles thingy.") -(eglot--define-process-var eglot--deferred-actions - (make-hash-table :test #'equal) - "Actions deferred to when server is thought to be ready.") +(defun eglot--on-shutdown (proc) ++ "Called by jsonrpc.el when PROC is already dead." + ;; Turn off `eglot--managed-mode' where appropriate. - (dolist (buffer (buffer-list)) - (with-current-buffer buffer - (when (eglot--buffer-managed-p proc) - (eglot--managed-mode -1)))) ++ (dolist (buffer (eglot--managed-buffers proc)) ++ (with-current-buffer buffer (eglot--managed-mode-onoff proc -1))) + ;; Kill any expensive watches + (maphash (lambda (_id watches) + (mapcar #'file-notify-rm-watch watches)) + (eglot--file-watches proc)) + ;; 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)) + (eglot--warn "Reconnecting after unexpected server exit.") + (eglot-reconnect proc)) + ((timerp (eglot--inhibit-autoreconnect proc)) + (eglot--warn "Not auto-reconnecting, last one didn't last long.")))) - (defun eglot-shutdown (proc &optional interactive) -(eglot--define-process-var eglot--file-watches (make-hash-table :test #'equal) - "File system watches for the didChangeWatchedfiles thingy.") ++(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)) - (when interactive (eglot--message "Asking %s politely to terminate" proc)) ++ (eglot--message "Asking %s politely to terminate" proc) + (unwind-protect + (let ((jsonrpc-request-timeout 3)) + (setf (eglot--moribund proc) t) + (jsonrpc-request proc :shutdown nil) - ;; this one should always fail under normal conditions ++ ;; 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 existing process %s" proc) ++ (eglot--warn "Brutally deleting non-compliant %s" proc) + (delete-process proc)))) -(eglot--define-process-var eglot--managed-buffers nil - "Buffers managed by the server.") +(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))) -(defun eglot--make-process (name managed-major-mode contact) - "Make a process from CONTACT. -NAME is used to name the the started process or connection. -MANAGED-MAJOR-MODE is a symbol naming a major mode. -CONTACT is in `eglot'. Returns a process object." - (let* ((readable-name (format "EGLOT server (%s/%s)" name managed-major-mode)) - (buffer (get-buffer-create (format "*%s stdout*" readable-name))) - (proc (cond - ((processp contact) contact) - ((integerp (cadr contact)) - (apply #'open-network-stream readable-name buffer contact)) - (t (make-process - :name readable-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) - proc)) - -(defmacro eglot--obj (&rest what) - "Make WHAT a suitable argument for `json-encode'." - (declare (debug (&rest form))) - ;; FIXME: maybe later actually do something, for now this just fixes - ;; the indenting of literal plists. - `(list ,@what)) ++(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))))) @@@ -306,63 -386,219 +306,64 @@@ INTERACTIVE is t if called interactivel (eglot-shutdown process interactive)) (eglot--connect (eglot--project process) (eglot--major-mode process) - (eglot--short-name process) - (eglot--contact process) - interactive) + (jsonrpc-name process) + (jsonrpc-contact process)) (eglot--message "Reconnected!")) -(defun eglot--process-sentinel (proc change) - "Called when PROC undergoes CHANGE." - (eglot--log-event proc `(:message "Process state changed" :change ,change)) - (when (not (process-live-p proc)) - (with-current-buffer (eglot-events-buffer proc) - (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 proc)) - (maphash (lambda (_id watches) - (mapcar #'file-notify-rm-watch watches)) - (eglot--file-watches proc)) +(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) + "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) + (let* ((contact (if (functionp contact) (funcall contact) contact)) + (proc + (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) (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 proc)) - ;; Turn off `eglot--managed-mode' where appropriate. - (dolist (buffer (eglot--managed-buffers proc)) - (with-current-buffer buffer (eglot--managed-mode-onoff proc -1))) - ;; Forget about the process-project relationship - (setf (gethash (eglot--project proc) eglot--processes-by-project) - (delq proc - (gethash (eglot--project proc) eglot--processes-by-project))) - ;; Say last words - (eglot--message "%s exited with status %s" proc (process-exit-status proc)) - (delete-process proc) - ;; Consider autoreconnecting - (cond ((eglot--moribund proc)) - ((not (eglot--inhibit-autoreconnect proc)) - (eglot--warn "Reconnecting after unexpected server exit") - (eglot-reconnect proc)) - ((timerp (eglot--inhibit-autoreconnect proc)) - (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 (eglot--expected-bytes proc))) - ;; 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) + (cl-destructuring-bind (&key capabilities) + (jsonrpc-request + proc + :initialize + (jsonrpc-obj :processId (unless (eq (process-type proc) + 'network) + (emacs-pid)) - :rootPath (car (project-roots project)) ++ :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) + (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) (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--process-receive proc 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 - ;; - (setf (eglot--expected-bytes proc) expected-bytes)))))) - -(defun eglot-events-buffer (process &optional interactive) - "Display events buffer for current LSP connection PROCESS. -INTERACTIVE is t if called interactively." - (interactive (list (eglot--current-process-or-lose) t)) - (let* ((probe (eglot--events-buffer process)) - (buffer (or (and (buffer-live-p probe) - probe) - (let ((buffer (get-buffer-create - (format "*%s events*" - (process-name process))))) - (with-current-buffer buffer - (buffer-disable-undo) - (read-only-mode t) - (setf (eglot--events-buffer process) buffer)) - buffer)))) - (when interactive (display-buffer buffer)) - buffer)) - -(defun eglot--log-event (proc message &optional type) - "Log an eglot-related event. -PROC is the current process. 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 proc) - (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--process-receive (proc message) - "Process MESSAGE from PROC." - (cl-destructuring-bind (&key method id params error result _jsonrpc) message - (let* ((continuations (and id - (not method) - (gethash id (eglot--pending-continuations proc))))) - (eglot--log-event proc message 'server) - (when error (setf (eglot--status proc) `(,error t))) - (cond (method - ;; a server notification or a server request - (let* ((handler-sym (intern (concat "eglot--server-" method)))) - (if (functionp handler-sym) - ;; FIXME: will fail if params is array instead of not an object - (apply handler-sym proc (append params (if id `(:id ,id)))) - (eglot--warn "No implementation of method %s yet" method) - (when id - (eglot--reply - proc id - :error `(:code -32601 :message "Method unimplemented")))))) - (continuations - (cancel-timer (cl-third continuations)) - (remhash id (eglot--pending-continuations proc)) - (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 proc) - (force-mode-line-update t)))) - -(defun eglot--process-send (proc message) - "Send MESSAGE to PROC (ID is optional)." - (let ((json (json-encode message))) - (process-send-string proc (format "Content-Length: %d\r\n\r\n%s" - (string-bytes json) - json)) - (eglot--log-event proc 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 (process) - "Stop waiting for responses from the current LSP PROCESS." - (interactive (list (eglot--current-process-or-lose))) - (clrhash (eglot--pending-continuations process))) - -(defun eglot-clear-status (process) - "Clear most recent error message from PROCESS." - (interactive (list (eglot--current-process-or-lose))) - (setf (eglot--status process) nil) - (force-mode-line-update t)) - -(defun eglot--call-deferred (proc) - "Call PROC's deferred actions, who may again defer themselves." - (when-let ((actions (hash-table-values (eglot--deferred-actions proc)))) - (eglot--log-event proc `(:running-deferred ,(length actions))) - (mapc #'funcall (mapcar #'car actions)))) - -(defvar eglot--ready-predicates '(eglot--server-ready-p) - "Special hook of predicates controlling deferred actions. -If one of these returns nil, a deferrable `eglot--async-request' -will be deferred. Each predicate is passed the symbol for the -request request and a process object.") + ((booleanp eglot-autoreconnect) (not eglot-autoreconnect)) + ((cl-plusp eglot-autoreconnect) + (run-with-timer eglot-autoreconnect nil + (lambda () + (setf (eglot--inhibit-autoreconnect proc) + (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." @@@ -390,22 -738,19 +389,19 @@@ (defun eglot--pos-to-lsp-position (&optional pos) "Convert point POS to LSP position." (save-excursion - (jsonrpc-obj :line - ;; F!@(#*&#$)CKING OFF-BY-ONE - (1- (line-number-at-pos pos t)) - :character - (- (goto-char (or pos (point))) - (line-beginning-position))))) - - (defun eglot--lsp-position-to-point (pos-plist) - "Convert LSP position POS-PLIST to Emacs point." - (eglot--obj :line (1- (line-number-at-pos pos t)) ; F!@&#$CKING OFF-BY-ONE - :character (- (goto-char (or pos (point))) - (line-beginning-position))))) ++ (jsonrpc-obj :line (1- (line-number-at-pos pos t)) ; F!@&#$CKING OFF-BY-ONE ++ :character (- (goto-char (or pos (point))) ++ (line-beginning-position))))) + + (defun eglot--lsp-position-to-point (pos-plist &optional marker) + "Convert LSP position POS-PLIST to Emacs point. + If optional MARKER, return a marker instead" (save-excursion (goto-char (point-min)) (forward-line (plist-get pos-plist :line)) - (forward-char - (min (plist-get pos-plist :character) - (- (line-end-position) - (line-beginning-position)))) - (point))) + (forward-char (min (plist-get pos-plist :character) + (- (line-end-position) + (line-beginning-position)))) + (if marker (copy-marker (point-marker)) (point)))) (defun eglot--path-to-uri (path) "URIfy PATH." @@@ -428,29 -773,31 +424,31 @@@ (defun eglot--format-markup (markup) "Format MARKUP according to LSP's spec." - (cond ((stringp markup) - (with-temp-buffer - (ignore-errors (funcall (intern "markdown-mode"))) ;escape bytecomp - (font-lock-ensure) - (insert markup) - (string-trim (buffer-string)))) - (t - (with-temp-buffer - (ignore-errors (funcall (intern (concat - (plist-get markup :language) - "-mode" )))) - (insert (plist-get markup :value)) - (font-lock-ensure) - (buffer-string))))) - - (defun eglot--server-capable (feat) - "Determine if current server is capable of FEAT." - (plist-get (eglot--capabilities (jsonrpc-current-process-or-lose)) feat)) - - (defun eglot--range-region (range) - "Return region (BEG . END) that represents LSP RANGE." - (cons (eglot--lsp-position-to-point (plist-get range :start)) - (eglot--lsp-position-to-point (plist-get range :end)))) + (pcase-let ((`(,string ,mode) + (if (stringp markup) (list (string-trim markup) + (intern "markdown-mode")) + (list (plist-get markup :value) + (intern (concat (plist-get markup :language) "-mode" )))))) + (with-temp-buffer + (ignore-errors (funcall mode)) + (insert string) (font-lock-ensure) (buffer-string)))) + + (defun eglot--server-capable (&rest feats) -"Determine if current server is capable of FEATS." -(cl-loop for caps = (eglot--capabilities (eglot--current-process-or-lose)) - then (cadr probe) - for feat in feats - for probe = (plist-member caps feat) - if (not probe) do (cl-return nil) - if (eq (cadr probe) t) do (cl-return t) - if (eq (cadr probe) :json-false) do (cl-return nil) - finally (cl-return (or probe t)))) ++ "Determine if current server is capable of FEATS." ++ (cl-loop for caps = (eglot--capabilities (jsonrpc-current-process-or-lose)) ++ then (cadr probe) ++ for feat in feats ++ for probe = (plist-member caps feat) ++ if (not probe) do (cl-return nil) ++ if (eq (cadr probe) t) do (cl-return t) ++ if (eq (cadr probe) :json-false) do (cl-return nil) ++ finally (cl-return (or probe t)))) + + (defun eglot--range-region (range &optional markers) + "Return region (BEG END) that represents LSP RANGE. + If optional MARKERS, make markers." + (list (eglot--lsp-position-to-point (plist-get range :start) markers) + (eglot--lsp-position-to-point (plist-get range :end) markers))) ;;; Minor modes @@@ -512,11 -855,13 +510,13 @@@ If PROC 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 - (when (eglot--buffer-managed-p proc) - (eglot--managed-mode 1) - (eglot--signal-textDocument/didOpen) - (flymake-start) - (funcall (or eglot--current-flymake-report-fn #'ignore) nil))) - (let* ((cur (and buffer-file-name (eglot--current-process))) ++ (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) + (eglot--signal-textDocument/didOpen) + (flymake-start) + (funcall (or eglot--current-flymake-report-fn #'ignore) nil)))) (add-hook 'find-file-hook 'eglot--maybe-activate-editing-mode) @@@ -532,7 -877,7 +532,8 @@@ (lambda (event) (interactive "e") (with-selected-window (posn-window (event-start event)) -- (call-interactively what)))) ++ (call-interactively what) ++ (force-mode-line-update t)))) (defun eglot--mode-line-props (thing face defs &optional prepend) "Helper for function `eglot--mode-line-format'. @@@ -567,7 -913,7 +568,7 @@@ Uses THING, FACE, DEFS and PREPEND. `("/" ,(eglot--mode-line-props "error" 'compilation-mode-line-fail '((mouse-1 eglot-events-buffer "go to events buffer") -- (mouse-3 eglot-clear-status "clear this status")) ++ (mouse-3 jrpc-clear-status "clear this status")) (format "An error occured: %s\n" status)))) ,@(when (and doing (not done-p)) `("/" ,(eglot--mode-line-props @@@ -577,9 -923,9 +578,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 eglot-clear-status "clear this status")) ++ (mouse-3 jrpc-forget-pending-continuations ++ "fahgettaboudit")) (format "%d pending requests\n" pending))))))))) (add-to-list 'mode-line-misc-info @@@ -679,15 -1044,12 +681,12 @@@ THINGS are either registrations or unre (proc &key id _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 - :result `(:applied :json-false) - :error - (jsonrpc-obj :code -32001 - :message (format "%s" err)))))) + (progn (eglot--apply-workspace-edit edit 'confirm) - (eglot--reply proc id :result `(:applied ))) - (error (eglot--reply proc id - :result `(:applied :json-false) - :error (eglot--obj :code -32001 - :message (format "%s" err)))))) ++ (jsonrpc-reply proc id :result `(:applied ))) ++ (error (jsonrpc-reply proc id ++ :result `(:applied :json-false) ++ :error (jsonrpc-obj :code -32001 ++ :message (format "%s" err)))))) (defun eglot--TextDocumentIdentifier () "Compute TextDocumentIdentifier object for current buffer." @@@ -746,14 -1108,6 +745,15 @@@ Records START, END and PRE-CHANGE-LENGT `[(,pre-change-length ,(buffer-substring-no-properties start end))]))) +;; HACK! Launching 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 `jsonrpc-ready-predicates'. +(advice-add #'jsonrpc-request :before + (cl-function (lambda (_proc _method _params &key deferred) + (when (and eglot--managed-mode deferred) - (eglot--signal-textDocument/didChange))))) ++ (eglot--signal-textDocument/didChange)))) ++ '((name . eglot--signal-textDocument/didChange))) + (defun eglot--signal-textDocument/didChange () "Send textDocument/didChange to server." (when (eglot--outstanding-edits-p) @@@ -939,14 -1289,15 +939,15 @@@ DUMMY is ignored (or (cdr bounds) (point)) (completion-table-with-cache (lambda (_ignored) - (let* ((resp (eglot--request proc - :textDocument/completion - (eglot--TextDocumentPositionParams) - :textDocument/completion)) + (let* ((resp (jsonrpc-request proc + :textDocument/completion + (eglot--TextDocumentPositionParams) + :deferred :textDocument/completion)) (items (if (vectorp resp) resp (plist-get resp :items)))) (mapcar - (jsonrpc-lambda (&rest all &key label &allow-other-keys) - (add-text-properties 0 1 all label) label) - (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)))) :annotation-function (lambda (obj) @@@ -964,18 -1318,18 +968,18 @@@ (lambda (obj) (let ((documentation (or (get-text-property 0 :documentation obj) - (plist-get (jsonrpc-request proc :completionItem/resolve - (text-properties-at 0 obj)) - :documentation)))) + (and (eglot--server-capable :completionProvider + :resolveProvider) - (plist-get (eglot--request proc :completionItem/resolve - (text-properties-at 0 obj)) ++ (plist-get (jsonrpc-request proc :completionItem/resolve ++ (text-properties-at 0 obj)) + :documentation))))) (when documentation (with-current-buffer (get-buffer-create " *eglot doc*") - (erase-buffer) - (ignore-errors (funcall (intern "markdown-mode"))) - (font-lock-ensure) - (insert documentation) + (insert (eglot--format-markup documentation)) (current-buffer))))) - :exit-function - (lambda (_string _status) (eglot-eldoc-function)))))) + :exit-function (lambda (_string _status) + (eglot--signal-textDocument/didChange) + (eglot-eldoc-function)))))) (defvar eglot--highlights nil "Overlays for textDocument/documentHighlight.") @@@ -1034,44 -1384,40 +1034,45 @@@ If SKIP-SIGNATURE, don't try to send te (&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 - :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 - :success-fn (eglot--lambda (&key contents range) + :success-fn (jsonrpc-lambda (&key contents range) (unless sig-showing - (when-buffer-window - (eldoc-message - (eglot--hover-info contents range))))) - (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 - :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) ++ (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) @@@ -1100,14 -1445,14 +1101,14 @@@ (unless (or (not version) (equal version eglot--versioned-identifier)) (eglot--error "Edits on `%s' require version %d, you have %d" (current-buffer) version eglot--versioned-identifier)) - (mapc (jsonrpc-lambda - (&key range newText) - (save-restriction - (widen) - (save-excursion - (pcase-let ((`(,beg . ,end) (eglot--range-region range))) - (goto-char beg) (delete-region beg end) (insert newText))))) - edits) + (save-restriction + (widen) + (save-excursion - (mapc (eglot--lambda (newText beg end) ++ (mapc (jsonrpc-lambda (newText beg end) + (goto-char beg) (delete-region beg end) (insert newText)) - (mapcar (eglot--lambda (&key range newText) ++ (mapcar (jsonrpc-lambda (&key range newText) + (cons newText (eglot--range-region range 'markers))) + edits)))) (eglot--message "%s: Performed %s edits" (current-buffer) (length edits))) (defun eglot--apply-workspace-edit (wedit &optional confirm)