7 files changed, 227 insertions, 0 deletions
diff --git a/users/Profpatsch/emacs-tree-sitter-move/default.nix b/users/Profpatsch/emacs-tree-sitter-move/default.nix
new file mode 100644
index 000000000000..fdc059c089b6
--- /dev/null
+++ b/users/Profpatsch/emacs-tree-sitter-move/default.nix
@@ -0,0 +1,3 @@
+# nothing yet (TODO: expose shell & tool)
+{...}:
+{}
diff --git a/users/Profpatsch/emacs-tree-sitter-move/shell.nix b/users/Profpatsch/emacs-tree-sitter-move/shell.nix
new file mode 100644
index 000000000000..81d622ac73e5
--- /dev/null
+++ b/users/Profpatsch/emacs-tree-sitter-move/shell.nix
@@ -0,0 +1,16 @@
+{ pkgs ? import ../../../third_party {}, ... }:
+let
+  inherit (pkgs) lib;
+
+  treeSitterGrammars = pkgs.runCommandLocal "grammars" {} ''
+    mkdir -p $out/bin
+    ${lib.concatStringsSep "\n"
+      (lib.mapAttrsToList (name: src: "ln -s ${src}/parser $out/bin/${name}.so") pkgs.tree-sitter.builtGrammars)};
+  '';
+
+in pkgs.mkShell {
+  buildInputs = [
+    pkgs.tree-sitter.builtGrammars.python
+  ];
+  TREE_SITTER_GRAMMAR_DIR = treeSitterGrammars;
+}
diff --git a/users/Profpatsch/emacs-tree-sitter-move/test.json b/users/Profpatsch/emacs-tree-sitter-move/test.json
new file mode 100644
index 000000000000..d9f8075976d6
--- /dev/null
+++ b/users/Profpatsch/emacs-tree-sitter-move/test.json
@@ -0,0 +1,14 @@
+{
+    "foo": {
+        "x": [ 1, 2, 3, 4 ],
+        "bar": "test"
+    },
+    "foo": {
+        "x": [ 1, 2, 3, 4 ],
+        "bar": "test"
+    },
+    "foo": {
+        "x": [ 1, 2, 3, 4 ],
+        "bar": "test"
+    }
+}
diff --git a/users/Profpatsch/emacs-tree-sitter-move/test.py b/users/Profpatsch/emacs-tree-sitter-move/test.py
new file mode 100644
index 000000000000..0f57bae035da
--- /dev/null
+++ b/users/Profpatsch/emacs-tree-sitter-move/test.py
@@ -0,0 +1,13 @@
+(4 + 5 + 5)
+
+def foo(a, b, c)
+
+def bar(a, b):
+    4
+    4
+    4
+
+[1, 4, 5, 10]
+
+def foo():
+    pass
diff --git a/users/Profpatsch/emacs-tree-sitter-move/test.sh b/users/Profpatsch/emacs-tree-sitter-move/test.sh
new file mode 100644
index 000000000000..681081f5909d
--- /dev/null
+++ b/users/Profpatsch/emacs-tree-sitter-move/test.sh
@@ -0,0 +1,14 @@
+function foo () {
+    local x=123
+}
+
+function bar () {
+    local x=123
+}
+
+echo abc def \
+     gef gef
+
+printf \
+    "%s\n" \
+    haha
diff --git a/users/Profpatsch/emacs-tree-sitter-move/tmp.el b/users/Profpatsch/emacs-tree-sitter-move/tmp.el
new file mode 100644
index 000000000000..88d13fa45b81
--- /dev/null
+++ b/users/Profpatsch/emacs-tree-sitter-move/tmp.el
@@ -0,0 +1,28 @@
+(defun tree-sitter-load-from-grammar-dir (grammar-dir sym lang-name)
+  (tree-sitter-load
+   sym
+   (format "%s/bin/%s"
+           (getenv grammar-dir)
+           lang-name)))
+
+(defun tree-sitter-init-tmp-langs (alist)
+  (mapcar
+   (lambda (lang)
+     (pcase-let ((`(,name ,sym ,mode) lang))
+       (tree-sitter-load-from-grammar-dir "TREE_SITTER_GRAMMAR_DIR" sym name)
+       (cons mode sym)))
+   alist))
+
+
+(setq tree-sitter-major-mode-language-alist
+      (tree-sitter-init-tmp-langs
+       '(("python" python python-mode)
+         ("json" json js-mode)
+         ("bash" bash sh-mode)
+         )))
+
+(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>") #'tree-sitter-move-left)
+(define-key evil-normal-state-map (kbd "C-<up>") #'tree-sitter-move-up)
+(define-key evil-normal-state-map (kbd "C-<down>") #'tree-sitter-move-down)
diff --git a/users/Profpatsch/emacs-tree-sitter-move/tree-sitter-move.el b/users/Profpatsch/emacs-tree-sitter-move/tree-sitter-move.el
new file mode 100644
index 000000000000..907e1e4081bc
--- /dev/null
+++ b/users/Profpatsch/emacs-tree-sitter-move/tree-sitter-move.el
@@ -0,0 +1,139 @@
+;; this is not an actual cursor, just a node.
+;; It’s not super efficient, but cursors can’t be *set* to an arbitrary
+;; subnode, because they can’t access the parent otherwise.
+;; We’d need a way to reset the cursor and walk down to the node?!
+(defvar-local tree-sitter-move--cursor nil
+  "the buffer-local cursor used for movement")
+
+(defvar-local tree-sitter-move--debug-overlay nil
+  "an overlay used to visually display the region currently marked by the cursor")
+
+;;;;; TODO: should everything use named nodes? Only some things?
+;;;;; maybe there should be a pair of functions for everything?
+;;;;; For now restrict to named nodes.
+
+(defun tree-sitter-move--setup ()
+  ;; TODO
+  (progn
+    ;; TODO: if tree-sitter-mode fails to load, display a better error
+    (tree-sitter-mode t)
+    (setq tree-sitter-move--cursor (tsc-root-node tree-sitter-tree))
+    (add-variable-watcher
+     'tree-sitter-move--cursor
+     #'tree-sitter-move--debug-overlay-update)))
+
+(defun tree-sitter-move--debug-overlay-update (sym newval &rest _args)
+  "variable-watcher to update the debug overlay when the cursor changes"
+  (let ((start (tsc-node-start-position newval))
+        (end (tsc-node-end-position newval)))
+    (symbol-macrolet ((o tree-sitter-move--debug-overlay))
+      (if o
+          (move-overlay o start end)
+        (setq o (make-overlay start end))
+        (overlay-put o 'face 'highlight)
+        ))))
+
+(defun tree-sitter-move--debug-overlay-teardown ()
+  "Turn of the overlay visibility and delete the overlay object"
+  (when tree-sitter-move--debug-overlay
+    (delete-overlay tree-sitter-move--debug-overlay)
+    (setq tree-sitter-move--debug-overlay nil)))
+
+(defun tree-sitter-move--teardown ()
+  (setq tree-sitter-move--cursor nil)
+  (tree-sitter-move--debug-overlay-teardown)
+  (tree-sitter-mode nil))
+
+;; Get the syntax node the cursor is on.
+(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)))
+
+;; TODO: is this function necessary?
+;; Maybe tree-sitter always guarantees that parents are named?
+(defun tsc-get-named-parent (node)
+  (when-let ((parent (tsc-get-parent node)))
+    (while (and parent (not (tsc-node-named-p parent)))
+      (setq parent (tsc-get-parent parent)))
+    parent))
+
+(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. 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-named-parent node)))
+    (while (and parent (not (funcall has-siblings-p parent)))
+      (setq cur parent)
+      (setq parent (tsc-get-named-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-named-node-at-point)))
+
+(defun tree-sitter-move--move-point-to-node (node)
+  (set-window-point
+    (selected-window)
+    (tsc-node-start-position node)))
+
+
+;; 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 ()
+  (interactive)
+  (tree-sitter-move--move-skip-non-sibling-nodes 'tsc-get-next-named-sibling))
+
+(defun tree-sitter-move-left ()
+  (interactive)
+  (tree-sitter-move--move-skip-non-sibling-nodes 'tsc-get-prev-named-sibling))
+
+(defun tree-sitter-move-up ()
+  (interactive)
+  (tree-sitter-move--move-skip-non-sibling-nodes 'tsc-get-parent))
+
+;; TODO: does not skip siblings yet, because the skip function only goes up (not down)
+(defun tree-sitter-move-down ()
+  (interactive)
+  (tree-sitter-move--move-if-possible (lambda (n) (tsc-get-nth-named-child n 0))))
+
+(defun tree-sitter-move--move-skip-non-sibling-nodes (move-fn)
+  "Moves to the sidewards next sibling. If the current node does not have siblings, go
+  upwards until something has siblings and then move to the side (right or left)."
+  (tree-sitter-move--move-if-possible
+   (lambda (cur)
+     (when-let ((with-siblings
+                 (tsc-get-first-named-node-with-siblings-up cur)))
+       (funcall move-fn 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))))
+
+; mostly stolen from tree-sitter-mode
+;;;###autoload
+(define-minor-mode tree-sitter-move-mode
+  "Minor mode to do cursor movements via tree-sitter"
+  :init-value nil
+  :lighter " tree-sitter-move"
+  (if tree-sitter-move-mode
+      (tree-sitter--error-protect
+          (progn
+            (tree-sitter-move--setup))
+        (setq tree-sitter-move-mode nil)
+        (tree-sitter-move--teardown))
+    (lambda ())
+    (tree-sitter-move--teardown)))