Add function to return list of Org items linking to item at point

This function is not meant for interactive use, but instead should be used in
source blocks such as

```
(db/org-backlinks-to-item-at-point)
```

This will add a table of all items linking to the current item at point, and cut
be used in item templates, for example.

Background: I tried to achive this functionality with `org-ql` directly, but
somehow failed.  This function simply encapsulates the corresponding call to
`org-ql-query`, adding the ID property of item at point automatically.
This commit is contained in:
Daniel - 2022-04-16 09:58:46 +02:00
parent 5576b363cb
commit 1d5f318b5b
No known key found for this signature in database
GPG Key ID: 1C7071A75BB72D64
1 changed files with 36 additions and 0 deletions

View File

@ -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")
@ -949,6 +950,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