Introduce dynamic block to show backlinks of Org item at point

This dynamic block will list all items (including their priority) that link to
the item at point or to any of its parent items.  The use case for this is to
have a series of periodic appointments where certain topics should be
discussed (“jour fixe”), and where those topics can be referenced in those
appointments via backlinks.  However, simple backlinks to an item on a fixed
date is not sufficient here, as there might not be enough time on that day to
discuss all items.  To avoid having to manipulate all backlinks that could not
be discussed, one could simply add a reference to the parent item of all
appointments of the jour fixe series.  Using the new dynamic block introduced
here, this item will be on the list of open topics until it's closed.

init.el

@@ -752,7 +752,8 @@
              db/org-find-links-to-current-item
              db/org-add-link-to-other-item
              db/org-add-link-to-current-clock
-             hydra-org-linking/body))
+             hydra-org-linking/body
+             org-dblock-write:db/org-backlinks))
 
 (use-package org
   :pin "gnu"

site-lisp/db-org.el

@@ -319,20 +319,23 @@ tag PERIODIC."
 
 (defun db/find-parent-task ()
   ;; http://doc.norang.ca/org-mode.html#Clocking
-  "Return point of the nearest parent task, and NIL if no such task exists."
+  "Return point of the nearest parent task, and NIL if no such task exists.
+
+Ignores headlines tagged with NOP or PERIODIC, as those items
+should not be clocked."
   (save-mark-and-excursion
-   (save-restriction
-     (widen)
-     (let ((parent-task nil))
-       (or (org-at-heading-p)
-           (org-back-to-heading t))
-       (while (and (not parent-task)
-                   (org-up-heading-safe))
-         (let ((tags (org-get-tags nil 'local)))
-           (unless (or (member "NOP" tags)
-                       (member "PERIODIC" tags))
-             (setq parent-task (point)))))
-       parent-task))))
+    (save-restriction
+      (widen)
+      (let ((parent-task nil))
+        (or (org-at-heading-p)
+            (org-back-to-heading t))
+        (while (and (not parent-task)
+                    (org-up-heading-safe))
+          (let ((tags (org-get-tags nil 'local)))
+            (unless (or (member "NOP" tags)
+                        (member "PERIODIC" tags))
+              (setq parent-task (point)))))
+        parent-task))))
 
 (defun db/ensure-running-clock ()
   "Clocks in into the parent task, if it exists, or the default task."
@@ -985,30 +988,86 @@ referenced in `org-agenda-text-search-extra-files'."
                                `(and ,link-expression ,org-ql-match)
                              link-expression)))))
 
-(defun db/org-backlinks-to-item-at-point (&optional org-ql-match archives)
-  "Return list of Org links to item at point.
-
-The links are grouped in singleton lists to allow easy formatting
-in Org mode source blocks with “:reslts value table”.  If the
-optional ORG-QL-MATCH is given and is a valid `org-ql' query in
-sexp syntax, filter the list for all items matching this query.
-If ARCHIVES is given, also include archive files.
-
-The search is conducted over all files returned by
-`org-agenda-files' including archives, as well as all files
-referenced in `org-agenda-text-search-extra-files'."
-
-  (let ((id-of-item-at-point (org-id-get)))
+(defun db/org--find-parent-marks ()
+  "Return list of markers of all parent headings of Org item at point.
 
-    (unless id-of-item-at-point
-      (user-error "Item at point does not have an ID property set, cannot determine backlinks"))
+The list will include a marker to the current headline as well.
+The order of the list will be in ascending order of
+positions (i.e., the marker for the headline with the lowest
+level/position comes first)."
+  (unless (derived-mode-p 'org-mode)
+    (user-error "Not in Org mode buffer, cannot determine parent items"))
 
-    (mapcar #'(lambda (id)
-                (list (org-link-make-string (format "id:%s" id)
-                                            (org-entry-get (org-id-find id 'marker) "ITEM"))))
-            (db/org--backlinks-for-id id-of-item-at-point org-ql-match archives))))
+  (save-mark-and-excursion
+    (save-restriction
+      (widen)
+
+      ;; Start at headline of current item
+      (or (org-at-heading-p)
+          (org-back-to-heading t))
+
+      ;; Iterate over parents until at top-level
+      (let ((parent-markers (list (point-marker))))
+        (while (org-up-heading-safe)
+          (push (point-marker) parent-markers))
+        parent-markers))))
+
+(defun db/org--format-link-with-headline (id)
+  "Format ID as an Org mode link [[ID][item headline]]."
+  (org-link-make-string (format "id:%s" id)
+                        (org-entry-get (org-id-find id 'marker) "ITEM")))
+
+(defun org-dblock-write:db/org-backlinks (params)
+  "Write table of backlinks for current item and its parent items as Org table.
+
+PARAMS may contain the following values:
+
+  :org-ql-match   An org-ql-match expression in sexp syntax to filter
+                  the resulting backlinks
+
+  :archives       If non-nil, include archives"
+  (let* ((org-ql-match (plist-get params :org-ql-match))
+         (archives (plist-get params :archives))
+         headlines)
+
+    ;; Get all backlinks as list of Org mode IDs.  Each list consists of the ID
+    ;; of the headline (current or partent), followed by the IDs linking back to
+    ;; that headline.  If any of the headlines (current or parent) does not have
+    ;; an ID, it will not be included in that list.
+    (setq headlines
+          (->> (db/org--find-parent-marks)
+               (mapcar #'(lambda (mark)
+                           (org-with-point-at mark
+                             (when-let ((id-at-point (org-id-get)))
+                               (cons id-at-point
+                                     (db/org--backlinks-for-id id-at-point org-ql-match archives))))))
+               (cl-remove-if #'null)))
+
+    ;; Formatting.
+    (insert (format "| Item | Backlinks | Priority |\n|---|"))
+    (dolist (headline headlines)
+      (insert (format "\n| %s |\n|---|" (db/org--format-link-with-headline (car headline))))
+      (let ((backlink-lines (-> (mapcar #'(lambda (backlink-id)
+                                            (list (db/org--format-link-with-headline backlink-id)
+                                                  (org-entry-get (org-id-find backlink-id 'marker)
+                                                                 "PRIORITY")))
+                                        (cdr headline))
+                                (cl-sort #'string< :key #'cl-second))))
+        (dolist (line backlink-lines)
+          (insert (apply #'format "\n| | %s | %s |" line)))
+        (when backlink-lines ; only print closing hline when there's something to close
+          (insert "\n|---|"))))
+    (org-table-align)))
+
+(defun db/org-insert-backlink-block ()
+  "Create dynamic block of backlinks to current item or any of its parents."
+  (interactive)
+  (org-create-dblock
+   (list :name "db/org-backlinks"
+         :org-ql-match '(todo)))
+  (org-update-dblock))
 
-;; TODO: function to return links to all backlinks of self and parents
+(org-dynamic-block-define "db/org-backlinks" #'db/org-insert-backlink-block)
 
 
 ;;; End