From f5b9a6862cdb71ab33b7a291386221fff6648d53 Mon Sep 17 00:00:00 2001 Message-ID: From: Gerard Vermeulen 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 + +'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