emacs-orgmode@gnu.org archives
 help / color / mirror / code / Atom feed
From: "Rick Lupton" <mail@ricklupton.name>
To: "Ihor Radchenko" <yantar92@posteo.net>
Cc: "emacs-orgmode list" <emacs-orgmode@gnu.org>
Subject: Re: [PATCH] org-id: allow using parent's existing id in links to headlines
Date: Sun, 19 Nov 2023 15:21:09 +0000	[thread overview]
Message-ID: <e66407c2-cd4f-4cb8-b933-4fd036b8d94a@app.fastmail.com> (raw)
In-Reply-To: <87cywh2ad6.fsf@localhost>

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

Here's an updated patch, which adds (optional) search strings to ID links, and the option to inherit ID targets from parent headline / the top level file properties.  I've also updated ORG-NEWS and the manual, and added tests.

I think I've fixed all the issues with my first patch about which headline gets used for the description when inheriting IDs, what happens if there is no ID, etc.

> Ideally, we should have all the necessary logic to store the link within `org-id-store-link' and then use `org-link-set-parameters' to configure id links.
> ...
> I think that we need to make a change in the rules for :store functions. `interactive?' may be passed as the argument to these functions.

I've also moved the org-id specific logic from `org-store-link` to `org-id-store-link`, and added the `interactive?` argument to link store functions as discussed.

>> So my question is: should search strings be added to all org-id links?
> Sounds as a reasonable default, but users should have an option to revert to previous behaviour with heading id being stored.

The default value for the new option `org-id-link-use-context` is `t`, but it can be set to `nil` (or disabled with a prefix argument to `org-store-link` temporarily).  This is a change in default behaviour when storing ID links with point at a subheading, named block, or target, or with an active region.

The option `org-id-link-consider-parent-id` I've left with a default value of `nil`, since I'm not sure if everyone will want this behaviour.

Thanks
Rick

[-- Attachment #2: 0001-org-id.el-Extend-links-with-search-strings-inherit-p.patch --]
[-- Type: application/octet-stream, Size: 38990 bytes --]

From b94cd1beba9b54ae23947d59e6a5cdc77fb2640e Mon Sep 17 00:00:00 2001
From: Rick Lupton <mail@ricklupton.name>
Date: Sun, 19 Nov 2023 14:52:05 +0000
Subject: [PATCH] org-id.el: Extend links with search strings, inherit parent
 IDs

* lisp/ol.el (org-store-link): Refactor org-id links to use standard
`org-store-link-functions'.
(org-link-precise-link-target): New function extracting logic to
identify a precise link target, e.g. a heading, named object, or text
search.
(org-link-try-link-store-functions): Extract logic to call external
link store functions. Pass them a new `interactive?' argument.
* lisp/org-id.el (org-id-link-consider-parent-id): New option to allow
a parent heading with an id to be considered as a link target.
(org-id-link-use-context): New option equivalent to
`org-link-context-for-files`, but for org-id links.
(org-id-get-create, org-id-get): Add optional `inherit' argument which
considers parents' IDs if the current entry does not have one.
(org-id-store-link): Move logic from `org-store-link' here to
determine when an org-id link should be stored. Consider IDs of parent
headings as link targets when current heading has no ID and
`org-id-link-consider-parent-id' is set. Add a search string to the
link when enabled.
(org-id-open): Recognise search strings after "::" in org-id links.
* testing/lisp/test-ol.el: Add tests for
`org-link-precise-link-target' and `org-id-store-link' functions,
testing new options.
* doc/org-manual.org: Update documentation about links.
* etc/ORG-NEWS: Document changes and new options.

These feature allows for more precise links when using org-id to link to
org headings, without requiring every single headline to have an id.

Link: https://list.orgmode.org/118435e8-0b20-46fd-af6a-88de8e19fac6@app.fastmail.com/
---
 doc/org-manual.org      | 118 +++++++++++++-----------
 etc/ORG-NEWS            |  33 +++++++
 lisp/ol.el              | 198 ++++++++++++++++++++++++----------------
 lisp/org-id.el          |  96 ++++++++++++++++---
 testing/lisp/test-ol.el | 134 +++++++++++++++++++++++++++
 5 files changed, 433 insertions(+), 146 deletions(-)

diff --git a/doc/org-manual.org b/doc/org-manual.org
index 85568e7ab..eedaf365a 100644
--- a/doc/org-manual.org
+++ b/doc/org-manual.org
@@ -3296,10 +3296,6 @@ Here is the full set of built-in link types:
 
   File links.  File name may be remote, absolute, or relative.
 
-  Additionally, you can specify a line number, or a text search.
-  In Org files, you may link to a headline name, a custom ID, or a
-  code reference instead.
-
   As a special case, "file" prefix may be omitted if the file name
   is complete, e.g., it starts with =./=, or =/=.
 
@@ -3363,44 +3359,50 @@ Here is the full set of built-in link types:
 
   Execute a shell command upon activation.
 
+
+For =file:= and =id:= links, you can additionally specify a line
+number, or a text search string, separated by =::=.  In Org files, you
+may link to a headline name, a custom ID, or a code reference instead.
+
 The following table illustrates the link types above, along with their
 options:
 
-| Link Type  | Example                                                  |
-|------------+----------------------------------------------------------|
-| http       | =http://staff.science.uva.nl/c.dominik/=                 |
-| https      | =https://orgmode.org/=                                   |
-| doi        | =doi:10.1000/182=                                        |
-| file       | =file:/home/dominik/images/jupiter.jpg=                  |
-|            | =/home/dominik/images/jupiter.jpg= (same as above)       |
-|            | =file:papers/last.pdf=                                   |
-|            | =./papers/last.pdf= (same as above)                      |
-|            | =file:/ssh:me@some.where:papers/last.pdf= (remote)       |
-|            | =/ssh:me@some.where:papers/last.pdf= (same as above)     |
-|            | =file:sometextfile::NNN= (jump to line number)           |
-|            | =file:projects.org=                                      |
-|            | =file:projects.org::some words= (text search)[fn:12]     |
-|            | =file:projects.org::*task title= (headline search)       |
-|            | =file:projects.org::#custom-id= (headline search)        |
-| attachment | =attachment:projects.org=                                |
-|            | =attachment:projects.org::some words= (text search)      |
-| docview    | =docview:papers/last.pdf::NNN=                           |
-| id         | =id:B7423F4D-2E8A-471B-8810-C40F074717E9=                |
-| news       | =news:comp.emacs=                                        |
-| mailto     | =mailto:adent@galaxy.net=                                |
-| mhe        | =mhe:folder= (folder link)                               |
-|            | =mhe:folder#id= (message link)                           |
-| rmail      | =rmail:folder= (folder link)                             |
-|            | =rmail:folder#id= (message link)                         |
-| gnus       | =gnus:group= (group link)                                |
-|            | =gnus:group#id= (article link)                           |
-| bbdb       | =bbdb:R.*Stallman= (record with regexp)                  |
-| irc        | =irc:/irc.com/#emacs/bob=                                |
-| help       | =help:org-store-link=                                    |
-| info       | =info:org#External links=                                |
-| shell      | =shell:ls *.org=                                         |
-| elisp      | =elisp:(find-file "Elisp.org")= (Elisp form to evaluate) |
-|            | =elisp:org-agenda= (interactive Elisp command)           |
+| Link Type  | Example                                                            |
+|------------+--------------------------------------------------------------------|
+| http       | =http://staff.science.uva.nl/c.dominik/=                           |
+| https      | =https://orgmode.org/=                                             |
+| doi        | =doi:10.1000/182=                                                  |
+| file       | =file:/home/dominik/images/jupiter.jpg=                            |
+|            | =/home/dominik/images/jupiter.jpg= (same as above)                 |
+|            | =file:papers/last.pdf=                                             |
+|            | =./papers/last.pdf= (same as above)                                |
+|            | =file:/ssh:me@some.where:papers/last.pdf= (remote)                 |
+|            | =/ssh:me@some.where:papers/last.pdf= (same as above)               |
+|            | =file:sometextfile::NNN= (jump to line number)                     |
+|            | =file:projects.org=                                                |
+|            | =file:projects.org::some words= (text search)[fn:12]               |
+|            | =file:projects.org::*task title= (headline search)                 |
+|            | =file:projects.org::#custom-id= (headline search)                  |
+| attachment | =attachment:projects.org=                                          |
+|            | =attachment:projects.org::some words= (text search)                |
+| docview    | =docview:papers/last.pdf::NNN=                                     |
+| id         | =id:B7423F4D-2E8A-471B-8810-C40F074717E9=                          |
+|            | =id:B7423F4D-2E8A-471B-8810-C40F074717E9::*task= (headline search) |
+| news       | =news:comp.emacs=                                                  |
+| mailto     | =mailto:adent@galaxy.net=                                          |
+| mhe        | =mhe:folder= (folder link)                                         |
+|            | =mhe:folder#id= (message link)                                     |
+| rmail      | =rmail:folder= (folder link)                                       |
+|            | =rmail:folder#id= (message link)                                   |
+| gnus       | =gnus:group= (group link)                                          |
+|            | =gnus:group#id= (article link)                                     |
+| bbdb       | =bbdb:R.*Stallman= (record with regexp)                            |
+| irc        | =irc:/irc.com/#emacs/bob=                                          |
+| help       | =help:org-store-link=                                              |
+| info       | =info:org#External links=                                          |
+| shell      | =shell:ls *.org=                                                   |
+| elisp      | =elisp:(find-file "Elisp.org")= (Elisp form to evaluate)           |
+|            | =elisp:org-agenda= (interactive Elisp command)                     |
 
 #+cindex: VM links
 #+cindex: Wanderlust links
@@ -3461,8 +3463,9 @@ current buffer:
 - /Org mode buffers/ ::
 
   For Org files, if there is a =<<target>>= at point, the link points
-  to the target.  Otherwise it points to the current headline, which
-  is also the description.
+  to the target.  If there is a named block (using =#+name:=) at
+  point, the link points to that name.  Otherwise it points to the
+  current headline, which is also the description.
 
   #+vindex: org-id-link-to-org-use-id
   #+cindex: @samp{CUSTOM_ID}, property
@@ -3480,6 +3483,13 @@ current buffer:
   timestamp, depending on ~org-id-method~.  Later, when inserting the
   link, you need to decide which one to use.
 
+  #+vindex: org-id-link-consider-parent-id
+  When ~org-id-link-consider-parent-id~ is ~t~, parent =ID= properties
+  are considered.  This allows linking to specific targets, named
+  blocks, or headlines (which may not have a globally unique =ID=
+  themselves) within the context of a parent headline or file which
+  does.
+
 - /Email/News clients: VM, Rmail, Wanderlust, MH-E, Gnus/ ::
 
   #+vindex: org-link-email-description-format
@@ -3753,13 +3763,15 @@ the link completion function like this:
 (org-link-set-parameter "type" :complete #'some-completion-function)
 #+end_src
 
-** Search Options in File Links
+** Search Options in File and ID Links
 :PROPERTIES:
 :DESCRIPTION: Linking to a specific location.
 :ALT_TITLE: Search Options
 :END:
 #+cindex: search option in file links
+#+cindex: search option in id links
 #+cindex: file links, searching
+#+cindex: id links, searching
 #+cindex: attachment links, searching
 
 File links can contain additional information to make Emacs jump to a
@@ -3771,8 +3783,8 @@ example, when the command ~org-store-link~ creates a link (see
 line as a search string that can be used to find this line back later
 when following the link with {{{kbd(C-c C-o)}}}.
 
-Note that all search options apply for Attachment links in the same
-way that they apply for File links.
+Note that all search options apply for Attachment and ID links in the
+same way that they apply for File links.
 
 Here is the syntax of the different ways to attach a search to a file
 link, together with explanations for each:
@@ -21177,7 +21189,7 @@ The following =ol-man.el= file implements it
 PATH should be a topic that can be thrown at the man command."
   (funcall org-man-command path))
 
-(defun org-man-store-link ()
+(defun org-man-store-link (&optional _interactive?)
   "Store a link to a man page."
   (when (memq major-mode '(Man-mode woman-mode))
     ;; This is a man page, we do make this link.
@@ -21237,13 +21249,15 @@ A review of =ol-man.el=:
 
    For example, ~org-man-store-link~ is responsible for storing a link
    when ~org-store-link~ (see [[*Handling Links]]) is called from a buffer
-   displaying a man page.  It first checks if the major mode is
-   appropriate.  If check fails, the function returns ~nil~, which
-   means it isn't responsible for creating a link to the current
-   buffer.  Otherwise the function makes a link string by combining
-   the =man:= prefix with the man topic.  It also provides a default
-   description.  The function ~org-insert-link~ can insert it back
-   into an Org buffer later on.
+   displaying a man page.  It is passed an argument ~interactive?~
+   which this function does not use, but other store functions use to
+   behave differently when a link is stored interactively by the user.
+   It first checks if the major mode is appropriate.  If check fails,
+   the function returns ~nil~, which means it isn't responsible for
+   creating a link to the current buffer.  Otherwise the function
+   makes a link string by combining the =man:= prefix with the man
+   topic.  It also provides a default description.  The function
+   ~org-insert-link~ can insert it back into an Org buffer later on.
 
 ** Adding Export Backends
 :PROPERTIES:
diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS
index 19117821a..6c6171dc7 100644
--- a/etc/ORG-NEWS
+++ b/etc/ORG-NEWS
@@ -229,6 +229,12 @@ timestamp object.  Possible values: ~timerange~, ~daterange~, ~nil~.
 ~org-element-timestamp-interpreter~ takes into account this property
 and returns an appropriate timestamp string.
 
+**** =org-link= store functions are passed an ~interactive?~ argument
+
+The ~:store:~ functions set for link types using
+~org-link-set-parameters~ are now passed an ~interactive?~ argument,
+indicating whether ~org-store-link~ was called interactively.
+
 *** ~org-priority=show~ command no longer adjusts for scheduled/deadline
 
 In agenda views, ~org-priority=show~ command previously displayed the
@@ -307,6 +313,17 @@ The change is breaking when ~org-use-property-inheritance~ is set to ~t~.
 *** ~org-babel-lilypond-compile-lilyfile~ ignores optional second argument
 
 The =TEST= parameter is better served by Emacs debugging tools.
+
+*** ~org-id-store-link~ now adds search strings for precise link targets
+
+Previously, search strings are supported for =file:= links but not for
+=id:= links.  This change adds support for search strings to =id:=
+links.
+
+This new behaviour can be disabled generally by setting
+~org-id-link-use-context~ to ~nil~, or when storing a specific link by
+passing a prefix argument to ~org-store-link~.
+
 ** New and changed options
 *** New variable ~org-clock-out-removed-last-clock~
 
@@ -485,6 +502,22 @@ Currently implemented options are:
   tasks this technically violates the iCalendar spec, but some
   iCalendar programs support this usage.
 
+*** New option ~org-id-link-consider-parent-id~ to allow =id:= links to parent headlines
+
+For =id:= links, when this option is enabled, ~org-store-link~ will
+look for ids from parent/ancestor headlines, if the current headline
+does not have an id.
+
+Combined with the new ability for =id:= links to use search strings
+for precise link targets (when =org-id-link-use-context= is =t=, which
+is the default), this allows linking to specific headlines without
+requiring every headline to have an id property, as long as the
+headline is unique within a subtree that does have an id property.
+
+By giving files top-level id properties, links to headlines in the
+file can be made more robust by using the file id instead of the file
+path.
+
 ** New features
 *** =ob-plantuml.el=: Support tikz file format output
 
diff --git a/lisp/ol.el b/lisp/ol.el
index e684b9504..e5938ee13 100644
--- a/lisp/ol.el
+++ b/lisp/ol.el
@@ -63,7 +63,6 @@
 (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-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))
@@ -819,6 +818,46 @@ spec."
     (not (org-in-regexp org-link-any-re))))
 
 \f
+(defun org-link--try-link-store-functions (interactive?)
+  "Try storing external links, prompting if more than one is possible.
+
+Each function returned by `org-store-link-functions` is called in
+turn. If multiple functions return non-nil, prompt for which link
+should be stored.
+
+Return t if a function has successfully stored a link, which will
+be stored in `org-link-store-props`.
+"
+  (let ((results-alist nil))
+    (dolist (f (org-store-link-functions))
+      (when (condition-case nil
+                (funcall f interactive?)
+              ;; XXX: The store function used (< Org 9.7) to accept no
+              ;; arguments; provide backward compatibility support for
+              ;; them.
+              (wrong-number-of-arguments
+               (funcall f)))
+        ;; XXX: return value is not link's plist, so we
+        ;; store the new value before it is modified.  It
+        ;; would be cleaner to ask store link functions to
+        ;; return the plist instead.
+        (push (cons f (copy-sequence org-store-link-plist))
+              results-alist)))
+    (pcase results-alist
+      (`nil nil)
+      (`((,_ . ,_)) t)	;single choice: nothing to do
+      (`((,name . ,_) . ,_)
+       ;; Reinstate link plist associated to the chosen
+       ;; function.
+       (apply #'org-link-store-props
+              (cdr (assoc-string
+                    (completing-read
+                     (format "Store link with (default %s): " name)
+                     (mapcar #'car results-alist)
+                     nil t nil nil (symbol-name name))
+                    results-alist)))
+       t))))
+
 ;;; Public API
 
 (defun org-link-types ()
@@ -1334,6 +1373,57 @@ priority cookie or tag."
 	  (org-link--normalize-string
 	   (or string (org-get-heading t t t t)))))
 
+(defun org-link-precise-link-target (&optional relative-to)
+  "Determine search string and description for storing a link.
+
+If a search string is found, return cons cell `(search-string
+. desc)`.  Otherwise, return nil.
+
+If there is an active region, the contents is used (see
+`org-link--context-from-region`).
+
+In org-mode buffers, if point is at a named element (e.g. a
+source block), the name is used. If within a heading, the current
+heading is used.
+
+If none of those finds a suitable search string, the current line
+is used as the search string.
+
+Optional argument RELATIVE-TO specifies the buffer position where
+the search will start from.  If the search target that would be
+returned is already at this location, return nil to avoid
+unnecessary search strings (for example, when using search
+strings to find targets within org-id links)."
+  (let ((result
+         (cond
+          ((derived-mode-p 'org-mode)
+           (let* ((element (org-element-at-point))
+                  (name (org-element-property :name element))
+                  (heading (org-element-lineage element 'headline t)))
+             (cond
+              ((let ((region (org-link--context-from-region)))
+                 (and region (cons (org-link--normalize-string region t) nil))))
+              (name
+               (cons name name))
+              ((org-before-first-heading-p)
+               (cons (org-link--normalize-string (org-current-line-string) t) nil))
+              ((and heading
+                    (> (org-element-begin heading) (or relative-to 0)))
+               (cons (org-link-heading-search-string)
+                     (org-link--normalize-string
+                      (org-get-heading t t t t)))))))
+
+          ;; Not in an org-mode buffer
+          (t
+           (cons (org-link--normalize-string
+                  (or (org-link--context-from-region) (org-current-line-string))
+                  t)
+                 nil)))))
+
+    ;; Only use search option if there is some text.
+    (when (org-string-nw-p (car result))
+      result)))
+
 (defun org-link-open-as-file (path in-emacs)
   "Pretend PATH is a file name and open it.
 
@@ -1560,29 +1650,7 @@ non-nil."
        ;; available. If more than one can generate a link from current
        ;; location, ask which one to use.
        ((and (not (equal arg '(16)))
-	     (let ((results-alist nil))
-	       (dolist (f (org-store-link-functions))
-		 (when (funcall f)
-		   ;; XXX: return value is not link's plist, so we
-		   ;; store the new value before it is modified.  It
-		   ;; would be cleaner to ask store link functions to
-		   ;; return the plist instead.
-		   (push (cons f (copy-sequence org-store-link-plist))
-			 results-alist)))
-	       (pcase results-alist
-		 (`nil nil)
-		 (`((,_ . ,_)) t)	;single choice: nothing to do
-		 (`((,name . ,_) . ,_)
-		  ;; Reinstate link plist associated to the chosen
-		  ;; function.
-		  (apply #'org-link-store-props
-			 (cdr (assoc-string
-			       (completing-read
-                                (format "Store link with (default %s): " name)
-                                (mapcar #'car results-alist)
-                                nil t nil nil (symbol-name name))
-			       results-alist)))
-		  t))))
+	     (org-link--try-link-store-functions interactive?))
 	(setq link (plist-get org-store-link-plist :link))
         ;; If store function actually set `:description' property, use
         ;; it, even if it is nil.  Otherwise, fallback to nil (ask user).
@@ -1634,6 +1702,7 @@ non-nil."
 	    (org-with-point-at m
 	      (setq agenda-link (org-store-link nil interactive?))))))
 
+       ;; Calendar mode
        ((eq major-mode 'calendar-mode)
 	(let ((cd (calendar-cursor-to-date)))
 	  (setq link
@@ -1642,6 +1711,7 @@ non-nil."
 		 (org-encode-time 0 0 0 (nth 1 cd) (nth 0 cd) (nth 2 cd))))
 	  (org-link-store-props :type "calendar" :date cd)))
 
+       ;; Image mode
        ((eq major-mode 'image-mode)
 	(setq cpltxt (concat "file:"
 			     (abbreviate-file-name buffer-file-name))
@@ -1659,12 +1729,20 @@ non-nil."
 	  (setq cpltxt (concat "file:" file)
 		link cpltxt)))
 
+       ;; Try `org-create-file-search-functions`.  If any are
+       ;; successful, create a file link to the current buffer with
+       ;; the provided search string.  (sets `link` and `cpltxt` to
+       ;; the same thing; it looks like the intention originally was
+       ;; that cpltxt was a description, which might have been set by
+       ;; the search-function (removed in switch to lexical binding)).
        ((setq search (run-hook-with-args-until-success
 		      'org-create-file-search-functions))
 	(setq link (concat "file:" (abbreviate-file-name buffer-file-name)
 			   "::" search))
 	(setq cpltxt (or link))) ;; description
 
+       ;; Main logic for storing built-in link types in org-mode
+       ;; buffers
        ((and (buffer-file-name (buffer-base-buffer)) (derived-mode-p 'org-mode))
 	(org-with-limited-levels
 	 (setq custom-id (org-entry-get nil "CUSTOM_ID"))
@@ -1684,71 +1762,33 @@ non-nil."
                  desc nil
                  ;; Do not append #CUSTOM_ID link below.
                  custom-id nil))
-	  ((and (featurep 'org-id)
-		(or (eq org-id-link-to-org-use-id t)
-		    (and interactive?
-			 (or (eq org-id-link-to-org-use-id 'create-if-interactive)
-			     (and (eq org-id-link-to-org-use-id
-				      'create-if-interactive-and-no-custom-id)
-				  (not custom-id))))
-		    (and org-id-link-to-org-use-id (org-entry-get nil "ID"))))
-	   ;; Store a link using the ID at point
-	   (setq link (condition-case nil
-			  (prog1 (org-id-store-link)
-			    (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))))))))
-	  (t
+          (t
 	   ;; Just link to current headline.
 	   (setq cpltxt (concat "file:"
 				(abbreviate-file-name
 				 (buffer-file-name (buffer-base-buffer)))))
-	   ;; Add a context search string.
-	   (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")))))
-	   (setq link cpltxt)))))
-
+           (when (org-xor org-link-context-for-files (equal arg '(4)))
+             (pcase (org-link-precise-link-target)
+               (`nil nil)
+               (`(,search-string . ,search-desc)
+                (setq cpltxt (format "%s::%s" cpltxt search-string))
+                (setq desc search-desc))))
+           (setq link cpltxt)))))
+
+       ;; Buffer linked to file, but not an org-mode buffer.
        ((buffer-file-name (buffer-base-buffer))
 	;; Just link to this file here.
 	(setq cpltxt (concat "file:"
 			     (abbreviate-file-name
 			      (buffer-file-name (buffer-base-buffer)))))
 	;; Add a context search string.
-	(when (org-xor org-link-context-for-files (equal arg '(4)))
-	  (let ((context (org-link--normalize-string
-			  (or (org-link--context-from-region)
-			      (org-current-line-string))
-			  t)))
-	    ;; Only use search option if there is some text.
-	    (when (org-string-nw-p context)
-	      (setq cpltxt (format "%s::%s" cpltxt context))
-	      (setq desc "NONE"))))
-	(setq link cpltxt))
+        (when (org-xor org-link-context-for-files (equal arg '(4)))
+          (pcase (org-link-precise-link-target)
+            (`nil nil)
+            (`(,search-string . ,search-desc)
+             (setq cpltxt (format "%s::%s" cpltxt search-string))
+             (setq desc search-desc))))
+        (setq link cpltxt))
 
        (interactive?
 	(user-error "No method for storing a link from this buffer"))
diff --git a/lisp/org-id.el b/lisp/org-id.el
index fbe6a0ed0..784d7cb00 100644
--- a/lisp/org-id.el
+++ b/lisp/org-id.el
@@ -129,6 +129,37 @@ nil   Never use an ID to make a link, instead link using a text search for
 	  (const :tag "Only use existing" use-existing)
 	  (const :tag "Do not use ID to create link" nil)))
 
+(defcustom org-id-link-consider-parent-id nil
+  "Non-nil means storing a link to an Org file will consider parent entry IDs.
+
+Use this with `org-id-link-use-context` set to `t` to allow
+linking to uniquely-named sub-entries within a parent entry with
+an ID, without requiring every sub-entry to have its own ID."
+  :group 'org-link-store
+  :group 'org-id
+  :package-version '(Org . "9.7")
+  :type 'boolean)
+
+(defcustom org-id-link-use-context t
+  "Non-nil means org-id links from `org-id-store-link' contain context.
+\\<org-mode-map>
+A search string is added to the id with \"::\" as separator and
+used to find the context when the link is activated by the
+command `org-open-at-point'.  When this option is t, the entire
+active region is be placed in the search string of the file link.
+If set to a positive integer N, only the first N lines of context
+are stored.
+
+Using a prefix argument to the commands `org-store-link' \
+\(`\\[universal-argument] \\[org-store-link]') or
+`org-id-store-link` negates this setting for the duration of the
+command."
+  :group 'org-link-store
+  :group 'org-id
+  :package-version '(Org . "9.7")
+  :type '(choice boolean integer)
+  :safe (lambda (val) (or (booleanp val) (integerp val))))
+
 (defcustom org-id-uuid-program "uuidgen"
   "The uuidgen program."
   :group 'org-id
@@ -258,14 +289,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 ()
@@ -280,15 +314,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)
@@ -704,17 +739,33 @@ 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 (interactive?)
   "Store a link to the current entry, using its ID.
 
+See also `org-id-link-to-org-use-id`,
+`org-id-link-use-context`,
+`org-id-link-consider-parent-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)))
+  (interactive "p")
+  (when (and (buffer-file-name (buffer-base-buffer))
+             (derived-mode-p 'org-mode)
+             (or (eq org-id-link-to-org-use-id t)
+                 (and interactive?
+                      (or (eq org-id-link-to-org-use-id 'create-if-interactive)
+                          (and (eq org-id-link-to-org-use-id
+                                   'create-if-interactive-and-no-custom-id)
+                               (not (org-entry-get nil "CUSTOM_ID")))))
+                 (and org-id-link-to-org-use-id
+                      (org-entry-get nil "ID" org-id-link-consider-parent-id))))
+    (let* ((link (concat "id:" (org-id-get-create nil org-id-link-consider-parent-id)))
+           (id-location (or (and org-entry-property-inherited-from
+                                 (marker-position org-entry-property-inherited-from))
+                            (save-excursion (org-back-to-heading-or-point-min) (point))))
 	   (case-fold-search nil)
 	   (desc (save-excursion
-		   (org-back-to-heading-or-point-min t)
+                   (goto-char id-location)
                    (cond ((org-before-first-heading-p)
                           (let ((keywords (org-collect-keywords '("TITLE"))))
                             (if keywords
@@ -726,14 +777,25 @@ or filename if no title."
 			      (match-string 4)
 			    (match-string 0)))
                          (t link)))))
+      ;; Prefix to `org-store-link` negates preference from `org-id-link-use-context`.
+      (when (org-xor current-prefix-arg org-id-link-use-context)
+        (pcase (org-link-precise-link-target id-location)
+          (`nil nil)
+          (`(,search-string . ,search-desc)
+           (setq link (concat link "::" search-string))
+           (setq desc search-desc))))
       (org-link-store-props :link link :description desc :type "id")
       link)))
 
 (defun org-id-open (id _)
   "Go to the entry with id ID."
-  (org-mark-ring-push)
-  (let ((m (org-id-find id 'marker))
-	cmd)
+  (let* ((option (and (string-match "::\\(.*\\)\\'" id)
+		      (match-string 1 id)))
+	 (id (if (not option) id
+               (substring id 0 (match-beginning 0))))
+         m cmd)
+    (org-mark-ring-push)
+    (setq m (org-id-find id 'marker))
     (unless m
       (error "Cannot find entry with ID \"%s\"" id))
     ;; Use a buffer-switching command in analogy to finding files
@@ -750,9 +812,13 @@ or filename if no title."
 	(funcall cmd (marker-buffer m)))
     (goto-char m)
     (move-marker m nil)
+    (when option
+      (org-link-search option))
     (org-fold-show-context)))
 
-(org-link-set-parameters "id" :follow #'org-id-open)
+(org-link-set-parameters "id"
+  :follow #'org-id-open
+  :store #'org-id-store-link)
 
 (provide 'org-id)
 
diff --git a/testing/lisp/test-ol.el b/testing/lisp/test-ol.el
index e0cec0854..24d926084 100644
--- a/testing/lisp/test-ol.el
+++ b/testing/lisp/test-ol.el
@@ -381,6 +381,140 @@ 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/precise-link-target ()
+  "Test `org-link-precise-link-target` specifications."
+  (should
+   (equal '("*H1" . "H1")
+          (org-test-with-temp-text "* H1<point>\n* H2\n"
+            (org-link-precise-link-target))))
+  (should
+   (equal '("foo" . "foo")
+          (org-test-with-temp-text "* H1\n#+name: foo<point>\n#+begin_example\nhi\n#+end_example\n"
+            (org-link-precise-link-target))))
+  (should
+   (equal '("Text" . nil)
+          (org-test-with-temp-text "\nText<point>\n* H1\n"
+            (org-link-precise-link-target))))
+  (should
+   (equal nil
+          (org-test-with-temp-text "\n<point>\n* H1\n"
+            (org-link-precise-link-target))))
+  ;; relative to a heading
+  (should
+   (equal nil
+          (org-test-with-temp-text "* H1<point>\n* H2\n"
+            (org-link-precise-link-target 1))))
+  (should
+   (equal '("*H2" . "H2")
+          (org-test-with-temp-text "* H1\n* H2<point>\n"
+            (org-link-precise-link-target 1))))
+  (should
+   (equal nil
+          (org-test-with-temp-text "* H1\n* H2<point>\n"
+            (org-link-precise-link-target 6))))
+  )
+
+(defmacro test-ol-stored-link-with-text (text &rest body)
+  "Return :link and :description from link stored in body."
+  (declare (indent 1))
+  `(let (org-store-link-plist)
+     (org-test-with-temp-text-in-file ,text
+       ,@body
+       (list (plist-get org-store-link-plist :link)
+             (plist-get org-store-link-plist :description)))))
+
+(ert-deftest test-org-link/id-store-link ()
+  "Test `org-id-store-link' specifications."
+  (let ((org-id-link-to-org-use-id nil))
+    (should
+     (equal '(nil nil)
+            (test-ol-stored-link-with-text "* H1\n:PROPERTIES:\n:ID: abc\n:END:\n"
+              (org-id-store-link t)))))
+  ;; On a headline, link to that headline's ID.  Use heading as the
+  ;; description of the link.
+  (let ((org-id-link-to-org-use-id t))
+    (should
+     (equal '("id:abc" "H1")
+            (test-ol-stored-link-with-text "* H1\n:PROPERTIES:\n:ID: abc\n:END:\n"
+              (org-id-store-link t)))))
+  ;; Remove TODO keywords etc from description of the link.
+  (let ((org-id-link-to-org-use-id t))
+    (should
+     (equal '("id:abc" "H1")
+            (test-ol-stored-link-with-text "* TODO [#A] H1 :tag:\n:PROPERTIES:\n:ID: abc\n:END:\n"
+              (org-id-store-link t)))))
+  ;; create-if-interactive
+  (let ((org-id-link-to-org-use-id 'create-if-interactive))
+    (should
+     (equal '("id:abc" "H1")
+            (cl-letf (((symbol-function 'org-id-new)
+                       (lambda (&rest _rest) "abc")))
+              (test-ol-stored-link-with-text "* H1\n"
+                (org-id-store-link t)))))
+    (should
+     (equal '(nil nil)
+            (test-ol-stored-link-with-text "* H1\n"
+              (org-id-store-link nil)))))
+  ;; create-if-interactive-and-no-custom-id
+  (let ((org-id-link-to-org-use-id 'create-if-interactive-and-no-custom-id))
+    (should
+     (equal '("id:abc" "H1")
+            (cl-letf (((symbol-function 'org-id-new)
+                       (lambda (&rest _rest) "abc")))
+              (test-ol-stored-link-with-text "* H1\n"
+                (org-id-store-link t)))))
+    (should
+     (equal '(nil nil)
+            (test-ol-stored-link-with-text "* H1\n:PROPERTIES:\n:CUSTOM_ID: xyz\n:END:\n"
+              (org-id-store-link t))))
+    (should
+     (equal '(nil nil)
+            (test-ol-stored-link-with-text "* H1\n"
+              (org-id-store-link nil))))))
+
+(ert-deftest test-org-link/id-store-link-using-parent ()
+  "Test `org-id-store-link' specifications with `org-id-link-consider-parent-id` set."
+  (let ((org-id-link-to-org-use-id 'use-existing)
+        (org-id-link-consider-parent-id nil))
+    (should
+     (equal '(nil nil)
+            (test-ol-stored-link-with-text "* H1\n:PROPERTIES:\n:ID: abc\n:END:\n** H2\n<point>"
+              (org-id-store-link t)))))
+  ;; when using context to still find specific heading
+  (let ((org-id-link-to-org-use-id 'use-existing)
+        (org-id-link-consider-parent-id t)
+        (org-id-link-use-context t))
+    (should
+     (equal '("id:abc::*H2" "H2")
+            (test-ol-stored-link-with-text "* H1\n:PROPERTIES:\n:ID: abc\n:END:\n** H2\n<point>"
+              (org-id-store-link t))))
+    (should
+     (equal '("id:abc::name" "name")
+            (test-ol-stored-link-with-text "* H1\n:PROPERTIES:\n:ID: abc\n:END:\n\n#+name: name\n<point>#+begin_example\nhi\n#+end_example\n"
+              (org-id-store-link t))))
+    (should
+     (equal '("id:abc" "H1")
+            (test-ol-stored-link-with-text "* H1<point>\n:PROPERTIES:\n:ID: abc\n:END:\n** H2\n"
+              (org-id-store-link t)))))
+  ;; when not using context, description should be the parent/file
+  (let ((org-id-link-to-org-use-id 'use-existing)
+        (org-id-link-consider-parent-id t)
+        (org-id-link-use-context nil))
+    (should
+     (equal '("id:abc" "H1")
+            (test-ol-stored-link-with-text "* H1\n:PROPERTIES:\n:ID: abc\n:END:\n** H2\n<point>"
+              (org-id-store-link t))))
+    (should
+     (let ((result (test-ol-stored-link-with-text ":PROPERTIES:\n:ID: top\n:END:\n:* H1\n<point>"
+                     (org-id-store-link t))))
+       (equal "id:top" (car result))
+       ;; strip random buffer file name
+       (equal "org-test" (substring (cadr result) 0 8))))
+    (should
+     (equal '("id:top" "title")
+            (test-ol-stored-link-with-text ":PROPERTIES:\n:ID: top\n:END:\n#+TITLE: title\n\n:* H1\n<point>"
+              (org-id-store-link t))))))
+
 \f
 ;;; Radio Targets
 
-- 
2.39.2 (Apple Git-143)


  reply	other threads:[~2023-11-19 15:22 UTC|newest]

Thread overview: 47+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2023-07-24 11:40 [PATCH] org-id: allow using parent's existing id in links to headlines Rick Lupton
2023-07-25  7:43 ` Ihor Radchenko
2023-07-25 15:16   ` Max Nikulin
2023-07-26  8:10     ` Ihor Radchenko
2023-07-27  0:16       ` Samuel Wales
2023-07-27  7:42         ` IDs below headline level (for paragraphs, lists, etc) (was: [PATCH] org-id: allow using parent's existing id in links to headlines) Ihor Radchenko
2023-07-28 20:00           ` Rick Lupton
2023-07-28 19:56       ` [PATCH] org-id: allow using parent's existing id in links to headlines Rick Lupton
2023-07-29  8:33         ` Ihor Radchenko
2023-11-09 20:56   ` Rick Lupton
2023-11-10 10:03     ` Ihor Radchenko
2023-11-19 15:21       ` Rick Lupton [this message]
2023-12-04 13:23         ` Rick Lupton
2023-12-10 13:35         ` Ihor Radchenko
2023-12-14 20:42           ` Rick Lupton
2023-12-15 12:55             ` Ihor Radchenko
2023-12-15 16:16               ` Rick Lupton
2023-12-16 14:20                 ` Ihor Radchenko
2023-12-17 19:07                   ` [PATCH v2] " Rick Lupton
2023-12-18 12:27                     ` Ihor Radchenko
2024-01-02 16:13                       ` Rick Lupton
2024-01-03 14:17                         ` Ihor Radchenko
2024-01-28 22:47                       ` Rick Lupton
2024-01-29  0:20                         ` Samuel Wales
2024-01-29 13:06                           ` Ihor Radchenko
2024-01-30  0:03                             ` Samuel Wales
2024-02-03 15:08                               ` Ihor Radchenko
2024-01-29 13:00                         ` Ihor Radchenko
2024-01-31 18:11                           ` Rick Lupton
2024-02-01 12:13                             ` Ihor Radchenko
2024-02-01 16:37                               ` Rick Lupton
2024-02-03 13:10                             ` Ihor Radchenko
2024-02-08  8:24                               ` [PATCH] lisp/ol.el: Improve docstring Rick Lupton
2024-02-08 14:52                                 ` Ihor Radchenko
2024-02-08  8:46                               ` [PATCH v2] org-id: allow using parent's existing id in links to headlines Rick Lupton
2024-02-08 13:02                                 ` Ihor Radchenko
2024-02-08 22:30                                   ` Rick Lupton
2024-02-09 12:09                                     ` Ihor Radchenko
2024-02-09 12:47                                       ` Rick Lupton
2024-02-09 12:57                                         ` Ihor Radchenko
2024-02-24 10:48                                           ` Bastien Guerry
2024-02-24 13:02                                             ` Ihor Radchenko
2024-02-24 15:57                                               ` Rick Lupton
2024-03-05 14:05                                               ` Stefan
2024-03-05 14:51                                                 ` Ihor Radchenko
2023-11-04 23:01 ` [PATCH] " Rick Lupton
2023-11-05 12:31   ` Ihor Radchenko

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.orgmode.org/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=e66407c2-cd4f-4cb8-b933-4fd036b8d94a@app.fastmail.com \
    --to=mail@ricklupton.name \
    --cc=emacs-orgmode@gnu.org \
    --cc=yantar92@posteo.net \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs/org-mode.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).