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

REF use org-agenda-files to determine files to scan

This commit is contained in:
Nathan Dwarshuis 2022-04-13 18:50:24 -04:00
parent 6ee63ca4e9
commit 8d01ebc94c
1 changed files with 49 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -2288,16 +2288,16 @@ FUTURE-LIMIT in a list."
;; auxiliary macros ;; auxiliary macros
(defmacro org-x-dag-with-ids (ids id-form) (defmacro org-x-dag-with-ids (files id-form)
(declare (indent 1)) (declare (indent 1))
`(with-temp-buffer `(with-temp-buffer
;; TODO this is silly and it adds 0.1 seconds to this function's runtime; ;; TODO this is silly and it adds 0.1 seconds to this function's runtime;
;; it is only needed to get the todo keyword the right color ;; it is only needed to get the todo keyword the right color
(org-mode) (org-mode)
(--mapcat ,id-form ,ids))) (--mapcat ,id-form (org-x-dag-files->ids ,files))))
(defmacro org-x-dag-with-action-ids (id-form) (defmacro org-x-dag-with-action-ids (id-form)
(declare (indent 0)) (declare (indent 1))
`(org-x-dag-with-ids (org-x-dag->action-ids) `(org-x-dag-with-ids (org-x-dag->action-ids)
,id-form)) ,id-form))
@ -2323,8 +2323,8 @@ FUTURE-LIMIT in a list."
;; tasks/projects ;; tasks/projects
;; TODO this includes tasks underneath cancelled headlines ;; TODO this includes tasks underneath cancelled headlines
(defun org-x-dag-itemize-tasks () (defun org-x-dag-itemize-tasks (files)
(org-x-dag-with-action-ids (org-x-dag-with-ids files
(pcase (either-from-right (org-x-dag-id->bs it) nil) (pcase (either-from-right (org-x-dag-id->bs it) nil)
(`(:sp-task :task-active ,s) (`(:sp-task :task-active ,s)
(-let (((&plist :sched :dead) s)) (-let (((&plist :sched :dead) s))
@ -2339,8 +2339,8 @@ FUTURE-LIMIT in a list."
'x-status :active) 'x-status :active)
(list)))))))))) (list))))))))))
(defun org-x-dag-itemize-projects () (defun org-x-dag-itemize-projects (files)
(org-x-dag-with-action-ids (org-x-dag-with-ids files
(pcase (either-from-right (org-x-dag-id->bs it) nil) (pcase (either-from-right (org-x-dag-id->bs it) nil)
(`(:sp-proj . ,status-data) (`(:sp-proj . ,status-data)
;; NOTE in the future there might be more than just the car to this ;; NOTE in the future there might be more than just the car to this
@ -2360,8 +2360,8 @@ FUTURE-LIMIT in a list."
'x-priority priority) 'x-priority priority)
(list)))))))))) (list))))))))))
(defun org-x-dag-itemize-iterators () (defun org-x-dag-itemize-iterators (files)
(org-x-dag-with-action-ids (org-x-dag-with-ids files
(pcase (either-from-right (org-x-dag-id->bs it) nil) (pcase (either-from-right (org-x-dag-id->bs it) nil)
(`(:sp-proj . ,status-data) (`(:sp-proj . ,status-data)
(let ((status (car status-data))) (let ((status (car status-data)))
@ -2372,8 +2372,8 @@ FUTURE-LIMIT in a list."
'x-status status) 'x-status status)
(list))))))))) (list)))))))))
(defun org-x-dag-itemize-incubated () (defun org-x-dag-itemize-incubated (files)
(org-x-dag-with-action-ids (org-x-dag-with-ids files
(-when-let (type (pcase (either-from-right (org-x-dag-id->bs it) nil) (-when-let (type (pcase (either-from-right (org-x-dag-id->bs it) nil)
(`(:sp-proj :proj-complete ,_) nil) (`(:sp-proj :proj-complete ,_) nil)
(`(:sp-task :task-complete ,_) nil) (`(:sp-task :task-complete ,_) nil)
@ -2406,8 +2406,8 @@ FUTURE-LIMIT in a list."
(--map (org-add-props (copy-seq item) nil 'x-goal-id it) ids) (--map (org-add-props (copy-seq item) nil 'x-goal-id it) ids)
(list (org-add-props item nil 'x-goal-id nil)))) (list (org-add-props item nil 'x-goal-id nil))))
(defun org-x-dag-itemize-tasks-with-goals () (defun org-x-dag-itemize-tasks-with-goals (files)
(org-x-dag-with-action-ids (org-x-dag-with-ids files
(pcase (either-from-right (org-x-dag-id->bs it) nil) (pcase (either-from-right (org-x-dag-id->bs it) nil)
(`(:sp-task :task-active ,_) (`(:sp-task :task-active ,_)
(-let ((goal-ids (-when-let (ns (org-x-dag-id->ns it)) (-let ((goal-ids (-when-let (ns (org-x-dag-id->ns it))
@ -2423,8 +2423,8 @@ FUTURE-LIMIT in a list."
'x-status :active) 'x-status :active)
(org-x-dag--item-add-goal-ids goal-ids))))))) (org-x-dag--item-add-goal-ids goal-ids)))))))
(defun org-x-dag-itemize-projects-with-goals () (defun org-x-dag-itemize-projects-with-goals (files)
(org-x-dag-with-action-ids (org-x-dag-with-ids files
(pcase (either-from-right (org-x-dag-id->bs it) nil) (pcase (either-from-right (org-x-dag-id->bs it) nil)
(`(:sp-proj . ,s) (`(:sp-proj . ,s)
(unless (eq (car s) :proj-complete) (unless (eq (car s) :proj-complete)
@ -2437,8 +2437,8 @@ FUTURE-LIMIT in a list."
(-> (org-x-dag-format-tag-node tags it) (-> (org-x-dag-format-tag-node tags it)
(org-x-dag--item-add-goal-ids goal-ids)))))))) (org-x-dag--item-add-goal-ids goal-ids))))))))
(defun org-x-dag-itemize-archived () (defun org-x-dag-itemize-archived (files)
(org-x-dag-with-action-ids (org-x-dag-with-ids files
(-let (((comptime type) (-let (((comptime type)
(pcase (either-from-right (org-x-dag-id->bs it) nil) (pcase (either-from-right (org-x-dag-id->bs it) nil)
(`(:sp-proj :proj-complete ,c) `(,c :proj)) (`(:sp-proj :proj-complete ,c) `(,c :proj))
@ -2459,7 +2459,7 @@ FUTURE-LIMIT in a list."
'x-type type) 'x-type type)
(list))))))))) (list)))))))))
(defun org-x-dag-itemize-errors () (defun org-x-dag-itemize-errors (files)
(cl-flet (cl-flet
((format-id ((format-id
(id msg) (id msg)
@ -2468,8 +2468,7 @@ FUTURE-LIMIT in a list."
'x-error msg)))) 'x-error msg))))
(with-temp-buffer (with-temp-buffer
(org-mode) (org-mode)
(->> (org-x-dag->action-files) (->> (org-x-dag-files->ids files)
(org-x-dag-files->ids)
(--map (pcase (org-x-dag-id->bs it) (--map (pcase (org-x-dag-id->bs it)
(`(:error ,msg) (format-id it msg)))) (`(:error ,msg) (format-id it msg))))
(-non-nil))))) (-non-nil)))))
@ -3454,15 +3453,17 @@ FUTURE-LIMIT in a list."
;; agenda builders ;; agenda builders
(defun org-x-dag-show-nodes (get-nodes) (defun org-x-dag-show-nodes (get-nodes)
(org-x-dag-sync)
(let* ((org-tags-match-list-sublevels org-tags-match-list-sublevels) (let* ((org-tags-match-list-sublevels org-tags-match-list-sublevels)
(completion-ignore-case t)) (completion-ignore-case t))
(catch 'exit (catch 'exit
;; this should be run before `org-x-dag-sync' as it refreshes properties
;; like effort and statistics
(org-agenda-prepare (concat "DAG-TAG")) (org-agenda-prepare (concat "DAG-TAG"))
(org-compile-prefix-format 'tags) (org-compile-prefix-format 'tags)
(org-set-sorting-strategy 'tags) (org-set-sorting-strategy 'tags)
(org-x-dag-sync)
(let ((org-agenda-redo-command `(org-x-dag-show-nodes ',get-nodes)) (let ((org-agenda-redo-command `(org-x-dag-show-nodes ',get-nodes))
(rtnall (funcall get-nodes))) (rtnall (funcall get-nodes org-agenda-files)))
(org-agenda--insert-overriding-header (org-agenda--insert-overriding-header
(with-temp-buffer (with-temp-buffer
(insert "Headlines with TAGS match: \n") (insert "Headlines with TAGS match: \n")
@ -3485,7 +3486,6 @@ FUTURE-LIMIT in a list."
;; make the signature exactly like `org-agenda-list' ...for now ;; make the signature exactly like `org-agenda-list' ...for now
(defun org-x-dag-show-daily-nodes (&optional _ start-day _ _) (defun org-x-dag-show-daily-nodes (&optional _ start-day _ _)
(org-x-dag-sync)
(-let ((completion-ignore-case t) (-let ((completion-ignore-case t)
;; TODO not sure if this if thing is actually necessary ;; TODO not sure if this if thing is actually necessary
((arg start-day span with-hour) (or org-agenda-overriding-arguments ((arg start-day span with-hour) (or org-agenda-overriding-arguments
@ -3494,6 +3494,7 @@ FUTURE-LIMIT in a list."
(org-agenda-prepare "DAG-DAILY") (org-agenda-prepare "DAG-DAILY")
(org-compile-prefix-format 'agenda) (org-compile-prefix-format 'agenda)
(org-set-sorting-strategy 'agenda) (org-set-sorting-strategy 'agenda)
(org-x-dag-sync)
(-let* ((today (org-today)) (-let* ((today (org-today))
(sd (or start-day today)) (sd (or start-day today))
(org-agenda-redo-command (org-agenda-redo-command
@ -3638,21 +3639,22 @@ review phase)"
(defun org-x-dag-agenda-incubator () (defun org-x-dag-agenda-incubator ()
"Show the incubator agenda view." "Show the incubator agenda view."
(interactive) (interactive)
(org-x-dag-agenda-show-nodes "Incubator" #'org-x-dag-itemize-incubated nil (let ((files (org-x-dag->action-files)))
`((org-agenda-sorting-strategy '(category-keep)) (org-x-dag-agenda-show-nodes "Incubator" #'org-x-dag-itemize-incubated files
(org-super-agenda-groups `((org-agenda-sorting-strategy '(category-keep))
'((:auto-map (org-super-agenda-groups
(lambda (line) '((:auto-map
(let ((p (get-text-property 1 'x-project-p line)) (lambda (line)
(s (get-text-property 1 'x-scheduled line)) (let ((p (get-text-property 1 'x-project-p line))
(d (get-text-property 1 'x-deadlined line))) (s (get-text-property 1 'x-scheduled line))
(cond (d (get-text-property 1 'x-deadlined line)))
((and s (not p)) (cond
(if (< (float-time) s) "Future Scheduled" "Past Scheduled")) ((and s (not p))
((and d (not p)) (if (< (float-time) s) "Future Scheduled" "Past Scheduled"))
(if (< (float-time) d) "Future Deadline" "Past Deadline")) ((and d (not p))
(p "Toplevel Projects") (if (< (float-time) d) "Future Deadline" "Past Deadline"))
(t "Standalone Tasks")))))))))) (p "Toplevel Projects")
(t "Standalone Tasks")))))))))))
(defun org-x-dag-agenda-iterators () (defun org-x-dag-agenda-iterators ()
"Show the iterator agenda view." "Show the iterator agenda view."
@ -3673,11 +3675,12 @@ review phase)"
(defun org-x-dag-agenda-errors () (defun org-x-dag-agenda-errors ()
"Show the critical errors agenda view." "Show the critical errors agenda view."
(interactive) (interactive)
(org-x-dag-agenda-show-nodes "Errors" #'org-x-dag-itemize-errors nil (let ((files (org-x-dag->action-files)))
`((org-super-agenda-groups (org-x-dag-agenda-show-nodes "Errors" #'org-x-dag-itemize-errors files
'((:auto-map `((org-super-agenda-groups
(lambda (line) '((:auto-map
(get-text-property 1 'x-error line)))))))) (lambda (line)
(get-text-property 1 'x-error line)))))))))
(defun org-x-dag-agenda-archive () (defun org-x-dag-agenda-archive ()
"Show the archive agenda view." "Show the archive agenda view."
@ -3828,8 +3831,9 @@ review phase)"
(defun org-x-dag-agenda-incubated () (defun org-x-dag-agenda-incubated ()
(interactive) (interactive)
(let ((match #'org-x-dag-itemize-incubated)) (let ((match #'org-x-dag-itemize-incubated)
(org-x-dag-agenda-show-nodes "Incubated-0" match nil (files (org-x-dag->action-files)))
(org-x-dag-agenda-show-nodes "Incubated-0" match files
`((org-agenda-sorting-strategy '(user-defined-up category-keep)) `((org-agenda-sorting-strategy '(user-defined-up category-keep))
(org-super-agenda-groups (org-super-agenda-groups
'((:auto-map '((:auto-map