ENH speed up buffer parser by...alot

This commit is contained in:
Nathan Dwarshuis 2022-03-02 20:00:12 -05:00
parent 851cafa78a
commit 5a0c4644a0
1 changed files with 73 additions and 37 deletions

View File

@ -1097,15 +1097,16 @@ A date like (YEAR MONTH DAY).")
;;; BUFFER SCANNING ;;; 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 (save-excursion
(goto-char beg) (goto-char beg)
(when (re-search-forward (org-re-property prop nil t) end t) (when (re-search-forward (org-re-property prop nil t) end t)
(match-string-no-properties 3))))) (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
(-let (((_ beg end _) bounds))
(save-excursion (save-excursion
(let (acc) (let (acc)
(while props (while props
@ -1113,18 +1114,18 @@ A date like (YEAR MONTH DAY).")
(when (re-search-forward (org-re-property (car props) nil t) end t) (when (re-search-forward (org-re-property (car props) nil t) end t)
(!cons (cons (car props) (match-string-no-properties 3)) acc)) (!cons (cons (car props) (match-string-no-properties 3)) acc))
(!cdr props)) (!cdr props))
acc)))) acc)))))
;; (car (org--property-local-values prop nil))) (defconst org-x-dag-parent-link-drawer-re
(concat
"^[ \t]*:X_PARENT_LINKS:[ \t]*\n"
"\\(\\(?:^- .*?\n\\)*?\\)"
"[ \t]*:END:[ \t]*$"))
;; (defun org-x-dag-get-link-property (range) (defun org-x-dag-next-headline ()
;; (-some->> (org-x-dag-get-local-property range org-x-prop-goal) (save-excursion (outline-next-heading)))
;; (s-split ";")
;; (--map (->> (s-trim it)
;; (s-match "^\\[\\[id:\\(.*\\)\\]\\[.*\\]\\]$")
;; (cadr)))))
(defun org-x-dag-get-parent-links () (defun org-x-dag-get-parent-links (&optional start end)
(cl-flet (cl-flet
((match-id ((match-id
(s) (s)
@ -1132,15 +1133,14 @@ A date like (YEAR MONTH DAY).")
(cadr) (cadr)
(substring-no-properties)))) (substring-no-properties))))
(save-excursion (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) (defun org-x-dag-line-regexp (kws)
(let ((level-re "\\(\\*+\\)") (let ((level-re "\\(\\*+\\)")
@ -1149,6 +1149,41 @@ A date like (YEAR MONTH DAY).")
(tag-re "\\(?:\\([[:alnum:]_@#%%:]+\\):\\)?")) (tag-re "\\(?:\\([[:alnum:]_@#%%:]+\\):\\)?"))
(format "^%s[ ]+%s%s%s[ ]*$" level-re kw-re title-re tag-re))) (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) (defun org-x-dag-get-buffer-nodes (file kws target-props)
"Return a list of nodes from FILE. "Return a list of nodes from FILE.
@ -1181,7 +1216,8 @@ headline."
this-title (-if-let (s (match-string 3)) (s-trim s) "") this-title (-if-let (s (match-string 3)) (s-trim s) "")
this-tags (-some-> (match-string-no-properties 4) this-tags (-some-> (match-string-no-properties 4)
(split-string ":" t)) (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-key nil
this-links nil) this-links nil)
;; Adjust the stack so that the top headline is the parent of the ;; Adjust the stack so that the top headline is the parent of the
@ -1202,11 +1238,8 @@ headline."
(--mapcat (nth 2 it)) (--mapcat (nth 2 it))
(append this-tags org-file-tags)) (append this-tags org-file-tags))
this-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 (if this-parent-key
(-some->> (--first (nth 3 it) cur-path) (-some->> (--first (nth 3 it) cur-path)
(nth 3)) (nth 3))
@ -1224,7 +1257,10 @@ headline."
(!cons (cons this-key this-meta) acc-meta) (!cons (cons this-key this-meta) acc-meta)
(!cons (cons this-key `(,(nth 1 this-parent) ,@this-links)) acc)) (!cons (cons this-key `(,(nth 1 this-parent) ,@this-links)) acc))
;; Add current headline to stack ;; 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)))) (list (nreverse acc) (nreverse acc-meta))))
(defun org-x-dag-get-file-nodes (file) (defun org-x-dag-get-file-nodes (file)