ox: Remove `org-export-execute-babel-code'

* lisp/ox.el (org-export-execute-babel-code): Remove function.
(org-export-as): Replace previous function with
`org-babel-exp-process-buffer'.
* lisp/ob-exp.el (org-babel-exp-process-buffer): Change signature.
  Copy buffer before evaluating code.

* testing/lisp/test-ob-exp.el (ob-exp/exports-inline-code):
(ob-exp/exports-inline-code-double-eval):
(ob-exp/exports-inline-code-eval-code-once):
(ob-exp/exports-inline-code-double-eval-exports-both):
(ob-export/export-with-results-before-block):
(ob-export/export-src-block-with-switches):
(ob-export/export-src-block-with-flags):
(ob-export/export-and-indentation):
(ob-export/export-under-commented-headline):
(ob-export/reference-in-post-header):
(ob-export/babel-evaluate):
(org-test-with-expanded-babel-code):
* testing/lisp/test-ob-lob.el (test-ob-lob/export-lob-lines):
(test-ob-lob/do-not-eval-lob-lines-in-example-blocks-on-export): Apply
change.

This patch merges `org-export-execute-babel-code' within
`org-babel-exp-process-buffer', removing one level of indirection.  Now,
all the Babel evaluation is on the Babel side.
This commit is contained in:
Nicolas Goaziou 2016-06-18 22:11:14 +02:00
parent f195259821
commit cfaf0d54d7
4 changed files with 173 additions and 168 deletions

View File

@ -24,25 +24,24 @@
;;; Code:
(require 'ob-core)
(require 'org-src)
(eval-when-compile
(require 'cl))
(defvar org-babel-ref-split-regexp)
(declare-function org-babel-lob-get-info "ob-lob" (&optional datum))
(declare-function org-babel-eval-wipe-error-buffer "ob-eval" ())
(declare-function org-get-indentation "org" (&optional line))
(declare-function org-heading-components "org" ())
(declare-function org-in-commented-heading-p "org" (&optional no-inheritance))
(declare-function org-link-search "org" (s &optional avoid-pos stealth))
(declare-function org-fill-template "org" (template alist))
(declare-function org-split-string "org" (string &optional separators))
(declare-function org-element-at-point "org-element" ())
(declare-function org-element-context "org-element" (&optional element))
(declare-function org-element-property "org-element" (property element))
(declare-function org-element-type "org-element" (element))
(declare-function org-export-copy-buffer "ox" ())
(declare-function org-fill-template "org" (template alist))
(declare-function org-get-indentation "org" (&optional line))
(declare-function org-heading-components "org" ())
(declare-function org-id-get "org-id" (&optional pom create prefix))
(declare-function org-in-commented-heading-p "org" (&optional no-inheritance))
(declare-function org-link-search "org" (s &optional avoid-pos stealth))
(declare-function org-split-string "org" (string &optional separators))
(defvar org-src-preserve-indentation)
(defcustom org-export-babel-evaluate t
"Switch controlling code evaluation during export.
@ -146,132 +145,145 @@ this template."
:group 'org-babel
:type 'string)
(defvar org-babel-default-lob-header-args)
(defun org-babel-exp-process-buffer (reference-buffer)
"Execute all Babel blocks in current buffer.
REFERENCE-BUFFER is the buffer containing a pristine copy of the
buffer being processed. It is used to properly resolve
references in source blocks, as modifications in current buffer
may make them unreachable."
(defun org-babel-exp-process-buffer ()
"Execute all Babel blocks in current buffer."
(interactive)
(when org-export-babel-evaluate
(save-window-excursion
(save-excursion
(let ((case-fold-search t)
(org-babel-exp-reference-buffer reference-buffer)
(regexp
(if (eq org-export-babel-evaluate 'inline-only)
"\\(call\\|src\\)_"
"\\(call\\|src\\)_\\|^[ \t]*#\\+\\(BEGIN_SRC\\|CALL:\\)")))
"\\(call\\|src\\)_\\|^[ \t]*#\\+\\(BEGIN_SRC\\|CALL:\\)"))
;; Get a pristine copy of current buffer so Babel
;; references are properly resolved and source block
;; context is preserved.
(org-babel-exp-reference-buffer (org-export-copy-buffer)))
(goto-char (point-min))
(while (re-search-forward regexp nil t)
(unless (save-match-data (org-in-commented-heading-p))
(let* ((element (save-match-data (org-element-context)))
(type (org-element-type element))
(begin (copy-marker (org-element-property :begin element)))
(end (copy-marker
(unwind-protect
(while (re-search-forward regexp nil t)
(unless (save-match-data (org-in-commented-heading-p))
(let* ((element (save-match-data (org-element-context)))
(type (org-element-type element))
(begin
(copy-marker (org-element-property :begin element)))
(end
(copy-marker
(save-excursion
(goto-char (org-element-property :end element))
(skip-chars-backward " \r\t\n")
(point)))))
(case type
(inline-src-block
(let* ((info (org-babel-get-src-block-info nil element))
(params (nth 2 info)))
(setf (nth 1 info)
(if (and (cdr (assoc :noweb params))
(string= "yes" (cdr (assoc :noweb params))))
(org-babel-expand-noweb-references
info org-babel-exp-reference-buffer)
(nth 1 info)))
(goto-char begin)
(let ((replacement (org-babel-exp-do-export info 'inline)))
(if (equal replacement "")
;; Replacement code is empty: remove inline
;; source block, including extra white
;; space that might have been created when
;; inserting results.
(delete-region begin
(progn (goto-char end)
(skip-chars-forward " \t")
(point)))
;; Otherwise: remove inline src block but
;; preserve following white spaces. Then
;; insert value.
(delete-region begin end)
(insert replacement)))))
((babel-call inline-babel-call)
(let ((results (org-babel-exp-do-export
(org-babel-lob-get-info element)
'lob))
(rep
(org-fill-template
org-babel-exp-call-line-template
`(("line" .
,(org-element-property :value element))))))
;; If replacement is empty, completely remove the
;; object/element, including any extra white
;; space that might have been created when
;; including results.
(if (equal rep "")
(delete-region
begin
(progn (goto-char end)
(if (not (eq type 'babel-call))
(progn (skip-chars-forward " \t") (point))
(skip-chars-forward " \r\t\n")
(line-beginning-position))))
;; Otherwise, preserve trailing spaces/newlines
;; and then, insert replacement string.
(goto-char begin)
(delete-region begin end)
(insert rep))))
(src-block
(let* ((match-start (copy-marker (match-beginning 0)))
(ind (org-get-indentation))
(lang (or (org-element-property :language element)
(user-error
"No language for src block: %s"
(or (org-element-property :name element)
"(unnamed)"))))
(headers
(cons lang
(let ((params
(org-element-property
:parameters element)))
(and params (org-split-string params))))))
;; Take care of matched block: compute
;; replacement string. In particular, a nil
;; REPLACEMENT means the block is left as-is
;; while an empty string removes the block.
(let ((replacement
(progn (goto-char match-start)
(org-babel-exp-src-block headers))))
(cond ((not replacement) (goto-char end))
((equal replacement "")
(goto-char end)
(skip-chars-forward " \r\t\n")
(beginning-of-line)
(delete-region begin (point)))
(t
(goto-char match-start)
(delete-region (point)
(save-excursion (goto-char end)
(line-end-position)))
(insert replacement)
(if (or org-src-preserve-indentation
(org-element-property :preserve-indent
element))
;; Indent only code block markers.
(save-excursion (skip-chars-backward " \r\t\n")
(indent-line-to ind)
(goto-char match-start)
(indent-line-to ind))
;; Indent everything.
(indent-rigidly match-start (point) ind)))))
(set-marker match-start nil))))
(set-marker begin nil)
(set-marker end nil)))))))))
(case type
(inline-src-block
(let* ((info
(org-babel-get-src-block-info nil element))
(params (nth 2 info)))
(setf (nth 1 info)
(if (and (cdr (assoc :noweb params))
(string= "yes"
(cdr (assq :noweb params))))
(org-babel-expand-noweb-references
info org-babel-exp-reference-buffer)
(nth 1 info)))
(goto-char begin)
(let ((replacement
(org-babel-exp-do-export info 'inline)))
(if (equal replacement "")
;; Replacement code is empty: remove
;; inline source block, including extra
;; white space that might have been
;; created when inserting results.
(delete-region begin
(progn (goto-char end)
(skip-chars-forward " \t")
(point)))
;; Otherwise: remove inline src block but
;; preserve following white spaces. Then
;; insert value.
(delete-region begin end)
(insert replacement)))))
((babel-call inline-babel-call)
(let ((results (org-babel-exp-do-export
(org-babel-lob-get-info element)
'lob))
(rep
(org-fill-template
org-babel-exp-call-line-template
`(("line" .
,(org-element-property :value element))))))
;; If replacement is empty, completely remove
;; the object/element, including any extra
;; white space that might have been created
;; when including results.
(if (equal rep "")
(delete-region
begin
(progn (goto-char end)
(if (not (eq type 'babel-call))
(progn (skip-chars-forward " \t")
(point))
(skip-chars-forward " \r\t\n")
(line-beginning-position))))
;; Otherwise, preserve trailing
;; spaces/newlines and then, insert
;; replacement string.
(goto-char begin)
(delete-region begin end)
(insert rep))))
(src-block
(let* ((match-start (copy-marker (match-beginning 0)))
(ind (org-get-indentation))
(lang
(or (org-element-property :language element)
(user-error
"No language for src block: %s"
(or (org-element-property :name element)
"(unnamed)"))))
(headers
(cons lang
(let ((params
(org-element-property
:parameters element)))
(and params
(org-split-string params))))))
;; Take care of matched block: compute
;; replacement string. In particular, a nil
;; REPLACEMENT means the block is left as-is
;; while an empty string removes the block.
(let ((replacement
(progn (goto-char match-start)
(org-babel-exp-src-block headers))))
(cond ((not replacement) (goto-char end))
((equal replacement "")
(goto-char end)
(skip-chars-forward " \r\t\n")
(beginning-of-line)
(delete-region begin (point)))
(t
(goto-char match-start)
(delete-region (point)
(save-excursion
(goto-char end)
(line-end-position)))
(insert replacement)
(if (or org-src-preserve-indentation
(org-element-property
:preserve-indent element))
;; Indent only code block
;; markers.
(save-excursion
(skip-chars-backward " \r\t\n")
(indent-line-to ind)
(goto-char match-start)
(indent-line-to ind))
;; Indent everything.
(indent-rigidly
match-start (point) ind)))))
(set-marker match-start nil))))
(set-marker begin nil)
(set-marker end nil))))
(kill-buffer org-babel-exp-reference-buffer)))))))
(defun org-babel-exp-do-export (info type &optional hash)
"Return a string with the exported content of a code block.

View File

@ -78,8 +78,7 @@
(declare-function org-publish "ox-publish" (project &optional force async))
(declare-function org-publish-all "ox-publish" (&optional force async))
(declare-function
org-publish-current-file "ox-publish" (&optional force async))
(declare-function org-publish-current-file "ox-publish" (&optional force async))
(declare-function org-publish-current-project "ox-publish"
(&optional force async))
@ -3014,7 +3013,7 @@ Return code as a string."
(org-set-regexps-and-options)
(org-update-radio-target-regexp)
(when org-export-babel-evaluate
(org-export-execute-babel-code)
(org-babel-exp-process-buffer)
(org-set-regexps-and-options)
(org-update-radio-target-regexp))
;; Run last hook with current back-end's name as argument.
@ -3552,14 +3551,6 @@ the included document."
(set-marker marker-max nil)))
(org-element-normalize-string (buffer-string))))
(defun org-export-execute-babel-code ()
"Execute every Babel code in the visible part of current buffer."
;; Get a pristine copy of current buffer so Babel references can be
;; properly resolved.
(let ((reference (org-export-copy-buffer)))
(unwind-protect (org-babel-exp-process-buffer reference)
(kill-buffer reference))))
(defun org-export--copy-to-kill-ring-p ()
"Return a non-nil value when output should be added to the kill ring.
See also `org-export-copy-to-kill-ring'."

View File

@ -27,13 +27,14 @@
(defmacro org-test-with-expanded-babel-code (&rest body)
"Execute BODY while in a buffer with all Babel code evaluated.
Current buffer is a copy of the original buffer."
`(let ((string (buffer-string))
(buf (current-buffer))
`(let ((string (org-with-wide-buffer (buffer-string)))
(narrowing (list (point-min) (point-max)))
(org-export-babel-evaluate t))
(with-temp-buffer
(org-mode)
(insert string)
(org-babel-exp-process-buffer buf)
(apply #'narrow-to-region narrowing)
(org-babel-exp-process-buffer)
(goto-char (point-min))
(progn ,@body))))
@ -206,39 +207,39 @@ Here is one at the end of a line. {{{results(=2=)}}}
(string-match "\\`src_emacs-lisp\\(?:\\[]\\)?{(\\+ 1 1)}$"
(org-test-with-temp-text
"src_emacs-lisp[:exports code]{(+ 1 1)}"
(org-export-execute-babel-code)
(org-babel-exp-process-buffer)
(buffer-string))))
(should
(string-match "\\`src_emacs-lisp\\(?:\\[]\\)?{(\\+ 1 1)}$"
(org-test-with-temp-text
"src_emacs-lisp[ :exports code ]{(+ 1 1)}"
(org-export-execute-babel-code)
(org-babel-exp-process-buffer)
(buffer-string))))
(should
(string-match "\\`src_emacs-lisp\\(?:\\[]\\)?{(\\+ 1 1)} {{{results(=2=)}}}$"
(org-test-with-temp-text
"src_emacs-lisp[:exports both]{(+ 1 1)}"
(org-export-execute-babel-code)
(org-babel-exp-process-buffer)
(buffer-string))))
(should
(string-match "\\`{{{results(=2=)}}}$"
(org-test-with-temp-text
"src_emacs-lisp[:exports results :results scalar]{(+ 1 1)}"
(org-export-execute-babel-code)
(org-babel-exp-process-buffer)
(buffer-string))))
(should
(let ((text "foosrc_emacs-lisp[:exports code]{(+ 1 1)}"))
(string-match (regexp-quote text)
(org-test-with-temp-text
text
(org-export-execute-babel-code)
(org-babel-exp-process-buffer)
(buffer-string)))))
(should
(let ((text "src_emacs lisp{(+ 1 1)}"))
(string-match (regexp-quote text)
(org-test-with-temp-text
text
(org-export-execute-babel-code)
(org-babel-exp-process-buffer)
(buffer-string)))))
(should
(string-match
@ -263,7 +264,7 @@ evaluated."
(string-match "\\`{{{results(src_emacs-lisp\\[\\]{2})}}}$"
(org-test-with-temp-text
"src_emacs-lisp[:exports results :results code]{(+ 1 1)}"
(org-export-execute-babel-code)
(org-babel-exp-process-buffer)
(buffer-string))))))
(ert-deftest ob-exp/exports-inline-code-eval-code-once ()
@ -275,7 +276,7 @@ be evaluated."
(org-test-with-temp-text
(concat "src_emacs-lisp[:exports results :results code "
":results_switches \":exports code\"]{(+ 1 1)}")
(org-export-execute-babel-code)
(org-babel-exp-process-buffer)
(buffer-string))))))
(ert-deftest ob-exp/exports-inline-code-double-eval-exports-both ()
@ -286,7 +287,7 @@ be evaluated."
(org-test-with-temp-text
(concat "src_emacs-lisp[:exports both :results code "
":results_switches \":exports code\"]{(+ 1 1)}")
(org-export-execute-babel-code)
(org-babel-exp-process-buffer)
(buffer-string))))))
(ert-deftest ob-exp/export-call-line-information ()
@ -393,7 +394,7 @@ be evaluated."
#+BEGIN_SRC emacs-lisp :exports both
\(+ 1 1)
#+END_SRC"
(org-export-execute-babel-code)
(org-babel-exp-process-buffer)
(org-trim (org-no-properties (buffer-string))))))))
(ert-deftest ob-export/export-src-block-with-switches ()
@ -403,7 +404,7 @@ be evaluated."
"\\`#\\+BEGIN_SRC emacs-lisp -n -r$"
(org-test-with-temp-text
"#+BEGIN_SRC emacs-lisp -n -r\n\(+ 1 1)\n#+END_SRC"
(org-export-execute-babel-code)
(org-babel-exp-process-buffer)
(buffer-string)))))
(ert-deftest ob-export/export-src-block-with-flags ()
@ -413,7 +414,7 @@ be evaluated."
"\\`#\\+BEGIN_SRC emacs-lisp -some-flag$"
(org-test-with-temp-text
"#+BEGIN_SRC emacs-lisp :flags -some-flag\n\(+ 1 1)\n#+END_SRC"
(org-export-execute-babel-code)
(org-babel-exp-process-buffer)
(buffer-string)))))
(ert-deftest ob-export/export-and-indentation ()
@ -426,7 +427,7 @@ be evaluated."
(let ((indent-tabs-mode t)
(tab-width 1)
(org-src-preserve-indentation nil))
(org-export-execute-babel-code)
(org-babel-exp-process-buffer)
(buffer-string)))))
;; Preserve indentation with "-i" flag.
(should
@ -435,7 +436,7 @@ be evaluated."
(org-test-with-temp-text "#+BEGIN_SRC emacs-lisp -i\n t\n#+END_SRC"
(let ((indent-tabs-mode t)
(tab-width 1))
(org-export-execute-babel-code)
(org-babel-exp-process-buffer)
(buffer-string)))))
;; Preserve indentation with a non-nil
;; `org-src-preserve-indentation'.
@ -446,7 +447,7 @@ be evaluated."
(let ((indent-tabs-mode t)
(tab-width 1)
(org-src-preserve-indentation t))
(org-export-execute-babel-code)
(org-babel-exp-process-buffer)
(buffer-string))))))
(ert-deftest ob-export/export-under-commented-headline ()
@ -461,7 +462,7 @@ be evaluated."
#+BEGIN_SRC emacs-lisp :exports results
\(+ 1 1)
#+END_SRC"
(org-export-execute-babel-code)
(org-babel-exp-process-buffer)
(buffer-string))))
(should-not
(string-match
@ -470,7 +471,7 @@ be evaluated."
#+BEGIN_SRC emacs-lisp :exports results
\(+ 1 1)
#+END_SRC"
(org-export-execute-babel-code)
(org-babel-exp-process-buffer)
(buffer-string))))
;; Do not eval inline blocks either.
(should
@ -478,14 +479,14 @@ be evaluated."
"=2="
(org-test-with-temp-text "* Headline
src_emacs-lisp{(+ 1 1)}"
(org-export-execute-babel-code)
(org-babel-exp-process-buffer)
(buffer-string))))
(should-not
(string-match
"=2="
(org-test-with-temp-text "* COMMENT Headline
src_emacs-lisp{(+ 1 1)}"
(org-export-execute-babel-code)
(org-babel-exp-process-buffer)
(buffer-string))))
;; Also check parent headlines.
(should-not
@ -497,7 +498,7 @@ src_emacs-lisp{(+ 1 1)}"
#+BEGIN_SRC emacs-lisp :exports results
\(+ 1 1)
#+END_SRC"
(org-export-execute-babel-code)
(org-babel-exp-process-buffer)
(buffer-string))))))
(ert-deftest ob-export/reference-in-post-header ()
@ -512,7 +513,7 @@ src_emacs-lisp{(+ 1 1)}"
#+NAME: nofun
#+BEGIN_SRC emacs-lisp :exports results :post foo(\"nofun\")
#+END_SRC"
(org-export-execute-babel-code) t)))
(org-babel-exp-process-buffer) t)))
(ert-deftest ob-export/babel-evaluate ()
"Test `org-export-babel-evaluate' effect."
@ -522,14 +523,14 @@ src_emacs-lisp{(+ 1 1)}"
"2"
(org-test-with-temp-text
"#+BEGIN_SRC emacs-lisp :exports results\n(+ 1 1)\n#+END_SRC"
(let ((org-export-babel-evaluate nil)) (org-export-execute-babel-code))
(let ((org-export-babel-evaluate nil)) (org-babel-exp-process-buffer))
(buffer-string))))
(should-not
(string-match-p
"2"
(org-test-with-temp-text
"src_emacs-lisp{(+ 1 1)}"
(let ((org-export-babel-evaluate nil)) (org-export-execute-babel-code))
(let ((org-export-babel-evaluate nil)) (org-babel-exp-process-buffer))
(buffer-string))))
;; When non-nil, all Babel code types are executed.
(should
@ -537,14 +538,14 @@ src_emacs-lisp{(+ 1 1)}"
"2"
(org-test-with-temp-text
"#+BEGIN_SRC emacs-lisp :exports results\n(+ 1 1)\n#+END_SRC"
(let ((org-export-babel-evaluate t)) (org-export-execute-babel-code))
(let ((org-export-babel-evaluate t)) (org-babel-exp-process-buffer))
(buffer-string))))
(should
(string-match-p
"2"
(org-test-with-temp-text
"src_emacs-lisp{(+ 1 1)}"
(let ((org-export-babel-evaluate t)) (org-export-execute-babel-code))
(let ((org-export-babel-evaluate t)) (org-babel-exp-process-buffer))
(buffer-string))))
;; When set to `inline-only' limit evaluation to inline code.
(should-not
@ -553,7 +554,7 @@ src_emacs-lisp{(+ 1 1)}"
(org-test-with-temp-text
"#+BEGIN_SRC emacs-lisp :exports results\n(+ 1 1)\n#+END_SRC"
(let ((org-export-babel-evaluate 'inline-only))
(org-export-execute-babel-code))
(org-babel-exp-process-buffer))
(buffer-string))))
(should
(string-match-p
@ -561,7 +562,7 @@ src_emacs-lisp{(+ 1 1)}"
(org-test-with-temp-text
"src_emacs-lisp{(+ 1 1)}"
(let ((org-export-babel-evaluate 'inline-only))
(org-export-execute-babel-code))
(org-babel-exp-process-buffer))
(buffer-string)))))

View File

@ -83,12 +83,13 @@
(org-export-babel-evaluate t))
(org-test-at-id "72ddeed3-2d17-4c7f-8192-a575d535d3fc"
(org-narrow-to-subtree)
(let ((buf (current-buffer))
(string (buffer-string)))
(let ((string (org-with-wide-buffer (buffer-string)))
(narrowing (list (point-min) (point-max))))
(with-temp-buffer
(org-mode)
(insert string)
(org-babel-exp-process-buffer buf)
(apply #'narrow-to-region narrowing)
(org-babel-exp-process-buffer)
(message (buffer-string))
(goto-char (point-min))
(should (re-search-forward "^: 0" nil t))
@ -106,7 +107,7 @@ for export
#+begin_example
#+call: rubbish()
#+end_example"
(should (progn (org-export-execute-babel-code) t))))
(should (progn (org-babel-exp-process-buffer) t))))
(ert-deftest test-ob-lob/caching-call-line ()
(let ((temporary-value-for-test 0))