aboutsummaryrefslogtreecommitdiffstats
path: root/lisp/progmodes/eglot.el
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/progmodes/eglot.el')
-rw-r--r--lisp/progmodes/eglot.el127
1 files changed, 58 insertions, 69 deletions
diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el
index 0b5720ae440..553495c7702 100644
--- a/lisp/progmodes/eglot.el
+++ b/lisp/progmodes/eglot.el
@@ -4320,73 +4320,60 @@ at point. With prefix argument, prompt for ACTION-KIND."
4320(defvar eglot-watch-files-outside-project-root t 4320(defvar eglot-watch-files-outside-project-root t
4321 "If non-nil, allow watching files outside project root") 4321 "If non-nil, allow watching files outside project root")
4322 4322
4323(defun eglot--list-directories (dir) 4323(cl-defun eglot--watch-globs (server id globs dir in-root
4324 (with-temp-buffer 4324 &aux (project (eglot--project server))
4325 (condition-case oops 4325 success)
4326 (call-process find-program nil t nil dir "-type" "d" "-print0") 4326 "Set up file watching for relative file names matching GLOBS under DIR.
4327 (error 4327GLOBS is a list of (COMPILED-GLOB . KIND) pairs, where COMPILED-GLOB is
4328 (eglot--warn "Can't list directories in %s: %s" dir oops))) 4328a compiled glob predicate and KIND is a bitmask of change types. DIR is
4329 (cl-loop initially (goto-char (point-min)) 4329the directory to watch (nil means entire project). IN-ROOT says if DIR
4330 for start = (point) while (search-forward "\0" nil t) 4330happens to be inside or maching the project root."
4331 collect (expand-file-name 4331 (cl-labels
4332 (buffer-substring-no-properties start (1- (point))) 4332 ((subdirs-using-project ()
4333 dir)))) 4333 (mapcar #'file-name-directory
4334 4334 (project-files project (and dir (list dir)))))
4335(defun eglot--watch-globs (server id globs &optional base-path) 4335 (subdirs-using-find ()
4336 "Set up file watching for files matching GLOBS under BASE-PATH. 4336 (with-temp-buffer
4337GLOBS is a list of (COMPILED-GLOB . KIND) pairs, where COMPILED-GLOB 4337 (call-process find-program nil t nil dir "-type" "d" "-print0")
4338is a compiled glob predicate and KIND is a bitmask of change types. 4338 (cl-loop initially (goto-char (point-min))
4339BASE-PATH is the directory to watch (nil means entire project). 4339 for start = (point) while (search-forward "\0" nil t)
4340Returns success status for SERVER and registration ID." 4340 collect (expand-file-name
4341 (let* ((project (eglot--project server)) 4341 (buffer-substring-no-properties start (1- (point)))
4342 (root (project-root project)) 4342 dir))))
4343 (dirs (if (and base-path 4343 (handle-event (event)
4344 (not (file-in-directory-p base-path root))) 4344 (pcase-let* ((`(,desc ,action ,file ,file1) event)
4345 ;; Outside root, use faster find-based listing 4345 (action-type (cl-case action
4346 (eglot--list-directories base-path) 4346 (created 1) (changed 2) (deleted 3)))
4347 ;; Inside project or entire project: use project-files 4347 (action-bit (when action-type
4348 ;; which respects ignores 4348 (ash 1 (1- action-type))))
4349 (delete-dups 4349 (candidate (if dir (file-relative-name file dir) file)))
4350 (mapcar #'file-name-directory 4350 (cond
4351 (project-files project (and base-path 4351 ((and (memq action '(created changed deleted))
4352 (list base-path))))))) 4352 (cl-loop for (compiled . kind) in globs
4353 (success nil)) 4353 thereis (and (> (logand kind action-bit) 0)
4354 (cl-labels 4354 (funcall compiled candidate))))
4355 ((handle-event (event) 4355 (jsonrpc-notify
4356 (pcase-let* ((`(,desc ,action ,file ,file1) event) 4356 server :workspace/didChangeWatchedFiles
4357 (action-type (cl-case action 4357 `(:changes ,(vector `(:uri ,(eglot-path-to-uri file)
4358 (created 1) (changed 2) (deleted 3))) 4358 :type ,action-type))))
4359 (action-bit (when action-type 4359 (when (and (eq action 'created)
4360 (ash 1 (1- action-type)))) 4360 (file-directory-p file))
4361 (candidate (if base-path 4361 (add-watch file)))
4362 (file-relative-name file base-path) 4362 ((eq action 'renamed)
4363 file))) 4363 (handle-event `(,desc deleted ,file))
4364 (cond 4364 (handle-event `(,desc created ,file1))))))
4365 ((and (memq action '(created changed deleted)) 4365 (add-watch (subdir)
4366 (cl-loop for (compiled . kind) in globs 4366 (when (file-readable-p subdir)
4367 thereis (and (> (logand kind action-bit) 0) 4367 (push (file-notify-add-watch subdir '(change) #'handle-event)
4368 (funcall compiled candidate)))) 4368 (gethash id (eglot--file-watches server))))))
4369 (jsonrpc-notify 4369 (let ((subdirs (if (or (null dir) in-root)
4370 server :workspace/didChangeWatchedFiles 4370 (subdirs-using-project)
4371 `(:changes ,(vector `(:uri ,(eglot-path-to-uri file) 4371 (condition-case _ (subdirs-using-find)
4372 :type ,action-type)))) 4372 (error (subdirs-using-project))))))
4373 (when (and (eq action 'created)
4374 (file-directory-p file))
4375 (add-watch file)))
4376 ((eq action 'renamed)
4377 (handle-event `(,desc deleted ,file))
4378 (handle-event `(,desc created ,file1))))))
4379 (add-watch (dir)
4380 (when (file-readable-p dir)
4381 (push (file-notify-add-watch dir '(change) #'handle-event)
4382 (gethash id (eglot--file-watches server))))))
4383 (unwind-protect 4373 (unwind-protect
4384 (dolist (d dirs) 4374 (cl-loop for sd in subdirs do (add-watch sd) finally (setq success t))
4385 (add-watch d)
4386 (setq success t))
4387 (unless success 4375 (unless success
4388 (eglot-unregister-capability server 'workspace/didChangeWatchedFiles id)))) 4376 (eglot-unregister-capability server 'workspace/didChangeWatchedFiles id))))))
4389 success))
4390 4377
4391(cl-defmethod eglot-register-capability 4378(cl-defmethod eglot-register-capability
4392 (server (method (eql workspace/didChangeWatchedFiles)) id &key watchers 4379 (server (method (eql workspace/didChangeWatchedFiles)) id &key watchers
@@ -4407,21 +4394,23 @@ Returns success status for SERVER and registration ID."
4407 (when base-uri 4394 (when base-uri
4408 (if (stringp base-uri) 4395 (if (stringp base-uri)
4409 (eglot-uri-to-path base-uri) 4396 (eglot-uri-to-path base-uri)
4410 (eglot-uri-to-path (plist-get base-uri :uri)))))) 4397 (eglot-uri-to-path (plist-get base-uri :uri)))))
4398 (in-root (or (null base-path)
4399 (file-in-directory-p base-path root))))
4411 (when (or eglot-watch-files-outside-project-root 4400 (when (or eglot-watch-files-outside-project-root
4412 (null base-path) 4401 (null base-path)
4413 (file-in-directory-p base-path root)) 4402 in-root)
4414 (push (cons (eglot--glob-compile pat t t) 4403 (push (cons (eglot--glob-compile pat t t)
4415 ;; the default "7" means bitwise OR of 4404 ;; the default "7" means bitwise OR of
4416 ;; WatchKind.Create (1), WatchKind.Change 4405 ;; WatchKind.Create (1), WatchKind.Change
4417 ;; (2), WatchKind.Delete (4) 4406 ;; (2), WatchKind.Delete (4)
4418 (or kind 7)) 4407 (or kind 7))
4419 (gethash base-path groups))))) 4408 (gethash (cons base-path in-root) groups)))))
4420 watchers) 4409 watchers)
4421 ;; For each group, set up watches 4410 ;; For each group, set up watches
4422 (maphash 4411 (maphash
4423 (lambda (base-path globs) 4412 (lambda (base-path globs)
4424 (eglot--watch-globs server id globs base-path)) 4413 (eglot--watch-globs server id globs (car base-path) (cdr base-path)))
4425 groups))) 4414 groups)))
4426 4415
4427(cl-defmethod eglot-unregister-capability 4416(cl-defmethod eglot-unregister-capability