Re: [PATCH] org-babel-demarcate-block: split using element API

[gerard.vermeulen@posteo.net]

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


On 08.01.2024 13:08, Ihor Radchenko wrote:
> gerard.vermeulen@posteo.net writes:
> 
Attached you'll find a new version of my patch addressing all your 
issues.
This mail ends with two other ideas in the context of this patch.
[...]
> I've tested your patch and found two problems:
> 
> 1. #+name: lines are duplicated, while they should not

Of course. Sometimes I delete lines by a slip of the fingers. Thanks.

> 2. Your patch does not create space between the src blocks, unlike what
>    we have on main.
>    I think that you need to (1) create a single blank lines between
>    blocks (set :post-blank property to 1); (2) keep the number blank
>    lines after the last block the same as in the initial block (copy 
> the
>    :post-blank property and assign it to the last inserted src block).
> 
>    For C-u argument, do not do anything special - just keep the 
> original
>    :post-blank as is. It is the closest to what we have on main.
> 

The previous version of the patch had
+            (insert (if arg (concat stars "\n") ""))
and now it has
+            (insert (if arg (concat stars "\n") "\n"))
I prefer this over setting the :post-blank property because it is 
simpler.
(main concats something like .... (if (arg stars "") "\n" ...).

[...]
> 
>> Agreed, this is wrong. A partial explanation is that I attached too
>> much value to the doc-string of `org-babel-get-src-block-info'
>> telling "Return nil if point is not on a source block.  Otherwise,"
>> which
>> is for me in contradiction with documentation (string and start
>> comment) in `org-babel-demarcate-block'.
> 
> `org-babel-get-src-block-info' docstring were not wrong. You just 
> missed
> the Org mode's convention that blank lines after src blocks or other
> syntax elements belong to these elements.
> 
> That said, we may clarify the `org-babel-get-src-block-info' docstring
> to highlight this fact and avoid future confusion.
> 
I changed the docstring as you suggested below.
> 
>> Now demarcating with point below a source block works again and
>> checking this is part of the ERT test.
> 
> The ERT test does not check removing #+caption from the original block.
> Also, as I said above, we should remove #+name.
> 
The ERT test now checks that #+caption and #+name are removed from
the original code.
> 
[...]
> 
> Note that indentation of src blocks has been refactored recently on
> main. It should be more reliable now. If not, please report any issues.
> 
I will pay attention.
> 
>> -;; Copyright (C) 2009-2024 Free Software Foundation, Inc.
>> +;; Copyright (C) 2009-2023 Free Software Foundation, Inc.
> 
> This is a spurious change :)
> 
Reverted: it shows that I started editing in 2023 and that I am no good 
at git :)
> 
>> -Return nil if point is not on a source block.  Otherwise, return
>> -a list with the following pattern:
>> +Return nil if point is not on a source block or not within blank
>> +lines after a source block.  Otherwise, return a list with the
>> +following pattern:
> 
> I'd rather say: Return nil if point is not on a source block (blank
> lines after a source block are considered a part of that source block).
> 
> It would be more accurate.
> 
Done.
> 
>> +        (let* ((copy (org-element-copy (org-element-at-point)))
>> +               (before (org-element-begin copy))
>> +               (beyond (org-element-end copy))
>> +               (parts (sort (if (org-region-active-p)
>> +                                (list body-beg (mark) (point) 
>> body-end)
>> +                              (list body-beg (point) body-end))
>> +                            #'<)))
>> +          ;; Prevent #+caption:, #+header:, and #+begin_src lines in 
>> block.
> 
> This comment is out of place. Also, we do preserve #+header and
> #+begin_src lines, don't we?
> 
Maybe I should have written:
+          ;; Prevent #+caption:, #+header:, and #+begin_src lines in 
*body*.

It prevents that when splitting with point at the # of #+caption a block 
like

#+caption: caption
#+name: name
#+begin_src emacs-lisp
;; elisp code
...
#+end_src

the first block ends up with

#+caption: caption
#+name: name
#+begin_src emacs-lisp
,#+caption: caption
,#+name: name
,#+begin_src emacs-lisp
;; elisp code
...
#+end_src

This is not easy to capture in a 1-2 line comment.

Anyhow, I have removed the comment and I have replaced check below it 
with
+          (set-mark (point)) ;; To simplify the next (unless ...):
+          (unless (and (>= (point) body-beg) (<= (mark) body-end))
+            (user-error "Select within the source block body to split 
it"))
which also protects against having point in body and mark on or below 
#+end_src

I think it covers everything that can be checked in the "splitting" 
branch.

I think also that the "wrapping" branch can be better protected against 
similar
region selection "user errors".  I will come back on improving the 
"wrapping"
branch shortly.
> 
> And we need to remove #+name lines.
> 
Done.
> 
>> +          (unless (and (>= (point) body-beg))
>> +            (user-error "move point within the source block body to 
>> split it"))
> 
> Please start error message from capital letter. It is Elisp convention
> (see `user-error' docstring).
> 
Thanks, done, see above.
> 
>> +          (setq parts (mapcar (lambda (p) (buffer-substring (car p) 
>> (cdr p)))
>> +                              (seq-mapn #'cons parts (cdr parts))))
>> +          (delete-region before beyond)
>> +          (deactivate-mark)
> 
> AFAIK, `deactivate-mark' should be unnecessary here. To indicate that
> region should be deactivated after finishing a command, we simply set
> `deactivate-mark' _variable_ to t. See the docstring.

Done

I have two other ideas in the context of this patch:

* Improving the "wrapping" branch

1. It must be easy (possible for me) to get the org-element-copy of the
    preceding code block and use it to insert a new block with the same
    headers and switches as the preceding block.
2. In that case it is easy to raise a user-error when mark is before
    body_end of the preceding block.

I think that with this improvement the user interface of the "wrapping"
branch is closer to that of the "splitting" branch.

That leaves only the "wrapping" branch open for "user errors" in case
info is nil (no preceding code block).

What do you think?

* Adding a user option for properties to set to nil in org-element-copy.

This may be overkill, but something like:

#+begin_src emacs-lisp :results nil :tangle no
(defcustom org-babel-demarcate-block-delete '(:caption :name)
   "List of things to delete from blocks below the upper block when
splitting blocks by demarcation.  Possible things are `:caption' to
delete \"#+CAPTION:\" keywords, `:header' to delete \"#+HEADER:\"
keywords, `:name' to delete \"#+NAME:\" keywords, and `switches'
to delete e.g. \"-i +n 10\" from the \"#+BEGIN_SRC\" line."
   :group 'org-babel
   :package-version '(Org . "9.7")
   :type '(set :tag "Things to delete when splitting blocks by 
demarcation"
               (const :caption)
               (const :header)
               (const :name)
               (const :switches))
   :initialize #'custom-initialize-default
   :set (lambda (sym val)
          (set-default sym val)))
#+end_src

and changing 3 lines in my version of `org-babel-demarcate-block'
allows a user to get close to the behavior of main if he does:
(setopt org-babel-demarcate-block-delete
         '(:caption :header :name :switches)

I think that it is more important to improve the "wrapping" branch
than to add the user option.

Regards -- Gerard

[-- Attachment #2: 0001-org-babel-demarcate-block-split-using-element-API.patch --]
[-- Type: application/octet-stream, Size: 14326 bytes --]

From fcf5833774a192473106d19825a2733954c7832d Mon Sep 17 00:00:00 2001
From: Gerard Vermeulen <gerard.vermeulen@posteo.net>
Date: Sun, 7 Jan 2024 09:18:36 +0100
Subject: [PATCH] org-babel-demarcate-block: split using element API

* lisp/ob-babel.el (org-babel-demarcate-block): Modify a copy
of (org-element-at-point) to replace the old source block with 2 or 3
new modified copies by means of `org-element-interpret-data'.  The 1st
source block contains the text from the body of the old block before
point or region, the 2nd block contains the body text after point or
body text within region, and in case of region, the 3rd block contains
the text after region.  The caption and the name are deleted from the
1 or 2 blocks below the upper source block.  Indent all blocks
immediately after insertion.  Trying to split when point is above the
body of the old source block raises an user-error.
* lisp/ob-babel (org-get-src-block-info): add the "within blank lines
after a source block" condition to the doc-string to match it with the
doc-string of and a comment in `org-babel-demarcate-block'.
* testing/lisp/test-ob.el (test-ob/demarcate-block): New test.  It
checks test cases that broke earlier versions of this patch.
---
 lisp/ob-core.el         |  61 ++++++++-------
 testing/lisp/test-ob.el | 168 ++++++++++++++++++++++++++++++++++++++++
 2 files changed, 201 insertions(+), 28 deletions(-)

diff --git a/lisp/ob-core.el b/lisp/ob-core.el
index 1de3af6ad..d01620243 100644
--- a/lisp/ob-core.el
+++ b/lisp/ob-core.el
@@ -73,6 +73,7 @@
 (declare-function org-element-parent "org-element-ast" (node))
 (declare-function org-element-type "org-element-ast" (node &optional anonymous))
 (declare-function org-element-type-p "org-element-ast" (node &optional types))
+(declare-function org-element-interpret-data "org-element" (data))
 (declare-function org-entry-get "org" (pom property &optional inherit literal-nil))
 (declare-function org-escape-code-in-region "org-src" (beg end))
 (declare-function org-forward-heading-same-level "org" (arg &optional invisible-ok))
@@ -700,8 +701,9 @@ By default, consider the block at point.  However, when optional
 argument DATUM is provided, extract information from that parsed
 object instead.
 
-Return nil if point is not on a source block.  Otherwise, return
-a list with the following pattern:
+Return nil if point is not on a source block (blank lines after a
+source block are considered a part of that source block).
+Otherwise, return a list with the following pattern:
 
   (language body arguments switches name start coderef)"
   (let* ((datum (or datum (org-element-context)))
@@ -2051,7 +2053,7 @@ With optional prefix argument ARG, jump backward ARG many source blocks."
       (goto-char (match-beginning 5)))))
 
 (defun org-babel-demarcate-block (&optional arg)
-  "Wrap or split the code in the region or on the point.
+  "Wrap or split the code in an active region or at point.
 
 With prefix argument ARG, also create a new heading at point.
 
@@ -2061,41 +2063,44 @@ is created.  In both cases if the region is demarcated and if the
 region is not active then the point is demarcated.
 
 When called within blank lines after a code block, create a new code
-block of the same language with the previous."
+block of the same language as the previous."
   (interactive "P")
   (let* ((info (org-babel-get-src-block-info 'no-eval))
 	 (start (org-babel-where-is-src-block-head))
          ;; `start' will be nil when within space lines after src block.
 	 (block (and start (match-string 0)))
-	 (headers (and start (match-string 4)))
+         (body-beg (and start (match-beginning 5)))
+         (body-end (and start (match-end 5)))
 	 (stars (concat (make-string (or (org-current-level) 1) ?*) " "))
 	 (upper-case-p (and block
 			    (let (case-fold-search)
 			      (string-match-p "#\\+BEGIN_SRC" block)))))
     (if (and info start) ;; At src block, but not within blank lines after it.
-        (mapc
-         (lambda (place)
-           (save-excursion
-             (goto-char place)
-             (let ((lang (nth 0 info))
-                   (indent (make-string (org-current-text-indentation) ?\s)))
-	       (when (string-match "^[[:space:]]*$"
-                                   (buffer-substring (line-beginning-position)
-                                                     (line-end-position)))
-                 (delete-region (line-beginning-position) (line-end-position)))
-               (insert (concat
-		        (if (looking-at "^") "" "\n")
-		        indent (if upper-case-p "#+END_SRC\n" "#+end_src\n")
-		        (if arg stars indent) "\n"
-		        indent (if upper-case-p "#+BEGIN_SRC " "#+begin_src ")
-		        lang
-		        (if (> (length headers) 1)
-			    (concat " " headers) headers)
-		        (if (looking-at "[\n\r]")
-			    ""
-			  (concat "\n" (make-string (current-column) ? )))))))
-	   (move-end-of-line 2))
-         (sort (if (org-region-active-p) (list (mark) (point)) (list (point))) #'>))
+        (let* ((copy (org-element-copy (org-element-at-point)))
+               (before (org-element-begin copy))
+               (beyond (org-element-end copy))
+               (parts (sort (if (org-region-active-p)
+                                (list body-beg (mark) (point) body-end)
+                              (list body-beg (point) body-end))
+                            #'<)))
+          (set-mark (point)) ;; To simplify the next (unless ...):
+          (unless (and (>= (point) body-beg) (<= (mark) body-end))
+            (user-error "Select within the source block body to split it"))
+          (setq parts (mapcar (lambda (p) (buffer-substring (car p) (cdr p)))
+                              (seq-mapn #'cons parts (cdr parts))))
+          (delete-region before beyond)
+          ;; Insert the 1st block.
+          (org-element-put-property copy :value (car parts))
+          (insert (org-element-interpret-data copy))
+          (org-indent-block)
+          (org-element-put-property copy :caption nil)
+          (org-element-put-property copy :name nil)
+          ;; Insert the 2nd block, and the 3rd block if there was an active region.
+          (dolist (part (cdr parts))
+            (org-element-put-property copy :value part)
+            (insert (if arg (concat stars "\n") "\n"))
+            (insert (org-element-interpret-data copy))
+            (org-indent-block)))
       (let ((start (point))
 	    (lang (or (car info) ; Reuse language from previous block.
                       (completing-read
diff --git a/testing/lisp/test-ob.el b/testing/lisp/test-ob.el
index 42c77ca56..ccdb9bf7a 100644
--- a/testing/lisp/test-ob.el
+++ b/testing/lisp/test-ob.el
@@ -26,6 +26,174 @@
 (require 'org-table)
 (eval-and-compile (require 'cl-lib))
 
+(ert-deftest test-ob/demarcate-block ()
+  "Test splitting and wrapping by demarcation."
+  ;; Test splitting with duplication of language, body, switches, and headers.
+  (let ((caption "#+caption: caption.")
+        (regexp (rx "#+caption: caption.")))
+    (org-test-with-temp-text (format "
+%s
+#+header: :var edge=\"also duplicated\"
+#+header: :wrap \"src any-spanish -n\"
+#+name: Nobody
+#+begin_src any-english -i -n :var here=\"duplicated\" :wrap \"src any-english -n\"
+
+above split
+<point>
+below split
+
+#+end_src
+" caption)
+      (let ((wrap-val "src any-spanish -n") above below avars bvars)
+        (org-babel-demarcate-block)
+        (goto-char (point-min))
+        (org-babel-next-src-block) ;; upper source block
+        (setq above (org-babel-get-src-block-info))
+        (setq avars (org-babel--get-vars (nth 2 above)))
+        (org-babel-next-src-block) ;; lower source block
+        (setq below (org-babel-get-src-block-info))
+        (setq bvars (org-babel--get-vars (nth 2 below)))
+        ;; duplicated multi-line header arguments:
+        (should (string= "also duplicated" (cdr (assq 'edge avars))))
+        (should (string= "also duplicated" (cdr (assq 'edge bvars))))
+        (should (string= wrap-val (cdr (assq :wrap (nth 2 above)))))
+        (should (string= wrap-val (cdr (assq :wrap (nth 2 below)))))
+        ;; duplicated language, other header arguments, and switches:
+        (should (string= "any-english" (nth 0 above)))
+        (should (string= "any-english" (nth 0 below)))
+        (should (string= "above split" (org-trim (nth 1 above))))
+        (should (string= "below split" (org-trim (nth 1 below))))
+        (should (string= "duplicated" (cdr (assq 'here avars))))
+        (should (string= "duplicated" (cdr (assq 'here bvars))))
+        (should (string= "-i -n" (nth 3 above)))
+        (should (string= "-i -n" (nth 3 below)))
+        ;; non-duplication of name and caption, which is not in above/below.
+        (should (string= "Nobody" (nth 4 above)))
+        (should-not (string= "" (nth 4 below)))
+        (goto-char (point-min))
+        (should (re-search-forward regexp))
+        (should-not (re-search-forward regexp nil 'noerror)))))
+  ;; Test wrapping point in blank lines below source block
+  (org-test-with-temp-text "
+#+begin_src any-language -i -n :var here=\"not duplicated\"
+to upper block
+#+end_src
+<point>
+"
+    (let (info)
+      (org-babel-demarcate-block)
+      (goto-char (point-min))
+      (org-babel-next-src-block)
+      (setq info (org-babel-get-src-block-info))  ;; upper source block info
+      (should (string= "any-language" (nth 0 info)))
+      (should (string= "to upper block" (org-trim (nth 1 info))))
+      (should (string= "not duplicated"
+                       (cdr (assq 'here (org-babel--get-vars (nth 2 info))))))
+      (should (string= "-i -n" (nth 3 info)))
+      (org-babel-next-src-block)
+      (setq info (org-babel-get-src-block-info)) ;; lower source block info
+      (should (string= "any-language" (nth 0 info)))
+      (should (string= "" (org-trim (nth 1 info))))
+      (should-not (org-babel--get-vars (nth 2 info)))
+      (should (string= "" (nth 3 info)))))
+  ;; Test wrapping region in blank lines below source block
+  (let ((region-text "mark this line as region"))
+    (org-test-with-temp-text (format "
+#+begin_src any-language -i -n :var here=\"not duplicated\"
+to upper block
+#+end_src
+
+%s
+" region-text)
+      (let (info)
+        (goto-char (point-min))
+        (re-search-forward region-text)
+        (set-mark (point))
+        (previous-line) ;; ensure that point is on an empty line.
+        (org-babel-demarcate-block)
+        (goto-char (point-min))
+        (org-babel-next-src-block)
+        (setq info (org-babel-get-src-block-info))  ;; upper source block info
+        (should (string= "any-language" (nth 0 info)))
+        (should (string= "to upper block" (org-trim (nth 1 info))))
+        (should (string= "not duplicated"
+                         (cdr (assq 'here (org-babel--get-vars (nth 2 info))))))
+        (should (string= "-i -n" (nth 3 info)))
+        (org-babel-next-src-block)
+        (setq info (org-babel-get-src-block-info)) ;; lower source block info
+        (should (string= "any-language" (nth 0 info)))
+        (should (string= region-text (org-trim (nth 1 info))))
+        (should-not (org-babel--get-vars (nth 2 info)))
+        (should (string= "" (nth 3 info))))))
+  ;; Test prefix argument point splitting.
+  (let ((org-adapt-indentation t)
+        (ok-col 11)
+        (stars "^\\*\\*\\*\\*\\*\\*\\*\\*\\*\\*"))
+    (org-test-with-temp-text "
+********** 10 stars with point between two lines
+           #+begin_src emacs-lisp
+           ;; to upper block
+           <point>
+           ;; to lower block
+           #+end_src
+"
+      (org-babel-demarcate-block 'a-prefix-arg)
+      (goto-char (point-min))
+      (dolist (regexp `(,stars
+                        "#\\+beg" ";; to upper block" "#\\+end"
+                        ,stars
+                        "#\\+beg" ";; to lower block" "#\\+end"))
+        (should (re-search-forward regexp))
+        (goto-char (match-beginning 0))
+        (if (or (string= regexp stars)
+                (string-prefix-p ";;" regexp))
+            (should (= 0 (current-column)))
+          (should (= ok-col (current-column)))))))
+  ;; Test prefix argument region splitting.
+  (let ((org-adapt-indentation t)
+        (ok-col 11)
+        (stars "^\\*\\*\\*\\*\\*\\*\\*\\*\\*\\*")
+        (parts '("to upper block" "mark this line as region" "to lower block")))
+    (org-test-with-temp-text (format "
+********** 10 stars with region between two lines
+           #+header: :var b=\"also seen\"
+           #+begin_src any-language -i -n :var a=\"seen\"
+           %s
+           %s
+           %s
+           #+end_src
+" (nth 0 parts) (nth 1 parts) (nth 2 parts))
+      (let ((n 0) info vars)
+        (goto-char (point-min))
+        (re-search-forward (nth 1 parts))
+        (set-mark (point))
+        ;; mark the region by moving point makes the test pass.
+        (beginning-of-line) ;; (goto-char (match-beginning 0)) fails.
+        (org-babel-demarcate-block 'a-prefix-argument)
+        (goto-char (point-min))
+        (while (< n (length parts))
+          (org-babel-next-src-block)
+          (setq info (org-babel-get-src-block-info))
+          (setq vars (org-babel--get-vars (nth 2 info)))
+          (should (string= "any-language" (nth 0 info)))
+          (should (string= (nth n parts) (org-trim (nth 1 info))))
+          (should (string= "seen" (cdr (assq 'a vars))))
+          (should (string= "also seen" (cdr (assq 'b vars))))
+          (should (string= "-i -n" (nth 3 info)))
+          (cl-incf n)))
+      (goto-char (point-min))
+      (dolist (regexp `(,stars
+                        "#\\+beg" ,(nth 0 parts) "#\\+end"
+                        ,stars
+                        "#\\+beg" ,(nth 1 parts) "#\\+end"
+                        ,stars
+                        "#\\+beg" ,(nth 2 parts) "#\\+end"))
+        (should (re-search-forward regexp))
+        (goto-char (match-beginning 0))
+        (if (string= regexp stars)
+            (should (= 0 (current-column)))
+          (should (= ok-col (current-column))))))))
+
 (ert-deftest test-ob/indented-cached-org-bracket-link ()
   "When the result of a source block is a cached indented link it
 should still return the link."
-- 
2.42.0