bug#73404: 30.0.50; [forward/kill/etc]-sexp commands do not behave as expected in tree-sitter modes

[Juri Linkov]

> Another variant is to leave treesit-forward-sexp as is,
> and create a new function treesit-forward-sexp-with-list
> that uses the 'list' thing.

This patch keep the current function treesit-forward-sexp,
and creates a new function treesit-forward-sexp-list
that uses the 'sexp-list' thing to navigate lists while
using forward-sexp-default-function to navigate atoms:

diff --git a/lisp/treesit.el b/lisp/treesit.el
index db8f7a7595d..f064be55b9c 100644
--- a/lisp/treesit.el
+++ b/lisp/treesit.el
@@ -2400,6 +2400,68 @@ treesit-forward-sexp
                                     (treesit-node-start boundary)
                                     (treesit-node-end boundary)))))))
 
+(defun treesit-forward-sexp-list (&optional arg)
+  "Tree-sitter implementation for `forward-sexp-function'.
+
+ARG is described in the docstring of `forward-sexp-function'.
+
+If point is inside a text environment where tree-sitter is not
+supported, go forward a sexp using `forward-sexp-default-function'.
+If point is inside code, use tree-sitter functions with the
+following behavior.  If there are no further sexps to move across,
+signal `scan-error' like `forward-sexp' does.  If point is already
+at top-level, return nil without moving point.
+
+What constitutes as text and source code sexp is determined
+by `text' and `sexp' in `treesit-thing-settings'."
+  (interactive "^p")
+  (let* ((arg (or arg 1))
+         (pred (or treesit-sexp-type-regexp 'sexp-list))
+         (current-thing (treesit-thing-at (point) pred t))
+         (default-pos
+          (condition-case _
+              (save-excursion
+                (forward-sexp-default-function arg)
+                (point))
+            (scan-error nil)))
+         (default-pos (unless (eq (point) default-pos) default-pos))
+         (sibling-pos
+          (save-excursion
+            (and (if (> arg 0)
+                     (treesit-end-of-thing pred (abs arg) 'restricted)
+                   (treesit-beginning-of-thing pred (abs arg) 'restricted))
+                 (point))))
+         (sibling (when sibling-pos
+                    (if (> arg 0)
+                        (treesit-thing-prev sibling-pos pred)
+                      (treesit-thing-next sibling-pos pred)))))
+
+    ;; 'forward-sexp-default-function' should not go out of the current thing,
+    ;; neither go inside the next thing, neither go over the next thing
+    (or (when (and default-pos
+                   (or (null current-thing)
+                       (if (> arg 0)
+                           (< default-pos (treesit-node-end current-thing))
+                         (> default-pos (treesit-node-start current-thing))))
+                   (or (null sibling)
+                       (if (> arg 0)
+                           (< default-pos (treesit-node-start sibling))
+                         (> default-pos (treesit-node-end sibling)))))
+          (goto-char default-pos))
+        (when sibling-pos
+          (goto-char sibling-pos))
+        ;; If we couldn't move, we should signal an error and report
+        ;; the obstacle, like `forward-sexp' does.  If we couldn't
+        ;; find a parent, we simply return nil without moving point,
+        ;; then functions like `up-list' will signal "at top level".
+        (when-let* ((parent (treesit-thing-at (point) pred t))
+                    (boundary (if (> arg 0)
+                                  (treesit-node-child parent -1)
+                                (treesit-node-child parent 0))))
+          (signal 'scan-error (list "No more sexp to move across"
+                                    (treesit-node-start boundary)
+                                    (treesit-node-end boundary)))))))
+
 (defun treesit-transpose-sexps (&optional arg)
   "Tree-sitter `transpose-sexps' function.
 ARG is the same as in `transpose-sexps'.
@@ -2849,7 +2911,7 @@ treesit-navigate-thing
           (if (eq tactic 'restricted)
               (setq pos (funcall
                          advance
-                         (cond ((and (null next) (null prev)) parent)
+                         (cond ((and (null next) (null prev) (not (eq thing 
'sexp-list))) parent)
                                ((> arg 0) next)
                                (t prev))))
             ;; For `nested', it's a bit more work:
@@ -3246,6 +3308,9 @@ treesit-major-mode-setup
     (setq-local forward-sexp-function #'treesit-forward-sexp)
     (setq-local transpose-sexps-function #'treesit-transpose-sexps))
 
+  (when (treesit-thing-defined-p 'sexp-list nil)
+    (setq-local forward-sexp-function #'treesit-forward-sexp-list))
+
   (when (treesit-thing-defined-p 'sentence nil)
     (setq-local forward-sentence-function #'treesit-forward-sentence))
 
diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el
index dbf721e8d0f..c4d33564e80 100644
--- a/lisp/progmodes/js.el
+++ b/lisp/progmodes/js.el
@@ -3878,6 +3878,19 @@ js--treesit-sexp-nodes
   "Nodes that designate sexps in JavaScript.
 See `treesit-thing-settings' for more information.")
 
+(defvar js--treesit-sexp-list-nodes
+  '("formal_parameters"
+    "arguments"
+    "statement_block"
+    "parenthesized_expression"
+    "switch_body"
+    "array"
+    "object"
+    "string"
+    "regex")
+  "Nodes that designate lists in JavaScript.
+See `treesit-thing-settings' for more information.")
+
 (defvar js--treesit-jsdoc-beginning-regexp (rx bos "/**")
   "Regular expression matching the beginning of a jsdoc block comment.")
 
@@ -3921,6 +3934,7 @@ js-ts-mode
     (setq-local treesit-thing-settings
                 `((javascript
                    (sexp ,(js--regexp-opt-symbol js--treesit-sexp-nodes))
+                   (sexp-list ,(js--regexp-opt-symbol 
js--treesit-sexp-list-nodes))
                    (sentence ,(js--regexp-opt-symbol 
js--treesit-sentence-nodes))
                    (text ,(js--regexp-opt-symbol '("comment"
                                                    "string_fragment"))))))