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

[gerard.vermeulen@posteo.net]

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

Attached you'll find a new patch addressing all you issues.

I have integrated our discussion leading to
https://list.orgmode.org/87ply6nyue.fsf@localhost/
Please feel free to add the line

Co-authored-by: Ihor Radchenko <yantar92@posteo.net>

to the commit message.  I think you should.

On 09.01.2024 15:49, Ihor Radchenko wrote:
> gerard.vermeulen@posteo.net writes:
> 
>> Attached you'll find a new patch fixing the three wrong lines in the
>> previous
>> and now the ERT test checks also for `user-error's.
> 
> 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.
> 
> Yet, it will lead to large spacing between src blocks in the following
> scenario:
> 
> --------------------
> #+begin_src emacs-lisp
>   "This is test"
> <point>  "This is test2"
>   "This is test3"
> #+end_src
> 
> 
> 
> 
> 
> 
> Paragraph.
> --------------------
> 

I have used the :post-blank property to fix it.  The result is now:
--------------------
#+begin_src emacs-lisp
   "This is test"
#+end_src

#+begin_src emacs-lisp
   "This is test2"
   "This is test3"
#+end_src






Paragraph.
--------------------

Here is also a redone comparison between main and patch:

------- begin comparison main and patch
#+begin_src emacs-lisp :results silent
(setopt org-adapt-indentation t
         org-edit-src-content-indentation 2
         org-src-preserve-indentation nil))
#+end_src

* main
**** C-u C-x C-v C-d
      #+CAPTION: caption.
      #+NAME: name.
      #+BEGIN_SRC emacs-lisp
        above
        ;; region
        below
      #+END_SRC
becomes
**** C-u C-x C-v C-d
      #+CAPTION: caption.
      #+NAME: name.
      #+BEGIN_SRC emacs-lisp
        above

        #+END_SRC
****
        #+BEGIN_SRC emacs-lisp
        ;; region
        #+END_SRC
****
        #+BEGIN_SRC emacs-lisp
        below
      #+END_SRC
pitfall

* patch
**** C-u C-x C-v C-d
      #+CAPTION: caption.
      #+NAME: name.
      #+BEGIN_SRC emacs-lisp
        above
        ;; region
        below
      #+END_SRC
becomes
**** C-u C-x C-v C-d
      #+caption: caption.
      #+name: name.
      #+begin_src emacs-lisp
        above
      #+end_src
****
      #+begin_src emacs-lisp
        ;; region
      #+end_src
****
      #+begin_src emacs-lisp

        below
      #+end_src
pitfall
------- end comparison main and patch

> 
> Also, your new version of the patch will completely misbehave because 
> of
> setting mark. Please, use `region-beginning' and `region-end' instead.
> Setting and checking mark is not to be done in Elisp - it only make
> sense when transient-mark-mode is enabled.
> 
Done. See below.
> 
>> * 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
> 
> That would make sense. Although, we do not have to limit the possible
> options to just what you listed. Arbitrary affiliated keywords might
> also be excluded. For example, #+ATTR_HTML keyword is stored in src
> block object as :attr_html.
> 
I prefer to postpone work on this idea.
> 
>> +          ;; To simplify the (unless ... (user-error ...)).
>> +          (unless (org-region-active-p) (set-mark (point)))
> 
> Setting mark causes issue in my above example.
> 
>> +          ;; Test mark to be more specific than "Not at a block".
>> +          (unless (and (>= (point) body-beg) (<= (mark) body-end))
>> +            (user-error "Select within the source block body to split 
>> it"))
> 
> Here, it is better to use `region-beginning', `point', and 
> `region-end'.
> `region-beginning', unlike mark and point, is guaranteed to be _before_
> `region-end'. Mark may be before point, in contrast.
> 
> You can write something like
> 
> (unless
>  (if (org-region-active-p)
>    (<= body-beg (region-beginning) (region-end) body-end)
>   (>= body-beg (point)))
>  (user-error ...))

Done, using a better initialization of parts, the test simplifies to:

            ;; Point or region are within body when parts is in 
increasing order.
            (unless (apply #'<= parts)
              (user-error "Select within the source block body to split 
it"))

Regards -- Gerard

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

From 56d6bf2b81027ee1c5ee0cc05b3301fe58a3d9dc Mon Sep 17 00:00:00 2001
From: Gerard Vermeulen <gerard.vermeulen@posteo.net>
Date: Thu, 11 Jan 2024 20:20:01 +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 (pitfall, see link).  Use :post-blank to
control white lines between inserted blocks.  Leave point at the last
inserted block.  Trying to split when point or region is not within
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.

Link: https://list.orgmode.org/87ply6nyue.fsf@localhost/
---
 lisp/ob-core.el         |  80 +++++++++-----
 testing/lisp/test-ob.el | 223 ++++++++++++++++++++++++++++++++++++++++
 2 files changed, 275 insertions(+), 28 deletions(-)

diff --git a/lisp/ob-core.el b/lisp/ob-core.el
index 1de3af6ad..55f747ee1 100644
--- a/lisp/ob-core.el
+++ b/lisp/ob-core.el
@@ -73,10 +73,12 @@
 (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))
 (declare-function org-in-commented-heading-p "org" (&optional no-inheritance))
+(declare-function org-indent-block "org" ())
 (declare-function org-indent-line "org" ())
 (declare-function org-list-get-list-end "org-list" (item struct prevs))
 (declare-function org-list-prevs-alist "org-list" (struct))
@@ -700,8 +702,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 +2054,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 +2064,62 @@ 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
+                (if (org-region-active-p)
+                    (list body-beg (region-beginning) (region-end) body-end)
+                  (list body-beg (point) body-end)))
+               (n (- (length parts) 2)) ;; 1 or 2 parts in `dolist' below.
+               ;; `post-blank' caches the property before setting it to 0.
+               (post-blank (org-element-property :post-blank copy)))
+          ;; Point or region are within body when parts is in increasing order.
+          (unless (apply #'<= parts)
+            (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)
+          ;; Set `:post-blank' to 0.  We take care of spacing between blocks.
+          (org-element-put-property copy :post-blank 0)
+          (org-element-put-property copy :value (car parts))
+          (insert (org-element-interpret-data copy))
+          ;; `org-indent-block' may see another `org-element' (e.g. paragraph)
+          ;; immediately after the block.  Ensure to indent the inserted block
+          ;; and move point to its end.
+          (org-babel-previous-src-block 1)
+          (org-indent-block)
+          (goto-char (org-element-end (org-element-at-point)))
+          (org-element-put-property copy :caption nil)
+          (org-element-put-property copy :name nil)
+          ;; Insert the 2nd block, and the 3rd block when region is active.
+          (dolist (part (cdr parts))
+            (org-element-put-property copy :value part)
+            (insert (if arg (concat stars "\n") "\n"))
+            (cl-decf n)
+            (when (= n 0)
+              ;; Use `post-blank' to reset the property of the last block.
+              (org-element-put-property copy :post-blank post-blank))
+            (insert (org-element-interpret-data copy))
+            ;; Ensure to indent the inserted block and move point to its end.
+            (org-babel-previous-src-block 1)
+            (org-indent-block)
+            (goto-char (org-element-end (org-element-at-point))))
+          ;; Leave point at the last inserted block.
+          (goto-char (org-babel-previous-src-block 1)))
       (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..1d85d1206 100644
--- a/testing/lisp/test-ob.el
+++ b/testing/lisp/test-ob.el
@@ -26,6 +26,229 @@
 (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-adapt-indentation nil))
+    (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
+do not org-indent-block text here
+" 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 vars)
+      (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
+      (setq vars (org-babel--get-vars (nth 2 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 vars))))
+      (should (string= "-i -n" (nth 3 info)))
+      (org-babel-next-src-block)
+      (setq info (org-babel-get-src-block-info)) ;; lower source block info
+      (setq vars (org-babel--get-vars (nth 2 info)))
+      (should (string= "any-language" (nth 0 info)))
+      (should (string= "" (org-trim (nth 1 info))))
+      (should-not vars)
+      (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 vars)
+        (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
+        (setq vars (org-babel--get-vars (nth 2 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 vars))))
+        (should (string= "-i -n" (nth 3 info)))
+        (org-babel-next-src-block)
+        (setq info (org-babel-get-src-block-info)) ;; lower source block info
+        (setq vars (org-babel--get-vars (nth 2 info)))
+        (should (string= "any-language" (nth 0 info)))
+        (should (string= region-text (org-trim (nth 1 info))))
+        (should-not vars)
+        (should (string= "" (nth 3 info))))))
+  ;; Test prefix argument point splitting.
+  (let ((org-adapt-indentation t)
+        (org-edit-src-content-indentation 2)
+        (org-src-preserve-indentation nil)
+        (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))
+        (cond ((string= regexp stars)
+               (should (= 0 (current-column))))
+              ((string-prefix-p ";;" regexp)
+               (should (= (+ ok-col org-edit-src-content-indentation)
+                          (current-column))))
+              (t (should (= ok-col (current-column))))))))
+  ;; Test prefix argument region splitting.
+  (let ((org-adapt-indentation t)
+        (org-edit-src-content-indentation 2)
+        (org-src-preserve-indentation nil)
+        (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))
+        (cond ((string= regexp stars)
+               (should (= 0 (current-column))))
+              ((memq regexp parts)
+               (should (= (+ ok-col org-edit-src-content-indentation)
+                          (current-column))))
+              (t (should (= ok-col (current-column)))))))
+    ;; Test for `user-errors's.
+    (let* ((caption "#+caption: caption.")
+           (regexp (rx "#+caption: caption."))
+           (within-body ";; within-body")
+           (below-block "# below block")
+           (temp-text (format "
+%s
+#+begin_src emacs-lisp
+
+  %s
+
+#+end_src
+
+%s
+" caption within-body below-block)))
+      ;; Test point at caption.
+      (org-test-with-temp-text temp-text
+        ;; Set point.
+        (should (re-search-forward regexp nil 'noerror))
+        (goto-char (match-beginning 0))
+        ;; Check (point).
+        (should (string= caption
+                         (buffer-substring
+                          (point) (+ (point) (length caption)))))
+        (should-error (org-babel-demarcate-block) :type 'user-error))
+      ;; Test region from below the block (mark) to within the body (point).
+      (org-test-with-temp-text temp-text
+        ;; Set mark.
+        (should (re-search-forward below-block nil 'noerror))
+        (set-mark (match-beginning 0))
+        ;; Check (mark).
+        (should (string= below-block
+                         (buffer-substring
+                          (mark) (+ (mark) (length below-block)))))
+        ;; Set point.
+        (should (re-search-backward within-body nil 'noerror))
+        (goto-char (match-beginning 0))
+        ;; Check (point).
+        (should (string= within-body
+                         (buffer-substring
+                          (point) (+ (point) (length within-body)))))
+        (should-error (org-babel-demarcate-block) :type 'user-error)))))
+
 (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