From ec615b192d703a0201ceefd46897e4636ff00a38 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Thu, 28 Apr 2016 17:25:31 +0200 Subject: [PATCH] Fix `org-export-babel-evaluate' handling * lisp/ob-exp.el (org-babel-exp-process-buffer): Handle `org-export-babel-evaluate' handling. (org-babel-exp-results): Ignore `org-export-babel-evaluate' since it is handled as a higher level. * lisp/ox.el (org-export-as): Allow to short-circuit babel evaluation if `org-export-babel-evaluate' is nil. * testing/lisp/test-ob-exp.el (ob-export/babel-evaluate): New test. Reported-by: Nicolas Richard --- lisp/ob-exp.el | 270 ++++++++++++++++++++++---------------------- lisp/ox.el | 7 +- testing/lisp/test-ob-exp.el | 50 ++++++++ 3 files changed, 189 insertions(+), 138 deletions(-) diff --git a/lisp/ob-exp.el b/lisp/ob-exp.el index 2e49a46b8..40dd5aa31 100644 --- a/lisp/ob-exp.el +++ b/lisp/ob-exp.el @@ -159,135 +159,138 @@ buffer being processed. It is used to properly resolve references in source blocks, as modifications in current buffer may make them unreachable." (interactive) - (save-window-excursion - (save-excursion - (let ((case-fold-search t) - (org-babel-exp-reference-buffer reference-buffer) - (regexp "\\(call\\|src\\)_\\|^[ \t]*#\\+\\(BEGIN_SRC\\|CALL:\\)")) - (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 - (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* ((lob-info (org-babel-lob-get-info element)) - (results - (org-babel-exp-do-export - (list "emacs-lisp" "results" - (apply #'org-babel-merge-params - org-babel-default-header-args - org-babel-default-lob-header-args - (append - (org-babel-params-from-properties) - (list - (org-babel-parse-header-arguments - (org-no-properties - (concat - ":var results=" - (mapconcat #'identity - (butlast lob-info 2) - " "))))))) - "" (nth 2 lob-info) (nth 3 lob-info)) - 'lob)) - (rep (org-fill-template - org-babel-exp-call-line-template - `(("line" . ,(nth 0 lob-info)))))) - ;; 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 following white - ;; spaces/newlines and then, insert replacement - ;; string. + (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:\\)"))) + (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 + (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) - (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 should be left as-is while an empty - ;; string should remove 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 the 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)))))))) + (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* ((lob-info (org-babel-lob-get-info element)) + (results + (org-babel-exp-do-export + (list "emacs-lisp" "results" + (apply #'org-babel-merge-params + org-babel-default-header-args + org-babel-default-lob-header-args + (append + (org-babel-params-from-properties) + (list + (org-babel-parse-header-arguments + (org-no-properties + (concat + ":var results=" + (mapconcat #'identity + (butlast lob-info 2) + " "))))))) + "" (nth 2 lob-info) (nth 3 lob-info)) + 'lob)) + (rep (org-fill-template + org-babel-exp-call-line-template + `(("line" . ,(nth 0 lob-info)))))) + ;; 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))))))))) (defun org-babel-exp-do-export (info type &optional hash) "Return a string with the exported content of a code block. @@ -380,10 +383,7 @@ Results are prepared in a manner suitable for export by Org mode. This function is called by `org-babel-exp-do-export'. The code block will be evaluated. Optional argument SILENT can be used to inhibit insertion of results into the buffer." - (when (and (or (eq org-export-babel-evaluate t) - (and (eq type 'inline) - (eq org-export-babel-evaluate 'inline-only))) - (not (and hash (equal hash (org-babel-current-result-hash))))) + (unless (and hash (equal hash (org-babel-current-result-hash))) (let ((lang (nth 0 info)) (body (if (org-babel-noweb-p (nth 2 info) :eval) (org-babel-expand-noweb-references @@ -412,9 +412,9 @@ inhibit insertion of results into the buffer." (org-babel-execute-src-block nil info)) (`lob (save-excursion - (goto-char (nth 5 info)) - (let (org-confirm-babel-evaluate) - (org-babel-execute-src-block nil info)))))))))) + (goto-char (nth 5 info)) + (let (org-confirm-babel-evaluate) + (org-babel-execute-src-block nil info)))))))))) (provide 'ob-exp) diff --git a/lisp/ox.el b/lisp/ox.el index d6b2de040..5ad17ecc3 100644 --- a/lisp/ox.el +++ b/lisp/ox.el @@ -3013,9 +3013,10 @@ Return code as a string." ;; again after executing Babel code. (org-set-regexps-and-options) (org-update-radio-target-regexp) - (org-export-execute-babel-code) - (org-set-regexps-and-options) - (org-update-radio-target-regexp) + (when org-export-babel-evaluate + (org-export-execute-babel-code) + (org-set-regexps-and-options) + (org-update-radio-target-regexp)) ;; Run last hook with current back-end's name as argument. ;; Update buffer properties and radio targets one last time ;; before parsing. diff --git a/testing/lisp/test-ob-exp.el b/testing/lisp/test-ob-exp.el index 393c441f8..6e1d73709 100644 --- a/testing/lisp/test-ob-exp.el +++ b/testing/lisp/test-ob-exp.el @@ -514,6 +514,56 @@ src_emacs-lisp{(+ 1 1)}" #+END_SRC" (org-export-execute-babel-code) t))) +(ert-deftest ob-export/babel-evaluate () + "Test `org-export-babel-evaluate' effect." + ;; When nil, no Babel code is executed. + (should-not + (string-match-p + "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)) + (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)) + (buffer-string)))) + ;; When non-nil, all Babel code types are executed. + (should + (string-match-p + "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)) + (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)) + (buffer-string)))) + ;; When set to `inline-only' limit evaluation to inline code. + (should-not + (string-match-p + "2" + (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)) + (buffer-string)))) + (should + (string-match-p + "2" + (org-test-with-temp-text + "src_emacs-lisp{(+ 1 1)}" + (let ((org-export-babel-evaluate 'inline-only)) + (org-export-execute-babel-code)) + (buffer-string))))) + (provide 'test-ob-exp) -- 2.11.4.GIT