ADD function to link ltg to epg nodes
This commit is contained in:
parent
f80f507a51
commit
5ed8dccc67
|
@ -291,6 +291,11 @@ that file as it currently sits on disk.")
|
||||||
(parent-tags (and inherit? (ascend id nil))))
|
(parent-tags (and inherit? (ascend id nil))))
|
||||||
(append local-tags parent-tags init))))
|
(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)
|
(defun org-x-dag-id->bucket (inherit? id)
|
||||||
(-some->> (org-x-dag-id->tags inherit? nil id)
|
(-some->> (org-x-dag-id->tags inherit? nil id)
|
||||||
(--find (= (elt it 0) org-x-tag-category-prefix))
|
(--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))))
|
(let ((first (car (org-ml-item-get-paragraph item))))
|
||||||
(if (and (org-ml-is-type 'link first)
|
(if (and (org-ml-is-type 'link first)
|
||||||
(equal (org-ml-get-property :type first) "id"))
|
(equal (org-ml-get-property :type first) "id"))
|
||||||
(->> (org-ml-get-children first)
|
(org-ml-get-property :path first)
|
||||||
(-map #'org-ml-to-trimmed-string)
|
;; (->> (org-ml-get-children first)
|
||||||
(apply #'concat)
|
;; (-map #'org-ml-to-trimmed-string)
|
||||||
(cons (org-ml-get-property :path first)))
|
;; (apply #'concat)
|
||||||
|
;; (cons (org-ml-get-property :path first)))
|
||||||
(error "Invalid link node: %S" first)))))
|
(error "Invalid link node: %S" first)))))
|
||||||
(-when-let (first (->> headline
|
(-when-let (first (->> headline
|
||||||
(org-ml-headline-get-contents (org-x-logbook-config))
|
(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
|
(-if-let (i (--find-index (org-x--is-drawer-with-name
|
||||||
org-x-drwr-parent-links it)
|
org-x-drwr-parent-links it)
|
||||||
it))
|
it))
|
||||||
(let ((d (nth i it))
|
(let ((d (nth i it)))
|
||||||
(pl (->> (-map #'org-x-dag-build-parent-link-item ids)
|
(-if-let (pl (-some->> (-map #'org-x-dag-id->link-item ids)
|
||||||
(apply #'org-ml-build-plain-list))))
|
(apply #'org-ml-build-plain-list)))
|
||||||
(-replace-at i (org-ml-set-children (list pl) d) it))
|
(-replace-at i (org-ml-set-children (list pl) d) it)
|
||||||
(cons (org-x-dag-build-parent-link-drawer ids) it))
|
(-remove-at i it)))
|
||||||
|
(if ids (cons (org-x-dag-build-parent-link-drawer ids) it) it))
|
||||||
headline))
|
headline))
|
||||||
|
|
||||||
(defmacro org-x-dag-headline-map-parent-links* (form 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)))
|
(it (org-x-dag-headline-get-parent-links ,h)))
|
||||||
(org-x-dag-headline-set-parent-links ,form ,h))))
|
(org-x-dag-headline-set-parent-links ,form ,h))))
|
||||||
|
|
||||||
(defun org-x-dag-headline-add-parent-link (id desc headline)
|
(defun org-x-dag-headline-add-parent-link (id headline)
|
||||||
(org-x-dag-headline-map-parent-links* (cons (cons id desc) it) headline))
|
(org-x-dag-headline-map-parent-links* (cons id it) headline))
|
||||||
|
|
||||||
(defun org-x-dag-headline-remove-parent-link (id headline)
|
(defun org-x-dag-headline-remove-parent-link (id headline)
|
||||||
(org-x-dag-headline-map-parent-links*
|
(org-x-dag-headline-map-parent-links*
|
||||||
(--remove-first (equal (car it) id) it)
|
(--remove-first (equal it id) it)
|
||||||
headline))
|
headline))
|
||||||
|
|
||||||
;;; ALLOCATION
|
;;; ALLOCATION
|
||||||
|
@ -2127,6 +2134,38 @@ FUTURE-LIMIT in a list."
|
||||||
(/ (* mins d*) qt-mins)))
|
(/ (* mins d*) qt-mins)))
|
||||||
(e (error "Invalid allocation: %s" e))))))
|
(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
|
;;; AGENDA VIEWS
|
||||||
|
|
||||||
(defun org-x-dag-agenda-run-series (name files cmds)
|
(defun org-x-dag-agenda-run-series (name files cmds)
|
||||||
|
|
Loading…
Reference in New Issue