Commit | Line | Data |
---|---|---|
86fbb8ca CD |
1 | ;;; ob-exp.el --- Exportation of org-babel source blocks |
2 | ||
ba318903 | 3 | ;; Copyright (C) 2009-2014 Free Software Foundation, Inc. |
86fbb8ca | 4 | |
dfd98937 | 5 | ;; Authors: Eric Schulte |
c7557a0f | 6 | ;; Dan Davison |
86fbb8ca CD |
7 | ;; Keywords: literate programming, reproducible research |
8 | ;; Homepage: http://orgmode.org | |
86fbb8ca CD |
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 <http://www.gnu.org/licenses/>. | |
24 | ||
86fbb8ca | 25 | ;;; Code: |
271672fa | 26 | (require 'ob-core) |
86fbb8ca CD |
27 | (eval-when-compile |
28 | (require 'cl)) | |
29 | ||
86fbb8ca CD |
30 | (defvar org-current-export-file) |
31 | (defvar org-babel-lob-one-liner-regexp) | |
32 | (defvar org-babel-ref-split-regexp) | |
8223b1d2 BG |
33 | (defvar org-list-forbidden-blocks) |
34 | ||
86fbb8ca | 35 | (declare-function org-babel-lob-get-info "ob-lob" ()) |
acedf35c | 36 | (declare-function org-babel-eval-wipe-error-buffer "ob-eval" ()) |
271672fa BG |
37 | (declare-function org-between-regexps-p "org" |
38 | (start-re end-re &optional lim-up lim-down)) | |
39 | (declare-function org-get-indentation "org" (&optional line)) | |
8223b1d2 | 40 | (declare-function org-heading-components "org" ()) |
271672fa BG |
41 | (declare-function org-in-block-p "org" (names)) |
42 | (declare-function org-in-verbatim-emphasis "org" ()) | |
8223b1d2 BG |
43 | (declare-function org-link-search "org" (s &optional type avoid-pos stealth)) |
44 | (declare-function org-fill-template "org" (template alist)) | |
271672fa BG |
45 | (declare-function org-split-string "org" (string &optional separators)) |
46 | (declare-function org-element-at-point "org-element" (&optional keep-trail)) | |
47 | (declare-function org-element-context "org-element" ()) | |
48 | (declare-function org-element-property "org-element" (property element)) | |
49 | (declare-function org-element-type "org-element" (element)) | |
50 | (declare-function org-escape-code-in-string "org-src" (s)) | |
86fbb8ca CD |
51 | |
52 | (defcustom org-export-babel-evaluate t | |
53 | "Switch controlling code evaluation during export. | |
afe98dfa | 54 | When set to nil no code will be evaluated as part of the export |
271672fa BG |
55 | process. When set to 'inline-only, only inline code blocks will |
56 | be executed." | |
86fbb8ca | 57 | :group 'org-babel |
372d7b21 | 58 | :version "24.1" |
271672fa BG |
59 | :type '(choice (const :tag "Never" nil) |
60 | (const :tag "Only inline code" inline-only) | |
61 | (const :tag "Always" t))) | |
86fbb8ca CD |
62 | (put 'org-export-babel-evaluate 'safe-local-variable (lambda (x) (eq x nil))) |
63 | ||
8223b1d2 BG |
64 | (defun org-babel-exp-get-export-buffer () |
65 | "Return the current export buffer if possible." | |
66 | (cond | |
67 | ((bufferp org-current-export-file) org-current-export-file) | |
68 | (org-current-export-file (get-file-buffer org-current-export-file)) | |
69 | ('otherwise | |
70 | (error "Requested export buffer when `org-current-export-file' is nil")))) | |
71 | ||
666ffc7e SM |
72 | (defvar org-link-search-inhibit-query) |
73 | ||
3ab2c837 BG |
74 | (defmacro org-babel-exp-in-export-file (lang &rest body) |
75 | (declare (indent 1)) | |
76 | `(let* ((lang-headers (intern (concat "org-babel-default-header-args:" ,lang))) | |
afe98dfa | 77 | (heading (nth 4 (ignore-errors (org-heading-components)))) |
8223b1d2 BG |
78 | (export-buffer (current-buffer)) |
79 | (original-buffer (org-babel-exp-get-export-buffer)) results) | |
80 | (when original-buffer | |
afe98dfa CD |
81 | ;; resolve parameters in the original file so that |
82 | ;; headline and file-wide parameters are included, attempt | |
83 | ;; to go to the same heading in the original file | |
8223b1d2 | 84 | (set-buffer original-buffer) |
afe98dfa | 85 | (save-restriction |
8223b1d2 BG |
86 | (when heading |
87 | (condition-case nil | |
88 | (let ((org-link-search-inhibit-query t)) | |
89 | (org-link-search heading)) | |
90 | (error (when heading | |
91 | (goto-char (point-min)) | |
92 | (re-search-forward (regexp-quote heading) nil t))))) | |
afe98dfa CD |
93 | (setq results ,@body)) |
94 | (set-buffer export-buffer) | |
95 | results))) | |
e66ba1df | 96 | (def-edebug-spec org-babel-exp-in-export-file (form body)) |
afe98dfa | 97 | |
271672fa | 98 | (defun org-babel-exp-src-block (&rest headers) |
86fbb8ca | 99 | "Process source block for export. |
271672fa BG |
100 | Depending on the 'export' headers argument, replace the source |
101 | code block like this: | |
86fbb8ca CD |
102 | |
103 | both ---- display the code and the results | |
104 | ||
105 | code ---- the default, display the code inside the block but do | |
106 | not process | |
107 | ||
108 | results - just like none only the block is run on export ensuring | |
109 | that it's results are present in the org-mode buffer | |
110 | ||
271672fa BG |
111 | none ---- do not display either code or results upon export |
112 | ||
113 | Assume point is at the beginning of block's starting line." | |
86fbb8ca | 114 | (interactive) |
3ab2c837 | 115 | (unless noninteractive (message "org-babel-exp processing...")) |
86fbb8ca | 116 | (save-excursion |
afe98dfa CD |
117 | (let* ((info (org-babel-get-src-block-info 'light)) |
118 | (lang (nth 0 info)) | |
3ab2c837 | 119 | (raw-params (nth 2 info)) hash) |
86fbb8ca CD |
120 | ;; bail if we couldn't get any info from the block |
121 | (when info | |
3ab2c837 BG |
122 | ;; if we're actually going to need the parameters |
123 | (when (member (cdr (assoc :exports (nth 2 info))) '("both" "results")) | |
124 | (org-babel-exp-in-export-file lang | |
125 | (setf (nth 2 info) | |
126 | (org-babel-process-params | |
271672fa BG |
127 | (apply #'org-babel-merge-params |
128 | org-babel-default-header-args | |
129 | (if (boundp lang-headers) (eval lang-headers) nil) | |
130 | (append (org-babel-params-from-properties lang) | |
131 | (list raw-params)))))) | |
3ab2c837 | 132 | (setf hash (org-babel-sha1-hash info))) |
3ab2c837 | 133 | (org-babel-exp-do-export info 'block hash))))) |
86fbb8ca | 134 | |
8223b1d2 BG |
135 | (defcustom org-babel-exp-call-line-template |
136 | "" | |
137 | "Template used to export call lines. | |
138 | This template may be customized to include the call line name | |
139 | with any export markup. The template is filled out using | |
140 | `org-fill-template', and the following %keys may be used. | |
141 | ||
142 | line --- call line | |
143 | ||
144 | An example value would be \"\\n: call: %line\" to export the call line | |
145 | wrapped in a verbatim environment. | |
146 | ||
147 | Note: the results are inserted separately after the contents of | |
148 | this template." | |
149 | :group 'org-babel | |
150 | :type 'string) | |
151 | ||
153ae947 | 152 | (defvar org-babel-default-lob-header-args) |
3c8b09ca BG |
153 | (defun org-babel-exp-process-buffer () |
154 | "Execute all Babel blocks in current buffer." | |
86fbb8ca | 155 | (interactive) |
3c8b09ca BG |
156 | (save-window-excursion |
157 | (save-excursion | |
158 | (let ((case-fold-search t) | |
159 | (regexp (concat org-babel-inline-src-block-regexp "\\|" | |
160 | org-babel-lob-one-liner-regexp "\\|" | |
161 | "^[ \t]*#\\+BEGIN_SRC"))) | |
162 | (goto-char (point-min)) | |
163 | (while (re-search-forward regexp nil t) | |
271672fa BG |
164 | (let* ((element (save-excursion |
165 | ;; If match is inline, point is at its | |
166 | ;; end. Move backward so | |
167 | ;; `org-element-context' can get the | |
168 | ;; object, not the following one. | |
169 | (backward-char) | |
170 | (save-match-data (org-element-context)))) | |
3c8b09ca | 171 | (type (org-element-type element)) |
30cb51f1 BG |
172 | (begin (copy-marker (org-element-property :begin element))) |
173 | (end (copy-marker | |
174 | (save-excursion | |
175 | (goto-char (org-element-property :end element)) | |
176 | (skip-chars-backward " \r\t\n") | |
177 | (point))))) | |
3c8b09ca BG |
178 | (case type |
179 | (inline-src-block | |
180 | (let* ((info (org-babel-parse-inline-src-block-match)) | |
181 | (params (nth 2 info))) | |
182 | (setf (nth 1 info) | |
183 | (if (and (cdr (assoc :noweb params)) | |
184 | (string= "yes" (cdr (assoc :noweb params)))) | |
185 | (org-babel-expand-noweb-references | |
186 | info (org-babel-exp-get-export-buffer)) | |
187 | (nth 1 info))) | |
30cb51f1 | 188 | (goto-char begin) |
3c8b09ca BG |
189 | (let ((replacement (org-babel-exp-do-export info 'inline))) |
190 | (if (equal replacement "") | |
191 | ;; Replacement code is empty: remove inline src | |
192 | ;; block, including extra white space that | |
193 | ;; might have been created when inserting | |
194 | ;; results. | |
30cb51f1 BG |
195 | (delete-region begin |
196 | (progn (goto-char end) | |
3c8b09ca | 197 | (skip-chars-forward " \t") |
271672fa | 198 | (point))) |
3c8b09ca BG |
199 | ;; Otherwise: remove inline src block but |
200 | ;; preserve following white spaces. Then insert | |
201 | ;; value. | |
30cb51f1 | 202 | (delete-region begin end) |
3c8b09ca BG |
203 | (insert replacement))))) |
204 | ((babel-call inline-babel-call) | |
205 | (let* ((lob-info (org-babel-lob-get-info)) | |
206 | (results | |
207 | (org-babel-exp-do-export | |
208 | (list "emacs-lisp" "results" | |
209 | (apply #'org-babel-merge-params | |
210 | org-babel-default-header-args | |
211 | org-babel-default-lob-header-args | |
212 | (append | |
213 | (org-babel-params-from-properties) | |
214 | (list | |
215 | (org-babel-parse-header-arguments | |
216 | (org-no-properties | |
217 | (concat | |
218 | ":var results=" | |
219 | (mapconcat 'identity | |
220 | (butlast lob-info 2) | |
221 | " "))))))) | |
222 | "" (nth 3 lob-info) (nth 2 lob-info)) | |
223 | 'lob)) | |
224 | (rep (org-fill-template | |
225 | org-babel-exp-call-line-template | |
226 | `(("line" . ,(nth 0 lob-info)))))) | |
227 | ;; If replacement is empty, completely remove the | |
228 | ;; object/element, including any extra white space | |
229 | ;; that might have been created when including | |
230 | ;; results. | |
231 | (if (equal rep "") | |
232 | (delete-region | |
30cb51f1 BG |
233 | begin |
234 | (progn (goto-char end) | |
3c8b09ca BG |
235 | (if (not (eq type 'babel-call)) |
236 | (progn (skip-chars-forward " \t") (point)) | |
237 | (skip-chars-forward " \r\t\n") | |
238 | (line-beginning-position)))) | |
239 | ;; Otherwise, preserve following white | |
240 | ;; spaces/newlines and then, insert replacement | |
241 | ;; string. | |
30cb51f1 BG |
242 | (goto-char begin) |
243 | (delete-region begin end) | |
3c8b09ca BG |
244 | (insert rep)))) |
245 | (src-block | |
30cb51f1 | 246 | (let* ((match-start (copy-marker (match-beginning 0))) |
3c8b09ca BG |
247 | (ind (org-get-indentation)) |
248 | (headers | |
249 | (cons | |
250 | (org-element-property :language element) | |
30cb51f1 BG |
251 | (let ((params (org-element-property :parameters |
252 | element))) | |
3c8b09ca BG |
253 | (and params (org-split-string params "[ \t]+")))))) |
254 | ;; Take care of matched block: compute replacement | |
255 | ;; string. In particular, a nil REPLACEMENT means | |
256 | ;; the block should be left as-is while an empty | |
257 | ;; string should remove the block. | |
258 | (let ((replacement (progn (goto-char match-start) | |
259 | (org-babel-exp-src-block headers)))) | |
30cb51f1 | 260 | (cond ((not replacement) (goto-char end)) |
3c8b09ca | 261 | ((equal replacement "") |
30cb51f1 BG |
262 | (goto-char end) |
263 | (skip-chars-forward " \r\t\n") | |
264 | (beginning-of-line) | |
265 | (delete-region begin (point))) | |
3c8b09ca BG |
266 | (t |
267 | (goto-char match-start) | |
30cb51f1 BG |
268 | (delete-region (point) |
269 | (save-excursion (goto-char end) | |
270 | (line-end-position))) | |
3c8b09ca | 271 | (insert replacement) |
30cb51f1 BG |
272 | (if (or org-src-preserve-indentation |
273 | (org-element-property :preserve-indent | |
274 | element)) | |
3c8b09ca BG |
275 | ;; Indent only the code block markers. |
276 | (save-excursion (skip-chars-backward " \r\t\n") | |
277 | (indent-line-to ind) | |
278 | (goto-char match-start) | |
279 | (indent-line-to ind)) | |
280 | ;; Indent everything. | |
30cb51f1 BG |
281 | (indent-rigidly match-start (point) ind))))) |
282 | (set-marker match-start nil)))) | |
283 | (set-marker begin nil) | |
284 | (set-marker end nil))))))) | |
86fbb8ca CD |
285 | |
286 | (defun org-babel-in-example-or-verbatim () | |
287 | "Return true if point is in example or verbatim code. | |
288 | Example and verbatim code include escaped portions of | |
289 | an org-mode buffer code that should be treated as normal | |
290 | org-mode text." | |
e66ba1df | 291 | (or (save-match-data |
3ab2c837 | 292 | (save-excursion |
86fbb8ca CD |
293 | (goto-char (point-at-bol)) |
294 | (looking-at "[ \t]*:[ \t]"))) | |
3ab2c837 | 295 | (org-in-verbatim-emphasis) |
e66ba1df BG |
296 | (org-in-block-p org-list-forbidden-blocks) |
297 | (org-between-regexps-p "^[ \t]*#\\+begin_src" "^[ \t]*#\\+end_src"))) | |
86fbb8ca | 298 | |
3ab2c837 | 299 | (defun org-babel-exp-do-export (info type &optional hash) |
86fbb8ca CD |
300 | "Return a string with the exported content of a code block. |
301 | The function respects the value of the :exports header argument." | |
8223b1d2 BG |
302 | (let ((silently (lambda () (let ((session (cdr (assoc :session (nth 2 info))))) |
303 | (when (not (and session (equal "none" session))) | |
304 | (org-babel-exp-results info type 'silent))))) | |
305 | (clean (lambda () (unless (eq type 'inline) (org-babel-remove-result info))))) | |
86fbb8ca | 306 | (case (intern (or (cdr (assoc :exports (nth 2 info))) "code")) |
8223b1d2 BG |
307 | ('none (funcall silently) (funcall clean) "") |
308 | ('code (funcall silently) (funcall clean) (org-babel-exp-code info)) | |
3ab2c837 BG |
309 | ('results (org-babel-exp-results info type nil hash) "") |
310 | ('both (org-babel-exp-results info type nil hash) | |
311 | (org-babel-exp-code info))))) | |
86fbb8ca | 312 | |
8223b1d2 | 313 | (defcustom org-babel-exp-code-template |
30cb51f1 | 314 | "#+BEGIN_SRC %lang%switches%flags\n%body\n#+END_SRC" |
8223b1d2 BG |
315 | "Template used to export the body of code blocks. |
316 | This template may be customized to include additional information | |
317 | such as the code block name, or the values of particular header | |
318 | arguments. The template is filled out using `org-fill-template', | |
319 | and the following %keys may be used. | |
320 | ||
321 | lang ------ the language of the code block | |
322 | name ------ the name of the code block | |
323 | body ------ the body of the code block | |
30cb51f1 | 324 | switches -- the switches associated to the code block |
8223b1d2 BG |
325 | flags ----- the flags passed to the code block |
326 | ||
327 | In addition to the keys mentioned above, every header argument | |
328 | defined for the code block may be used as a key and will be | |
329 | replaced with its value." | |
330 | :group 'org-babel | |
331 | :type 'string) | |
332 | ||
3ab2c837 BG |
333 | (defun org-babel-exp-code (info) |
334 | "Return the original code block formatted for export." | |
8223b1d2 BG |
335 | (setf (nth 1 info) |
336 | (if (string= "strip-export" (cdr (assoc :noweb (nth 2 info)))) | |
337 | (replace-regexp-in-string | |
338 | (org-babel-noweb-wrap) "" (nth 1 info)) | |
339 | (if (org-babel-noweb-p (nth 2 info) :export) | |
340 | (org-babel-expand-noweb-references | |
341 | info (org-babel-exp-get-export-buffer)) | |
342 | (nth 1 info)))) | |
3ab2c837 | 343 | (org-fill-template |
8223b1d2 | 344 | org-babel-exp-code-template |
3ab2c837 | 345 | `(("lang" . ,(nth 0 info)) |
271672fa | 346 | ("body" . ,(org-escape-code-in-string (nth 1 info))) |
30cb51f1 BG |
347 | ("switches" . ,(let ((f (nth 3 info))) |
348 | (and (org-string-nw-p f) (concat " " f)))) | |
349 | ("flags" . ,(let ((f (assq :flags (nth 2 info)))) | |
350 | (and f (concat " " (cdr f))))) | |
8223b1d2 BG |
351 | ,@(mapcar (lambda (pair) |
352 | (cons (substring (symbol-name (car pair)) 1) | |
353 | (format "%S" (cdr pair)))) | |
354 | (nth 2 info)) | |
8223b1d2 | 355 | ("name" . ,(or (nth 4 info) ""))))) |
86fbb8ca | 356 | |
3ab2c837 | 357 | (defun org-babel-exp-results (info type &optional silent hash) |
86fbb8ca CD |
358 | "Evaluate and return the results of the current code block for export. |
359 | Results are prepared in a manner suitable for export by org-mode. | |
360 | This function is called by `org-babel-exp-do-export'. The code | |
361 | block will be evaluated. Optional argument SILENT can be used to | |
362 | inhibit insertion of results into the buffer." | |
271672fa BG |
363 | (when (and (or (eq org-export-babel-evaluate t) |
364 | (and (eq type 'inline) | |
365 | (eq org-export-babel-evaluate 'inline-only))) | |
3ab2c837 BG |
366 | (not (and hash (equal hash (org-babel-current-result-hash))))) |
367 | (let ((lang (nth 0 info)) | |
8223b1d2 BG |
368 | (body (if (org-babel-noweb-p (nth 2 info) :eval) |
369 | (org-babel-expand-noweb-references | |
370 | info (org-babel-exp-get-export-buffer)) | |
371 | (nth 1 info))) | |
271672fa BG |
372 | (info (copy-sequence info)) |
373 | (org-babel-current-src-block-location (point-marker))) | |
3ab2c837 BG |
374 | ;; skip code blocks which we can't evaluate |
375 | (when (fboundp (intern (concat "org-babel-execute:" lang))) | |
376 | (org-babel-eval-wipe-error-buffer) | |
377 | (prog1 nil | |
8223b1d2 | 378 | (setf (nth 1 info) body) |
3ab2c837 BG |
379 | (setf (nth 2 info) |
380 | (org-babel-exp-in-export-file lang | |
381 | (org-babel-process-params | |
afe98dfa CD |
382 | (org-babel-merge-params |
383 | (nth 2 info) | |
3ab2c837 BG |
384 | `((:results . ,(if silent "silent" "replace"))))))) |
385 | (cond | |
e66ba1df BG |
386 | ((equal type 'block) |
387 | (org-babel-execute-src-block nil info)) | |
388 | ((equal type 'inline) | |
389 | ;; position the point on the inline source block allowing | |
390 | ;; `org-babel-insert-result' to check that the block is | |
391 | ;; inline | |
392 | (re-search-backward "[ \f\t\n\r\v]" nil t) | |
393 | (re-search-forward org-babel-inline-src-block-regexp nil t) | |
394 | (re-search-backward "src_" nil t) | |
3ab2c837 BG |
395 | (org-babel-execute-src-block nil info)) |
396 | ((equal type 'lob) | |
397 | (save-excursion | |
398 | (re-search-backward org-babel-lob-one-liner-regexp nil t) | |
271672fa BG |
399 | (let (org-confirm-babel-evaluate) |
400 | (org-babel-execute-src-block nil info)))))))))) | |
86fbb8ca | 401 | |
5b409b39 | 402 | |
271672fa | 403 | (provide 'ob-exp) |
86fbb8ca CD |
404 | |
405 | ;;; ob-exp.el ends here |