On 05/03/2021 04:03, Samuel Wales wrote:
interesting. that would be great to speed it up. [i just meant that
the file list used to be correct.]
I am a bit disappointed. I have managed to get x2 performance boost. At
first, the result was x2 better but I realized that I did not added
heading cleanup for the new strategy. It adds several regexp to the
inner loop and severely hits performance. I do not like the idea to
manually inline (with minor variations) existing functions and regexps,
but the function is still slow.
For a while, improvement is significant, so I am attaching the patch
that should make jumps using org-goto or org-refile faster. I hope, I
have not broken anything.
commit 45cfa5b15e9009fee4f6a688caa210ff543b1ac1
Author: Max Nikulin <maniku...@gmail.com>
Date: Sat Mar 6 22:14:39 2021 +0700
testing/lisp/test-org.el: More tests for `org-refile-get-targets'
testing/lisp/test-org.el (test-org/refile-get-targets): Add a few more
cases for the `org-refile-get-targets' function.
- Fraction of completed subtasks is removed from heading.
- `:level' filter ignores headings having over levels.
- Outline path works with `:tag' filter.
The aim is to increase coverage for experiments with optimizing
of the function.
diff --git a/testing/lisp/test-org.el b/testing/lisp/test-org.el
index 2d727ba7a..da313b45b 100644
--- a/testing/lisp/test-org.el
+++ b/testing/lisp/test-org.el
@@ -6369,6 +6369,27 @@ Paragraph<point>"
(let ((org-refile-use-outline-path t)
(org-refile-targets `((nil :maxlevel . 1))))
(mapcar #'car (org-refile-get-targets))))))
+ ;; When providing targets as paths, clean fraction cookie.
+ (should
+ (equal '("H1")
+ (org-test-with-temp-text "* H1 [1/1]"
+ (let ((org-refile-use-outline-path t)
+ (org-refile-targets '((nil :maxlevel . 1))))
+ (mapcar #'car (org-refile-get-targets))))))
+ ;; When providing targets as paths, intermediate paths are cached correctly.
+ (should
+ (equal '("H1/H2")
+ (org-test-with-temp-text "* Skip 1\n* H1\n*** Skip 2\n** H2\n*** Skip 3"
+ (let ((org-refile-use-outline-path t)
+ (org-refile-targets '((nil :level . 2))))
+ (mapcar #'car (org-refile-get-targets))))))
+ ;; When providing targets as paths, they are obtained correctly.
+ (should
+ (equal '("H1/H2" "H3")
+ (org-test-with-temp-text "* Skip 1\n* H1\n** Skip 2\n** H2 :take:\n* H3 :take:"
+ (let ((org-refile-use-outline-path t)
+ (org-refile-targets '((nil :tag . "take"))))
+ (mapcar #'car (org-refile-get-targets))))))
;; When `org-refile-use-outline-path' is `file', include file name
;; without directory in targets.
(should
commit 58b477e999f3bb5b48c39fe0a4e5ad0d37e2bb9d
Author: Max Nikulin <maniku...@gmail.com>
Date: Sat Mar 6 22:44:27 2021 +0700
lisp/org-refile.el: Speed up `org-refile-get-targets'
lisp/org-refile.el (org-refile-get-targets): Optimize performance
by eliminating backward lookup of already seen headers.
If configuration allows it, incrementally update current outline path.
For dense target trees (`:maxlevel' and `:level') it allows to avoid
"one step forward, two steps back" strategy that requires multiple
backward searches for deeply nested headings.
diff --git a/lisp/org-refile.el b/lisp/org-refile.el
index 4e9f26eff..8e760f1c3 100644
--- a/lisp/org-refile.el
+++ b/lisp/org-refile.el
@@ -267,7 +267,8 @@ converted to a headline before refiling."
(let ((case-fold-search nil)
;; otherwise org confuses "TODO" as a kw and "Todo" as a word
(entries (or org-refile-targets '((nil . (:level . 1)))))
- targets tgs files desc descre)
+ targets tgs files desc descre
+ outline-path cache-outline-path target-outline-level)
(message "Getting targets...")
(with-current-buffer (or default-buffer (current-buffer))
(dolist (entry entries)
@@ -281,6 +282,11 @@ converted to a headline before refiling."
((and (symbolp files) (boundp files))
(setq files (symbol-value files))))
(when (stringp files) (setq files (list files)))
+ (setq cache-outline-path (and org-refile-use-outline-path
+ (memq (car desc) '(:level :maxlevel))))
+ (setq target-outline-level
+ (if (and cache-outline-path (eq (car desc) :level))
+ (if org-odd-levels-only (1- (* 2 (cdr desc))) (cdr desc))))
(cond
((eq (car desc) :tag)
(setq descre (concat "^\\*+[ \t]+.*?:" (regexp-quote (cdr desc)) ":")))
@@ -288,13 +294,13 @@ converted to a headline before refiling."
(setq descre (concat "^\\*+[ \t]+" (regexp-quote (cdr desc)) "[ \t]")))
((eq (car desc) :regexp)
(setq descre (cdr desc)))
- ((eq (car desc) :level)
+ ((and (not target-outline-level) (eq (car desc) :level))
(setq descre (concat "^\\*\\{" (number-to-string
(if org-odd-levels-only
(1- (* 2 (cdr desc)))
(cdr desc)))
"\\}[ \t]")))
- ((eq (car desc) :maxlevel)
+ ((memq (car desc) '(:level :maxlevel))
(setq descre (concat "^\\*\\{1," (number-to-string
(if org-odd-levels-only
(1- (* 2 (cdr desc)))
@@ -318,13 +324,30 @@ converted to a headline before refiling."
(org-with-wide-buffer
(goto-char (point-min))
(setq org-outline-path-cache nil)
+ (setq outline-path nil)
(while (re-search-forward descre nil t)
(beginning-of-line)
(let ((case-fold-search nil))
(looking-at org-complex-heading-regexp))
(let ((begin (point))
- (heading (match-string-no-properties 4)))
- (unless (or (and
+ (heading (match-string-no-properties 4))
+ (heading-level (length (match-string-no-properties 1))))
+ (when cache-outline-path
+ (while (and outline-path (<= heading-level (caar outline-path)))
+ (pop outline-path))
+ (push (cons heading-level
+ ;; Taken from org--get-outline-path-1. It is really slow.
+ (if (not heading)
+ ""
+ (org-trim
+ (org-link-display-format
+ (replace-regexp-in-string
+ "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" ""
+ heading)))))
+ outline-path))
+ (unless (or (and target-outline-level
+ (not (eq heading-level target-outline-level)))
+ (and
org-refile-target-verify-function
(not
(funcall org-refile-target-verify-function)))
@@ -349,7 +372,9 @@ converted to a headline before refiling."
(_ nil))
(mapcar (lambda (s) (replace-regexp-in-string
"/" "\\/" s nil t))
- (org-get-outline-path t t)))
+ (if outline-path
+ (nreverse (mapcar #'cdr outline-path))
+ (org-get-outline-path t t))))
"/"))))
(push (list target f re (org-refile-marker (point)))
tgs)))
