From 9a19f142d72229cf714d6fce7aabb8860db81a73 Mon Sep 17 00:00:00 2001 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): 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 + +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