From: gerard.vermeulen@posteo.net
To: Ihor Radchenko <yantar92@posteo.net>
Cc: Emacs orgmode <emacs-orgmode@gnu.org>,
emacs-orgmode-bounces+gerard.vermeulen=posteo.net@gnu.org
Subject: Re: [PATCH] org-babel-demarcate-block: split using element API
Date: Tue, 09 Jan 2024 10:50:00 +0000 [thread overview]
Message-ID: <261356c53e857e0bc4b04f884366edfa@posteo.net> (raw)
In-Reply-To: <c4a1570502fd3b3f4df0c7880c2c0a96@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
next prev parent reply other threads:[~2024-01-09 10:51 UTC|newest]
Thread overview: 41+ messages / expand[flat|nested] mbox.gz Atom feed top
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 [this message]
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
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.orgmode.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=261356c53e857e0bc4b04f884366edfa@posteo.net \
--to=gerard.vermeulen@posteo.net \
--cc=emacs-orgmode-bounces+gerard.vermeulen=posteo.net@gnu.org \
--cc=emacs-orgmode@gnu.org \
--cc=yantar92@posteo.net \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).