From: João Távora Date: Mon, 14 May 2018 19:06:44 +0000 (+0100) Subject: Merge master into jsonrpc-refactor (using imerge) X-Git-Tag: emacs-29.0.90~1616^2~524^2~4^2~489^2~26 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=10a19cb11ba7a83d12626d7da2467bd2356982c3;p=emacs.git Merge master into jsonrpc-refactor (using imerge) --- 10a19cb11ba7a83d12626d7da2467bd2356982c3 diff --cc lisp/progmodes/eglot.el index f33a851eced,85b2d89a67a..879972df1b1 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@@ -40,7 -39,7 +39,8 @@@ (require 'flymake) (require 'xref) (require 'subr-x) +(require 'jrpc) + (require 'filenotify) ;;; User tweakable stuff @@@ -87,51 -133,59 +87,58 @@@ 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).") +(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 :") ++(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." @@@ -147,17 -201,19 +154,19 @@@ (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) @@@ -230,12 -334,8 +242,8 @@@ MANAGED-MAJOR-MODE 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? ")) @@@ -264,41 -365,218 +273,44 @@@ INTERACTIVE is t if called interactivel 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." @@@ -492,14 -876,14 +500,13 @@@ Uses THING, FACE, DEFS and PREPEND. (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 @@@ -597,32 -1000,31 +604,31 @@@ (t (eglot--message "OK so %s isn't visited" filename))))) + (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 ++ (jrpc-reply + proc jsonrpc-id + :error `(:code -32601 :message ,(or (cadr retval) "sorry"))))))))) - (eglot--reply proc jsonrpc-id :result (eglot--obj :message "OK"))) ++ (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) @@@ -737,26 -1132,27 +743,27 @@@ Records START, END and PRE-CHANGE-LENGT (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." @@@ -948,35 -1366,51 +977,51 @@@ DUMMY is ignored (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) @@@ -998,22 -1432,20 +1043,20 @@@ 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." @@@ -1067,12 -1498,45 +1109,45 @@@ Proceed? ;;; 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")) ;;; Rust-specific