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

ENH show overdue deadlines

This commit is contained in:
Nathan Dwarshuis 2022-06-01 18:34:30 -04:00
parent c081c34a43
commit 6aaa513856
1 changed files with 17 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -3296,32 +3296,41 @@ FUTURE-LIMIT in a list."
(defun org-x-dag-itemize-agenda (files sel-date) (defun org-x-dag-itemize-agenda (files sel-date)
(let ((todayp (org-x-dag-date= (org-x-dag-current-date) sel-date))) (let ((todayp (org-x-dag-date= (org-x-dag-current-date) sel-date)))
(cl-flet* (cl-flet*
((get-datetimes ((past-p
(donep dt-fun pts) (datetime)
(org-x-dag-date< datetime sel-date))
(get-datetimes
(donep keep-most-recent-p dt-fun pts)
(if donep (if donep
(-let (((&plist :datetime) pts)) (-let (((&plist :datetime) pts))
(when (org-x-dag-date= datetime sel-date) (when (org-x-dag-date= datetime sel-date)
`(,datetime))) `(,datetime)))
(-when-let (datetimes (funcall dt-fun sel-date pts)) (-when-let (datetimes (funcall dt-fun sel-date pts))
(if todayp datetimes (cond
(--drop-while (org-x-dag-date< it sel-date) datetimes))))) (todayp
datetimes)
(keep-most-recent-p
(-let (((past rest) (-split-with #'past-p datetimes)))
(if past (cons (-last-item past) rest) rest)))
(t
(-drop-while #'past-p datetimes))))))
(expand-datetimes (expand-datetimes
(id donep which dt-fun post-fun) (id donep keep-past-p which dt-fun post-fun)
(-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 keep-past-p dt-fun pts))
(-let ((tags (org-x-dag-id->tags id)) (-let ((tags (org-x-dag-id->tags id))
((&plist :pos) pts)) ((&plist :pos) pts))
(->> (-map post-fun ds) (->> (-map post-fun ds)
(--map (list :pos pos :datetime it :tags tags :id id))))))) (--map (list :pos pos :datetime it :tags tags :id id)))))))
(scheduled-datetimes (scheduled-datetimes
(id donep) (id donep)
(expand-datetimes id donep :scheduled (expand-datetimes id donep nil :scheduled
#'org-x-dag-get-scheduled-at #'org-x-dag-get-scheduled-at
#'identity)) #'identity))
(deadlined-datetimes (deadlined-datetimes
(id donep) (id donep)
(expand-datetimes id donep :deadline (expand-datetimes id donep t :deadline
#'org-x-dag-get-deadlines-at #'org-x-dag-get-deadlines-at
(lambda (datetime) (lambda (datetime)
(if (org-x-dag-date= datetime sel-date) datetime (if (org-x-dag-date= datetime sel-date) datetime