mirror/org-mode
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs/org-mode.git synced 2024-11-23 07:18:53 +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
(goto-char (point-min))
(setq org-outline-path-cache nil)
(while (re-search-forward descre nil t)
(forward-line 0)
(let ((case-fold-search nil))
(looking-at org-complex-heading-regexp))
(let ((begin (point))
(heading (match-string-no-properties 4)))
(unless (or (and
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
(let ((base (pcase org-refile-use-outline-path
(`file (list
(and (buffer-file-name (buffer-base-buffer))
(file-name-nondirectory
(buffer-file-name (buffer-base-buffer))))))
(`title (list
(or (org-get-title)
(and (buffer-file-name (buffer-base-buffer))
(file-name-nondirectory
(buffer-file-name (buffer-base-buffer))))))
(`title (list
(or (org-get-title)
(and (buffer-file-name (buffer-base-buffer))
(file-name-nondirectory
(buffer-file-name (buffer-base-buffer)))))))
(`full-file-path
(list (buffer-file-name
(buffer-base-buffer))))
(`buffer-name
(list (buffer-name
(buffer-base-buffer))))
(_ nil))
(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)))))))
(buffer-file-name (buffer-base-buffer)))))))
(`full-file-path
(list (buffer-file-name
(buffer-base-buffer))))
(`buffer-name
(list (buffer-name
(buffer-base-buffer))))
(_ nil))))
(while (re-search-forward descre nil t)
(forward-line 0)
(let ((case-fold-search nil))
(looking-at org-complex-heading-regexp))
(let ((begin (point))
(heading (match-string-no-properties 4)))
(unless (or (and
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
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
(org-refile-cache-put tgs (buffer-file-name) descre))
(setq targets (append tgs targets))))))