Simplify code searching for backlinks

Reduce the conditional parts and extract common code.

site-lisp/db-org.el

@@ -16,6 +16,7 @@
 (require 'hydra)
 (require 'db-customize)
 (require 'ox-icalendar)
+(require 'org-ql)
 
 (autoload 'counsel-org-goto-all "counsel")
 (autoload 'which-function "which-func")
@@ -813,11 +814,11 @@ not."
 (defun db/org-get-location (&optional arg)
   "Interactively query for location and return mark.
 
-Searches through the current buffer if that one is associated
+Searches through the current buffer if that one is an Org buffer
-with a file, or `db/org-default-org-file'.  When ARG is non-nil,
+and is associated with a file, or `db/org-default-org-file'.
-search through all files in the variables `org-agenda-files',
+When ARG is non-nil, search through all files in the variables
-`org-agenda-text-search-extra-files', and the current file or
+`org-agenda-files', `org-agenda-text-search-extra-files', and the
-`db/org-default-org-file'.
+current file or `db/org-default-org-file'.
 
 Search is always conducted up to level 9.  If the selected
 location does not have an associated point or mark, error out.
@@ -825,9 +826,10 @@ Disable refile cache and any active refile filter hooks to allow
 linking to any item."
   (let ((org-refile-target-verify-function nil)
         (org-refile-use-cache nil)
-        ;; If the current buffer is associated with a file, search through it;
+        ;; If the current buffer is an Org buffer and is associated with a file,
-        ;; otherwise, use the default Org Mode file as default buffer
+        ;; search through it; otherwise, use the default Org Mode file as
-        (default-buffer (if (buffer-file-name)
+        ;; default buffer
+        (default-buffer (if (and (buffer-file-name) (derived-mode-p 'org-mode))
                            (current-buffer)
                          (find-file-noselect db/org-default-org-file))))
     (when (null default-buffer)
@@ -858,19 +860,23 @@ Only links using the ID or CUSTOM_ID property are considered.
 
 If ARG is given, or if neither in an Org Mode buffer nor on a
 headline in an Org Agenda buffer, interactively prompt for an
-item."
+item using `db/org-get-location', which see."
   (interactive "P")
   (apply #'db/org-find-items-linking-by-id
-         (cond ((and (not arg) (derived-mode-p 'org-mode))
+         ;; Determine the current item interactively based on where we are: when
-                (list (org-id-get) (org-entry-get nil "CUSTOM_ID")))
+         ;; in an Org buffer or in Org agenda view, indeed use the item at
-               ((and (not arg)
+         ;; point; otherwise, and when ARG is given, query the user for the item
-                     (derived-mode-p 'org-agenda-mode)
+         ;; to look for.
-                     (org-get-at-bol 'org-hd-marker))
+         (org-with-point-at (cond ((and (not arg)
-                (org-with-point-at (org-get-at-bol 'org-hd-marker)
+                                        (derived-mode-p 'org-mode))
-                  (list (org-id-get) (org-entry-get nil "CUSTOM_ID"))))
+                                   (point))
-               (t
+                                  ((and (not arg)
-                (org-with-point-at (db/org-get-location)
+                                        (derived-mode-p 'org-agenda-mode)
-                  (list (org-id-get) (org-entry-get nil "CUSTOM_ID")))))))
+                                        (org-get-at-bol 'org-hd-marker))
+                                   (org-get-at-bol 'org-hd-marker))
+                                  (t
+                                   (db/org-get-location)))
+           (list (org-id-get) (org-entry-get nil "CUSTOM_ID")))))
 
 (defun db/org-insert-link-to-pom (pom)
   "Insert an Org link to headline at POM.
@@ -949,6 +955,41 @@ Show _b_acklinks to current item."
   ("O" (db/org-add-link-to-other-item t))
   ("b" db/org-find-links-to-current-item))
 
+(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))
+        (org-agenda-text-search-extra-files org-agenda-text-search-extra-files)
+        files)
+
+    (unless id-of-item-at-point
+      (user-error "Item at point does not have an ID property set, cannot determine backlinks"))
+
+    ;; Determine files to search through; ignore `agenda-archive' in
+    ;; `org-agenda-text-search-extra-files', as we already handle this when
+    ;; calling `org-agenda-files'.
+    (setq files (org-agenda-files t archives))
+    (when (eq (car org-agenda-text-search-extra-files) 'agenda-archives)
+      (pop org-agenda-text-search-extra-files))
+    (setq files (nconc files org-agenda-text-search-extra-files))
+
+    (org-ql-query :select '(list (org-link-make-string (format "id:%s" (org-id-get-create))
+                                                       (org-entry-get (point) "ITEM")))
+                  :from files
+                  :where (let ((link-expression `(link :target ,id-of-item-at-point)))
+                           (if org-ql-match
+                               `(and ,link-expression ,org-ql-match)
+                             link-expression)))))
+
 
 ;;; End