master d7b93f63f69: Eglot: supported nested {} patterns in globs

[João Távora]

branch: master
commit d7b93f63f6923f13fe999d12c4f0ba1dbf7160a8
Author: João Távora <joaotavora@gmail.com>
Commit: João Távora <joaotavora@gmail.com>

    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
---
 lisp/progmodes/eglot.el            | 41 ++++++++++++++++++++++++++------------
 test/lisp/progmodes/eglot-tests.el | 18 +++++++++++------
 2 files changed, 40 insertions(+), 19 deletions(-)

diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el
index 5845aff39b7..31948a12d69 100644
--- a/lisp/progmodes/eglot.el
+++ b/lisp/progmodes/eglot.el
@@ -3879,7 +3879,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)
@@ -3889,20 +3889,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)))
 
@@ -3922,10 +3927,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 af1ee998919..1e653716a2c 100644
--- 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)