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