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

ENH make agenda scanner understand daily nodes (in theory)

This commit is contained in:
Nathan Dwarshuis 2022-04-05 22:47:10 -04:00
parent 757c36fde9
commit d671b9b45e
1 changed files with 38 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1963,17 +1963,18 @@ used for optimization."
((-some->> it-planning (org-ml-get-properties :deadline)) ((-some->> it-planning (org-ml-get-properties :deadline))
(either :left "Daily metablocks cannot be deadlined")) (either :left "Daily metablocks cannot be deadlined"))
((equal it-todo org-x-kw-todo) ((equal it-todo org-x-kw-todo)
(-if-let ((sched-date sched-time) (-some->> it-planning (-if-let (sched (-some->> it-planning
(org-ml-get-property :scheduled) (org-ml-get-property :scheduled)))
(-let (((sched-date sched-time) (->> sched
(org-ml-timestamp-get-start-time) (org-ml-timestamp-get-start-time)
(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) (-let* (((&plist :tags) node-data)
(tag-date (org-x-dag-daily-tags-to-date tags))) (tag-date (org-x-dag-daily-tags-to-date tags)))
(if (org-x-dag-datetime= tag-date sched-date) (if (org-x-dag-datetime= tag-date sched-date)
(either :right `(:active)) (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")))))
(either :left "Daily metablocks must be scheduled"))) (either :left "Daily metablocks must be scheduled")))
(t (t
(org-x-dag-bs-error-kw "Daily metablock" it-todo))))) (org-x-dag-bs-error-kw "Daily metablock" it-todo)))))
@ -3498,22 +3499,32 @@ except it ignores inactive timestamps."
(--> datetimes (--> datetimes
(--remove (and donep (not (org-x-dag-datetime= (-take 3 it) sel-date))) it) (--remove (and donep (not (org-x-dag-datetime= (-take 3 it) sel-date))) it)
(if (not todayp) (--remove (org-x-dag-datetime< (-take 3 it) sel-date) it) it) (if (not todayp) (--remove (org-x-dag-datetime< (-take 3 it) sel-date) it) it)
(--map (funcall format-datetime-fun sel-date pos it tags id) it))))))) (--map (funcall format-datetime-fun sel-date pos it tags id) it))))))
(let ((todayp (= (org-x-dag-date-to-absolute sel-date) (org-today)))) (format-scheduleds
;; TODO this won't show daily nodes (todayp sel-date id ts)
(org-x-dag-with-action-ids (format-timestamps todayp sel-date id ts
#'org-x-dag-get-scheduled-at
#'org-x-dag-format-scheduled-node))
(format-deadlines
(todayp sel-date id ts)
(format-timestamps todayp sel-date id ts
#'org-x-dag-get-deadlines-at
#'org-x-dag-format-deadline-node)))
(let* ((todayp (= (org-x-dag-date-to-absolute sel-date) (org-today)))
(action (org-x-dag-with-action-ids
(pcase (either-from-right (org-x-dag-id->bs it) nil) (pcase (either-from-right (org-x-dag-id->bs it) nil)
(`(:sp-task :task-active ,s) (`(:sp-task :task-active ,s)
(-let (((&plist :sched :dead) s)) (-let (((&plist :sched :dead) s))
(append (append
(when dead (when dead
(format-timestamps todayp sel-date it dead (format-deadlines todayp sel-date it dead))
#'org-x-dag-get-deadlines-at
#'org-x-dag-format-deadline-node))
(when sched (when sched
(format-timestamps todayp sel-date it sched (format-scheduleds todayp sel-date it sched))))))))
#'org-x-dag-get-scheduled-at (daily (org-x-dag-with-file-ids (org-x-dag->planning-file :daily)
#'org-x-dag-format-scheduled-node)))))))))) (pcase (either-from-right (org-x-dag-id->bs it) nil)
(`(:daily :active ,s)
(format-scheduleds todayp sel-date it sched))))))
(append action daily))))
(defun org-x-dag-scan-quarterly-plan () (defun org-x-dag-scan-quarterly-plan ()
(let ((week-file (list (org-x-get-weekly-plan-file))) (let ((week-file (list (org-x-get-weekly-plan-file)))