>From 9c2bf9869fbd76b81c21f13a02d70e85eec736be Mon Sep 17 00:00:00 2001
From: Theodor Thornhill <theo@thornhill.no>
Date: Thu, 15 Dec 2022 21:22:13 +0100
Subject: [PATCH] Add treesit-transpose-sexps

We don't really need to rely on forward-sexp to define what to
transpose.  In tree-sitter we can consider siblings as "balanced
expressions", and swap them without doing any movement to calculate
where the siblings in question are.

* lisp/simple.el: Add requires for treesit.
* lisp/simple.el (transpose-sexps): If tree-sitter is available, use
treesit-transpose-sexps as the 'special' function.
(transpose-subr): Just use tree-sitter when available.
* lisp/treesit.el (treesit-transpose-sexps): New function.
---
 lisp/simple.el  | 67 ++++++++++++++++++++++++++-----------------------
 lisp/treesit.el | 16 ++++++++++++
 2 files changed, 52 insertions(+), 31 deletions(-)

diff --git a/lisp/simple.el b/lisp/simple.el
index dcc2242e49..15f7381f06 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -28,10 +28,12 @@
 
 ;;; Code:
 
-(eval-when-compile (require 'cl-lib))
+(eval-when-compile (require 'cl-lib)
+                   (require 'treesit))
 
 (declare-function widget-convert "wid-edit" (type &rest args))
 (declare-function shell-mode "shell" ())
+(declare-function treesit-parser-list "treesit.c")
 
 ;;; From compile.el
 (defvar compilation-current-error)
@@ -8453,36 +8455,37 @@ transpose-sexps
           (transpose-sexps arg nil)
         (scan-error (user-error "Not between two complete sexps")))
     (transpose-subr
-     (lambda (arg)
-       ;; Here we should try to simulate the behavior of
-       ;; (cons (progn (forward-sexp x) (point))
-       ;;       (progn (forward-sexp (- x)) (point)))
-       ;; Except that we don't want to rely on the second forward-sexp
-       ;; putting us back to where we want to be, since forward-sexp-function
-       ;; might do funny things like infix-precedence.
-       (if (if (> arg 0)
-	       (looking-at "\\sw\\|\\s_")
-	     (and (not (bobp))
-		  (save-excursion
-                    (forward-char -1)
-                    (looking-at "\\sw\\|\\s_"))))
-	   ;; Jumping over a symbol.  We might be inside it, mind you.
-	   (progn (funcall (if (> arg 0)
-			       'skip-syntax-backward 'skip-syntax-forward)
-			   "w_")
-		  (cons (save-excursion (forward-sexp arg) (point)) (point)))
-         ;; Otherwise, we're between sexps.  Take a step back before jumping
-         ;; to make sure we'll obey the same precedence no matter which
-         ;; direction we're going.
-         (funcall (if (> arg 0) 'skip-syntax-backward 'skip-syntax-forward)
-                  " .")
-         (cons (save-excursion (forward-sexp arg) (point))
-	       (progn (while (or (forward-comment (if (> arg 0) 1 -1))
-			         (not (zerop (funcall (if (> arg 0)
-							  'skip-syntax-forward
-						        'skip-syntax-backward)
-						      ".")))))
-		      (point)))))
+     (if (treesit-parser-list) #'treesit-transpose-sexps
+       (lambda (arg)
+         ;; Here we should try to simulate the behavior of
+         ;; (cons (progn (forward-sexp x) (point))
+         ;;       (progn (forward-sexp (- x)) (point)))
+         ;; Except that we don't want to rely on the second forward-sexp
+         ;; putting us back to where we want to be, since forward-sexp-function
+         ;; might do funny things like infix-precedence.
+         (if (if (> arg 0)
+	         (looking-at "\\sw\\|\\s_")
+	       (and (not (bobp))
+		    (save-excursion
+                      (forward-char -1)
+                      (looking-at "\\sw\\|\\s_"))))
+             ;; Jumping over a symbol.  We might be inside it, mind you.
+	     (progn (funcall (if (> arg 0)
+			         'skip-syntax-backward 'skip-syntax-forward)
+			     "w_")
+		    (cons (save-excursion (forward-sexp arg) (point)) (point)))
+           ;; Otherwise, we're between sexps.  Take a step back before jumping
+           ;; to make sure we'll obey the same precedence no matter which
+           ;; direction we're going.
+           (funcall (if (> arg 0) 'skip-syntax-backward 'skip-syntax-forward)
+                    " .")
+           (cons (save-excursion (forward-sexp arg) (point))
+	         (progn (while (or (forward-comment (if (> arg 0) 1 -1))
+			           (not (zerop (funcall (if (> arg 0)
+							    'skip-syntax-forward
+						          'skip-syntax-backward)
+						        ".")))))
+		        (point))))))
      arg 'special)))
 
 (defun transpose-lines (arg)
@@ -8521,6 +8524,8 @@ transpose-subr
 		       (progn (funcall mover (- x)) (point))))))
 	pos1 pos2)
     (cond
+     ((treesit-parser-list)
+      (apply #'transpose-subr-1 (funcall aux arg)))
      ((= arg 0)
       (save-excursion
 	(setq pos1 (funcall aux 1))
diff --git a/lisp/treesit.el b/lisp/treesit.el
index 0df71d12ed..69b53bde5d 100644
--- a/lisp/treesit.el
+++ b/lisp/treesit.el
@@ -1623,6 +1623,22 @@ treesit--defun-maybe-top-level
                  node)
       finally return node))))
 
+(defun treesit-transpose-sexps (&optional arg)
+  "Tree-sitter `transpose-sexps' function.
+Arg is the same as in `transpose-sexps'."
+  (interactive "*p")
+  (if-let* ((node (treesit-node-at (point)))
+            (parent (treesit-node-parent node))
+            (index (treesit-node-index node))
+            (prev (treesit-node-child parent (1- index)))
+            (next (treesit-node-child parent (+ arg index))))
+      (list (cons (treesit-node-start prev)
+                  (treesit-node-end prev))
+            (cons (treesit-node-start next)
+                  (treesit-node-end next)))
+    ;; Hack to trigger the error message in `transpose-subr-1' when we
+    ;; don't have siblings to swap.
+    (list (cons 0 1) (cons 0 1))))
 (defun treesit-beginning-of-defun (&optional arg)
   "Move backward to the beginning of a defun.
 
-- 
2.34.1