Function: org-babel-demarcate-block

org-babel-demarcate-block is an interactive and byte-compiled function defined in ob-core.el.gz.

Signature

(org-babel-demarcate-block &optional ARG)

Documentation

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 as the previous.

Key Bindings

Source Code

;; Defined in /usr/src/emacs/lisp/org/ob-core.el.gz
(defun org-babel-demarcate-block (&optional arg)
  "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 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)))
         (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.
        (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
		       "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 ")
			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")))
	(goto-char start)
	(move-end-of-line 1)))))