ADD parent link drawer functions

local/lib/org-x/org-x-dag.el

@@ -165,6 +165,18 @@ that file as it currently sits on disk.")
                 (s-match "^\\[\\[id:\\(.*\\)\\]\\[.*\\]\\]$")
                 (cadr)))))
 
+(defun org-x-dag-get-parent-links ()
+  (save-excursion
+    (let ((re (concat
+               "^[ \t]*:X_PARENT_LINKS:[ \t]*\n"
+               "\\(\\(?:^- .*?\n\\)*?\\)"
+               "[ \t]*:END:[ \t]*$"))
+          (end (save-excursion (outline-next-heading))))
+      (-some->> (and (re-search-forward re end t) (match-string 1))
+        (s-trim)
+        (s-split "\n")
+        (--map (cadr (s-match "id:\\([^][]\\{36\\}\\)" it)))))))
+
 (defun org-x-dag-get-buffer-nodes (file kws)
   "Return a list of nodes from FILE.
 
@@ -179,7 +191,8 @@ valid keyword or none of its parents have valid keywords."
     (goto-char (point-min))
     ;; If not on a headline, check for a property drawer with links in it
     (unless (= ?* (following-char))
-      (setq this-file-links (org-x-dag-get-link-property)))
+      ;; (setq this-file-links (org-x-dag-get-link-property)))
+      (setq this-file-links (org-x-dag-get-parent-links)))
     ;; move forward until on a headline
     (while (and (not (= ?* (following-char))) (= 0 (forward-line 1))))
     ;; Build alist; Keep track of how 'deep' we are in a given org-tree using a
@@ -226,7 +239,8 @@ valid keyword or none of its parents have valid keywords."
                                     (--mapcat (nth 2 it))
                                     (append this-tags))
                              this-tags)
-                  this-links (or (org-x-dag-get-link-property)
+                  this-links (or (org-x-dag-get-parent-links)
+                                 ;;(org-x-dag-get-link-property)
                                  (when (not this-parent-key) this-file-links))
                   this-meta (org-x-dag-build-meta file
                                                   this-point
@@ -560,6 +574,9 @@ FUTURE-LIMIT in a list."
   (let ((end (save-excursion (outline-next-heading))))
     (save-excursion
       (when (re-search-forward org-planning-line-re end t)
+        ;; TODO this is rather slow since I'm using a general org-ml parsing
+        ;; function; I'm also not even using the match results from the planning
+        ;; line re, which might be useful
         (-let* ((pl (org-ml-parse-this-element)))
           (->> (org-ml-get-properties '(:deadline :scheduled) pl)
                (--map (-some-> it (org-x-dag-partition-timestamp)))))))))
@@ -1250,5 +1267,66 @@ FUTURE-LIMIT in a list."
         (org-agenda-finalize)
         (setq buffer-read-only t)))))
 
+;;; PARENT LINK FUNCTONS
+
+(defconst org-x-drwr-parent-links "X_PARENT_LINKS")
+
+(defun org-x-dag-headline-get-parent-links (headline)
+  (cl-flet
+      ((parse-item
+        (item)
+        (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)))
+            (error "Invalid link node: %S" first)))))
+    (-when-let (first (->> headline
+                           (org-ml-headline-get-contents (org-x-logbook-config))
+                           (--find (org-x--is-drawer-with-name org-x-drwr-parent-links it))
+                           (org-ml-get-children)
+                           (car)))
+      (if (org-ml-is-type 'plain-list first)
+          (->> (org-ml-get-children first)
+               (-map #'parse-item))
+        (error "Invalid parent link drawer")))))
+
+(defun org-x-dag-headline-set-parent-links (link-pairs headline)
+  (cl-flet
+      ((from-pair
+        (pair)
+        (-let (((id . desc) pair))
+          (->> (org-ml-build-secondary-string! desc)
+               (apply #'org-ml-build-link id :type "id")
+               (org-ml-build-paragraph)
+               (org-ml-build-item)))))
+    (let ((pl (->> (-map #'from-pair link-pairs)
+                   (apply #'org-ml-build-plain-list))))
+      (org-ml-headline-map-contents* (org-x-logbook-config)
+        (-if-let (i (--find-index (org-x--is-drawer-with-name
+                                   org-x-drwr-parent-links it)
+                                  it))
+            (let ((d (nth i it)))
+              (-replace-at i (org-ml-set-children (list pl) d) it))
+          (-> (org-ml-build-drawer "X_PARENT_LINKS" pl)
+            (cons it)))
+        headline))))
+
+(defmacro org-x-dag-headline-map-parent-links* (form headline)
+  (let ((h (make-symbol "--headline")))
+    `(let* ((,h ,headline)
+            (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-remove-parent-link (id headline)
+  (org-x-dag-headline-map-parent-links*
+   (--remove-first (equal (car it) id) it)
+   headline))
+
 (provide 'org-x-dag)
 ;;; org-x-dag.el ends here