ob-exp.el 11 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316
  1. ;;; ob-exp.el --- Exportation of org-babel source blocks
  2. ;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
  3. ;; Author: Eric Schulte
  4. ;; Dan Davison
  5. ;; Keywords: literate programming, reproducible research
  6. ;; Homepage: http://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 <http://www.gnu.org/licenses/>.
  18. ;;; Code:
  19. (require 'ob)
  20. (require 'org-exp-blocks)
  21. (eval-when-compile
  22. (require 'cl))
  23. (defvar obe-marker nil)
  24. (defvar org-current-export-file)
  25. (defvar org-babel-lob-one-liner-regexp)
  26. (defvar org-babel-ref-split-regexp)
  27. (declare-function org-babel-lob-get-info "ob-lob" ())
  28. (declare-function org-babel-eval-wipe-error-buffer "ob-eval" ())
  29. (add-to-list 'org-export-interblocks '(src org-babel-exp-non-block-elements))
  30. (org-export-blocks-add-block '(src org-babel-exp-src-block nil))
  31. (defcustom org-export-babel-evaluate t
  32. "Switch controlling code evaluation during export.
  33. When set to nil no code will be evaluated as part of the export
  34. process."
  35. :group 'org-babel
  36. :version "24.1"
  37. :type 'boolean)
  38. (put 'org-export-babel-evaluate 'safe-local-variable (lambda (x) (eq x nil)))
  39. (defun org-babel-exp-get-export-buffer ()
  40. "Return the current export buffer if possible."
  41. (cond
  42. ((bufferp org-current-export-file) org-current-export-file)
  43. (org-current-export-file (get-file-buffer org-current-export-file))
  44. ('otherwise
  45. (error "Requested export buffer when `org-current-export-file' is nil"))))
  46. (defmacro org-babel-exp-in-export-file (lang &rest body)
  47. (declare (indent 1))
  48. `(let* ((lang-headers (intern (concat "org-babel-default-header-args:" ,lang)))
  49. (heading (nth 4 (ignore-errors (org-heading-components))))
  50. (export-buffer (current-buffer))
  51. (original-buffer (org-babel-exp-get-export-buffer)) results)
  52. (when original-buffer
  53. ;; resolve parameters in the original file so that
  54. ;; headline and file-wide parameters are included, attempt
  55. ;; to go to the same heading in the original file
  56. (set-buffer original-buffer)
  57. (save-restriction
  58. (when heading
  59. (condition-case nil
  60. (let ((org-link-search-inhibit-query t))
  61. (org-link-search heading))
  62. (error (when heading
  63. (goto-char (point-min))
  64. (re-search-forward (regexp-quote heading) nil t)))))
  65. (setq results ,@body))
  66. (set-buffer export-buffer)
  67. results)))
  68. (def-edebug-spec org-babel-exp-in-export-file (form body))
  69. (defun org-babel-exp-src-block (body &rest headers)
  70. "Process source block for export.
  71. Depending on the 'export' headers argument in replace the source
  72. code block with...
  73. both ---- display the code and the results
  74. code ---- the default, display the code inside the block but do
  75. not process
  76. results - just like none only the block is run on export ensuring
  77. that it's results are present in the org-mode buffer
  78. none ----- do not display either code or results upon export"
  79. (interactive)
  80. (unless noninteractive (message "org-babel-exp processing..."))
  81. (save-excursion
  82. (goto-char (match-beginning 0))
  83. (let* ((info (org-babel-get-src-block-info 'light))
  84. (lang (nth 0 info))
  85. (raw-params (nth 2 info)) hash)
  86. ;; bail if we couldn't get any info from the block
  87. (when info
  88. ;; if we're actually going to need the parameters
  89. (when (member (cdr (assoc :exports (nth 2 info))) '("both" "results"))
  90. (org-babel-exp-in-export-file lang
  91. (setf (nth 2 info)
  92. (org-babel-process-params
  93. (org-babel-merge-params
  94. org-babel-default-header-args
  95. (org-babel-params-from-properties lang)
  96. (if (boundp lang-headers) (eval lang-headers) nil)
  97. raw-params))))
  98. (setf hash (org-babel-sha1-hash info)))
  99. ;; expand noweb references in the original file
  100. (setf (nth 1 info)
  101. (if (string= "strip-export" (cdr (assoc :noweb (nth 2 info))))
  102. (replace-regexp-in-string
  103. (org-babel-noweb-wrap) "" (nth 1 info))
  104. (if (org-babel-noweb-p (nth 2 info) :export)
  105. (org-babel-expand-noweb-references
  106. info (org-babel-exp-get-export-buffer))
  107. (nth 1 info))))
  108. (org-babel-exp-do-export info 'block hash)))))
  109. (defcustom org-babel-exp-call-line-template
  110. ""
  111. "Template used to export call lines.
  112. This template may be customized to include the call line name
  113. with any export markup. The template is filled out using
  114. `org-fill-template', and the following %keys may be used.
  115. line --- call line
  116. An example value would be \"\\n: call: %line\" to export the call line
  117. wrapped in a verbatim environment.
  118. Note: the results are inserted separately after the contents of
  119. this template."
  120. :group 'org-babel
  121. :type 'string)
  122. (defvar org-babel-default-lob-header-args)
  123. (defun org-babel-exp-non-block-elements (start end)
  124. "Process inline source and call lines between START and END for export."
  125. (interactive)
  126. (save-excursion
  127. (goto-char start)
  128. (unless (markerp end)
  129. (let ((m (make-marker)))
  130. (set-marker m end (current-buffer))
  131. (setq end m)))
  132. (let ((rx (concat "\\(" org-babel-inline-src-block-regexp
  133. "\\|" org-babel-lob-one-liner-regexp "\\)")))
  134. (while (and (< (point) (marker-position end))
  135. (re-search-forward rx end t))
  136. (if (save-excursion
  137. (goto-char (match-beginning 0))
  138. (looking-at org-babel-inline-src-block-regexp))
  139. (progn
  140. (forward-char 1)
  141. (let* ((info (save-match-data
  142. (org-babel-parse-inline-src-block-match)))
  143. (params (nth 2 info)))
  144. (save-match-data
  145. (goto-char (match-beginning 2))
  146. (unless (org-babel-in-example-or-verbatim)
  147. ;; expand noweb references in the original file
  148. (setf (nth 1 info)
  149. (if (and (cdr (assoc :noweb params))
  150. (string= "yes" (cdr (assoc :noweb params))))
  151. (org-babel-expand-noweb-references
  152. info (org-babel-exp-get-export-buffer))
  153. (nth 1 info)))
  154. (let ((code-replacement (save-match-data
  155. (org-babel-exp-do-export
  156. info 'inline))))
  157. (if code-replacement
  158. (progn (replace-match code-replacement nil nil nil 1)
  159. (delete-char 1))
  160. (org-babel-examplize-region (match-beginning 1)
  161. (match-end 1))
  162. (forward-char 2)))))))
  163. (unless (org-babel-in-example-or-verbatim)
  164. (let* ((lob-info (org-babel-lob-get-info))
  165. (inlinep (match-string 11))
  166. (inline-start (match-end 11))
  167. (inline-end (match-end 0))
  168. (results (save-match-data
  169. (org-babel-exp-do-export
  170. (list "emacs-lisp" "results"
  171. (org-babel-merge-params
  172. org-babel-default-header-args
  173. org-babel-default-lob-header-args
  174. (org-babel-params-from-properties)
  175. (org-babel-parse-header-arguments
  176. (org-babel-clean-text-properties
  177. (concat ":var results="
  178. (mapconcat #'identity
  179. (butlast lob-info)
  180. " ")))))
  181. "" nil (car (last lob-info)))
  182. 'lob)))
  183. (rep (org-fill-template
  184. org-babel-exp-call-line-template
  185. `(("line" . ,(nth 0 lob-info))))))
  186. (if inlinep
  187. (save-excursion
  188. (goto-char inline-start)
  189. (delete-region inline-start inline-end)
  190. (insert rep))
  191. (replace-match rep t t)))))))))
  192. (defun org-babel-in-example-or-verbatim ()
  193. "Return true if point is in example or verbatim code.
  194. Example and verbatim code include escaped portions of
  195. an org-mode buffer code that should be treated as normal
  196. org-mode text."
  197. (or (save-match-data
  198. (save-excursion
  199. (goto-char (point-at-bol))
  200. (looking-at "[ \t]*:[ \t]")))
  201. (org-in-verbatim-emphasis)
  202. (org-in-block-p org-list-forbidden-blocks)
  203. (org-between-regexps-p "^[ \t]*#\\+begin_src" "^[ \t]*#\\+end_src")))
  204. (defun org-babel-exp-do-export (info type &optional hash)
  205. "Return a string with the exported content of a code block.
  206. The function respects the value of the :exports header argument."
  207. (flet ((silently () (let ((session (cdr (assoc :session (nth 2 info)))))
  208. (when (not (and session (equal "none" session)))
  209. (org-babel-exp-results info type 'silent))))
  210. (clean () (unless (eq type 'inline) (org-babel-remove-result info))))
  211. (case (intern (or (cdr (assoc :exports (nth 2 info))) "code"))
  212. ('none (silently) (clean) "")
  213. ('code (silently) (clean) (org-babel-exp-code info))
  214. ('results (org-babel-exp-results info type nil hash) "")
  215. ('both (org-babel-exp-results info type nil hash)
  216. (org-babel-exp-code info)))))
  217. (defcustom org-babel-exp-code-template
  218. "#+BEGIN_SRC %lang%flags\n%body\n#+END_SRC"
  219. "Template used to export the body of code blocks.
  220. This template may be customized to include additional information
  221. such as the code block name, or the values of particular header
  222. arguments. The template is filled out using `org-fill-template',
  223. and the following %keys may be used.
  224. lang ------ the language of the code block
  225. name ------ the name of the code block
  226. body ------ the body of the code block
  227. flags ----- the flags passed to the code block
  228. In addition to the keys mentioned above, every header argument
  229. defined for the code block may be used as a key and will be
  230. replaced with its value."
  231. :group 'org-babel
  232. :type 'string)
  233. (defun org-babel-exp-code (info)
  234. "Return the original code block formatted for export."
  235. (org-fill-template
  236. org-babel-exp-code-template
  237. `(("lang" . ,(nth 0 info))
  238. ("body" . ,(nth 1 info))
  239. ,@(mapcar (lambda (pair)
  240. (cons (substring (symbol-name (car pair)) 1)
  241. (format "%S" (cdr pair))))
  242. (nth 2 info))
  243. ("flags" . ,((lambda (f) (when f (concat " " f))) (nth 3 info)))
  244. ("name" . ,(or (nth 4 info) "")))))
  245. (defun org-babel-exp-results (info type &optional silent hash)
  246. "Evaluate and return the results of the current code block for export.
  247. Results are prepared in a manner suitable for export by org-mode.
  248. This function is called by `org-babel-exp-do-export'. The code
  249. block will be evaluated. Optional argument SILENT can be used to
  250. inhibit insertion of results into the buffer."
  251. (when (and org-export-babel-evaluate
  252. (not (and hash (equal hash (org-babel-current-result-hash)))))
  253. (let ((lang (nth 0 info))
  254. (body (nth 1 info))
  255. (info (copy-sequence info)))
  256. ;; skip code blocks which we can't evaluate
  257. (when (fboundp (intern (concat "org-babel-execute:" lang)))
  258. (org-babel-eval-wipe-error-buffer)
  259. (prog1 nil
  260. (setf (nth 2 info)
  261. (org-babel-exp-in-export-file lang
  262. (org-babel-process-params
  263. (org-babel-merge-params
  264. (nth 2 info)
  265. `((:results . ,(if silent "silent" "replace")))))))
  266. (cond
  267. ((equal type 'block)
  268. (org-babel-execute-src-block nil info))
  269. ((equal type 'inline)
  270. ;; position the point on the inline source block allowing
  271. ;; `org-babel-insert-result' to check that the block is
  272. ;; inline
  273. (re-search-backward "[ \f\t\n\r\v]" nil t)
  274. (re-search-forward org-babel-inline-src-block-regexp nil t)
  275. (re-search-backward "src_" nil t)
  276. (org-babel-execute-src-block nil info))
  277. ((equal type 'lob)
  278. (save-excursion
  279. (re-search-backward org-babel-lob-one-liner-regexp nil t)
  280. (org-babel-execute-src-block nil info)))))))))
  281. (provide 'ob-exp)
  282. ;;; ob-exp.el ends here