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

ENH don't refer to buffer when making agenda items

This commit is contained in:
Nathan Dwarshuis 2022-03-03 19:22:07 -05:00
parent ac0f85cd64
commit 9a6ab71ab7
1 changed files with 147 additions and 135 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -350,10 +350,9 @@ highest in the tree."
(defun org-x-dag-id->link (id) (defun org-x-dag-id->link (id)
"Return the link node for ID." "Return the link node for ID."
(org-x-dag-with-id-in-file id (let ((desc (org-x-dag-id->title id)))
(let ((desc (org-x-dag-id->title id))) (->> (org-ml-build-secondary-string! desc)
(->> (org-ml-build-secondary-string! desc) (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."
@ -1564,21 +1563,48 @@ FUTURE-LIMIT in a list."
(->> (org-ml-get-properties '(:deadline :scheduled) pl) (->> (org-ml-get-properties '(:deadline :scheduled) pl)
(--map (-some-> it (org-x-dag-partition-timestamp))))))))) (--map (-some-> it (org-x-dag-partition-timestamp)))))))))
(defun org-x-dag-format-tag-node (category tags key) (defun org-x-dag-id->agenda-timestamp (id)
"Retrieve timestamp information of ID for sorting agenda views.
This is a rewrite of `org-agenda-entry-get-agenda-timestamp'
except it ignores inactive timestamps."
(-let (((ts type)
(cond ((org-em 'scheduled-up 'scheduled-down
org-agenda-sorting-strategy-selected)
`(,(org-x-dag-id->planning-timestamp :scheduled id) " scheduled"))
((org-em 'deadline-up 'deadline-down
org-agenda-sorting-strategy-selected)
`(,(org-x-dag-id->planning-timestamp :deadline id) " deadline"))
((org-em 'timestamp-up 'timestamp-down
org-agenda-sorting-strategy-selected)
`(,(or (org-x-dag-id->planning-timestamp :scheduled id)
(org-x-dag-id->planning-timestamp :deadline id))
""))
(t
'(nil "")))))
(cons (-some->> ts
(org-ml-timestamp-get-start-time)
(org-x-dag-date-to-absolute))
type)))
(defun org-x-dag-id->marker (id &optional point)
(let* ((f (org-x-dag-id->file id))
(p (or point (org-x-dag-id->point id)))
(b (or (get-file-buffer f) (find-file-noselect f))))
(set-marker (make-marker) p b)))
(defun org-x-dag-format-tag-node (category tags id)
;; ASSUME I don't use subtree-level categories ;; ASSUME I don't use subtree-level categories
(-let* (;; (category (org-get-category)) (-let* ((tags* (org-x-dag-prepare-tags tags))
(tags* (org-x-dag-prepare-tags tags)) (todo-state (org-x-dag-id->todo id))
(todo-state (org-x-dag-id->todo key))
;; 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)
(head (format "%s %s" todo-state (org-x-dag-id->title key))) (head (format "%s %s" todo-state (org-x-dag-id->title id)))
(level (org-x-dag-id->formatted-level key)) (level (org-x-dag-id->formatted-level id))
(marker (org-agenda-new-marker)) (marker (org-agenda-new-marker (org-x-dag-id->marker id)))
;; no idea what this function actually does ((ts . ts-type) (org-x-dag-id->agenda-timestamp id))
((ts . ts-type) (org-agenda-entry-get-agenda-timestamp (point)))
(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 key) (-> (org-x-dag-add-default-props item id)
(org-add-props nil (org-add-props nil
;; face ;; face
'face 'default 'face 'default
@ -1616,8 +1642,8 @@ FUTURE-LIMIT in a list."
'undone-face face 'undone-face face
'done-face 'org-agenda-done 'done-face 'org-agenda-done
;; marker ;; marker
'org-hd-marker (org-agenda-new-marker) 'org-hd-marker (org-agenda-new-marker (org-x-dag-id->marker id))
'org-marker (org-agenda-new-marker pos) 'org-marker (org-agenda-new-marker (org-x-dag-id->marker id pos))
;; headline stuff ;; headline stuff
'date (org-x-dag-date-to-absolute date) 'date (org-x-dag-date-to-absolute date)
'ts-date (org-x-dag-date-to-absolute ts-date) 'ts-date (org-x-dag-date-to-absolute ts-date)
@ -1739,8 +1765,8 @@ FUTURE-LIMIT in a list."
(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)
(->> (org-x-dag-id->metaprop id :planning) (-some->> (org-x-dag-id->metaprop id :planning)
(org-ml-get-property which))) (org-ml-get-property which)))
(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->metaprop id :props) nil nil #'equal))
@ -1796,16 +1822,16 @@ FUTURE-LIMIT in a list."
;;; STATUS DETERMINATION ;;; STATUS DETERMINATION
(defmacro org-x-dag-with-id (key &rest body) ;; (defmacro org-x-dag-with-id (key &rest body)
(declare (indent 1)) ;; (declare (indent 1))
`(progn ;; `(progn
(goto-char (org-x-dag-id->point ,key)) ;; (goto-char (org-x-dag-id->point ,key))
,@body)) ;; ,@body))
(defmacro org-x-dag-with-id-in-file (id &rest body) ;; (defmacro org-x-dag-with-id-in-file (id &rest body)
(declare (indent 1)) ;; (declare (indent 1))
`(org-x-with-file (org-x-dag-id->file ,id) ;; `(org-x-with-file (org-x-dag-id->file ,id)
(org-x-dag-with-id ,id ,@body))) ;; (org-x-dag-with-id ,id ,@body)))
(defun org-x-headline-get-task-status-0 (kw) (defun org-x-headline-get-task-status-0 (kw)
(if (member kw org-x-done-keywords) (if (member kw org-x-done-keywords)
@ -1825,7 +1851,11 @@ FUTURE-LIMIT in a list."
(let ((c (org-x-dag-id->planning-timestamp :closed id))) (let ((c (org-x-dag-id->planning-timestamp :closed id)))
(if (org-x-dag-id->is-done-p id) (if (org-x-dag-id->is-done-p id)
(if c (if c
(if (org-x-dag-time-is-archivable-p c) :archivable :complete) (if (->> (org-ml-timestamp-get-start-time c)
(org-ml-time-to-unixtime)
(org-x-dag-time-is-archivable-p))
:archivable
:complete)
:done-unclosed) :done-unclosed)
(cond (cond
;; ((org-x-headline-is-expired-p) :expired) ;; ((org-x-headline-is-expired-p) :expired)
@ -1858,10 +1888,9 @@ FUTURE-LIMIT in a list."
(alist-get top-status ',trans-tbl)))) (alist-get top-status ',trans-tbl))))
(cons top-status* child-results)) (cons top-status* child-results))
(let ((it-kw (org-x-dag-id->todo key))) (let ((it-kw (org-x-dag-id->todo key)))
(org-x-dag-with-id key (-> ,task-form
(-> ,task-form (nth ',allowed-codes)
(nth ',allowed-codes) (list))))))
(list)))))))
(let* ((results (-map #'get-project-or-task-status ,keys)) (let* ((results (-map #'get-project-or-task-status ,keys))
(status (->> (-map #'car results) (status (->> (-map #'car results)
(org-x-dag-get-max-index ',allowed-codes)))) (org-x-dag-get-max-index ',allowed-codes))))
@ -1869,7 +1898,6 @@ FUTURE-LIMIT in a list."
(defun org-x-dag-headline-get-project-status (id 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 id
(let ((keyword (org-x-dag-id->todo id))) (let ((keyword (org-x-dag-id->todo id)))
(-let (((status . child-results) (-let (((status . child-results)
(cond (cond
@ -1920,7 +1948,6 @@ FUTURE-LIMIT in a list."
(cons (list :key key :status status :tags tags) child-results)))) (cons (list :key key :status status :tags tags) child-results))))
(defun org-x-dag-headline-get-iterator-project-status (id children) (defun org-x-dag-headline-get-iterator-project-status (id children)
;; (org-x-dag-with-id id
(let* ((kw (org-x-dag-id->todo id)) (let* ((kw (org-x-dag-id->todo id))
(status (status
(cond (cond
@ -1955,7 +1982,6 @@ FUTURE-LIMIT in a list."
status)) status))
(defun org-x-dag-headline-get-iterator-task-status (id) (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 (org-x-dag-id->is-done-p id) :empt
(-if-let (ts (or (org-x-dag-id->planning-timestamp :scheduled id) (-if-let (ts (or (org-x-dag-id->planning-timestamp :scheduled id)
(org-x-dag-id->planning-timestamp :deadline id))) (org-x-dag-id->planning-timestamp :deadline id)))
@ -2007,22 +2033,20 @@ FUTURE-LIMIT in a list."
(-let* (((&plist :key :status :tags) result) (-let* (((&plist :key :status :tags) result)
(priority (alist-get status org-x-project-status-priorities))) (priority (alist-get status org-x-project-status-priorities)))
(when (>= priority 0) (when (>= priority 0)
(org-x-dag-with-id key (-> (org-x-dag-format-tag-node cat tags key)
(-> (org-x-dag-format-tag-node cat tags key) (org-add-props nil
(org-add-props nil 'x-toplevelp (org-x-dag-id->is-toplevel-p key)
'x-toplevelp (org-x-dag-id->is-toplevel-p key) 'x-status status
'x-status status 'x-priority priority)))))
'x-priority priority))))))
(format-key (format-key
(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 (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-id->is-iterator-p key))
(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-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-id->is-done-p it))) (not (org-x-dag-id->is-done-p it)))
@ -2049,18 +2073,16 @@ FUTURE-LIMIT in a list."
((format-result ((format-result
(tags cat key) (tags cat key)
(-let ((status (org-x-dag-headline-get-iterator-status key))) (-let ((status (org-x-dag-headline-get-iterator-status key)))
(org-x-dag-with-id key (-> (org-x-dag-format-tag-node cat tags key)
(-> (org-x-dag-format-tag-node cat tags key) (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-dag->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 (when (org-x-dag-id->is-iterator-p it)
(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)
(declare (indent 2)) (declare (indent 2))
@ -2081,17 +2103,17 @@ 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)))
(unless (or (not (eq (cadr (org-x-dag-id->goal-status 'current key)) :planned)) (unless (or (member org-x-tag-incubated tags)
(org-x-dag->planning-file :scheduled key) ;; (not (eq (cadr (org-x-dag-id->goal-status 'current key)) :planned))
(org-x-dag->planning-file :deadline key)) (org-x-dag-id->planning-timestamp :scheduled key)
(let* ((s (org-x-dag-id->task-status id)) (org-x-dag-id->planning-timestamp :deadline key))
(let* ((s (org-x-dag-id->task-status 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 'x-status s))))))))
'x-status s)))))))))
(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)
(-if-let (project-tasks (org-x-dag-get-task-nodes (-if-let (project-tasks (org-x-dag-get-task-nodes
@ -2118,18 +2140,17 @@ 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))
(let* ((s (org-x-dag-id->task-status id)) (let* ((s (org-x-dag-id->task-status 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 'x-status s)
'x-status s) (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-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)
(-if-let (project-tasks (org-x-dag-get-task-nodes (-if-let (project-tasks (org-x-dag-get-task-nodes
@ -2149,12 +2170,11 @@ FUTURE-LIMIT in a list."
(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 'x-status s)
'x-status s) (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-id->is-iterator-p it))) (not (org-x-dag-id->is-iterator-p it)))
@ -2174,13 +2194,12 @@ FUTURE-LIMIT in a list."
(when (>= priority 0) (when (>= priority 0)
(-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 (-> (org-x-dag-format-tag-node cat tags key)
(-> (org-x-dag-format-tag-node cat tags key) (org-add-props nil
(org-add-props nil 'x-toplevelp (org-x-dag-id->is-toplevel-p key)
'x-toplevelp (org-x-dag-id->is-toplevel-p key) 'x-status status
'x-status status 'x-priority priority)
'x-priority priority) (org-x-dag--item-add-goal-ids goal-ids)))))))
(org-x-dag--item-add-goal-ids goal-ids))))))))
(format-key (format-key
(cat key) (cat key)
(let ((tags (org-x-dag-id->tags nil key))) (let ((tags (org-x-dag-id->tags nil key)))
@ -2222,21 +2241,20 @@ FUTURE-LIMIT in a list."
(let ((tags (org-x-dag-id->tags nil key))) (let ((tags (org-x-dag-id->tags nil key)))
;; TODO is this what I actually want? ;; TODO is this what I actually want?
(when (memq (cadr (org-x-dag-id->goal-status 'current key)) '(:planned :committed)) (when (memq (cadr (org-x-dag-id->goal-status 'current key)) '(:planned :committed))
(org-x-dag-with-id key (-let (((is-archivable is-project)
(-let (((is-archivable is-project) (-if-let (children (org-x-dag-id->buffer-children key))
(-if-let (children (org-x-dag-id->buffer-children key)) (-> (org-x-dag-headline-get-project-status key tags children)
(-> (org-x-dag-headline-get-project-status key tags children) (alist-get org-x-project-status-priorities)
(alist-get org-x-project-status-priorities)
(eq :archivable)
(list t))
(-> (org-x-dag-id->task-status id)
(alist-get org-x-headline-task-status-priorities)
(eq :archivable) (eq :archivable)
(list t))))) (list t))
(when is-archivable (-> (org-x-dag-id->task-status id)
(-> (org-x-dag-format-tag-node category tags key) (alist-get org-x-headline-task-status-priorities)
(org-add-props nil (eq :archivable)
'x-project-p is-project))))))))) (list t)))))
(when is-archivable
(-> (org-x-dag-format-tag-node category tags key)
(org-add-props nil
'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)
(if (org-x-dag->is-iterator-p it) (if (org-x-dag->is-iterator-p it)
@ -2286,8 +2304,7 @@ FUTURE-LIMIT in a list."
other))))) other)))))
(org-x-dag-with-files (list (org-x-dag->goal-file which)) (org-x-dag-with-files (list (org-x-dag->goal-file which))
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-epgs () (defun org-x-dag-scan-epgs ()
(let ((parent-files `(,(org-x-dag->goal-file :lifetime)))) (let ((parent-files `(,(org-x-dag->goal-file :lifetime))))
@ -2303,14 +2320,13 @@ 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-with-id id (-> (org-x-dag-format-tag-node category tags id)
(-> (org-x-dag-format-tag-node category tags id) (org-x-dag--add-goal-status :endpoint
(org-x-dag--add-goal-status :endpoint (append buffer-children local)
(append buffer-children local) action
action other
other goal-parents
goal-parents other-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
(list (format-id it-category it)))))) (list (format-id it-category it))))))
@ -2332,10 +2348,9 @@ FUTURE-LIMIT in a list."
(when (<= (float-time) (org-2ft created)) (when (<= (float-time) (org-2ft 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))
(list (format-id it-category it))))) (list (format-id it-category it)))))
@ -2356,16 +2371,15 @@ FUTURE-LIMIT in a list."
(--map (funcall format-datetime-fun sel-date pos it cat tags id) it)))))) (--map (funcall format-datetime-fun sel-date pos it cat tags id) it))))))
(format-id (format-id
(todayp cat id) (todayp cat id)
(org-x-dag-with-id id (append
(append (-when-let (dead (org-x-dag-id->planning-timestamp :deadline id))
(-when-let (dead (org-x-dag-id->planning-timestamp :deadline id)) (format-timestamps todayp sel-date cat id dead
(format-timestamps todayp sel-date cat id dead #'org-x-dag-get-deadlines-at
#'org-x-dag-get-deadlines-at #'org-x-dag-format-deadline-node))
#'org-x-dag-format-deadline-node)) (-when-let (sched(org-x-dag-id->planning-timestamp :scheduled id))
(-when-let (sched(org-x-dag-id->planning-timestamp :scheduled id)) (format-timestamps todayp sel-date cat id sched
(format-timestamps todayp sel-date cat id sched #'org-x-dag-get-scheduled-at
#'org-x-dag-get-scheduled-at #'org-x-dag-format-scheduled-node)))))
#'org-x-dag-format-scheduled-node))))))
(org-x-dag-with-files (org-x-dag->action-files) (org-x-dag-with-files (org-x-dag->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))))
@ -2382,13 +2396,12 @@ FUTURE-LIMIT in a list."
(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-dag->planning-file :quarterly) (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))))))
@ -2405,13 +2418,12 @@ FUTURE-LIMIT in a list."
(--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-dag->planning-file :weekly) (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))))))