[PATCH] optimize org-refile-get-targets

[Maxim Nikulin <manikulin@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 705 bytes --]

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.


[-- Attachment #2: refile-get-targets-outline-path-tests.patch --]
[-- Type: text/x-patch, Size: 2012 bytes --]

commit 45cfa5b15e9009fee4f6a688caa210ff543b1ac1
Author: Max Nikulin <manikulin@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

[-- Attachment #3: refile-get-targets-outline-path-optimize.patch --]
[-- Type: text/x-patch, Size: 4030 bytes --]

commit 58b477e999f3bb5b48c39fe0a4e5ad0d37e2bb9d
Author: Max Nikulin <manikulin@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)))