* [PATCH] org-babel-demarcate-block: duplicate switches too
@ 2023-12-30 19:13 gerard.vermeulen
2023-12-31 14:28 ` Ihor Radchenko
0 siblings, 1 reply; 41+ messages in thread
From: gerard.vermeulen @ 2023-12-30 19:13 UTC (permalink / raw)
To: Emacs orgmode
[-- Attachment #1: Type: text/plain, Size: 179 bytes --]
Hi,
The purpose of this patch is to duplicate switches when
org-babel-demarcate-block
duplicates headers (meaning point in the source block when demarcating).
Regards -- Gerard
[-- Attachment #2: 0001-org-babel-demarcate-block-duplicate-switches-too.patch --]
[-- Type: application/octet-stream, Size: 1369 bytes --]
From d0462f21597174cc4fad31ad5404fbabe8e6416b Mon Sep 17 00:00:00 2001
From: Gerard Vermeulen <gerard.vermeulen@posteo.net>
Date: Sat, 30 Dec 2023 19:25:25 +0100
Subject: [PATCH] org-babel-demarcate-block: duplicate switches too
* lisp/ob-babel (org-babel-demarcate-block): duplicate switches when
the demarcation duplicates headers.
---
lisp/ob-core.el | 3 +++
1 file changed, 3 insertions(+)
diff --git a/lisp/ob-core.el b/lisp/ob-core.el
index f7e4e255f..634b7626b 100644
--- a/lisp/ob-core.el
+++ b/lisp/ob-core.el
@@ -2078,6 +2078,7 @@ block of the same language with the previous."
(save-excursion
(goto-char place)
(let ((lang (nth 0 info))
+ (switches (nth 3 info))
(indent (make-string (org-current-text-indentation) ?\s)))
(when (string-match "^[[:space:]]*$"
(buffer-substring (line-beginning-position)
@@ -2089,6 +2090,8 @@ block of the same language with the previous."
(if arg stars indent) "\n"
indent (if upper-case-p "#+BEGIN_SRC " "#+begin_src ")
lang
+ (if (> (length switches) 1)
+ (concat " " switches) switches)
(if (> (length headers) 1)
(concat " " headers) headers)
(if (looking-at "[\n\r]")
--
2.42.0
^ permalink raw reply related [flat|nested] 41+ messages in thread
* Re: [PATCH] org-babel-demarcate-block: duplicate switches too
2023-12-30 19:13 [PATCH] org-babel-demarcate-block: duplicate switches too gerard.vermeulen
@ 2023-12-31 14:28 ` Ihor Radchenko
2024-01-01 12:52 ` gerard.vermeulen
0 siblings, 1 reply; 41+ messages in thread
From: Ihor Radchenko @ 2023-12-31 14:28 UTC (permalink / raw)
To: gerard.vermeulen; +Cc: Emacs orgmode
gerard.vermeulen@posteo.net writes:
> The purpose of this patch is to duplicate switches when
> org-babel-demarcate-block
> duplicates headers (meaning point in the source block when demarcating).
Thanks for the patch!
Would you mind also adding a test for `org-babel-demarcate-block' in
testing/lisp/test-ob.el?
--
Ihor Radchenko // yantar92,
Org mode contributor,
Learn more about Org mode at <https://orgmode.org/>.
Support Org development at <https://liberapay.com/org-mode>,
or support my work at <https://liberapay.com/yantar92>
^ permalink raw reply [flat|nested] 41+ messages in thread
* Re: [PATCH] org-babel-demarcate-block: duplicate switches too
2023-12-31 14:28 ` Ihor Radchenko
@ 2024-01-01 12:52 ` gerard.vermeulen
2024-01-02 10:48 ` Ihor Radchenko
0 siblings, 1 reply; 41+ messages in thread
From: gerard.vermeulen @ 2024-01-01 12:52 UTC (permalink / raw)
To: Ihor Radchenko; +Cc: Emacs orgmode
[-- Attachment #1: Type: text/plain, Size: 1025 bytes --]
On 31.12.2023 15:28, Ihor Radchenko wrote:
> gerard.vermeulen@posteo.net writes:
>
>> The purpose of this patch is to duplicate switches when
>> org-babel-demarcate-block
>> duplicates headers (meaning point in the source block when
>> demarcating).
>
> Thanks for the patch!
> Would you mind also adding a test for `org-babel-demarcate-block' in
> testing/lisp/test-ob.el?
I have attached a new patch with a test named
`test-ob/demarcate-block-split'.
Besides testing the duplication of switches and some header arguments,
it also
shows that multi-line header arguments are not duplicated.
Whether this is a bug or a feature in `org-babel-demarcate-block' may be
a
point of discussion. I have no real opinion.
The code of the 4 (should ...) forms in the test below the line
;; unduplicated multi-line header arguments:
feels a bit clumsy. Does Org have a function to extract the value that a
particular
var-name has from the association list returned by
`org-babel-get-src-block-info'?
Regards -- Gerard
Regards
[-- Attachment #2: 0001-org-babel-demarcate-block-duplicate-switches-too.patch --]
[-- Type: application/octet-stream, Size: 3624 bytes --]
From 5501c0632f323bde472ff94a25ed85bf05f4c1ca Mon Sep 17 00:00:00 2001
From: Gerard Vermeulen <gerard.vermeulen@posteo.net>
Date: Sat, 30 Dec 2023 19:25:25 +0100
Subject: [PATCH] org-babel-demarcate-block: duplicate switches too
* lisp/ob-babel.el (org-babel-demarcate-block): duplicate switches when
the demarcation duplicates headers.
* testing/lisp/test-ob.el (test-ob/demarcate-block-split): New test
for block splitting by demarcation. It checks that switches and
header arguments (with the exception of multi-line header arguments)
are duplicated.
---
lisp/ob-core.el | 3 +++
testing/lisp/test-ob.el | 37 +++++++++++++++++++++++++++++++++++++
2 files changed, 40 insertions(+)
diff --git a/lisp/ob-core.el b/lisp/ob-core.el
index f7e4e255f..634b7626b 100644
--- a/lisp/ob-core.el
+++ b/lisp/ob-core.el
@@ -2078,6 +2078,7 @@ block of the same language with the previous."
(save-excursion
(goto-char place)
(let ((lang (nth 0 info))
+ (switches (nth 3 info))
(indent (make-string (org-current-text-indentation) ?\s)))
(when (string-match "^[[:space:]]*$"
(buffer-substring (line-beginning-position)
@@ -2089,6 +2090,8 @@ block of the same language with the previous."
(if arg stars indent) "\n"
indent (if upper-case-p "#+BEGIN_SRC " "#+begin_src ")
lang
+ (if (> (length switches) 1)
+ (concat " " switches) switches)
(if (> (length headers) 1)
(concat " " headers) headers)
(if (looking-at "[\n\r]")
diff --git a/testing/lisp/test-ob.el b/testing/lisp/test-ob.el
index 42c77ca56..70d56d199 100644
--- a/testing/lisp/test-ob.el
+++ b/testing/lisp/test-ob.el
@@ -26,6 +26,43 @@
(require 'org-table)
(eval-and-compile (require 'cl-lib))
+(ert-deftest test-ob/demarcate-block-split ()
+ "Test duplication of headers and switches in demarcation block splitting."
+ (org-test-with-temp-text "
+#+header: :var edge=\"unduplicated\"
+#+header: :wrap \"src any-spanish -i -n\"
+#+begin_src any-english -i -n :var here=\"seen\"
+
+above split
+<point>
+below split
+
+#+end_src
+"
+ (let (above below)
+ (org-babel-demarcate-block)
+ (setq above (org-babel-get-src-block-info))
+ (org-babel-next-src-block)
+ (setq below (org-babel-get-src-block-info))
+ ;; unduplicated multi-line header arguments:
+ (should (equal '(edge . "unduplicated")
+ (cdr (assq :var (cdr (nth 2 above))))))
+ (should (not (equal '(edge . "unduplicated")
+ (cdr (assq :var (cdr (nth 2 below)))))))
+ (should (equal "src any-spanish -i -n"
+ (cdr (assq :wrap (nth 2 above)))))
+ (should (not (equal "src any-spanish -i -n"
+ (cdr (assq :wrap (nth 2 below))))))
+ ;; duplicated headers 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 (equal '(here . "seen") (cdr (assq :var (nth 2 above)))))
+ (should (equal '(here . "seen") (cdr (assq :var (nth 2 below)))))
+ (should (string= "-i -n" (nth 3 above)))
+ (should (string= "-i -n" (nth 3 below))))))
+
(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
^ permalink raw reply related [flat|nested] 41+ messages in thread
* Re: [PATCH] org-babel-demarcate-block: duplicate switches too
2024-01-01 12:52 ` gerard.vermeulen
@ 2024-01-02 10:48 ` Ihor Radchenko
2024-01-02 20:20 ` [PATCH] org-babel-demarcate-block: split using org-element instead of regexp gerard.vermeulen
0 siblings, 1 reply; 41+ messages in thread
From: Ihor Radchenko @ 2024-01-02 10:48 UTC (permalink / raw)
To: gerard.vermeulen; +Cc: Emacs orgmode
gerard.vermeulen@posteo.net writes:
>> Thanks for the patch!
>> Would you mind also adding a test for `org-babel-demarcate-block' in
>> testing/lisp/test-ob.el?
>
> I have attached a new patch with a test named
> `test-ob/demarcate-block-split'.
> Besides testing the duplication of switches and some header arguments,
> it also
> shows that multi-line header arguments are not duplicated.
>
> Whether this is a bug or a feature in `org-babel-demarcate-block' may be
> a
> point of discussion. I have no real opinion.
IMHO, this is a bug.
The current approach with regexp matching in `org-babel-demarcate-block'
is clearly not accurate. What would be more robust is using
org-element-at-point + org-element-copy + set :value +
org-element-interpret-data to carry over all the affiliated keywords and
header arguments.
> The code of the 4 (should ...) forms in the test below the line
> ;; unduplicated multi-line header arguments:
> feels a bit clumsy. Does Org have a function to extract the value that a
> particular
> var-name has from the association list returned by
> `org-babel-get-src-block-info'?
(org-babel--get-vars (nth 2 (org-babel-get-src-block-info)))
--
Ihor Radchenko // yantar92,
Org mode contributor,
Learn more about Org mode at <https://orgmode.org/>.
Support Org development at <https://liberapay.com/org-mode>,
or support my work at <https://liberapay.com/yantar92>
^ permalink raw reply [flat|nested] 41+ messages in thread
* Re: [PATCH] org-babel-demarcate-block: split using org-element instead of regexp
2024-01-02 10:48 ` Ihor Radchenko
@ 2024-01-02 20:20 ` gerard.vermeulen
2024-01-03 15:11 ` Ihor Radchenko
0 siblings, 1 reply; 41+ messages in thread
From: gerard.vermeulen @ 2024-01-02 20:20 UTC (permalink / raw)
To: Ihor Radchenko; +Cc: Emacs orgmode
[-- Attachment #1: Type: text/plain, Size: 1848 bytes --]
On 02.01.2024 11:48, Ihor Radchenko wrote:
> gerard.vermeulen@posteo.net writes:
>
[...]
>
> IMHO, this is a bug.
> The current approach with regexp matching in
> `org-babel-demarcate-block'
> is clearly not accurate. What would be more robust is using
> org-element-at-point + org-element-copy + set :value +
> org-element-interpret-data to carry over all the affiliated keywords
> and
> header arguments.
>
[...]
>
> (org-babel--get-vars (nth 2 (org-babel-get-src-block-info)))
Attached you'll find a new patch trying to implement your suggestions.
Interactive splitting by demarcation seems to work quite well (see the
before and after splitting snippets in the PS).
However, I cannot run the test because org-babel-demarcate-block
always errors "org-element--cache: Emergency exit" while the same
input works interactively. Could there be a problem of cache
synchronization or something like that? Is there something I can do?
I also did not yet look into how to propagate a switch like -n10.
PS:
# begin before splitting snippet
#+caption[Demarcation splitting test]:
#+caption: Demarcation splitting test.
#+header: :var edge="also copied"
#+header: :wrap "src any-spanish -n"
#+name: lst:test
#+begin_src python -i -n :var here="copied" :wrap "src any-english -n"
# above-split
# below-split
#+end_src
# end before splitting snippet
# begin after splitting snippet
#+caption[Demarcation splitting test]:
#+caption: Demarcation splitting test.
#+header: :var edge="also copied"
#+header: :wrap "src any-spanish -n"
#+name: lst:test
#+begin_src python -i -n :var here="copied" :wrap "src any-english -n"
# above-split
#+end_src
#+header: :var edge="also copied"
#+header: :wrap "src any-spanish -n"
#+begin_src python -i -n :var here="copied" :wrap "src any-english -n"
# below-split
#+end_src
# end after splitting snippet
[-- Attachment #2: 0001-org-babel-demarcate-block-split-using-org-element-in.patch --]
[-- Type: application/octet-stream, Size: 5783 bytes --]
From bfd1615e4e0e0dad64e8559f39cb638d6f2d9ce4 Mon Sep 17 00:00:00 2001
From: Gerard Vermeulen <gerard.vermeulen@posteo.net>
Date: Sat, 30 Dec 2023 19:25:25 +0100
Subject: [PATCH] org-babel-demarcate-block: split using org-element instead of
regexp
* lisp/ob-babel.el (org-babel-demarcate-block): Delete the caption and
the name from a copy of (org-element-at-point) and set its value to
the body inside the source block after point. Delete all superfluous
text after point from the current Emacs buffer and add a proper
sentinel to the upper source block. Insert the lower block by
applying `org-element-interpret-data' to the modified copy. Leave
point in a convenient position.
* testing/lisp/test-ob.el (test-ob/demarcate-block-split): New test
for block splitting by demarcation. It checks also that the language,
switches, and header arguments are duplicated.
---
lisp/ob-core.el | 37 +++++++++++++------------------------
testing/lisp/test-ob.el | 36 ++++++++++++++++++++++++++++++++++++
2 files changed, 49 insertions(+), 24 deletions(-)
diff --git a/lisp/ob-core.el b/lisp/ob-core.el
index f7e4e255f..d541af612 100644
--- a/lisp/ob-core.el
+++ b/lisp/ob-core.el
@@ -2067,35 +2067,24 @@ block of the same language with the previous."
(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)))
(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* ((body-end (match-end 5))
+ (copy (org-element-copy (org-element-at-point)))
+ (beyond (aref (plist-get (cadr copy) :standard-properties) 4))
+ (indent (make-string (org-current-text-indentation) ?\s)))
+ (plist-put (cadr copy) :caption nil)
+ (plist-put (cadr copy) :name nil)
+ (plist-put (cadr copy) :value (buffer-substring (point) body-end))
+ (delete-region (point) beyond)
+ (insert (concat indent (if upper-case-p "#+END_SRC\n" "#+end_src\n")
+ (if arg stars indent) "\n"))
+ (insert (org-element-interpret-data copy))
+ ;; Go back to the lower source block for `org-narrow-to-element':
+ (re-search-backward (rx bol (1+ nonl))))
(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..cfd825c14 100644
--- a/testing/lisp/test-ob.el
+++ b/testing/lisp/test-ob.el
@@ -26,6 +26,42 @@
(require 'org-table)
(eval-and-compile (require 'cl-lib))
+(ert-deftest test-ob/demarcate-block-split ()
+ "Test duplication of headers and switches in demarcation block splitting."
+ (org-test-with-temp-text "
+#+header: :var edge=\"also duplicated\"
+#+header: :wrap \"src any-spanish -n\"
+#+begin_src emacs-lisp -i -n :var here=\"duplicated\" :wrap \"src any-english -n\"
+
+'above-split
+<point>
+'below-split
+
+#+end_src
+"
+ (let ((wrap-val "src any-spanish -n") above below avars bvars)
+ ;; BUG: org-babel-demarcate-block errors "org-element--cache: Emergency exit"
+ (org-babel-demarcate-block)
+ (setq above (org-babel-get-src-block-info))
+ (setq avars (org-babel--get-vars (nth 2 above)))
+ (org-babel-next-src-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= "emacs-lisp" (nth 0 above)))
+ (should (string= "emacs-lisp" (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))))))
+
(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
^ permalink raw reply related [flat|nested] 41+ messages in thread
* Re: [PATCH] org-babel-demarcate-block: split using org-element instead of regexp
2024-01-02 20:20 ` [PATCH] org-babel-demarcate-block: split using org-element instead of regexp gerard.vermeulen
@ 2024-01-03 15:11 ` Ihor Radchenko
2024-01-04 8:59 ` gerard.vermeulen
0 siblings, 1 reply; 41+ messages in thread
From: Ihor Radchenko @ 2024-01-03 15:11 UTC (permalink / raw)
To: gerard.vermeulen; +Cc: Emacs orgmode
[-- Attachment #1: Type: text/plain, Size: 1470 bytes --]
gerard.vermeulen@posteo.net writes:
> Attached you'll find a new patch trying to implement your suggestions.
> Interactive splitting by demarcation seems to work quite well (see the
> before and after splitting snippets in the PS).
Thanks!
> However, I cannot run the test because org-babel-demarcate-block
> always errors "org-element--cache: Emergency exit" while the same
> input works interactively. Could there be a problem of cache
> synchronization or something like that? Is there something I can do?
This was a bug in `org-element-copy'. Fixed, on main now.
https://git.savannah.gnu.org/cgit/emacs/org-mode.git/commit/?id=dfeff03c5
> I also did not yet look into how to propagate a switch like -n10.
-n10 is not a valid switch, AFAIK. We demand space: -n 10.
See 12.6 Literal Examples section of the manual.
I made some adjustments to the patch, making use of org-element API.
See the attached updated version of the patch.
I am not yet merging it as I found some weirdness with indentation.
Consider the following (indentation is important):
#+BEGIN_SRC emacs-lisp -n 20
;; This exports with line number 20.
<point> (message "This is line 21")
#+END_SRC
After M-x org-babel-demarcate-block, I am getting
#+BEGIN_SRC emacs-lisp -n 20
;; This exports with line number 20.
#+END_SRC
#+begin_src emacs-lisp -n 20
(message "This is line 21")
#+end_src
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-org-babel-demarcate-block-split-using-org-element-in.patch --]
[-- Type: text/x-patch, Size: 6409 bytes --]
From f5b9a6862cdb71ab33b7a291386221fff6648d53 Mon Sep 17 00:00:00 2001
Message-ID: <f5b9a6862cdb71ab33b7a291386221fff6648d53.1704294360.git.yantar92@posteo.net>
From: Gerard Vermeulen <gerard.vermeulen@posteo.net>
Date: Sat, 30 Dec 2023 19:25:25 +0100
Subject: [PATCH] org-babel-demarcate-block: split using org-element instead of
regexp
* lisp/ob-babel.el (org-babel-demarcate-block): Delete the caption and
the name from a copy of (org-element-at-point) and set its value to
the body inside the source block after point. Delete all superfluous
text after point from the current Emacs buffer and add a proper
sentinel to the upper source block. Insert the lower block by
applying `org-element-interpret-data' to the modified copy. Leave
point in a convenient position.
* testing/lisp/test-ob.el (test-ob/demarcate-block-split): New test
for block splitting by demarcation. It checks also that the language,
switches, and header arguments are duplicated.
---
lisp/ob-core.el | 38 ++++++++++++++------------------------
testing/lisp/test-ob.el | 35 +++++++++++++++++++++++++++++++++++
2 files changed, 49 insertions(+), 24 deletions(-)
diff --git a/lisp/ob-core.el b/lisp/ob-core.el
index f7e4e255f..300747dae 100644
--- a/lisp/ob-core.el
+++ b/lisp/ob-core.el
@@ -73,6 +73,7 @@ (declare-function org-element-contents-end "org-element" (node))
(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))
@@ -2067,35 +2068,24 @@ (defun org-babel-demarcate-block (&optional arg)
(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)))
(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* ((body-end (match-end 5))
+ (copy (org-element-copy (org-element-at-point)))
+ (end (org-element-end copy))
+ (indent (make-string (org-current-text-indentation) ?\s)))
+ (org-element-put-property copy :caption nil)
+ (org-element-put-property copy :name nil)
+ (org-element-put-property copy :value (buffer-substring (point) body-end))
+ (delete-region (point) end)
+ (insert (concat indent (if upper-case-p "#+END_SRC\n" "#+end_src\n")
+ (if arg stars indent) "\n"))
+ (insert (org-element-interpret-data copy))
+ ;; Go back to the lower source block for `org-narrow-to-element':
+ (re-search-backward (rx bol (1+ nonl))))
(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..e57edfa22 100644
--- a/testing/lisp/test-ob.el
+++ b/testing/lisp/test-ob.el
@@ -26,6 +26,41 @@ (require 'ob-ref)
(require 'org-table)
(eval-and-compile (require 'cl-lib))
+(ert-deftest test-ob/demarcate-block-split ()
+ "Test duplication of headers and switches in demarcation block splitting."
+ (org-test-with-temp-text "
+#+header: :var edge=\"also duplicated\"
+#+header: :wrap \"src any-spanish -n\"
+#+begin_src emacs-lisp -i -n :var here=\"duplicated\" :wrap \"src any-english -n\"
+
+'above-split
+<point>
+'below-split
+
+#+end_src
+"
+ (let ((wrap-val "src any-spanish -n") above below avars bvars)
+ (org-babel-demarcate-block)
+ (setq above (org-babel-get-src-block-info))
+ (setq avars (org-babel--get-vars (nth 2 above)))
+ (org-babel-next-src-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= "emacs-lisp" (nth 0 above)))
+ (should (string= "emacs-lisp" (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))))))
+
(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
[-- Attachment #3: Type: text/plain, Size: 224 bytes --]
--
Ihor Radchenko // yantar92,
Org mode contributor,
Learn more about Org mode at <https://orgmode.org/>.
Support Org development at <https://liberapay.com/org-mode>,
or support my work at <https://liberapay.com/yantar92>
^ permalink raw reply related [flat|nested] 41+ messages in thread
* Re: [PATCH] org-babel-demarcate-block: split using org-element instead of regexp
2024-01-03 15:11 ` Ihor Radchenko
@ 2024-01-04 8:59 ` gerard.vermeulen
2024-01-04 14:43 ` Ihor Radchenko
0 siblings, 1 reply; 41+ messages in thread
From: gerard.vermeulen @ 2024-01-04 8:59 UTC (permalink / raw)
To: Ihor Radchenko; +Cc: Emacs orgmode
[-- Attachment #1: Type: text/plain, Size: 2595 bytes --]
On 03.01.2024 16:11, Ihor Radchenko wrote:
> gerard.vermeulen@posteo.net writes:
>
[...]
Attached you'll find a new patch that seems to solve the block
indentation
problem that you have pointed out, see PS or attached patch-demo.org.
test-ob/demarcate-block-split passes.
>
> This was a bug in `org-element-copy'. Fixed, on main now.
> https://git.savannah.gnu.org/cgit/emacs/org-mode.git/commit/?id=dfeff03c5
>
I did not yet pull your change. Nevertheless, the Emergency exit errors
have disappeared.
>
[...]
>
> I made some adjustments to the patch, making use of org-element API.
> See the attached updated version of the patch.
>
This patch is heavily edited and I think I did not forget any of your
changes.
I have tried to clean up the code. I have also tried to get `body-beg'
and
`body-end' marking the text between the #+begin_src and #+end_src lines
from the element API, but I failed and had to fall back to
`org-babel-where-is-src-block-head'. But only for that.
> I am not yet merging it as I found some weirdness with indentation.
> Consider the following (indentation is important):
>
> #+BEGIN_SRC emacs-lisp -n 20
> ;; This exports with line number 20.
> <point> (message "This is line 21")
> #+END_SRC
>
> After M-x org-babel-demarcate-block, I am getting
>
> #+BEGIN_SRC emacs-lisp -n 20
> ;; This exports with line number 20.
> #+END_SRC
>
> #+begin_src emacs-lisp -n 20
> (message "This is line 21")
> #+end_src
See PS or patch-demo.org: PS (hope you read it with a mono-spaced font):
#+begin_src emacs-lisp :results silent
(setopt org-adapt-indentation t
org-src-preserve-indentation nil
org-edit-src-content-indentation 2)
#+end_src
******** before C-u org-babel-demarcate-block splitting
I put point at the left of the last line in this block before
splitting
#+BEGIN_SRC emacs-lisp -n 20
;; this exports with line number 20
<point> (message "This exports with line number 21")
#+END_SRC
C-u C-c C-v d gets the stars right and the indentation
******** after C-u org-babel-demarcate-block splitting
I put point at the left of the last line in this block before
splitting
#+begin_src emacs-lisp -n 20
;; this exports with line number 20
#+end_src
********
#+begin_src emacs-lisp -n 20
(message "This exports with line number 21")
#+end_src
C-u C-c C-v d gets the stars right and the indentation
[-- Attachment #2: 0001-org-babel-demarcate-block-split-using-org-element-in.patch --]
[-- Type: application/octet-stream, Size: 10058 bytes --]
From 9a19f142d72229cf714d6fce7aabb8860db81a73 Mon Sep 17 00:00:00 2001
From: Gerard Vermeulen <gerard.vermeulen@posteo.net>
Date: Sat, 30 Dec 2023 19:25:25 +0100
Subject: [PATCH] org-babel-demarcate-block: split using org-element instead of
regexp
* lisp/ob-babel.el (org-babel-demarcate-block): Modify a copy
of (org-element-at-point) to replace the old source block with 2 new
blocks after applying `org-element-interpret-data' to suitable
modified copies. The upper source block contains the text from the
body of the old block before point and the lower source block contains
the body text after point. The caption and the name are deleted from
the lower source block. Check `org-adapt-indentation' whether to
indent the blocks. Leave point in a convenient position after
splitting. Trying to split when point is at the old source block but
not within the body of the old source block raises an user-error.
Clean up the wrap by demarcation branch and the documentation string.
* testing/lisp/test-ob.el (test-ob/demarcate-block-split): New test
for block splitting by demarcation. It checks also that the language,
switches, and header arguments are duplicated.
---
lisp/ob-core.el | 103 ++++++++++++++++++++--------------------
testing/lisp/test-ob.el | 38 +++++++++++++++
2 files changed, 90 insertions(+), 51 deletions(-)
diff --git a/lisp/ob-core.el b/lisp/ob-core.el
index f7e4e255f..de05d7144 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))
@@ -2051,72 +2052,72 @@ 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.
-When called from inside of a code block the current block is
-split. When called from outside of a code block a new code block
-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."
+When called from inside of a code block the current block is split. When
+called from outside of a code block a new code block is created. In the
+first case, point is demarcated and in the second case an active region is
+demarcated, but if there is no active region then point is demarcated."
(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)))
- (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)))
+ (stars (concat (make-string (or (org-current-level) 1) ?*) " ")))
+ (if (eq 'src-block (car copy))
+ ;; Keep this branch in sync with test-ob/demarcate-block-split.
+ ;; _start is never nil, since there is a source block element at point.
+ (let* ((_start (org-babel-where-is-src-block-head))
+ (body-beg (match-beginning 5))
+ (body-end (match-end 5))
+ (before (org-element-begin copy))
+ (beyond (org-element-end copy))
+ above below)
+ (unless (and (>= (point) body-beg) (>= body-end (point)))
+ (user-error "move point within the source block body to split it"))
+ (setq above (buffer-substring body-beg (point)))
+ (setq below (buffer-substring (point) body-end))
+ (delete-region before beyond)
+ (org-element-put-property copy :value above)
+ (insert (org-element-interpret-data copy))
+ (insert (concat (if arg stars "") "\n"))
+ (org-element-put-property copy :caption nil)
+ (org-element-put-property copy :name nil)
+ (org-element-put-property copy :value below)
+ (insert (org-element-interpret-data copy))
+ (if (not org-adapt-indentation)
+ ;; Move point to the left of the lower block line #+begin_src.
+ (org-previous-block 1)
+ ;; Adapt the indentation: upper block first and lower block second.
+ (org-previous-block 2)
+ (org-indent-block)
+ ;; Move point to the left of the lower block line #+begin_src.
+ (org-next-block 1)
+ (org-indent-block)))
(let ((start (point))
- (lang (or (car info) ; Reuse language from previous block.
- (completing-read
- "Lang: "
- (mapcar #'symbol-name
- (delete-dups
- (append (mapcar #'car org-babel-load-languages)
- (mapcar (lambda (el) (intern (car el)))
- org-src-lang-modes)))))))
+ ;; (org-babel-get-src-block-info 'no-eval) returns nil,
+ ;; since there is no source block at point. Therefore, this
+ ;; cannot be used to get the language of a neighbour block.
+ ;; Deleted code indicated that this may have worked in the past.
+ ;; I have removed upper-case-p, since it could never be true here.
+ (lang (completing-read
+ "Lang: "
+ (mapcar #'symbol-name
+ (delete-dups
+ (append (mapcar #'car org-babel-load-languages)
+ (mapcar (lambda (el) (intern (car el)))
+ org-src-lang-modes))))))
(body (delete-and-extract-region
(if (org-region-active-p) (mark) (point)) (point))))
(insert (concat (if (looking-at "^") "" "\n")
(if arg (concat stars "\n") "")
- (if upper-case-p "#+BEGIN_SRC " "#+begin_src ")
+ "#+begin_src "
lang "\n" body
(if (or (= (length body) 0)
(string-suffix-p "\r" body)
(string-suffix-p "\n" body))
""
"\n")
- (if upper-case-p "#+END_SRC\n" "#+end_src\n")))
+ "#+end_src\n"))
(goto-char start)
(move-end-of-line 1)))))
diff --git a/testing/lisp/test-ob.el b/testing/lisp/test-ob.el
index 42c77ca56..1fbc47151 100644
--- a/testing/lisp/test-ob.el
+++ b/testing/lisp/test-ob.el
@@ -26,6 +26,44 @@
(require 'org-table)
(eval-and-compile (require 'cl-lib))
+(ert-deftest test-ob/demarcate-block-split ()
+ "Test duplication of headers and switches in demarcation block splitting."
+ (org-test-with-temp-text "
+#+header: :var edge=\"also duplicated\"
+#+header: :wrap \"src any-spanish -n\"
+#+begin_src any-english -i -n :var here=\"duplicated\" :wrap \"src any-english -n\"
+
+above split
+<point>
+below split
+
+#+end_src
+"
+ (let ((wrap-val "src any-spanish -n") above below avars bvars)
+ (org-babel-demarcate-block)
+ ;; point is now before #+begin_src of the lower source 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))))))
+
(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
[-- Attachment #3: patch-demo.org --]
[-- Type: application/octet-stream, Size: 1027 bytes --]
Trying to edit code as your example (I never do this like that)
#+begin_src emacs-lisp :results silent
(setopt org-adapt-indentation t
org-src-preserve-indentation nil
org-edit-src-content-indentation 2)
#+end_src
******** before C-u org-babel-demarcate-block splitting
I put point at the left of the last line in this block before splitting
#+BEGIN_SRC emacs-lisp -n 20
;; this exports with line number 20
<point> (message "This exports with line number 21")
#+END_SRC
C-u C-c C-v d gets the stars right and the indentation
******** after C-u org-babel-demarcate-block splitting
I put point at the left of the last line in this block before splitting
#+begin_src emacs-lisp -n 20
;; this exports with line number 20
#+end_src
********
#+begin_src emacs-lisp -n 20
(message "This exports with line number 21")
#+end_src
C-u C-c C-v d gets the stars right and the indentation
^ permalink raw reply related [flat|nested] 41+ messages in thread
* Re: [PATCH] org-babel-demarcate-block: split using org-element instead of regexp
2024-01-04 8:59 ` gerard.vermeulen
@ 2024-01-04 14:43 ` Ihor Radchenko
2024-01-07 18:49 ` [PATCH] org-babel-demarcate-block: split using element API gerard.vermeulen
0 siblings, 1 reply; 41+ messages in thread
From: Ihor Radchenko @ 2024-01-04 14:43 UTC (permalink / raw)
To: gerard.vermeulen; +Cc: Emacs orgmode
gerard.vermeulen@posteo.net writes:
>> I made some adjustments to the patch, making use of org-element API.
>> See the attached updated version of the patch.
Thanks! See my comments inline.
> I have tried to clean up the code. I have also tried to get `body-beg'
> and
> `body-end' marking the text between the #+begin_src and #+end_src lines
> from the element API, but I failed and had to fall back to
> `org-babel-where-is-src-block-head'. But only for that.
org-element API does not provide this information for now. Maybe it is a
good opportunity to alter the parser, so that code boundaries are
provided...
> (defun org-babel-demarcate-block (&optional arg)
> ...
> -When called within blank lines after a code block, create a new code
> -block of the same language with the previous."
Is there any reason why you dropped this feature?
When I try
#+begin_src emacs-lisp
(+ 1 2)
#+end_src
<point>
M-x org-babel-demacrate-block throws an error with your patch.
It creates a new block with the same language before your patch.
> + (let ((copy (org-element-copy (org-element-at-point)))
> + (stars (concat (make-string (or (org-current-level) 1) ?*) " ")))
> + (if (eq 'src-block (car copy))
You can instead use `org-element-type-p'
> + ;; Keep this branch in sync with test-ob/demarcate-block-split.
> + ;; _start is never nil, since there is a source block element at point.
May you elaborate what you mean by "keep in sync"?
> + (let* ((_start (org-babel-where-is-src-block-head))
Are you using (org-babel-where-is-src-block-head) for side effect of
modifying the match data? If so, please do it outside let, with
appropriate comment.
> + (if (not org-adapt-indentation)
> + ;; Move point to the left of the lower block line #+begin_src.
> + (org-previous-block 1)
> + ;; Adapt the indentation: upper block first and lower block second.
> + (org-previous-block 2)
> + (org-indent-block)
> + ;; Move point to the left of the lower block line #+begin_src.
> + (org-next-block 1)
> + (org-indent-block)))
`org-indent-block' should honor `org-adapt-indentation'. You do not need
to call it conditionally. Re-indenting unconditionally should be better
here.
> (let ((start (point))
> - (lang (or (car info) ; Reuse language from previous block.
> - (completing-read
> - "Lang: "
> - (mapcar #'symbol-name
> - (delete-dups
> - (append (mapcar #'car org-babel-load-languages)
> - (mapcar (lambda (el) (intern (car el)))
> - org-src-lang-modes)))))))
> + ;; (org-babel-get-src-block-info 'no-eval) returns nil,
> + ;; since there is no source block at point. Therefore, this
> + ;; cannot be used to get the language of a neighbour block.
Why nil? The condition was
(and info start) ;; At src block, but not within blank lines after it.
So, this branch of the if used to be INFO - non-nil, and START nil ->
re-use the information. And if INFO were nil, query.
> + ;; Deleted code indicated that this may have worked in the past.
> + ;; I have removed upper-case-p, since it could never be true here.
The idea of UPPER-CASE-P is to keep user preference for keyword style
(upper case or lower case). There is no reason to remove this feature.
Although, since we are using `org-element-interpret-data', it might be a
good idea to extend org-element parser to preserve the keyword case
information.
--
Ihor Radchenko // yantar92,
Org mode contributor,
Learn more about Org mode at <https://orgmode.org/>.
Support Org development at <https://liberapay.com/org-mode>,
or support my work at <https://liberapay.com/yantar92>
^ permalink raw reply [flat|nested] 41+ messages in thread
* Re: [PATCH] org-babel-demarcate-block: split using element API
2024-01-04 14:43 ` Ihor Radchenko
@ 2024-01-07 18:49 ` gerard.vermeulen
2024-01-08 12:08 ` Ihor Radchenko
0 siblings, 1 reply; 41+ messages in thread
From: gerard.vermeulen @ 2024-01-07 18:49 UTC (permalink / raw)
To: Ihor Radchenko; +Cc: Emacs orgmode
[-- Attachment #1: Type: text/plain, Size: 7936 bytes --]
On 04.01.2024 15:43, Ihor Radchenko wrote:
> gerard.vermeulen@posteo.net writes:
>
Attached you'll find a new version of the patch that addresses your
comments. I have modified the ERT test so that it checks most of
your examples showing where the older versions of the patch failed.
The test is now called `test-ob/demarcate-block'
It also allows to split in three blocks when a region is selected (main
does this contrary to my older patches).
Below, I compare region splitting using main or my patch. White-space
differs between main and the patch and one might argue that the result
produced by the patch is more consistent. Maybe, the indenting of the
input code block is somewhat contrived, because all code is moved
completely to the left after calling `org-indent-block'.
* main does this
#+begin_src emacs-lisp :results silent
(setopt org-adapt-indentation t
org-src-preserve-indentation t
org-edit-src-content-indentation 2)
#+end_src
******** before C-u org-babel-demarcate-block region splitting
#+begin_src emacs-lisp
(defun above ()
(message "above"))
(defun region ()
(message "mark region with leading and trailing blank
lines"))
(defun below ()
(message "below"))
#+end_src
******** after C-u org-babel-demarcate-block region splitting
#+begin_src emacs-lisp
(defun above ()
(message "above"))
#+end_src
********
#+begin_src emacs-lisp
(defun region ()
(message "mark region with leading and trailing blank
lines"))
#+end_src
********
#+begin_src emacs-lisp
(defun below ()
(message "below"))
#+end_src
* end main does this
* patch does this
#+begin_src emacs-lisp :results silent
(setopt org-adapt-indentation t
org-src-preserve-indentation t
org-edit-src-content-indentation 2)
#+end_src
******** before C-u org-babel-demarcate-block region splitting
#+begin_src emacs-lisp
(defun above ()
(message "above"))
(defun region ()
(message "mark region with leading and trailing blank
lines"))
(defun below ()
(message "below"))
#+end_src
******** after C-u org-babel-demarcate-block region splitting
#+begin_src emacs-lisp
(defun above ()
(message "above"))
#+end_src
********
#+begin_src emacs-lisp
(defun region ()
(message "mark region with leading and trailing blank lines"))
#+end_src
********
#+begin_src emacs-lisp
(defun below ()
(message "below"))
#+end_src
* end patch does this
>
>> I have tried to clean up the code. I have also tried to get
>> `body-beg'
>> and
>> `body-end' marking the text between the #+begin_src and #+end_src
>> lines
>> from the element API, but I failed and had to fall back to
>> `org-babel-where-is-src-block-head'. But only for that.
>
> org-element API does not provide this information for now. Maybe it is
> a
> good opportunity to alter the parser, so that code boundaries are
> provided...
>
>> (defun org-babel-demarcate-block (&optional arg)
>> ...
>> -When called within blank lines after a code block, create a new code
>> -block of the same language with the previous."
>
> Is there any reason why you dropped this feature?
>
> When I try
>
> #+begin_src emacs-lisp
> (+ 1 2)
> #+end_src
> <point>
>
> M-x org-babel-demarcate-block throws an error with your patch.
> It creates a new block with the same language before your patch.
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'.
I have patched the doc-string of `org-babel-get-src-block-info' to
add the "blank lines below condition".
This patch reverts all changes that are due to my misunderstanding
of what `org-babel-get-src-block-info' does.
Now demarcating with point below a source block works again and
checking this is part of the ERT test.
>
>> + (let ((copy (org-element-copy (org-element-at-point)))
>> + (stars (concat (make-string (or (org-current-level) 1) ?*) "
>> ")))
>> + (if (eq 'src-block (car copy))
>
> You can instead use `org-element-type-p'
This is now back to the original (if (and info start) ;; At src block,
but ...
>
>> + ;; Keep this branch in sync with
>> test-ob/demarcate-block-split.
>> + ;; _start is never nil, since there is a source block element
>> at point.
>
> May you elaborate what you mean by "keep in sync"?
"keep in sync" is a kind of reminder to myself, because I think that
test-ob/demarcate-block-split was fragile wrt where point is after
demarcation.
The test is now called test-ob/demarcate-block and I tried to make
it more robust.
>
>> + (let* ((_start (org-babel-where-is-src-block-head))
>
> Are you using (org-babel-where-is-src-block-head) for side effect of
> modifying the match data? If so, please do it outside let, with
> appropriate comment.
This was based on my misunderstanding of `org-babel-get-src-block-info'
and has been removed.
>
>> + (if (not org-adapt-indentation)
>> + ;; Move point to the left of the lower block line
>> #+begin_src.
>> + (org-previous-block 1)
>> + ;; Adapt the indentation: upper block first and lower
>> block second.
>> + (org-previous-block 2)
>> + (org-indent-block)
>> + ;; Move point to the left of the lower block line
>> #+begin_src.
>> + (org-next-block 1)
>> + (org-indent-block)))
>
> `org-indent-block' should honor `org-adapt-indentation'. You do not
> need
> to call it conditionally. Re-indenting unconditionally should be better
> here.
OK. I have always used `org-adapt-indentation' set to nil and I do not
like
the result of `org-indent-block' when it is non-nil (#+begin_src and
#+end_src
indented and the code pushed to the left), but I will have to get used
to it.
Tests using `org-adapt-indention' non-nil are part of
`test-ob/demarcate-block'.
>
>> (let ((start (point))
>> - (lang (or (car info) ; Reuse language from previous block.
>> - (completing-read
>> - "Lang: "
>> - (mapcar #'symbol-name
>> - (delete-dups
>> - (append (mapcar #'car org-babel-load-languages)
>> - (mapcar (lambda (el) (intern (car el)))
>> - org-src-lang-modes)))))))
>> + ;; (org-babel-get-src-block-info 'no-eval) returns nil,
>> + ;; since there is no source block at point. Therefore,
>> this
>> + ;; cannot be used to get the language of a neighbour
>> block.
>
> Why nil? The condition was
>
> (and info start) ;; At src block, but not within blank lines after
> it.
>
> So, this branch of the if used to be INFO - non-nil, and START nil ->
> re-use the information. And if INFO were nil, query.
>
This was based on my misunderstanding of `org-babel-get-src-block-info'
and has been reverted.
>
>> + ;; Deleted code indicated that this may have worked in
>> the past.
>> + ;; I have removed upper-case-p, since it could never be
>> true here.
>
> The idea of UPPER-CASE-P is to keep user preference for keyword style
> (upper case or lower case). There is no reason to remove this feature.
> Although, since we are using `org-element-interpret-data', it might be
> a
> good idea to extend org-element parser to preserve the keyword case
> information.
This was based on my misunderstanding of `org-babel-get-src-block-info'
and has been removed.
Regards -- Gerard
[-- Attachment #2: 0001-org-babel-demarcate-block-split-using-element-API.patch --]
[-- Type: application/octet-stream, Size: 14140 bytes --]
From 18ee837796039d577df5b38cc0624c36775b5867 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 | 63 ++++++++--------
testing/lisp/test-ob.el | 160 ++++++++++++++++++++++++++++++++++++++++
2 files changed, 194 insertions(+), 29 deletions(-)
diff --git a/lisp/ob-core.el b/lisp/ob-core.el
index 1de3af6ad..3d2b035b2 100644
--- a/lisp/ob-core.el
+++ b/lisp/ob-core.el
@@ -1,6 +1,6 @@
;;; ob-core.el --- Working with Code Blocks -*- lexical-binding: t; -*-
-;; Copyright (C) 2009-2024 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2023 Free Software Foundation, Inc.
;; Authors: Eric Schulte
;; Dan Davison
@@ -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 or not within blank
+lines after a 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))
+ #'<)))
+ ;; Prevent #+caption:, #+header:, and #+begin_src lines in block.
+ (unless (and (>= (point) body-beg))
+ (user-error "move point 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)
+ (deactivate-mark)
+ ;; 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)
+ ;; 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") ""))
+ (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..b6a3dbf73 100644
--- a/testing/lisp/test-ob.el
+++ b/testing/lisp/test-ob.el
@@ -26,6 +26,166 @@
(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.
+ (org-test-with-temp-text "
+#+header: :var edge=\"also duplicated\"
+#+header: :wrap \"src any-spanish -n\"
+#+begin_src any-english -i -n :var here=\"duplicated\" :wrap \"src any-english -n\"
+
+above split
+<point>
+below split
+
+#+end_src
+"
+ (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)))))
+ ;; 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)
+ (message "%s" (buffer-substring (point-min) (point-max)))
+ (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"))
+ (message "regexp: %s" regexp)
+ (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
^ permalink raw reply related [flat|nested] 41+ messages in thread
* Re: [PATCH] org-babel-demarcate-block: split using element API
2024-01-07 18:49 ` [PATCH] org-babel-demarcate-block: split using element API gerard.vermeulen
@ 2024-01-08 12:08 ` Ihor Radchenko
2024-01-08 20:25 ` gerard.vermeulen
0 siblings, 1 reply; 41+ messages in thread
From: Ihor Radchenko @ 2024-01-08 12:08 UTC (permalink / raw)
To: gerard.vermeulen; +Cc: Emacs orgmode
gerard.vermeulen@posteo.net writes:
> On 04.01.2024 15:43, Ihor Radchenko wrote:
>> gerard.vermeulen@posteo.net writes:
>>
> Attached you'll find a new version of the patch that addresses your
> comments. I have modified the ERT test so that it checks most of
> your examples showing where the older versions of the patch failed.
> The test is now called `test-ob/demarcate-block'
Thanks!
I've tested your patch and found two problems:
1. #+name: lines are duplicated, while they should not
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.
> Below, I compare region splitting using main or my patch. White-space
> differs between main and the patch and one might argue that the result
> produced by the patch is more consistent.
Agree.
> 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.
> 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.
>> `org-indent-block' should honor `org-adapt-indentation'. You do not
>> need
>> to call it conditionally. Re-indenting unconditionally should be better
>> here.
> OK. I have always used `org-adapt-indentation' set to nil and I do not
> like
> the result of `org-indent-block' when it is non-nil (#+begin_src and
> #+end_src
> indented and the code pushed to the left), but I will have to get used
> to it.
Note that indentation of src blocks has been refactored recently on
main. It should be more reliable now. If not, please report any issues.
> -;; Copyright (C) 2009-2024 Free Software Foundation, Inc.
> +;; Copyright (C) 2009-2023 Free Software Foundation, Inc.
This is a spurious change :)
> -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.
> + (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?
And we need to remove #+name lines.
> + (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).
> + (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.
--
Ihor Radchenko // yantar92,
Org mode contributor,
Learn more about Org mode at <https://orgmode.org/>.
Support Org development at <https://liberapay.com/org-mode>,
or support my work at <https://liberapay.com/yantar92>
^ permalink raw reply [flat|nested] 41+ messages in thread
* Re: [PATCH] org-babel-demarcate-block: split using element API
2024-01-08 12:08 ` Ihor Radchenko
@ 2024-01-08 20:25 ` gerard.vermeulen
2024-01-09 7:49 ` gerard.vermeulen
0 siblings, 1 reply; 41+ messages in thread
From: gerard.vermeulen @ 2024-01-08 20:25 UTC (permalink / raw)
To: Ihor Radchenko; +Cc: Emacs orgmode
[-- 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
^ permalink raw reply related [flat|nested] 41+ messages in thread
* Re: [PATCH] org-babel-demarcate-block: split using element API
2024-01-08 20:25 ` gerard.vermeulen
@ 2024-01-09 7:49 ` gerard.vermeulen
2024-01-09 10:50 ` gerard.vermeulen
0 siblings, 1 reply; 41+ messages in thread
From: gerard.vermeulen @ 2024-01-09 7:49 UTC (permalink / raw)
To: Ihor Radchenko
Cc: Emacs orgmode, emacs-orgmode-bounces+gerard.vermeulen=posteo.net
On 08.01.2024 21:25, gerard.vermeulen@posteo.net wrote:
> On 08.01.2024 13:08, Ihor Radchenko wrote:
>> gerard.vermeulen@posteo.net writes:
[...]
> 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
>
It occurred to me to that I only should set mark to point when the
region is
not active. I will add checking for `user-error's to the ERT test.
Regards -- Gerard
^ permalink raw reply [flat|nested] 41+ messages in thread
* Re: [PATCH] org-babel-demarcate-block: split using element API
2024-01-09 7:49 ` gerard.vermeulen
@ 2024-01-09 10:50 ` gerard.vermeulen
2024-01-09 14:49 ` Ihor Radchenko
0 siblings, 1 reply; 41+ messages in thread
From: gerard.vermeulen @ 2024-01-09 10:50 UTC (permalink / raw)
To: Ihor Radchenko
Cc: Emacs orgmode, emacs-orgmode-bounces+gerard.vermeulen=posteo.net
[-- Attachment #1: Type: text/plain, Size: 765 bytes --]
On 09.01.2024 08:49, gerard.vermeulen@posteo.net wrote:
[...]
>> 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
>>
> It occurred to me to that I only should set mark to point when the
> region is
> not active. I will add checking for `user-error's to the ERT test.
>
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.
Regards -- Gerard
[-- Attachment #2: 0001-org-babel-demarcate-block-split-using-element-API.patch --]
[-- Type: application/octet-stream, Size: 16080 bytes --]
From 347c07525c19f3fa2aa1fccdf31b5c152139015b 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 | 63 ++++++------
testing/lisp/test-ob.el | 212 ++++++++++++++++++++++++++++++++++++++++
2 files changed, 247 insertions(+), 28 deletions(-)
diff --git a/lisp/ob-core.el b/lisp/ob-core.el
index 1de3af6ad..4de82e7a3 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,46 @@ 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))
+ #'<)))
+ ;; To simplify the (unless ... (user-error ...)).
+ (unless (org-region-active-p) (set-mark (point)))
+ ;; 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"))
+ (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..2597f7037 100644
--- a/testing/lisp/test-ob.el
+++ b/testing/lisp/test-ob.el
@@ -26,6 +26,218 @@
(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 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)
+ (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))))))
+ ;; 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
^ permalink raw reply related [flat|nested] 41+ messages in thread
* Re: [PATCH] org-babel-demarcate-block: split using element API
2024-01-09 10:50 ` gerard.vermeulen
@ 2024-01-09 14:49 ` Ihor Radchenko
2024-01-13 14:04 ` gerard.vermeulen
0 siblings, 1 reply; 41+ messages in thread
From: Ihor Radchenko @ 2024-01-09 14:49 UTC (permalink / raw)
To: gerard.vermeulen
Cc: Emacs orgmode, emacs-orgmode-bounces+gerard.vermeulen=posteo.net
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.
--------------------
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.
> * 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.
> + ;; 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 ...))
--
Ihor Radchenko // yantar92,
Org mode contributor,
Learn more about Org mode at <https://orgmode.org/>.
Support Org development at <https://liberapay.com/org-mode>,
or support my work at <https://liberapay.com/yantar92>
^ permalink raw reply [flat|nested] 41+ messages in thread
* Re: [PATCH] org-babel-demarcate-block: split using element API
2024-01-09 14:49 ` Ihor Radchenko
@ 2024-01-13 14:04 ` gerard.vermeulen
2024-01-13 15:17 ` Ihor Radchenko
0 siblings, 1 reply; 41+ messages in thread
From: gerard.vermeulen @ 2024-01-13 14:04 UTC (permalink / raw)
To: Ihor Radchenko
Cc: Emacs orgmode, emacs-orgmode-bounces+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
^ permalink raw reply related [flat|nested] 41+ messages in thread
* Re: [PATCH] org-babel-demarcate-block: split using element API
2024-01-13 14:04 ` gerard.vermeulen
@ 2024-01-13 15:17 ` Ihor Radchenko
2024-01-13 20:16 ` gerard.vermeulen
0 siblings, 1 reply; 41+ messages in thread
From: Ihor Radchenko @ 2024-01-13 15:17 UTC (permalink / raw)
To: gerard.vermeulen
Cc: Emacs orgmode, emacs-orgmode-bounces+gerard.vermeulen=posteo.net
gerard.vermeulen@posteo.net writes:
> Attached you'll find a new patch addressing all you issues.
Thanks!
I tried to run make test, and I am getting
FAILED test-ob/demarcate-block ((should (string= region-text (org-trim (nth 1 info)))) :form (string= "mark this line as region" "") :value nil :explanation (arrays-of-different-length 24 0 "mark this line as region" "" first-mismatch-at 0))
--
Ihor Radchenko // yantar92,
Org mode contributor,
Learn more about Org mode at <https://orgmode.org/>.
Support Org development at <https://liberapay.com/org-mode>,
or support my work at <https://liberapay.com/yantar92>
^ permalink raw reply [flat|nested] 41+ messages in thread
* Re: [PATCH] org-babel-demarcate-block: split using element API
2024-01-13 15:17 ` Ihor Radchenko
@ 2024-01-13 20:16 ` gerard.vermeulen
2024-01-14 10:53 ` gerard.vermeulen
0 siblings, 1 reply; 41+ messages in thread
From: gerard.vermeulen @ 2024-01-13 20:16 UTC (permalink / raw)
To: Ihor Radchenko
Cc: Emacs orgmode, emacs-orgmode-bounces+gerard.vermeulen=posteo.net
[-- Attachment #1: Type: text/plain, Size: 2164 bytes --]
On 13.01.2024 16:17, Ihor Radchenko wrote:
> gerard.vermeulen@posteo.net writes:
>
>> Attached you'll find a new patch addressing all you issues.
>
> Thanks!
> I tried to run make test, and I am getting
> FAILED test-ob/demarcate-block ((should (string= region-text
> (org-trim (nth 1 info)))) :form (string= "mark this line as region"
> "") :value nil :explanation (arrays-of-different-length 24 0 "mark
> this line as region" "" first-mismatch-at 0))
I have improved a regexp used to mark a region in this sub-test
improving the robustness of the code.
Furthermore, I have replaced all occurrences of (set-mark (point))
with (set-mark-command nil), but I doubt that this is the reason.
Nevertheless, I feel I need to point out the limitation of this
particular
test case.
Prerequisites:
#+begin_src emacs-lisp :results silent
(setopt org-adapt-indentation t
org-edit-src-content-indentation 2
org-src-preserve-indentation nil)
#+end_src
When I mark really the line containing "mark this line as region"
C-u C-C C-v C-d works nicely (done in the sub-test).
********** 10 stars with region between two lines
#+header: :var b="also seen"
#+begin_src any-language -i -n :var a="seen"
to upper block
mark this line as region
to lower block
#+end_src
but C-u C-c C-v C-d after marking ' this line as ' produces this:
********** 10 stars with region between two lines
#+header: :var b="also seen"
#+begin_src any-language -i -n :var a="seen"
to upper block
mark
#+end_src
**********
#+header: :var b="also seen"
#+begin_src any-language -i -n :var a="seen"
this line as
#+end_src
**********
#+header: :var b="also seen"
#+begin_src any-language -i -n :var a="seen"
region
to lower block
#+end_src
The text after (mark) and (point) is misaligned.
I tend to mark regions in a way that is compatible with the patch,
but some users won't (maybe they are willing to adapt).
Patch attached.
Regards -- Gerard
[-- Attachment #2: 0001-org-babel-demarcate-block-split-using-element-API.patch --]
[-- Type: application/octet-stream, Size: 18071 bytes --]
From b08b5be2a767cebfdb68f1d17ec57cc917830597 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..5b5afeeb1 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-command nil)
+ (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 (format "[ \t]+%s" (nth 1 parts)))
+ (set-mark-command nil)
+ (goto-char (match-beginning 0))
+ (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))
+ (goto-char (match-beginning 0))
+ (set-mark-command nil)
+ ;; 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
^ permalink raw reply related [flat|nested] 41+ messages in thread
* Re: [PATCH] org-babel-demarcate-block: split using element API
2024-01-13 20:16 ` gerard.vermeulen
@ 2024-01-14 10:53 ` gerard.vermeulen
2024-01-14 12:16 ` Ihor Radchenko
0 siblings, 1 reply; 41+ messages in thread
From: gerard.vermeulen @ 2024-01-14 10:53 UTC (permalink / raw)
To: Ihor Radchenko
Cc: Emacs orgmode, emacs-orgmode-bounces+gerard.vermeulen=posteo.net
[-- Attachment #1: Type: text/plain, Size: 1536 bytes --]
On 13.01.2024 21:16, gerard.vermeulen@posteo.net wrote:
> On 13.01.2024 16:17, Ihor Radchenko wrote:
>> gerard.vermeulen@posteo.net writes:
>>
>>> Attached you'll find a new patch addressing all you issues.
>>
>> Thanks!
>> I tried to run make test, and I am getting
>> FAILED test-ob/demarcate-block ((should (string= region-text
>> (org-trim (nth 1 info)))) :form (string= "mark this line as region"
>> "") :value nil :explanation (arrays-of-different-length 24 0 "mark
>> this line as region" "" first-mismatch-at 0))
>
> I have improved a regexp used to mark a region in this sub-test
> improving the robustness of the code.
> Furthermore, I have replaced all occurrences of (set-mark (point))
> with (set-mark-command nil), but I doubt that this is the reason.
>
> Nevertheless, I feel I need to point out the limitation of this
> particular
> test case.
>
[...]
> The text after (mark) and (point) is misaligned.
> I tend to mark regions in a way that is compatible with the patch,
> but some users won't (maybe they are willing to adapt).
>
> Patch attached.
>
I found a way to preserve the (current-column) of text after point and
mark in the element API code so that point or region splitting behaves
like main where the (current-column)'s remain preserved naturally.
I think this is preferable with respect to the previous patch (at least
it does not break the expectations of current users).
It allowed a minor simplification of the sub-test that failed in your
case.
New patch attached.
Regards -- Gerard
[-- Attachment #2: 0001-org-babel-demarcate-block-split-using-element-API.patch --]
[-- Type: application/octet-stream, Size: 18975 bytes --]
From da41e526ecc2e902461a292545c19a18c8f1c5ae 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. Take care to preserve (current-column) of text
after point (and mark) in the 2nd (and 3rd) 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 | 94 ++++++++++++-----
testing/lisp/test-ob.el | 223 ++++++++++++++++++++++++++++++++++++++++
2 files changed, 289 insertions(+), 28 deletions(-)
diff --git a/lisp/ob-core.el b/lisp/ob-core.el
index 1de3af6ad..e200f82c0 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,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..95dc444f9 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-command nil)
+ (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 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
+ %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-command nil)
+ (goto-char (match-beginning 0))
+ (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))
+ (goto-char (match-beginning 0))
+ (set-mark-command nil)
+ ;; 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
^ permalink raw reply related [flat|nested] 41+ messages in thread
* Re: [PATCH] org-babel-demarcate-block: split using element API
2024-01-14 10:53 ` gerard.vermeulen
@ 2024-01-14 12:16 ` Ihor Radchenko
2024-01-14 19:18 ` gerard.vermeulen
0 siblings, 1 reply; 41+ messages in thread
From: Ihor Radchenko @ 2024-01-14 12:16 UTC (permalink / raw)
To: gerard.vermeulen
Cc: Emacs orgmode, emacs-orgmode-bounces+gerard.vermeulen=posteo.net
gerard.vermeulen@posteo.net writes:
> New patch attached.
I tried make test and the tests are still failing with this new patch:
1 unexpected results:
FAILED test-ob/demarcate-block ((should (string= region-text (org-trim (nth 1 info)))) :form (string= "mark this line as region" "") :value nil :explanation (arrays-of-different-length 24 0 "mark this line as region" "" first-mismatch-at 0))
--
Ihor Radchenko // yantar92,
Org mode contributor,
Learn more about Org mode at <https://orgmode.org/>.
Support Org development at <https://liberapay.com/org-mode>,
or support my work at <https://liberapay.com/yantar92>
^ permalink raw reply [flat|nested] 41+ messages in thread
* Re: [PATCH] org-babel-demarcate-block: split using element API
2024-01-14 12:16 ` Ihor Radchenko
@ 2024-01-14 19:18 ` gerard.vermeulen
2024-01-15 9:37 ` gerard.vermeulen
0 siblings, 1 reply; 41+ messages in thread
From: gerard.vermeulen @ 2024-01-14 19:18 UTC (permalink / raw)
To: Ihor Radchenko
Cc: Emacs orgmode, emacs-orgmode-bounces+gerard.vermeulen=posteo.net
[-- Attachment #1: Type: text/plain, Size: 1411 bytes --]
On 14.01.2024 13:16, Ihor Radchenko wrote:
> gerard.vermeulen@posteo.net writes:
[...]
> I tried make test and the tests are still failing with this new patch:
>
> 1 unexpected results:
> FAILED test-ob/demarcate-block ((should (string= region-text
> (org-trim (nth 1 info)))) :form (string= "mark this line as region"
> "") :value nil :explanation (arrays-of-different-length 24 0 "mark
> this line as region" "" first-mismatch-at 0))
This is a tough lesson: the tests pass always on my system.
I think the failure you see is related to a problem marking a region
in my test code (wish: support in `org-test-with-temp-text' for
"<mark>" besides "<point>", but maybe that depends on ERT), else
the problem would have shown up while testing the patch interactively.
I think that I have improved my region marking code by using "<point>"
in the temp-text as a start. Then, I only have to find where to set
mark,
and eventually exchange point and mark.
The test code now checks (mark) in the 3 places where a region is
marked.
This looks superfluous if the code is really robust, but at least it
checks
whether the region marking is (or was) the problem.
New patch attached.
Some of the scaffolding (should ...) forms could be removed if
the 5 sub-test in test-ob/demarcate-block would be 5 separated
ERT tests. I prefer to continue like this and do eventual refactoring
later.
Regards -- Gerard
[-- Attachment #2: 0001-org-babel-demarcate-block-split-using-element-API.patch --]
[-- Type: application/octet-stream, Size: 19080 bytes --]
From 829d99fa58ba91933ef9e6b84ea59c19ae916b29 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. Take care to preserve (current-column) of text
after point (and mark) in the 2nd (and 3rd) 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 | 94 ++++++++++++-----
testing/lisp/test-ob.el | 225 ++++++++++++++++++++++++++++++++++++++++
2 files changed, 291 insertions(+), 28 deletions(-)
diff --git a/lisp/ob-core.el b/lisp/ob-core.el
index 1de3af6ad..e200f82c0 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,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..19dbc4231 100644
--- a/testing/lisp/test-ob.el
+++ b/testing/lisp/test-ob.el
@@ -26,6 +26,231 @@
(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 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)
+ (set-mark-command nil)
+ (search-forward region-text)
+ (exchange-point-and-mark)
+ ;; Check (mark).
+ (should (string= region-text
+ (buffer-substring
+ (- (mark) (length region-text)) (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))))))
+ ;; 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 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)
+ (set-mark-command nil)
+ (search-forward (nth 1 parts))
+ (exchange-point-and-mark)
+ ;; Check (mark).
+ (should (string= (nth 1 parts)
+ (buffer-substring
+ (- (mark) (length (nth 1 parts))) (mark))))
+ (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.")
+ (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 "")
+ ;; 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
+ (format template "" caption within-body below-block "<point>")
+ ;; Set mark.
+ (set-mark-command nil)
+ ;; Check (mark).
+ (should (string= below-block
+ (buffer-substring
+ (- (mark) (length below-block)) (mark))))
+ ;; Set point.
+ (should (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
^ permalink raw reply related [flat|nested] 41+ messages in thread
* Re: [PATCH] org-babel-demarcate-block: split using element API
2024-01-14 19:18 ` gerard.vermeulen
@ 2024-01-15 9:37 ` gerard.vermeulen
2024-01-16 13:34 ` Ihor Radchenko
0 siblings, 1 reply; 41+ messages in thread
From: gerard.vermeulen @ 2024-01-15 9:37 UTC (permalink / raw)
To: Ihor Radchenko
Cc: Emacs orgmode, emacs-orgmode-bounces+gerard.vermeulen=posteo.net
[-- Attachment #1: Type: text/plain, Size: 1697 bytes --]
On 14.01.2024 20:18, gerard.vermeulen@posteo.net wrote:
> On 14.01.2024 13:16, Ihor Radchenko wrote:
>> gerard.vermeulen@posteo.net writes:
> [...]
>> I tried make test and the tests are still failing with this new patch:
>>
>> 1 unexpected results:
>> FAILED test-ob/demarcate-block ((should (string= region-text
>> (org-trim (nth 1 info)))) :form (string= "mark this line as region"
>> "") :value nil :explanation (arrays-of-different-length 24 0 "mark
>> this line as region" "" first-mismatch-at 0))
>
> This is a tough lesson: the tests pass always on my system.
>
> I think the failure you see is related to a problem marking a region
> in my test code (wish: support in `org-test-with-temp-text' for
> "<mark>" besides "<point>", but maybe that depends on ERT), else
> the problem would have shown up while testing the patch interactively.
>
> I think that I have improved my region marking code by using "<point>"
> in the temp-text as a start. Then, I only have to find where to set
> mark,
> and eventually exchange point and mark.
>
> The test code now checks (mark) in the 3 places where a region is
> marked.
> This looks superfluous if the code is really robust, but at least it
> checks
> whether the region marking is (or was) the problem.
>
To converge faster, I have split the test into 6 tests:
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
The test failure on your system was due to the sub-test that is now
test-ob/demarcate-block-wrap-region
Regards -- Gerard
[-- Attachment #2: 0001-org-babel-demarcate-block-split-using-element-API.patch --]
[-- Type: application/octet-stream, Size: 19672 bytes --]
From fa161b3793a210961aceb5f7c7d0ddc8efb0aa52 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. Take care to preserve (current-column) of text
after point (and mark) in the 2nd (and 3rd) 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.
Link: https://list.orgmode.org/87ply6nyue.fsf@localhost/
---
lisp/ob-core.el | 94 +++++++++++-----
testing/lisp/test-ob.el | 238 ++++++++++++++++++++++++++++++++++++++++
2 files changed, 304 insertions(+), 28 deletions(-)
diff --git a/lisp/ob-core.el b/lisp/ob-core.el
index 1de3af6ad..e200f82c0 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,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..0766fd2e2 100644
--- a/testing/lisp/test-ob.el
+++ b/testing/lisp/test-ob.el
@@ -2545,6 +2545,244 @@ abc
(lambda (&rest _) (error "No warnings should occur"))))
(org-babel-import-elisp-from-file (buffer-file-name))))))
+(ert-deftest test-ob/demarcate-block-split-duplicatigon ()
+ "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)
+ (set-mark-command nil)
+ (search-forward (nth 1 parts))
+ (exchange-point-and-mark)
+ ;; Check (mark).
+ (should (string= (nth 1 parts)
+ (buffer-substring
+ (- (mark) (length (nth 1 parts))) (mark))))
+ (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 "")
+ ;; 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
+ (format template "" caption within-body below-block "<point>")
+ ;; Set mark.
+ (set-mark-command nil)
+ ;; Check (mark).
+ (should (string= below-block
+ (buffer-substring
+ (- (mark) (length below-block)) (mark))))
+ ;; Set point.
+ (should (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/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)
+ (set-mark-command nil)
+ (search-forward region-text)
+ (exchange-point-and-mark)
+ ;; Check (mark).
+ (should (string= region-text
+ (buffer-substring
+ (- (mark) (length region-text)) (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
^ permalink raw reply related [flat|nested] 41+ messages in thread
* Re: [PATCH] org-babel-demarcate-block: split using element API
2024-01-15 9:37 ` gerard.vermeulen
@ 2024-01-16 13:34 ` Ihor Radchenko
2024-02-19 9:46 ` Ihor Radchenko
0 siblings, 1 reply; 41+ messages in thread
From: Ihor Radchenko @ 2024-01-16 13:34 UTC (permalink / raw)
To: gerard.vermeulen
Cc: Emacs orgmode, emacs-orgmode-bounces+gerard.vermeulen=posteo.net
gerard.vermeulen@posteo.net writes:
>>> 1 unexpected results:
>>> FAILED test-ob/demarcate-block ((should (string= region-text
>>> (org-trim (nth 1 info)))) :form (string= "mark this line as region"
>>> "") :value nil :explanation (arrays-of-different-length 24 0 "mark
>>> this line as region" "" first-mismatch-at 0))
>>
>> This is a tough lesson: the tests pass always on my system.
>>
>> I think the failure you see is related to a problem marking a region
>> in my test code (wish: support in `org-test-with-temp-text' for
>> "<mark>" besides "<point>", but maybe that depends on ERT), else
>> the problem would have shown up while testing the patch interactively.
>>
>> I think that I have improved my region marking code by using "<point>"
>> in the temp-text as a start. Then, I only have to find where to set
>> mark,
>> and eventually exchange point and mark.
Still failing on my side (when running tests non-interactively from
command line). To fix the problem, please use the approach from
`test-org-list/indent-item':
(transient-mark-mode 1)
(push-mark (point) t t)
Instead of (set-mark-command nil)
> + ;; Map positions to columns for white-space padding.
> + (setq pads (mapcar (lambda (p) (save-excursion
> + (goto-char p)
> + (current-column)))
> + pads))
This will break when the region does not start near the beginning of
line or does not end there:
#+begin_src emacs-lisp
<mark>'(1 2 3)
'(1 2 <point>3)
#+end_src
Also, the indentation of source code inside src block should not be used
to indent the whole block. This is because it may be additionally
indented according to `org-edit-src-content-indentation'. If you want to
preserve the original indentation, just use
`org-current-text-indentation' at the beginning of the src block.
--
Ihor Radchenko // yantar92,
Org mode contributor,
Learn more about Org mode at <https://orgmode.org/>.
Support Org development at <https://liberapay.com/org-mode>,
or support my work at <https://liberapay.com/yantar92>
^ permalink raw reply [flat|nested] 41+ messages in thread
* Re: [PATCH] org-babel-demarcate-block: split using element API
2024-01-16 13:34 ` Ihor Radchenko
@ 2024-02-19 9:46 ` Ihor Radchenko
2024-02-19 13:01 ` gerard.vermeulen
0 siblings, 1 reply; 41+ messages in thread
From: Ihor Radchenko @ 2024-02-19 9:46 UTC (permalink / raw)
To: gerard.vermeulen
Cc: Emacs orgmode, emacs-orgmode-bounces+gerard.vermeulen=posteo.net
Ihor Radchenko <yantar92@posteo.net> writes:
> gerard.vermeulen@posteo.net writes:
>
>>> I think that I have improved my region marking code by using "<point>"
>>> in the temp-text as a start. Then, I only have to find where to set
>>> mark,
>>> and eventually exchange point and mark.
>
> Still failing on my side (when running tests non-interactively from
> command line). To fix the problem, please use the approach from
> `test-org-list/indent-item':
>
> (transient-mark-mode 1)
> (push-mark (point) t t)
>
> Instead of (set-mark-command nil)
Gerard, may I know if you had a chance to look into my comments?
--
Ihor Radchenko // yantar92,
Org mode contributor,
Learn more about Org mode at <https://orgmode.org/>.
Support Org development at <https://liberapay.com/org-mode>,
or support my work at <https://liberapay.com/yantar92>
^ permalink raw reply [flat|nested] 41+ messages in thread
* Re: [PATCH] org-babel-demarcate-block: split using element API
2024-02-19 9:46 ` Ihor Radchenko
@ 2024-02-19 13:01 ` gerard.vermeulen
2024-02-21 9:40 ` Ihor Radchenko
0 siblings, 1 reply; 41+ messages in thread
From: gerard.vermeulen @ 2024-02-19 13:01 UTC (permalink / raw)
To: Ihor Radchenko
Cc: Emacs orgmode, emacs-orgmode-bounces+gerard.vermeulen=posteo.net
On 19.02.2024 10:46, Ihor Radchenko wrote:
> Ihor Radchenko <yantar92@posteo.net> writes:
>
>> gerard.vermeulen@posteo.net writes:
>>
>>>> I think that I have improved my region marking code by using
>>>> "<point>"
>>>> in the temp-text as a start. Then, I only have to find where to set
>>>> mark,
>>>> and eventually exchange point and mark.
>>
>> Still failing on my side (when running tests non-interactively from
>> command line). To fix the problem, please use the approach from
>> `test-org-list/indent-item':
>>
>> (transient-mark-mode 1)
>> (push-mark (point) t t)
>>
>> Instead of (set-mark-command nil)
>
> Gerard, may I know if you had a chance to look into my comments?
I think that I have addressed this particular comment.
However, I am confused by your comments concerning this example
#+begin_src emacs-lisp
<mark>'(1 2 3)
'(1 2 <point>3)
#+end_src
since it breaks my patch as well as main in the sense that such examples
can generate three blocks with invalid code.
I think there is in general no way to protect a user against bad
selections
for splitting by demarcation.
Secondly, I see (saw) sometimes Org emitting warnings with backtraces
starting from my patch. I think the warning may be due either to a
mistake
on my side or a bug in Org, but I am not sure.
Regards -- Gerard
^ permalink raw reply [flat|nested] 41+ messages in thread
* Re: [PATCH] org-babel-demarcate-block: split using element API
2024-02-19 13:01 ` gerard.vermeulen
@ 2024-02-21 9:40 ` Ihor Radchenko
2024-02-21 18:19 ` gerard.vermeulen
0 siblings, 1 reply; 41+ messages in thread
From: Ihor Radchenko @ 2024-02-21 9:40 UTC (permalink / raw)
To: gerard.vermeulen
Cc: Emacs orgmode, emacs-orgmode-bounces+gerard.vermeulen=posteo.net
[-- Attachment #1: Type: text/plain, Size: 1174 bytes --]
gerard.vermeulen@posteo.net writes:
>>> Still failing on my side (when running tests non-interactively from
>>> command line). To fix the problem, please use the approach from
>>> `test-org-list/indent-item':
>>>
>>> (transient-mark-mode 1)
>>> (push-mark (point) t t)
>>>
>>> Instead of (set-mark-command nil)
>>
>> Gerard, may I know if you had a chance to look into my comments?
>
> I think that I have addressed this particular comment.
Not really.
In any case, see the attached updated patch with my suggestion
incorporated.
> However, I am confused by your comments concerning this example
> #+begin_src emacs-lisp
> <mark>'(1 2 3)
> '(1 2 <point>3)
> #+end_src
> since it breaks my patch as well as main in the sense that such examples
> can generate three blocks with invalid code.
> I think there is in general no way to protect a user against bad
> selections
> for splitting by demarcation.
Fair.
> Secondly, I see (saw) sometimes Org emitting warnings with backtraces
> starting from my patch. I think the warning may be due either to a
> mistake
> on my side or a bug in Org, but I am not sure.
May you please provide more details?
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-org-babel-demarcate-block-split-using-element-API.patch --]
[-- Type: text/x-patch, Size: 19909 bytes --]
From dc71a916c829e979c0728f95bfefe54b1cfa3887 Mon Sep 17 00:00:00 2001
Message-ID: <dc71a916c829e979c0728f95bfefe54b1cfa3887.1708508366.git.yantar92@posteo.net>
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. Take care to preserve (current-column) of text
after point (and mark) in the 2nd (and 3rd) 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.
Link: https://list.orgmode.org/87ply6nyue.fsf@localhost/
---
lisp/ob-core.el | 94 +++++++++++-----
testing/lisp/test-ob.el | 241 ++++++++++++++++++++++++++++++++++++++++
2 files changed, 307 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-contents-end "org-element" (node))
(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 @@ (defun org-babel-get-src-block-info (&optional no-eval datum)
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 @@ (defun org-babel-mark-block ()
(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 @@ (defun org-babel-demarcate-block (&optional arg)
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..0ecc8810a 100644
--- a/testing/lisp/test-ob.el
+++ b/testing/lisp/test-ob.el
@@ -2545,6 +2545,247 @@ (ert-deftest test-ob/import-elisp-from-file ()
(lambda (&rest _) (error "No warnings should occur"))))
(org-babel-import-elisp-from-file (buffer-file-name))))))
+(ert-deftest test-ob/demarcate-block-split-duplicatigon ()
+ "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))
+ (exchange-point-and-mark)
+ ;; Check (mark).
+ (should (string= (nth 1 parts)
+ (buffer-substring
+ (- (mark) (length (nth 1 parts))) (mark))))
+ (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 "")
+ ;; 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
+ (format template "" caption within-body below-block "<point>")
+ ;; Set mark.
+ (transient-mark-mode 1)
+ (push-mark (point) t t)
+ ;; Check (mark).
+ (should (string= below-block
+ (buffer-substring
+ (- (mark) (length below-block)) (mark))))
+ ;; Set point.
+ (should (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/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)
+ ;; Check (mark).
+ (should (string= region-text
+ (buffer-substring
+ (- (mark) (length region-text)) (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.43.0
[-- Attachment #3: Type: text/plain, Size: 224 bytes --]
--
Ihor Radchenko // yantar92,
Org mode contributor,
Learn more about Org mode at <https://orgmode.org/>.
Support Org development at <https://liberapay.com/org-mode>,
or support my work at <https://liberapay.com/yantar92>
^ permalink raw reply related [flat|nested] 41+ messages in thread
* Re: [PATCH] org-babel-demarcate-block: split using element API
2024-02-21 9:40 ` Ihor Radchenko
@ 2024-02-21 18:19 ` gerard.vermeulen
2024-02-22 16:28 ` gerard.vermeulen
0 siblings, 1 reply; 41+ messages in thread
From: gerard.vermeulen @ 2024-02-21 18:19 UTC (permalink / raw)
To: Ihor Radchenko
Cc: Emacs orgmode, emacs-orgmode-bounces+gerard.vermeulen=posteo.net
On 21.02.2024 10:40, Ihor Radchenko wrote:
> gerard.vermeulen@posteo.net writes:
>
>>>> Still failing on my side (when running tests non-interactively from
>>>> command line). To fix the problem, please use the approach from
>>>> `test-org-list/indent-item':
>>>>
>>>> (transient-mark-mode 1)
>>>> (push-mark (point) t t)
>>>>
>>>> Instead of (set-mark-command nil)
>>>
>>> Gerard, may I know if you had a chance to look into my comments?
>>
>> I think that I have addressed this particular comment.
>
> Not really.
> In any case, see the attached updated patch with my suggestion
> incorporated.
>
Indeed, I did not address it. I also tried out your suggestion out this
morning
and saw that it makes "make test" pass.
>
[...]
>
>> Secondly, I see (saw) sometimes Org emitting warnings with backtraces
>> starting from my patch. I think the warning may be due either to a
>> mistake
>> on my side or a bug in Org, but I am not sure.
>
> May you please provide more details?
I fail to reproduce the warnings, but I think that I have seen (rx ... )
type warnings in the Emacs warnings buffer with the patched
org-babel-demarcate-block as backtrace entry point. I did not capture
those at the time, because I thought I could trigger those warnings
easily
which is not the case. This is Emacs-30.0.50.
I am sorry I cannot give more details.
How to proceed? Of course, I agree with your version of the patch
although I had started to remove some of the superfluous scaffolding
to know where point and mark are.
Regards -- Gerard
^ permalink raw reply [flat|nested] 41+ messages in thread
* Re: [PATCH] org-babel-demarcate-block: split using element API
2024-02-21 18:19 ` gerard.vermeulen
@ 2024-02-22 16:28 ` gerard.vermeulen
2024-02-23 13:43 ` Ihor Radchenko
0 siblings, 1 reply; 41+ messages in thread
From: gerard.vermeulen @ 2024-02-22 16:28 UTC (permalink / raw)
To: Ihor Radchenko
Cc: Emacs orgmode, emacs-orgmode-bounces+gerard.vermeulen=posteo.net
On 21.02.2024 19:19, gerard.vermeulen@posteo.net wrote:
> On 21.02.2024 10:40, Ihor Radchenko wrote:
>> gerard.vermeulen@posteo.net writes:
[...]
>> May you please provide more details?
>
This is different of what I saw before:
When splitting python blocks in an org file I got a long list of
warnings:
Warning (org-element): ‘org-element-at-point’ cannot be used in non-Org
buffer #<buffer *Org Src rpasyncio.org[ python ]*> (python-mode)
until it stopped by itself.
I traced this to user-errors in my own `org-babel-edit-prep:python'
which I
use to let eglot handle python source blocks.
I rewrote my `org-babel-edit-prep:python' to get rid of user-errors but
then I bumped on the user-error coming from
`org-src--make-source-overlay'.
I think that this may be the case for other definitions of
`org-babel-edit-prep:LANG'
I copy my `org-babel-edit-edit-prep:python' without user-errors below:
#+begin_src emacs-lisp -n :results silent
(with-eval-after-load 'emacs
(defcustom eglot-maybe-ensure-modes '(python-mode)
"Modes where maybe `eglot-ensure' should be or has been called.
This may be in the case of proper directory local variables or in
the case of proper `org-src-mode' buffers.")
;; https://www.reddit.com/r/emacs/comments/w4f4u3
;; /using_rustic_eglot_and_orgbabel_for_literate/
(defun eglot-org-babel-edit-prep (info)
"Try to setup an `org-mode-src' buffer to make `eglot-ensure'
succeed.
INFO has a form similar to the return value of
`org-babel-get-src-block-info'. Try to load the tangled file
into the `org-src-mode' buffer as well as to narrow the region to
the Org-mode source block code before calling `eglot-ensure'."
(when-let ((ok (bound-and-true-p org-src-mode))
(mark (point))
(body (nth 1 info))
(filename (cdr (assq :tangle (nth 2 info)))))
(when (string= filename "no")
(message "Org source block has no tangled file")
(setq ok nil))
(when ok
(setq filename (expand-file-name filename))
(unless (file-readable-p filename)
(message "Tangled file %s is not readable" filename)
(setq ok nil)))
(when ok
(with-temp-buffer
(insert-file-contents filename 'visit nil nil 'replace)
(unless (search-forward body nil 'noerror)
(message "Org source block does not occur in tangled file
%s"
filename)
(setq ok nil))
(when (search-forward body nil 'noerror)
(message "Org source block occurs twice or more in tangled
file %s"
filename)
(setq ok nil))))
(when ok
(goto-char (point-min))
(insert-file-contents filename 'visit nil nil 'replace)
(search-forward body)
(narrow-to-region (match-beginning 0) (match-end 0))
(goto-char mark)
(eglot-ensure))
;; (message "Buffer %s is no `org-src-mode' buffer" (buffer-name))
))
(defun org-babel-edit-prep:python (info)
(eglot-org-babel-edit-prep info)))
#+end_src
Regards -- Gerard
^ permalink raw reply [flat|nested] 41+ messages in thread
* Re: [PATCH] org-babel-demarcate-block: split using element API
2024-02-22 16:28 ` gerard.vermeulen
@ 2024-02-23 13:43 ` Ihor Radchenko
2024-02-25 12:06 ` gerard.vermeulen
0 siblings, 1 reply; 41+ messages in thread
From: Ihor Radchenko @ 2024-02-23 13:43 UTC (permalink / raw)
To: gerard.vermeulen
Cc: Emacs orgmode, emacs-orgmode-bounces+gerard.vermeulen=posteo.net
gerard.vermeulen@posteo.net writes:
>>> May you please provide more details?
>>
> This is different of what I saw before:
>
> When splitting python blocks in an org file I got a long list of
> warnings:
> Warning (org-element): ‘org-element-at-point’ cannot be used in non-Org
> buffer #<buffer *Org Src rpasyncio.org[ python ]*> (python-mode)
> until it stopped by itself.
>
> I traced this to user-errors in my own `org-babel-edit-prep:python'
> which I
> use to let eglot handle python source blocks.
>
> I rewrote my `org-babel-edit-prep:python' to get rid of user-errors but
> then I bumped on the user-error coming from
> `org-src--make-source-overlay'.
This is strange. `org-src--make-source-overlay' does not use
`org-element' API. I cannot see how you are getting such warnings from there.
--
Ihor Radchenko // yantar92,
Org mode contributor,
Learn more about Org mode at <https://orgmode.org/>.
Support Org development at <https://liberapay.com/org-mode>,
or support my work at <https://liberapay.com/yantar92>
^ permalink raw reply [flat|nested] 41+ messages in thread
* Re: [PATCH] org-babel-demarcate-block: split using element API
2024-02-23 13:43 ` Ihor Radchenko
@ 2024-02-25 12:06 ` gerard.vermeulen
2024-02-25 12:21 ` Ihor Radchenko
0 siblings, 1 reply; 41+ messages in thread
From: gerard.vermeulen @ 2024-02-25 12:06 UTC (permalink / raw)
To: Ihor Radchenko
Cc: Emacs orgmode, emacs-orgmode-bounces+gerard.vermeulen=posteo.net
[-- Attachment #1: Type: text/plain, Size: 925 bytes --]
On 23.02.2024 14:43, Ihor Radchenko wrote:
> gerard.vermeulen@posteo.net writes:
>
[...]
>>
>> I rewrote my `org-babel-edit-prep:python' to get rid of user-errors
>> but
>> then I bumped on the user-error coming from
>> `org-src--make-source-overlay'.
>
> This is strange. `org-src--make-source-overlay' does not use
> `org-element' API. I cannot see how you are getting such warnings from
> there.
I am using since a few days a clone of the mailed
`org-babel-edit-prep:python'
function (an irrelevant fix for setting point) and it works without
glitches.
I have no explanation of what happened.
I added the caveat:
This patch is incompatible with `org-babel-edit-prep:<LANG>' functions
that signal `user-error's.
to the commit message and cleaned it up a bit.
I also removed the scaffolding from the tests that checks where mark and
point are.
The tests pass with make test.
Patch attached.
Regards -- Gerard
[-- Attachment #2: 0001-org-babel-demarcate-block-split-using-element-API.patch --]
[-- Type: application/octet-stream, Size: 18844 bytes --]
From 41ec246168492088cb9e4d8737a4345c523a48e1 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.
This patch is incompatible with `org-babel-edit-prep:<LANG>' functions
that signal `user-error's.
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
^ permalink raw reply related [flat|nested] 41+ messages in thread
* Re: [PATCH] org-babel-demarcate-block: split using element API
2024-02-25 12:06 ` gerard.vermeulen
@ 2024-02-25 12:21 ` Ihor Radchenko
2024-02-26 8:51 ` gerard.vermeulen
2024-02-26 9:06 ` gerard.vermeulen
0 siblings, 2 replies; 41+ messages in thread
From: Ihor Radchenko @ 2024-02-25 12:21 UTC (permalink / raw)
To: gerard.vermeulen
Cc: Emacs orgmode, emacs-orgmode-bounces+gerard.vermeulen=posteo.net
gerard.vermeulen@posteo.net writes:
> I added the caveat:
> This patch is incompatible with `org-babel-edit-prep:<LANG>' functions
> that signal `user-error's.
> to the commit message and cleaned it up a bit.
You may wrap `org-indent-block' into `condition-case' to catch
user-errors.
--
Ihor Radchenko // yantar92,
Org mode contributor,
Learn more about Org mode at <https://orgmode.org/>.
Support Org development at <https://liberapay.com/org-mode>,
or support my work at <https://liberapay.com/yantar92>
^ permalink raw reply [flat|nested] 41+ messages in thread
* Re: [PATCH] org-babel-demarcate-block: split using element API
2024-02-25 12:21 ` Ihor Radchenko
@ 2024-02-26 8:51 ` gerard.vermeulen
2024-02-28 11:54 ` Ihor Radchenko
2024-02-26 9:06 ` gerard.vermeulen
1 sibling, 1 reply; 41+ messages in thread
From: gerard.vermeulen @ 2024-02-26 8:51 UTC (permalink / raw)
To: Ihor Radchenko
Cc: Emacs orgmode, emacs-orgmode-bounces+gerard.vermeulen=posteo.net
[-- Attachment #1: Type: text/plain, Size: 2356 bytes --]
On 25.02.2024 13:21, Ihor Radchenko wrote:
> gerard.vermeulen@posteo.net writes:
>
>> I added the caveat:
>> This patch is incompatible with `org-babel-edit-prep:<LANG>' functions
>> that signal `user-error's.
>> to the commit message and cleaned it up a bit.
>
> 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 also attach condition-case.diff that I use to try to argue that
condition-case never gets into its error-handler (I am running the
code with the condition-case now), because I never see the signal of
~(user-error "Error in `org-babel-edit-prep:<LANG>'?")~ (I needed to
read the condition-case documentation, because this is the first time
I am trying to use it).
#+begin_src emacs-lisp -n :results silent
;; Fails with org-babel-demarcate-block in patch.
(defun edit-prep-user-error (_info)
(user-error "Signaling user-errors is harmfull"))
(defun org-babel-edit-prep:python (info)
(edit-prep-user-error info))
(message "Harm-FULL edit-prep:python")
#+end_src
#+begin_src emacs-lisp -n :results silent
;; Works with org-babel-demarcate-block in patch.
(defun edit-prep-message (_info)
(message "Displaying messages is harmless"))
(defun org-babel-edit-prep:python (info)
(edit-prep-message info))
(message "Harm-LESS edit-prep:python")
#+end_src
~org-babel-demarcate-blocks~ works with "Harm-LESS edit-prep:python"
but fails with "Harm-FULL edit-prep:python" and it leaves the Org mode
buffer in a state similar to shown in no-user-errors-in-edit-prep.org
(I have to pass through org-edit-src-code to be able to edit the block
in the Org mode buffer).
But I only can do that after interrupting (C-g C-g) an infinite stream
of warnings "Warning (org-element): ‘org-element-at-point’ cannot be
used in non-Org buffer #<buffer *Org Src mail.org[ python ]*>
(python-mode)" which should come from the `org-element-at-point' call
indicated by ;; <= HERE? in condition-case.diff.
Test block below:
#+begin_src python -i -n :results silent
11
22
#+end_src
Regards -- Gerard
[-- Attachment #2: no-user-errors-in-edit-prep.org --]
[-- Type: application/octet-stream, Size: 2281 bytes --]
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. Demo:
#+begin_src emacs-lisp -n :results silent
;; Limited source block editing in an Org buffer.
(defun edit-prep-user-error (_info)
(user-error "Signaling user-errors is harmfull"))
(defun org-babel-edit-prep:python (info)
(edit-prep-user-error info))
#+end_src
#+begin_src emacs-lisp -n :results silent
;; Supports source block editing in an Org buffer.
(defun edit-prep-message (_info)
(message "Displaying messages is harmless"))
(defun org-babel-edit-prep:python (info)
(edit-prep-message info))
#+end_src
When org-babel-edit-prep:python displays a message and without using
M-x org-edit-src-code, it is possible to insert newlines like any
other character in the block below:
#+begin_src python -i -n :results silent
# comment
#+end_src
But when org-babel-edit-prep:python signals an user-error, inserting a
newline differs from inserting other characters:
1. The newline gets inserted but the edit buffer changes state (turns
yellow on my system)
2. Typing any character does not work, but I get in the message buffer:
- "Cannot modify an area being edited in a dedicated buffer"
3. After M-x org-edit-src-code I get in the message buffer:
- "Return to existing edit buffer ([n] will revert changes)? (y or n) y"
- "edit-prep-user-error: Signaling user-errors is harmfull"
4. It is possible to go back immediately to the Org mode buffer to
insert a character sequence (terminated by a newline that changes
the state of the edit buffer back to 1).
When org-babel-edit-prep:python displays a message, I never see
turning the state of an Org source buffer to "dedicated" when editing
the block in an Org mode buffer.
I am sure that the "dedicated" state of the Org source buffer is
related to the warnings: "Warning (org-element):
‘org-element-at-point’ cannot be used in non-Org buffer #<buffer *Org
Src no-user-errors-in-edit-prep.org[ python ]*> (python-mode)" when I
try to split the blocks by demarcation with the patch.
#+begin_src emacs-lisp -n :results silent
(condition-case nil
(user-error "Hidden")
(user-error "Shown"))
#+end_src
[-- Attachment #3: condition-case.diff --]
[-- Type: application/octet-stream, Size: 7440 bytes --]
diff --git a/lisp/ob-core.el b/lisp/ob-core.el
index e3110a3f1..c2e9bf97a 100644
--- a/lisp/ob-core.el
+++ b/lisp/ob-core.el
@@ -2101,63 +2101,65 @@ block of the same language as the previous."
(let (case-fold-search)
(string-match-p "#\\+BEGIN_SRC" block)))))
(if (and info start) ;; At src block, but not within blank lines after it.
- (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)))
+ (condition-case nil
+ (let* ((copy (org-element-copy (org-element-at-point))) ;; <= HERE?
+ (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)))
+ (user-error "Error in `org-babel-edit-prep:<LANG>'?"))
(let ((start (point))
(lang (or (car info) ; Reuse language from previous block.
(completing-read
^ permalink raw reply related [flat|nested] 41+ messages in thread
* Re: [PATCH] org-babel-demarcate-block: split using element API
2024-02-25 12:21 ` Ihor Radchenko
2024-02-26 8:51 ` gerard.vermeulen
@ 2024-02-26 9:06 ` gerard.vermeulen
1 sibling, 0 replies; 41+ messages in thread
From: gerard.vermeulen @ 2024-02-26 9:06 UTC (permalink / raw)
To: Ihor Radchenko
Cc: Emacs orgmode, emacs-orgmode-bounces+gerard.vermeulen=posteo.net
[-- Attachment #1: Type: text/plain, Size: 446 bytes --]
On 25.02.2024 13:21, Ihor Radchenko wrote:
> gerard.vermeulen@posteo.net writes:
>
>> I added the caveat:
>> This patch is incompatible with `org-babel-edit-prep:<LANG>' functions
>> that signal `user-error's.
>> to the commit message and cleaned it up a bit.
>
> You may wrap `org-indent-block' into `condition-case' to catch
> user-errors.
Sorry, I did attach an old version of no-user-errors-in-edit-prep.org.
Corrected.
Regards -- Gerard
[-- Attachment #2: no-user-errors-in-edit-prep.org --]
[-- Type: application/octet-stream, Size: 2281 bytes --]
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. Demo:
#+begin_src emacs-lisp -n :results silent
;; Limited source block editing in an Org buffer.
(defun edit-prep-user-error (_info)
(user-error "Signaling user-errors is harmfull"))
(defun org-babel-edit-prep:python (info)
(edit-prep-user-error info))
#+end_src
#+begin_src emacs-lisp -n :results silent
;; Supports source block editing in an Org buffer.
(defun edit-prep-message (_info)
(message "Displaying messages is harmless"))
(defun org-babel-edit-prep:python (info)
(edit-prep-message info))
#+end_src
When org-babel-edit-prep:python displays a message and without using
M-x org-edit-src-code, it is possible to insert newlines like any
other character in the block below:
#+begin_src python -i -n :results silent
# comment
#+end_src
But when org-babel-edit-prep:python signals an user-error, inserting a
newline differs from inserting other characters:
1. The newline gets inserted but the edit buffer changes state (turns
yellow on my system)
2. Typing any character does not work, but I get in the message buffer:
- "Cannot modify an area being edited in a dedicated buffer"
3. After M-x org-edit-src-code I get in the message buffer:
- "Return to existing edit buffer ([n] will revert changes)? (y or n) y"
- "edit-prep-user-error: Signaling user-errors is harmfull"
4. It is possible to go back immediately to the Org mode buffer to
insert a character sequence (terminated by a newline that changes
the state of the edit buffer back to 1).
When org-babel-edit-prep:python displays a message, I never see
turning the state of an Org source buffer to "dedicated" when editing
the block in an Org mode buffer.
I am sure that the "dedicated" state of the Org source buffer is
related to the warnings: "Warning (org-element):
‘org-element-at-point’ cannot be used in non-Org buffer #<buffer *Org
Src no-user-errors-in-edit-prep.org[ python ]*> (python-mode)" when I
try to split the blocks by demarcation with the patch.
#+begin_src emacs-lisp -n :results silent
(condition-case nil
(user-error "Hidden")
(user-error "Shown"))
#+end_src
^ permalink raw reply [flat|nested] 41+ messages in thread
* Re: [PATCH] org-babel-demarcate-block: split using element API
2024-02-26 8:51 ` gerard.vermeulen
@ 2024-02-28 11:54 ` Ihor Radchenko
2024-02-29 9:50 ` gerard.vermeulen
0 siblings, 1 reply; 41+ messages in thread
From: Ihor Radchenko @ 2024-02-28 11:54 UTC (permalink / raw)
To: gerard.vermeulen
Cc: Emacs orgmode, emacs-orgmode-bounces+gerard.vermeulen=posteo.net
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?
--
Ihor Radchenko // yantar92,
Org mode contributor,
Learn more about Org mode at <https://orgmode.org/>.
Support Org development at <https://liberapay.com/org-mode>,
or support my work at <https://liberapay.com/yantar92>
^ permalink raw reply [flat|nested] 41+ messages in thread
* Re: [PATCH] org-babel-demarcate-block: split using element API
2024-02-28 11:54 ` Ihor Radchenko
@ 2024-02-29 9:50 ` gerard.vermeulen
2024-02-29 11:56 ` Ihor Radchenko
0 siblings, 1 reply; 41+ messages in thread
From: gerard.vermeulen @ 2024-02-29 9:50 UTC (permalink / raw)
To: Ihor Radchenko; +Cc: Emacs orgmode
[-- 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
^ permalink raw reply related [flat|nested] 41+ messages in thread
* Re: [PATCH] org-babel-demarcate-block: split using element API
2024-02-29 9:50 ` gerard.vermeulen
@ 2024-02-29 11:56 ` Ihor Radchenko
2024-02-29 17:33 ` gerard.vermeulen
0 siblings, 1 reply; 41+ messages in thread
From: Ihor Radchenko @ 2024-02-29 11:56 UTC (permalink / raw)
To: gerard.vermeulen; +Cc: Emacs orgmode
gerard.vermeulen@posteo.net writes:
> 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).
Because `org-babel-edit-prep:sql' does not signal anything. It simply
returns a string:
In
(condition-case nil
(sql-set-product product)
(user-error "Cannot set `sql-product' in Org Src edit buffer"))
(user-error <staff>) means "If we encounter user-error, do <staff>".
That code is certainly misleading.
--
Ihor Radchenko // yantar92,
Org mode contributor,
Learn more about Org mode at <https://orgmode.org/>.
Support Org development at <https://liberapay.com/org-mode>,
or support my work at <https://liberapay.com/yantar92>
^ permalink raw reply [flat|nested] 41+ messages in thread
* Re: [PATCH] org-babel-demarcate-block: split using element API
2024-02-29 11:56 ` Ihor Radchenko
@ 2024-02-29 17:33 ` gerard.vermeulen
2024-03-03 13:08 ` Ihor Radchenko
0 siblings, 1 reply; 41+ messages in thread
From: gerard.vermeulen @ 2024-02-29 17:33 UTC (permalink / raw)
To: Ihor Radchenko; +Cc: Emacs orgmode
On 29.02.2024 12:56, Ihor Radchenko wrote:
> gerard.vermeulen@posteo.net writes:
>
>> 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).
[...]
I have reduced my version of `org-babel-demarcate-block' to a minimal
function to locate the bug stemming from edit-prep signaling an
user-error or not. In case edit-prep signals an user-error the call
chain `org-indent-block', `org-indent-region', `org-element-at-point'
triggers an infinite list of warnings (major mode is Python when run
on the test block).
#+begin_src emacs-lisp -n :results silent
(defun oeap-test ()
"Test `org-element-at-point': call with point at block."
(interactive)
(let* ((info (org-babel-get-src-block-info 'noeval))
(start (org-babel-where-is-src-block-head))
(body (and start (match-string 5))))
(if (and info start)
(let* ((copy (org-element-copy (org-element-at-point)))
(before (org-element-begin copy))
(beyond (org-element-end copy)))
(org-element-put-property copy :value body)
(delete-region before beyond)
(insert (org-element-interpret-data copy))
(org-babel-previous-src-block 1)
(message "Mode derived from: %S" (derived-mode-p 'org-mode))
;; Triggers list of warnings and condition-case is no
solution:
(org-indent-block)))))
#+end_src
Working edit-prep:
#+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)
(condition-case nil
(harm-full-edit-prep info)
(t nil)))
(message "Working edit-prep:python")
#+end_src
Failing edit-prep:
#+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)
(harm-full-edit-prep info))
(message "Failing edit-prep:python")
#+end_src
Test block:
#+begin_src python -i -n :results silent
11
22
#+end_src
I do not like to put extra constraints on edit-prep functions. Maybe,
it is better to cancel the patch.
Regards -- Gerard
^ permalink raw reply [flat|nested] 41+ messages in thread
* Re: [PATCH] org-babel-demarcate-block: split using element API
2024-02-29 17:33 ` gerard.vermeulen
@ 2024-03-03 13:08 ` Ihor Radchenko
2024-03-03 15:45 ` gerard.vermeulen
0 siblings, 1 reply; 41+ messages in thread
From: Ihor Radchenko @ 2024-03-03 13:08 UTC (permalink / raw)
To: gerard.vermeulen; +Cc: Emacs orgmode
gerard.vermeulen@posteo.net writes:
> I have reduced my version of `org-babel-demarcate-block' to a minimal
> function to locate the bug stemming from edit-prep signaling an
> user-error or not. In case edit-prep signals an user-error the call
> chain `org-indent-block', `org-indent-region', `org-element-at-point'
> triggers an infinite list of warnings (major mode is Python when run
> on the test block).
Have you tried the latest main?
--
Ihor Radchenko // yantar92,
Org mode contributor,
Learn more about Org mode at <https://orgmode.org/>.
Support Org development at <https://liberapay.com/org-mode>,
or support my work at <https://liberapay.com/yantar92>
^ permalink raw reply [flat|nested] 41+ messages in thread
* Re: [PATCH] org-babel-demarcate-block: split using element API
2024-03-03 13:08 ` Ihor Radchenko
@ 2024-03-03 15:45 ` gerard.vermeulen
2024-03-04 10:12 ` Ihor Radchenko
0 siblings, 1 reply; 41+ messages in thread
From: gerard.vermeulen @ 2024-03-03 15:45 UTC (permalink / raw)
To: Ihor Radchenko; +Cc: Emacs orgmode
On 03.03.2024 14:08, Ihor Radchenko wrote:
> gerard.vermeulen@posteo.net writes:
>
>> I have reduced my version of `org-babel-demarcate-block' to a minimal
>> function to locate the bug stemming from edit-prep signaling an
>> user-error or not. In case edit-prep signals an user-error the call
>> chain `org-indent-block', `org-indent-region', `org-element-at-point'
>> triggers an infinite list of warnings (major mode is Python when run
>> on the test block).
>
> Have you tried the latest main?
Yes (just tried again), the minimal function still triggers the
"infinite" list of warnings
"Warning (org-element): ‘org-element-at-point’ cannot be used in non-Org
buffer #<buffer *Org Src oeap.org[ python ]*> (python-mode)"
It is coming from the last org-indent-block call even though the message
just before tells that the mode is derived from org-mode.
Your changes of last thursday helped me to narrow the problem down to
this call.
Regards -- Gerard
^ permalink raw reply [flat|nested] 41+ messages in thread
* Re: [PATCH] org-babel-demarcate-block: split using element API
2024-03-03 15:45 ` gerard.vermeulen
@ 2024-03-04 10:12 ` Ihor Radchenko
2024-03-04 11:40 ` gerard.vermeulen
0 siblings, 1 reply; 41+ messages in thread
From: Ihor Radchenko @ 2024-03-04 10:12 UTC (permalink / raw)
To: gerard.vermeulen; +Cc: Emacs orgmode
gerard.vermeulen@posteo.net writes:
>> Have you tried the latest main?
>
> Yes (just tried again), the minimal function still triggers the
> "infinite" list of warnings
> "Warning (org-element): ‘org-element-at-point’ cannot be used in non-Org
> buffer #<buffer *Org Src oeap.org[ python ]*> (python-mode)"
> It is coming from the last org-indent-block call even though the message
> just before tells that the mode is derived from org-mode.
What about after
https://git.savannah.gnu.org/cgit/emacs/org-mode.git/commit/?id=5f5db3d35
?
--
Ihor Radchenko // yantar92,
Org mode contributor,
Learn more about Org mode at <https://orgmode.org/>.
Support Org development at <https://liberapay.com/org-mode>,
or support my work at <https://liberapay.com/yantar92>
^ permalink raw reply [flat|nested] 41+ messages in thread
* Re: [PATCH] org-babel-demarcate-block: split using element API
2024-03-04 10:12 ` Ihor Radchenko
@ 2024-03-04 11:40 ` gerard.vermeulen
2024-03-04 11:51 ` Ihor Radchenko
0 siblings, 1 reply; 41+ messages in thread
From: gerard.vermeulen @ 2024-03-04 11:40 UTC (permalink / raw)
To: Ihor Radchenko; +Cc: Emacs orgmode
[-- Attachment #1: Type: text/plain, Size: 261 bytes --]
On 04.03.2024 11:12, Ihor Radchenko wrote:
> What about after
> https://git.savannah.gnu.org/cgit/emacs/org-mode.git/commit/?id=5f5db3d35
> ?
This fixes the bug.
I resubmit my patch (attached) without any caveats in the commit
message.
Regards -- Gerard
[-- Attachment #2: 0001-org-babel-demarcate-block-split-using-element-API.patch --]
[-- Type: application/octet-stream, Size: 18745 bytes --]
From 8e1860eb93085058f8064dea6e5cfc21c09786dc 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.
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 cc257a3b3..4dcfbd3b0 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)))
@@ -2080,7 +2083,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.
@@ -2090,41 +2093,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
^ permalink raw reply related [flat|nested] 41+ messages in thread
* Re: [PATCH] org-babel-demarcate-block: split using element API
2024-03-04 11:40 ` gerard.vermeulen
@ 2024-03-04 11:51 ` Ihor Radchenko
0 siblings, 0 replies; 41+ messages in thread
From: Ihor Radchenko @ 2024-03-04 11:51 UTC (permalink / raw)
To: gerard.vermeulen; +Cc: Emacs orgmode
gerard.vermeulen@posteo.net writes:
> I resubmit my patch (attached) without any caveats in the commit
> message.
Thanks!
Applied, onto main.
https://git.savannah.gnu.org/cgit/emacs/org-mode.git/commit/?id=c2ea553be
--
Ihor Radchenko // yantar92,
Org mode contributor,
Learn more about Org mode at <https://orgmode.org/>.
Support Org development at <https://liberapay.com/org-mode>,
or support my work at <https://liberapay.com/yantar92>
^ permalink raw reply [flat|nested] 41+ messages in thread
end of thread, other threads:[~2024-03-04 11:48 UTC | newest]
Thread overview: 41+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2023-12-30 19:13 [PATCH] org-babel-demarcate-block: duplicate switches too gerard.vermeulen
2023-12-31 14:28 ` Ihor Radchenko
2024-01-01 12:52 ` gerard.vermeulen
2024-01-02 10:48 ` Ihor Radchenko
2024-01-02 20:20 ` [PATCH] org-babel-demarcate-block: split using org-element instead of regexp gerard.vermeulen
2024-01-03 15:11 ` Ihor Radchenko
2024-01-04 8:59 ` gerard.vermeulen
2024-01-04 14:43 ` Ihor Radchenko
2024-01-07 18:49 ` [PATCH] org-babel-demarcate-block: split using element API gerard.vermeulen
2024-01-08 12:08 ` Ihor Radchenko
2024-01-08 20:25 ` gerard.vermeulen
2024-01-09 7:49 ` gerard.vermeulen
2024-01-09 10:50 ` gerard.vermeulen
2024-01-09 14:49 ` Ihor Radchenko
2024-01-13 14:04 ` gerard.vermeulen
2024-01-13 15:17 ` Ihor Radchenko
2024-01-13 20:16 ` gerard.vermeulen
2024-01-14 10:53 ` gerard.vermeulen
2024-01-14 12:16 ` Ihor Radchenko
2024-01-14 19:18 ` gerard.vermeulen
2024-01-15 9:37 ` gerard.vermeulen
2024-01-16 13:34 ` Ihor Radchenko
2024-02-19 9:46 ` Ihor Radchenko
2024-02-19 13:01 ` gerard.vermeulen
2024-02-21 9:40 ` Ihor Radchenko
2024-02-21 18:19 ` gerard.vermeulen
2024-02-22 16:28 ` gerard.vermeulen
2024-02-23 13:43 ` Ihor Radchenko
2024-02-25 12:06 ` gerard.vermeulen
2024-02-25 12:21 ` Ihor Radchenko
2024-02-26 8:51 ` gerard.vermeulen
2024-02-28 11:54 ` Ihor Radchenko
2024-02-29 9:50 ` gerard.vermeulen
2024-02-29 11:56 ` Ihor Radchenko
2024-02-29 17:33 ` gerard.vermeulen
2024-03-03 13:08 ` Ihor Radchenko
2024-03-03 15:45 ` gerard.vermeulen
2024-03-04 10:12 ` Ihor Radchenko
2024-03-04 11:40 ` gerard.vermeulen
2024-03-04 11:51 ` Ihor Radchenko
2024-02-26 9:06 ` gerard.vermeulen
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.