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

ADD function to link ltg to epg nodes

This commit is contained in:
Nathan Dwarshuis 2022-02-18 18:46:01 -05:00
parent f80f507a51
commit 5ed8dccc67
1 changed files with 51 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -291,6 +291,11 @@ that file as it currently sits on disk.")
(parent-tags (and inherit? (ascend id nil))))
(append local-tags parent-tags init))))
(defun org-x-dag-id->title (id)
(org-x-dag-with-id-in-file id
(->> (org-get-heading t t t t)
(substring-no-properties))))
(defun org-x-dag-id->bucket (inherit? id)
(-some->> (org-x-dag-id->tags inherit? nil id)
(--find (= (elt it 0) org-x-tag-category-prefix))
@ -2047,10 +2052,11 @@ FUTURE-LIMIT in a list."
(let ((first (car (org-ml-item-get-paragraph item))))
(if (and (org-ml-is-type 'link first)
(equal (org-ml-get-property :type first) "id"))
(->> (org-ml-get-children first)
(-map #'org-ml-to-trimmed-string)
(apply #'concat)
(cons (org-ml-get-property :path first)))
(org-ml-get-property :path first)
;; (->> (org-ml-get-children first)
;; (-map #'org-ml-to-trimmed-string)
;; (apply #'concat)
;; (cons (org-ml-get-property :path first)))
(error "Invalid link node: %S" first)))))
(-when-let (first (->> headline
(org-ml-headline-get-contents (org-x-logbook-config))
@ -2072,11 +2078,12 @@ FUTURE-LIMIT in a list."
(-if-let (i (--find-index (org-x--is-drawer-with-name
org-x-drwr-parent-links it)
it))
(let ((d (nth i it))
(pl (->> (-map #'org-x-dag-build-parent-link-item ids)
(apply #'org-ml-build-plain-list))))
(-replace-at i (org-ml-set-children (list pl) d) it))
(cons (org-x-dag-build-parent-link-drawer ids) it))
(let ((d (nth i it)))
(-if-let (pl (-some->> (-map #'org-x-dag-id->link-item ids)
(apply #'org-ml-build-plain-list)))
(-replace-at i (org-ml-set-children (list pl) d) it)
(-remove-at i it)))
(if ids (cons (org-x-dag-build-parent-link-drawer ids) it) it))
headline))
(defmacro org-x-dag-headline-map-parent-links* (form headline)
@ -2085,12 +2092,12 @@ FUTURE-LIMIT in a list."
(it (org-x-dag-headline-get-parent-links ,h)))
(org-x-dag-headline-set-parent-links ,form ,h))))
(defun org-x-dag-headline-add-parent-link (id desc headline)
(org-x-dag-headline-map-parent-links* (cons (cons id desc) it) headline))
(defun org-x-dag-headline-add-parent-link (id headline)
(org-x-dag-headline-map-parent-links* (cons id it) headline))
(defun org-x-dag-headline-remove-parent-link (id headline)
(org-x-dag-headline-map-parent-links*
(--remove-first (equal (car it) id) it)
(--remove-first (equal it id) it)
headline))
;;; ALLOCATION
@ -2127,6 +2134,38 @@ FUTURE-LIMIT in a list."
(/ (* mins d*) qt-mins)))
(e (error "Invalid allocation: %s" e))))))
;;; INTERACTIVE FUNCTIONS
(defun org-x-dag-add-id-to-this-headline (id)
(org-ml-update-this-headline*
(org-x-dag-headline-add-parent-link id it)))
(defun org-x-dag-read-id (ids cur-ids)
(cl-flet
((make-cell
(id cur-ids)
(let ((title (org-x-dag-id->title id))
(presentp (and (member id cur-ids) t)))
(list (format "%c %s" (if presentp ?* ?\s) title)
:id id
:title title
:presentp presentp))))
(let ((mapper (->> ids
(--map (make-cell it cur-ids))
(--sort (plist-get (cdr it) :presentp)))))
(print (-map #'cdr mapper))
(alist-get (completing-read "Node: " mapper) mapper nil nil #'equal))))
(defun org-x-dag-link-ltg-to-epg ()
(if (not (equal (buffer-file-name) (org-x-get-endpoint-goal-file)))
(message "Not in endpoint goal file")
(org-ml-update-this-headline*
(-let* ((ltg-ids (org-x-dag->ltg-ids))
(cur-ids (org-x-dag-headline-get-parent-links it))
((&plist :id i :presentp p) (org-x-dag-read-id ltg-ids cur-ids)))
(if p (org-x-dag-headline-remove-parent-link i it)
(org-x-dag-headline-add-parent-link i it))))))
;;; AGENDA VIEWS
(defun org-x-dag-agenda-run-series (name files cmds)