org-html-format-latex: Avoid unnecessary string allocation

* lisp/ox.el (org-export--generate-copy-script): Add new optional
arguments to limit what is being copied.
(org-export-copy-buffer): Allow copying into provided buffer and copy
selectively passing the new optional arguments to
`org-export--generate-copy-script'.  Do not try to check if all the
local variable values are `read'able - it is only needed during async
export.
* lisp/ox-html.el (org-html-format-latex): Re-use the same hidden
buffer during export.  Only copy local variables into that buffer.

This commit avoids excessive calls to `org-mode' and copying the
exported buffer contents for every single latex fragment.  The result
is lower impact on GC and better overall performance.

Reported-by: Rudolf Adamkovič <salutis@me.com>
Link: https://list.orgmode.org/m2zgef774u.fsf@me.com/T/#t
This commit is contained in:
Ihor Radchenko 2022-10-05 15:01:06 +08:00
parent b45911d41e
commit 09fd5f886a
No known key found for this signature in database
GPG Key ID: 6470762A7DA11D8B
2 changed files with 85 additions and 49 deletions

View File

@ -2879,12 +2879,15 @@ INFO is a plist containing export properties."
;; temporary buffer so that dvipng/imagemagick can properly
;; turn the fragment into an image.
(setq latex-frag (concat latex-header latex-frag))))
(org-export-with-buffer-copy
(erase-buffer)
(insert latex-frag)
(org-format-latex cache-relpath nil nil cache-dir nil
"Creating LaTeX Image..." nil processing-type)
(buffer-string))))
(with-current-buffer
(org-export-copy-buffer
(get-buffer-create " *Org HTML Export LaTeX*")
'drop-visible 'drop-narrowing 'drop-contents)
(erase-buffer)
(insert latex-frag)
(org-format-latex cache-relpath nil nil cache-dir nil
"Creating LaTeX Image..." nil processing-type)
(buffer-string))))
(defun org-html--wrap-latex-environment (contents _ &optional caption label)
"Wrap CONTENTS string within appropriate environment for equations.

View File

@ -2544,12 +2544,25 @@ Return the updated communication channel."
;; a default template (or a back-end specific template) at point or in
;; current subtree.
(defun org-export-copy-buffer ()
(defun org-export-copy-buffer (&optional buffer drop-visibility
drop-narrowing drop-contents
drop-locals)
"Return a copy of the current buffer.
The copy preserves Org buffer-local variables, visibility and
narrowing."
(let ((copy-buffer-fun (org-export--generate-copy-script (current-buffer)))
(new-buf (generate-new-buffer (buffer-name))))
narrowing.
When optional argument BUFFER is non-nil, copy into BUFFER.
Optional arguments DROP-VISIBILITY, DROP-NARROWING, DROP-CONTENTS, and
DROP-LOCALS are passed to `org-export--generate-copy-script'."
(let ((copy-buffer-fun (org-export--generate-copy-script
(current-buffer)
'do-not-check-unreadable
drop-visibility
drop-narrowing
drop-contents
drop-locals))
(new-buf (or buffer (generate-new-buffer (buffer-name)))))
(with-current-buffer new-buf
(funcall copy-buffer-fun)
(set-buffer-modified-p nil))
@ -2573,55 +2586,73 @@ when BODY is applied."
(restore-buffer-modified-p nil))
(kill-buffer ,buf-copy)))))))
(defun org-export--generate-copy-script (buffer)
(defun org-export--generate-copy-script (buffer
&optional
copy-unreadable
drop-visibility
drop-narrowing
drop-contents
drop-locals)
"Generate a function duplicating BUFFER.
The copy will preserve local variables, visibility, contents and
narrowing of the original buffer. If a region was active in
BUFFER, contents will be narrowed to that region instead.
When optional argument COPY-UNREADABLE is non-nil, do not ensure that
all the copied local variables will be readable in another Emacs
session.
When optional arguments DROP-VISIBILITY, DROP-NARROWING,
DROP-CONTENTS, or DROP-LOCALS are non-nil, do not preserve visibility,
narrowing, contents, or local variables correspondingly.
The resulting function can be evaluated at a later time, from
another buffer, effectively cloning the original buffer there.
The function assumes BUFFER's major mode is `org-mode'."
(with-current-buffer buffer
(let ((str (org-with-wide-buffer (buffer-string)))
(let ((str (unless drop-contents (org-with-wide-buffer (buffer-string))))
(narrowing
(if (org-region-active-p)
(list (region-beginning) (region-end))
(list (point-min) (point-max))))
(unless drop-narrowing
(if (org-region-active-p)
(list (region-beginning) (region-end))
(list (point-min) (point-max)))))
(pos (point))
(varvals
(let ((bound-variables (org-export--list-bound-variables))
(varvals nil))
(dolist (entry (buffer-local-variables (buffer-base-buffer)))
(when (consp entry)
(let ((var (car entry))
(val (cdr entry)))
(and (not (memq var org-export-ignored-local-variables))
(or (memq var
'(default-directory
buffer-file-name
buffer-file-coding-system
;; Needed to preserve folding state
char-property-alias-alist))
(assq var bound-variables)
(string-match "^\\(org-\\|orgtbl-\\)"
(symbol-name var)))
;; Skip unreadable values, as they cannot be
;; sent to external process.
(or (not val) (ignore-errors (read (format "%S" val))))
(push (cons var val) varvals)))))
varvals))
(unless drop-locals
(let ((bound-variables (org-export--list-bound-variables))
(varvals nil))
(dolist (entry (buffer-local-variables (buffer-base-buffer)))
(when (consp entry)
(let ((var (car entry))
(val (cdr entry)))
(and (not (memq var org-export-ignored-local-variables))
(or (memq var
'(default-directory
buffer-file-name
buffer-file-coding-system
;; Needed to preserve folding state
char-property-alias-alist))
(assq var bound-variables)
(string-match "^\\(org-\\|orgtbl-\\)"
(symbol-name var)))
;; Skip unreadable values, as they cannot be
;; sent to external process.
(or copy-unreadable (not val)
(ignore-errors (read (format "%S" val))))
(push (cons var val) varvals)))))
varvals)))
(ols
(let (ov-set)
(dolist (ov (overlays-in (point-min) (point-max)))
(let ((invis-prop (overlay-get ov 'invisible)))
(when invis-prop
(push (list (overlay-start ov) (overlay-end ov)
invis-prop)
ov-set))))
ov-set)))
(unless drop-visibility
(let (ov-set)
(dolist (ov (overlays-in (point-min) (point-max)))
(let ((invis-prop (overlay-get ov 'invisible)))
(when invis-prop
(push (list (overlay-start ov) (overlay-end ov)
invis-prop)
ov-set))))
ov-set))))
(lambda ()
(let ((inhibit-modification-hooks t))
;; Never write the buffer copy to disk, despite
@ -2629,19 +2660,21 @@ The function assumes BUFFER's major mode is `org-mode'."
(set 'write-contents-functions (list #'always))
;; Set major mode. Ignore `org-mode-hook' and other hooks as
;; they have been run already in BUFFER.
(delay-mode-hooks
(let ((org-inhibit-startup t)) (org-mode)))
(unless (eq major-mode 'org-mode)
(delay-mode-hooks
(let ((org-inhibit-startup t)) (org-mode))))
;; Copy specific buffer local variables and variables set
;; through BIND keywords.
(pcase-dolist (`(,var . ,val) varvals)
(set (make-local-variable var) val))
;; Whole buffer contents.
(insert str)
;; Whole buffer contents when requested.
(when str (erase-buffer) (insert str))
;; Make org-element-cache not complain about changed buffer
;; state.
(org-element-cache-reset)
;; Narrowing.
(apply #'narrow-to-region narrowing)
(when narrowing
(apply #'narrow-to-region narrowing))
;; Current position of point.
(goto-char pos)
;; Overlays with invisible property.