[PATCH] org-id: allow using parent's existing id in links to headlines

["Rick Lupton" <mail@ricklupton.name>]

[-- Attachment #1: Type: text/plain, Size: 1335 bytes --]

Hi,

Here is a small new feature for org-id that I have been using and finding useful. The patch adds the option to look for ancestors of the current headline that have an ID defined and use that together with a link search string to link to specific headlines, without needing every single headline to have its own ID.

For example if you have:

#+begin_example
* H1
:PROPERTIES:
:ID: abc
:END:

** H2
<point>Link to here
#+end_example

with `org-id-link-to-org-use-id' set to `t`, the result of org-store-link will be that "H2" has a new id generated, and the link is to that new ID: `[[id:new-id][H2]]`.

Now, with `org-id-link-to-org-use-id' set to `inherit`, "H2" is not modified, and the resulting link is `[[id:abc::*H2][H2]]`, which will still take you to the same place as long as the sub-heading is unique within the parent heading with an ID.

As an example, I find this useful in situations like this:

#+begin_example
* Project 1
:PROPERTIES:
:ID: project-1
:END:

** <2023-07-01> Meeting A
** <2023-07-08> Meeting B
** <2023-07-15> Meeting C
#+end_example

... so that I can link to specific meetings without needing every one to have its own org ID.

Feedback on the patch welcome. If you would like to merge this I will (I assume) need to sort out FSF copyright assignment and update ORG-NEWS and the manual.

Best
Rick

[-- Attachment #2: 0001-lisp-org-id.el-Allow-using-a-parent-s-existing-id.patch --]
[-- Type: application/octet-stream, Size: 8328 bytes --]

From 99b439865b214ecfbbb2b6685ed7782293c157c1 Mon Sep 17 00:00:00 2001
From: Rick Lupton <mail@ricklupton.name>
Date: Mon, 24 Jul 2023 12:29:30 +0100
Subject: [PATCH] lisp/org-id.el: Allow using a parent's existing id

* lisp/ol.el (org-store-link): When `org-id-link-to-org-use-id` is
`inherit`, look for existing IDs on ancestors of the current headline,
and use a link search string to find the current headline within that
ancestor.
* lisp/org-id.el (org-id-link-to-org-use-id): Introduce new `inherit`
value.
(org-id-get-create, org-id-get, org-id-store-link): Add optional
`inherit` argument which considers parents' IDs if the current entry
does not have one.
* testing/lisp/test-ol.el: Add test for `org-id-link-to-org-use-id` set
to `inherit`.

This feature allows for more precise links when using org-id to link to
org headings, without requiring every single headline to have an id.
---
 lisp/ol.el              | 38 +++++++++++++++++++++++++++++++++++++-
 lisp/org-id.el          | 27 +++++++++++++++++++--------
 testing/lisp/test-ol.el | 20 ++++++++++++++++++++
 3 files changed, 76 insertions(+), 9 deletions(-)

diff --git a/lisp/ol.el b/lisp/ol.el
index 3a8ca5f39..2e863e47b 100644
--- a/lisp/ol.el
+++ b/lisp/ol.el
@@ -63,7 +63,7 @@
 (declare-function org-find-property "org" (property &optional value))
 (declare-function org-get-heading "org" (&optional no-tags no-todo no-priority no-comment))
 (declare-function org-id-find-id-file "org-id" (id))
-(declare-function org-id-store-link "org-id" ())
+(declare-function org-id-store-link "org-id" (&optional inherit))
 (declare-function org-insert-heading "org" (&optional arg invisible-ok top))
 (declare-function org-load-modules-maybe "org" (&optional force))
 (declare-function org-mark-ring-push "org" (&optional pos buffer))
@@ -1700,6 +1700,42 @@ non-nil."
 			 (concat "file:"
 				 (abbreviate-file-name
 				  (buffer-file-name (buffer-base-buffer))))))))
+	  ((and (featurep 'org-id)
+            (eq org-id-link-to-org-use-id 'inherit))
+           ;; Store a link using the inherited ID and search string
+           (setq cpltxt (condition-case nil
+                            (prog1 (org-id-store-link 'inherit)
+                              (setq desc (plist-get org-store-link-plist :description)))
+                          (error
+                           ;; Probably before first headline, link only to file
+                           (concat "file:"
+                                   (abbreviate-file-name
+                                    (buffer-file-name (buffer-base-buffer)))))))
+           ;; Add a context search string, limited by current region
+           (when (org-xor org-link-context-for-files (equal arg '(4)))
+             (let* ((element (org-element-at-point))
+                    (name (org-element-property :name element))
+                    (context
+                     (cond
+                      ((let ((region (org-link--context-from-region)))
+                         (and region (org-link--normalize-string region t))))
+                      (name)
+                      ((org-before-first-heading-p)
+                       (org-link--normalize-string (org-current-line-string) t))
+                      (t (org-link-heading-search-string)))))
+               (when (org-string-nw-p context)
+                 (setq cpltxt (format "%s::%s" cpltxt context))
+                 (setq desc
+                       (or name
+                           ;; Although description is not a search
+                           ;; string, use `org-link--normalize-string'
+                           ;; to prettify it (contiguous white spaces)
+                           ;; and remove volatile contents (statistics
+                           ;; cookies).
+                           (and (not (org-before-first-heading-p))
+                                (org-link--normalize-string
+                                 (org-get-heading t t t t)))
+                           "NONE"))))))
 	  (t
 	   ;; Just link to current headline.
 	   (setq cpltxt (concat "file:"
diff --git a/lisp/org-id.el b/lisp/org-id.el
index dae3a0ca8..7b57c8289 100644
--- a/lisp/org-id.el
+++ b/lisp/org-id.el
@@ -114,6 +114,10 @@ create-if-interactive-and-no-custom-id
 use-existing
       Use existing ID, do not create one.
 
+inherit
+      Use existing ID from a parent headline, and use a text
+      search to find this headline within it.
+
 nil   Never use an ID to make a link, instead link using a text search for
       the headline text."
   :group 'org-link-store
@@ -255,14 +259,17 @@ This variable is only relevant when `org-id-track-globally' is set."
 ;;; The API functions
 
 ;;;###autoload
-(defun org-id-get-create (&optional force)
+(defun org-id-get-create (&optional force inherit)
   "Create an ID for the current entry and return it.
 If the entry already has an ID, just return it.
-With optional argument FORCE, force the creation of a new ID."
+With optional argument FORCE, force the creation of a new ID.
+With optional argument INHERIT, consider parents' IDs if the
+current entry does not have one."
   (interactive "P")
   (when force
-    (org-entry-put (point) "ID" nil))
-  (org-id-get (point) 'create))
+    (org-entry-put (point) "ID" nil)
+    (setq inherit nil))
+  (org-id-get (point) 'create nil inherit))
 
 ;;;###autoload
 (defun org-id-copy ()
@@ -277,15 +284,16 @@ This is useful when working with contents in a temporary buffer
 that will be copied back to the original.")
 
 ;;;###autoload
-(defun org-id-get (&optional epom create prefix)
+(defun org-id-get (&optional epom create prefix inherit)
   "Get the ID property of the entry at EPOM.
 EPOM is an element, marker, or buffer position.
 If EPOM is nil, refer to the entry at point.
 If the entry does not have an ID, the function returns nil.
+If INHERIT is non-nil, parents' IDs are also considered.
 However, when CREATE is non-nil, create an ID if none is present already.
 PREFIX will be passed through to `org-id-new'.
 In any case, the ID of the entry is returned."
-  (let ((id (org-entry-get epom "ID")))
+  (let ((id (org-entry-get epom "ID" inherit)))
     (cond
      ((and id (stringp id) (string-match "\\S-" id))
       id)
@@ -680,14 +688,17 @@ optional argument MARKERP, return the position as a new marker."
 ;; so we do have to add it to `org-store-link-functions'.
 
 ;;;###autoload
-(defun org-id-store-link ()
+(defun org-id-store-link (&optional inherit)
   "Store a link to the current entry, using its ID.
 
+If INHERIT is non-nil, consider also parents' IDs if the current
+entry does not have an ID.
+
 If before first heading store first title-keyword as description
 or filename if no title."
   (interactive)
   (when (and (buffer-file-name (buffer-base-buffer)) (derived-mode-p 'org-mode))
-    (let* ((link (concat "id:" (org-id-get-create)))
+    (let* ((link (concat "id:" (org-id-get-create nil inherit)))
 	   (case-fold-search nil)
 	   (desc (save-excursion
 		   (org-back-to-heading-or-point-min t)
diff --git a/testing/lisp/test-ol.el b/testing/lisp/test-ol.el
index a38d9f979..7a4d9999a 100644
--- a/testing/lisp/test-ol.el
+++ b/testing/lisp/test-ol.el
@@ -381,6 +381,26 @@ See https://github.com/yantar92/org/issues/4."
 	 (equal (format "[[file:%s::*foo bar][foo bar]]" file file)
 		(org-store-link nil)))))))
 
+(ert-deftest test-org-link/store-link-with-id ()
+  "Test `org-store-link' specifications with org-id."
+  ;; On a headline, link to that headline's ID.  Use heading as the
+  ;; description of the link.
+  (should
+   (let ((org-stored-links nil)
+         (org-id-link-to-org-use-id t))
+     (org-test-with-temp-text-in-file "* H1\n:PROPERTIES:\n:ID: abc\n:END:\n"
+        (equal "[[id:abc][H1]]"
+               (org-store-link nil)))))
+  ;; On a headline without an ID, link to that headline's parent's ID,
+  ;; with the current headline as context.  Use heading as the
+  ;; description of the link.
+  (should
+   (let ((org-stored-links nil)
+         (org-id-link-to-org-use-id 'inherit))
+     (org-test-with-temp-text-in-file "* H1\n:PROPERTIES:\n:ID: abc\n:END:\n** H2\n** H3<point>\n** H4\n"
+       (let ((link (org-store-link nil)))
+         (equal link "[[id:abc::*H3][H3]]"))))))
+
 \f
 ;;; Radio Targets
 
-- 
2.37.1 (Apple Git-137.1)