[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/eglot 50b0e84 22/49: Fix #602: fully handle LSP glob sy
From: |
Stefan Monnier |
Subject: |
[elpa] externals/eglot 50b0e84 22/49: Fix #602: fully handle LSP glob syntax |
Date: |
Wed, 17 Mar 2021 18:41:46 -0400 (EDT) |
branch: externals/eglot
commit 50b0e8485e76a0b89ff067db22f58e8d88d76f83
Author: João Távora <joaotavora@gmail.com>
Commit: João Távora <joaotavora@gmail.com>
Fix #602: 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.
---
eglot-tests.el | 55 ++++++++++++++++++++++++++++
eglot.el | 113 +++++++++++++++++++++++++++++++++++++++++++++------------
2 files changed, 144 insertions(+), 24 deletions(-)
diff --git a/eglot-tests.el b/eglot-tests.el
index 852b65a..f081afa 100644
--- a/eglot-tests.el
+++ b/eglot-tests.el
@@ -1044,6 +1044,61 @@ will assume it exists."
(should (equal guessed-class 'eglot-lsp-server))
(should (equal guessed-contact '("some-executable"))))))
+(defun eglot--glob-match (glob str)
+ (funcall (eglot--glob-compile glob t t) str))
+
+(ert-deftest eglot--glob-test ()
+ (should (eglot--glob-match "foo/**/baz" "foo/bar/baz"))
+ (should (eglot--glob-match "foo/**/baz" "foo/baz"))
+ (should-not (eglot--glob-match "foo/**/baz" "foo/bar"))
+ (should (eglot--glob-match "foo/**/baz/**/quuz" "foo/baz/foo/quuz"))
+ (should (eglot--glob-match "foo/**/baz/**/quuz" "foo/foo/foo/baz/foo/quuz"))
+ (should-not (eglot--glob-match "foo/**/baz/**/quuz"
"foo/foo/foo/ding/foo/quuz"))
+ (should (eglot--glob-match "*.js" "foo.js"))
+ (should-not (eglot--glob-match "*.js" "foo.jsx"))
+ (should (eglot--glob-match "foo/**/*.js" "foo/bar/baz/foo.js"))
+ (should-not (eglot--glob-match "foo/**/*.js" "foo/bar/baz/foo.jsx"))
+ (should (eglot--glob-match "*.{js,ts}" "foo.js"))
+ (should-not (eglot--glob-match "*.{js,ts}" "foo.xs"))
+ (should (eglot--glob-match "foo/**/*.{js,ts}" "foo/bar/baz/foo.ts"))
+ (should (eglot--glob-match "foo/**/*.{js,ts}x" "foo/bar/baz/foo.tsx"))
+ (should (eglot--glob-match "?oo.js" "foo.js"))
+ (should (eglot--glob-match "foo/**/*.{js,ts}?" "foo/bar/baz/foo.tsz"))
+ (should (eglot--glob-match "foo/**/*.{js,ts}?" "foo/bar/baz/foo.tsz"))
+ (should (eglot--glob-match "example.[!0-9]" "example.a"))
+ (should-not (eglot--glob-match "example.[!0-9]" "example.0"))
+ (should (eglot--glob-match "example.[0-9]" "example.0"))
+ (should-not (eglot--glob-match "example.[0-9]" "example.a"))
+ (should (eglot--glob-match "**/bar/" "foo/bar/"))
+ (should-not (eglot--glob-match "foo.hs" "fooxhs"))
+
+ ;; Some more tests
+ (should (eglot--glob-match "**/.*" ".git"))
+ (should (eglot--glob-match ".?" ".o"))
+ (should (eglot--glob-match "**/.*" ".hidden.txt"))
+ (should (eglot--glob-match "**/.*" "path/.git"))
+ (should (eglot--glob-match "**/.*" "path/.hidden.txt"))
+ (should (eglot--glob-match "**/node_modules/**" "node_modules/"))
+ (should (eglot--glob-match "{foo,bar}/**" "foo/test"))
+ (should (eglot--glob-match "{foo,bar}/**" "bar/test"))
+ (should (eglot--glob-match "some/**/*" "some/foo.js"))
+ (should (eglot--glob-match "some/**/*" "some/folder/foo.js"))
+
+ ;; VSCode supposedly supports this, not sure if good idea.
+ ;;
+ ;; (should (eglot--glob-match "**/node_modules/**" "node_modules"))
+ ;; (should (eglot--glob-match "{foo,bar}/**" "foo"))
+ ;; (should (eglot--glob-match "{foo,bar}/**" "bar"))
+
+ ;; VSCode also supports nested blobs. Do we care?
+ ;;
+ ;; (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"))
+ )
+
+
(provide 'eglot-tests)
;;; eglot-tests.el ends here
diff --git a/eglot.el b/eglot.el
index 8403e5d..51ed1c4 100644
--- a/eglot.el
+++ b/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))))))
@@ -2670,6 +2662,79 @@ at point. With prefix argument, prompt for ACTION-KIND."
(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
;;;
(defclass eglot-rls (eglot-lsp-server) () :documentation "Rustlang's RLS.")
- [elpa] externals/eglot 8761f86 11/49: Unbreak eglot-dcase test, (continued)
- [elpa] externals/eglot 8761f86 11/49: Unbreak eglot-dcase test, Stefan Monnier, 2021/03/17
- [elpa] externals/eglot 0c4daa4 13/49: Fix #531: mention M-x eldoc as preferred documentation command, Stefan Monnier, 2021/03/17
- [elpa] externals/eglot e5a9648 07/49: Fix #513: use `path-separator', not ":", in Eclipse/JDT custom code, Stefan Monnier, 2021/03/17
- [elpa] externals/eglot e6ca70c 14/49: Close #599: add rnix-lsp server for nix-mode, community suggestion, Stefan Monnier, 2021/03/17
- [elpa] externals/eglot 1f2b024 23/49: Close #605: Support activeParameter property for SignatureInformation, Stefan Monnier, 2021/03/17
- [elpa] externals/eglot 2fc0db8 33/49: Fix #467: make eglot-ignored-server-capabilites defcustom a set, Stefan Monnier, 2021/03/17
- [elpa] externals/eglot 1a54fc0 40/49: Per #627: URIfy better, Stefan Monnier, 2021/03/17
- [elpa] externals/eglot 7f2e680 38/49: Fix #627: handle empty actions array in window/showMessageRequest, Stefan Monnier, 2021/03/17
- [elpa] externals/eglot d00dfe3 08/49: Fix #592: run exit-function only for finished completion, Stefan Monnier, 2021/03/17
- [elpa] externals/eglot 8305eed 18/49: * eglot.el (eglot): Tweak docstring grammar., Stefan Monnier, 2021/03/17
- [elpa] externals/eglot 50b0e84 22/49: Fix #602: fully handle LSP glob syntax,
Stefan Monnier <=
- [elpa] externals/eglot 550ffc2 34/49: Per #602: tweak glob-parsing grammar, Stefan Monnier, 2021/03/17
- [elpa] externals/eglot 133c25e 24/49: Close #613: explicitly require seq.el, Stefan Monnier, 2021/03/17
- [elpa] externals/eglot a43289e 25/49: Fix #616: also override global flymake-diagnostic-functions, Stefan Monnier, 2021/03/17
- [elpa] externals/eglot fc4c324 29/49: Fix #567: update elixir-ls link in README.md, Stefan Monnier, 2021/03/17
- [elpa] externals/eglot 7918fac 43/49: Close #637: Add TRAMP support, Stefan Monnier, 2021/03/17
- [elpa] externals/eglot 33e83ba 44/49: Fix #638: convert colon to hex in URI, Stefan Monnier, 2021/03/17
- [elpa] externals/eglot bf4a7aa 31/49: Fix #406: mention eglot-stay-out-of in README.md, Stefan Monnier, 2021/03/17
- [elpa] externals/eglot 65aadca 46/49: Fix #620: simplify eglot--apply-workspace-edit, Stefan Monnier, 2021/03/17
- [elpa] externals/eglot 97ed4ca 49/49: Close #643: add new command eglot-shutdown-all, Stefan Monnier, 2021/03/17
- [elpa] externals/eglot f9df418 06/49: Fix #584: Define a face for symbol highlight, Stefan Monnier, 2021/03/17