ENH make DLP menu show times and sort

This commit is contained in:
Nathan Dwarshuis 2022-05-07 16:49:21 -04:00
parent ba6276debf
commit f83ff47f72
1 changed files with 61 additions and 13 deletions

View File

@ -1802,6 +1802,17 @@ DEF-FUN and the output from GET-FUN (type :: a -> NS)."
(:daily "DLP") (:daily "DLP")
(_ "???"))) (_ "???")))
(defun org-x-dag-group-order (group)
(pcase group
(:lifetime 7)
(:survival 6)
(:endpoint 5)
(:action 4)
(:quarterly 3)
(:weekly 2)
(:daily 1)
(_ 0)))
(defun org-x-dag-read-file-paths () (defun org-x-dag-read-file-paths ()
(list :goal-files (list :lifetime (org-x-get-lifetime-goal-file) (list :goal-files (list :lifetime (org-x-get-lifetime-goal-file)
:endpoint (org-x-get-endpoint-goal-file) :endpoint (org-x-get-endpoint-goal-file)
@ -2141,6 +2152,10 @@ highest in the tree."
(-some->> (org-x-dag-id->planning-timestamp which id) (-some->> (org-x-dag-id->planning-timestamp which id)
(org-ml-timestamp-get-start-time))) (org-ml-timestamp-get-start-time)))
(defun org-x-dag-id->planning-epoch (which id)
(-some->> (org-x-dag-id->planning-datetime which id)
(org-ml-time-to-unixtime)))
(defun org-x-dag-id->agenda-timestamp (id) (defun org-x-dag-id->agenda-timestamp (id)
"Retrieve timestamp information of ID for sorting agenda views. "Retrieve timestamp information of ID for sorting agenda views.
This is a rewrite of `org-agenda-entry-get-agenda-timestamp' This is a rewrite of `org-agenda-entry-get-agenda-timestamp'
@ -3772,7 +3787,8 @@ FUTURE-LIMIT in a list."
(org-x-dag-id->title id) (org-x-dag-id->title id)
(org-x-dag-id->path (eq group :action) id))))) (org-x-dag-id->path (eq group :action) id)))))
(defun org-x-dag--link-parent-to-child (parent-id-fun child-id-fun fmt-fun) (defun org-x-dag--link-parent-to-child (parent-id-fun child-id-fun fmt-fun
sort-fun)
(cl-flet* (cl-flet*
(;; (is-valid-node (;; (is-valid-node
;; (id) ;; (id)
@ -3788,6 +3804,7 @@ FUTURE-LIMIT in a list."
(this-id) (this-id)
(-if-let (collection (->> (funcall child-id-fun) (-if-let (collection (->> (funcall child-id-fun)
;; (-filter #'is-valid-node) ;; (-filter #'is-valid-node)
(-sort sort-fun)
(--map (to-menu-line this-id it)))) (--map (to-menu-line this-id it))))
(-let* (((&plist :id :presentp) (-let* (((&plist :id :presentp)
(-> (completing-read "Child: " collection nil t) (-> (completing-read "Child: " collection nil t)
@ -3812,11 +3829,19 @@ FUTURE-LIMIT in a list."
(defun org-x-dag-link-parent-to-child () (defun org-x-dag-link-parent-to-child ()
(interactive) (interactive)
(cl-flet* (cl-flet*
((id-group-order
(id)
(->> (org-x-dag-id->group id)
(org-x-dag-group-order)))
(id-epoch
(id)
(or (org-x-dag-id->planning-epoch :scheduled id) 0))
;; parent id functions ;; parent id functions
;; ;;
;; TODO might make sense to check for validity here so I don't link ;; TODO might make sense to check for validity here so I don't link
;; poisoned nodes together ;; poisoned nodes together
((id-getter (id-getter
() ()
(-if-let (id (org-id-get)) (-if-let (id (org-id-get))
(either :right id) (either :right id)
@ -3855,7 +3880,30 @@ FUTURE-LIMIT in a list."
(not (org-x-dag-id->ns-key :survivalp it)))))) (not (org-x-dag-id->ns-key :survivalp it))))))
(epg-action-qtp-getter (epg-action-qtp-getter
() ()
`(,@(org-x-dag->epg-ids) ,@(action-qtp-getter)))) `(,@(org-x-dag->epg-ids) ,@(action-qtp-getter)))
;; format functions
(dlp-formatter
(id)
(let ((title (org-x-dag-id->title id))
(time (-some->> (org-x-dag-id->planning-datetime :scheduled id)
(org-x-dag-datetime-split)
(nth 1)
(apply #'format "%02d:%02d"))))
(format "%s | %s" (or time "??:??") title)))
;; sort functions
(pos-sort
(id-a id-b)
(let ((ga (id-group-order id-a))
(gb (id-group-order id-b)))
(if (= ga gb) (< ga gb)
(let ((pa (org-x-dag-id->point id-a))
(pb (org-x-dag-id->point id-a)))
(< pa pb)))))
(time-sort
(id-a id-b)
(< (id-epoch id-a) (id-epoch id-b))))
(org-x-dag-sync) (org-x-dag-sync)
(let ((f (buffer-file-name))) (let ((f (buffer-file-name)))
@ -3864,32 +3912,32 @@ FUTURE-LIMIT in a list."
(org-x-dag--link-parent-to-child (org-x-dag--link-parent-to-child
#'leaf-id-getter #'leaf-id-getter
#'epg-action-qtp-getter #'epg-action-qtp-getter
#'org-x-dag--format-link-menu-line-expanded)) #'org-x-dag--format-link-menu-line-expanded
#'pos-sort))
((equal f (org-x-dag->goal-file :endpoint)) ((equal f (org-x-dag->goal-file :endpoint))
(org-x-dag--link-parent-to-child (org-x-dag--link-parent-to-child
#'leaf-id-getter #'leaf-id-getter
#'action-qtp-getter #'action-qtp-getter
#'org-x-dag--format-link-menu-line-expanded)) #'org-x-dag--format-link-menu-line-expanded
#'pos-sort))
((equal f (org-x-dag->goal-file :survival)) ((equal f (org-x-dag->goal-file :survival))
(org-x-dag--link-parent-to-child (org-x-dag--link-parent-to-child
#'leaf-id-getter #'leaf-id-getter
#'svg-action-getter #'svg-action-getter
(-partial #'org-x-dag-id->path t))) (-partial #'org-x-dag-id->path t)
#'pos-sort))
((member f (org-x-dag->action-files)) ((member f (org-x-dag->action-files))
(org-x-dag--link-parent-to-child (org-x-dag--link-parent-to-child
#'action-id-getter #'action-id-getter
#'org-x-dag->current-dlp-ids #'org-x-dag->current-dlp-ids
#'org-x-dag-id->title)) #'dlp-formatter
#'time-sort))
((equal f (org-x-dag->planning-file :quarterly)) ((equal f (org-x-dag->planning-file :quarterly))
(org-x-dag--link-parent-to-child (org-x-dag--link-parent-to-child
#'id-getter #'id-getter
#'org-x-dag->current-wkp-ids #'org-x-dag->current-wkp-ids
#'org-x-dag-id->title)) #'org-x-dag-id->title
((equal f (org-x-dag->planning-file :weekly)) #'pos-sort))
(org-x-dag--link-parent-to-child
#'id-getter
#'org-x-dag->current-dlp-ids
#'org-x-dag-id->title))
(t (t
(message "Cannot link child from parent in current file")))))) (message "Cannot link child from parent in current file"))))))