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

ENH don't use stateful functions in scanner to get node info

This commit is contained in:
Nathan Dwarshuis 2022-03-02 23:44:42 -05:00
parent 62b4dbbd8e
commit ac0f85cd64
1 changed files with 210 additions and 183 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1738,6 +1738,21 @@ FUTURE-LIMIT in a list."
(defun org-x-dag-headline-is-closed-p (want-time) (defun org-x-dag-headline-is-closed-p (want-time)
(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)
(->> (org-x-dag-id->metaprop id :planning)
(org-ml-get-property which)))
(defun org-x-dag-id->node-property (prop id)
(alist-get prop (org-x-dag-id->metaprop id :props) nil nil #'equal))
(defun org-x-dag-id->node-property-equal-p (prop value id)
(equal (org-x-dag-id->node-property prop id) value))
(defun org-x-dag-id->is-iterator-p (id)
(org-x-dag-id->node-property-equal-p org-x-prop-parent-type
org-x-prop-parent-type-iterator
id))
;; (defun org-x-dag-is-created-p (want-time) ;; (defun org-x-dag-is-created-p (want-time)
;; (save-excursion ;; (save-excursion
;; (-when-let (ts (org-x-dag-get-local-property org-x-prop-created)) ;; (-when-let (ts (org-x-dag-get-local-property org-x-prop-created))
@ -1771,7 +1786,13 @@ FUTURE-LIMIT in a list."
(:inert . 4))) (:inert . 4)))
(defun org-x-dag-time-is-archivable-p (epochtime) (defun org-x-dag-time-is-archivable-p (epochtime)
(< (- (float-time) epochtime) (* 60 60 24 org-x-archive-delay))) (< (* 60 60 24 org-x-archive-delay) (- (float-time) epochtime)))
(defun org-x-dag-id->is-archivable-p (id)
(-some->> (org-x-dag-id->planning-timestamp :closed id)
(org-ml-timestamp-get-start-time)
(org-ml-time-to-unixtime)
(org-x-dag-time-is-archivable-p)))
;;; STATUS DETERMINATION ;;; STATUS DETERMINATION
@ -1799,6 +1820,19 @@ FUTURE-LIMIT in a list."
((org-x-dag-headline-is-closed-p nil) :undone-closed) ((org-x-dag-headline-is-closed-p nil) :undone-closed)
(t :active)))) (t :active))))
(defun org-x-dag-id->task-status (id)
;; ASSUME this is actually a task
(let ((c (org-x-dag-id->planning-timestamp :closed id)))
(if (org-x-dag-id->is-done-p id)
(if c
(if (org-x-dag-time-is-archivable-p c) :archivable :complete)
:done-unclosed)
(cond
;; ((org-x-headline-is-expired-p) :expired)
;; ((org-x-headline-is-inert-p) :inert)
(c :undone-closed)
(t :active)))))
(defun org-x-dag-get-max-index (ys xs) (defun org-x-dag-get-max-index (ys xs)
"Return the member of XS that has the highest index in YS." "Return the member of XS that has the highest index in YS."
(--max-by (> (-elem-index it ys) (-elem-index other ys)) xs)) (--max-by (> (-elem-index it ys) (-elem-index other ys)) xs))
@ -1833,111 +1867,112 @@ FUTURE-LIMIT in a list."
(org-x-dag-get-max-index ',allowed-codes)))) (org-x-dag-get-max-index ',allowed-codes))))
(cons status (-mapcat #'cdr results)))))) (cons status (-mapcat #'cdr results))))))
(defun org-x-dag-headline-get-project-status (key tags children) (defun org-x-dag-headline-get-project-status (id tags children)
;; ASSUME children will always be at least 1 long ;; ASSUME children will always be at least 1 long
(org-x-dag-with-id key ;; (org-x-dag-with-id id
(let ((keyword (org-x-dag-id->todo key))) (let ((keyword (org-x-dag-id->todo id)))
(-let (((status . child-results) (-let (((status . child-results)
(cond
((org-x-dag-headline-is-scheduled-p nil)
(list :scheduled-project))
((equal keyword org-x-kw-hold)
(list (if (org-x-headline-is-inert-p) :inert :held)))
((member keyword org-x--project-invalid-todostates)
(list :invalid-todostate))
((equal keyword org-x-kw-canc)
(list (if (org-x-headline-is-archivable-p) :archivable :complete)))
((equal keyword org-x-kw-done)
(org-x-dag-descend-into-project children tags
((:archivable)
(:complete)
(:done-incomplete :stuck :inert :held :wait :active
:scheduled-project :invalid-todostate
:undone-complete))
(if (member it-kw org-x-done-keywords)
(if (org-x-headline-is-archivable-p) 0 1)
2)
#'org-x-dag-headline-get-project-status))
((equal keyword org-x-kw-todo)
(org-x-dag-descend-into-project children tags
((:undone-complete :complete :archivable)
(:stuck :scheduled-project :invalid-todostate
:done-incomplete)
(:held)
(:wait)
(:inert)
(:active))
(cond
((and (not (member it-kw org-x-done-keywords))
(org-x-headline-is-inert-p))
4)
((equal it-kw org-x-kw-todo)
(if (org-x-dag-headline-is-scheduled-p nil) 5 1))
((equal it-kw org-x-kw-hold)
2)
((equal it-kw org-x-kw-wait)
3)
((equal it-kw org-x-kw-next)
5)
(t 0))
#'org-x-dag-headline-get-project-status))
(t (error "Invalid keyword detected: %s" keyword)))))
(cons (list :key key :status status :tags tags) child-results)))))
(defun org-x-dag-headline-get-iterator-project-status (key children)
(org-x-dag-with-id key
(let* ((kw (org-x-dag-id->todo key))
(status
(cond (cond
((or (member kw org-x--project-invalid-todostates) ((org-x-dag-id->planning-timestamp :scheduled id)
(org-x-dag-headline-is-scheduled-p nil)) (list :scheduled-project))
(list :project-error)) ((equal keyword org-x-kw-hold)
((equal kw org-x-kw-canc) ;; (list (if (org-x-headline-is-inert-p) :inert :held)))
(list :empt)) (list :held))
;; TODO this is a bit awkward since I don't care about the child statuses ((member keyword org-x--project-invalid-todostates)
;; and I don't care about tags (list :invalid-todostate))
((equal kw org-x-kw-done) ((equal keyword org-x-kw-canc)
(org-x-dag-descend-into-project children nil (list (if (org-x-id->is-archivable-p id) :archivable :complete)))
((:empt) ((equal keyword org-x-kw-done)
(:project-error :unscheduled :actv)) (org-x-dag-descend-into-project children tags
(if (member it-kw org-x-done-keywords) 0 1) ((:archivable)
;; TODO this has an argument mismatch (:complete)
#'org-x-dag-headline-get-iterator-project-status)) (:done-incomplete :stuck :inert :held :wait :active
((equal kw org-x-kw-todo) :scheduled-project :invalid-todostate
(org-x-dag-descend-into-project children nil :undone-complete))
((:unscheduled :project-error) (if (member it-kw org-x-done-keywords)
(:empt) (if (org-x-dag-id->is-archivable-p id) 0 1)
(:actv)) 2)
;; TODO this triggers a compiler warning because I don't use #'org-x-dag-headline-get-project-status))
;; `it-kw' ((equal keyword org-x-kw-todo)
(let ((ts (org-x-dag-headline-is-scheduled-p t))) (org-x-dag-descend-into-project children tags
(cond ((:undone-complete :complete :archivable)
((not ts) 0) (:stuck :scheduled-project :invalid-todostate
((> org-x-iterator-active-future-offset (- ts (float-time))) 1) :done-incomplete)
(t 2))) (:held)
#'org-x-dag-headline-get-iterator-project-status)) (:wait)
(t (error "Invalid keyword detected: %s" kw))))) ;; (:inert)
status))) (:active))
(cond
;; ((and (not (member it-kw org-x-done-keywords))
;; (org-x-headline-is-inert-p))
;; 4)
((equal it-kw org-x-kw-todo)
(if (org-x-dag-id->planning-timestamp :scheduled id) 4 1))
((equal it-kw org-x-kw-hold)
2)
((equal it-kw org-x-kw-wait)
3)
((equal it-kw org-x-kw-next)
4)
(t 0))
#'org-x-dag-headline-get-project-status))
(t (error "Invalid keyword detected: %s" keyword)))))
(cons (list :key key :status status :tags tags) child-results))))
(defun org-x-dag-headline-get-iterator-task-status (key) (defun org-x-dag-headline-get-iterator-project-status (id children)
(org-x-dag-with-id key ;; (org-x-dag-with-id id
(if (org-x-dag-id->is-done-p key) :empt (let* ((kw (org-x-dag-id->todo id))
(-if-let (ts (or (org-x-dag-headline-is-scheduled-p t) (status
(org-x-dag-headline-is-deadlined-p t))) (cond
(if (< org-x-iterator-active-future-offset (- ts (float-time))) ((or (member kw org-x--project-invalid-todostates)
:actv (org-x-dag-id->planning-timestamp :scheduled id))
:empt) (list :project-error))
:unscheduled)))) ((equal kw org-x-kw-canc)
(list :empt))
;; TODO this is a bit awkward since I don't care about the child statuses
;; and I don't care about tags
((equal kw org-x-kw-done)
(org-x-dag-descend-into-project children nil
((:empt)
(:project-error :unscheduled :actv))
(if (member it-kw org-x-done-keywords) 0 1)
;; TODO this has an argument mismatch
#'org-x-dag-headline-get-iterator-project-status))
((equal kw org-x-kw-todo)
(org-x-dag-descend-into-project children nil
((:unscheduled :project-error)
(:empt)
(:actv))
;; TODO this triggers a compiler warning because I don't use
;; `it-kw'
(let ((ts (org-x-dag-id->planning-timestamp :scheduled id)))
(cond
((not ts) 0)
((> org-x-iterator-active-future-offset (- ts (float-time))) 1)
(t 2)))
#'org-x-dag-headline-get-iterator-project-status))
(t (error "Invalid keyword detected: %s" kw)))))
status))
(defun org-x-dag-headline-get-iterator-status (key) (defun org-x-dag-headline-get-iterator-task-status (id)
;; (org-x-dag-with-id key
(if (org-x-dag-id->is-done-p id) :empt
(-if-let (ts (or (org-x-dag-id->planning-timestamp :scheduled id)
(org-x-dag-id->planning-timestamp :deadline id)))
(if (< org-x-iterator-active-future-offset (- ts (float-time)))
:actv
:empt)
:unscheduled)))
(defun org-x-dag-headline-get-iterator-status (id)
(cl-flet (cl-flet
((get-status ((get-status
(key) (id)
(-if-let (children (org-x-dag-id->buffer-children key)) (-if-let (children (org-x-dag-id->buffer-children id))
(->> children (->> children
(org-x-dag-headline-get-iterator-project-status key) (org-x-dag-headline-get-iterator-project-status id)
(car)) (car))
(org-x-dag-headline-get-iterator-task-status key)))) (org-x-dag-headline-get-iterator-task-status id))))
(->> (org-x-dag-id->buffer-children key) (->> (org-x-dag-id->buffer-children key)
(-map #'get-status) (-map #'get-status)
(org-x-dag-get-max-index org-x--iter-statuscodes)))) (org-x-dag-get-max-index org-x--iter-statuscodes))))
@ -1984,11 +2019,11 @@ FUTURE-LIMIT in a list."
;; TODO don't hardcode these things ;; TODO don't hardcode these things
(org-x-dag-with-id key (org-x-dag-with-id key
(unless (or (not (eq (cadr (org-x-dag-id->goal-status 'current key)) :planned)) (unless (or (not (eq (cadr (org-x-dag-id->goal-status 'current key)) :planned))
(org-x-dag-headline-is-iterator-p)) (org-x-dag-id->is-iterator-p key))
(-some->> (org-x-dag-id->buffer-children key) (-some->> (org-x-dag-id->buffer-children key)
(org-x-dag-headline-get-project-status key tags) (org-x-dag-headline-get-project-status key tags)
(--map (format-result cat it)))))))) (--map (format-result cat it))))))))
(org-x-dag-with-files (org-x-get-action-files) (org-x-dag-with-files (org-x-dag->action-files)
(and (org-x-dag-id->is-toplevel-p it) (and (org-x-dag-id->is-toplevel-p it)
(not (org-x-dag-id->is-done-p it))) (not (org-x-dag-id->is-done-p it)))
(format-key it-category it)))) (format-key it-category it))))
@ -2019,12 +2054,12 @@ FUTURE-LIMIT in a list."
(org-add-props nil (org-add-props nil
'x-status status)))))) 'x-status status))))))
;; TODO this will only scan toplevel iterators ;; TODO this will only scan toplevel iterators
(org-x-dag-with-files (org-x-get-action-files) (org-x-dag-with-files (org-x-dag->action-files)
(org-x-dag-id->is-toplevel-p it) (org-x-dag-id->is-toplevel-p it)
(let ((tags (org-x-dag-id->tags nil it))) (let ((tags (org-x-dag-id->tags nil it)))
(when (eq (cadr (org-x-dag-id->goal-status 'current id)) :planned) (when (eq (cadr (org-x-dag-id->goal-status 'current id)) :planned)
(org-x-dag-with-id it (org-x-dag-with-id it
(when (org-x-dag-headline-is-iterator-p) (when (org-x-dag-id->is-iterator-p it)
(list (format-result tags it-category it))))))))) (list (format-result tags it-category it)))))))))
(defun org-x-dag-get-task-nodes (pred id) (defun org-x-dag-get-task-nodes (pred id)
@ -2046,13 +2081,13 @@ FUTURE-LIMIT in a list."
((format-key ((format-key
(category is-standalone key) (category is-standalone key)
(let ((tags (org-x-dag-id->tags nil key))) (let ((tags (org-x-dag-id->tags nil key)))
(org-x-dag-with-id key (unless (or (not (eq (cadr (org-x-dag-id->goal-status 'current key)) :planned))
(unless (or (not (eq (cadr (org-x-dag-id->goal-status 'current key)) :planned)) (org-x-dag->planning-file :scheduled key)
(org-x-dag-headline-is-scheduled-p nil) (org-x-dag->planning-file :deadline key))
(org-x-dag-headline-is-deadlined-p nil)) (let* ((s (org-x-dag-id->task-status id))
(let* ((s (org-x-headline-get-task-status-0 (org-x-dag-id->todo key))) (p (alist-get s org-x-headline-task-status-priorities)))
(p (alist-get s org-x-headline-task-status-priorities))) (unless (= p -1)
(unless (= p -1) (org-x-dag-with-id key
(-> (org-x-dag-format-tag-node category tags key) (-> (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 is-standalone
@ -2063,7 +2098,6 @@ FUTURE-LIMIT in a list."
(lambda (it) (not (member (org-x-dag-id->todo it) (lambda (it) (not (member (org-x-dag-id->todo it)
(list org-x-kw-canc org-x-kw-hold)))) (list org-x-kw-canc org-x-kw-hold))))
it)) it))
(--map (format-key it-category nil it) project-tasks) (--map (format-key it-category nil it) project-tasks)
(list (format-key it-category t it)))))) (list (format-key it-category t it))))))
@ -2084,13 +2118,13 @@ FUTURE-LIMIT in a list."
(category is-standalone key) (category is-standalone key)
(-let (((goal-ids goal-status) (org-x-dag-id->goal-status 'current key))) (-let (((goal-ids goal-status) (org-x-dag-id->goal-status 'current key)))
(when (memq goal-status '(:planned :committed)) (when (memq goal-status '(:planned :committed))
(org-x-dag-with-id key (let* ((s (org-x-dag-id->task-status id))
(let* ((s (org-x-headline-get-task-status-0 (org-x-dag-id->todo key))) (p (alist-get s org-x-headline-task-status-priorities))
(p (alist-get s org-x-headline-task-status-priorities)) (tags (org-x-dag-id->tags nil key)))
(tags (org-x-dag-id->tags nil key))) (unless (= p -1)
(unless (= p -1) ;; ASSUME only ids with at least one valid goal will get this
;; ASSUME only ids with at least one valid goal will get this ;; far
;; far (org-x-dag-with-id key
(-> (org-x-dag-format-tag-node category tags key) (-> (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 is-standalone
@ -2111,11 +2145,11 @@ FUTURE-LIMIT in a list."
(category is-standalone key) (category is-standalone key)
(-let (((goal-ids goal-status) (org-x-dag-id->goal-status 'current key))) (-let (((goal-ids goal-status) (org-x-dag-id->goal-status 'current key)))
(when (eq goal-status :survival) (when (eq goal-status :survival)
(org-x-dag-with-id key (let* ((s (org-x-dag->task-status key))
(let* ((s (org-x-headline-get-task-status-0 (org-x-dag-id->todo key))) (p (alist-get s org-x-headline-task-status-priorities))
(p (alist-get s org-x-headline-task-status-priorities)) (tags (org-x-dag-id->tags nil key)))
(tags (org-x-dag-id->tags nil key))) (unless (= p -1)
(unless (= p -1) (org-x-dag-with-id key
(-> (org-x-dag-format-tag-node category tags key) (-> (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 is-standalone
@ -2123,9 +2157,7 @@ FUTURE-LIMIT in a list."
(org-x-dag--item-add-goal-ids goal-ids))))))))) (org-x-dag--item-add-goal-ids goal-ids)))))))))
(org-x-dag-with-files (org-x-dag->action-files) (org-x-dag-with-files (org-x-dag->action-files)
(and (org-x-dag-id->is-toplevel-p it) (and (org-x-dag-id->is-toplevel-p it)
(not (org-x-dag-with-id it (not (org-x-dag-id->is-iterator-p it)))
(equal (org-x-dag-get-local-property org-x-prop-parent-type)
org-x-prop-parent-type-iterator))))
(-if-let (project-tasks (org-x-dag-get-task-nodes (-if-let (project-tasks (org-x-dag-get-task-nodes
(lambda (it) (not (member (org-x-dag-id->todo it) (lambda (it) (not (member (org-x-dag-id->todo it)
(list org-x-kw-canc org-x-kw-hold)))) (list org-x-kw-canc org-x-kw-hold))))
@ -2153,10 +2185,9 @@ FUTURE-LIMIT in a list."
(cat key) (cat key)
(let ((tags (org-x-dag-id->tags nil key))) (let ((tags (org-x-dag-id->tags nil key)))
;; TODO don't hardcode these things ;; TODO don't hardcode these things
(org-x-dag-with-id key (-some->> (org-x-dag-id->buffer-children key)
(-some->> (org-x-dag-id->buffer-children key) (org-x-dag-headline-get-project-status key tags)
(org-x-dag-headline-get-project-status key tags) (--mapcat (format-result cat it))))))
(--mapcat (format-result cat it)))))))
;; TODO this is hella-inefficient, just get the child links from the ;; TODO this is hella-inefficient, just get the child links from the
;; survival goal file and start from there ;; survival goal file and start from there
(org-x-dag-with-files (org-x-dag->action-files) (org-x-dag-with-files (org-x-dag->action-files)
@ -2198,7 +2229,7 @@ FUTURE-LIMIT in a list."
(alist-get org-x-project-status-priorities) (alist-get org-x-project-status-priorities)
(eq :archivable) (eq :archivable)
(list t)) (list t))
(-> (org-x-headline-get-task-status-0 (org-x-dag-id->todo key)) (-> (org-x-dag-id->task-status id)
(alist-get org-x-headline-task-status-priorities) (alist-get org-x-headline-task-status-priorities)
(eq :archivable) (eq :archivable)
(list t))))) (list t)))))
@ -2208,11 +2239,10 @@ FUTURE-LIMIT in a list."
'x-project-p is-project))))))))) 'x-project-p is-project)))))))))
(org-x-dag-with-files (org-x-get-action-files) (org-x-dag-with-files (org-x-get-action-files)
(org-x-dag-id->is-toplevel-p it) (org-x-dag-id->is-toplevel-p it)
(org-x-dag-with-id it (if (org-x-dag->is-iterator-p it)
(if (org-x-dag-headline-is-iterator-p) (->> (org-x-dag-id->buffer-children it)
(->> (org-x-dag-id->buffer-children it) (--map (format-key it-category it)))
(--map (format-key it-category it))) (list (format-key it-category it))))))
(list (format-key it-category it)))))))
(defun org-x-dag--classify-goal-link (which which-goal id) (defun org-x-dag--classify-goal-link (which which-goal id)
(let ((f (org-x-dag-id->file id))) (let ((f (org-x-dag-id->file id)))
@ -2273,17 +2303,17 @@ FUTURE-LIMIT in a list."
(--separate (member (org-x-dag-id->file it) parent-files) (--separate (member (org-x-dag-id->file it) parent-files)
linked-parents)) linked-parents))
(tags (org-x-dag-id->tags nil id))) (tags (org-x-dag-id->tags nil id)))
(-> (org-x-dag-format-tag-node category tags id) (org-x-dag-with-id id
(org-x-dag--add-goal-status :endpoint (-> (org-x-dag-format-tag-node category tags id)
(append buffer-children local) (org-x-dag--add-goal-status :endpoint
action (append buffer-children local)
other action
goal-parents other
other-parents))))) goal-parents
other-parents))))))
(org-x-dag-with-files (list (org-x-dag->goal-file :endpoint)) (org-x-dag-with-files (list (org-x-dag->goal-file :endpoint))
nil nil
(org-x-dag-with-id it (list (format-id it-category it))))))
(list (format-id it-category it)))))))
(defun org-x-dag-scan-goals () (defun org-x-dag-scan-goals ()
(append (org-x-dag-scan-toplevel-goals :lifetime :endpoint) (append (org-x-dag-scan-toplevel-goals :lifetime :endpoint)
@ -2294,22 +2324,21 @@ FUTURE-LIMIT in a list."
(cl-flet (cl-flet
((format-id ((format-id
(category id) (category id)
(org-x-dag-with-id id (-when-let (error-type
(-when-let (error-type (if (org-x-dag-id->is-iterator-p id)
(if (org-x-dag-headline-is-iterator-p) (unless (org-x-dag-id->node-property "ARCHIVE" id)
(unless (org-x-dag-get-local-property "ARCHIVE") :missing-archive)
:missing-archive) (-if-let (created (org-x-dag-id->node-property org-x-prop-created))
(-if-let (created (org-x-dag-is-created-p t)) (when (<= (float-time) (org-2ft created))
(when (<= (float-time) created) :future-created)
:future-created) :missing-created)))
:missing-created))) (org-x-dag-with-id id
(-> (org-x-dag-format-tag-node category nil id) (-> (org-x-dag-format-tag-node category nil id)
(org-add-props nil (org-add-props nil
'x-error error-type)))))) 'x-error error-type))))))
(org-x-dag-with-files (org-x-dag->files) (org-x-dag-with-files (org-x-dag->files)
(not (org-x-dag-id->is-done-p it)) (not (org-x-dag-id->is-done-p it))
(org-x-dag-with-id it (list (format-id it-category it)))))
(list (format-id it-category it))))))
(defun org-x-dag-scan-agenda (sel-date) (defun org-x-dag-scan-agenda (sel-date)
(cl-flet* (cl-flet*
@ -2328,18 +2357,16 @@ FUTURE-LIMIT in a list."
(format-id (format-id
(todayp cat id) (todayp cat id)
(org-x-dag-with-id id (org-x-dag-with-id id
(-when-let (res (org-x-dag-headline-get-planning)) (append
(-let (((dead sched) res)) (-when-let (dead (org-x-dag-id->planning-timestamp :deadline id))
(append (format-timestamps todayp sel-date cat id dead
(when dead #'org-x-dag-get-deadlines-at
(format-timestamps todayp sel-date cat id dead #'org-x-dag-format-deadline-node))
#'org-x-dag-get-deadlines-at (-when-let (sched(org-x-dag-id->planning-timestamp :scheduled id))
#'org-x-dag-format-deadline-node)) (format-timestamps todayp sel-date cat id sched
(when sched #'org-x-dag-get-scheduled-at
(format-timestamps todayp sel-date cat id sched #'org-x-dag-format-scheduled-node))))))
#'org-x-dag-get-scheduled-at (org-x-dag-with-files (org-x-dag->action-files)
#'org-x-dag-format-scheduled-node))))))))
(org-x-dag-with-files (org-x-get-action-files)
nil nil
(let ((todayp (= (org-x-dag-date-to-absolute sel-date) (org-today)))) (let ((todayp (= (org-x-dag-date-to-absolute sel-date) (org-today))))
(format-id todayp it-category it))))) (format-id todayp it-category it)))))
@ -2351,18 +2378,18 @@ FUTURE-LIMIT in a list."
(cl-flet (cl-flet
((format-id ((format-id
(id) (id)
(org-x-dag-with-id id (let ((alloc (-some->> (org-x-dag-id->node-property org-x-prop-allocate id)
(let ((alloc (-some->> (org-x-dag-get-local-property org-x-prop-allocate) (org-x-dag-allocation-fraction current-quarter)))
(org-x-dag-allocation-fraction current-quarter))) (assignedp (org-x-dag-id->has-child-in-files-p id week-file))
(assignedp (org-x-dag-id->has-child-in-files-p id week-file)) (bucket (org-x-dag-id->bucket nil id)))
(bucket (org-x-dag-id->bucket nil id))) (org-x-dag-with-id id
(-> (org-x-dag-format-tag-node "goal" (list bucket) id) (-> (org-x-dag-format-tag-node "goal" (list bucket) id)
(org-add-props nil (org-add-props nil
'x-assignedp assignedp 'x-assignedp assignedp
;; override face ;; override face
'face (if assignedp 'org-warning 'default) 'face (if assignedp 'org-warning 'default)
'x-alloc (or alloc 0))))))) 'x-alloc (or alloc 0)))))))
(org-x-with-file (org-x-qtp-get-file) (org-x-with-file (org-x-dag->planning-file :quarterly)
(-map #'format-id (org-x-dag->qtp-ids 'current)))))) (-map #'format-id (org-x-dag->qtp-ids 'current))))))
(defun org-x-dag-scan-weekly-plan () (defun org-x-dag-scan-weekly-plan ()
@ -2370,22 +2397,22 @@ FUTURE-LIMIT in a list."
(cl-flet (cl-flet
((format-id ((format-id
(id) (id)
(org-x-dag-with-id id ;; TODO this assigned thing needs to be limited in scope to the
;; TODO this assigned thing needs to be limited in scope to the ;; the current ids of the time period in question
; the current ids of the time period in question (let* ((assignedp (org-x-dag-id->has-child-in-files-p id daily-file))
(let* ((assignedp (org-x-dag-id->has-child-in-files-p id daily-file)) (day (-some->> (org-x-dag-id->tags nil id)
(day (-some->> (org-x-dag-id->tags nil id) ;; TODO I guess this works...could be more precise
;; TODO I guess this works...could be more precise (--filter (s-matches-p "[A-Z]\\{3\\}" it))
(--filter (s-matches-p "[A-Z]\\{3\\}" it)) (car)))
(car))) (daynum (car (rassoc day org-x-dag-weekly-tags))))
(daynum (car (rassoc day org-x-dag-weekly-tags)))) (org-x-dag-with-id id
(-> (org-x-dag-format-tag-node "goal" nil id) (-> (org-x-dag-format-tag-node "goal" nil id)
(org-add-props nil (org-add-props nil
'x-assignedp assignedp 'x-assignedp assignedp
'x-day-of-week (format "%d. %s" daynum day) 'x-day-of-week (format "%d. %s" daynum day)
;; override face ;; override face
'face (if assignedp 'org-warning 'default))))))) 'face (if assignedp 'org-warning 'default)))))))
(org-x-with-file (org-x-get-weekly-plan-file) (org-x-with-file (org-x-dag->planning-file :weekly)
(-map #'format-id (org-x-dag->wkp-ids 'current)))))) (-map #'format-id (org-x-dag->wkp-ids 'current))))))
;; (cl-flet ;; (cl-flet