From 89fccba0088f765ba6a4d02b7ca4bf53633b43be Mon Sep 17 00:00:00 2001 From: =?utf8?q?Jo=C3=A3o=20T=C3=A1vora?= Date: Sun, 31 Jan 2021 18:18:02 +0000 Subject: [PATCH] Fully handle lsp glob syntax Thanks to Brian Leung and Dan Peterson for testing and helping me spot bugs. * eglot-tests.el (eglot--glob-match): New test. * eglot.el (eglot--wildcard-to-regexp): Delete. (eglot-register-capability): Rework. (eglot--glob-parse, eglot--glob-compile, eglot--glob-emit-self) (eglot--glob-emit-**, eglot--glob-emit-*, eglot--glob-emit-?) (eglot--glob-emit-{}, eglot--glob-emit-range) (eglot--directories-recursively): New helpers. GitHub-reference: fix https://github.com/joaotavora/eglot/issues/602 --- lisp/progmodes/eglot.el | 113 +++++++++++++++++++++++++++++++--------- 1 file changed, 89 insertions(+), 24 deletions(-) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 8403e5dfdb1..51ed1c49a96 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -2606,40 +2606,32 @@ at point. With prefix argument, prompt for ACTION-KIND." ;;; Dynamic registration ;;; -(defun eglot--wildcard-to-regexp (wildcard) - "(Very lame attempt to) convert WILDCARD to a Elisp regexp." - (cl-loop - with substs = '(("{" . "\\\\(") - ("}" . "\\\\)") - ("," . "\\\\|")) - with string = (wildcard-to-regexp wildcard) - for (pattern . rep) in substs - for target = string then result - for result = (replace-regexp-in-string pattern rep target) - finally return result)) - (cl-defmethod eglot-register-capability (server (method (eql workspace/didChangeWatchedFiles)) id &key watchers) "Handle dynamic registration of workspace/didChangeWatchedFiles" (eglot-unregister-capability server method id) (let* (success - (globs (mapcar (eglot--lambda ((FileSystemWatcher) globPattern) - globPattern) - watchers)) - (glob-dirs - (delete-dups (mapcar #'file-name-directory - (mapcan #'file-expand-wildcards globs))))) + (globs (mapcar + (eglot--lambda ((FileSystemWatcher) globPattern) + (cons + (eglot--glob-compile globPattern t t) + (eglot--glob-compile + (replace-regexp-in-string "/[^/]*$" "/" globPattern) t t))) + watchers)) + (dirs-to-watch + (cl-loop for dir in (eglot--directories-recursively) + when (cl-loop for g in globs + thereis (ignore-errors (funcall (cdr g) dir))) + collect dir))) (cl-labels ((handle-event (event) (pcase-let ((`(,desc ,action ,file ,file1) event)) (cond ((and (memq action '(created changed deleted)) - (cl-find file globs + (cl-find file (mapcar #'car globs) :test (lambda (f glob) - (string-match (eglot--wildcard-to-regexp - (expand-file-name glob)) - f)))) + (funcall glob f)))) (jsonrpc-notify server :workspace/didChangeWatchedFiles `(:changes ,(vector `(:uri ,(eglot--path-to-uri file) @@ -2652,13 +2644,13 @@ at point. With prefix argument, prompt for ACTION-KIND." (handle-event `(,desc 'created ,file1))))))) (unwind-protect (progn - (dolist (dir glob-dirs) + (dolist (dir dirs-to-watch) (push (file-notify-add-watch dir '(change) #'handle-event) (gethash id (eglot--file-watches server)))) (setq success `(:message ,(format "OK, watching %s directories in %s watchers" - (length glob-dirs) (length watchers))))) + (length dirs-to-watch) (length watchers))))) (unless success (eglot-unregister-capability server method id)))))) @@ -2669,6 +2661,79 @@ at point. With prefix argument, prompt for ACTION-KIND." (remhash id (eglot--file-watches server)) (list t "OK")) + +;;; Glob heroics +;;; +(defun eglot--glob-parse (glob) + "Compute list of (STATE-SYM EMITTER-FN PATTERN)." + (with-temp-buffer + (save-excursion (insert glob)) + (cl-loop + with grammar = '((:** "\\*\\*/?" eglot--glob-emit-**) + (:* "\\*" eglot--glob-emit-*) + (:? "\\?" eglot--glob-emit-?) + (:/ "/" eglot--glob-emit-self) + (:{} "{[^][/*{}]+}" eglot--glob-emit-{}) + (:range "\\[\\^?[^][/,*{}]+\\]" eglot--glob-emit-range) + (:literal "[^][/,*?{}]+" eglot--glob-emit-self)) + until (eobp) + collect (cl-loop + for (_token regexp emitter) in grammar + thereis (and (re-search-forward (concat "\\=" regexp) nil t) + (list (cl-gensym "state-") emitter (match-string 0))) + finally (error "Glob '%s' invalid at %s" (buffer-string) (point)))))) + +(defun eglot--glob-compile (glob &optional byte-compile noerror) + "Convert GLOB into Elisp function. Maybe BYTE-COMPILE it. +If NOERROR, return predicate, else erroring function." + (let* ((states (eglot--glob-parse glob)) + (body `(with-temp-buffer + (save-excursion (insert string)) + (cl-labels ,(cl-loop for (this that) on states + for (self emit text) = this + for next = (or (car that) 'eobp) + collect (funcall emit text self next)) + (or (,(caar states)) + (error "Glob done but more unmatched text: '%s'" + (buffer-substring (point) (point-max))))))) + (form `(lambda (string) ,(if noerror `(ignore-errors ,body) body)))) + (if byte-compile (byte-compile form) form))) + +(defun eglot--glob-emit-self (text self next) + `(,self () (re-search-forward ,(concat "\\=" (regexp-quote text))) (,next))) + +(defun eglot--glob-emit-** (_ self next) + `(,self () (or (ignore-errors (save-excursion (,next))) + (and (re-search-forward "\\=/?[^/]+/?") (,self))))) + +(defun eglot--glob-emit-* (_ self next) + `(,self () (re-search-forward "\\=[^/]") + (or (ignore-errors (save-excursion (,next))) (,self)))) + +(defun eglot--glob-emit-? (_ self next) + `(,self () (re-search-forward "\\=[^/]") (,next))) + +(defun eglot--glob-emit-{} (arg self next) + (let ((alternatives (split-string (substring arg 1 (1- (length arg))) ","))) + `(,self () + (or ,@(cl-loop for alt in alternatives + collect `(re-search-forward ,(concat "\\=" alt) nil t)) + (error "Failed matching any of %s" ',alternatives)) + (,next)))) + +(defun eglot--glob-emit-range (arg self next) + (when (eq ?! (aref arg 1)) (aset arg 1 ?^)) + `(,self () (re-search-forward ,(concat "\\=" arg)) (,next))) + +(defun eglot--directories-recursively (&optional dir) + "Because `directory-files-recursively' isn't complete in 26.3." + (cons (setq dir (expand-file-name (or dir default-directory))) + (cl-loop + with default-directory = dir + with completion-regexp-list = '("^[^.]") + for f in (file-name-all-completions "" dir) + when (file-directory-p f) append (eglot--directories-recursively f)))) + ;;; Rust-specific ;;; -- 2.39.5