From: "Rick Lupton" <mail@ricklupton.name>
To: "Ihor Radchenko" <yantar92@posteo.net>
Cc: "Y. E." <emacs-orgmode@gnu.org>
Subject: Re: [PATCH v2] org-id: allow using parent's existing id in links to headlines
Date: Thu, 08 Feb 2024 08:46:51 +0000 [thread overview]
Message-ID: <2a4b236c-c377-4493-b5ed-632c5518d514@app.fastmail.com> (raw)
In-Reply-To: <87cytdithi.fsf@localhost>
[-- Attachment #1: Type: text/plain, Size: 1481 bytes --]
On Sat, 3 Feb 2024, at 1:10 PM, Ihor Radchenko wrote:
> I'd prefer to avoid using global variables here.
> `org-entry-property-inherited-from' dates to pre-lexical binding times
> and is a potential source of subtle bugs if several `org-entry-get'
> calls happen unexpectedly to the code, changing
> `org-entry-property-inherited-from' multiple times.
>
> Instead, I suggest changing the return value of
> `org-link-precise-link-target' to a list that includes marker in
> addition to search string and description.
Makes sense -- I changed it to work that way and it is neater.
I returned simply the buffer position rather than a marker, since it is always in the current buffer, and avoids needing to worry about cleaning up the marker when finished or if not of interest.
> It looks like we cannot simply rely on narrowing to determine the
> created heading level.
I think you're right. I have extended `org-link-search' to accept an optional argument describing the org element where newly created headings should go as subheadings.
My thought was that this was not significantly more complicated than just passing the numeric level for new headings, but actually more flexible (e.g. you could if you wanted (with additional future elisp) create missing headings as part of a "To be filed" subtree within the file, rather than always at the end).
Does that look ok?
[is it useful to keep attaching the unchanged first patch so they are available as a set?]
Thanks
Rick
[-- Attachment #2: 0001-lisp-org.el-org-insert-heading-allow-specifying-head.patch --]
[-- Type: application/octet-stream, Size: 5084 bytes --]
From 1f9b776548baca13032a078150b79f4d6b827c71 Mon Sep 17 00:00:00 2001
From: Rick Lupton <mail@ricklupton.name>
Date: Wed, 3 Jan 2024 22:37:38 +0000
Subject: [PATCH 1/2] lisp/org.el (org-insert-heading): allow specifying
heading level
* lisp/org.el (org-insert-heading): Change optional argument TOP to
LEVEL, accepting a number to force a specific heading level.
* testing/lisp/test-org.el (test-org/insert-heading): Add tests
* etc/ORG-NEWS: Document changes
---
etc/ORG-NEWS | 6 ++++++
lisp/org.el | 21 ++++++++++++++-------
testing/lisp/test-org.el | 26 ++++++++++++++++++++++++--
3 files changed, 44 insertions(+), 9 deletions(-)
diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS
index 92d363b80..9e68bcdcb 100644
--- a/etc/ORG-NEWS
+++ b/etc/ORG-NEWS
@@ -1033,6 +1033,12 @@ as the function can also act on objects.
*** ~org-export-get-parent-element~ is renamed to ~org-element-parent-element~ and moved to =lisp/org-element.el=
+*** ~org-insert-heading~ optional argument =TOP= is now =LEVEL=
+
+A numeric value forces a heading at that level to be inserted. For
+backwards compatibility, non-numeric non-nil values insert level 1
+headings as before.
+
** Miscellaneous
*** =org-crypt.el= now applies initial visibility settings to decrypted entries
diff --git a/lisp/org.el b/lisp/org.el
index da315fccb..54748f495 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -6364,7 +6364,7 @@ headline instead of current one."
(`(heading . ,value) value)
(_ nil)))
-(defun org-insert-heading (&optional arg invisible-ok top)
+(defun org-insert-heading (&optional arg invisible-ok level)
"Insert a new heading or an item with the same depth at point.
If point is at the beginning of a heading, insert a new heading
@@ -6393,12 +6393,19 @@ When INVISIBLE-OK is set, stop at invisible headlines when going
back. This is important for non-interactive uses of the
command.
-When optional argument TOP is non-nil, insert a level 1 heading,
-unconditionally."
+When optional argument LEVEL is a number, insert a heading at
+that level. For backwards compatibility, when LEVEL is non-nil
+but not a number, insert a level-1 heading."
(interactive "P")
(let* ((blank? (org--blank-before-heading-p (equal arg '(16))))
- (level (org-current-level))
- (stars (make-string (if (and level (not top)) level 1) ?*)))
+ (current-level (org-current-level))
+ (num-stars (or
+ ;; Backwards compat: if LEVEL non-nil, level is 1
+ (and level (if (wholenump level) level 1))
+ current-level
+ ;; This `1' is for when before first headline
+ 1))
+ (stars (make-string num-stars ?*)))
(cond
((or org-insert-heading-respect-content
(member arg '((4) (16)))
@@ -6407,7 +6414,7 @@ unconditionally."
;; Position point at the location of insertion. Make sure we
;; end up on a visible headline if INVISIBLE-OK is nil.
(org-with-limited-levels
- (if (not level) (outline-next-heading) ;before first headline
+ (if (not current-level) (outline-next-heading) ;before first headline
(org-back-to-heading invisible-ok)
(when (equal arg '(16)) (org-up-heading-safe))
(org-end-of-subtree invisible-ok 'to-heading)))
@@ -6420,7 +6427,7 @@ unconditionally."
(org-before-first-heading-p)))
(insert "\n")
(backward-char))
- (when (and (not level) (not (eobp)) (not (bobp)))
+ (when (and (not current-level) (not (eobp)) (not (bobp)))
(when (org-at-heading-p) (insert "\n"))
(backward-char))
(unless (and blank? (org-previous-line-empty-p))
diff --git a/testing/lisp/test-org.el b/testing/lisp/test-org.el
index 822cbc67a..fc50dc787 100644
--- a/testing/lisp/test-org.el
+++ b/testing/lisp/test-org.el
@@ -1980,8 +1980,30 @@ CLOCK: [2022-09-17 sam. 11:00]--[2022-09-17 sam. 11:46] => 0:46"
(let ((org-insert-heading-respect-content nil))
(org-insert-heading '(16)))
(buffer-string))))
- ;; When optional TOP-LEVEL argument is non-nil, always insert
- ;; a level 1 heading.
+ ;; When optional LEVEL argument is a number, insert a heading at
+ ;; that level.
+ (should
+ (equal "* H1\n** H2\n* "
+ (org-test-with-temp-text "* H1\n** H2<point>"
+ (org-insert-heading nil nil 1)
+ (buffer-string))))
+ (should
+ (equal "* H1\n** H2\n** "
+ (org-test-with-temp-text "* H1\n** H2<point>"
+ (org-insert-heading nil nil 2)
+ (buffer-string))))
+ (should
+ (equal "* H1\n** H2\n*** "
+ (org-test-with-temp-text "* H1\n** H2<point>"
+ (org-insert-heading nil nil 3)
+ (buffer-string))))
+ (should
+ (equal "* H1\n- item\n* "
+ (org-test-with-temp-text "* H1\n- item<point>"
+ (org-insert-heading nil nil 1)
+ (buffer-string))))
+ ;; When optional LEVEL argument is non-nil, always insert a level 1
+ ;; heading.
(should
(equal "* H1\n** H2\n* "
(org-test-with-temp-text "* H1\n** H2<point>"
--
2.37.1 (Apple Git-137.1)
[-- Attachment #3: 0002-org-id.el-Add-search-strings-inherit-parent-IDs.patch --]
[-- Type: application/octet-stream, Size: 58214 bytes --]
From d5759dd95bec88be38ddbde07fa4437c0528469a Mon Sep 17 00:00:00 2001
From: Rick Lupton <mail@ricklupton.name>
Date: Sun, 19 Nov 2023 14:52:05 +0000
Subject: [PATCH 2/2] org-id.el: Add search strings, inherit parent IDs
* lisp/ol.el (org-store-link): Refactor org-id links to use standard
`org-store-link-functions'.
(org-link-search): Create new headings at appropriate level.
(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/ol-bbdb.el (org-bbdb-store-link):
* lisp/ol-bibtex.el (org-bibtex-store-link):
* lisp/ol-docview.el (org-docview-store-link):
* lisp/ol-eshell.el (org-eshell-store-link):
* lisp/ol-eww.el (org-eww-store-link):
* lisp/ol-gnus.el (org-gnus-store-link):
* lisp/ol-info.el (org-info-store-link):
* lisp/ol-irc.el (org-irc-store-link):
* lisp/ol-man.el (org-man-store-link):
* lisp/ol-mhe.el (org-mhe-store-link):
* lisp/ol-rmail.el (org-rmail-store-link): Accept optional arg.
* 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 to add context to org-id links.
(org-id-get): Add optional `inherit' argument which considers parents'
IDs if the current entry does not have one.
(org-id-store-link): 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-store-link-maybe): Function set as :store option for custom id
link property. Move logic from `org-store-link' here to determine when
an org-id link should be stored using `org-id-store-link'.
(org-id-open): Recognise search strings after "::" in org-id links.
* lisp/org-lint.el: add checker for "::" in ID properties.
* 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 | 133 ++++++++++-------
etc/ORG-NEWS | 64 ++++++++
lisp/ol-bbdb.el | 2 +-
lisp/ol-bibtex.el | 2 +-
lisp/ol-docview.el | 2 +-
lisp/ol-eshell.el | 2 +-
lisp/ol-eww.el | 2 +-
lisp/ol-gnus.el | 2 +-
lisp/ol-info.el | 2 +-
lisp/ol-irc.el | 2 +-
lisp/ol-man.el | 2 +-
lisp/ol-mhe.el | 2 +-
lisp/ol-rmail.el | 2 +-
lisp/ol.el | 324 +++++++++++++++++++++++++---------------
lisp/org-id.el | 178 +++++++++++++++++++---
lisp/org-lint.el | 16 ++
testing/lisp/test-ol.el | 122 +++++++++++++++
17 files changed, 655 insertions(+), 204 deletions(-)
diff --git a/doc/org-manual.org b/doc/org-manual.org
index 1a025a139..49fce9113 100644
--- a/doc/org-manual.org
+++ b/doc/org-manual.org
@@ -3300,10 +3300,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 =/=.
@@ -3367,44 +3363,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
@@ -3465,8 +3467,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
@@ -3484,6 +3487,30 @@ 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
+ #+vindex: org-id-link-use-context
+ When ~org-id-link-consider-parent-id~ is ~t~ (and
+ ~org-link-context-for-files~ and ~org-id-link-use-context~ are both
+ enabled), 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.
+
+ For example, given this org file with those variables set:
+
+ #+begin_src org
+ ,* Parent
+ :PROPERTIES:
+ :ID: abc
+ :END:
+ ,** Child 1
+ ,** Child 2
+ #+end_src
+
+ Storing a link with point at "Child 1" will produce a link
+ =<id:abc::*Child 1>=, which precisely links to the "Child 1"
+ headline even though it does not have its own ID.
+
- /Email/News clients: VM, Rmail, Wanderlust, MH-E, Gnus/ ::
#+vindex: org-link-email-description-format
@@ -3763,7 +3790,9 @@ the link completion function like this:
: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
@@ -3775,8 +3804,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:
@@ -21367,7 +21396,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.
@@ -21427,13 +21456,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 9e68bcdcb..84bbc5243 100644
--- a/etc/ORG-NEWS
+++ b/etc/ORG-NEWS
@@ -390,6 +390,14 @@ 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.
+
+Existing store functions will continue to work.
+
*** ~org-priority=show~ command no longer adjusts for scheduled/deadline
In agenda views, ~org-priority=show~ command previously displayed the
@@ -468,6 +476,27 @@ 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
+
+This new behaviour can be disabled generally by setting
+~org-id-link-use-context~ to ~nil~, or the setting can be toggled for
+a single call to ~org-store-link~ with a universal argument.
+
+When using this feature, IDs should not include =::=, which is used in
+links to indicate the start of the search string. For backwards
+compability, existing IDs including =::= will still be matched (but
+cannot be used together with precise link targets). An org-lint
+checker has been added to warn about this.
+
+*** ~org-store-link~ behaviour storing additional =CUSTOM_ID= links has changed
+
+As well as an =id:= link, ~org-store-link~ stores an additional "human
+readable" link using a node's =CUSTOM_ID= property, if available.
+This behaviour has been expanded to store an additional =CUSTOM_ID=
+link when storing any type of external link type in an Org file, not
+just =id:= links.
+
** New and changed options
*** ~repeated-after-deadline~ value of ~org-agenda-skip-scheduled-repeats-after-deadline~ is moved to a new customization
@@ -743,6 +772,35 @@ This option starts the agenda to automatically include archives,
propagating the value for this variable to ~org-agenda-archives-mode~.
For acceptable values and their meaning, see the value of that variable.
+*** 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.
+
+For example, given this org file:
+
+#+begin_src org
+,* Parent
+:PROPERTIES:
+:ID: abc
+:END:
+,** Child 1
+,** Child 2
+#+end_src
+
+Storing a link with point at "Child 1" will produce a link
+=<id:abc::*Child 1>=, which precisely links to the "Child 1" headline
+even though it does not have its own ID. By giving files top-level id
+properties, links to headlines in the file can also be made more
+robust by using the file id instead of the file path.
+
** New features
*** =ob-plantuml.el=: Support tikz file format output
@@ -1039,6 +1097,12 @@ A numeric value forces a heading at that level to be inserted. For
backwards compatibility, non-numeric non-nil values insert level 1
headings as before.
+*** New optional argument for ~org-id-get~
+
+New optional argument =INHERIT= means inherited ID properties from
+parent entries are considered when getting an entry's ID (see
+~org-id-link-consider-parent-id~ option).
+
** Miscellaneous
*** =org-crypt.el= now applies initial visibility settings to decrypted entries
diff --git a/lisp/ol-bbdb.el b/lisp/ol-bbdb.el
index be3924fc9..6ea060f70 100644
--- a/lisp/ol-bbdb.el
+++ b/lisp/ol-bbdb.el
@@ -226,7 +226,7 @@ date year)."
;;; Implementation
-(defun org-bbdb-store-link ()
+(defun org-bbdb-store-link (&optional _interactive?)
"Store a link to a BBDB database entry."
(when (eq major-mode 'bbdb-mode)
;; This is BBDB, we make this link!
diff --git a/lisp/ol-bibtex.el b/lisp/ol-bibtex.el
index c5a950e2d..38468f32f 100644
--- a/lisp/ol-bibtex.el
+++ b/lisp/ol-bibtex.el
@@ -507,7 +507,7 @@ ARG, when non-nil, is a universal prefix argument. See
`org-open-file' for details."
(org-link-open-as-file path arg))
-(defun org-bibtex-store-link ()
+(defun org-bibtex-store-link (&optional _interactive?)
"Store a link to a BibTeX entry."
(when (eq major-mode 'bibtex-mode)
(let* ((search (org-create-file-search-in-bibtex))
diff --git a/lisp/ol-docview.el b/lisp/ol-docview.el
index b31f1ce5e..0907ddee1 100644
--- a/lisp/ol-docview.el
+++ b/lisp/ol-docview.el
@@ -83,7 +83,7 @@
(error "No such file: %s" path))
(when page (doc-view-goto-page page))))
-(defun org-docview-store-link ()
+(defun org-docview-store-link (&optional _interactive?)
"Store a link to a docview buffer."
(when (eq major-mode 'doc-view-mode)
;; This buffer is in doc-view-mode
diff --git a/lisp/ol-eshell.el b/lisp/ol-eshell.el
index 2c7ec6bef..595dd0ee0 100644
--- a/lisp/ol-eshell.el
+++ b/lisp/ol-eshell.el
@@ -60,7 +60,7 @@ followed by a colon."
(insert command)
(eshell-send-input)))
-(defun org-eshell-store-link ()
+(defun org-eshell-store-link (&optional _interactive?)
"Store eshell link.
When opened, the link switches back to the current eshell buffer and
the current working directory."
diff --git a/lisp/ol-eww.el b/lisp/ol-eww.el
index 40b820d2b..c13dbf339 100644
--- a/lisp/ol-eww.el
+++ b/lisp/ol-eww.el
@@ -62,7 +62,7 @@
"Open URL with Eww in the current buffer."
(eww url))
-(defun org-eww-store-link ()
+(defun org-eww-store-link (&optional _interactive?)
"Store a link to the url of an EWW buffer."
(when (eq major-mode 'eww-mode)
(org-link-store-props
diff --git a/lisp/ol-gnus.el b/lisp/ol-gnus.el
index e105fdb2c..b9ee8683f 100644
--- a/lisp/ol-gnus.el
+++ b/lisp/ol-gnus.el
@@ -123,7 +123,7 @@ If `org-store-link' was called with a prefix arg the meaning of
(url-encode-url message-id))
(concat "gnus:" group "#" message-id)))
-(defun org-gnus-store-link ()
+(defun org-gnus-store-link (&optional _interactive?)
"Store a link to a Gnus folder or message."
(pcase major-mode
(`gnus-group-mode
diff --git a/lisp/ol-info.el b/lisp/ol-info.el
index 0edf9a13f..6062cab34 100644
--- a/lisp/ol-info.el
+++ b/lisp/ol-info.el
@@ -50,7 +50,7 @@
:insert-description #'org-info-description-as-command)
;; Implementation
-(defun org-info-store-link ()
+(defun org-info-store-link (&optional _interactive?)
"Store a link to an Info file and node."
(when (eq major-mode 'Info-mode)
(let ((link (concat "info:"
diff --git a/lisp/ol-irc.el b/lisp/ol-irc.el
index 78c4884b0..b263e52db 100644
--- a/lisp/ol-irc.el
+++ b/lisp/ol-irc.el
@@ -103,7 +103,7 @@ attributes that are found."
parts))
;;;###autoload
-(defun org-irc-store-link ()
+(defun org-irc-store-link (&optional _interactive?)
"Dispatch to the appropriate function to store a link to an IRC session."
(cond
((eq major-mode 'erc-mode)
diff --git a/lisp/ol-man.el b/lisp/ol-man.el
index e3f13815e..42aacea81 100644
--- a/lisp/ol-man.el
+++ b/lisp/ol-man.el
@@ -82,7 +82,7 @@ matched strings in man buffer."
(set-window-point window point)
(set-window-start window point)))))))
-(defun org-man-store-link ()
+(defun org-man-store-link (&optional _interactive?)
"Store a link to a README file."
(when (memq major-mode '(Man-mode woman-mode))
;; This is a man page, we do make this link
diff --git a/lisp/ol-mhe.el b/lisp/ol-mhe.el
index 106cfedc9..a32481324 100644
--- a/lisp/ol-mhe.el
+++ b/lisp/ol-mhe.el
@@ -80,7 +80,7 @@ supported by MH-E."
(org-link-set-parameters "mhe" :follow #'org-mhe-open :store #'org-mhe-store-link)
;; Implementation
-(defun org-mhe-store-link ()
+(defun org-mhe-store-link (&optional _interactive?)
"Store a link to an MH-E folder or message."
(when (or (eq major-mode 'mh-folder-mode)
(eq major-mode 'mh-show-mode))
diff --git a/lisp/ol-rmail.el b/lisp/ol-rmail.el
index f6031ab52..f1f753b6f 100644
--- a/lisp/ol-rmail.el
+++ b/lisp/ol-rmail.el
@@ -51,7 +51,7 @@
:store #'org-rmail-store-link)
;; Implementation
-(defun org-rmail-store-link ()
+(defun org-rmail-store-link (&optional _interactive?)
"Store a link to an Rmail folder or message."
(when (or (eq major-mode 'rmail-mode)
(eq major-mode 'rmail-summary-mode))
diff --git a/lisp/ol.el b/lisp/ol.el
index f8d911127..762d7a0d8 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))
@@ -818,6 +817,74 @@ spec."
(org-with-point-at (car region)
(not (org-in-regexp org-link-any-re))))
+(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.
+
+Argument INTERACTIVE? indicates whether `org-store-link' was
+called interactively and is passed to the link store functions.
+
+Return t when a link has been stored in `org-link-store-props'."
+ (let ((results-alist nil))
+ (dolist (f (org-store-link-functions))
+ (when (condition-case nil
+ (funcall f interactive?)
+ ;; FIXME: The store function used (< Org 9.7) to accept
+ ;; no arguments; provide backward compatibility support
+ ;; for them.
+ (wrong-number-of-arguments
+ (funcall f)))
+ ;; FIXME: 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))))
+
+(defun org-link--add-to-stored-links (link desc)
+ "Add LINK to `org-stored-links' with description DESC."
+ (cond
+ ((not (member (list link desc) org-stored-links))
+ (push (list link desc) org-stored-links)
+ (message "Stored: %s" (or desc link)))
+ ((equal (list link desc) (car org-stored-links))
+ (message "This link has already been stored"))
+ (t
+ (setq org-stored-links
+ (delete (list link desc) org-stored-links))
+ (push (list link desc) org-stored-links)
+ (message "Link moved to front: %s" (or desc link)))))
+
+(defun org-link--file-link-to-here ()
+ "Return as (LINK . DESC) a file link with search string to here."
+ (let ((link (concat "file:"
+ (abbreviate-file-name
+ (buffer-file-name (buffer-base-buffer)))))
+ desc)
+ (when org-link-context-for-files
+ (pcase (org-link-precise-link-target)
+ (`nil nil)
+ (`(,search-string ,search-desc ,_position)
+ (setq link (format "%s::%s" link search-string))
+ (setq desc search-desc))))
+ (cons link desc)))
+
\f
;;; Public API
@@ -1044,7 +1111,9 @@ LINK is escaped with backslashes for inclusion in buffer."
"List of functions that are called to create and store a link.
The functions are defined in the `:store' property of
-`org-link-parameters'.
+`org-link-parameters'. Each function should accept an argument
+INTERACTIVE? which indicates whether the user has initiated
+`org-store-link' interactively.
Each function will be called in turn until one returns a non-nil
value. Each function should check if it is responsible for
@@ -1163,7 +1232,7 @@ Optional argument ARG is passed to `org-open-file' when S is a
(`nil (user-error "No valid link in %S" s))
(link (org-link-open link arg))))
-(defun org-link-search (s &optional avoid-pos stealth)
+(defun org-link-search (s &optional avoid-pos stealth new-heading-container)
"Search for a search string S in the accessible part of the buffer.
If S starts with \"#\", it triggers a custom ID search.
@@ -1183,6 +1252,13 @@ When optional argument STEALTH is non-nil, do not modify
visibility around point, thus ignoring `org-show-context-detail'
variable.
+When optional argument NEW-HEADING-CONTAINER is an element, any
+new heading that is created (see
+`org-link-search-must-match-exact-headline') will be added as a
+subheading of NEW-HEADING-CONTAINER. Otherwise, new headings are
+created at level 1 at the end of the accessible part of the
+buffer.
+
Search is case-insensitive and ignores white spaces. Return type
of matched result, which is either `dedicated' or `fuzzy'. Search
respects buffer narrowing."
@@ -1281,11 +1357,17 @@ respects buffer narrowing."
((and (derived-mode-p 'org-mode)
(eq org-link-search-must-match-exact-headline 'query-to-create)
(yes-or-no-p "No match - create this as a new heading? "))
- (goto-char (point-max))
- (unless (bolp) (newline))
- (org-insert-heading nil t t)
- (insert s "\n")
- (forward-line -1))
+ (let* ((new-heading-position (if new-heading-container
+ (- (org-element-end new-heading-container) 1)
+ (point-max)))
+ (new-heading-level (if new-heading-container
+ (+ 1 (org-element-property :level new-heading-container))
+ 1)))
+ (goto-char new-heading-position)
+ (unless (bolp) (newline))
+ (org-insert-heading nil t new-heading-level)
+ (insert (if starred (substring s 1) s) "\n")
+ (forward-line -1)))
;; Only headlines are looked after. No need to process
;; further: throw an error.
((and (derived-mode-p 'org-mode)
@@ -1335,6 +1417,70 @@ priority cookie or tag."
(org-link--normalize-string
(or string (org-get-heading t t t t)))))
+(defun org-link-precise-link-target ()
+ "Determine search string and description for storing a link.
+
+If a search string (see `org-link-search') is found, return
+list (SEARCH-STRING DESC POSITION). Otherwise, return nil.
+
+If there is an active region, the contents (or a part of it, see
+`org-link-context-for-files') is used as the search string.
+
+In Org buffers, if point is at a named element (such as a source
+block), the name is used for the search string. If at a heading,
+its CUSTOM_ID is used to form a search string of the form
+\"#id\", if present, otherwise the current heading text is used
+in the form \"*Heading\".
+
+If none of those finds a suitable search string, the current line
+is used as the search string.
+
+The description DESC is nil (meaning the user will be prompted
+for a description when inserting the link) for search strings
+based on a region or the current line. For other cases, DESC is
+a cleaned-up version of the name or heading at point.
+
+POSITION is the buffer position at which the search string
+matches."
+ (let* ((region (org-link--context-from-region))
+ (result
+ (cond
+ (region
+ (list (org-link--normalize-string region t)
+ nil
+ (region-beginning)))
+
+ ((derived-mode-p 'org-mode)
+ (let* ((element (org-element-at-point))
+ (name (org-element-property :name element))
+ (heading (org-element-lineage element '(headline inlinetask) t))
+ (custom-id (org-entry-get heading "CUSTOM_ID")))
+ (cond
+ (name
+ (list name
+ name
+ (org-element-begin element)))
+ ((org-before-first-heading-p)
+ (list (org-link--normalize-string (org-current-line-string) t)
+ nil
+ (line-beginning-position)))
+ (heading
+ (list (if custom-id (concat "#" custom-id)
+ (org-link-heading-search-string))
+ (org-link--normalize-string
+ (org-get-heading t t t t))
+ (org-element-begin heading))))))
+
+ ;; Not in an org-mode buffer, no region
+ (t
+ (list (org-link--normalize-string (org-current-line-string) t)
+ nil
+ (line-beginning-position))))))
+
+ ;; 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.
@@ -1407,7 +1553,7 @@ PATH is a symbol name, as a string."
((and (pred boundp) variable) (describe-variable variable))
(name (user-error "Unknown function or variable: %s" name))))
-(defun org-link--store-help ()
+(defun org-link--store-help (&optional _interactive?)
"Store \"help\" type link."
(when (eq major-mode 'help-mode)
(let ((symbol
@@ -1542,7 +1688,12 @@ prefix ARG forces storing a link for each line in the
active region.
Assume the function is called interactively if INTERACTIVE? is
-non-nil."
+non-nil.
+
+In Org buffers, an additional \"human-readable\" simple file link
+is stored as an alternative to persistent org-id or other links,
+if at a heading with a CUSTOM_ID property or an element with a
+NAME."
(interactive "P\np")
(org-load-modules-maybe)
(if (and (equal arg '(64)) (org-region-active-p))
@@ -1557,36 +1708,19 @@ non-nil."
(move-beginning-of-line 2)
(set-mark (point)))))
(setq org-store-link-plist nil)
- (let (link cpltxt desc search custom-id agenda-link) ;; description
+ ;; Negate `org-context-in-file-links' when given a single universal arg.
+ (let ((org-link-context-for-files (org-xor org-link-context-for-files
+ (equal arg '(4))))
+ link cpltxt desc search agenda-link) ;; description
(cond
;; Store a link using an external link type, if any function is
- ;; available. If more than one can generate a link from current
- ;; location, ask which one to use.
+ ;; available, unless external link types are skipped for this
+ ;; call using two universal args. If more than one function
+ ;; can generate a link from current location, ask the user
+ ;; 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))))
- (setq link (plist-get org-store-link-plist :link))
+ (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).
(setq desc (plist-get org-store-link-plist :description)))
@@ -1637,6 +1771,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
@@ -1645,6 +1780,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))
@@ -1662,15 +1798,22 @@ 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"))
(cond
;; Store a link using the target at point
((org-in-regexp "[^<]<<\\([^<>]+\\)>>[^>]" 1)
@@ -1684,74 +1827,21 @@ non-nil."
;; links. Maybe the case of identical target and
;; description should be handled by `org-insert-link'.
cpltxt 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
+ desc nil))
+ (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)))))
+ (let ((here (org-link--file-link-to-here)))
+ (setq cpltxt (car here))
+ (setq desc (cdr here)))
+ (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))
+ (let ((here (org-link--file-link-to-here)))
+ (setq cpltxt (car here))
+ (setq desc (cdr here)))
+ (setq link cpltxt))
(interactive?
(user-error "No method for storing a link from this buffer"))
@@ -1767,24 +1857,18 @@ non-nil."
;; Store and return the link
(if (not (and interactive? link))
(or agenda-link (and link (org-link-make-string link desc)))
- (dotimes (_ (if custom-id 2 1)) ; Store 2 links when CUSTOM-ID is non-nil.
- (cond
- ((not (member (list link desc) org-stored-links))
- (push (list link desc) org-stored-links)
- (message "Stored: %s" (or desc link)))
- ((equal (list link desc) (car org-stored-links))
- (message "This link has already been stored"))
- (t
- (setq org-stored-links
- (delete (list link desc) org-stored-links))
- (push (list link desc) org-stored-links)
- (message "Link moved to front: %s" (or desc link))))
- (when custom-id
- (setq link (concat "file:"
- (abbreviate-file-name
- (buffer-file-name (buffer-base-buffer)))
- "::#" custom-id))))
- (car org-stored-links)))))
+ (org-link--add-to-stored-links link desc)
+ ;; In org buffers, store an additional "human-readable" link
+ ;; using custom id, if available.
+ (when (and (buffer-file-name (buffer-base-buffer))
+ (derived-mode-p 'org-mode)
+ (org-entry-get nil "CUSTOM_ID"))
+ (let ((here (org-link--file-link-to-here)))
+ (setq link (car here))
+ (setq desc (cdr here)))
+ (unless (equal (list link desc) (car org-stored-links))
+ (org-link--add-to-stored-links link desc)))
+ (car org-stored-links)))))
;;;###autoload
(defun org-insert-link (&optional complete-file link-location description)
diff --git a/lisp/org-id.el b/lisp/org-id.el
index 8647a57cc..58d51deca 100644
--- a/lisp/org-id.el
+++ b/lisp/org-id.el
@@ -129,6 +129,46 @@ 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 entry considers inherited IDs.
+
+When this option is non-nil and `org-id-link-use-context' is
+enabled, ID properties inherited from parent entries will be
+considered when storing an ID link. If no ID is found in this
+way, a new one may be created as normal (see
+`org-id-link-to-org-use-id').
+
+For example, given this org file:
+
+* Parent
+:PROPERTIES:
+:ID: abc
+:END:
+** Child 1
+** Child 2
+
+With `org-id-link-consider-parent-id' and
+`org-id-link-use-context' both enabled, storing a link with point
+at \"Child 1\" will produce a link \"<id:abc::*Child 1>\". This
+allows 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 enables search string context in org-id links.
+
+Search strings are added by `org-id-store-link' when both the
+general option `org-link-context-for-files' and the org-id option
+`org-id-link-use-context' are non-nil."
+ :group 'org-link-store
+ :group 'org-id
+ :package-version '(Org . "9.7")
+ :type 'boolean)
+
(defcustom org-id-uuid-program "uuidgen"
"The uuidgen program."
:group 'org-id
@@ -280,15 +320,21 @@ 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)
- "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.
-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")))
+(defun org-id-get (&optional epom create prefix inherit)
+ "Get the ID of the entry at EPOM.
+
+EPOM is an element, marker, or buffer position. If EPOM is nil,
+refer to the entry at point.
+
+If INHERIT is non-nil, ID properties inherited from parent
+entries are considered. Otherwise, only ID properties on the
+entry itself are considered.
+
+When CREATE is nil, return the ID of the entry if found,
+otherwise nil. When CREATE is non-nil, create an ID if none has
+been found, and return the new ID. PREFIX will be passed through
+to `org-id-new'."
+ (let ((id (org-entry-get epom "ID" (and inherit t))))
(cond
((and id (stringp id) (string-match "\\S-" id))
id)
@@ -700,21 +746,56 @@ optional argument MARKERP, return the position as a new marker."
;; id link type
-;; Calling the following function is hard-coded into `org-store-link',
-;; so we do have to add it to `org-store-link-functions'.
+(defun org-id--get-id-to-store-link (&optional create)
+ "Get or create the relevant ID for storing a link.
+
+Optional argument CREATE is passed to `org-id-get'.
+
+Inherited IDs are only considered when
+`org-id-link-consider-parent-id', `org-id-link-use-context' and
+`org-link-context-for-files' are all enabled, since inherited IDs
+are confusing without the additional search string context.
+
+Note that this function resets the
+`org-entry-property-inherited-from' marker: it will either point
+to nil (if the id was not inherited) or to the point it was
+inherited from."
+ (let* ((inherit-id (and org-id-link-consider-parent-id
+ org-id-link-use-context
+ org-link-context-for-files)))
+ (move-marker org-entry-property-inherited-from nil)
+ (org-id-get nil create nil inherit-id)))
;;;###autoload
(defun org-id-store-link ()
"Store a link to the current entry, using its ID.
-If before first heading store first title-keyword as description
-or filename if no title."
+The link description is based on the heading, or if before the
+first heading, the title keyword if available, or else the
+filename.
+
+When `org-link-context-for-files' and `org-id-link-use-context'
+are non-nil, add a search string to the link. The link
+description is then based on the search string target.
+
+When in addition `org-id-link-consider-parent-id' is non-nil, the
+ID can be inherited from a parent entry, with the search string
+used to still link to the current location."
(interactive)
- (when (and (buffer-file-name (buffer-base-buffer)) (derived-mode-p 'org-mode))
- (let* ((link (concat "id:" (org-id-get-create)))
+ (when (and (buffer-file-name (buffer-base-buffer))
+ (derived-mode-p 'org-mode))
+ ;; Get the precise target first, in case looking for an id causes
+ ;; a properties drawer to be added at the current location.
+ (let* ((precise-target (and org-link-context-for-files
+ org-id-link-use-context
+ (org-link-precise-link-target)))
+ (link (concat "id:" (org-id--get-id-to-store-link 'create)))
+ (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 t) (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 +807,59 @@ or filename if no title."
(match-string 4)
(match-string 0)))
(t link)))))
+ ;; Precise targets should be after id-location to avoid
+ ;; duplicating the current headline as a search string
+ (when (and precise-target
+ (> (nth 2 precise-target) id-location))
+ (setq link (concat link "::" (nth 0 precise-target)))
+ (setq desc (nth 1 precise-target)))
(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)
+;;;###autoload
+(defun org-id-store-link-maybe (&optional interactive?)
+ "Store a link to the current entry using its ID if enabled.
+
+The value of `org-id-link-to-org-use-id' determines whether an ID
+link should be stored, using `org-id-store-link'.
+
+Assume the function is called interactively if INTERACTIVE? is
+non-nil."
+ (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")))))
+ ;; 'use-existing
+ (and org-id-link-to-org-use-id
+ (org-id--get-id-to-store-link))))
+ (org-id-store-link)))
+
+(defun org-id-open (link _)
+ "Go to the entry indicated by id link LINK.
+
+The link can include a search string after \"::\", which is
+passed to `org-link-search'.
+
+For backwards compatibility with IDs that contain \"::\", if no
+match is found for the ID, the full link string including \"::\"
+will be tried as an ID."
+ (let* ((option (and (string-match "::\\(.*\\)\\'" link)
+ (match-string 1 link)))
+ (id (if (not option) link
+ (substring link 0 (match-beginning 0))))
+ m cmd)
+ (org-mark-ring-push)
+ (setq m (org-id-find id 'marker))
+ (when (and (not m) option)
+ ;; Backwards compatibility: if id is not found, try treating
+ ;; whole link as an id.
+ (setq m (org-id-find link 'marker))
+ (when m
+ (setq option nil)))
(unless m
(error "Cannot find entry with ID \"%s\"" id))
;; Use a buffer-switching command in analogy to finding files
@@ -750,9 +876,17 @@ or filename if no title."
(funcall cmd (marker-buffer m)))
(goto-char m)
(move-marker m nil)
+ (when option
+ (save-restriction
+ (unless (org-before-first-heading-p)
+ (org-narrow-to-subtree))
+ (org-link-search option nil nil
+ (org-element-lineage (org-element-at-point) 'headline t))))
(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-maybe)
(provide 'org-id)
diff --git a/lisp/org-lint.el b/lisp/org-lint.el
index 4d2a55d15..b23afcca3 100644
--- a/lisp/org-lint.el
+++ b/lisp/org-lint.el
@@ -65,6 +65,7 @@
;; - special properties in properties drawers,
;; - obsolete syntax for properties drawers,
;; - invalid duration in EFFORT property,
+;; - invalid ID property with a double colon,
;; - missing definition for footnote references,
;; - missing reference for footnote definitions,
;; - non-footnote definitions in footnote section,
@@ -686,6 +687,16 @@ Use :header-args: instead"
(list (org-element-begin p)
(format "Invalid effort duration format: %S" value))))))))
+(defun org-lint-invalid-id-property (ast)
+ (org-element-map ast 'node-property
+ (lambda (p)
+ (when (equal "ID" (org-element-property :key p))
+ (let ((value (org-element-property :value p)))
+ (and (org-string-nw-p value)
+ (string-match-p "::" value)
+ (list (org-element-begin p)
+ (format "IDs should not include \"::\": %S" value))))))))
+
(defun org-lint-link-to-local-file (ast)
(org-element-map ast 'link
(lambda (l)
@@ -1684,6 +1695,11 @@ AST is the buffer parse tree."
#'org-lint-invalid-effort-property
:categories '(properties))
+(org-lint-add-checker 'invalid-id-property
+ "Report search string delimiter \"::\" in ID property"
+ #'org-lint-invalid-id-property
+ :categories '(properties))
+
(org-lint-add-checker 'undefined-footnote-reference
"Report missing definition for footnote references"
#'org-lint-undefined-footnote-reference
diff --git a/testing/lisp/test-ol.el b/testing/lisp/test-ol.el
index e0cec0854..3150b4e2f 100644
--- a/testing/lisp/test-ol.el
+++ b/testing/lisp/test-ol.el
@@ -381,6 +381,128 @@ 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."
+ (org-test-with-temp-text "* H1<point>\n* H2\n"
+ (should
+ (equal '("*H1" "H1" 1)
+ (org-link-precise-link-target))))
+ (org-test-with-temp-text "* H1\n#+name: foo<point>\n#+begin_example\nhi\n#+end_example\n"
+ (should
+ (equal '("foo" "foo" 6)
+ (org-link-precise-link-target))))
+ (org-test-with-temp-text "\nText<point>\n* H1\n"
+ (should
+ (equal '("Text" nil 2)
+ (org-link-precise-link-target))))
+ (org-test-with-temp-text "\n<point>\n* H1\n"
+ (should
+ (equal nil (org-link-precise-link-target)))))
+
+(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-maybe 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-maybe 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-maybe 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-maybe t)))))
+ (should
+ (equal '(nil nil)
+ (test-ol-stored-link-with-text "* H1\n"
+ (org-id-store-link-maybe 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-maybe 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-maybe t))))
+ (should
+ (equal '(nil nil)
+ (test-ol-stored-link-with-text "* H1\n"
+ (org-id-store-link-maybe nil)))))
+ ;; use-context should have no effect when on the headline with an id
+ (let ((org-id-link-to-org-use-id t)
+ (org-id-link-use-context t))
+ (should
+ (equal '("id:abc" "H2")
+ (test-ol-stored-link-with-text "* H1\n** H2<point>\n:PROPERTIES:\n:ID: abc\n:END:\n"
+ ;; simulate previously getting an inherited value
+ (move-marker org-entry-property-inherited-from 1)
+ (org-id-store-link-maybe t))))))
+
+(ert-deftest test-org-link/id-store-link-using-parent ()
+ "Test `org-id-store-link' specifications with `org-id-link-consider-parent-id` set."
+ ;; when using context to still find specific heading
+ (let ((org-id-link-to-org-use-id t)
+ (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))))
+ (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))))
+ (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))))
+ ;; should not use newly added ids as search string, e.g. in an empty file
+ (should
+ (let (name result)
+ (setq result
+ (cl-letf (((symbol-function 'org-id-new)
+ (lambda (&rest _rest) "abc")))
+ (test-ol-stored-link-with-text "<point>"
+ (setq name (buffer-name))
+ (org-id-store-link))))
+ (equal `("id:abc" ,name) result))))
+ ;; should not find targets in the next section
+ (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 '(nil nil)
+ (test-ol-stored-link-with-text "* H1\n:PROPERTIES:\n:ID: abc\n:END:\n* H2\n** <point>Target\n"
+ (org-id-store-link-maybe t))))))
+
\f
;;; Radio Targets
--
2.37.1 (Apple Git-137.1)
next prev parent reply other threads:[~2024-02-08 8:48 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
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 ` Rick Lupton [this message]
2024-02-08 13:02 ` [PATCH v2] org-id: allow using parent's existing id in links to headlines 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=2a4b236c-c377-4493-b5ed-632c5518d514@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).