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

ENH update task scanner with new ns/bs stuff

This commit is contained in:
Nathan Dwarshuis 2022-03-30 19:47:15 -04:00
parent c6786fb293
commit c350eff7df
1 changed files with 75 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -301,14 +301,36 @@ that file as it currently sits on disk.")
;; id properties ;; id properties
(defun org-x-dag-id->metaprop (id prop) (defun org-x-dag-id->node-meta (id)
(-> (org-x-dag->metatable) (-> (org-x-dag->adjacency-list)
(ht-get id) (ht-get id)
(plist-get :node-meta)))
(defun org-x-dag-id->hl-meta (id)
(-> (org-x-dag-id->node-meta id)
(plist-get :hl-meta)))
(defun org-x-dag-id->bs (id)
(-> (org-x-dag-id->node-meta id)
(plist-get :buffer-status)))
(defun org-x-dag-id->buffer-parent (id)
(-> (org-x-dag-id->node-meta id)
(plist-get :buffer-parent)))
(defun org-x-dag-id->ns (id)
(let ((nst (plist-get org-x-dag :netstat)))
(-> (org-x-dag-id->hl-meta-prop id :group)
(alist-get nst)
(ht-get id))))
(defun org-x-dag-id->hl-meta-prop (id prop)
(-> (org-x-dag-id->hl-meta id)
(plist-get prop))) (plist-get prop)))
(defun org-x-dag-id->file (id) (defun org-x-dag-id->file (id)
"Return file for ID." "Return file for ID."
(org-x-dag-id->metaprop id :file)) (org-x-dag-id->hl-meta-prop id :file))
(defun org-x-dag-id->file-group (id) (defun org-x-dag-id->file-group (id)
"Return file group for ID. "Return file group for ID.
@ -323,23 +345,23 @@ Return one of seven values: :lifetime, :survival, :endpoint,
(defun org-x-dag-id->point (id) (defun org-x-dag-id->point (id)
"Return point for ID." "Return point for ID."
(org-x-dag-id->metaprop id :point)) (org-x-dag-id->hl-meta-prop id :point))
(defun org-x-dag-id->level (id) (defun org-x-dag-id->level (id)
"Return level for ID." "Return level for ID."
(org-x-dag-id->metaprop id :level)) (org-x-dag-id->hl-meta-prop id :level))
(defun org-x-dag-id->todo (id) (defun org-x-dag-id->todo (id)
"Return todo keyword for ID." "Return todo keyword for ID."
(org-x-dag-id->metaprop id :todo)) (org-x-dag-id->hl-meta-prop id :todo))
(defun org-x-dag-id->title (id) (defun org-x-dag-id->title (id)
"Return title for ID." "Return title for ID."
(org-x-dag-id->metaprop id :title)) (org-x-dag-id->hl-meta-prop id :title))
(defun org-x-dag-id->local-tags (id) (defun org-x-dag-id->local-tags (id)
"Return local tags for ID." "Return local tags for ID."
(org-x-dag-id->metaprop id :tags)) (org-x-dag-id->hl-meta-prop id :tags))
(defun org-x-dag-id->tags (parent-tags id) (defun org-x-dag-id->tags (parent-tags id)
"Return all tags for ID. "Return all tags for ID.
@ -353,7 +375,7 @@ highest in the tree."
(cl-labels (cl-labels
((ascend ((ascend
(id tags) (id tags)
(-if-let (parent (org-x-dag-id->metaprop id :buffer-parent)) (-if-let (parent (org-x-dag-id->hl-meta-prop id :buffer-parent))
;; tags in the front of the list have precedence over latter tags, ;; tags in the front of the list have precedence over latter tags,
;; so putting parent tags at the end means child tags have ;; so putting parent tags at the end means child tags have
;; precedence ;; precedence
@ -396,7 +418,7 @@ highest in the tree."
(defun org-x-dag-id->buffer-parent (id) (defun org-x-dag-id->buffer-parent (id)
"Return the buffer parent id (if any) of ID." "Return the buffer parent id (if any) of ID."
(org-x-dag-id->metaprop id :buffer-parent)) (org-x-dag-id->hl-meta-prop id :buffer-parent))
(defun org-x-dag-id->split-parents-2 (id) (defun org-x-dag-id->split-parents-2 (id)
"Return the buffer and non-buffer parents of ID. "Return the buffer and non-buffer parents of ID.
@ -605,12 +627,11 @@ be uncommitted if it is also incubated."
;; files to ids ;; files to ids
(defun org-x-dag-files->ids (files)
(let ((filemap (plist-get org-x-dag :file->ids)))
(--mapcat (ht-get filemap it) files)))
(defun org-x-dag-file->ids (file) (defun org-x-dag-file->ids (file)
(org-x-dag-files->ids `(,file))) (ht-get (plist-get org-x-dag :file->ids) file))
(defun org-x-dag-files->ids (files)
(-mapcat #'org-x-dag-file->ids files))
(defun org-x-dag->epg-ids () (defun org-x-dag->epg-ids ()
(org-x-dag-file->ids (org-x-get-endpoint-goal-file))) (org-x-dag-file->ids (org-x-get-endpoint-goal-file)))
@ -2445,12 +2466,12 @@ removed from, added to, or edited within the DAG respectively."
TO-REMOVE, TO-INSERT, and TO-UPDATE are lists of files to remove TO-REMOVE, TO-INSERT, and TO-UPDATE are lists of files to remove
from, add to, and update with the DAG. FILE-STATE is a nested from, add to, and update with the DAG. FILE-STATE is a nested
plist holding the files to be used in the DAG." plist holding the files to be used in the DAG."
(-let* (((&plist :file->links) org-x-dag) (-let* (((&plist :file->ids :file->links) org-x-dag)
(files2rem (append to-update to-remove)) (files2rem (append to-update to-remove))
(files2ins (append to-update to-insert)) (files2ins (append to-update to-insert))
(ids2rem (org-x-dag-files->ids files2rem)) (ids2rem (org-x-dag-files->ids files2rem))
((ids2ins fms2ins links2ins) (org-x-dag-read-files files2ins))) ((ids2ins fms2ins links2ins) (org-x-dag-read-files files2ins)))
;; (org-x-dag-update-ht files2rem fms2ins file->ids) (org-x-dag-update-ht files2rem fms2ins file->ids)
(org-x-dag-update-ht files2rem links2ins file->links) (org-x-dag-update-ht files2rem links2ins file->links)
(org-x-dag-update-dag ids2ins ids2rem) (org-x-dag-update-dag ids2ins ids2rem)
(plist-put org-x-dag :files file-state) (plist-put org-x-dag :files file-state)
@ -2526,7 +2547,7 @@ encountered will be returned."
'mouse-face 'highlight)) 'mouse-face 'highlight))
(defun org-x-dag-id->formatted-level (id) (defun org-x-dag-id->formatted-level (id)
(-> (org-x-dag-id->metaprop id :level) (-> (org-x-dag-id->hl-meta-prop id :level)
(org-reduced-level) (org-reduced-level)
(make-string ?\s))) (make-string ?\s)))
@ -2695,9 +2716,9 @@ except it ignores inactive timestamps."
(b (or (get-file-buffer f) (find-file-noselect f)))) (b (or (get-file-buffer f) (find-file-noselect f))))
(set-marker (make-marker) p b))) (set-marker (make-marker) p b)))
(defun org-x-dag-format-tag-node (category tags id) (defun org-x-dag-format-tag-node (tags id)
;; ASSUME I don't use subtree-level categories
(-let* ((tags* (org-x-dag-prepare-tags tags)) (-let* ((tags* (org-x-dag-prepare-tags tags))
(category (org-x-dag-id->hl-meta-prop id :category))
(todo-state (org-x-dag-id->todo id)) (todo-state (org-x-dag-id->todo id))
;; TODO the only reason this format thing is here is to satisfy ;; TODO the only reason this format thing is here is to satisfy
;; `org-agenda-format-item' (which I should probably just rewrite) ;; `org-agenda-format-item' (which I should probably just rewrite)
@ -2705,6 +2726,8 @@ except it ignores inactive timestamps."
(level (org-x-dag-id->formatted-level id)) (level (org-x-dag-id->formatted-level id))
(marker (org-agenda-new-marker (org-x-dag-id->marker id))) (marker (org-agenda-new-marker (org-x-dag-id->marker id)))
((ts . ts-type) (org-x-dag-id->agenda-timestamp id)) ((ts . ts-type) (org-x-dag-id->agenda-timestamp id))
;; NOTE this depends on the buffer position only when using
;; breadcrumbs (which I never do)
(item (org-agenda-format-item "" head level category tags*)) (item (org-agenda-format-item "" head level category tags*))
(priority (org-get-priority item))) (priority (org-get-priority item)))
(-> (org-x-dag-add-default-props item id) (-> (org-x-dag-add-default-props item id)
@ -2868,7 +2891,7 @@ except it ignores inactive timestamps."
(org-x-headline-has-timestamp org-closed-time-regexp want-time)) (org-x-headline-has-timestamp org-closed-time-regexp want-time))
(defun org-x-dag-id->planning-timestamp (which id) (defun org-x-dag-id->planning-timestamp (which id)
(-some->> (org-x-dag-id->metaprop id :planning) (-some->> (org-x-dag-id->hl-meta-prop id :planning)
(org-ml-get-property which))) (org-ml-get-property which)))
(defun org-x-dag-id->planning-datetime (which id) (defun org-x-dag-id->planning-datetime (which id)
@ -2880,7 +2903,7 @@ except it ignores inactive timestamps."
(org-ml-time-to-unixtime))) (org-ml-time-to-unixtime)))
(defun org-x-dag-id->node-property (prop id) (defun org-x-dag-id->node-property (prop id)
(alist-get prop (org-x-dag-id->metaprop id :props) nil nil #'equal)) (alist-get prop (org-x-dag-id->hl-meta-prop id :props) nil nil #'equal))
(defun org-x-dag-id->node-property-equal-p (prop value id) (defun org-x-dag-id->node-property-equal-p (prop value id)
(equal (org-x-dag-id->node-property prop id) value)) (equal (org-x-dag-id->node-property prop id) value))
@ -3195,27 +3218,36 @@ except it ignores inactive timestamps."
(defun org-x-dag-scan-tasks () (defun org-x-dag-scan-tasks ()
(cl-flet (cl-flet
((format-key ((format-key
(category is-standalone key) (id s)
(let ((tags (org-x-dag-id->tags nil key))) (-let (((_ sched dead) s))
(unless (or (member org-x-tag-incubated tags) (pcase (org-x-dag-id->ns id)
;; (not (eq (cadr (org-x-dag-id->goal-status 'current key)) :planned)) (`(:valid ,ns)
(org-x-dag-id->planning-timestamp :scheduled key) (-let (((&plist :committed c) ns))
(org-x-dag-id->planning-timestamp :deadline key)) (when (and (not sched) (not dead) c)
(let* ((s (org-x-dag-id->task-status key)) (let ((tags (org-x-dag-id->tags nil id))
(p (alist-get s org-x-headline-task-status-priorities))) (bp (org-x-dag-id->buffer-parent id)))
(unless (= p -1) (-> (org-x-dag-format-tag-node tags id)
(-> (org-x-dag-format-tag-node category tags key)
(org-add-props nil (org-add-props nil
'x-is-standalone is-standalone 'x-is-standalone (not bp)
'x-status s)))))))) 'x-status :task-active))))))))))
(org-x-dag-with-files (org-x-get-action-files) (->> (org-x-dag->action-files)
(org-x-dag-id->is-toplevel-p it) (org-x-dag-files->ids)
(-if-let (project-tasks (org-x-dag-get-task-nodes (--reduce-from (pcase (org-x-dag-id->bs it)
(lambda (it) (not (member (org-x-dag-id->todo it) (`(:valid (:sp-task :task-active ,s))
(list org-x-kw-canc org-x-kw-hold)))) (-if-let (new (format-key it s))
it)) (cons new acc)
(--map (format-key it-category nil it) project-tasks) acc))
(list (format-key it-category t it)))))) (_ acc))
nil))))
;; (org-x-dag-with-files (org-x-dag->action-files)
;; (org-x-dag-id->is-toplevel-p it)
;; (-if-let (project-tasks (org-x-dag-get-task-nodes
;; (lambda (it) (not (member (org-x-dag-id->todo it)
;; (list org-x-kw-canc org-x-kw-hold))))
;; it))
;; (--map (format-key it-category nil it) project-tasks)
;; (list (format-key it-category t it))))))
;; TODO wetter than Prince's dreams ;; TODO wetter than Prince's dreams
(defun org-x-dag-scan-tasks-with-goals () (defun org-x-dag-scan-tasks-with-goals ()