mirror/org-mode
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs/org-mode.git synced 2024-11-27 07:37:25 +00:00
Code

org-refile: calculate file part of the outline path once per file

Browse Source 
* lisp/org-refile.el (org-refile-get-targets): Calculate the file part
of the outline path once per file, improving the performance when
org-refile-use-outline-path is set to 'title.
This commit is contained in:
Sacha Chua 2024-10-13 21:30:29 -04:00 committed by Ihor Radchenko
parent da0f6eff75
commit 566c341155
No known key found for this signature in database
GPG Key ID: 6470762A7DA11D8B
1 changed files with 43 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

85
lisp/org-refile.el
View File

@ -341,50 +341,51 @@ When `org-refile-use-cache' is nil, just return POS."
(org-with-wide-buffer (org-with-wide-buffer
(goto-char (point-min)) (goto-char (point-min))
(setq org-outline-path-cache nil) (setq org-outline-path-cache nil)
(while (re-search-forward descre nil t) (let ((base (pcase org-refile-use-outline-path
(forward-line 0) (`file (list
(let ((case-fold-search nil)) (and (buffer-file-name (buffer-base-buffer))
(looking-at org-complex-heading-regexp)) (file-name-nondirectory
(let ((begin (point)) (buffer-file-name (buffer-base-buffer))))))
(heading (match-string-no-properties 4))) (`title (list
(unless (or (and (or (org-get-title)
org-refile-target-verify-function
(not
(funcall org-refile-target-verify-function)))
(not heading))
(let ((re (format org-complex-heading-regexp-format
(regexp-quote heading)))
(target
(if (not org-refile-use-outline-path) heading
(mapconcat
#'identity
(append
(pcase org-refile-use-outline-path
(`file (list
(and (buffer-file-name (buffer-base-buffer)) (and (buffer-file-name (buffer-base-buffer))
(file-name-nondirectory (file-name-nondirectory
(buffer-file-name (buffer-base-buffer)))))) (buffer-file-name (buffer-base-buffer)))))))
(`title (list (`full-file-path
(or (org-get-title) (list (buffer-file-name
(and (buffer-file-name (buffer-base-buffer)) (buffer-base-buffer))))
(file-name-nondirectory (`buffer-name
(buffer-file-name (buffer-base-buffer))))))) (list (buffer-name
(`full-file-path (buffer-base-buffer))))
(list (buffer-file-name (_ nil))))
(buffer-base-buffer)))) (while (re-search-forward descre nil t)
(`buffer-name (forward-line 0)
(list (buffer-name (let ((case-fold-search nil))
(buffer-base-buffer)))) (looking-at org-complex-heading-regexp))
(_ nil)) (let ((begin (point))
(mapcar (lambda (s) (replace-regexp-in-string (heading (match-string-no-properties 4)))
"/" "\\/" s nil t)) (unless (or (and
(org-get-outline-path t t))) org-refile-target-verify-function
"/")))) (not
(push (list target f re (org-refile-marker (point))) (funcall org-refile-target-verify-function)))
tgs))) (not heading))
(when (= (point) begin) (let ((re (format org-complex-heading-regexp-format
;; Verification function has not moved point. (regexp-quote heading)))
(end-of-line))))))) (target
(if (not org-refile-use-outline-path) heading
(mapconcat
#'identity
(append
base
(mapcar (lambda (s) (replace-regexp-in-string
"/" "\\/" s nil t))
(org-get-outline-path t t)))
"/"))))
(push (list target f re (org-refile-marker (point)))
tgs)))
(when (= (point) begin)
;; Verification function has not moved point.
(end-of-line))))))))
(when org-refile-use-cache (when org-refile-use-cache
(org-refile-cache-put tgs (buffer-file-name) descre)) (org-refile-cache-put tgs (buffer-file-name) descre))
(setq targets (append tgs targets)))))) (setq targets (append tgs targets))))))