[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[nongnu] elpa/cider e8b61c4efd 2/2: Rework `cider-find-keyword`
From: |
ELPA Syncer |
Subject: |
[nongnu] elpa/cider e8b61c4efd 2/2: Rework `cider-find-keyword` |
Date: |
Tue, 29 Aug 2023 06:59:41 -0400 (EDT) |
branch: elpa/cider
commit e8b61c4efdee5b2671b446315aaeae3fe2d3fadb
Author: vemv <vemv@users.noreply.github.com>
Commit: vemv <vemv@users.noreply.github.com>
Rework `cider-find-keyword`
* Make it work in ClojureScript
* Don't match non-symbols
* Don't match keywords that are a superset of the current one
* Don't leave buffers open if the keyword wasn't found
---
CHANGELOG.md | 1 +
cider-client.el | 27 ++++++++++++++-----
cider-find.el | 67 +++++++++++++++++++++++++++++++++++++++---------
test/cider-find-tests.el | 53 ++++++++++++++++++++++++++++++++++++++
4 files changed, 130 insertions(+), 18 deletions(-)
diff --git a/CHANGELOG.md b/CHANGELOG.md
index f155d73874..175b231930 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -34,6 +34,7 @@
- [#2436](https://github.com/clojure-emacs/cider/issues/2436): Prevent
malformed `cider-repl-history-file`s from failing `cider-jack-in`.
- Fix the `xref-find-definitions` CIDER backend to return correct filenames.
- Fix the `cider-xref-fn-deps` buttons to direct to the right file.
+- Fix the `cider-find-keyword` overall reliability and correctness,
particularly for ClojureScript.
- Make TRAMP functionality work when using non-standard ports.
### Changes
diff --git a/cider-client.el b/cider-client.el
index 13c311d870..b40bff38de 100644
--- a/cider-client.el
+++ b/cider-client.el
@@ -732,12 +732,27 @@ returned."
(cider-nrepl-send-sync-request)
(nrepl-dict-get "ns-vars")))
-(defun cider-sync-request:ns-path (ns)
- "Get the path to the file containing NS."
- (thread-first `("op" "ns-path"
- "ns" ,ns)
- (cider-nrepl-send-sync-request)
- (nrepl-dict-get "path")))
+(defun cider-sync-request:ns-path (ns &optional favor-url)
+ "Get the path to the file containing NS, FAVOR-URL if specified.
+
+FAVOR-URL ensures a Java URL is returned.
+
+* This always is the case if the underlying runtime is JVM Clojure.
+* For ClojureScript, the default is a resource name.
+ * This often cannot be open by `cider-find-file'
+ (unless there was already a buffer opening that file)
+
+Generally, you always want to FAVOR-URL.
+The option is kept for backwards compatibility.
+
+Note that even when favoring a url, the url itself might be nil,
+in which case we'll fall back to the resource name."
+ (let ((response (cider-nrepl-send-sync-request `("op" "ns-path"
+ "ns" ,ns))))
+ (nrepl-dbind-response response (path url)
+ (if (and favor-url url)
+ url
+ path))))
(defun cider-sync-request:ns-vars-with-meta (ns)
"Get a map of the vars in NS to its metadata information."
diff --git a/cider-find.el b/cider-find.el
index ea3f50ab36..f835c2a249 100644
--- a/cider-find.el
+++ b/cider-find.el
@@ -192,6 +192,52 @@ the results to be displayed in a different window."
(ns (completing-read "Find namespace: " namespaces)))
(cider--find-ns ns (cider--open-other-window-p arg)))))
+(defun cider--find-keyword-in-buffer (buffer kw)
+ "Returns the point where `KW' is found in `BUFFER'.
+Returns nil of no matching keyword is found.
+Occurrences of `KW' as (or within) strings, comments, #_ forms, symbols, etc
+are disregarded."
+ (with-current-buffer buffer
+ (save-excursion
+ (goto-char (point-min))
+ (font-lock-ensure) ;; make the forthcoming `text-properties-at` call
useful
+ (let ((found nil)
+ (continue t)
+ (current-point (point)))
+ (while continue
+ (setq found (and (search-forward-regexp kw nil 'noerror)
+ (member 'clojure-keyword-face (text-properties-at
(1- (point))))))
+ (setq continue (and (not found)
+ ;; if we haven't moved, there's nothing left to
search:
+ (not (equal current-point (point)))))
+ (setq current-point (point)))
+ (when found
+ current-point)))))
+
+(defun cider--find-keyword-loc (kw)
+ "Given `KW', returns an nrepl-dict with url, dest, dest-point.
+
+Returns the dict in all cases. `dest-point' indicates success:
+integer on successful finds, nil otherwise."
+ (let* ((ns-qualifier (and
+ (string-match "^:+\\(.+\\)/.+$" kw)
+ (match-string 1 kw)))
+ (kw-ns (or (cider-resolve--get-in (cider-current-ns) "aliases"
ns-qualifier)
+ ns-qualifier))
+ (kw-name (replace-regexp-in-string "^:+\\(.+/\\)?" "" kw))
+ (end-of-word "\\>") ;; important: if searching for foo, we don't want
to match foobar (a larger word)
+ (kw-to-find (concat "\\("
+ (concat "::" kw-name)
+ "\\|"
+ (concat ":" kw-ns "/" kw-name)
+ "\\)"
+ end-of-word)))
+ (let* ((url (cider-sync-request:ns-path kw-ns t))
+ (dest (cider-find-file url))
+ (dest-point (when dest
+ (cider--find-keyword-in-buffer dest kw-to-find))))
+ (nrepl-dict "url" url "dest" dest "dest-point" dest-point))))
+
;;;###autoload
(defun cider-find-keyword (&optional arg)
"Find the namespace of the keyword at point and its first occurrence there.
@@ -213,18 +259,15 @@ thing at point."
(format "Keyword (default %s): " kw-at-point)
nil nil kw-at-point)
kw-at-point)))
- (ns-qualifier (and
- (string-match "^:+\\(.+\\)/.+$" kw)
- (match-string 1 kw)))
- (kw-ns (if ns-qualifier
- (cider-resolve-alias (cider-current-ns) ns-qualifier)
- (cider-current-ns)))
- (kw-to-find (concat "::" (replace-regexp-in-string "^:+\\(.+/\\)?" ""
kw))))
-
- (when (and ns-qualifier (string= kw-ns (cider-current-ns)))
- (error "Could not resolve alias `%s' in `%s'" ns-qualifier
(cider-current-ns)))
- (cider--find-ns kw-ns arg)
- (search-forward-regexp kw-to-find nil 'noerror)))
+ (before (buffer-list))
+ (result (cider--find-keyword-loc kw)))
+ (nrepl-dbind-response result (dest dest-point)
+ (if dest-point
+ (cider-jump-to dest dest-point arg)
+ (progn
+ (unless (memq dest before)
+ (kill-buffer dest))
+ (user-error "Couldn't find a definition for %S" kw))))))
(provide 'cider-find)
;;; cider-find.el ends here
diff --git a/test/cider-find-tests.el b/test/cider-find-tests.el
index 1c5c742acd..cdf87786da 100644
--- a/test/cider-find-tests.el
+++ b/test/cider-find-tests.el
@@ -37,3 +37,56 @@
(it "raises a user error if the op is not supported"
(spy-on 'cider-nrepl-op-supported-p :and-return-value nil)
(expect (cider-find-ns) :to-throw 'user-error)))
+
+(describe "cider--find-keyword-loc"
+ (it "finds the given keyword, discarding false positives"
+ (with-clojure-buffer "(ns some.ns)
+;; ::foo
+\"::foo\"
+#_::foo
+::foobar
+\"
+::foo
+\"
+::foo
+more
+stuff"
+ (let* ((sample-buffer (current-buffer)))
+ (spy-on 'cider-ensure-connected :and-return-value t)
+ (spy-on 'cider-resolve--get-in :and-return-value nil)
+ (spy-on 'cider-current-ns :and-return-value nil)
+ (spy-on 'cider-sync-request:ns-path :and-call-fake (lambda (kw-ns _)
+ kw-ns))
+ (spy-on 'cider-find-file :and-call-fake (lambda (kw-ns)
+ (when (equal kw-ns "some.ns")
+ sample-buffer)))
+
+ (nrepl-dbind-response (cider--find-keyword-loc "::some.ns/foo") (dest
dest-point)
+ (expect dest-point :to-equal 63)
+ (with-current-buffer dest
+ (goto-char dest-point)
+ ;; important - ensure that we're looking at ::foo and not ::foobar:
+ (expect (cider-symbol-at-point 'look-back) :to-equal "::foo")))
+
+ (nrepl-dbind-response (cider--find-keyword-loc ":some.ns/foo") (dest
dest-point)
+ (expect dest-point :to-equal 63)
+ (with-current-buffer dest
+ (goto-char dest-point)
+ ;; important - ensure that we're looking at ::foo and not ::foobar:
+ (expect (cider-symbol-at-point 'look-back) :to-equal "::foo")))
+
+ (nrepl-dbind-response (cider--find-keyword-loc "::some.ns/bar") (dest
dest-point)
+ (expect dest-point :to-equal nil))
+
+ (nrepl-dbind-response (cider--find-keyword-loc ":some.ns/bar") (dest
dest-point)
+ (expect dest-point :to-equal nil))
+
+ (nrepl-dbind-response (cider--find-keyword-loc ":foo") (dest
dest-point)
+ (expect dest-point :to-equal nil))
+
+ (nrepl-dbind-response (cider--find-keyword-loc ":unrelated/foo") (dest
dest-point)
+ (expect dest-point :to-equal nil))
+
+ (nrepl-dbind-response (cider--find-keyword-loc "::unrelated/foo")
(dest dest-point)
+ (expect dest-point :to-equal nil))
+ ))))