(require 'flymake)
(require 'xref)
(require 'subr-x)
+(require 'jrpc)
+ (require 'filenotify)
\f
;;; User tweakable stuff
"\"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).")
+(jrpc-define-process-var eglot--moribund nil
+ "Non-nil if server is about to exit")
-(eglot--define-process-var eglot--inhibit-autoreconnect eglot-autoreconnect
+(jrpc-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.
-Either a list of strings (a shell command and arguments), or a
-list of a single string of the form <host>:<port>")
++(jrpc-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)
+ ;; 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))))
++ ;; 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 unexpected server exit.")
+ (eglot-reconnect proc))
+ (t
+ (eglot--warn "Not auto-reconnecting, last one didn't last long."))))
-(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 (jrpc-current-process-or-lose) t))
+ (when interactive (eglot--message "Asking %s politely to terminate" proc))
+ (unwind-protect
+ (let ((jrpc-request-timeout 3))
+ (setf (eglot--moribund proc) t)
+ (jrpc-request proc :shutdown nil)
+ ;; this one should always fail under normal conditions
+ (ignore-errors (jrpc-request proc :exit nil)))
+ (when (process-live-p proc)
+ (eglot--warn "Brutally deleting existing process %s" proc)
+ (delete-process proc))))
-(defun eglot--make-process (name managed-major-mode contact)
- "Make a process from CONTACT.
-NAME is a name to give the inferior process or connection.
-MANAGED-MAJOR-MODE is a symbol naming a major mode.
-CONTACT is as `eglot--contact'. Returns a process object."
- (let* ((readable-name (format "EGLOT server (%s/%s)" name managed-major-mode))
- (buffer (get-buffer-create
- (format "*%s inferior*" readable-name)))
- singleton
- (proc
- (if (and (setq singleton (and (null (cdr contact)) (car contact)))
- (string-match "^[\s\t]*\\(.*\\):\\([[:digit:]]+\\)[\s\t]*$"
- singleton))
- (open-network-stream readable-name
- buffer
- (match-string 1 singleton)
- (string-to-number
- (match-string 2 singleton)))
- (make-process :name readable-name
- :buffer buffer
- :command contact
- :connection-type 'pipe
- :stderr (get-buffer-create (format "*%s stderr*"
- name))))))
- (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))
+(defun eglot--find-current-process ()
+ "The current logical EGLOT process."
- (let* ((cur (project-current))
- (processes (and cur (gethash cur eglot--processes-by-project))))
- (cl-find major-mode processes :key #'eglot--major-mode)))
++ (let* ((probe (or (project-current) (cons 'transient default-directory))))
++ (cl-find major-mode (gethash probe eglot--processes-by-project)
++ :key #'eglot--major-mode)))
(defun eglot--project-short-name (project)
"Give PROJECT a short name."
(defun eglot--client-capabilities ()
"What the EGLOT LSP client supports."
- (eglot--obj
- :workspace (eglot--obj
+ (jrpc-obj
+ :workspace (jrpc-obj
+ :applyEdit t
+ :workspaceEdit `(:documentChanges :json-false)
+ :didChangeWatchesFiles `(:dynamicRegistration t)
:symbol `(:dynamicRegistration :json-false))
- :textDocument (eglot--obj
- :synchronization (eglot--obj
+ :textDocument (jrpc-obj
+ :synchronization (jrpc-obj
:dynamicRegistration :json-false
- :willSave t
- :willSaveWaitUntil :json-false
- :didSave t)
+ :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)
INTERACTIVE is t if called interactively."
(interactive (eglot--interactive))
- (let* ((project (project-current))
- (short-name (eglot--project-short-name project)))
- (unless project (eglot--error "Cannot work without a current project!"))
- (unless command (eglot--error "Don't know how to start EGLOT for %s buffers"
- major-mode))
+ (let* ((short-name (eglot--project-short-name project)))
- (let ((current-process (eglot--current-process)))
+ (let ((current-process (jrpc-current-process)))
(if (and (process-live-p current-process)
interactive
(y-or-n-p "[eglot] Live process found, reconnect instead? "))
interactive)
(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))
- (unwind-protect
- ;; Call all outstanding error handlers
- (maphash (lambda (_id triplet)
- (cl-destructuring-bind (_success error _timeout) triplet
- (funcall error :code -1 :message (format "Server died"))))
- (eglot--pending-continuations proc))
- ;; Turn off `eglot--managed-mode' where appropriate.
+(defalias 'eglot-events-buffer 'jrpc-events-buffer)
+
++(defvar eglot-connect-hook nil "Hook run after connecting in `eglot--connect'.")
++
+(defun eglot--connect (project managed-major-mode name command
+ dont-inhibit)
+ (let ((proc (jrpc-connect name command "eglot--server-" #'eglot--on-shutdown)))
+ (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)
+ (cl-destructuring-bind (&key capabilities)
+ (jrpc-request
+ proc
+ :initialize
+ (jrpc-obj :processId (unless (eq (process-type proc)
+ 'network)
+ (emacs-pid))
+ :rootUri (eglot--path-to-uri
+ (car (project-roots project)))
+ :initializationOptions []
+ :capabilities (eglot--client-capabilities)))
+ (setf (eglot--capabilities proc) capabilities)
+ (setf (jrpc-status proc) nil)
(dolist (buffer (buffer-list))
(with-current-buffer buffer
- (when (eglot--buffer-managed-p proc)
- (eglot--managed-mode -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)))
- (eglot--message "Server exited with status %s" (process-exit-status proc))
- (cond ((eglot--moribund proc))
- ((not (eglot--inhibit-autoreconnect proc))
- (eglot--warn "Reconnecting unexpected server exit.")
- (eglot-reconnect proc))
- (t
- (eglot--warn "Not auto-reconnecting, last one didn't last long.")))
- (delete-process proc))))
-
-(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)
- (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 error &allow-other-keys) 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)
- (apply handler-sym proc (append
- (plist-get message :params)
- (if id `(:id ,id))))
- (eglot--warn "No implementation of method %s yet" method)
- (when id
- (eglot--reply
- proc id
- :error (eglot--obj :code -32601
- :message "Method unimplemented"))))))
- (continuations
- (cancel-timer (cl-third continuations))
- (remhash id (eglot--pending-continuations proc))
- (if error
- (apply (cl-second continuations) error)
- (let ((res (plist-get message :result)))
- (if (listp res)
- (apply (cl-first continuations) res)
- (funcall (cl-first continuations) res)))))
- (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))
-
-(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.")
+ (eglot--maybe-activate-editing-mode proc)))
+ (jrpc-notify proc :initialized (jrpc-obj :__dummy__ t))
+ (setf (eglot--inhibit-autoreconnect proc)
+ (cond
+ ((booleanp eglot-autoreconnect) (not eglot-autoreconnect))
+ (dont-inhibit nil)
+ ((cl-plusp eglot-autoreconnect)
+ (run-with-timer eglot-autoreconnect nil
+ (lambda ()
+ (setf (eglot--inhibit-autoreconnect proc)
+ (null eglot-autoreconnect)))))))
+ proc)))
(defun eglot--server-ready-p (_what _proc)
"Tell if server of PROC ready for processing deferred WHAT."
(defun eglot--mode-line-format ()
"Compose the EGLOT's mode-line."
- (pcase-let* ((proc (eglot--current-process))
- (name (and (process-live-p proc) (eglot--short-name proc)))
- (pending (and proc (hash-table-count
- (eglot--pending-continuations proc))))
+ (pcase-let* ((proc (jrpc-current-process))
+ (name (and (process-live-p proc) (jrpc-name proc)))
+ (pending (and proc (length (jrpc-outstanding-request-ids proc))))
(`(,_id ,doing ,done-p ,detail) (and proc (eglot--spinner proc)))
- (`(,status ,serious-p) (and proc (eglot--status proc))))
+ (`(,status ,serious-p) (and proc (jrpc-status proc))))
(append
- `(,(eglot--mode-line-props "eglot" 'eglot-mode-line
- '((down-mouse-1 eglot-menu "pop up EGLOT menu"))))
+ `(,(eglot--mode-line-props "eglot" 'eglot-mode-line nil))
(when name
`(":" ,(eglot--mode-line-props
name 'eglot-mode-line
(t
(eglot--message "OK so %s isn't visited" filename)))))
- (eglot--reply
+ (cl-defun eglot--register-unregister (proc jsonrpc-id things how)
+ "Helper for `eglot--server-client/registerCapability'.
+ THINGS are either registrations or unregisterations."
+ (dolist (thing (cl-coerce things 'list))
+ (cl-destructuring-bind (&key id method registerOptions) thing
+ (let (retval)
+ (unwind-protect
+ (setq retval (apply (intern (format "eglot--%s-%s" how method))
+ proc :id id registerOptions))
+ (unless (eq t (car retval))
+ (cl-return-from eglot--register-unregister
- (eglot--reply proc jsonrpc-id :result (eglot--obj :message "OK")))
++ (jrpc-reply
+ proc jsonrpc-id
+ :error `(:code -32601 :message ,(or (cadr retval) "sorry")))))))))
++ (jrpc-reply proc jsonrpc-id :result (jrpc-obj :message "OK")))
+
(cl-defun eglot--server-client/registerCapability
(proc &key id registrations)
- "Handle notification client/registerCapability"
- (let ((jrpc-id id)
- (done (make-symbol "done")))
- (catch done
- (mapc
- (lambda (reg)
- (apply
- (cl-function
- (lambda (&key id method registerOptions)
- (pcase-let*
- ((handler-sym (intern (concat "eglot--register-"
- method)))
- (`(,ok ,message)
- (and (functionp handler-sym)
- (apply handler-sym proc :id id registerOptions))))
- (unless ok
- (throw done
- (jrpc-reply proc jrpc-id
- :error (jrpc-obj
- :code -32601
- :message (or message "sorry :-("))))))))
- reg))
- registrations)
- (jrpc-reply proc id :result (jrpc-obj :message "OK")))))
+ "Handle server request client/registerCapability"
+ (eglot--register-unregister proc id registrations 'register))
+
+ (cl-defun eglot--server-client/unregisterCapability
+ (proc &key id unregisterations) ;; XXX: Yeah, typo and all.. See spec...
+ "Handle server request client/unregisterCapability"
+ (eglot--register-unregister proc id unregisterations 'unregister))
(cl-defun eglot--server-workspace/applyEdit
(proc &key id _label edit)
(defun eglot--signal-textDocument/didOpen ()
"Send textDocument/didOpen to server."
(setq eglot--recent-changes (cons [] []))
- (jrpc-notify (jrpc-current-process-or-lose)
- :textDocument/didOpen
- (jrpc-obj :textDocument
- (eglot--TextDocumentItem))))
- (eglot--notify
- (eglot--current-process-or-lose)
++ (jrpc-notify
++ (jrpc-current-process-or-lose)
+ :textDocument/didOpen `(:textDocument ,(eglot--TextDocumentItem))))
(defun eglot--signal-textDocument/didClose ()
"Send textDocument/didClose to server."
- (jrpc-notify (jrpc-current-process-or-lose)
- :textDocument/didClose
- (jrpc-obj :textDocument
- (eglot--TextDocumentIdentifier))))
- (eglot--notify
- (eglot--current-process-or-lose)
++ (jrpc-notify
++ (jrpc-current-process-or-lose)
+ :textDocument/didClose `(:textDocument ,(eglot--TextDocumentIdentifier))))
(defun eglot--signal-textDocument/willSave ()
"Send textDocument/willSave to server."
- (jrpc-notify
- (jrpc-current-process-or-lose)
- :textDocument/willSave
- (jrpc-obj
- :reason 1 ; Manual, emacs laughs in the face of auto-save muahahahaha
- :textDocument (eglot--TextDocumentIdentifier))))
- (let ((proc (eglot--current-process-or-lose))
++ (let ((proc (jrpc-current-process-or-lose))
+ (params `(:reason 1 :textDocument ,(eglot--TextDocumentIdentifier))))
- (eglot--notify proc :textDocument/willSave params)
++ (jrpc-notify proc :textDocument/willSave params)
+ (ignore-errors
- (let ((eglot-request-timeout 0.5))
++ (let ((jrpc-request-timeout 0.5))
+ (when (plist-get :willSaveWaitUntil
+ (eglot--server-capable :textDocumentSync))
+ (eglot--apply-text-edits
- (eglot--request proc :textDocument/willSaveWaituntil params)))))))
++ (jrpc-request proc :textDocument/willSaveWaituntil params)))))))
(defun eglot--signal-textDocument/didSave ()
"Send textDocument/didSave to server."
(insert (eglot--hover-info contents range))))))
(defun eglot-eldoc-function ()
- "EGLOT's `eldoc-documentation-function' function."
- (let ((buffer (current-buffer))
- (proc (jrpc-current-process-or-lose))
- (position-params (eglot--TextDocumentPositionParams)))
- (when (eglot--server-capable :hoverProvider)
- (jrpc-async-request
- proc :textDocument/hover position-params
- :success-fn (jrpc-lambda (&key contents range)
- (when (get-buffer-window buffer)
- (with-current-buffer buffer
- (eldoc-message (eglot--hover-info contents range)))))
- :deferred :textDocument/hover))
- (when (eglot--server-capable :documentHighlightProvider)
- (jrpc-async-request
- proc :textDocument/documentHighlight position-params
- :success-fn (lambda (highlights)
- (mapc #'delete-overlay eglot--highlights)
- (setq eglot--highlights
- (when (get-buffer-window buffer)
- (with-current-buffer buffer
- (jrpc-mapply
- (jrpc-lambda (&key range _kind)
- (eglot--with-lsp-range (beg end) range
- (let ((ov (make-overlay beg end)))
- (overlay-put ov 'face 'highlight)
- (overlay-put ov 'evaporate t)
- ov)))
- highlights)))))
- :deferred :textDocument/documentHighlight)))
+ "EGLOT's `eldoc-documentation-function' function.
+ If SKIP-SIGNATURE, don't try to send textDocument/signatureHelp."
+ (let* ((buffer (current-buffer))
- (proc (eglot--current-process-or-lose))
++ (proc (jrpc-current-process-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
++ (jrpc-async-request
+ proc :textDocument/signatureHelp position-params
- :success-fn (eglot--lambda (&key signatures activeSignature
++ :success-fn (jrpc-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
++ (jrpc-async-request
+ proc :textDocument/hover position-params
- :success-fn (eglot--lambda (&key contents range)
++ :success-fn (jrpc-lambda (&key contents range)
+ (unless sig-showing
+ (when-buffer-window
+ (eldoc-message (eglot--hover-info contents range)))))
+ :deferred :textDocument/hover))
+ (when (eglot--server-capable :documentHighlightProvider)
- (eglot--async-request
++ (jrpc-async-request
+ proc :textDocument/documentHighlight position-params
+ :success-fn (lambda (highlights)
+ (mapc #'delete-overlay eglot--highlights)
+ (setq eglot--highlights
+ (when-buffer-window
- (eglot--mapply
- (eglot--lambda (&key range _kind)
++ (jrpc-mapply
++ (jrpc-lambda (&key range _kind)
+ (eglot--with-lsp-range (beg end) range
+ (let ((ov (make-overlay beg end)))
+ (overlay-put ov 'face 'highlight)
+ (overlay-put ov 'evaporate t)
+ ov)))
+ highlights))))
+ :deferred :textDocument/documentHighlight))))
nil)
(defun eglot-imenu (oldfun)
entries))
(funcall oldfun)))
- (defun eglot--apply-text-edits (buffer edits &optional version)
- "Apply the EDITS for BUFFER."
- (with-current-buffer buffer
- (unless (or (not version)
- (equal version eglot--versioned-identifier))
- (eglot--error "Edits on `%s' require version %d, you have %d"
- buffer version eglot--versioned-identifier))
- (jrpc-mapply
- (jrpc-lambda (&key range newText)
- (save-restriction
- (widen)
- (save-excursion
- (eglot--with-lsp-range (beg end) range
- (goto-char beg) (delete-region beg end) (insert newText)))))
- edits)
- (eglot--message "%s: Performed %s edits" (current-buffer) (length edits))))
+ (defun eglot--apply-text-edits (edits &optional version)
+ "Apply EDITS for current buffer if at VERSION, or if it's 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))
- (eglot--mapply
- (eglot--lambda (&key range newText)
++ (jrpc-mapply
++ (jrpc-lambda (&key range newText)
+ (save-restriction
+ (widen)
+ (save-excursion
+ (eglot--with-lsp-range (beg end) range
+ (goto-char beg) (delete-region beg end) (insert newText)))))
+ edits)
+ (eglot--message "%s: Performed %s edits" (current-buffer) (length edits)))
(defun eglot--apply-workspace-edit (wedit &optional confirm)
"Apply the workspace edit WEDIT. If CONFIRM, ask user first."
\f
;;; Dynamic registration
;;;
- (cl-defun eglot--register-workspace/didChangeWatchedFiles
- (_proc &key _id _watchers)
+ (cl-defun eglot--register-workspace/didChangeWatchedFiles (proc &key id watchers)
"Handle dynamic registration of workspace/didChangeWatchedFiles"
- ;; TODO: file-notify-add-watch and
- ;; file-notify-rm-watch can probably handle this
- (list nil "Sorry, can't do this yet"))
+ (eglot--unregister-workspace/didChangeWatchedFiles proc :id id)
+ (let* (success
+ (globs (mapcar (lambda (w) (plist-get w :globPattern)) watchers)))
+ (cl-labels
+ ((handle-event
+ (event)
+ (cl-destructuring-bind (desc action file &optional file1) event
+ (cond
+ ((and (memq action '(created changed deleted))
+ (cl-find file globs
+ :test (lambda (f glob)
+ (string-match (wildcard-to-regexp
+ (expand-file-name glob))
+ f))))
- (eglot--notify
++ (jrpc-notify
+ proc :workspace/didChangeWatchedFiles
+ `(:changes ,(vector `(:uri ,(eglot--path-to-uri file)
+ :type ,(cl-case action
+ (created 1)
+ (changed 2)
+ (deleted 3)))))))
+ ((eq action 'renamed)
+ (handle-event desc 'deleted file)
+ (handle-event desc 'created file1))))))
+ (unwind-protect
+ (progn (dolist (dir (delete-dups (mapcar #'file-name-directory globs)))
+ (push (file-notify-add-watch dir '(change) #'handle-event)
+ (gethash id (eglot--file-watches proc))))
+ (setq success `(t "OK")))
+ (unless success
+ (eglot--unregister-workspace/didChangeWatchedFiles proc :id id))))))
+
+ (cl-defun eglot--unregister-workspace/didChangeWatchedFiles (proc &key id)
+ "Handle dynamic unregistration of workspace/didChangeWatchedFiles"
+ (mapc #'file-notify-rm-watch (gethash id (eglot--file-watches proc)))
+ (remhash id (eglot--file-watches proc))
+ (list t "OK"))
\f
;;; Rust-specific
projects / emacs.git / commitdiff