bug#60128: 30.0.50; [PATCH]: Add treesit-transpose-sexps

bug#60128: 30.0.50; [PATCH]: Add treesit-transpose-sexps

[Theodor Thornhill via Bug reports for GNU Emacs, the Swiss army knife of text editors]

[-- Attachment #1: Type: text/plain, Size: 598 bytes --]


Hi there!

Attached is a patch that enables transpose-sexps for tree-sitter enabled
modes.

This function will swap the node _before_ node-at-point with the node
_after_, so it would do something like:

       foo a|nd bar => bar and foo|

or
       foo(a + 4,| y + c * b, b, d); => foo(y + c * b, a + 4|, b, d);

It will _not_ try to swap things that are not siblings.  I think that
makes sense in the case of non-lisp languages, since _most_ places you
can transpose-sexps you will end up with broken code.

What do you think?  I think this makes sense on the master branch, not
release.

Theo


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Add-treesit-transpose-sexps.patch --]
[-- Type: text/x-diff, Size: 5865 bytes --]

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

bug#60128: 30.0.50; [PATCH]: Add treesit-transpose-sexps

[Theodor Thornhill via Bug reports for GNU Emacs, the Swiss army knife of text editors]

[-- Attachment #1: Type: text/plain, Size: 1028 bytes --]

Theodor Thornhill <theo@thornhill.no> writes:

> Hi there!
>
> Attached is a patch that enables transpose-sexps for tree-sitter enabled
> modes.
>
> This function will swap the node _before_ node-at-point with the node
> _after_, so it would do something like:
>
>        foo a|nd bar => bar and foo|
>
> or
>        foo(a + 4,| y + c * b, b, d); => foo(y + c * b, a + 4|, b, d);
>
> It will _not_ try to swap things that are not siblings.  I think that
> makes sense in the case of non-lisp languages, since _most_ places you
> can transpose-sexps you will end up with broken code.
>

from 'transpose-subr-1':

  (if (> (cdr pos1) (car pos2)) (error "Don't have two things to
  transpose"))

I added this hack into the function in the patch, but I think that
triggering an error is too much.

    ;; 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))))

I guess I could just follow suit in my function and do like in the
following patch:

Theo


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Add-treesit-transpose-sexps.patch --]
[-- Type: text/x-diff, Size: 5756 bytes --]

From e26dc6ab62ddf7b60fcbe2532acdf9f8500c904f 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 | 14 +++++++++++
 2 files changed, 50 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..1504ad3482 100644
--- a/lisp/treesit.el
+++ b/lisp/treesit.el
@@ -1623,6 +1623,20 @@ 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'."
+  (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)))
+    (user-error "Don't have two things to transpose")))
+
 (defun treesit-beginning-of-defun (&optional arg)
   "Move backward to the beginning of a defun.
 
-- 
2.34.1

bug#60128: 30.0.50; [PATCH]: Add treesit-transpose-sexps

[Theodor Thornhill via Bug reports for GNU Emacs, the Swiss army knife of text editors]

[-- Attachment #1: Type: text/plain, Size: 1810 bytes --]

Theodor Thornhill <theo@thornhill.no> writes:

> Theodor Thornhill <theo@thornhill.no> writes:
>
>> Hi there!
>>
>> Attached is a patch that enables transpose-sexps for tree-sitter enabled
>> modes.
>>
>> This function will swap the node _before_ node-at-point with the node
>> _after_, so it would do something like:
>>
>>        foo a|nd bar => bar and foo|
>>
>> or
>>        foo(a + 4,| y + c * b, b, d); => foo(y + c * b, a + 4|, b, d);
>>
>> It will _not_ try to swap things that are not siblings.  I think that
>> makes sense in the case of non-lisp languages, since _most_ places you
>> can transpose-sexps you will end up with broken code.
>>
>
> from 'transpose-subr-1':
>
>   (if (> (cdr pos1) (car pos2)) (error "Don't have two things to
>   transpose"))
>
> I added this hack into the function in the patch, but I think that
> triggering an error is too much.
>
>     ;; 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))))
>
> I guess I could just follow suit in my function and do like in the
> following patch:
>
> Theo


Considering there is both a bug-report _and_ a discussion around this I
guess the best idea is to add the patch to this bug report, and continue
discussing this in the report rather than emacs-devel?

What do you think about this patch?

(copied from emacs-devel):
It feels a little iffy how to handle the separate return values, but it
works.  I'd be super happy for some feedback on how to best solve that,
though :)

Also, I made the treesit-transpose-sexps a little better imo, in that we
only find named nodes to swap, but use every available node for the
entry. We rarely, if ever want to swap the unnamed nodes.

Eli, does this require a NEWS entry or more documentation?

Theo


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Add-treesit-transpose-sexps-bug-60128.patch --]
[-- Type: text/x-diff, Size: 8114 bytes --]

From 0dc412eaf16123dcb65381970fb82c0741809753 Mon Sep 17 00:00:00 2001
From: Theodor Thornhill <theo@thornhill.no>
Date: Sun, 25 Dec 2022 20:11:59 +0100
Subject: [PATCH] Add treesit-transpose-sexps (bug#60128)

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 (transpose-sexps-function): New defvar-local.
(transpose-sexps): Use the new defvar-local if available.
(transpose-subr): Check whether the mover function returns a cons of
conses, then run transpose-subr-1 on the position-pairs.
* lisp/treesit.el (treesit-transpose-sexps): New function.
---
 lisp/simple.el  | 97 ++++++++++++++++++++++++++++---------------------
 lisp/treesit.el | 24 +++++++++++-
 2 files changed, 78 insertions(+), 43 deletions(-)

diff --git a/lisp/simple.el b/lisp/simple.el
index 4551b749d5..591b659c62 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -8438,6 +8438,14 @@ transpose-words
   (interactive "*p")
   (transpose-subr 'forward-word arg))
 
+(defvar-local transpose-sexps-function nil
+  "If non-nil, `transpose-sexps' delegates to this function.
+
+The return value of this function is expected to be a cons of two
+conses, denoting the positions in the current buffer to be
+transposed.  If no such pair of positions is available, signal
+USER-ERROR.")
+
 (defun transpose-sexps (arg &optional interactive)
   "Like \\[transpose-chars] (`transpose-chars'), but applies to sexps.
 Unlike `transpose-words', point must be between the two sexps and not
@@ -8454,36 +8462,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 transpose-sexps-function transpose-sexps-function
+       (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)
@@ -8509,19 +8518,23 @@ transpose-lines
 ;; FIXME document SPECIAL.
 (defun transpose-subr (mover arg &optional special)
   "Subroutine to do the work of transposing objects.
-Works for lines, sentences, paragraphs, etc.  MOVER is a function that
-moves forward by units of the given object (e.g. `forward-sentence',
-`forward-paragraph').  If ARG is zero, exchanges the current object
-with the one containing mark.  If ARG is an integer, moves the
-current object past ARG following (if ARG is positive) or
-preceding (if ARG is negative) objects, leaving point after the
-current object."
-  (let ((aux (if special mover
-	       (lambda (x)
-		 (cons (progn (funcall mover x) (point))
-		       (progn (funcall mover (- x)) (point))))))
-	pos1 pos2)
+Works for lines, sentences, paragraphs, etc.  MOVER is either a
+function that moves forward by units of the given
+object (e.g. `forward-sentence', `forward-paragraph'), or a
+function that calculates a cons of two position-pairs.  If ARG is
+zero, exchanges the current object with the one containing mark.
+If ARG is an integer, moves the current object past ARG
+following (if ARG is positive) or preceding (if ARG is negative)
+objects, leaving point after the current object."
+  (let* ((aux (if special mover
+	        (lambda (x)
+		  (cons (progn (funcall mover x) (point))
+		        (progn (funcall mover (- x)) (point))))))
+	 (pos1 (save-excursion (funcall aux arg)))
+         pos2)
     (cond
+     ((and (consp (car pos1)) (consp (cdr pos1)))
+      (transpose-subr-1 (car pos1) (cdr pos1)))
      ((= arg 0)
       (save-excursion
 	(setq pos1 (funcall aux 1))
diff --git a/lisp/treesit.el b/lisp/treesit.el
index cefbed1a16..9f0965ac68 100644
--- a/lisp/treesit.el
+++ b/lisp/treesit.el
@@ -1582,6 +1582,27 @@ treesit-search-forward-goto
       (goto-char current-pos)))
     node))
 
+(defun treesit-transpose-sexps (&optional arg)
+  "Tree-sitter `transpose-sexps' function.
+Arg is the same as in `transpose-sexps'.
+
+Return a pair of positions describing the regions to transpose
+for use in `transpose-subr' and friends."
+  (let* ((parent (treesit-node-parent (treesit-node-at (point))))
+         (child (treesit-node-child parent 0 t)))
+    (named-let loop ((prev child)
+                     (next (treesit-node-child
+                            parent (+ arg (treesit-node-index child t))
+                            t)))
+      (if (< (point) (or (treesit-node-end next)
+                         (user-error "Don't have two things to transpose")))
+          (cons (cons (treesit-node-start prev)
+                      (treesit-node-end prev))
+                (cons (treesit-node-start next)
+                      (treesit-node-end next)))
+        (loop (treesit-node-next-sibling prev t)
+              (treesit-node-next-sibling next t))))))
+
 ;;; Navigation, defun, things
 ;;
 ;; Emacs lets you define "things" by a regexp that matches the type of
@@ -2111,7 +2132,8 @@ treesit-major-mode-setup
   ;; Defun name.
   (when treesit-defun-name-function
     (setq-local add-log-current-defun-function
-                #'treesit-add-log-current-defun)))
+                #'treesit-add-log-current-defun))
+  (setq-local transpose-sexps-function #'treesit-transpose-sexps))
 
 ;;; Debugging
 
-- 
2.34.1

bug#60128: 30.0.50; [PATCH]: Add treesit-transpose-sexps

[Yuan Fu]

> On Dec 26, 2022, at 12:53 PM, Theodor Thornhill <theo@thornhill.no> wrote:
> 
> Theodor Thornhill <theo@thornhill.no> writes:
> 
>> Theodor Thornhill <theo@thornhill.no> writes:
>> 
>>> Hi there!
>>> 
>>> Attached is a patch that enables transpose-sexps for tree-sitter enabled
>>> modes.
>>> 
>>> This function will swap the node _before_ node-at-point with the node
>>> _after_, so it would do something like:
>>> 
>>>       foo a|nd bar => bar and foo|
>>> 
>>> or
>>>       foo(a + 4,| y + c * b, b, d); => foo(y + c * b, a + 4|, b, d);
>>> 
>>> It will _not_ try to swap things that are not siblings.  I think that
>>> makes sense in the case of non-lisp languages, since _most_ places you
>>> can transpose-sexps you will end up with broken code.
>>> 
>> 
>> from 'transpose-subr-1':
>> 
>>  (if (> (cdr pos1) (car pos2)) (error "Don't have two things to
>>  transpose"))
>> 
>> I added this hack into the function in the patch, but I think that
>> triggering an error is too much.
>> 
>>    ;; 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))))
>> 
>> I guess I could just follow suit in my function and do like in the
>> following patch:
>> 
>> Theo
> 
> 
> Considering there is both a bug-report _and_ a discussion around this I
> guess the best idea is to add the patch to this bug report, and continue
> discussing this in the report rather than emacs-devel?
> 
> What do you think about this patch?
> 
> (copied from emacs-devel):
> It feels a little iffy how to handle the separate return values, but it
> works.  I'd be super happy for some feedback on how to best solve that,
> though :)

By separate return values, do you mean the function returns a cons of cons? It seems fine to me. Though I think the docstring could be more specific. Like saying return a cons (REGION . REGION), where REGION is (BEG . END), where BEG and END...

> 
> Also, I made the treesit-transpose-sexps a little better imo, in that we
> only find named nodes to swap, but use every available node for the
> entry. We rarely, if ever want to swap the unnamed nodes.
> 
> Eli, does this require a NEWS entry or more documentation?

IMHO a backend/helper function shouldn’t signal a user-error, it’s better to return nil and let the command to signal errors.

Yuan

bug#60128: 30.0.50; [PATCH]: Add treesit-transpose-sexps

[Theodor Thornhill via Bug reports for GNU Emacs, the Swiss army knife of text editors]

[-- Attachment #1: Type: text/plain, Size: 3083 bytes --]

Yuan Fu <casouri@gmail.com> writes:

>> On Dec 26, 2022, at 12:53 PM, Theodor Thornhill <theo@thornhill.no> wrote:
>> 
>> Theodor Thornhill <theo@thornhill.no> writes:
>> 
>>> Theodor Thornhill <theo@thornhill.no> writes:
>>> 
>>>> Hi there!
>>>> 
>>>> Attached is a patch that enables transpose-sexps for tree-sitter enabled
>>>> modes.
>>>> 
>>>> This function will swap the node _before_ node-at-point with the node
>>>> _after_, so it would do something like:
>>>> 
>>>>       foo a|nd bar => bar and foo|
>>>> 
>>>> or
>>>>       foo(a + 4,| y + c * b, b, d); => foo(y + c * b, a + 4|, b, d);
>>>> 
>>>> It will _not_ try to swap things that are not siblings.  I think that
>>>> makes sense in the case of non-lisp languages, since _most_ places you
>>>> can transpose-sexps you will end up with broken code.
>>>> 
>>> 
>>> from 'transpose-subr-1':
>>> 
>>>  (if (> (cdr pos1) (car pos2)) (error "Don't have two things to
>>>  transpose"))
>>> 
>>> I added this hack into the function in the patch, but I think that
>>> triggering an error is too much.
>>> 
>>>    ;; 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))))
>>> 
>>> I guess I could just follow suit in my function and do like in the
>>> following patch:
>>> 
>>> Theo
>> 
>> 
>> Considering there is both a bug-report _and_ a discussion around this I
>> guess the best idea is to add the patch to this bug report, and continue
>> discussing this in the report rather than emacs-devel?
>> 
>> What do you think about this patch?
>> 
>> (copied from emacs-devel):
>> It feels a little iffy how to handle the separate return values, but it
>> works.  I'd be super happy for some feedback on how to best solve that,
>> though :)
>
> By separate return values, do you mean the function returns a cons of
> cons? It seems fine to me. Though I think the docstring could be more
> specific. Like saying return a cons (REGION . REGION), where REGION is
> (BEG . END), where BEG and END...
>

I updated the patch adressing your comment.  The current "protocol" used
on the master branch implies that the regions are calculated by actually
moving inside the buffer and running (point).  Because we don't need
that with the ast in hand I'm trying to support a new protocol, where we
just supply the data we need.  It's a little difficult to "surgically"
modify the behavior, so I'm very open to suggestions, but I believe it
should work properly as the patch stands.

>> 
>> Also, I made the treesit-transpose-sexps a little better imo, in that we
>> only find named nodes to swap, but use every available node for the
>> entry. We rarely, if ever want to swap the unnamed nodes.
>> 
>> Eli, does this require a NEWS entry or more documentation?
>
> IMHO a backend/helper function shouldn’t signal a user-error, it’s
> better to return nil and let the command to signal errors.

Yeah, I agree.  Adjusted the patch.  Let me know what you think!

Theo


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Add-treesit-transpose-sexps-bug-60128.patch --]
[-- Type: text/x-diff, Size: 8824 bytes --]

From 74a7980758b929c991e317ea281b7cd4a097fdff Mon Sep 17 00:00:00 2001
From: Theodor Thornhill <theo@thornhill.no>
Date: Sun, 25 Dec 2022 20:11:59 +0100
Subject: [PATCH] Add treesit-transpose-sexps (bug#60128)

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 (transpose-sexps-function): New defvar-local.
(transpose-sexps): Use the new defvar-local if available.
(transpose-subr): Check whether the mover function returns a cons of
conses, then run transpose-subr-1 on the position-pairs.
* lisp/treesit.el (treesit-transpose-sexps): New function.
---
 lisp/simple.el  | 106 +++++++++++++++++++++++++++++-------------------
 lisp/treesit.el |  28 ++++++++++++-
 2 files changed, 91 insertions(+), 43 deletions(-)

diff --git a/lisp/simple.el b/lisp/simple.el
index 4551b749d5..99dbfaea9f 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -8438,6 +8438,21 @@ transpose-words
   (interactive "*p")
   (transpose-subr 'forward-word arg))
 
+(defvar-local transpose-sexps-function nil
+  "If non-nil, `transpose-sexps' delegates to this function.
+
+This function takes one argument ARG, a number as provided
+through running `transpose-sexps'.  It supports the following two
+return values:
+
+1. A cons (REGION . REGION), where REGION is (BEG . END) and BEG
+and END are buffer positions.
+
+2. A cons (BEG . END), where BEG and END are buffer positions.
+
+If the second return value is chosen for this function, it is
+expected to behave similarly to `forward-sexp' and friends.")
+
 (defun transpose-sexps (arg &optional interactive)
   "Like \\[transpose-chars] (`transpose-chars'), but applies to sexps.
 Unlike `transpose-words', point must be between the two sexps and not
@@ -8454,36 +8469,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 transpose-sexps-function transpose-sexps-function
+       (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)
@@ -8509,19 +8525,23 @@ transpose-lines
 ;; FIXME document SPECIAL.
 (defun transpose-subr (mover arg &optional special)
   "Subroutine to do the work of transposing objects.
-Works for lines, sentences, paragraphs, etc.  MOVER is a function that
-moves forward by units of the given object (e.g. `forward-sentence',
-`forward-paragraph').  If ARG is zero, exchanges the current object
-with the one containing mark.  If ARG is an integer, moves the
-current object past ARG following (if ARG is positive) or
-preceding (if ARG is negative) objects, leaving point after the
-current object."
-  (let ((aux (if special mover
-	       (lambda (x)
-		 (cons (progn (funcall mover x) (point))
-		       (progn (funcall mover (- x)) (point))))))
-	pos1 pos2)
+Works for lines, sentences, paragraphs, etc.  MOVER is either a
+function that moves forward by units of the given
+object (e.g. `forward-sentence', `forward-paragraph'), or a
+function that calculates a cons of two position-pairs.  If ARG is
+zero, exchanges the current object with the one containing mark.
+If ARG is an integer, moves the current object past ARG
+following (if ARG is positive) or preceding (if ARG is negative)
+objects, leaving point after the current object."
+  (let* ((aux (if special mover
+	        (lambda (x)
+		  (cons (progn (funcall mover x) (point))
+		        (progn (funcall mover (- x)) (point))))))
+	 (pos1 (save-excursion (funcall aux arg)))
+         pos2)
     (cond
+     ((and (consp (car pos1)) (consp (cdr pos1)))
+      (transpose-subr-1 (car pos1) (cdr pos1)))
      ((= arg 0)
       (save-excursion
 	(setq pos1 (funcall aux 1))
@@ -8542,6 +8562,8 @@ transpose-subr
       (goto-char (+ (car pos2) (- (cdr pos1) (car pos1))))))))
 
 (defun transpose-subr-1 (pos1 pos2)
+  (unless (and pos1 pos2)
+    (error "Don't have two things to transpose"))
   (when (> (car pos1) (cdr pos1)) (setq pos1 (cons (cdr pos1) (car pos1))))
   (when (> (car pos2) (cdr pos2)) (setq pos2 (cons (cdr pos2) (car pos2))))
   (when (> (car pos1) (car pos2))
diff --git a/lisp/treesit.el b/lisp/treesit.el
index cefbed1a16..2bd7f71f2f 100644
--- a/lisp/treesit.el
+++ b/lisp/treesit.el
@@ -1582,6 +1582,31 @@ treesit-search-forward-goto
       (goto-char current-pos)))
     node))
 
+(defun treesit-transpose-sexps (&optional arg)
+  "Tree-sitter `transpose-sexps' function.
+Arg is the same as in `transpose-sexps'.
+
+Locate the node closest to POINT, and transpose that node with
+its sibling node ARG nodes away.
+
+Return a pair of positions as described by
+`transpose-sexps-function' for use in `transpose-subr' and
+friends."
+  (let* ((parent (treesit-node-parent (treesit-node-at (point))))
+         (child (treesit-node-child parent 0 t)))
+    (named-let loop ((prev child)
+                     (next (treesit-node-child
+                            parent (+ arg (treesit-node-index child t))
+                            t)))
+      (when (and prev next)
+        (if (< (point) (treesit-node-end next))
+            (cons (cons (treesit-node-start prev)
+                        (treesit-node-end prev))
+                  (cons (treesit-node-start next)
+                        (treesit-node-end next)))
+          (loop (treesit-node-next-sibling prev t)
+                (treesit-node-next-sibling next t)))))))
+
 ;;; Navigation, defun, things
 ;;
 ;; Emacs lets you define "things" by a regexp that matches the type of
@@ -2111,7 +2136,8 @@ treesit-major-mode-setup
   ;; Defun name.
   (when treesit-defun-name-function
     (setq-local add-log-current-defun-function
-                #'treesit-add-log-current-defun)))
+                #'treesit-add-log-current-defun))
+  (setq-local transpose-sexps-function #'treesit-transpose-sexps))
 
 ;;; Debugging
 
-- 
2.34.1

bug#60128: 30.0.50; [PATCH]: Add treesit-transpose-sexps

[Eli Zaretskii]

> From: Theodor Thornhill <theo@thornhill.no>
> Cc: casouri@gmail.com,  Stefan Monnier <monnier@iro.umontreal.ca>, eliz@gnu.org
> Date: Mon, 26 Dec 2022 21:53:57 +0100
> 
> Eli, does this require a NEWS entry or more documentation?

A NEWS entry should be enough.

bug#60128: 30.0.50; [PATCH]: Add treesit-transpose-sexps

[Yuan Fu]

Eli Zaretskii <eliz@gnu.org> writes:

>> From: Theodor Thornhill <theo@thornhill.no>
>> Cc: casouri@gmail.com,  Stefan Monnier <monnier@iro.umontreal.ca>, eliz@gnu.org
>> Date: Mon, 26 Dec 2022 21:53:57 +0100
>> 
>> Eli, does this require a NEWS entry or more documentation?
>
> A NEWS entry should be enough.

IIRC this is pushed to master right? If so I’ll close this.

Yuan

bug#60128: 30.0.50; [PATCH]: Add treesit-transpose-sexps

[Eli Zaretskii]

> From: Yuan Fu <casouri@gmail.com>
> Date: Sat, 7 Jan 2023 15:18:17 -0800
> Cc: Theodor Thornhill <theo@thornhill.no>,
>  60128@debbugs.gnu.org,
>  monnier@iro.umontreal.ca
> 
> 
> Eli Zaretskii <eliz@gnu.org> writes:
> 
> >> From: Theodor Thornhill <theo@thornhill.no>
> >> Cc: casouri@gmail.com,  Stefan Monnier <monnier@iro.umontreal.ca>, eliz@gnu.org
> >> Date: Mon, 26 Dec 2022 21:53:57 +0100
> >> 
> >> Eli, does this require a NEWS entry or more documentation?
> >
> > A NEWS entry should be enough.
> 
> IIRC this is pushed to master right?

I don't see it there, no.

I asked to add a NEWS entry, and then it can be installed on master.

Theo?

bug#60128: 30.0.50; [PATCH]: Add treesit-transpose-sexps

[Theodor Thornhill via Bug reports for GNU Emacs, the Swiss army knife of text editors]

Eli Zaretskii <eliz@gnu.org> writes:

>> From: Yuan Fu <casouri@gmail.com>
>> Date: Sat, 7 Jan 2023 15:18:17 -0800
>> Cc: Theodor Thornhill <theo@thornhill.no>,
>>  60128@debbugs.gnu.org,
>>  monnier@iro.umontreal.ca
>> 
>> 
>> Eli Zaretskii <eliz@gnu.org> writes:
>> 
>> >> From: Theodor Thornhill <theo@thornhill.no>
>> >> Cc: casouri@gmail.com,  Stefan Monnier <monnier@iro.umontreal.ca>, eliz@gnu.org
>> >> Date: Mon, 26 Dec 2022 21:53:57 +0100
>> >> 
>> >> Eli, does this require a NEWS entry or more documentation?
>> >
>> > A NEWS entry should be enough.
>> 
>> IIRC this is pushed to master right?
>
> I don't see it there, no.
>
> I asked to add a NEWS entry, and then it can be installed on master.
>
> Theo?

Yeah, it was added in 7e98b8a0fa67f51784024fac3199d774dfa77192 and
commited by Stefan :-)

Should I add anything else?

Theo

bug#60128: 30.0.50; [PATCH]: Add treesit-transpose-sexps

[Stefan Kangas]

Theodor Thornhill <theo@thornhill.no> writes:

> Eli Zaretskii <eliz@gnu.org> writes:
>
>>> From: Yuan Fu <casouri@gmail.com>
>>> Date: Sat, 7 Jan 2023 15:18:17 -0800
>>> Cc: Theodor Thornhill <theo@thornhill.no>,
>>>  60128@debbugs.gnu.org,
>>>  monnier@iro.umontreal.ca
>>>
>>>
>>> Eli Zaretskii <eliz@gnu.org> writes:
>>>
>>> >> From: Theodor Thornhill <theo@thornhill.no>
>>> >> Cc: casouri@gmail.com,  Stefan Monnier <monnier@iro.umontreal.ca>, eliz@gnu.org
>>> >> Date: Mon, 26 Dec 2022 21:53:57 +0100
>>> >>
>>> >> Eli, does this require a NEWS entry or more documentation?
>>> >
>>> > A NEWS entry should be enough.
>>>
>>> IIRC this is pushed to master right?
>>
>> I don't see it there, no.
>>
>> I asked to add a NEWS entry, and then it can be installed on master.
>>
>> Theo?
>
> Yeah, it was added in 7e98b8a0fa67f51784024fac3199d774dfa77192 and
> commited by Stefan :-)
>
> Should I add anything else?
>
> Theo

It seems like this bug is done, as the patch was committed.  Closing.