ob-exp.el 15 KB

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