mirror/org-mode
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs/org-mode.git synced 2024-12-22 10:26:23 +00:00
Code

org-id.el: Add search strings, inherit parent IDs

Browse Source 
* 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/
This commit is contained in:
Rick Lupton 2023-11-19 14:52:05 +00:00 committed by Ihor Radchenko
parent 6e7e0b2cd3
commit 95554543b9
No known key found for this signature in database
GPG Key ID: 6470762A7DA11D8B
17 changed files with 673 additions and 204 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

67
doc/org-manual.org
View File

@ -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,11 +3363,16 @@ 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= |
@ -3390,6 +3391,7 @@ options:
| | =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) |
@ -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,32 @@ 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
#+vindex: org-link-context-for-files
When ~org-id-link-consider-parent-id~ is ~t~[fn:: Also,
~org-link-context-for-files~ and ~org-id-link-use-context~ should be
both enabled (which they are, by default).], 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:
#+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 +3792,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 +3806,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:
@ -21522,7 +21553,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.
@ -21582,13 +21613,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:

72
etc/ORG-NEWS
View File

@ -460,6 +460,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
@ -538,6 +546,28 @@ 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.
*** =id:= links support search options; ~org-id-store-link~ adds search option by default
Adding search option by ~org-id-store-link~ can be disabled by setting
~org-id-link-use-context~ to ~nil~, or toggled for a single call by
passing 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 search option). A new org-lint checker
has been added to warn about this.
*** ~org-store-link~ behaviour storing additional =CUSTOM_ID= links has changed
Previously, when storing =id:= link, ~org-store-link~ stored an
additional "human readable" link using a node's =CUSTOM_ID= property.
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
*** New option ~org-beamer-frame-environment~
@ -868,6 +898,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 options
[fn:: 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
@ -1164,6 +1223,19 @@ 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).
*** New optional argument for ~org-link-search~
If a missing heading is created to match the search string, the new
optional argument =NEW-HEADING-CONTAINER= specifies where in the
buffer it will be added. If not specified, new headings are created
at level 1 at the end of the accessible part of the buffer, as before.
** Miscellaneous
*** =org-crypt.el= now applies initial visibility settings to decrypted entries

2
lisp/ol-bbdb.el
View File

@ -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!

2
lisp/ol-bibtex.el
View File

@ -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))

2
lisp/ol-docview.el
View File

@ -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

2
lisp/ol-eshell.el
View File

@ -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."

2
lisp/ol-eww.el
View File

@ -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

2
lisp/ol-gnus.el
View File

@ -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

2
lisp/ol-info.el
View File

@ -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:"

2
lisp/ol-irc.el
View File

@ -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)

2
lisp/ol-man.el
View File

@ -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

2
lisp/ol-mhe.el
View File

@ -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))

2
lisp/ol-rmail.el
View File

@ -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))

320
lisp/ol.el
View File

@ -57,13 +57,13 @@
(declare-function org-element-link-parser "org-element" ())
(declare-function org-element-property "org-element-ast" (property node))
(declare-function org-element-begin "org-element" (node))
(declare-function org-element-end "org-element" (node))
(declare-function org-element-type-p "org-element-ast" (node types))
(declare-function org-element-update-syntax "org-element" ())
(declare-function org-entry-get "org" (pom property &optional inherit literal-nil))
(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 +818,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)))
;;; Public API
@ -1044,7 +1112,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 +1233,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 +1253,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 +1358,24 @@ 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))
(let* ((container-ok (and new-heading-container
(org-element-type-p new-heading-container '(headline))))
(new-heading-position (if container-ok
(- (org-element-end new-heading-container) 1)
(point-max)))
(new-heading-level (if container-ok
(+ 1 (org-element-property :level new-heading-container))
1)))
;; Need to widen when target is outside accessible portion of
;; buffer, since the we want the user to end up there.
(unless (and (<= (point-min) new-heading-position)
(>= (point-max) new-heading-position))
(widen))
(goto-char new-heading-position)
(unless (bolp) (newline))
(org-insert-heading nil t t)
(insert s "\n")
(forward-line -1))
(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 +1425,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 +1561,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 +1696,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,35 +1716,18 @@ 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))))
(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).
@ -1637,6 +1779,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 +1788,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 +1806,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,73 +1835,20 @@ 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))))))))
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")))))
(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"))))
(let ((here (org-link--file-link-to-here)))
(setq cpltxt (car here))
(setq desc (cdr here)))
(setq link cpltxt))
(interactive?
@ -1767,23 +1865,17 @@ 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))))
(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

176
lisp/org-id.el
View File

@ -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."
;;;###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)
(let ((m (org-id-find id 'marker))
cmd)
(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)

16
lisp/org-lint.el
View File

@ -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)
@ -1697,6 +1708,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

122
testing/lisp/test-ol.el
View File

@ -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))))))
;;; Radio Targets