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

REF make date comparisons simpler

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

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

@ -46,8 +46,11 @@
(-take 5) (-take 5)
(reverse))) (reverse)))
(defun org-x-dag-datetime-to-date (datetime)
(-take 3 datetime))
(defun org-x-dag-current-date () (defun org-x-dag-current-date ()
(-take 3 (org-x-dag-current-datetime))) (org-x-dag-datetime-to-date (org-x-dag-current-datetime)))
(defun org-x-dag-current-time () (defun org-x-dag-current-time ()
(-drop 3 (org-x-dag-current-datetime))) (-drop 3 (org-x-dag-current-datetime)))
@ -89,6 +92,13 @@
,form ,form
(error "Datetimes are invalid lengths: %S and %S" ,datetime0 ,datetime1))) (error "Datetimes are invalid lengths: %S and %S" ,datetime0 ,datetime1)))
(defun org-x-dag-datetime-split (datetime)
;; TODO this function doesn't guarantee that a short timestamp is properly
;; formatted
(if (org-ml-time-is-long datetime)
(-split-at 3 datetime)
`(,(org-x-dag-datetime-to-date datetime) nil)))
(defun org-x-dag-datetime< (datetime0 datetime1) (defun org-x-dag-datetime< (datetime0 datetime1)
(org-x-dag-with-times datetime0 datetime1 (org-x-dag-with-times datetime0 datetime1
(-when-let (next (->> (-zip-with #'cons datetime0 datetime1) (-when-let (next (->> (-zip-with #'cons datetime0 datetime1)
@ -102,12 +112,13 @@
(--drop-while (= (car it) (cdr it))) (--drop-while (= (car it) (cdr it)))
(not)))) (not))))
(defun org-x-dag-datetime-split (datetime) (defun org-x-dag-date< (datetime0 datetime1)
;; TODO this function doesn't guarantee that a short timestamp is properly (org-x-dag-datetime< (org-x-dag-datetime-to-date datetime0)
;; formatted (org-x-dag-datetime-to-date datetime1)))
(if (org-ml-time-is-long datetime)
(-split-at 3 datetime) (defun org-x-dag-date= (datetime0 datetime1)
`(,(-take 3 datetime) nil))) (org-x-dag-datetime= (org-x-dag-datetime-to-date datetime0)
(org-x-dag-datetime-to-date datetime1)))
(defun org-x-dag-datetime-shift (datetime shift unit) (defun org-x-dag-datetime-shift (datetime shift unit)
(cl-flet* (cl-flet*
@ -120,7 +131,7 @@
(list y* m* d* H* M*))) (list y* m* d* H* M*)))
(enc-dec-short (enc-dec-short
(y m d) (y m d)
(-take 3 (enc-dec-long y m d 0 0)))) (org-x-dag-datetime-to-date (enc-dec-long y m d 0 0))))
(pcase datetime (pcase datetime
((or `(,y ,m ,d) `(,y ,m ,d nil nil)) ((or `(,y ,m ,d) `(,y ,m ,d nil nil))
(pcase unit (pcase unit
@ -2773,8 +2784,8 @@ FUTURE-LIMIT in a list."
((&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
(--remove (and donep (not (org-x-dag-datetime= (-take 3 it) sel-date))) it) (--remove (and donep (not (org-x-dag-date= 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-date< 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))))))
(format-scheduleds (format-scheduleds
(todayp sel-date id ts) (todayp sel-date id ts)
@ -2798,11 +2809,11 @@ FUTURE-LIMIT in a list."
(pcase (either-from-right (org-x-dag-id->bs it) nil) (pcase (either-from-right (org-x-dag-id->bs it) nil)
(`(:daily :active (:sched ,sched)) (`(:daily :active (:sched ,sched))
(-when-let (datetime (org-ml-timestamp-get-start-time sched)) (-when-let (datetime (org-ml-timestamp-get-start-time sched))
(when (org-x-dag-datetime= sel-date (-take 3 datetime)) (when (org-x-dag-date= sel-date datetime)
(format-scheduleds todayp sel-date it sched)))) (format-scheduleds todayp sel-date it sched))))
(`(:daily :complete ,_) (`(:daily :complete ,_)
(-when-let (sched (org-x-dag-id->planning-timestamp :scheduled it)) (-when-let (sched (org-x-dag-id->planning-timestamp :scheduled it))
(when (org-x-dag-datetime= sel-date (-take 3 (org-ml-timestamp-get-start-time sched))) (when (org-x-dag-date= sel-date (org-ml-timestamp-get-start-time sched))
(format-scheduleds todayp sel-date it sched)))) (format-scheduleds todayp sel-date it sched))))
(`(:sp-task :task-active ,_) (`(:sp-task :task-active ,_)
(with-task-ish it todayp)) (with-task-ish it todayp))