"\"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)))))
(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."
(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."
(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)))
\f
;;; Minor modes
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)
(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'.
`("/" ,(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
'((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
(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."
`[(,pre-change-length
,(buffer-substring-no-properties start end))])))
- (eglot--signal-textDocument/didChange)))))
+;; 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))))
++ '((name . eglot--signal-textDocument/didChange)))
+
(defun eglot--signal-textDocument/didChange ()
"Send textDocument/didChange to server."
(when (eglot--outstanding-edits-p)
(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)
(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.")
(&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)
(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)
projects / emacs.git / commitdiff