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

ENH don't show planning tags in agenda views

This commit is contained in:
Nathan Dwarshuis 2022-04-24 11:19:43 -04:00
parent 2bc636fb72
commit 79af946098
1 changed files with 24 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -534,18 +534,16 @@ used for optimization."
(unless node-stack (unless node-stack
(or (nth 2 (car bare-stack)) (or (nth 2 (car bare-stack))
this-file-links)))) this-file-links))))
(when this-tags
(setq this-tags (split-string this-tags ":")))
(unless node-stack
(setq this-tags (->> (or (nth 1 (car bare-stack)) org-file-tags)
(append this-tags))))
(->> (list :point this-point (->> (list :point this-point
:buffer-parent this-buffer-parent :buffer-parent this-buffer-parent
:effort (org-x-dag-get-local-property pbeg pend effort-prop) :effort (org-x-dag-get-local-property pbeg pend effort-prop)
:level this-level :level this-level
:todo this-todo :todo this-todo
:title (if this-title (substring-no-properties this-title) "") :title (if this-title (substring-no-properties this-title) "")
:tags this-tags :tags (when this-tags (split-string this-tags ":"))
:parent-tags (unless node-stack
(or (nth 1 (car bare-stack))
org-file-tags))
:planning (org-x-dag-parse-this-planning (nth 0 this-pblock)) :planning (org-x-dag-parse-this-planning (nth 0 this-pblock))
:props (org-x-dag-get-local-properties pbeg pend pps)) :props (org-x-dag-get-local-properties pbeg pend pps))
(append file-meta) (append file-meta)
@ -1069,8 +1067,10 @@ used for optimization."
(either :left "QTPs cannot be scheduled")) (either :left "QTPs cannot be scheduled"))
((equal it-todo org-x-kw-todo) ((equal it-todo org-x-kw-todo)
(-if-let (dead (-some->> it-planning (org-ml-get-properties :deadline))) (-if-let (dead (-some->> it-planning (org-ml-get-properties :deadline)))
(-let* (((&plist :tags) node-data) ;; ASSUME :parent-tags will contain the date tags as the level of the
(tag-dt (org-x-dag-quarter-tags-to-date tags)) ;; plan will never exceed one
(-let* (((&plist :parent-tags) node-data)
(tag-dt (org-x-dag-quarter-tags-to-date parent-tags))
(dead-dt (->> (org-ml-timestamp-get-start-time dead) (dead-dt (->> (org-ml-timestamp-get-start-time dead)
(org-x-dag-datetime-split) (org-x-dag-datetime-split)
(car)))) (car))))
@ -1111,8 +1111,10 @@ used for optimization."
(org-x-dag-datetime-split)))) (org-x-dag-datetime-split))))
(if (not sched-time) (if (not sched-time)
(either :left "Daily metablocks must have scheduled time") (either :left "Daily metablocks must have scheduled time")
(-let* (((&plist :tags) node-data) ;; ASSUME :parent-tags will contain the date tags as the level
(tag-date (org-x-dag-daily-tags-to-date tags))) ;; of the daily plan will never exceed one
(-let* (((&plist :parent-tags) node-data)
(tag-date (org-x-dag-daily-tags-to-date parent-tags)))
(if (org-x-dag-datetime= tag-date sched-date) (if (org-x-dag-datetime= tag-date sched-date)
(either :right `(:active (:sched ,sched))) (either :right `(:active (:sched ,sched)))
(either :left "Daily metablocks must be scheduled within their date"))))) (either :left "Daily metablocks must be scheduled within their date")))))
@ -1205,9 +1207,6 @@ used for optimization."
(-some->> (org-x-dag-adjlist-id-hl-meta-prop adjlist :planning id) (-some->> (org-x-dag-adjlist-id-hl-meta-prop adjlist :planning id)
(org-ml-get-property which))) (org-ml-get-property which)))
(defun org-x-dag-adjlist-id-tags (adjlist id)
(org-x-dag-adjlist-id-hl-meta-prop adjlist :tags id))
(defun org-x-dag-get-children (adjlist id) (defun org-x-dag-get-children (adjlist id)
(->> (plist-get (ht-get adjlist id) :children) (->> (plist-get (ht-get adjlist id) :children)
(--filter (-> (org-x-dag-adjlist-id-hl-meta adjlist it) (--filter (-> (org-x-dag-adjlist-id-hl-meta adjlist it)
@ -1591,13 +1590,13 @@ DEF-FUN and the output from GET-FUN (type :: a -> NS)."
(propagate h it ))))) (propagate h it )))))
(defun org-x-dag-get-network-status (sel-date adjlist links) (defun org-x-dag-get-network-status (sel-date adjlist links)
(cl-flet (cl-flet*
((cur-links ((plan-tags
(id)
(org-x-dag-adjlist-id-hl-meta-prop adjlist :parent-tags id))
(cur-links
(tag-fun date links) (tag-fun date links)
(--filter (equal date (->> (car it) (--filter (equal date (funcall tag-fun (plan-tags (car it)))) links)))
(org-x-dag-adjlist-id-tags adjlist)
(funcall tag-fun)))
links)))
(-let* ((ns (->> (list :action (-let* ((ns (->> (list :action
:endpoint :endpoint
:lifetime :lifetime
@ -1951,9 +1950,9 @@ highest in the tree."
(->> (org-x-dag-id->local-tags parent) (->> (org-x-dag-id->local-tags parent)
(append tags) (append tags)
(ascend parent)) (ascend parent))
tags))) `(,@tags ,@(org-x-dag-id->hl-meta-prop id :parent-tags)))))
(let ((local-tags (org-x-dag-id->local-tags id))) `(,@(org-x-dag-id->local-tags id)
`(,@local-tags ,@(ascend id nil))))) ,@(ascend id nil))))
(defun org-x-dag-id->node-properties (id) (defun org-x-dag-id->node-properties (id)
(org-x-dag-id->hl-meta-prop id :props)) (org-x-dag-id->hl-meta-prop id :props))
@ -2853,7 +2852,9 @@ FUTURE-LIMIT in a list."
(-when-let (pts (-some->> (org-x-dag-id->planning-timestamp which id) (-when-let (pts (-some->> (org-x-dag-id->planning-timestamp which id)
(org-x-dag-partition-timestamp))) (org-x-dag-partition-timestamp)))
(-when-let (ds (get-datetimes donep dt-fun pts)) (-when-let (ds (get-datetimes donep dt-fun pts))
(-let ((tags (org-x-dag-id->tags id)) (-let ((tags (if (eq (org-x-dag-id->group id) :daily)
(org-x-dag-id->local-tags id)
(org-x-dag-id->tags id)))
((&plist :pos) pts)) ((&plist :pos) pts))
(--map (list :pos pos :datetime it :tags tags :id id) ds))))) (--map (list :pos pos :datetime it :tags tags :id id) ds)))))
(scheduled-datetimes (scheduled-datetimes