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

REF simplify calling tags functions

This commit is contained in:
Nathan Dwarshuis 2022-04-22 19:09:00 -04:00
parent b584f6ed9c
commit 69b17e90b3
1 changed files with 20 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1900,13 +1900,9 @@ Return one of seven values: :lifetime, :survival, :endpoint,
"Return local tags for ID." "Return local tags for ID."
(org-x-dag-id->hl-meta-prop id :tags)) (org-x-dag-id->hl-meta-prop id :tags))
(defun org-x-dag-id->tags (parent-tags id) (defun org-x-dag-id->tags (id)
"Return all tags for ID. "Return all tags for ID.
If PARENT-TAGS is nil, return all inherited tags based on the
parents of ID. If PARENT-TAGS is a list of strings, these are
used as the parent tags instead of looking them up.
Returned tags will be ordered from left to right as lowest to Returned tags will be ordered from left to right as lowest to
highest in the tree." highest in the tree."
(cl-labels (cl-labels
@ -1921,13 +1917,13 @@ highest in the tree."
(ascend parent)) (ascend parent))
tags))) tags)))
(let ((local-tags (org-x-dag-id->local-tags id))) (let ((local-tags (org-x-dag-id->local-tags id)))
`(,@local-tags ,@(or parent-tags (ascend id nil)))))) `(,@local-tags ,@(ascend id nil)))))
(defun org-x-dag-id->bucket (parent-tags id) ;; (defun org-x-dag-id->bucket (parent-tags id)
(-some->> (org-x-dag-id->tags parent-tags id) ;; (-some->> (org-x-dag-id->tags parent-tags id)
(--find (= (elt it 0) org-x-tag-category-prefix)) ;; (--find (= (elt it 0) org-x-tag-category-prefix))
(s-chop-prefix "_") ;; (s-chop-prefix "_")
(intern))) ;; (intern)))
(defun org-x-dag-id->link (id) (defun org-x-dag-id->link (id)
"Return the link node for ID." "Return the link node for ID."
@ -2110,10 +2106,10 @@ Return value is a list like (BUFFER NON-BUFFER)."
(org-x-dag-files->ids))) (org-x-dag-files->ids)))
(defun org-x-dag-filter-ids-tags (tags ids) (defun org-x-dag-filter-ids-tags (tags ids)
(--filter (-intersection (org-x-dag-id->tags nil it) tags) ids)) (--filter (-intersection (org-x-dag-id->tags it) tags) ids))
(defun org-x-dag-date->tagged-ids (ids tag-getter date) (defun org-x-dag-date->tagged-ids (ids tag-getter date)
(--filter (equal date (funcall tag-getter (org-x-dag-id->tags nil it))) ids)) (--filter (equal date (funcall tag-getter (org-x-dag-id->tags it))) ids))
(defun org-x-dag-date->qtp-ids (date) (defun org-x-dag-date->qtp-ids (date)
(org-x-dag-date->tagged-ids (org-x-dag->qtp-ids) (org-x-dag-date->tagged-ids (org-x-dag->qtp-ids)
@ -2536,7 +2532,7 @@ FUTURE-LIMIT in a list."
(-let (((&plist :committed c) (-when-let (ns (org-x-dag-id->ns it)) (-let (((&plist :committed c) (-when-let (ns (org-x-dag-id->ns it))
(either-from-right ns nil)))) (either-from-right ns nil))))
(when (and (not sched) (not dead) c) (when (and (not sched) (not dead) c)
(let ((tags (org-x-dag-id->tags nil it)) (let ((tags (org-x-dag-id->tags it))
(bp (org-x-dag-id->buffer-parent it))) (bp (org-x-dag-id->buffer-parent it)))
(-> (org-x-dag-format-tag-node tags it) (-> (org-x-dag-format-tag-node tags it)
(org-add-props nil (org-add-props nil
@ -2557,7 +2553,7 @@ FUTURE-LIMIT in a list."
(:proj-stuck 1))) (:proj-stuck 1)))
(-when-let ((&plist :committed) (-when-let (ns (org-x-dag-id->ns it)) (-when-let ((&plist :committed) (-when-let (ns (org-x-dag-id->ns it))
(either-from-right ns nil))) (either-from-right ns nil)))
(let ((tags (org-x-dag-id->tags nil it))) (let ((tags (org-x-dag-id->tags it)))
(-> (org-x-dag-format-tag-node tags it) (-> (org-x-dag-format-tag-node tags it)
(org-add-props nil (org-add-props nil
'x-toplevelp (org-x-dag-id->is-toplevel-p it) 'x-toplevelp (org-x-dag-id->is-toplevel-p it)
@ -2571,7 +2567,7 @@ FUTURE-LIMIT in a list."
(`(:sp-proj . ,status-data) (`(:sp-proj . ,status-data)
(let ((status (car status-data))) (let ((status (car status-data)))
(when (memq status '(:iter-empty :iter-active)) (when (memq status '(:iter-empty :iter-active))
(let ((tags (org-x-dag-id->tags nil it))) (let ((tags (org-x-dag-id->tags it)))
(-> (org-x-dag-format-tag-node tags it) (-> (org-x-dag-format-tag-node tags it)
(org-add-props nil (org-add-props nil
'x-status status) 'x-status status)
@ -2592,7 +2588,7 @@ FUTURE-LIMIT in a list."
(-some-> (org-x-dag-id->ns it) (-some-> (org-x-dag-id->ns it)
(either-from-right nil)))) (either-from-right nil))))
(when (not p) (when (not p)
(let ((tags (org-x-dag-id->tags nil it)) (let ((tags (org-x-dag-id->tags it))
(toplevelp (pcase type (toplevelp (pcase type
((or :proj :task) ((or :proj :task)
(org-x-dag-id->is-toplevel-p it)) (org-x-dag-id->is-toplevel-p it))
@ -2611,7 +2607,7 @@ FUTURE-LIMIT in a list."
(cl-flet (cl-flet
((mk-item ((mk-item
(id type plannedp fulfilledp committedp) (id type plannedp fulfilledp committedp)
(let ((tags (org-x-dag-id->tags nil id)) (let ((tags (org-x-dag-id->tags id))
(leafp (org-x-dag-id->is-buffer-leaf-p id))) (leafp (org-x-dag-id->is-buffer-leaf-p id)))
(-> (org-x-dag-format-tag-node tags id) (-> (org-x-dag-format-tag-node tags id)
(org-add-props nil (org-add-props nil
@ -2652,7 +2648,7 @@ FUTURE-LIMIT in a list."
(org-x-dag-with-ids files (org-x-dag-with-ids files
(pcase (either-from-right (org-x-dag-id->bs it) nil) (pcase (either-from-right (org-x-dag-id->bs it) nil)
(`(:quarterly :active ,dead) (`(:quarterly :active ,dead)
(let* ((tags (org-x-dag-id->tags nil it)) (let* ((tags (org-x-dag-id->tags it))
(date (org-x-dag-quarter-tags-to-date tags))) (date (org-x-dag-quarter-tags-to-date tags)))
(when (org-x-dag-datetime= q-date date) (when (org-x-dag-datetime= q-date date)
(-when-let (ns (org-x-dag-id->ns it)) (-when-let (ns (org-x-dag-id->ns it))
@ -2674,7 +2670,7 @@ FUTURE-LIMIT in a list."
(org-x-dag-with-ids files (org-x-dag-with-ids files
(pcase (either-from-right (org-x-dag-id->bs it) nil) (pcase (either-from-right (org-x-dag-id->bs it) nil)
(`(:weekly :active) (`(:weekly :active)
(let* ((tags (org-x-dag-id->tags nil it)) (let* ((tags (org-x-dag-id->tags it))
(date (org-x-dag-weekly-tags-to-date tags)) (date (org-x-dag-weekly-tags-to-date tags))
(day (nth 2 (reverse tags)))) (day (nth 2 (reverse tags))))
(when (org-x-dag-datetime= sel-date date) (when (org-x-dag-datetime= sel-date date)
@ -2702,7 +2698,7 @@ FUTURE-LIMIT in a list."
nil nil
(unless (plist-get it :survivalp) (unless (plist-get it :survivalp)
(plist-get it :committed))))) (plist-get it :committed)))))
(tags (org-x-dag-id->tags nil it)) (tags (org-x-dag-id->tags it))
(bp (org-x-dag-id->buffer-parent it))) (bp (org-x-dag-id->buffer-parent it)))
(-> (org-x-dag-format-tag-node tags it) (-> (org-x-dag-format-tag-node tags it)
(org-add-props nil (org-add-props nil
@ -2720,7 +2716,7 @@ FUTURE-LIMIT in a list."
nil nil
(unless (plist-get it :survivalp) (unless (plist-get it :survivalp)
(plist-get it :committed))))) (plist-get it :committed)))))
(tags (org-x-dag-id->tags nil it))) (tags (org-x-dag-id->tags it)))
(-> (org-x-dag-format-tag-node tags it) (-> (org-x-dag-format-tag-node tags it)
(org-x-dag--item-add-goal-ids goal-ids)))))))) (org-x-dag--item-add-goal-ids goal-ids))))))))
@ -2740,7 +2736,7 @@ FUTURE-LIMIT in a list."
(org-x-dag-id->is-active-iterator-child-p it)))) (org-x-dag-id->is-active-iterator-child-p it))))
(-let ((epoch (plist-get comptime :epoch))) (-let ((epoch (plist-get comptime :epoch)))
(when (org-x-dag-time-is-archivable-p epoch) (when (org-x-dag-time-is-archivable-p epoch)
(let ((tags (org-x-dag-id->tags nil it))) (let ((tags (org-x-dag-id->tags it)))
(-> (org-x-dag-format-tag-node tags it) (-> (org-x-dag-format-tag-node tags it)
(org-add-props nil (org-add-props nil
'x-type type) 'x-type type)
@ -2773,7 +2769,7 @@ FUTURE-LIMIT in a list."
(-when-let (datetimes (funcall get-datetimes-fun sel-date pts)) (-when-let (datetimes (funcall get-datetimes-fun sel-date pts))
;; TODO this will show all tasks regardless of if they have a ;; TODO this will show all tasks regardless of if they have a
;; goal/plan or not ;; goal/plan or not
(-let ((tags (org-x-dag-id->tags nil id)) (-let ((tags (org-x-dag-id->tags id))
((&plist :pos) pts) ((&plist :pos) pts)
(donep (org-x-dag-id->is-done-p id))) (donep (org-x-dag-id->is-done-p id)))
(--> datetimes (--> datetimes