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

ENH make buffer scanner faster

This commit is contained in:
Nathan Dwarshuis 2022-03-27 11:56:40 -04:00
parent ea9ab62f2c
commit 65389c6611
1 changed files with 76 additions and 68 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1218,10 +1218,9 @@ A date like (YEAR MONTH DAY).")
(defun org-x-dag-get-local-properties (bounds prop-pairs) (defun org-x-dag-get-local-properties (bounds prop-pairs)
(when bounds (when bounds
(-let (((_ beg end _) bounds) (-let (((_ beg end _) bounds))
(cur))
(save-excursion (save-excursion
(let (acc) (let (acc cur)
(while prop-pairs (while prop-pairs
(goto-char beg) (goto-char beg)
(setq cur (car prop-pairs)) (setq cur (car prop-pairs))
@ -1267,7 +1266,6 @@ A date like (YEAR MONTH DAY).")
(defconst org-x-dag-prop-drawer-re (defconst org-x-dag-prop-drawer-re
(concat (concat
"^[\t ]*:PROPERTIES:[\t ]*\n" "^[\t ]*:PROPERTIES:[\t ]*\n"
;; "\\([\t ]*:\\S-+:\\(?: .*\\)?[\t ]*\n\\)"
"\\(\\(.\\|\n\\)*?\\)" "\\(\\(.\\|\n\\)*?\\)"
"[\t ]*:END:[\t ]*$")) "[\t ]*:END:[\t ]*$"))
@ -1311,78 +1309,88 @@ used for optimization."
(org-x-dag-node i ps ,form))) (org-x-dag-node i ps ,form)))
(defun org-x-dag-get-buffer-nodes (file-meta kws target-props) (defun org-x-dag-get-buffer-nodes (file-meta kws target-props)
(let ((line-re (org-x-dag-line-regexp kws)) (goto-char (point-min))
(pps (--map (cons it (org-re-property it nil t)) target-props)) (let* ((line-re (org-x-dag-line-regexp kws))
(id-prop (org-re-property "ID" nil t)) (first-hl (org-x-dag-next-headline))
cur-path this-point this-key this-level this-todo has-todo this-parent ;; If not on a headline, check for a property drawer with links in it
this-tags this-meta all-tags this-file-links this-links this-parent-key acc) (this-file-links (unless (= ?* (following-char))
(goto-char (point-min)) (org-x-dag-get-parent-links first-hl nil)))
;; If not on a headline, check for a property drawer with links in it (pps (--map (cons it (org-re-property it nil t)) target-props))
(unless (= ?* (following-char)) (id-prop (org-re-property "ID" nil t))
(->> (org-x-dag-next-headline) ;; stack vars
(org-x-dag-get-parent-links nil) bare-stack node-level bury-level
(setq this-file-links))) ;; data vars
;; loop through all headlines this-id this-level this-todo this-tags this-pblock acc)
(while (re-search-forward line-re nil t) (when first-hl
(goto-char first-hl))
(while (looking-at line-re)
;; Keep track of how 'deep' we are in a given org-tree using a stack. The ;; Keep track of how 'deep' we are in a given org-tree using a stack. The
;; stack will have members like (LEVEL KEY TAGS) where LEVEL is the level ;; stack will have members like (LEVEL KEY TAGS) where LEVEL is the level
;; of the headline and KEY is the node key if it has a keyword, and TAGS ;; of the headline and KEY is the node key if it has a keyword, and TAGS
;; is a list of tags for the headlines. Only add a node to the accumulator ;; is a list of tags for the headlines. Only add a node to the accumulator
;; if it has a keyword and an ID property, and only include its parent ;; if it has a keyword and an ID property, and only include its parent
;; headline if the parent also has a keyword. ;; headline if the parent also has a keyword.
(setq this-point (car (match-data)) (setq this-point (car (match-data t))
this-level (length (match-string 1)) this-level (length (match-string 1))
this-todo (match-string 2) this-todo (match-string 2)
this-title (-if-let (s (match-string 3)) (s-trim s) "") this-title (match-string 3)
this-tags (-some-> (match-string-no-properties 4) this-tags (match-string-no-properties 4)
(split-string ":" t)) next-pos (or (org-x-dag-next-headline) (point-max)))
next-pos (or (org-x-dag-next-headline) (point-max)) (unless (and bury-level (< bury-level this-level))
this-key nil ;; Adjust the stack so that the top headline is the parent of the
this-links nil) ;; current headline
;; Adjust the stack so that the top headline is the parent of the (when (and node-level (<= this-level node-level))
;; current headline (setq node-level nil))
(while (and cur-path (<= this-level (nth 0 (car cur-path)))) (unless node-level
(!cdr cur-path)) (while (and bare-stack (<= this-level (nth 0 (car bare-stack))))
(setq this-parent (car cur-path) (!cdr bare-stack)))
this-parent-key (nth 1 this-parent)) ;; Add the current headline to accumulator if it is a node, but only if
;; Add the current headline to accumulator if it is a node, but only if ;; its parent is a node or none of its parents are nodes
;; its parent is a node or none of its parents are nodes (cond
(when (and this-todo ((and this-todo
(or this-parent-key (--none-p (nth 1 it) cur-path)) (setq this-pblock (org-x-dag-property-block next-pos)
(setq this-id (org-x-dag-get-local-property this-pblock id-prop)))
this-prop-bounds (org-x-dag-property-block next-pos) (setq bury-level nil
this-key (org-x-dag-get-local-property this-prop-bounds id-prop))) this-tags nil)
;; If parent is not a node and we want tag inheritance, store all (when this-tags
;; tags above this headline (including file tags) (setq this-tags (split-string this-tags ":" t)))
(setq this-links (or (-> (nth 3 this-prop-bounds) (when (and (not node-level) bare-stack)
(org-x-dag-get-parent-links next-pos)) (setq this-tags (->> (car bare-stack)
(unless this-parent-key (nth 1)
(-some->> (--first (nth 3 it) cur-path) (append this-tags))))
(nth 3) (-> (list
(append this-file-links)))) :id this-id
this-node :parents (or (-> (nth 3 this-pblock)
(list :id this-key (org-x-dag-get-parent-links next-pos))
:parents this-links (unless node-level
:node-meta (nth 2 (car bare-stack))))
(list :point this-point :node-meta
:level this-level (list
:todo this-todo :point this-point
:title this-title :level this-level
:tags (if (and (not this-parent-key) org-use-tag-inheritance) :todo this-todo
(->> cur-path :title (if this-title (s-trim-right this-title) "")
(--mapcat (nth 2 it)) :tags this-tags
(append this-tags org-file-tags)) :planning (->> (car this-pblock)
this-tags) (org-x-dag-parse-this-planning))
:planning (->> (car this-prop-bounds) :props (org-x-dag-get-local-properties this-pblock pps)))
(org-x-dag-parse-this-planning)) (!cons acc))
:props (-> this-prop-bounds (setq node-level this-level))
(org-x-dag-get-local-properties pps))))) ;; Underneath a node but not on a node, therefore we are buried
(!cons this-node acc)) (node-level
;; Add current headline to stack (setq bury-level this-level))
;; TODO this isn't necessary for non-node children of nodes ;; Anything else means we are on a bare headline above any nodes
(!cons (list this-level this-key this-tags this-links) cur-path) (t
;; Since we know the next headline's position already, skip ahead to (setq bury-level nil
;; save some work node-level nil)
(when this-tags
(setq this-tags (split-string this-tags ":" t)))
(-> (list this-level
(append this-tags (or (nth 1 (car bare-stack)) org-file-tags))
(or (org-x-dag-get-parent-links nil next-pos)
(nth 2 (car bare-stack))
this-file-links))
(!cons bare-stack)))))
(goto-char next-pos)) (goto-char next-pos))
(nreverse acc))) (nreverse acc)))