Eglot: supported nested {} patterns in globs

The tailwindcss-language server issues patterns like this:

   **/{tailwind,tailwind.config,tailwind.*.config,\
   tailwind.config.*}.{js,cjs,ts,mjs}

Notive the nested "*" blob inside the the {} group.

Eglot used to reject them in 'workspace/didChangeWatchedFiles' requests,
responding with "Internal Error".  This could confuse some servers.  Now
I've done some changes to the state machine generation and it supports
them.

* lisp/progmodes/eglot.el (eglot--glob-parse): Relax parser.
(eglot--glob-fsm): New helper.
(eglot--glob-compile, eglot--glob-emit-{}): Use it.

* test/lisp/progmodes/eglot-tests.el (eglot-test-glob-test):
Uncomment some test cases.

Github-reference: https://github.com/joaotavora/eglot/issues/1403
(cherry picked from commit d7b93f63f6923f13fe999d12c4f0ba1dbf7160a8)

diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el
index 6cd48917d472599fb88b697c6f5c0bd383a380d8..9c55402cc05bdb31b4cd190cc67fa0c30f2f6aa2 100644 (file)
--- a/lisp/progmodes/eglot.el
+++ b/lisp/progmodes/eglot.el
@@ -3964,7 +3964,7 @@ at point.  With prefix argument, prompt for ACTION-KIND."
      with grammar = '((:**      "\\*\\*/?"              eglot--glob-emit-**)
                       (:*       "\\*"                   eglot--glob-emit-*)
                       (:?       "\\?"                   eglot--glob-emit-?)
-                      (:{}      "{[^][*{}]+}"           eglot--glob-emit-{})
+                      (:{}      "{[^{}]+}"              eglot--glob-emit-{})
                       (:range   "\\[\\^?[^][/,*{}]+\\]" eglot--glob-emit-range)
                       (:literal "[^][,*?{}]+"           eglot--glob-emit-self))
      until (eobp)
@@ -3974,20 +3974,25 @@ at point.  With prefix argument, prompt for ACTION-KIND."
                            (list (cl-gensym "state-") emitter (match-string 0)))
               finally (error "Glob '%s' invalid at %s" (buffer-string) (point))))))
 
+(cl-defun eglot--glob-fsm (states &key (exit 'eobp) noerror)
+  `(cl-labels ,(cl-loop for (this that) on states
+                        for (self emit text) = this
+                        for next = (or (car that) exit)
+                        collect (funcall emit text self next))
+     ,(if noerror
+          `(,(caar states))
+        `(or (,(caar states))
+             (error "Glob done but more unmatched text: '%s'"
+                    (buffer-substring (point) (point-max)))))))
+
 (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))
+  (let* ((states (eglot--glob-parse  glob))
          (body `(with-current-buffer (get-buffer-create " *eglot-glob-matcher*")
                   (erase-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)))))))
+                  ,(eglot--glob-fsm states)))
          (form `(lambda (string) ,(if noerror `(ignore-errors ,body) body))))
     (if byte-compile (byte-compile form) form)))
 
@@ -4007,10 +4012,20 @@ If NOERROR, return predicate, else erroring function."
 
 (defun eglot--glob-emit-{} (arg self next)
   (let ((alternatives (split-string (substring arg 1 (1- (length arg))) ",")))
-    `(,self ()
-            (or (re-search-forward ,(concat "\\=" (regexp-opt alternatives)) nil t)
-                (error "Failed matching any of %s" ',alternatives))
-            (,next))))
+    (if (cl-notany (lambda (a) (string-match "\\*" a)) alternatives)
+        `(,self ()
+                (or (re-search-forward ,(concat "\\=" (regexp-opt alternatives)) nil t)
+                    (error "No alternatives match: %s" ',alternatives))
+                (,next))
+      (let ((fsms (mapcar (lambda (a)
+                            `(save-excursion
+                               (ignore-errors
+                                 ,(eglot--glob-fsm (eglot--glob-parse a)
+                                                   :exit next :noerror t))))
+                          alternatives)))
+        `(,self ()
+                (or ,@fsms
+                    (error "Glob match fail after alternatives %s" ',alternatives)))))))
 
 (defun eglot--glob-emit-range (arg self next)
   (when (eq ?! (aref arg 1)) (aset arg 1 ?^))

diff --git a/test/lisp/progmodes/eglot-tests.el b/test/lisp/progmodes/eglot-tests.el
index af1ee9989191cd03954d2133c320a6f5702feec8..1e653716a2c9879c9d56b8828dd349fd92059866 100644 (file)
--- a/test/lisp/progmodes/eglot-tests.el
+++ b/test/lisp/progmodes/eglot-tests.el
@@ -1284,13 +1284,19 @@ GUESSED-MAJOR-MODES-SYM are bound to the useful return values of
   ;; (should (eglot--glob-match "{foo,bar}/**" "foo"))
   ;; (should (eglot--glob-match "{foo,bar}/**" "bar"))
 
-  ;; VSCode also supports nested blobs.  Do we care?
+  ;; VSCode also supports nested blobs.  Do we care?  Apparently yes:
+  ;; github#1403
   ;;
-  ;; (should (eglot--glob-match "{**/*.d.ts,**/*.js}" "/testing/foo.js"))
-  ;; (should (eglot--glob-match "{**/*.d.ts,**/*.js}" "testing/foo.d.ts"))
-  ;; (should (eglot--glob-match "{**/*.d.ts,**/*.js,foo.[0-9]}" "foo.5"))
-  ;; (should (eglot--glob-match "prefix/{**/*.d.ts,**/*.js,foo.[0-9]}" "prefix/foo.8"))
-  )
+  (should (eglot--glob-match "{**/*.d.ts,**/*.js}" "/testing/foo.js"))
+  (should (eglot--glob-match "{**/*.d.ts,**/*.js}" "testing/foo.d.ts"))
+  (should (eglot--glob-match "{**/*.d.ts,**/*.js,foo.[0-9]}" "foo.5"))
+  (should-not (eglot--glob-match "{**/*.d.ts,**/*.js,foo.[0-4]}" "foo.5"))
+  (should (eglot--glob-match "prefix/{**/*.d.ts,**/*.js,foo.[0-9]}"
+                             "prefix/foo.8"))
+  (should (eglot--glob-match "prefix/{**/*.js,**/foo.[0-9]}.suffix"
+                             "prefix/a/b/c/d/foo.5.suffix"))
+  (should (eglot--glob-match "prefix/{**/*.js,**/foo.[0-9]}.suffix"
+                             "prefix/a/b/c/d/foo.js.suffix")))
 
 (defvar tramp-histfile-override)
 (defun eglot--call-with-tramp-test (fn)