From 78e6c73a710a8b7ffbed156f9ccb8663a6900eed Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Sun, 18 Apr 2021 16:33:23 -0400
Subject: [PATCH] ENH make org-x-has-children faster

---
 local/lib/org-x/org-x.el | 65 ++++++++++++++++++++--------------------
 1 file changed, 33 insertions(+), 32 deletions(-)

diff --git a/local/lib/org-x/org-x.el b/local/lib/org-x/org-x.el
index db217ce..c6bdc85 100644
--- a/local/lib/org-x/org-x.el
+++ b/local/lib/org-x/org-x.el
@@ -452,39 +452,40 @@ compared to REF-TIME. Returns nil if no timestamp is found."
 
 ;; relational testing
 
-;; TODO this function seems slow
-(defun org-x-headline-has-children (heading-test)
-  "Return t if heading has a child for whom HEADING-TEST is t."
-  (let ((subtree-end (save-excursion (org-end-of-subtree t)))
-        has-children previous-point)
-    (save-excursion
-      (setq previous-point (point))
-      (outline-next-heading)
+(defun org-x-headline-has-children (test-fun)
+  "Return t if heading has a child for whom TEST-FUN is t.
+Assume that point is at the beginning of a headline."
+  ;; Rather than using regular expressions, it is much faster and simpler to
+  ;; walk down each line and count the number of stars to get the level.
+  ;;
+  ;; Algorithm steps:
+  ;; 1. Count stars on the current headline (move point forward until first
+  ;;    non-star, and use the column number to get level) and add 1 to get
+  ;;    the "target-level" (that is the child level of the current headline)
+  ;; 2. Move forward one line until a) `test-fun' returns t b) the current
+  ;;    level of the org-tree is less than the target-level or c) the end of
+  ;;    the buffer is reached.
+  ;;    2.1. If point not on a star, continue looping.
+  ;;    2.2. Otherwise, get the current level similar to (1) using the column
+  ;;         number. If the current level is equal to the target level, eval
+  ;;         `test-fun', otherwise do nothing since point is too deep in the
+  ;;         tree
+  (save-excursion
+    (forward-char 1)
+    (while (= ?* (following-char)) (forward-char 1))
+    (let* ((target-level (1+ (current-column)))
+           (cur-level (1+ target-level))
+           (has-children nil))
       (while (and (not has-children)
-                  (< previous-point (point) subtree-end))
-        (when (funcall heading-test)
-          (setq has-children t))
-        (setq previous-point (point))
-        (org-forward-heading-same-level 1 t)))
-    has-children))
-
-;; (defun org-x-headline-has-children (test-fun)
-;;   "Return t if heading has a child for whom TEST-FUN is t."
-;;   ;; assume that point is at the beginning of a headline
-;;   (let* ((level (1+ (org-current-level)))
-;;          (has-children nil)
-;;          (cur-level level))
-;;     ;; skip over the current headline
-;;     (re-search-forward org-outline-regexp-bol nil t)
-;;     (save-excursion
-;;       (while (and (<= level cur-level)
-;;                   (re-search-forward org-outline-regexp-bol nil t))
-;;         ;; it's actually more efficient to scan every headline and check its
-;;         ;; level rather than using a regexp to match the target depth
-;;         (setq cur-level (- (match-end 0) (match-beginning 0) 1))
-;;         (when (and (= cur-level level) (funcall test-fun))
-;;           (setq has-children t))))
-;;     has-children))
+                  (<= target-level cur-level)
+                  (= 0 (forward-line 1)))
+        (when (= ?* (following-char))
+          (forward-char 1)
+          (while (= ?* (following-char)) (forward-char 1))
+          (setq cur-level (current-column))
+          (when (and (= cur-level target-level) (funcall test-fun))
+            (setq has-children t))))
+      has-children)))
 
 (defun org-x-headline-has-parent (heading-test)
   "Return t if heading has parent for whom HEADING-TEST is t."