From 9da760fba4ebd16b4255663a399efff551ab95aa Mon Sep 17 00:00:00 2001
From: Profpatsch <mail@profpatsch.de>
Date: Sat, 19 Dec 2020 20:05:35 +0100
Subject: feat(emacs-tree-sitter-move): Add tree-sitter-move-reset
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Resets the cursor to the named node under the cursor.
`-right` does not do it anymore, so it’s possible to navigate on
higher levels of the tree instead of always resetting to a leaf.

Change-Id: Id330854c72ea24da0cc8611f30f5617e0f127c1b
Reviewed-on: https://cl.tvl.fyi/c/depot/+/2259
Reviewed-by: Profpatsch <mail@profpatsch.de>
Tested-by: BuildkiteCI
---
 users/Profpatsch/emacs-tree-sitter-move/tmp.el     |  1 +
 .../emacs-tree-sitter-move/tree-sitter-move.el     | 46 ++++++++++++----------
 2 files changed, 27 insertions(+), 20 deletions(-)

(limited to 'users')

diff --git a/users/Profpatsch/emacs-tree-sitter-move/tmp.el b/users/Profpatsch/emacs-tree-sitter-move/tmp.el
index dcd17aa5757f..fa13da120772 100644
--- a/users/Profpatsch/emacs-tree-sitter-move/tmp.el
+++ b/users/Profpatsch/emacs-tree-sitter-move/tmp.el
@@ -7,6 +7,7 @@
       '((python-mode . python)))
 
 
+(define-key evil-normal-state-map (kbd "C-.") #'tree-sitter-move-reset)
 (define-key evil-normal-state-map (kbd "C-<right>") #'tree-sitter-move-right)
 ;; (define-key evil-normal-state-map (kbd "C-<left>") 'sp-backward-parallel-sexp)
 ;; (define-key evil-normal-state-map (kbd "C-<down>") 'sp-down-sexp)
diff --git a/users/Profpatsch/emacs-tree-sitter-move/tree-sitter-move.el b/users/Profpatsch/emacs-tree-sitter-move/tree-sitter-move.el
index 37aafefb0e6e..0a5e34e4be8f 100644
--- a/users/Profpatsch/emacs-tree-sitter-move/tree-sitter-move.el
+++ b/users/Profpatsch/emacs-tree-sitter-move/tree-sitter-move.el
@@ -44,34 +44,31 @@
   (tree-sitter-mode nil))
 
 ;; Get the syntax node the cursor is on.
-(defun tsc-node-named-node-at-point ()
+(defun tsc-get-named-node-at-point ()
   (let ((p (point)))
     (tsc-get-named-descendant-for-position-range
      (tsc-root-node tree-sitter-tree) p p)))
 
-(defun tsc-get-node-at-point ()
-  (let ((p (point)))
-    (tsc-get-descendant-for-position-range
-     (tsc-root-node tree-sitter-tree) p p)))
-
 (defun tsc-get-first-named-node-with-siblings-up (node)
   "Returns the first 'upwards' node that has siblings. That includes the current
-  node, so if the given node has siblings, it is returned."
-  (let ((has-siblings-p
-         (lambda (n)
-           (> (tsc-count-named-children (tsc-get-parent n))
-              1)))
-        (res node))
-    (while (not (funcall has-siblings-p res))
-      ;; TODO tsc-get-parent is called twice, nicer somehow?
-      (setq res (tsc-get-parent res)))
-    res))
+  node, so if the given node has siblings, it is returned. Returns nil if there
+  is no such node until the root"
+  (when-let ((has-siblings-p
+            (lambda (parent-node)
+              (> (tsc-count-named-children parent-node)
+                 1)))
+           (cur node)
+           (parent (tsc-get-parent node)))
+      (while (not (funcall has-siblings-p parent))
+        (setq cur parent)
+        (setq parent (tsc-get-parent cur)))
+    cur))
 
 (defun tree-sitter-move--set-cursor-to-node (node)
   (setq tree-sitter-move--cursor node))
 
 (defun tree-sitter-move--set-cursor-to-node-at-point ()
-  (tree-sitter-move--set-cursor-to-node (tsc-get-node-at-point)))
+  (tree-sitter-move--set-cursor-to-node (tsc-get-named-node-at-point)))
 
 (defun tree-sitter-move--move-point-to-node (node)
   (set-window-point
@@ -81,13 +78,22 @@
 
 ;; interactive commands (“do what I expect” section)
 
+(defun tree-sitter-move-reset ()
+  (interactive)
+  (tree-sitter-move--set-cursor-to-node-at-point))
+
 (defun tree-sitter-move-right ()
   "Moves to the next sibling. If the current node does not have siblings, go
   upwards until something has siblings and then move right."
   (interactive)
-  (tree-sitter-move--set-cursor-to-node-at-point)
-  (let ((next (tsc-get-next-named-sibling
-               (tsc-get-first-named-node-with-siblings-up tree-sitter-move--cursor))))
+  (tree-sitter-move--move-if-possible
+   (lambda (cur)
+     (when-let ((with-siblings
+                 (tsc-get-first-named-node-with-siblings-up cur)))
+       (tsc-get-next-named-sibling with-siblings)))))
+
+(defun tree-sitter-move--move-if-possible (dir-fn)
+  (let ((next (funcall dir-fn tree-sitter-move--cursor)))
     (when next
       (tree-sitter-move--set-cursor-to-node next)
       (tree-sitter-move--move-point-to-node next))))
-- 
cgit 1.4.1