From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Theodor Thornhill via "Emacs development discussions." Newsgroups: gmane.emacs.devel Subject: Re: Plug treesit.el into other emacs constructs Date: Wed, 28 Dec 2022 10:26:48 +0100 Message-ID: <87tu1fx4iv.fsf@thornhill.no> References: <87wn6whete.fsf@thornhill.no> <4315EFC6-7AA8-4A48-845C-9CA8B88034D9@thornhill.no> <87bko521n0.fsf@thornhill.no> <87359h1ybt.fsf@thornhill.no> <871qp01msi.fsf@thornhill.no> <87v8mczb6b.fsf@thornhill.no> <87sfhgz9s8.fsf@thornhill.no> <87pmckz8p0.fsf@thornhill.no> <5DF07C4E-2CCD-4561-AFFB-D5D81D67BFE0@thornhill.no> <87o7rq7zf2.fsf@thornhill.no> <87wn6cwl1d.fsf@thornhill.no> Reply-To: Theodor Thornhill Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="39136"; mail-complaints-to="usenet@ciao.gmane.io" Cc: Yuan Fu , emacs-devel@gnu.org, eliz@gnu.org To: Stefan Monnier Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Wed Dec 28 10:27:33 2022 Return-path: Envelope-to: ged-emacs-devel@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1pASih-0009ws-Hn for ged-emacs-devel@m.gmane-mx.org; Wed, 28 Dec 2022 10:27:31 +0100 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1pASi9-0001if-Kp; Wed, 28 Dec 2022 04:26:57 -0500 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pASi7-0001iS-Jy for emacs-devel@gnu.org; Wed, 28 Dec 2022 04:26:55 -0500 Original-Received: from out-87.mta0.migadu.com ([2001:41d0:1004:224b::57]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pASi5-0003TY-96 for emacs-devel@gnu.org; Wed, 28 Dec 2022 04:26:55 -0500 X-Report-Abuse: Please report any abuse attempt to abuse@migadu.com and include these headers. DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=thornhill.no; s=key1; t=1672219610; h=from:from:reply-to:subject:subject:date:date:message-id:message-id: to:to:cc:cc:mime-version:mime-version:content-type:content-type: in-reply-to:in-reply-to:references:references; bh=4UJzJSThxGlfS/TePfoNKz0n1aRS0no0MvqNE4rdA2Q=; b=JeSDZyBEZI2ZX7rTSNXHOLhRGMrBMdvItD14vwK4tTFaIiVNj0lSDom/MFsm2QNByCikgJ xKVOkKsIgnLLkfMI1Eyf286EvKWQXzIDzh1Q+sqwbtuS65cwm+bA88xiu7IltkoI5KPh1e +VaSWSCBIwPnXPXbmBJOUnUyAkwUkWzE4Q4lH5NbNTE/puplmhS1zk+rUhlcHV80xEOHyO rLak7WhQOMoCloMRvDzzRqDTDW+6nup8jxOBsKaYE6Ii/kmBemk+7IChnnWX/fzaqAUtCX 5Ci1h1jMppVJjgr3Y3v5apWKwHFAC5Mbv2a3XuTzNvr7hdtjIjy2Grg409L6LA== In-Reply-To: X-Migadu-Flow: FLOW_OUT Received-SPF: pass client-ip=2001:41d0:1004:224b::57; envelope-from=theo@thornhill.no; helo=out-87.mta0.migadu.com X-Spam_score_int: -16 X-Spam_score: -1.7 X-Spam_bar: - X-Spam_report: (-1.7 / 5.0 requ) BAYES_00=-1.9, DKIM_INVALID=0.1, DKIM_SIGNED=0.1, SPF_HELO_NONE=0.001, SPF_PASS=-0.001 autolearn=no autolearn_force=no X-Spam_action: no action X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.emacs.devel:301998 Archived-At: --=-=-= Content-Type: text/plain Stefan Monnier writes: >> I think I managed to keep the semantics as they are now. What do you >> think? Does this seem like a sane approach? > > Yes, LGTM. See nitpicks below. > >> +** New function 'treesit-trnspose-sexps' > ^^ > a > >> +(defvar-local transpose-sexps-function > > I'd keep it a plain `defvar`. > >> + "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.") > > The ARG is not quite the same as the one passed to `transpose-sexps`. > I think we should say something like ".. ARG, a number. Its expected > return value is a pair of positions (BEG . END) delimiting the ARGth > sibling". > > The rest looks great, thanks. > > Something like this? If you're ok with this, maybe you can install for me, as I can't? Then I can close the relevant bugreport. Oh, and one more thing. There is a bug in in 'transpose-subr' in the case where (> arg 0). Transpose-subr-1 makes an effort to swap the conses around so that we have ranges that makes sense. However, the case in question then unconditionally jumps to (car pos2), which would be the wrong position. Either we need to change that, or add something like this to the docstring for the MOVER function: ``` The MOVER function is expected to return its conses in different orders. if `forward-word' is used for the mover function the conses will be like this, where the number is the order the position is calculated ('|' is where point is initially): first| second ^ ^ ^ ^ (2 . 1) (4 . 3) ``` What do you think? I'll open a bug report for it if the docstring isn't enough. Theo --=-=-= Content-Type: text/x-diff Content-Disposition: attachment; filename=0001-Add-treesit-transpose-sexps-bug-60128.patch >From c773c854c1648786cc26cd2ade734ebce016d66a 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 | 88 +++++++++++++++++++++++++++---------------------- lisp/treesit.el | 29 +++++++++++++++- 3 files changed, 86 insertions(+), 40 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index d17e1f1f89..83aa81eb4b 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 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 --- diff --git a/lisp/simple.el b/lisp/simple.el index 4551b749d5..cf0845853a 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -8438,6 +8438,43 @@ transpose-words (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 @@ 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. @@ -8509,13 +8515,15 @@ 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." +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 @@ 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 --=-=-=--