Fix cider-find-keyword for clojure-ts-mode

CHANGELOG.md

@@ -6,6 +6,10 @@
 
 - [#3777](https://github.com/clojure-emacs/cider/issues/3777): Inspector no longer displays parsed Javadoc for Java classes and members.
 
+### Bugs fixed
+
+- `cider-find-keyword` doesn't work with `clojure-ts-mode`.
+
 ## 1.17.1 (2025-02-25)
 
 ### Changes

cider-find.el

@@ -206,7 +206,7 @@ are disregarded."
             (current-point (point)))
         (while continue
           (setq found (and (search-forward-regexp kw nil 'noerror)
-                           (member 'clojure-keyword-face (text-properties-at (1- (point))))))
+                           (cider-keyword-at-point-p (1- (point)))))
           (setq continue (and (not found)
                               ;; if we haven't moved, there's nothing left to search:
                               (not (equal current-point (point)))))

cider-util.el

@@ -69,6 +69,10 @@ Setting this to nil removes the fontification restriction."
   "Return non-nil if current buffer is managed by a ClojureC major mode."
   (derived-mode-p 'clojurec-mode 'clojure-ts-clojurec-mode))
 
+(defun cider-clojure-ts-mode-p ()
+  "Return non-nil if current buffer is managed by a Clojure[TS] major mode."
+  (derived-mode-p 'clojure-ts-mode))
+
 (defun cider-util--clojure-buffers ()
   "Return a list of all existing `clojure-mode' buffers."
   (seq-filter
@@ -107,6 +111,18 @@ If BUFFER is provided act on that buffer instead."
   (with-current-buffer (or buffer (current-buffer))
     (or (cider-clojurec-major-mode-p))))
 
+(defun cider-keyword-at-point-p (&optional point)
+  "Return non-nil if POINT is in a Clojure keyword.
+
+Take into consideration current major mode."
+  (let ((pos (or point (point))))
+    (if (and (cider-clojure-ts-mode-p)
+             (fboundp 'clojure-ts--keyword-node-p)
+             (fboundp 'treesit-node-parent)
+             (fboundp 'treesit-node-at))
+        (clojure-ts--keyword-node-p (treesit-node-parent (treesit-node-at pos)))
+      (member 'clojure-keyword-face (text-properties-at pos)))))
+
 
 ;;; Thing at point
 

test/clojure-ts-mode/cider-find-ts-tests.el

@@ -0,0 +1,88 @@
+;;; cider-find-ts-tests.el ---                       -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2025  Roman Rudakov
+
+;; Author: Roman Rudakov <rrudakov@fastmail.com>
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This is part of CIDER
+
+;;; Code:
+
+(require 'buttercup)
+(require 'cider-find)
+
+(describe "cider--find-keyword-loc (TreeSitter)"
+  (it "finds the given keyword, discarding false positives"
+    (with-clojure-ts-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-sync-request:ns-path :and-call-fake (lambda (kw-ns _)
+                                                             kw-ns))
+        (spy-on 'cider-resolve-alias :and-call-fake (lambda (_ns ns-qualifier)
+                                                      ns-qualifier))
+        (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 "::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))
+
+        (expect (cider--find-keyword-loc ":foo") :to-throw 'user-error)
+
+        (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))))))
+
+(provide 'cider-find-ts-tests)
+;;; cider-find-ts-tests.el ends here

test/clojure-ts-mode/cider-util-ts-tests.el

@@ -32,6 +32,24 @@
 (require 'clojure-ts-mode)
 (require 'cider-util)
 
+(defun with-clojure-ts-buffer--go-to-point ()
+  (when (search-forward "|" nil 'noerror)
+    (delete-char -1)))
+
+(defmacro with-clojure-ts-buffer (contents &rest body)
+  "Execute BODY in a clojure-ts-mode buffer with CONTENTS
+
+CONTENTS is a string containing an optional character `|' indicating the
+cursor position. If not present, the cursor is placed at the end of the
+buffer."
+  (declare (indent 1))
+  `(with-temp-buffer
+     (delay-mode-hooks (clojure-ts-mode))
+     (insert ,contents)
+     (goto-char (point-min))
+     (with-clojure-ts-buffer--go-to-point)
+     ,@body))
+
 (describe "clojure-ts-mode activation"
   (it "test suite installs the tree-sitter-clojure grammar"
     (with-temp-buffer
@@ -56,4 +74,20 @@
       (expect (cider-clojurescript-major-mode-p) :not :to-be-truthy)
       (expect (cider-clojurec-major-mode-p) :to-be-truthy))))
 
+(describe "cider-keyword-at-p"
+  (it "returns `t' if in keyword"
+    (with-clojure-ts-buffer ":he|llo"
+      (expect (cider-keyword-at-point-p) :to-be-truthy)
+      (expect (cider-keyword-at-point-p (point)) :to-be-truthy))
+    (with-clojure-ts-buffer "::he|llo"
+      (expect (cider-keyword-at-point-p) :to-be-truthy)
+      (expect (cider-keyword-at-point-p (point)) :to-be-truthy))
+    (with-clojure-ts-buffer ":some.names|pace/hello"
+      (expect (cider-keyword-at-point-p) :to-be-truthy)
+      (expect (cider-keyword-at-point-p (point)) :to-be-truthy)))
+  (it "returns `nil' if not in keyword"
+    (with-clojure-ts-buffer ":hello \"|World\""
+      (expect (cider-keyword-at-point-p) :not :to-be-truthy)
+      (expect (cider-keyword-at-point-p (point)) :not :to-be-truthy))))
+
 (provide 'cider-ts-util-tests)