From a028abb82296fe96c74b9dde1c120397f261fe00 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Sun, 27 Mar 2022 13:13:20 -0400
Subject: [PATCH] ENH make property/link parsers faster

---
 local/lib/org-x/org-x-dag.el | 69 ++++++++++++++++++------------------
 1 file changed, 34 insertions(+), 35 deletions(-)

diff --git a/local/lib/org-x/org-x-dag.el b/local/lib/org-x/org-x-dag.el
index e2eaa91..c30ddb1 100644
--- a/local/lib/org-x/org-x-dag.el
+++ b/local/lib/org-x/org-x-dag.el
@@ -1209,36 +1209,33 @@ A date like (YEAR MONTH DAY).")
 
 ;;; BUFFER SCANNING
 
-(defun org-x-dag-get-local-property (bounds prop-re)
-  (-when-let ((_ beg end _) bounds)
-    (save-excursion
-      (goto-char beg)
-      (when (re-search-forward prop-re end t)
-        (match-string-no-properties 3)))))
+(defun org-x-dag-get-local-property (beg end prop-re)
+  (save-excursion
+    (goto-char beg)
+    (when (re-search-forward prop-re end t)
+      (match-string-no-properties 3))))
 
-(defun org-x-dag-get-local-properties (bounds prop-pairs)
-  (when bounds
-    (-let (((_ beg end _) bounds))
-      (save-excursion
-        (let (acc cur)
-          (while prop-pairs
-            (goto-char beg)
-            (setq cur (car prop-pairs))
-            (when (re-search-forward (cdr cur) end t)
-              (!cons (cons (car cur) (match-string-no-properties 3)) acc))
-            (!cdr prop-pairs))
-          acc)))))
+(defun org-x-dag-get-local-properties (beg end prop-pairs)
+  (save-excursion
+    (let (acc cur)
+      (while prop-pairs
+        (goto-char beg)
+        (setq cur (car prop-pairs))
+        (when (re-search-forward (cdr cur) end t)
+          (!cons (cons (car cur) (match-string-no-properties 3)) acc))
+        (!cdr prop-pairs))
+      acc)))
 
 (defconst org-x-dag-parent-link-drawer-re 
   (concat
    "^[ \t]*:X_PARENT_LINKS:[ \t]*\n"
-   "\\(\\(?:^- .*?\n\\)*?\\)"
+   "\\(\\(?:^- .*?\n\\)+\\)"
    "[ \t]*:END:[ \t]*$"))
 
 (defun org-x-dag-next-headline ()
   (save-excursion (outline-next-heading)))
 
-(defun org-x-dag-get-parent-links (&optional start end)
+(defun org-x-dag-get-parent-links (start end)
   (cl-flet
       ((match-id
         (s)
@@ -1248,13 +1245,14 @@ A date like (YEAR MONTH DAY).")
     (save-excursion
       (when start
         (goto-char start))
-      (let ((end (or end (org-x-dag-next-headline))))
-        (when (re-search-forward org-x-dag-parent-link-drawer-re end t)
-          (-some->> (match-string 1)
-            (s-trim)
-            (s-split "\n")
-            (-map #'match-id)
-            (-non-nil)))))))
+      (when (re-search-forward org-x-dag-parent-link-drawer-re end t)
+        (let ((ss (split-string (match-string-no-properties 1) "\n" t))
+              acc)
+          (while ss
+            (when (string-match "id:\\([^][]\\{36\\}\\)" (car ss))
+              (!cons (match-string-no-properties 1 (car ss)) acc))
+            (!cdr ss))
+          acc)))))
 
 (defun org-x-dag-line-regexp (kws)
   (let ((level-re "\\(\\*+\\)")
@@ -1314,13 +1312,13 @@ used for optimization."
          (first-hl (org-x-dag-next-headline))
          ;; If not on a headline, check for a property drawer with links in it
          (this-file-links (unless (= ?* (following-char))
-                            (org-x-dag-get-parent-links first-hl nil)))
+                            (org-x-dag-get-parent-links nil first-hl)))
          (pps (--map (cons it (org-re-property it nil t)) target-props))
          (id-prop (org-re-property "ID" nil t))
          ;; stack vars
          bare-stack node-level bury-level
          ;; data vars
-         this-id this-level this-todo this-tags this-pblock acc)
+         this-id this-level this-todo this-tags this-pblock pbeg pend acc)
     (when first-hl
       (goto-char first-hl))
     (while (looking-at line-re)
@@ -1349,7 +1347,9 @@ used for optimization."
         (cond
          ((and this-todo
                (setq this-pblock (org-x-dag-property-block next-pos)
-                     this-id (org-x-dag-get-local-property this-pblock id-prop)))
+                     pbeg (nth 1 this-pblock)
+                     pend (nth 2 this-pblock)
+                     this-id (org-x-dag-get-local-property pbeg pend id-prop)))
           (setq bury-level nil)
           (when this-tags
             (setq this-tags (split-string this-tags ":")))
@@ -1359,8 +1359,8 @@ used for optimization."
                                  (append this-tags))))
           (-> (list
                :id this-id
-               :parents (or (-> (nth 3 this-pblock)
-                                (org-x-dag-get-parent-links next-pos))
+               :parents (or (org-x-dag-get-parent-links (nth 3 this-pblock)
+                                                        next-pos)
                             (unless node-level
                               (nth 2 (car bare-stack))))
                :node-meta
@@ -1370,9 +1370,8 @@ used for optimization."
                 :todo this-todo
                 :title (or this-title "")
                 :tags this-tags
-                :planning (->> (car this-pblock)
-                               (org-x-dag-parse-this-planning))
-                :props (org-x-dag-get-local-properties this-pblock pps)))
+                :planning (org-x-dag-parse-this-planning (nth 0 this-pblock))
+                :props (org-x-dag-get-local-properties pbeg pend pps)))
               (!cons acc))
           (setq node-level this-level))
          ;; Underneath a node but not on a node, therefore we are buried