1 ;;; ob-exp.el --- Exportation of org-babel source blocks
3 ;; Copyright (C) 2009-2016 Free Software Foundation, Inc.
5 ;; Authors: Eric Schulte
7 ;; Keywords: literate programming, reproducible research
8 ;; Homepage: http://orgmode.org
10 ;; This file is part of GNU Emacs.
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.
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.
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/>.
31 (defvar org-babel-lob-one-liner-regexp
)
32 (defvar org-babel-ref-split-regexp
)
34 (declare-function org-babel-lob-get-info
"ob-lob" (&optional datum
))
35 (declare-function org-babel-eval-wipe-error-buffer
"ob-eval" ())
36 (declare-function org-between-regexps-p
"org"
37 (start-re end-re
&optional lim-up lim-down
))
38 (declare-function org-get-indentation
"org" (&optional line
))
39 (declare-function org-heading-components
"org" ())
40 (declare-function org-in-commented-heading-p
"org" (&optional no-inheritance
))
41 (declare-function org-in-block-p
"org" (names))
42 (declare-function org-in-verbatim-emphasis
"org" ())
43 (declare-function org-link-search
"org" (s &optional avoid-pos stealth
))
44 (declare-function org-fill-template
"org" (template alist
))
45 (declare-function org-split-string
"org" (string &optional separators
))
46 (declare-function org-element-at-point
"org-element" ())
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-id-get
"org-id" (&optional pom create prefix
))
51 (declare-function org-escape-code-in-string
"org-src" (s))
53 (defcustom org-export-babel-evaluate t
54 "Switch controlling code evaluation during export.
55 When set to nil no code will be evaluated as part of the export
56 process. When set to `inline-only', only inline code blocks will
60 :type
'(choice (const :tag
"Never" nil
)
61 (const :tag
"Only inline code" inline-only
)
62 (const :tag
"Always" t
)))
63 (put 'org-export-babel-evaluate
'safe-local-variable
(lambda (x) (eq x nil
)))
65 (defvar org-link-search-inhibit-query
)
66 (defmacro org-babel-exp-in-export-file
(lang &rest body
)
68 `(let* ((lang-headers (intern (concat "org-babel-default-header-args:" ,lang
)))
69 (heading-query (or (org-id-get)
70 ;; CUSTOM_IDs don't work, maybe they are
71 ;; stripped, or maybe they resolve too
72 ;; late in `org-link-search'.
73 ;; (org-entry-get nil "CUSTOM_ID")
74 (nth 4 (ignore-errors (org-heading-components)))))
75 (export-buffer (current-buffer))
77 (when org-babel-exp-reference-buffer
78 ;; Resolve parameters in the original file so that headline and
79 ;; file-wide parameters are included, attempt to go to the same
80 ;; heading in the original file
81 (set-buffer org-babel-exp-reference-buffer
)
85 (let ((org-link-search-inhibit-query t
))
86 ;; TODO: When multiple headings have the same title,
87 ;; this returns the first, which is not always
88 ;; the right heading. Consider a better way to
89 ;; find the proper heading.
90 (org-link-search heading-query
))
91 (error (when heading-query
92 (goto-char (point-min))
93 (re-search-forward (regexp-quote heading-query
) nil t
)))))
94 (setq results
,@body
))
95 (set-buffer export-buffer
)
97 (def-edebug-spec org-babel-exp-in-export-file
(form body
))
99 (defun org-babel-exp-src-block (&rest headers
)
100 "Process source block for export.
101 Depending on the `export' headers argument, replace the source
102 code block like this:
104 both ---- display the code and the results
106 code ---- the default, display the code inside the block but do
109 results - just like none only the block is run on export ensuring
110 that its results are present in the org-mode buffer
112 none ---- do not display either code or results upon export
114 Assume point is at the beginning of block's starting line."
117 (let* ((info (org-babel-get-src-block-info 'light
))
118 (line (org-current-line))
120 (raw-params (nth 2 info
)) hash
)
121 ;; bail if we couldn't get any info from the block
122 (unless noninteractive
123 (message "org-babel-exp process %s at line %d..." lang line
))
125 ;; if we're actually going to need the parameters
126 (when (member (cdr (assoc :exports
(nth 2 info
))) '("both" "results"))
127 (org-babel-exp-in-export-file lang
129 (org-babel-process-params
130 (apply #'org-babel-merge-params
131 org-babel-default-header-args
132 (if (boundp lang-headers
) (eval lang-headers
) nil
)
133 (append (org-babel-params-from-properties lang
)
134 (list raw-params
))))))
135 (setf hash
(org-babel-sha1-hash info
)))
136 (org-babel-exp-do-export info
'block hash
)))))
138 (defcustom org-babel-exp-call-line-template
140 "Template used to export call lines.
141 This template may be customized to include the call line name
142 with any export markup. The template is filled out using
143 `org-fill-template', and the following %keys may be used.
147 An example value would be \"\\n: call: %line\" to export the call line
148 wrapped in a verbatim environment.
150 Note: the results are inserted separately after the contents of
155 (defvar org-babel-default-lob-header-args
)
156 (defun org-babel-exp-process-buffer (reference-buffer)
157 "Execute all Babel blocks in current buffer.
158 REFERENCE-BUFFER is the buffer containing a pristine copy of the
159 buffer being processed. It is used to properly resolve
160 references in source blocks, as modifications in current buffer
161 may make them unreachable."
163 (save-window-excursion
165 (let ((case-fold-search t
)
166 (org-babel-exp-reference-buffer reference-buffer
)
167 (regexp (concat org-babel-inline-src-block-regexp
"\\|"
168 org-babel-lob-one-liner-regexp
"\\|"
169 "^[ \t]*#\\+BEGIN_SRC")))
170 (goto-char (point-min))
171 (while (re-search-forward regexp nil t
)
172 (unless (save-match-data (org-in-commented-heading-p))
173 (let* ((element (save-excursion
174 ;; If match is inline, point is at its
175 ;; end. Move backward so
176 ;; `org-element-context' can get the
177 ;; object, not the following one.
179 (save-match-data (org-element-context))))
180 (type (org-element-type element
))
181 (begin (copy-marker (org-element-property :begin element
)))
184 (goto-char (org-element-property :end element
))
185 (skip-chars-backward " \r\t\n")
189 (let* ((info (org-babel-get-src-block-info nil element
))
190 (params (nth 2 info
)))
192 (if (and (cdr (assoc :noweb params
))
193 (string= "yes" (cdr (assoc :noweb params
))))
194 (org-babel-expand-noweb-references
195 info org-babel-exp-reference-buffer
)
198 (let ((replacement (org-babel-exp-do-export info
'inline
)))
199 (if (equal replacement
"")
200 ;; Replacement code is empty: remove inline
201 ;; source block, including extra white space
202 ;; that might have been created when
203 ;; inserting results.
205 (progn (goto-char end
)
206 (skip-chars-forward " \t")
208 ;; Otherwise: remove inline src block but
209 ;; preserve following white spaces. Then
211 (delete-region begin end
)
212 (insert replacement
)))))
213 ((babel-call inline-babel-call
)
214 (let* ((lob-info (org-babel-lob-get-info element
))
216 (org-babel-exp-do-export
217 (list "emacs-lisp" "results"
218 (apply #'org-babel-merge-params
219 org-babel-default-header-args
220 org-babel-default-lob-header-args
222 (org-babel-params-from-properties)
224 (org-babel-parse-header-arguments
228 (mapconcat #'identity
233 (rep (org-fill-template
234 org-babel-exp-call-line-template
235 `(("line" .
,(nth 0 lob-info
))))))
236 ;; If replacement is empty, completely remove the
237 ;; object/element, including any extra white space
238 ;; that might have been created when including
243 (progn (goto-char end
)
244 (if (not (eq type
'babel-call
))
245 (progn (skip-chars-forward " \t") (point))
246 (skip-chars-forward " \r\t\n")
247 (line-beginning-position))))
248 ;; Otherwise, preserve following white
249 ;; spaces/newlines and then, insert replacement
252 (delete-region begin end
)
255 (let* ((match-start (copy-marker (match-beginning 0)))
256 (ind (org-get-indentation))
257 (lang (or (org-element-property :language element
)
259 "No language for src block: %s"
260 (or (org-element-property :name element
)
265 (org-element-property
266 :parameters element
)))
267 (and params
(org-split-string params
))))))
268 ;; Take care of matched block: compute replacement
269 ;; string. In particular, a nil REPLACEMENT means
270 ;; the block should be left as-is while an empty
271 ;; string should remove the block.
273 (progn (goto-char match-start
)
274 (org-babel-exp-src-block headers
))))
275 (cond ((not replacement
) (goto-char end
))
276 ((equal replacement
"")
278 (skip-chars-forward " \r\t\n")
280 (delete-region begin
(point)))
282 (goto-char match-start
)
283 (delete-region (point)
284 (save-excursion (goto-char end
)
285 (line-end-position)))
287 (if (or org-src-preserve-indentation
288 (org-element-property :preserve-indent
290 ;; Indent only the code block markers.
291 (save-excursion (skip-chars-backward " \r\t\n")
293 (goto-char match-start
)
294 (indent-line-to ind
))
295 ;; Indent everything.
296 (indent-rigidly match-start
(point) ind
)))))
297 (set-marker match-start nil
))))
298 (set-marker begin nil
)
299 (set-marker end nil
))))))))
301 (defun org-babel-exp-do-export (info type
&optional hash
)
302 "Return a string with the exported content of a code block.
303 The function respects the value of the :exports header argument."
304 (let ((silently (lambda () (let ((session (cdr (assoc :session
(nth 2 info
)))))
305 (unless (equal "none" session
)
306 (org-babel-exp-results info type
'silent
)))))
307 (clean (lambda () (if (eq type
'inline
)
308 (org-babel-remove-inline-result)
309 (org-babel-remove-result info
)))))
310 (pcase (or (cdr (assq :exports
(nth 2 info
))) "code")
311 ("none" (funcall silently
) (funcall clean
) "")
312 ("code" (funcall silently
) (funcall clean
) (org-babel-exp-code info type
))
313 ("results" (org-babel-exp-results info type nil hash
) "")
315 (org-babel-exp-results info type nil hash
)
316 (org-babel-exp-code info type
)))))
318 (defcustom org-babel-exp-code-template
319 "#+BEGIN_SRC %lang%switches%flags\n%body\n#+END_SRC"
320 "Template used to export the body of code blocks.
321 This template may be customized to include additional information
322 such as the code block name, or the values of particular header
323 arguments. The template is filled out using `org-fill-template',
324 and the following %keys may be used.
326 lang ------ the language of the code block
327 name ------ the name of the code block
328 body ------ the body of the code block
329 switches -- the switches associated to the code block
330 flags ----- the flags passed to the code block
332 In addition to the keys mentioned above, every header argument
333 defined for the code block may be used as a key and will be
334 replaced with its value."
338 (defcustom org-babel-exp-inline-code-template
339 "src_%lang[%switches%flags]{%body}"
340 "Template used to export the body of inline code blocks.
341 This template may be customized to include additional information
342 such as the code block name, or the values of particular header
343 arguments. The template is filled out using `org-fill-template',
344 and the following %keys may be used.
346 lang ------ the language of the code block
347 name ------ the name of the code block
348 body ------ the body of the code block
349 switches -- the switches associated to the code block
350 flags ----- the flags passed to the code block
352 In addition to the keys mentioned above, every header argument
353 defined for the code block may be used as a key and will be
354 replaced with its value."
358 :package-version
'(Org .
"8.3"))
360 (defun org-babel-exp-code (info type
)
361 "Return the original code block formatted for export."
363 (if (string= "strip-export" (cdr (assoc :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
)
371 (if (eq type
'inline
)
372 org-babel-exp-inline-code-template
373 org-babel-exp-code-template
)
374 `(("lang" .
,(nth 0 info
))
375 ("body" .
,(org-escape-code-in-string (nth 1 info
)))
376 ("switches" .
,(let ((f (nth 3 info
)))
377 (and (org-string-nw-p f
) (concat " " f
))))
378 ("flags" .
,(let ((f (assq :flags
(nth 2 info
))))
379 (and f
(concat " " (cdr f
)))))
380 ,@(mapcar (lambda (pair)
381 (cons (substring (symbol-name (car pair
)) 1)
382 (format "%S" (cdr pair
))))
384 ("name" .
,(or (nth 4 info
) "")))))
386 (defun org-babel-exp-results (info type
&optional silent hash
)
387 "Evaluate and return the results of the current code block for export.
388 Results are prepared in a manner suitable for export by org-mode.
389 This function is called by `org-babel-exp-do-export'. The code
390 block will be evaluated. Optional argument SILENT can be used to
391 inhibit insertion of results into the buffer."
392 (when (and (or (eq org-export-babel-evaluate t
)
393 (and (eq type
'inline
)
394 (eq org-export-babel-evaluate
'inline-only
)))
395 (not (and hash
(equal hash
(org-babel-current-result-hash)))))
396 (let ((lang (nth 0 info
))
397 (body (if (org-babel-noweb-p (nth 2 info
) :eval
)
398 (org-babel-expand-noweb-references
399 info org-babel-exp-reference-buffer
)
401 (info (copy-sequence info
))
402 (org-babel-current-src-block-location (point-marker)))
403 ;; Skip code blocks which we can't evaluate.
404 (when (fboundp (intern (concat "org-babel-execute:" lang
)))
405 (org-babel-eval-wipe-error-buffer)
407 (setf (nth 1 info
) body
)
409 (org-babel-exp-in-export-file lang
410 (org-babel-process-params
411 (org-babel-merge-params
413 `((:results .
,(if silent
"silent" "replace")))))))
415 (`block
(org-babel-execute-src-block nil info
))
417 ;; Position the point on the inline source block
418 ;; allowing `org-babel-insert-result' to check that the
420 (goto-char (nth 5 info
))
421 (org-babel-execute-src-block nil info
))
424 (re-search-backward org-babel-lob-one-liner-regexp nil t
)
425 (let (org-confirm-babel-evaluate)
426 (org-babel-execute-src-block nil info
))))))))))
431 ;;; ob-exp.el ends here