emacs-29 aee10ca1cbe: Adjust tree-sitter defun navigation (bug#61617)

[Yuan Fu]

branch: emacs-29
commit aee10ca1cbee1d653f89f028c34066bf3ebb32ab
Author: Yuan Fu <casouri@gmail.com>
Commit: Yuan Fu <casouri@gmail.com>

    Adjust tree-sitter defun navigation (bug#61617)
    
    Before this change, when you use a tree-sitter navigation function to
    move to the next beginning of a thing, it jumps over the immediate
    next thing and lands you at the beginning of the next-next thing.
    
    Eg, when point is at the "|", and we evaluate
    (treesit--navigate-thing pos 1 'beg), we go from
    
    |  (thing) (thing)
    
    to
    
       (thing) |(thing)
    
    But some might expect point to go to
    
       |(thing) (thing)
    
    instead, which makes sense.  Also, that's how Emacs expect defun
    navigation functions to work.  The discrepancy in expectation causes
    bug#61617.
    
    In this change I made tree-sitter navigation functions to work as what
    Emacs expects.  And what I described for moving to the next beginning
    of thing is similarly applicable to moving to the end of previous end
    of thing.
    
    * lisp/treesit.el (treesit-beginning-of-defun)
    (treesit-end-of-defun): Handle the case where defun-skipper moves
    point back to where we started, by adding a retry.
    
    (treesit--navigate-thing): Add a single condition checking for
    progress to the condition form responsible for checking whether to
    skip the next defun.  Namely (eq pos (funcall advance next)))).
    
    * test/src/treesit-tests.el:
    (treesit--ert-defun-navigation-nested-master)
    (treesit--ert-defun-navigation-top-level-master): Change tests to
    reflect the new expectation.
---
 lisp/treesit.el           | 73 +++++++++++++++++++++++++++++++++--------------
 test/src/treesit-tests.el | 32 ++++++++++-----------
 2 files changed, 68 insertions(+), 37 deletions(-)

diff --git a/lisp/treesit.el b/lisp/treesit.el
index 6b4db2a990c..052f641abfd 100644
--- a/lisp/treesit.el
+++ b/lisp/treesit.el
@@ -1828,10 +1828,23 @@ This is a tree-sitter equivalent of 
`beginning-of-defun'.
 Behavior of this function depends on `treesit-defun-type-regexp'
 and `treesit-defun-skipper'."
   (interactive "^p")
-  (when (treesit-beginning-of-thing treesit-defun-type-regexp arg)
-    (when treesit-defun-skipper
-      (funcall treesit-defun-skipper))
-    t))
+  (let ((orig-point (point))
+        (success nil))
+    (catch 'done
+      (dotimes (_ 2)
+
+        (when (treesit-beginning-of-thing treesit-defun-type-regexp arg)
+          (when treesit-defun-skipper
+            (funcall treesit-defun-skipper)
+            (setq success t)))
+
+        ;; If we end up at the same point, it means we went to the
+        ;; next beg-of-defun, but defun skipper moved point back to
+        ;; where we started, in this case we just move one step
+        ;; further.
+        (if (or (eq arg 0) (not (eq orig-point (point))))
+            (throw 'done success)
+          (setq arg (if (> arg 0) (1+ arg) (1- arg))))))))
 
 (defun treesit-end-of-defun (&optional arg _)
   "Move forward to next end of defun.
@@ -1843,9 +1856,21 @@ This is a tree-sitter equivalent of `end-of-defun'.  
Behavior of
 this function depends on `treesit-defun-type-regexp' and
 `treesit-defun-skipper'."
   (interactive "^p\nd")
-  (when (treesit-end-of-thing treesit-defun-type-regexp arg)
-    (when treesit-defun-skipper
-      (funcall treesit-defun-skipper))))
+  (let ((orig-point (point)))
+    (catch 'done
+      (dotimes (_ 2) ; Not making progress is better than infloop.
+
+        (when (treesit-end-of-thing treesit-defun-type-regexp arg)
+          (when treesit-defun-skipper
+            (funcall treesit-defun-skipper)))
+
+        ;; If we end up at the same point, it means we went to the
+        ;; prev end-of-defun, but defun skipper moved point back to
+        ;; where we started, in this case we just move one step
+        ;; further.
+        (if (or (eq arg 0) (not (eq orig-point (point))))
+            (throw 'done nil)
+          (setq arg (if (> arg 0) (1+ arg) (1- arg))))))))
 
 (defun treesit-default-defun-skipper ()
   "Skips spaces after navigating a defun.
@@ -1967,9 +1992,9 @@ REGEXP and PRED are the same as in 
`treesit-thing-at-point'."
 ;;
 ;; prev-end (tricky):
 ;; 1. prev-sibling exists
-;;    -> If you think about it, we are already at prev-sibling's end!
-;;       So we need to go one step further, either to
-;;       prev-prev-sibling's end, or parent's prev-sibling's end, etc.
+;;    -> If we are already at prev-sibling's end, we need to go one
+;;       step further, either to prev-prev-sibling's end, or parent's
+;;       prev-sibling's end, etc.
 ;; 2. prev-sibling is nil but parent exists
 ;;    -> Obviously we don't want to go to parent's end, instead, we
 ;;       want to go to parent's prev-sibling's end.  Again, we recurse
@@ -2019,18 +2044,24 @@ function is called recursively."
               ;; ...forward.
               (if (and (eq side 'beg)
                        ;; Should we skip the defun (recurse)?
-                       (cond (next (not recursing)) ; [1] (see below)
-                             (parent t) ; [2]
-                             (t nil)))
-                  ;; Special case: go to next beg-of-defun.  Set POS
-                  ;; to the end of next-sib/parent defun, and run one
-                  ;; more step.  If there is a next-sib defun, we only
-                  ;; need to recurse once, so we don't need to recurse
-                  ;; if we are already recursing [1]. If there is no
+                       (cond (next (and (not recursing) ; [1] (see below)
+                                        (eq pos (funcall advance next))))
+                             (parent t))) ; [2]
+                  ;; Special case: go to next beg-of-defun, but point
+                  ;; is already on beg-of-defun.  Set POS to the end
+                  ;; of next-sib/parent defun, and run one more step.
+                  ;; If there is a next-sib defun, we only need to
+                  ;; recurse once, so we don't need to recurse if we
+                  ;; are already recursing [1]. If there is no
                   ;; next-sib but a parent, keep stepping out
                   ;; (recursing) until we got out of the parents until
                   ;; (1) there is a next sibling defun, or (2) no more
                   ;; parents [2].
+                  ;;
+                  ;; If point on beg-of-defun but we are already
+                  ;; recurring, that doesn't count as special case,
+                  ;; because we have already made progress (by moving
+                  ;; the end of next before recurring.)
                   (setq pos (or (treesit--navigate-thing
                                  (treesit-node-end (or next parent))
                                  1 'beg regexp pred t)
@@ -2039,9 +2070,9 @@ function is called recursively."
                 (setq pos (funcall advance (or next parent))))
             ;; ...backward.
             (if (and (eq side 'end)
-                     (cond (prev (not recursing))
-                           (parent t)
-                           (t nil)))
+                     (cond (prev (and (not recursing)
+                                      (eq pos (funcall advance prev))))
+                           (parent t)))
                 ;; Special case: go to prev end-of-defun.
                 (setq pos (or (treesit--navigate-thing
                                (treesit-node-start (or prev parent))
diff --git a/test/src/treesit-tests.el b/test/src/treesit-tests.el
index 5aa12e8aa0e..468cd221ef9 100644
--- a/test/src/treesit-tests.el
+++ b/test/src/treesit-tests.el
@@ -977,22 +977,22 @@ and \"]\"."
 
 (defvar treesit--ert-defun-navigation-nested-master
   ;; START PREV-BEG NEXT-END PREV-END NEXT-BEG
-  '((0 103 105 102 106) ; Between Beg of parent & 1st sibling.
+  '((0 103 105 102 104) ; Between Beg of parent & 1st sibling.
     (1 103 105 102 106) ; Beg of 1st sibling.
     (2 104 105 102 106) ; Inside 1st sibling.
-    (3 104 107 102 109) ; End of 1st sibling.
-    (4 104 107 102 109) ; Between 1st sibling & 2nd sibling.
-    (5 104 107 102 109) ; Beg of 2nd sibling.
+    (3 104 107 102 106) ; End of 1st sibling.
+    (4 104 107 105 106) ; Between 1st sibling & 2nd sibling.
+    (5 104 107 105 109) ; Beg of 2nd sibling.
     (6 106 107 105 109) ; Inside 2nd sibling.
     (7 106 108 105 109) ; End of 2nd sibling.
-    (8 106 108 105 109) ; Between 2nd sibling & end of parent.
-    (9 103 110 102 nil) ; End of parent.
+    (8 106 108 107 109) ; Between 2nd sibling & end of parent.
+    (9 103 110 102 109) ; End of parent.
 
-    (100 nil 102 nil 103) ; Before 1st parent.
+    (100 nil 102 nil 101) ; Before 1st parent.
     (101 nil 102 nil 103) ; Beg of 1st parent.
-    (102 101 108 nil 109) ; Between 1st & 2nd parent.
-    (103 101 108 nil 109) ; Beg of 2nd parent.
-    (110 109 nil 108 nil) ; After 3rd parent.
+    (102 101 108 102 103) ; Between 1st & 2nd parent.
+    (103 101 108 102 109) ; Beg of 2nd parent.
+    (110 109 nil 110 nil) ; After 3rd parent.
     )
   "Master of nested navigation test.
 
@@ -1000,7 +1000,7 @@ This basically says, e.g., \"start with point on marker 
0, go to
 the prev-beg, now point should be at marker 103\", etc.")
 
 (defvar treesit--ert-defun-navigation-top-level-master
-  ;; START PREV-BEG NEXT-END NEXT-BEG PREV-END
+  ;; START PREV-BEG NEXT-END PREV-END NEXT-BEG
   '((0 103 108 102 109) ; Between Beg of parent & 1st sibling.
     (1 103 108 102 109) ; Beg of 1st sibling.
     (2 103 108 102 109) ; Inside 1st sibling.
@@ -1010,14 +1010,14 @@ the prev-beg, now point should be at marker 103\", 
etc.")
     (6 103 108 102 109) ; Inside 2nd sibling.
     (7 103 108 102 109) ; End of 2nd sibling.
     (8 103 108 102 109) ; Between 2nd sibling & end of parent.
-    (9 103 110 102 nil) ; End of parent.
+    (9 103 110 102 109) ; End of parent.
 
     ;; Top-level defuns should be identical to the nested test.
-    (100 nil 102 nil 103) ; Before 1st parent.
+    (100 nil 102 nil 101) ; Before 1st parent.
     (101 nil 102 nil 103) ; Beg of 1st parent.
-    (102 101 108 nil 109) ; Between 1st & 2nd parent.
-    (103 101 108 nil 109) ; Beg of 2nd parent.
-    (110 109 nil 108 nil) ; After 3rd parent.
+    (102 101 108 102 103) ; Between 1st & 2nd parent.
+    (103 101 108 102 109) ; Beg of 2nd parent.
+    (110 109 nil 110 nil) ; After 3rd parent.
     )
   "Master of top-level navigation test.")