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.
This commit is contained in:
Theodor Thornhill
Stefan Monnier
parent
7dc24fb611
commit
7e98b8a0fa
3 changed files with 86 additions and 40 deletions
9
etc/NEWS
9
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 to customize the behavior of the
|
||||
'transpose-sexps' function.
|
||||
|
||||
** New function 'treesit-transpose-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
|
||||
---
|
||||
|
|
|
|||
|
|
@ -8438,6 +8438,43 @@ are interchanged."
|
|||
(interactive "*p")
|
||||
(transpose-subr 'forward-word arg))
|
||||
|
||||
(defvar 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. 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 +8490,7 @@ report errors as appropriate for this kind of usage."
|
|||
(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.
|
||||
|
|
@ -8509,13 +8515,15 @@ With argument 0, interchanges line point is in with line mark is in."
|
|||
;; 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."
|
||||
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'), or a
|
||||
function calculating a cons of buffer positions.
|
||||
|
||||
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))
|
||||
|
|
@ -8542,6 +8550,8 @@ current object."
|
|||
(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))
|
||||
|
|
|
|||
|
|
@ -1582,6 +1582,32 @@ BACKWARD and ALL are the same as in `treesit-search-forward'."
|
|||
(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 @@ before calling this function."
|
|||
;; 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
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue