[nongnu] elpa/cider e8b61c4efd 2/2: Rework `cider-find-keyword`

[ELPA Syncer]

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))
+        ))))