ob-exp.el 18 KB

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