branch: externals/org
commit 3bbbf77f36a0654bcfa3e9aec6d944eea284b381
Author: Ihor Radchenko <yanta...@gmail.com>
Commit: Ihor Radchenko <yanta...@gmail.com>
org-babel-exp-process-buffer: Improve performance
* lisp/ob-exp.el (org-babel-exp-src-block): New optional argument
providing ELEMENT at point.
(org-babel-exp-code-template): Use lower-case #+begin/#+end lines to
avoid triggering source code block changes when the blocks are
exported with :exports code and also contain lower-case
#+begin/#+end. We prefer lower-case default because other parts of
Org, like `org-insert-structure-template' default to lower-case as
well.
(org-babel-exp-process-buffer): Do no disable cache as changes are not
expected to be as frequent anymore. Pass pre-calculated element at
point to inner function calls to `org-in-commented-heading-p',
`org-in-archived-heading-p', `org-element-context', and
`org-babel-exp-src-block'. Do not force-replace source block contents
when no change is required.
* testing/lisp/test-ob-exp.el (ob-export/export-with-results-before-block):
(ob-export/body-with-coderef):
(ob-exp/src-block-with-affiliated-keyword): Update tests according to
the new `org-babel-exp-code-template'.
---
lisp/ob-exp.el | 300 ++++++++++++++++++++++++--------------------
testing/lisp/test-ob-exp.el | 10 +-
2 files changed, 170 insertions(+), 140 deletions(-)
diff --git a/lisp/ob-exp.el b/lisp/ob-exp.el
index b1144b1d29..7b250f6bbc 100644
--- a/lisp/ob-exp.el
+++ b/lisp/ob-exp.el
@@ -66,7 +66,7 @@ point is at the beginning of the Babel block."
(when source (goto-char source))
,@body))))
-(defun org-babel-exp-src-block ()
+(defun org-babel-exp-src-block (&optional element)
"Process source block for export.
Depending on the \":export\" header argument, replace the source
code block like this:
@@ -81,10 +81,12 @@ results - just like none only the block is run on export
ensuring
none ---- do not display either code or results upon export
+Optional argument ELEMENT must contain source block element at point.
+
Assume point is at block opening line."
(interactive)
(save-excursion
- (let* ((info (org-babel-get-src-block-info))
+ (let* ((info (org-babel-get-src-block-info nil element))
(lang (nth 0 info))
(raw-params (nth 2 info))
hash)
@@ -137,7 +139,8 @@ this template."
;; 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)))
+ (org-babel-exp-reference-buffer (org-export-copy-buffer))
+ element)
(unwind-protect
(save-excursion
;; First attach to every source block their original
@@ -158,139 +161,166 @@ this template."
;; encountered.
(goto-char (point-min))
;; We are about to do a large number of changes in
- ;; buffer. Do not try to track them in cache and update
- ;; the folding states. Reset the cache afterwards.
- (org-element-with-disabled-cache
- (org-fold-core-ignore-modifications
- (while (re-search-forward regexp nil t)
- (unless (save-match-data (or (org-in-commented-heading-p)
- (org-in-archived-heading-p)))
- (let* ((object? (match-end 1))
- (element (save-match-data
- (if object? (org-element-context)
- ;; No deep inspection if we're
- ;; just looking for an element.
- (org-element-at-point))))
- (type
- (pcase (org-element-type element)
- ;; Discard block elements if we're looking
- ;; for inline objects. False results
- ;; happen when, e.g., "call_" syntax is
- ;; located within affiliated keywords:
- ;;
- ;; #+name: call_src
- ;; #+begin_src ...
- ((and (or `babel-call `src-block) (guard
object?))
- nil)
- (type type)))
- (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)))))
- (pcase 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 (assq :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 source block
- ;; but preserve following white spaces.
- ;; Then insert value.
+ ;; buffer, but we do not care about folding in this
+ ;; buffer.
+ (org-fold-core-ignore-modifications
+ (while (re-search-forward regexp nil t)
+ (setq element (org-element-at-point))
+ (unless (save-match-data
+ (or (org-in-commented-heading-p nil element)
+ (org-in-archived-heading-p nil element)))
+ (let* ((object? (match-end 1))
+ (element (save-match-data
+ (if object?
+ (org-element-context element)
+ ;; No deep inspection if we're
+ ;; just looking for an element.
+ element)))
+ (type
+ (pcase (org-element-type element)
+ ;; Discard block elements if we're looking
+ ;; for inline objects. False results
+ ;; happen when, e.g., "call_" syntax is
+ ;; located within affiliated keywords:
+ ;;
+ ;; #+name: call_src
+ ;; #+begin_src ...
+ ((and (or `babel-call `src-block) (guard object?))
+ nil)
+ (type type)))
+ (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)))))
+ (pcase 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 (assq :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 source block
+ ;; but preserve following white spaces.
+ ;; Then insert value.
+ (unless (string= replacement
+ (buffer-substring begin end))
(delete-region begin end)
- (insert replacement)))))
- ((or `babel-call `inline-babel-call)
- (org-babel-exp-do-export
- (or (org-babel-lob-get-info element)
- (user-error "Unknown Babel reference: %s"
- (org-element-property :call
element)))
- 'lob)
- (let ((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 (current-indentation)))
- ;; 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))))
- (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.
+ (insert replacement))))))
+ ((or `babel-call `inline-babel-call)
+ (org-babel-exp-do-export
+ (or (org-babel-lob-get-info element)
+ (user-error "Unknown Babel reference: %s"
+ (org-element-property :call
element)))
+ 'lob)
+ (let ((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 (current-indentation)))
+ ;; 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 element))))
+ (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
+ (if (or org-src-preserve-indentation
+ (org-element-property
+ :preserve-indent element))
+ ;; Indent only code block
+ ;; markers.
+ (with-temp-buffer
+ ;; Do not use tabs for block
+ ;; indentation.
+ (when (fboundp 'indent-tabs-mode)
+ (indent-tabs-mode -1)
+ ;; FIXME: Emacs 26
+ ;; compatibility.
+ (setq-local indent-tabs-mode nil))
+ (insert replacement)
+ (skip-chars-backward " \r\t\n")
+ (indent-line-to ind)
+ (goto-char 1)
+ (indent-line-to ind)
+ (setq replacement (buffer-string)))
+ ;; Indent everything.
+ (with-temp-buffer
+ ;; Do not use tabs for block
+ ;; indentation.
+ (when (fboundp 'indent-tabs-mode)
+ (indent-tabs-mode -1)
+ ;; FIXME: Emacs 26
+ ;; compatibility.
+ (setq-local indent-tabs-mode nil))
+ (insert replacement)
(indent-rigidly
- match-start (point) ind)))))
- (set-marker match-start nil))))
- (set-marker begin nil)
- (set-marker end nil))))))
- ;; Reset the outdated cache.
- (org-element-cache-reset))
+ 1 (point) ind)
+ (setq replacement (buffer-string))))
+ (goto-char match-start)
+ (let ((rend (save-excursion
+ (goto-char end)
+ (line-end-position))))
+ (if (string-equal replacement
+ (buffer-substring
match-start rend))
+ (goto-char rend)
+ (delete-region match-start
+ (save-excursion
+ (goto-char end)
+ (line-end-position)))
+ (insert replacement))))))
+ (set-marker match-start nil))))
+ (set-marker begin nil)
+ (set-marker end nil))))))
(kill-buffer org-babel-exp-reference-buffer)
(remove-text-properties (point-min) (point-max)
'(org-reference nil)))))))
@@ -313,7 +343,7 @@ The function respects the value of the :exports header
argument."
(org-babel-exp-code info type)))))
(defcustom org-babel-exp-code-template
- "#+BEGIN_SRC %lang%switches%flags\n%body\n#+END_SRC"
+ "#+begin_src %lang%switches%flags\n%body\n#+end_src"
"Template used to export the body of code blocks.
This template may be customized to include additional information
such as the code block name, or the values of particular header
diff --git a/testing/lisp/test-ob-exp.el b/testing/lisp/test-ob-exp.el
index 6cd7514a55..1289745aea 100644
--- a/testing/lisp/test-ob-exp.el
+++ b/testing/lisp/test-ob-exp.el
@@ -398,9 +398,9 @@ be evaluated."
: 2
#+NAME: src1
-#+BEGIN_SRC emacs-lisp
+#+begin_src emacs-lisp
\(+ 1 1)
-#+END_SRC"
+#+end_src"
(org-test-with-temp-text
"#+RESULTS: src1
@@ -565,7 +565,7 @@ src_emacs-lisp{(+ 1 1)}"
(ert-deftest ob-export/body-with-coderef ()
"Test exporting a code block with coderefs."
(should
- (equal "#+BEGIN_SRC emacs-lisp\n0 (ref:foo)\n#+END_SRC"
+ (equal "#+begin_src emacs-lisp\n0 (ref:foo)\n#+end_src"
(org-test-with-temp-text
"#+BEGIN_SRC emacs-lisp :exports code\n0 (ref:foo)\n#+END_SRC"
(let ((org-export-use-babel t)
@@ -574,7 +574,7 @@ src_emacs-lisp{(+ 1 1)}"
(buffer-string))))
(should
(equal
- "#+BEGIN_SRC emacs-lisp -l \"r:%s\"\n1 r:foo\n#+END_SRC"
+ "#+begin_src emacs-lisp -l \"r:%s\"\n1 r:foo\n#+end_src"
(org-test-with-temp-text
"#+BEGIN_SRC emacs-lisp -l \"r:%s\" -lisp :exports code\n1
r:foo\n#+END_SRC"
(let ((org-export-use-babel t))
@@ -586,7 +586,7 @@ src_emacs-lisp{(+ 1 1)}"
;; Pathological case: affiliated keyword matches inline source block
;; syntax.
(should
- (equal "#+name: call_foo\n#+BEGIN_SRC emacs-lisp\n42\n#+END_SRC"
+ (equal "#+name: call_foo\n#+begin_src emacs-lisp\n42\n#+end_src"
(org-test-with-temp-text
"#+name: call_foo\n#+BEGIN_SRC emacs-lisp\n42\n#+END_SRC"
(let ((org-export-use-babel t))
