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