ENH speed up buffer parser by...alot

local/lib/org-x/org-x-dag.el

@@ -1097,34 +1097,35 @@ A date like (YEAR MONTH DAY).")
 
 ;;; BUFFER SCANNING
 
-(defun org-x-dag-get-local-property (range prop)
+(defun org-x-dag-get-local-property (bounds prop)
-  (-when-let ((beg . end) range)
+  (-when-let ((_ beg end _) bounds)
     (save-excursion
       (goto-char beg)
       (when (re-search-forward (org-re-property prop nil t) end t)
         (match-string-no-properties 3)))))
 
-(defun org-x-dag-get-local-properties (range props)
+(defun org-x-dag-get-local-properties (bounds props)
-  (-when-let ((beg . end) range)
+  (when bounds
-    (save-excursion
+    (-let (((_ beg end _) bounds))
-      (let (acc)
+      (save-excursion
-        (while props
+        (let (acc)
-          (goto-char beg)
+          (while props
-          (when (re-search-forward (org-re-property (car props) nil t) end t)
+            (goto-char beg)
-            (!cons (cons (car props) (match-string-no-properties 3)) acc))
+            (when (re-search-forward (org-re-property (car props) nil t) end t)
-          (!cdr props))
+              (!cons (cons (car props) (match-string-no-properties 3)) acc))
-        acc))))
+            (!cdr props))
-          
+          acc)))))
-    ;; (car (org--property-local-values prop nil)))
 
-;; (defun org-x-dag-get-link-property (range)
+(defconst org-x-dag-parent-link-drawer-re 
-;;   (-some->> (org-x-dag-get-local-property range org-x-prop-goal)
+  (concat
-;;     (s-split ";")
+   "^[ \t]*:X_PARENT_LINKS:[ \t]*\n"
-;;     (--map (->> (s-trim it)
+   "\\(\\(?:^- .*?\n\\)*?\\)"
-;;                 (s-match "^\\[\\[id:\\(.*\\)\\]\\[.*\\]\\]$")
+   "[ \t]*:END:[ \t]*$"))
-;;                 (cadr)))))
 
-(defun org-x-dag-get-parent-links ()
+(defun org-x-dag-next-headline ()
+  (save-excursion (outline-next-heading)))
+
+(defun org-x-dag-get-parent-links (&optional start end)
   (cl-flet
       ((match-id
         (s)
@@ -1132,15 +1133,14 @@ A date like (YEAR MONTH DAY).")
              (cadr)
              (substring-no-properties))))
     (save-excursion
-      (let ((re (concat
+      (when start
-                 "^[ \t]*:X_PARENT_LINKS:[ \t]*\n"
+        (goto-char start))
-                 "\\(\\(?:^- .*?\n\\)*?\\)"
+      (let ((end (or end (org-x-dag-next-headline))))
-                 "[ \t]*:END:[ \t]*$"))
+        (when (re-search-forward org-x-dag-parent-link-drawer-re end t)
-            (end (save-excursion (outline-next-heading))))
+          (-some->> (match-string 1)
-        (-some->> (and (re-search-forward re end t) (match-string 1))
+            (s-trim)
-          (s-trim)
+            (s-split "\n")
-          (s-split "\n")
+            (-map #'match-id)))))))
-          (-map #'match-id))))))
 
 (defun org-x-dag-line-regexp (kws)
   (let ((level-re "\\(\\*+\\)")
@@ -1149,6 +1149,41 @@ A date like (YEAR MONTH DAY).")
         (tag-re "\\(?:\\([[:alnum:]_@#%%:]+\\):\\)?"))
     (format "^%s[ ]+%s%s%s[ ]*$" level-re kw-re title-re tag-re)))
 
+(defconst org-x-dag-prop-drawer-re
+  (concat
+   "^[\t ]*:PROPERTIES:[\t ]*\n"
+   ;; "\\([\t ]*:\\S-+:\\(?: .*\\)?[\t ]*\n\\)"
+   "\\(\\(.\\|\n\\)*?\\)"
+   "[\t ]*:END:[\t ]*$"))
+
+(defun org-x-dag-property-block (end)
+  "Return (DRWR-BEG BEG END DRWR-END) of the property block.
+
+This is like `org-get-property-block' except way faster, and
+assumes the point is on the first line of the headline in
+question. END is the end of the search space (presumably the next
+headline)."
+  (save-excursion
+    (when (re-search-forward org-x-dag-prop-drawer-re end t)
+      (list (match-beginning 0)
+            (match-beginning 1)
+            (match-end 1)
+            (match-end 0)))))
+
+(defun org-x-dag-parse-this-planning (prop-beg)
+  "Parse the planning element for this headline.
+
+Assume point is somewhere on the first line of headline. Note
+that it is invalid for the planning keyword to start on anything
+other than the next line.
+
+PROP-BEG is the beginning position of the property drawer and
+used for optimization."
+  (save-excursion
+    (forward-line 1)
+    (when (and (< (point) prop-beg) (looking-at org-planning-line-re))
+      (org-element-planning-parser prop-beg))))
+
 (defun org-x-dag-get-buffer-nodes (file kws target-props)
   "Return a list of nodes from FILE.
 
@@ -1181,7 +1216,8 @@ headline."
             this-title (-if-let (s (match-string 3)) (s-trim s) "")
             this-tags (-some-> (match-string-no-properties 4)
                         (split-string ":" t))
-            this-prop-bounds (org-get-property-block)
+            next-pos (or (org-x-dag-next-headline) (point-max))
+            this-prop-bounds (org-x-dag-property-block next-pos)
             this-key nil
             this-links nil)
       ;; Adjust the stack so that the top headline is the parent of the
@@ -1202,11 +1238,8 @@ headline."
                                 (--mapcat (nth 2 it))
                                 (append this-tags org-file-tags))
                          this-tags)
-              this-planning (save-excursion
+              this-planning (org-x-dag-parse-this-planning (car this-prop-bounds))
-                              (forward-line 1)
+              this-links (or (org-x-dag-get-parent-links (nth 3 this-prop-bounds) next-pos)
-                              (when (looking-at org-planning-line-re)
-                                (org-element-planning-parser nil)))
-              this-links (or (org-x-dag-get-parent-links)
                              (if this-parent-key
                                  (-some->> (--first (nth 3 it) cur-path)
                                    (nth 3))
@@ -1224,7 +1257,10 @@ headline."
         (!cons (cons this-key this-meta) acc-meta)
         (!cons (cons this-key `(,(nth 1 this-parent) ,@this-links)) acc))
       ;; Add current headline to stack
-      (!cons (list this-level this-key this-tags this-links) cur-path))
+      (!cons (list this-level this-key this-tags this-links) cur-path)
+      ;; Since we know the next headline's position already, skip ahead to
+      ;; save some work
+      (goto-char next-pos))
     (list (nreverse acc) (nreverse acc-meta))))
 
 (defun org-x-dag-get-file-nodes (file)