ENH make status buffer use org syntax
This commit is contained in:
parent
5bb0f8d279
commit
71f293892a
|
|
@ -2122,17 +2122,20 @@ highest in the tree."
|
||||||
;; (s-chop-prefix "_")
|
;; (s-chop-prefix "_")
|
||||||
;; (intern)))
|
;; (intern)))
|
||||||
|
|
||||||
(defun org-x-dag-id->link (id)
|
(defun org-x-dag-id->link (fullpath id)
|
||||||
"Return the link node for ID."
|
"Return the link node for ID."
|
||||||
(let ((desc (org-x-dag-id->title id)))
|
(->> (if fullpath (org-x-dag-id->path nil id) (org-x-dag-id->title id))
|
||||||
(->> (org-ml-build-secondary-string! desc)
|
(org-ml-build-secondary-string!)
|
||||||
(apply #'org-ml-build-link id :type "id"))))
|
(apply #'org-ml-build-link id :type "id")))
|
||||||
|
|
||||||
(defun org-x-dag-id->link-item (id)
|
(defun org-x-dag-id->link-item (id)
|
||||||
"Return the link node of ID wrapped in an item node."
|
"Return the link node of ID wrapped in an item node."
|
||||||
(->> (org-x-dag-id->link id)
|
(let* ((group (org-x-dag-id->group id))
|
||||||
(org-ml-build-paragraph)
|
(tag (if (eq group :action) (org-x-dag-id->category id)
|
||||||
(org-ml-build-item)))
|
(org-x-dag-group-code group)))
|
||||||
|
(fullpathp (memq group `(:action :endpoint :lifetime :survival)))
|
||||||
|
(link (org-x-dag-id->link fullpathp id)))
|
||||||
|
(org-ml-build-item :tag `(,tag) (org-ml-build-paragraph link))))
|
||||||
|
|
||||||
(defun org-x-dag-id->ns (id)
|
(defun org-x-dag-id->ns (id)
|
||||||
(-if-let (nst (plist-get org-x-dag :netstat))
|
(-if-let (nst (plist-get org-x-dag :netstat))
|
||||||
|
|
@ -4186,90 +4189,94 @@ FUTURE-LIMIT in a list."
|
||||||
(let ((s (make-string n ?\s)))
|
(let ((s (make-string n ?\s)))
|
||||||
(--map (s-prepend s it) lines)))
|
(--map (s-prepend s it) lines)))
|
||||||
|
|
||||||
(defun org-x-dag--format-bs (bs-data)
|
(defun org-x-dag--build-bs-paragraph (bs-data)
|
||||||
(cl-flet
|
(cl-flet*
|
||||||
((format-comptime
|
((format-event
|
||||||
|
(verb what y m d H M)
|
||||||
|
(format "%s %s on %d-%02d-%02d at %02d:%02d" verb what y m d H M))
|
||||||
|
(format-comptime
|
||||||
(what comptime)
|
(what comptime)
|
||||||
(-let* (((&plist :epoch e :canceledp c) comptime)
|
(-let* (((&plist :epoch e :canceledp c) comptime)
|
||||||
((y m d H M) (org-ml-unixtime-to-time-long e))
|
((y m d H M) (org-ml-unixtime-to-time-long e))
|
||||||
(verb (if c "Canceled" "Completed")))
|
(verb (if c "Canceled" "Completed")))
|
||||||
(format "%s %s on %d-%d-%d at %02d:%02d" verb what y m d H M))))
|
(format-event verb what y m d H M))))
|
||||||
;; TODO this could show more detail if I wanted
|
;; TODO this could show more detail if I wanted
|
||||||
(pcase bs-data
|
(let ((ls (pcase bs-data
|
||||||
(`(:action . ,d)
|
(`(:action . ,d)
|
||||||
(-let* (((&plist :ancestry a :local l) d)
|
(-let* (((&plist :ancestry a :local l) d)
|
||||||
(local-status
|
(local-status
|
||||||
(pcase l
|
(pcase l
|
||||||
(`(:sp-proj :proj-active)
|
(`(:sp-proj :proj-active)
|
||||||
"Active Project")
|
"Active Project")
|
||||||
(`(:sp-proj :proj-wait)
|
(`(:sp-proj :proj-wait)
|
||||||
"Waiting Project")
|
"Waiting Project")
|
||||||
(`(:sp-proj :proj-held)
|
(`(:sp-proj :proj-held)
|
||||||
"Held Project")
|
"Held Project")
|
||||||
(`(:sp-proj :proj-stuck)
|
(`(:sp-proj :proj-stuck)
|
||||||
"Stuck Project")
|
"Stuck Project")
|
||||||
(`(:sp-proj :proj-complete ,comptime)
|
(`(:sp-proj :proj-complete ,comptime)
|
||||||
(format-comptime "project" comptime))
|
(format-comptime "project" comptime))
|
||||||
(`(:sp-task :task-complete ,comptime)
|
(`(:sp-task :task-complete ,comptime)
|
||||||
(format-comptime "task" comptime))
|
(format-comptime "task" comptime))
|
||||||
(`(:sp-task :task-active ,_)
|
(`(:sp-task :task-active ,_)
|
||||||
"Active Task")
|
"Active Task")
|
||||||
(`(:sp-iter :iter-active ,_)
|
(`(:sp-iter :iter-active ,_)
|
||||||
"Active Iterator")
|
"Active Iterator")
|
||||||
(`(:sp-iter :iter-empty)
|
(`(:sp-iter :iter-empty)
|
||||||
"Empty Iterator")
|
"Empty Iterator")
|
||||||
(`(:sp-iter :iter-complete ,comptime)
|
(`(:sp-iter :iter-complete ,comptime)
|
||||||
(format-comptime "iterator" comptime))
|
(format-comptime "iterator" comptime))
|
||||||
(`(:sp-subiter :si-active ,_)
|
(`(:sp-subiter :si-active ,_)
|
||||||
"Active sub-iterator")
|
"Active sub-iterator")
|
||||||
(`(:sp-subiter :si-complete ,comptime)
|
(`(:sp-subiter :si-complete ,comptime)
|
||||||
(format-comptime "sub-iterator" comptime))
|
(format-comptime "sub-iterator" comptime))
|
||||||
(e (error "Unmatched pattern: %s" e))))
|
(e (error "Unmatched pattern: %s" e))))
|
||||||
((&plist :canceled-parent-p c :held-parent-p h) a)
|
((&plist :canceled-parent-p c :held-parent-p h) a)
|
||||||
(ancestry-status (cond
|
(ancestry-status (cond
|
||||||
((and c h) "Held/Canceled")
|
((and c h) "Held/Canceled")
|
||||||
(c "Canceled")
|
(c "Canceled")
|
||||||
(h "Held")
|
(h "Held")
|
||||||
(t "Unmasked"))))
|
(t "Unmasked"))))
|
||||||
(list (format "Action status: %s" local-status)
|
(list (format "Action status: %s" local-status)
|
||||||
(format "Mask status: %s" ancestry-status))))
|
(format "Mask status: %s" ancestry-status))))
|
||||||
|
|
||||||
(`(:endpoint . ,d)
|
(`(:endpoint . ,d)
|
||||||
(-let* (((&plist :ancestry a :local l) d)
|
(-let* (((&plist :ancestry a :local l) d)
|
||||||
(local-status (pcase l
|
(local-status (pcase l
|
||||||
(`(:active)
|
(`(:active)
|
||||||
"Active Endpoint Goal")
|
"Active Endpoint Goal")
|
||||||
(`(:complete ,comptime)
|
(`(:complete ,comptime)
|
||||||
(format-comptime "EPG" comptime))))
|
(format-comptime "EPG" comptime))))
|
||||||
(ancestry-status (if (plist-get a :canceled-parent-p)
|
(ancestry-status (if (plist-get a :canceled-parent-p)
|
||||||
"Canceled"
|
"Canceled"
|
||||||
"Unmasked")))
|
"Unmasked")))
|
||||||
(list (format "Goal status: %s" local-status)
|
(list (format "Goal status: %s" local-status)
|
||||||
(format "Mask status: %s" ancestry-status))))
|
(format "Mask status: %s" ancestry-status))))
|
||||||
;; TODO I currently don't allow either of these to be anything other than
|
;; TODO I currently don't allow either of these to be
|
||||||
;; "TODO"
|
;; anything other than "TODO"
|
||||||
(`(,(or :lifetime :survival) . ,d)
|
(`(,(or :lifetime :survival) . ,d)
|
||||||
(-let* (((&plist :ancestry a :local _) d)
|
(-let* (((&plist :ancestry a :local _) d)
|
||||||
(ancestry-status (plist-get a :canceled-parent-p)))
|
(ancestry-status (plist-get a :canceled-parent-p)))
|
||||||
(list "Active" (format "Mask Status: %s" ancestry-status))))
|
(list "Active" (format "Mask Status: %s" ancestry-status))))
|
||||||
|
|
||||||
(`(:quarterly :active ,dead)
|
(`(:quarterly :active ,dead)
|
||||||
(->> (if dead (->> (org-ml-to-trimmed-string dead)
|
(->> (if dead (->> (org-ml-to-trimmed-string dead)
|
||||||
(format "deadline: %s"))
|
(format "deadline: %s"))
|
||||||
"no deadline")
|
"no deadline")
|
||||||
(format "Active with %s")
|
(format "Active with %s")
|
||||||
(list)))
|
(list)))
|
||||||
(`(:quarterly :complete ,comptime)
|
(`(:quarterly :complete ,comptime)
|
||||||
(list (format-comptime "quarterly plan" comptime)))
|
(list (format-comptime "quarterly plan" comptime)))
|
||||||
(`(:weekly :active)
|
(`(:weekly :active)
|
||||||
"Active")
|
"Active")
|
||||||
(`(:weekly :complete ,comptime)
|
(`(:weekly :complete ,comptime)
|
||||||
(list (format-comptime "weekly plan" comptime)))
|
(list (format-comptime "weekly plan" comptime)))
|
||||||
(`(:daily :active (:sched ,sched))
|
(`(:daily :active (:sched ,sched))
|
||||||
(-let (((y m d H M) (org-ml-timestamp-get-start-time sched)))
|
(-let (((y m d H M) (org-ml-timestamp-get-start-time sched)))
|
||||||
(list (format "Open and scheduled on %d-%d-%d at %02d:%02d" y m d H M))))
|
(list (format-event "Scheduled" "metablock" y m d H M))))
|
||||||
(`(:daily :complete ,comptime)
|
(`(:daily :complete ,comptime)
|
||||||
(list (format-comptime "daily metablock" comptime))))))
|
(list (format-comptime "daily metablock" comptime))))))
|
||||||
|
(org-ml-build-paragraph (s-join "\n" ls)))))
|
||||||
|
|
||||||
(defun org-x-dag--format-title-with-group (id)
|
(defun org-x-dag--format-title-with-group (id)
|
||||||
(let ((title (org-x-dag-id->title id))
|
(let ((title (org-x-dag-id->title id))
|
||||||
|
|
@ -4277,132 +4284,98 @@ FUTURE-LIMIT in a list."
|
||||||
(org-x-dag-group-code))))
|
(org-x-dag-group-code))))
|
||||||
(format "%s - %s" group title)))
|
(format "%s - %s" group title)))
|
||||||
|
|
||||||
(defun org-x-dag--format-ns (id ns-data)
|
(defun org-x-dag--build-ns-list (id ns-data)
|
||||||
(cl-flet
|
(cl-flet*
|
||||||
((format-group
|
((build-item
|
||||||
(header key fun)
|
(header &rest children)
|
||||||
(-some->> (plist-get ns-data key)
|
(apply #'org-ml-build-item! :post-blank 1 :paragraph header children))
|
||||||
(--map (funcall fun it))
|
(format-group
|
||||||
(org-x-dag--indent-lines 2)
|
(header key)
|
||||||
(cons (format "%s:" header))))
|
(-if-let (subitems (-some->> (plist-get ns-data key)
|
||||||
(append-groups
|
(-map #'org-x-dag-id->link-item)))
|
||||||
(&rest groups)
|
(->> (apply #'org-ml-build-plain-list subitems)
|
||||||
(or (->> (-non-nil groups)
|
(build-item (format "%s:" header)))
|
||||||
(-interpose '(""))
|
(build-item (format "%s: none" header)))))
|
||||||
(-flatten-n 1))
|
(let* ((group (org-x-dag-id->group id))
|
||||||
'("none"))))
|
(args (pcase group
|
||||||
(let ((group (org-x-dag-id->group id)))
|
(:action
|
||||||
(pcase group
|
'(("Planned" :planned)
|
||||||
(:action
|
("Committed Goals" :committed)))
|
||||||
(append-groups
|
(:lifetime
|
||||||
(format-group "Planned"
|
'(("Planned" :planned)
|
||||||
:planned
|
("Fulfilled" :committed)))
|
||||||
#'org-x-dag-id->title)
|
(:endpoint
|
||||||
(format-group "Committed Goals"
|
'(("Planned" :planned)
|
||||||
:committed
|
("Committed" :committed)
|
||||||
#'org-x-dag--format-title-with-group)))
|
("Fulfilled" :fulfilled)))
|
||||||
(:lifetime
|
(:survival
|
||||||
(append-groups
|
;; TODO not sure if this works
|
||||||
(format-group "Planned"
|
'(("Planned" :planned)
|
||||||
:planned
|
("Fulfilled" :fulfilled)))
|
||||||
#'org-x-dag-id->title)
|
(:quarterly
|
||||||
(format-group "Fulfilled"
|
'(("Scheduled actions" :scheduled-actions)
|
||||||
:committed
|
("Planned" :planned)
|
||||||
#'org-x-dag--format-title-with-group)))
|
("Committed Goals" :committed)))
|
||||||
(:endpoint
|
(:weekly
|
||||||
(append-groups
|
'(("Planned" :planned)
|
||||||
(format-group "Planned"
|
("Committed" :committed)))
|
||||||
:planned
|
(:daily
|
||||||
#'org-x-dag-id->title)
|
'(("Planned" :planned)
|
||||||
(format-group "Committed"
|
("Committed" :committed))))))
|
||||||
:committed
|
(->> (--map (apply #'format-group it) args)
|
||||||
(lambda (id)
|
(apply #'org-ml-build-plain-list)))))
|
||||||
(org-x-dag-id->path nil id)))
|
|
||||||
(format-group "Fulfilled"
|
(defun org-x-dag-pop-buffer (name to-insert)
|
||||||
:fulfilled
|
(pop-to-buffer (format "*%s*" name))
|
||||||
(lambda (id)
|
(read-only-mode 0)
|
||||||
(org-x-dag-id->path t id)))))
|
(org-mode)
|
||||||
(:survival
|
(erase-buffer)
|
||||||
(append-groups
|
(insert to-insert)
|
||||||
;; TODO not sure if this works
|
(read-only-mode 1))
|
||||||
(format-group "Planned"
|
|
||||||
:planned
|
|
||||||
(lambda (id)
|
|
||||||
(org-x-dag-id->path t id)))
|
|
||||||
(format-group "Fulfilled"
|
|
||||||
:fulfilled
|
|
||||||
(lambda (id)
|
|
||||||
(org-x-dag-id->path t id)))))
|
|
||||||
(:quarterly
|
|
||||||
(append-groups
|
|
||||||
(format-group "Scheduled actions"
|
|
||||||
:scheduled-actions
|
|
||||||
(lambda (id)
|
|
||||||
(org-x-dag-id->path t id)))
|
|
||||||
(format-group "Planned"
|
|
||||||
:planned
|
|
||||||
#'org-x-dag-id->title)
|
|
||||||
(format-group "Committed Goals"
|
|
||||||
:committed
|
|
||||||
#'org-x-dag--format-title-with-group)))
|
|
||||||
(:weekly
|
|
||||||
(append-groups
|
|
||||||
(format-group "Planned"
|
|
||||||
:planned
|
|
||||||
(lambda (id)
|
|
||||||
(org-x-dag-id->path t id)))
|
|
||||||
(format-group "Committed"
|
|
||||||
:committed
|
|
||||||
#'org-x-dag-id->title)))
|
|
||||||
(:daily
|
|
||||||
(append-groups
|
|
||||||
(format-group "Planned"
|
|
||||||
:planned
|
|
||||||
(lambda (id)
|
|
||||||
(org-x-dag-id->path t id)))
|
|
||||||
(format-group "Committed"
|
|
||||||
:committed
|
|
||||||
#'org-x-dag-id->title)))))))
|
|
||||||
|
|
||||||
(defun org-x-dag-show-status ()
|
(defun org-x-dag-show-status ()
|
||||||
(interactive)
|
(interactive)
|
||||||
(cl-flet*
|
(cl-flet*
|
||||||
((format-maybe
|
((paragraph-maybe
|
||||||
(x alt)
|
(x alt)
|
||||||
(if (not x) (list "none") (funcall alt x)))
|
(if (not x) (list (org-ml-build-paragraph "none")) (funcall alt x)))
|
||||||
(format-header
|
(build-headline
|
||||||
(header lines)
|
(title section)
|
||||||
(->> (org-x-dag--indent-lines 2 lines)
|
(org-ml-build-headline! :title-text title
|
||||||
(s-join "\n")
|
:post-blank 0
|
||||||
(format "%s:\n%s" header)))
|
:section-children section))
|
||||||
(format-titles
|
(build-id-list
|
||||||
(ids)
|
(ids)
|
||||||
(-map #'org-x-dag--format-title-with-group ids))
|
(->> (-map #'org-x-dag-id->link-item ids)
|
||||||
(format-ids
|
(apply #'org-ml-build-plain-list)
|
||||||
|
(list)))
|
||||||
|
(build-id-headline
|
||||||
(what ids)
|
(what ids)
|
||||||
(->> (format-maybe ids #'format-titles)
|
(->> (paragraph-maybe ids #'build-id-list)
|
||||||
(format-header what)))
|
(build-headline what)))
|
||||||
(format-either
|
|
||||||
(e right)
|
|
||||||
(either-from e (lambda (e) (list (format "Error: %s" e))) right))
|
|
||||||
(format-bs
|
(format-bs
|
||||||
(bs)
|
(bs)
|
||||||
(->> (format-either bs (lambda (b) (org-x-dag--format-bs b)))
|
(->> (either-from* bs
|
||||||
(format-header "Buffer Status")))
|
(org-ml-build-paragraph (format "Error: %s" it))
|
||||||
|
(org-x-dag--build-bs-paragraph it))
|
||||||
|
(list)
|
||||||
|
(build-headline "Buffer Status")))
|
||||||
(format-ns-either
|
(format-ns-either
|
||||||
(id ns-either)
|
(id ns-either)
|
||||||
(either-from* ns-either
|
(either-from* ns-either
|
||||||
(->> it
|
(->> it
|
||||||
(--mapcat
|
(--mapcat
|
||||||
(-let (((&plist :msg :ids) it))
|
(-let (((&plist :msg :ids) it)
|
||||||
(->> (-map #'org-x-dag--format-title-with-group ids)
|
(para (org-ml-build-paragraph (format "Error: %s" msg))))
|
||||||
(org-x-dag--indent-lines 2)
|
(->> (-map #'org-x-dag-id->link-item ids)
|
||||||
(cons (format "Error: %s" msg))))))
|
(apply #'org-ml-build-plain-list)
|
||||||
(org-x-dag--format-ns id it)))
|
(org-ml-build-item para))))
|
||||||
|
(apply #'org-ml-build-plain-list))
|
||||||
|
(org-x-dag--build-ns-list id it)))
|
||||||
(format-ns
|
(format-ns
|
||||||
(id ns)
|
(id ns)
|
||||||
(->> (format-maybe ns (lambda (x) (format-ns-either id x)))
|
(->> (paragraph-maybe ns (lambda (x) (list (format-ns-either id x))))
|
||||||
(format-header "Network Status"))))
|
(build-headline "Network Status"))))
|
||||||
(org-x-dag-sync)
|
(org-x-dag-sync)
|
||||||
(-if-let (hl (org-ml-parse-this-headline))
|
(-if-let (hl (org-ml-parse-this-headline))
|
||||||
(let* ((id (org-x-dag-headline-get-id hl))
|
(let* ((id (org-x-dag-headline-get-id hl))
|
||||||
|
|
@ -4411,17 +4384,15 @@ FUTURE-LIMIT in a list."
|
||||||
(format-bs))))
|
(format-bs))))
|
||||||
(if (not bs) (message "Headline is not node")
|
(if (not bs) (message "Headline is not node")
|
||||||
(let ((lps (->> (org-x-dag-id->linked-parents id)
|
(let ((lps (->> (org-x-dag-id->linked-parents id)
|
||||||
(format-ids "Parent Links")))
|
(build-id-headline "Parent Links")))
|
||||||
(lcs (->> (org-x-dag-id->linked-children id)
|
(lcs (->> (org-x-dag-id->linked-children id)
|
||||||
(format-ids "Child Links")))
|
(build-id-headline "Child Links")))
|
||||||
(ns (->> (org-x-dag-id->ns id)
|
(ns (->> (org-x-dag-id->ns id)
|
||||||
(format-ns id))))
|
(format-ns id))))
|
||||||
;; TODO there is probably a better way to do this
|
(->> (list lps lcs bs ns)
|
||||||
(pop-to-buffer "*Org-DAG Node Status*")
|
(-map #'org-ml-to-string)
|
||||||
(read-only-mode 0)
|
(s-join "\n")
|
||||||
(erase-buffer)
|
(org-x-dag-pop-buffer "Org-DAG Node Status")))))
|
||||||
(insert (s-join "\n\n" (list lps lcs bs ns)))
|
|
||||||
(read-only-mode 1))))
|
|
||||||
(message "Not on headline"))))
|
(message "Not on headline"))))
|
||||||
|
|
||||||
(defun org-x-dag-agenda-show-status ()
|
(defun org-x-dag-agenda-show-status ()
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue