ndwarshuis
/
emacs-config
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

ENH make property/link parsers faster

This commit is contained in:
Nathan Dwarshuis 2022-03-27 13:13:20 -04:00
parent 8a717cc1fd
commit a028abb822
1 changed files with 34 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

69
local/lib/org-x/org-x-dag.el
View File

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