From 051e7b9d7c6ad7a83ca40a88ab53549414cb2b80 Mon Sep 17 00:00:00 2001 From: Ihor Radchenko Date: Sat, 16 Mar 2024 11:21:30 +0300 Subject: [PATCH] Reduce repetitive calls to `find-buffer-visiting' + `find-file-noselect' * lisp/org-macs.el (org-with-file-buffer): New macro switching to a file buffer temporarily and killing it if a buffer visiting file did not exist previously. (org-file-buffer-created): New variable set when buffer visiting file has been created. * lisp/ob-tangle.el (org-babel-tangle-file): * lisp/org-archive.el (org-archive-subtree): * lisp/org-refile.el (org-refile): (org-refile-check-position): (org-refile-new-child): * lisp/ox-org.el (org-org-publish-to-org): * lisp/ox-publish.el (org-publish-org-to): (org-publish-find-property): Avoid calling `find-buffer-visiting' + `find-file-noselect'. The latter calls the former. Instead, either just call `find-file-noselect' or use `org-with-file-buffer'. This commit addresses O(N_buffers) complexity in `find-buffer-visiting', reducing the number of calls to it. See Emacs bug#66117. --- lisp/ob-tangle.el | 12 +++------ lisp/org-archive.el | 3 +-- lisp/org-macs.el | 25 +++++++++++++++++++ lisp/org-refile.el | 12 +++------ lisp/ox-org.el | 7 ++---- lisp/ox-publish.el | 61 +++++++++++++++++++-------------------------- 6 files changed, 62 insertions(+), 58 deletions(-) diff --git a/lisp/ob-tangle.el b/lisp/ob-tangle.el index 9bb69e5da..79fe6448b 100644 --- a/lisp/ob-tangle.el +++ b/lisp/ob-tangle.el @@ -222,14 +222,10 @@ source code blocks by languages matching a regular expression. Return list of the tangled file names." (interactive "fFile to tangle: \nP") - (let* ((visited (find-buffer-visiting file)) - (buffer (or visited (find-file-noselect file)))) - (prog1 - (with-current-buffer buffer - (org-with-wide-buffer - (mapcar #'expand-file-name - (org-babel-tangle nil target-file lang-re)))) - (unless visited (kill-buffer buffer))))) + (org-with-file-buffer file + (org-with-wide-buffer + (mapcar #'expand-file-name + (org-babel-tangle nil target-file lang-re))))) (defun org-babel-tangle-publish (_ filename pub-dir) "Tangle FILENAME and place the results in PUB-DIR." diff --git a/lisp/org-archive.el b/lisp/org-archive.el index e46649fd3..f38f8938d 100644 --- a/lisp/org-archive.el +++ b/lisp/org-archive.el @@ -254,8 +254,7 @@ direct children of this heading." (newfile-p (and (org-string-nw-p afile) (not (file-exists-p afile)))) (buffer (cond ((not (org-string-nw-p afile)) this-buffer) - ((find-buffer-visiting afile)) - ((find-file-noselect afile)) + ((find-file-noselect afile 'nowarn)) (t (error "Cannot access file \"%s\"" afile)))) (org-odd-levels-only (if (local-variable-p 'org-odd-levels-only (current-buffer)) diff --git a/lisp/org-macs.el b/lisp/org-macs.el index cd23844c8..595ff8171 100644 --- a/lisp/org-macs.el +++ b/lisp/org-macs.el @@ -291,6 +291,31 @@ FILE is the file name passed to `find-buffer-visiting'." (find-buffer-visiting file)))) (org-base-buffer buf))) +(defvar-local org-file-buffer-created nil + "Non-nil when current buffer is created from `org-with-file-buffer'. +The value is FILE argument passed to `org-with-file-buffer'.") +(defmacro org-with-file-buffer (file &rest body) + "Evaluate BODY with current buffer visiting FILE. +When no live buffer is visiting FILE, create one and kill after +evaluating BODY. +During evaluation, when the buffer was created, `org-file-buffer-created' +variable is set to FILE." + (declare (debug (form body)) (indent 1)) + (org-with-gensyms (mark-function filename buffer) + `(let ((,mark-function (lambda () (setq-local org-file-buffer-created ,file))) + (,filename ,file) + ,buffer) + (add-hook 'find-file-hook ,mark-function) + (unwind-protect + (progn + (setq ,buffer (find-file-noselect ,filename t)) + (with-current-buffer ,buffer + (prog1 (progn ,@body) + (with-current-buffer ,buffer + (when (equal ,filename org-file-buffer-created) + (kill-buffer)))))) + (remove-hook 'find-file-hook ,mark-function))))) + (defun org-fit-window-to-buffer (&optional window max-height min-height shrink-only) "Fit WINDOW to the buffer, but only if it is not a side-by-side window. diff --git a/lisp/org-refile.el b/lisp/org-refile.el index a19c19545..7b59e82de 100644 --- a/lisp/org-refile.el +++ b/lisp/org-refile.el @@ -541,8 +541,7 @@ prefix argument (`C-u C-u C-u C-c C-w')." (< pos (save-excursion (org-end-of-subtree t t)))))) (error "Cannot refile to position inside the tree or region")) - (setq nbuf (or (find-buffer-visiting file) - (find-file-noselect file))) + (setq nbuf (find-file-noselect file 'nowarn)) (if (and arg (not (equal arg 3))) (progn (pop-to-buffer-same-window nbuf) @@ -562,8 +561,7 @@ prefix argument (`C-u C-u C-u C-c C-w')." ;; will then remain before the inserted subtree in ;; unexpected location. (set-marker-insertion-type origin t) - (with-current-buffer (setq nbuf (or (find-buffer-visiting file) - (find-file-noselect file))) + (with-current-buffer (setq nbuf (find-file-noselect file 'nowarn)) (setq reversed (org-notes-order-reversed-p)) (org-with-wide-buffer (if pos @@ -727,8 +725,7 @@ this function appends the default value from (when (org-string-nw-p re) (setq buffer (if (markerp pos) (marker-buffer pos) - (or (find-buffer-visiting file) - (find-file-noselect file)))) + (find-file-noselect file 'nowarn))) (with-current-buffer buffer (org-with-wide-buffer (goto-char pos) @@ -743,8 +740,7 @@ this function appends the default value from (let ((file (nth 1 parent-target)) (pos (nth 3 parent-target)) level) - (with-current-buffer (or (find-buffer-visiting file) - (find-file-noselect file)) + (with-current-buffer (find-file-noselect file 'nowarn) (org-with-wide-buffer (if pos (goto-char pos) diff --git a/lisp/ox-org.el b/lisp/ox-org.el index 1083d2925..d74ad4afb 100644 --- a/lisp/ox-org.el +++ b/lisp/ox-org.el @@ -345,10 +345,8 @@ Return output file name." (htmlize-output-type 'css) (html-ext (concat "." (or (plist-get plist :html-extension) org-html-extension "html"))) - (visitingp (find-buffer-visiting filename)) - (work-buffer (or visitingp (find-file-noselect filename))) newbuf) - (with-current-buffer work-buffer + (org-with-file-buffer filename (font-lock-ensure) (org-fold-show-all) (setq newbuf (htmlize-buffer))) @@ -363,8 +361,7 @@ Return output file name." org-org-htmlized-css-url) t t))) (write-file (concat pub-dir (file-name-nondirectory filename) html-ext))) - (kill-buffer newbuf) - (unless visitingp (kill-buffer work-buffer))))) + (kill-buffer newbuf)))) (provide 'ox-org) diff --git a/lisp/ox-publish.el b/lisp/ox-publish.el index eba873cff..9bfd333a4 100644 --- a/lisp/ox-publish.el +++ b/lisp/ox-publish.el @@ -565,30 +565,25 @@ directory. Return output file name." (unless (or (not pub-dir) (file-exists-p pub-dir)) (make-directory pub-dir t)) ;; Check if a buffer visiting FILENAME is already open. - (let* ((org-inhibit-startup t) - (visiting (find-buffer-visiting filename)) - (work-buffer (or visiting (find-file-noselect filename)))) - (unwind-protect - (with-current-buffer work-buffer - (let ((output (org-export-output-file-name extension nil pub-dir))) - (org-export-to-file backend output - nil nil nil (plist-get plist :body-only) - ;; Add `org-publish--store-crossrefs' and - ;; `org-publish-collect-index' to final output filters. - ;; The latter isn't dependent on `:makeindex', since we - ;; want to keep it up-to-date in cache anyway. - (org-combine-plists - plist - `(:crossrefs - ,(org-publish-cache-get-file-property - ;; Normalize file names in cache. - (file-truename filename) :crossrefs nil t) - :filter-final-output - (org-publish--store-crossrefs - org-publish-collect-index - ,@(plist-get plist :filter-final-output))))))) - ;; Remove opened buffer in the process. - (unless visiting (kill-buffer work-buffer))))) + (let* ((org-inhibit-startup t)) + (org-with-file-buffer filename + (let ((output (org-export-output-file-name extension nil pub-dir))) + (org-export-to-file backend output + nil nil nil (plist-get plist :body-only) + ;; Add `org-publish--store-crossrefs' and + ;; `org-publish-collect-index' to final output filters. + ;; The latter isn't dependent on `:makeindex', since we + ;; want to keep it up-to-date in cache anyway. + (org-combine-plists + plist + `(:crossrefs + ,(org-publish-cache-get-file-property + ;; Normalize file names in cache. + (file-truename filename) :crossrefs nil t) + :filter-final-output + (org-publish--store-crossrefs + org-publish-collect-index + ,@(plist-get plist :filter-final-output))))))))) (defun org-publish-attachment (_plist filename pub-dir) "Publish a file with no transformation of any kind. @@ -852,17 +847,13 @@ Return value may be a string or a list, depending on the type of PROPERTY, i.e. \"behavior\" parameter from `org-export-options-alist'." (let ((file (org-publish--expand-file-name file project))) (when (and (file-readable-p file) (not (directory-name-p file))) - (let* ((org-inhibit-startup t) - (visiting (find-buffer-visiting file)) - (buffer (or visiting (find-file-noselect file)))) - (unwind-protect - (plist-get (with-current-buffer buffer - (if (not visiting) (org-export-get-environment backend) - ;; Protect local variables in open buffers. - (org-export-with-buffer-copy - (org-export-get-environment backend)))) - property) - (unless visiting (kill-buffer buffer))))))) + (let* ((org-inhibit-startup t)) + (plist-get (org-with-file-buffer file + (if (not org-file-buffer-created) (org-export-get-environment backend) + ;; Protect local variables in open buffers. + (org-export-with-buffer-copy + (org-export-get-environment backend)))) + property))))) (defun org-publish-find-title (file project) "Find the title of FILE in PROJECT."