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

[gerard.vermeulen@posteo.net]

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



On 28.02.2024 12:54, Ihor Radchenko wrote:
> gerard.vermeulen@posteo.net writes:
> 
>>> You may wrap `org-indent-block' into `condition-case' to catch
>>> user-errors.
>> 
>> The caveat is not a real constraint, since Org has limited support for
>> source block editing in an Org mode buffer when an
>> `org-babel-edit-prep:<LANG>' function signals an user-error.
>> 
>> I show that in the attached no-user-errors-in-edit-prep.org.
> 
> I studied the existing Org handling of various errors related to src
> edit buffers and it seems that we tend to ignore them in a number of
> scenarios. In particular, when major mode fails to load for any reason,
> Org mode does not even throw an error, but simply displays a warning.
> 
> So, I think that we can similarly ignore errors in edit-prep function,
> demoting them to messages.
> 
> (In addition, it does not look like electric-indent-mode triggered in
> your example file by pressing <RET> handles errors gracefully either -
> yet another reason not to throw errors in `org-indent-*' functions)
> 
> Does it make sense?

Your reply helped me to read the Org Babel code from a different view
point.  I re-discovered that `org-babel-edit-prep:sql' handles all
issues gracefully while trying the block below:
#+begin_src sql :engine wrong
a
b
#+end_src
That includes `org-babel-demarcate-block' splitting with the patch.

I do not understand why it works and why I never see the user-error
re-signalled by `org-babel-edit-prep:sql' (even as demoted message).

After writing `org-babel-edit-prep:python' like:
#+begin_src emacs-lisp -n :results silent
(defun harm-full-edit-prep (_info)
   (user-error "Harm-FULL edit-prep"))

(defun org-babel-edit-prep:python (info)
   "Imitate `org-babel-edit-prep:sql'."
   (condition-case nil
       (harm-full-edit-prep info)
     (user-error "Why is this harm-LESS in `org-babel-edit-prep:sql'?")))
#+end_src
and trying it on the block below:
#+begin_src python -i -n :results silent
11
22
#+end_src
I see that this `org-babel-edit-prep:python' handles all issues like
`org-babel-edit-prep:sql' (and it does not matter whether
`electric-indent-mode' is disabled or enabled).

I conclude (contrary to the previous commit message in the patch):

In case functions called by an `org-babel-edit-prep:<LANG>' function
raise an user-error, this `org-babel-edit-prep:<LANG>' function should
re-signal the user-error like `org-babel-edit-prep:sql' does.

Attached you'll find the patch with an updated commit message.

Regards -- Gerard

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

From b51be84e239c108bf3d731f4f259bbd4088790c7 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.  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-split-duplication)
(test-ob/demarcate-block-split-prefix-point)
(test-ob/demarcate-block-split-prefix-region)
(test-ob/demarcate-block-split-user-errors)
(test-ob/demarcate-block-wrap-point)
(test-ob/demarcate-block-wrap-region): New tests to check test cases
that broke earlier versions of this patch.

In case functions called by an `org-babel-edit-prep:<LANG>' function
raise an user-error, this `org-babel-edit-prep:<LANG>' function should
re-signal the user-error like `org-babel-edit-prep:sql' does.

Link: https://list.orgmode.org/7e41f9b6e9026a404e256f33371e974c@posteo.net/
---
 lisp/ob-core.el         |  94 ++++++++++++-----
 testing/lisp/test-ob.el | 219 ++++++++++++++++++++++++++++++++++++++++
 2 files changed, 285 insertions(+), 28 deletions(-)

diff --git a/lisp/ob-core.el b/lisp/ob-core.el
index bfeac257b..e3110a3f1 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)))
@@ -2075,7 +2078,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.
 
@@ -2085,41 +2088,76 @@ 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)))
+               (pads ;; To calculate left-side white-space padding.
+                (if (org-region-active-p)
+                    (list (region-beginning) (region-end))
+                  (list (point))))
+               (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))))
+          ;; Map positions to columns for white-space padding.
+          (setq pads (mapcar (lambda (p) (save-excursion
+                                           (goto-char p)
+                                           (current-column)))
+                             pads))
+          (push 0 pads) ;; The 1st part never requires white-space padding.
+          (setq parts (mapcar (lambda (p) (string-join
+                                           (list (make-string (car p) ?\s)
+                                                 (cdr p))))
+                              (seq-mapn #'cons pads 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..c088af7c8 100644
--- a/testing/lisp/test-ob.el
+++ b/testing/lisp/test-ob.el
@@ -2545,6 +2545,225 @@ abc
 		(lambda (&rest _) (error "No warnings should occur"))))
        (org-babel-import-elisp-from-file (buffer-file-name))))))
 
+(ert-deftest test-ob/demarcate-block-split-duplication ()
+  "Test duplication of language, body, switches, and headers in splitting."
+  (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))))))
+
+(ert-deftest test-ob/demarcate-block-split-prefix-point ()
+  "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)))))))))
+
+(ert-deftest test-ob/demarcate-block-split-prefix-region ()
+  "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 those words 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
+             <point>%s
+             %s
+           #+end_src
+" (nth 0 parts) (nth 1 parts) (nth 2 parts))
+      (let ((n 0) info vars)
+        (transient-mark-mode 1)
+        (push-mark (point) t t)
+        (search-forward (nth 1 parts))
+        (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)))))))))
+
+(ert-deftest test-ob/demarcate-block-split-user-errors ()
+  "Test for `user-error's in splitting"
+  (let ((org-adapt-indentation t)
+        (org-edit-src-content-indentation 2)
+        (org-src-preserve-indentation))
+    (let* ((caption "#+caption: caption.")
+           (within-body ";; within-body")
+           (below-block "# below block")
+           (template  "
+%s%s
+#+begin_src emacs-lisp
+
+  %s
+
+#+end_src
+
+%s%s
+"))
+      ;; Test point at caption.
+      (org-test-with-temp-text
+          (format template "<point>" caption within-body below-block "")
+        (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
+          (format template "" caption within-body below-block "<point>")
+        ;; Set mark.
+        (transient-mark-mode 1)
+        (push-mark (point) t t)
+        ;; Set point.
+        (should (search-backward within-body nil 'noerror))
+        (goto-char (match-beginning 0))
+        (should-error (org-babel-demarcate-block) :type 'user-error)))))
+
+(ert-deftest test-ob/demarcate-block-wrap-point ()
+  "Test wrapping point in blank lines below a 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))))))
+
+(ert-deftest test-ob/demarcate-block-wrap-region ()
+  "Test wrapping region in blank lines below a source block."
+  (let ((region-text "mark this line as region leaving point in blank lines"))
+    (org-test-with-temp-text (format "
+#+begin_src any-language -i -n :var here=\"not duplicated\"
+to upper block
+#+end_src
+<point>
+%s
+" region-text)
+      (let (info vars)
+        (transient-mark-mode 1)
+        (push-mark (point) t t)
+        (search-forward region-text)
+        (exchange-point-and-mark)
+        (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)))))))
+
 (provide 'test-ob)
 
 ;;; test-ob ends here
-- 
2.42.0