diff --git a/lisp/ob-exp.el b/lisp/ob-exp.el index 769b7f021..1791b9c06 100644 --- a/lisp/ob-exp.el +++ b/lisp/ob-exp.el @@ -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. diff --git a/lisp/ox.el b/lisp/ox.el index d85c6ef26..96310afe4 100644 --- a/lisp/ox.el +++ b/lisp/ox.el @@ -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'." diff --git a/testing/lisp/test-ob-exp.el b/testing/lisp/test-ob-exp.el index 6e1d73709..b25f121a7 100644 --- a/testing/lisp/test-ob-exp.el +++ b/testing/lisp/test-ob-exp.el @@ -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))))) diff --git a/testing/lisp/test-ob-lob.el b/testing/lisp/test-ob-lob.el index 7f769c931..6da58b236 100644 --- a/testing/lisp/test-ob-lob.el +++ b/testing/lisp/test-ob-lob.el @@ -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))