>From 805199c03d6cfee4bec828295a6105d51b96867f Mon Sep 17 00:00:00 2001 From: Theodor Thornhill 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. --- etc/NEWS | 9 ++++++ lisp/simple.el | 73 +++++++++++++++++++++++++++---------------------- lisp/treesit.el | 29 +++++++++++++++++++- 3 files changed, 78 insertions(+), 33 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index d17e1f1f89..5997d7a19c 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -44,6 +44,15 @@ example, as part of preview for iconified frames. * Editing Changes in Emacs 30.1 +** New helper 'transpose-sexps-function' +Emacs now can set this defvar buffer-locally to customize the behavior +of the 'transpose-sexps' function. + +** New function 'treesit-trnspose-sexps' +treesit.el now unconditionally sets 'transpose-sexps-function' for all +Tree-sitter modes. This functionality utilizes the new +'transpose-sexps-function'. + * Changes in Specialized Modes and Packages in Emacs 30.1 --- diff --git a/lisp/simple.el b/lisp/simple.el index 4551b749d5..03d3fda451 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -8438,6 +8438,44 @@ transpose-words (interactive "*p") (transpose-subr 'forward-word arg)) +(defvar-local 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))))) + "If non-nil, `transpose-sexps' delegates to this function. + +This function takes one argument ARG, a number as provided +through running `transpose-sexps'. Its expected return value is +a position pair, which is a cons (BEG . END), where BEG and END +are buffer positions.") + (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 @@ -8453,38 +8491,7 @@ transpose-sexps (condition-case nil (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))))) - arg 'special))) + (transpose-subr transpose-sexps-function arg 'special))) (defun transpose-lines (arg) "Exchange current line and previous line, leaving point after both. @@ -8542,6 +8549,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..203a724fe7 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -1582,6 +1582,32 @@ 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-next-sibling child t))) + (when (and prev next) + (if (< (point) (treesit-node-end next)) + (if (= arg -1) + (cons (treesit-node-start prev) + (treesit-node-end prev)) + (when-let ((n (treesit-node-child + parent (+ arg (treesit-node-index prev t)) t))) + (cons (treesit-node-end n) + (treesit-node-start n)))) + (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 +2137,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