ob-exp.el (18849B)
1 ;;; ob-exp.el --- Exportation of Babel Source Blocks -*- lexical-binding: t; -*- 2 3 ;; Copyright (C) 2009-2024 Free Software Foundation, Inc. 4 5 ;; Authors: Eric Schulte 6 ;; Dan Davison 7 ;; Keywords: literate programming, reproducible research 8 ;; URL: https://orgmode.org 9 10 ;; This file is part of GNU Emacs. 11 12 ;; GNU Emacs is free software: you can redistribute it and/or modify 13 ;; it under the terms of the GNU General Public License as published by 14 ;; the Free Software Foundation, either version 3 of the License, or 15 ;; (at your option) any later version. 16 17 ;; GNU Emacs is distributed in the hope that it will be useful, 18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 20 ;; GNU General Public License for more details. 21 22 ;; You should have received a copy of the GNU General Public License 23 ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. 24 25 ;;; Commentary: 26 27 ;;; Code: 28 29 (require 'org-macs) 30 (org-assert-version) 31 32 (require 'ob-core) 33 34 (declare-function org-babel-lob-get-info "ob-lob" (&optional datum no-eval)) 35 (declare-function org-element-at-point "org-element" (&optional pom cached-only)) 36 (declare-function org-element-context "org-element" (&optional element)) 37 (declare-function org-element-property "org-element-ast" (property node)) 38 (declare-function org-element-begin "org-element" (node)) 39 (declare-function org-element-end "org-element" (node)) 40 (declare-function org-element-type "org-element-ast" (node &optional anonymous)) 41 (declare-function org-escape-code-in-string "org-src" (s)) 42 (declare-function org-export-copy-buffer "ox" 43 (&optional buffer drop-visibility 44 drop-narrowing drop-contents 45 drop-locals)) 46 (declare-function org-in-commented-heading-p "org" (&optional no-inheritance element)) 47 (declare-function org-in-archived-heading-p "org" (&optional no-inheritance element)) 48 (declare-function org-src-preserve-indentation-p "org-src" (node)) 49 50 (defcustom org-export-use-babel t 51 "Switch controlling code evaluation and header processing during export. 52 When set to nil no code will be evaluated as part of the export 53 process and no header arguments will be obeyed. Users who wish 54 to avoid evaluating code on export should use the header argument 55 `:eval never-export'." 56 :group 'org-babel 57 :version "24.1" 58 :type '(choice (const :tag "Never" nil) 59 (const :tag "Always" t)) 60 :safe #'null) 61 62 63 (defmacro org-babel-exp--at-source (&rest body) 64 "Evaluate BODY at the source of the Babel block at point. 65 Source is located in `org-babel-exp-reference-buffer'. The value 66 returned is the value of the last form in BODY. Assume that 67 point is at the beginning of the Babel block." 68 (declare (indent 1) (debug body)) 69 `(let ((source (get-text-property (point) 'org-reference))) 70 ;; Source blocks created during export process (e.g., by other 71 ;; source blocks) are not referenced. In this case, do not move 72 ;; point at all. 73 (with-current-buffer (if source org-babel-exp-reference-buffer 74 (current-buffer)) 75 (org-with-wide-buffer 76 (when source (goto-char source)) 77 ,@body)))) 78 79 (defun org-babel-exp-src-block (&optional element) 80 "Process source block for export. 81 Depending on the \":export\" header argument, replace the source 82 code block like this: 83 84 both ---- display the code and the results 85 86 code ---- the default, display the code inside the block but do 87 not process 88 89 results - just like none only the block is run on export ensuring 90 that its results are present in the Org mode buffer 91 92 none ---- do not display either code or results upon export 93 94 Optional argument ELEMENT must contain source block element at point. 95 96 Assume point is at block opening line." 97 (interactive) 98 (save-excursion 99 (let* ((info (org-babel-get-src-block-info nil element)) 100 (lang (nth 0 info)) 101 (raw-params (nth 2 info)) 102 hash) 103 ;; bail if we couldn't get any info from the block 104 (unless noninteractive 105 (message "org-babel-exp process %s at position %d..." 106 lang 107 (line-beginning-position))) 108 (when info 109 ;; if we're actually going to need the parameters 110 (when (member (cdr (assq :exports (nth 2 info))) '("both" "results")) 111 (let ((lang-headers (intern (concat "org-babel-default-header-args:" 112 lang)))) 113 (org-babel-exp--at-source 114 (setf (nth 2 info) 115 (org-babel-process-params 116 (apply #'org-babel-merge-params 117 org-babel-default-header-args 118 (and (boundp lang-headers) 119 (symbol-value lang-headers)) 120 (append (org-babel-params-from-properties lang) 121 (list raw-params))))))) 122 (setf hash (org-babel-sha1-hash info :export))) 123 (org-babel-exp-do-export info 'block hash))))) 124 125 (defcustom org-babel-exp-call-line-template 126 "" 127 "Template used to export call lines. 128 This template may be customized to include the call line name 129 with any export markup. The template is filled out using 130 `org-fill-template', and the following %keys may be used. 131 132 line --- call line 133 134 An example value would be \"\\n: call: %line\" to export the call line 135 wrapped in a verbatim environment. 136 137 Note: the results are inserted separately after the contents of 138 this template." 139 :group 'org-babel 140 :type 'string) 141 142 (defun org-babel-exp-process-buffer () 143 "Execute all Babel blocks in current buffer." 144 (interactive) 145 (when org-export-use-babel 146 (let ((case-fold-search t) 147 (regexp "\\(call\\|src\\)_\\|^[ \t]*#\\+\\(BEGIN_SRC\\|CALL:\\)") 148 ;; Get a pristine copy of current buffer so Babel 149 ;; references are properly resolved and source block 150 ;; context is preserved. 151 (org-babel-exp-reference-buffer (org-export-copy-buffer)) 152 element) 153 (unwind-protect 154 (save-excursion 155 ;; First attach to every source block their original 156 ;; position, so that they can be retrieved within 157 ;; `org-babel-exp-reference-buffer', even after heavy 158 ;; modifications on current buffer. 159 ;; 160 ;; False positives are harmless, so we don't check if 161 ;; we're really at some Babel object. Moreover, 162 ;; `line-end-position' ensures that we propertize 163 ;; a noticeable part of the object, without affecting 164 ;; multiple objects on the same line. 165 (goto-char (point-min)) 166 (while (re-search-forward regexp nil t) 167 (let ((s (match-beginning 0))) 168 (put-text-property s (line-end-position) 'org-reference s))) 169 ;; Evaluate from top to bottom every Babel block 170 ;; encountered. 171 (goto-char (point-min)) 172 ;; We are about to do a large number of changes in 173 ;; buffer, but we do not care about folding in this 174 ;; buffer. 175 (org-fold-core-ignore-modifications 176 (while (re-search-forward regexp nil t) 177 (setq element (save-match-data (org-element-at-point))) 178 (unless (save-match-data 179 (or (org-in-commented-heading-p nil element) 180 (org-in-archived-heading-p nil element))) 181 (let* ((object? (match-end 1)) 182 (element (save-match-data 183 (if object? 184 (org-element-context element) 185 ;; No deep inspection if we're 186 ;; just looking for an element. 187 element))) 188 (type 189 (pcase (org-element-type element) 190 ;; Discard block elements if we're looking 191 ;; for inline objects. False results 192 ;; happen when, e.g., "call_" syntax is 193 ;; located within affiliated keywords: 194 ;; 195 ;; #+name: call_src 196 ;; #+begin_src ... 197 ((and (or `babel-call `src-block) (guard object?)) 198 nil) 199 (type type))) 200 (begin 201 (copy-marker (org-element-begin element))) 202 (end 203 (copy-marker 204 (save-excursion 205 (goto-char (org-element-end element)) 206 (skip-chars-backward " \r\t\n") 207 (point))))) 208 (pcase type 209 (`inline-src-block 210 (let* ((info 211 (org-babel-get-src-block-info nil element)) 212 (params (nth 2 info))) 213 (setf (nth 1 info) 214 (if (and (cdr (assq :noweb params)) 215 (string= "yes" 216 (cdr (assq :noweb params)))) 217 (org-babel-expand-noweb-references 218 info org-babel-exp-reference-buffer) 219 (nth 1 info))) 220 (goto-char begin) 221 (let ((replacement 222 (org-babel-exp-do-export info 'inline))) 223 (cond 224 ((equal replacement "") 225 ;; Replacement code is empty: remove 226 ;; inline source block, including extra 227 ;; white space that might have been 228 ;; created when inserting results. 229 (delete-region begin 230 (progn (goto-char end) 231 (skip-chars-forward " \t") 232 (point)))) 233 ((not replacement) 234 ;; Replacement code cannot be determined. 235 ;; Leave the code block as is. 236 (goto-char end)) 237 ;; Otherwise: remove inline source block 238 ;; but preserve following white spaces. 239 ;; Then insert value. 240 ((not (string= replacement 241 (buffer-substring begin end))) 242 (delete-region begin end) 243 (insert replacement)) 244 ;; Replacement is the same as the source 245 ;; block. Continue onwards. 246 (t (goto-char end)))))) 247 ((or `babel-call `inline-babel-call) 248 (org-babel-exp-do-export 249 (or (org-babel-lob-get-info element) 250 (user-error "Unknown Babel reference: %s" 251 (org-element-property :call element))) 252 'lob) 253 (let ((rep 254 (org-fill-template 255 org-babel-exp-call-line-template 256 `(("line" . 257 ,(org-element-property :value element)))))) 258 ;; If replacement is empty, completely remove 259 ;; the object/element, including any extra 260 ;; white space that might have been created 261 ;; when including results. 262 (cond 263 ((equal rep "") 264 (delete-region 265 begin 266 (progn (goto-char end) 267 (if (not (eq type 'babel-call)) 268 (progn (skip-chars-forward " \t") 269 (point)) 270 (unless (eobp) 271 (skip-chars-forward " \r\t\n") 272 (line-beginning-position)))))) 273 ((not rep) 274 ;; Replacement code cannot be determined. 275 ;; Leave the code block as is. 276 (goto-char end)) 277 (t 278 ;; Otherwise, preserve trailing 279 ;; spaces/newlines and then, insert 280 ;; replacement string. 281 (goto-char begin) 282 (delete-region begin end) 283 (insert rep))))) 284 (`src-block 285 (let ((match-start (copy-marker (match-beginning 0))) 286 (ind (org-current-text-indentation))) 287 ;; Take care of matched block: compute 288 ;; replacement string. In particular, a nil 289 ;; REPLACEMENT means the block is left as-is 290 ;; while an empty string removes the block. 291 (let ((replacement 292 (progn (goto-char match-start) 293 (org-babel-exp-src-block element)))) 294 (cond ((not replacement) (goto-char end)) 295 ((equal replacement "") 296 (goto-char end) 297 (unless (eobp) 298 (skip-chars-forward " \r\t\n") 299 (forward-line 0)) 300 (delete-region begin (point))) 301 (t 302 (if (org-src-preserve-indentation-p element) 303 ;; Indent only code block 304 ;; markers. 305 (with-temp-buffer 306 ;; Do not use tabs for block 307 ;; indentation. 308 (when (fboundp 'indent-tabs-mode) 309 (indent-tabs-mode -1) 310 ;; FIXME: Emacs 26 311 ;; compatibility. 312 (setq-local indent-tabs-mode nil)) 313 (insert replacement) 314 (skip-chars-backward " \r\t\n") 315 (indent-line-to ind) 316 (goto-char 1) 317 (indent-line-to ind) 318 (setq replacement (buffer-string))) 319 ;; Indent everything. 320 (with-temp-buffer 321 ;; Do not use tabs for block 322 ;; indentation. 323 (when (fboundp 'indent-tabs-mode) 324 (indent-tabs-mode -1) 325 ;; FIXME: Emacs 26 326 ;; compatibility. 327 (setq-local indent-tabs-mode nil)) 328 (insert replacement) 329 (indent-rigidly 330 1 (point) ind) 331 (setq replacement (buffer-string)))) 332 (goto-char match-start) 333 (let ((rend (save-excursion 334 (goto-char end) 335 (line-end-position)))) 336 (if (string-equal replacement 337 (buffer-substring match-start rend)) 338 (goto-char rend) 339 (delete-region match-start 340 (save-excursion 341 (goto-char end) 342 (line-end-position))) 343 (insert replacement)))))) 344 (set-marker match-start nil)))) 345 (set-marker begin nil) 346 (set-marker end nil)))))) 347 (kill-buffer org-babel-exp-reference-buffer) 348 (remove-text-properties (point-min) (point-max) 349 '(org-reference nil)))))) 350 351 (defun org-babel-exp-do-export (info type &optional hash) 352 "Return a string with the exported content of a code block defined by INFO. 353 TYPE is the code block type: `block', `inline', or `lob'. HASH is the 354 result hash. 355 356 Return nil when exported content cannot be determined. 357 358 The function respects the value of the :exports header argument." 359 (let ((silently (lambda () (let ((session (cdr (assq :session (nth 2 info))))) 360 (unless (equal "none" session) 361 (org-babel-exp-results info type 'silent))))) 362 (clean (lambda () (if (eq type 'inline) 363 (org-babel-remove-inline-result) 364 (org-babel-remove-result info))))) 365 (pcase (or (cdr (assq :exports (nth 2 info))) "code") 366 ("none" (funcall silently) (funcall clean) "") 367 ("code" (funcall silently) (funcall clean) (org-babel-exp-code info type)) 368 ("results" (org-babel-exp-results info type nil hash) "") 369 ("both" 370 (org-babel-exp-results info type nil hash) 371 (org-babel-exp-code info type)) 372 (unknown-value 373 (warn "Unknown value of src block parameter :exports %S" unknown-value) 374 nil)))) 375 376 (defcustom org-babel-exp-code-template 377 "#+begin_src %lang%switches%header-args\n%body\n#+end_src" 378 "Template used to export the body of code blocks. 379 This template may be customized to include additional information 380 such as the code block name, or the values of particular header 381 arguments. The template is filled out using `org-fill-template', 382 and the following %keys may be used. 383 384 lang ------ the language of the code block 385 name ------ the name of the code block 386 body ------ the body of the code block 387 switches -- the switches associated to the code block 388 header-args the header arguments of the code block 389 390 In addition to the keys mentioned above, every header argument 391 defined for the code block may be used as a key and will be 392 replaced with its value." 393 :group 'org-babel 394 :type 'string 395 :package-version '(Org . "9.7")) 396 397 (defcustom org-babel-exp-inline-code-template 398 "src_%lang[%switches%header-args]{%body}" 399 "Template used to export the body of inline code blocks. 400 This template may be customized to include additional information 401 such as the code block name, or the values of particular header 402 arguments. The template is filled out using `org-fill-template', 403 and the following %keys may be used. 404 405 lang ------ the language of the code block 406 name ------ the name of the code block 407 body ------ the body of the code block 408 switches -- the switches associated to the code block 409 header-args the header arguments of the code block 410 411 In addition to the keys mentioned above, every header argument 412 defined for the code block may be used as a key and will be 413 replaced with its value." 414 :group 'org-babel 415 :type 'string 416 :package-version '(Org . "9.7")) 417 418 (defun org-babel-exp-code (info type) 419 "Return the original code block of TYPE defined by INFO, formatted for export." 420 (setf (nth 1 info) 421 (if (string= "strip-export" (cdr (assq :noweb (nth 2 info)))) 422 (replace-regexp-in-string 423 (org-babel-noweb-wrap) "" (nth 1 info)) 424 (if (org-babel-noweb-p (nth 2 info) :export) 425 (org-babel-expand-noweb-references 426 info org-babel-exp-reference-buffer) 427 (nth 1 info)))) 428 (org-fill-template 429 (if (eq type 'inline) 430 org-babel-exp-inline-code-template 431 org-babel-exp-code-template) 432 `(("lang" . ,(nth 0 info)) 433 ;; Inline source code should not be escaped. 434 ("body" . ,(let ((body (nth 1 info))) 435 (if (eq type 'inline) body 436 (org-escape-code-in-string body)))) 437 ("switches" . ,(let ((f (nth 3 info))) 438 (and (org-string-nw-p f) (concat " " f)))) 439 ("flags" . ,(let ((f (assq :flags (nth 2 info)))) 440 (and f (concat " " (cdr f))))) 441 ("header-args" 442 . 443 ,(org-babel-exp--at-source 444 (when-let* ((params (org-element-property :parameters (org-element-context)))) 445 (concat " " params)))) 446 ,@(mapcar (lambda (pair) 447 (cons (substring (symbol-name (car pair)) 1) 448 (format "%S" (cdr pair)))) 449 (nth 2 info)) 450 ("name" . ,(or (nth 4 info) ""))))) 451 452 (defun org-babel-exp-results (info type &optional silent hash) 453 "Evaluate and return the results of the current code block for export. 454 INFO is as returned by `org-babel-get-src-block-info'. TYPE is the 455 code block type. HASH is the result hash. 456 457 Results are prepared in a manner suitable for export by Org mode. 458 This function is called by `org-babel-exp-do-export'. The code 459 block will be evaluated. Optional argument SILENT can be used to 460 inhibit insertion of results into the buffer." 461 (unless (and hash (equal hash (org-babel-current-result-hash))) 462 (let ((lang (nth 0 info)) 463 (body (if (org-babel-noweb-p (nth 2 info) :eval) 464 (org-babel-expand-noweb-references 465 info org-babel-exp-reference-buffer) 466 (nth 1 info))) 467 (info (copy-sequence info)) 468 (org-babel-current-src-block-location (point-marker))) 469 ;; Skip code blocks which we can't evaluate. 470 (if (not (fboundp (intern (concat "org-babel-execute:" lang)))) 471 (warn "org-export: No org-babel-execute function for %s. Not updating exported results." lang) 472 (org-babel-eval-wipe-error-buffer) 473 (setf (nth 1 info) body) 474 (setf (nth 2 info) 475 (org-babel-exp--at-source 476 (org-babel-process-params 477 (org-babel-merge-params 478 (nth 2 info) 479 `((:results . ,(if silent "silent" "replace"))))))) 480 (pcase type 481 (`block (org-babel-execute-src-block nil info)) 482 (`inline 483 ;; Position the point on the inline source block 484 ;; allowing `org-babel-insert-result' to check that the 485 ;; block is inline. 486 (goto-char (nth 5 info)) 487 (org-babel-execute-src-block nil info)) 488 (`lob 489 (save-excursion 490 (goto-char (nth 5 info)) 491 (org-babel-execute-src-block nil info)))))))) 492 493 (provide 'ob-exp) 494 495 ;;; ob-exp.el ends here