From: "Rick Lupton" <mail@ricklupton.name>
To: "Ihor Radchenko" <yantar92@posteo.net>
Cc: "Y. E." <emacs-orgmode@gnu.org>
Subject: [PATCH v2] org-id: allow using parent's existing id in links to headlines
Date: Sun, 17 Dec 2023 19:07:08 +0000 [thread overview]
Message-ID: <c98a38b0-6dea-4b5c-b00f-a39ea922537f@app.fastmail.com> (raw)
In-Reply-To: <87bkaqcjpz.fsf@localhost>
[-- Attachment #1: Type: text/plain, Size: 151 bytes --]
Please find attached updated patch which I think addresses all the points discussed. Let me know if you see any further changes needed.
Thanks,
Rick
[-- Attachment #2: 0001-org-id.el-Extend-links-with-search-strings-inherit-v2.patch --]
[-- Type: application/octet-stream, Size: 39400 bytes --]
diff --git a/doc/org-manual.org b/doc/org-manual.org
index ee2413248..a82265e04 100644
--- a/doc/org-manual.org
+++ b/doc/org-manual.org
@@ -3296,10 +3296,6 @@ Here is the full set of built-in link types:
File links. File name may be remote, absolute, or relative.
- Additionally, you can specify a line number, or a text search.
- In Org files, you may link to a headline name, a custom ID, or a
- code reference instead.
-
As a special case, "file" prefix may be omitted if the file name
is complete, e.g., it starts with =./=, or =/=.
@@ -3363,44 +3359,50 @@ Here is the full set of built-in link types:
Execute a shell command upon activation.
+
+For =file:= and =id:= links, you can additionally specify a line
+number, or a text search string, separated by =::=. In Org files, you
+may link to a headline name, a custom ID, or a code reference instead.
+
The following table illustrates the link types above, along with their
options:
-| Link Type | Example |
-|------------+----------------------------------------------------------|
-| http | =http://staff.science.uva.nl/c.dominik/= |
-| https | =https://orgmode.org/= |
-| doi | =doi:10.1000/182= |
-| file | =file:/home/dominik/images/jupiter.jpg= |
-| | =/home/dominik/images/jupiter.jpg= (same as above) |
-| | =file:papers/last.pdf= |
-| | =./papers/last.pdf= (same as above) |
-| | =file:/ssh:me@some.where:papers/last.pdf= (remote) |
-| | =/ssh:me@some.where:papers/last.pdf= (same as above) |
-| | =file:sometextfile::NNN= (jump to line number) |
-| | =file:projects.org= |
-| | =file:projects.org::some words= (text search)[fn:12] |
-| | =file:projects.org::*task title= (headline search) |
-| | =file:projects.org::#custom-id= (headline search) |
-| attachment | =attachment:projects.org= |
-| | =attachment:projects.org::some words= (text search) |
-| docview | =docview:papers/last.pdf::NNN= |
-| id | =id:B7423F4D-2E8A-471B-8810-C40F074717E9= |
-| news | =news:comp.emacs= |
-| mailto | =mailto:adent@galaxy.net= |
-| mhe | =mhe:folder= (folder link) |
-| | =mhe:folder#id= (message link) |
-| rmail | =rmail:folder= (folder link) |
-| | =rmail:folder#id= (message link) |
-| gnus | =gnus:group= (group link) |
-| | =gnus:group#id= (article link) |
-| bbdb | =bbdb:R.*Stallman= (record with regexp) |
-| irc | =irc:/irc.com/#emacs/bob= |
-| help | =help:org-store-link= |
-| info | =info:org#External links= |
-| shell | =shell:ls *.org= |
-| elisp | =elisp:(find-file "Elisp.org")= (Elisp form to evaluate) |
-| | =elisp:org-agenda= (interactive Elisp command) |
+| Link Type | Example |
+|------------+--------------------------------------------------------------------|
+| http | =http://staff.science.uva.nl/c.dominik/= |
+| https | =https://orgmode.org/= |
+| doi | =doi:10.1000/182= |
+| file | =file:/home/dominik/images/jupiter.jpg= |
+| | =/home/dominik/images/jupiter.jpg= (same as above) |
+| | =file:papers/last.pdf= |
+| | =./papers/last.pdf= (same as above) |
+| | =file:/ssh:me@some.where:papers/last.pdf= (remote) |
+| | =/ssh:me@some.where:papers/last.pdf= (same as above) |
+| | =file:sometextfile::NNN= (jump to line number) |
+| | =file:projects.org= |
+| | =file:projects.org::some words= (text search)[fn:12] |
+| | =file:projects.org::*task title= (headline search) |
+| | =file:projects.org::#custom-id= (headline search) |
+| attachment | =attachment:projects.org= |
+| | =attachment:projects.org::some words= (text search) |
+| docview | =docview:papers/last.pdf::NNN= |
+| id | =id:B7423F4D-2E8A-471B-8810-C40F074717E9= |
+| | =id:B7423F4D-2E8A-471B-8810-C40F074717E9::*task= (headline search) |
+| news | =news:comp.emacs= |
+| mailto | =mailto:adent@galaxy.net= |
+| mhe | =mhe:folder= (folder link) |
+| | =mhe:folder#id= (message link) |
+| rmail | =rmail:folder= (folder link) |
+| | =rmail:folder#id= (message link) |
+| gnus | =gnus:group= (group link) |
+| | =gnus:group#id= (article link) |
+| bbdb | =bbdb:R.*Stallman= (record with regexp) |
+| irc | =irc:/irc.com/#emacs/bob= |
+| help | =help:org-store-link= |
+| info | =info:org#External links= |
+| shell | =shell:ls *.org= |
+| elisp | =elisp:(find-file "Elisp.org")= (Elisp form to evaluate) |
+| | =elisp:org-agenda= (interactive Elisp command) |
#+cindex: VM links
#+cindex: Wanderlust links
@@ -3461,8 +3463,9 @@ current buffer:
- /Org mode buffers/ ::
For Org files, if there is a =<<target>>= at point, the link points
- to the target. Otherwise it points to the current headline, which
- is also the description.
+ to the target. If there is a named block (using =#+name:=) at
+ point, the link points to that name. Otherwise it points to the
+ current headline, which is also the description.
#+vindex: org-id-link-to-org-use-id
#+cindex: @samp{CUSTOM_ID}, property
@@ -3480,6 +3483,13 @@ current buffer:
timestamp, depending on ~org-id-method~. Later, when inserting the
link, you need to decide which one to use.
+ #+vindex: org-id-link-consider-parent-id
+ When ~org-id-link-consider-parent-id~ is ~t~, parent =ID= properties
+ are considered. This allows linking to specific targets, named
+ blocks, or headlines (which may not have a globally unique =ID=
+ themselves) within the context of a parent headline or file which
+ does.
+
- /Email/News clients: VM, Rmail, Wanderlust, MH-E, Gnus/ ::
#+vindex: org-link-email-description-format
@@ -3753,13 +3763,15 @@ the link completion function like this:
(org-link-set-parameter "type" :complete #'some-completion-function)
#+end_src
-** Search Options in File Links
+** Search Options in File and ID Links
:PROPERTIES:
:DESCRIPTION: Linking to a specific location.
:ALT_TITLE: Search Options
:END:
#+cindex: search option in file links
+#+cindex: search option in id links
#+cindex: file links, searching
+#+cindex: id links, searching
#+cindex: attachment links, searching
File links can contain additional information to make Emacs jump to a
@@ -3771,8 +3783,8 @@ example, when the command ~org-store-link~ creates a link (see
line as a search string that can be used to find this line back later
when following the link with {{{kbd(C-c C-o)}}}.
-Note that all search options apply for Attachment links in the same
-way that they apply for File links.
+Note that all search options apply for Attachment and ID links in the
+same way that they apply for File links.
Here is the syntax of the different ways to attach a search to a file
link, together with explanations for each:
@@ -21252,7 +21264,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.
@@ -21312,13 +21324,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 6c81221c1..426e8e820 100644
--- a/etc/ORG-NEWS
+++ b/etc/ORG-NEWS
@@ -283,6 +283,12 @@ timestamp object. Possible values: ~timerange~, ~daterange~, ~nil~.
~org-element-timestamp-interpreter~ takes into account this property
and returns an appropriate timestamp string.
+**** =org-link= store functions are passed an ~interactive?~ argument
+
+The ~:store:~ functions set for link types using
+~org-link-set-parameters~ are now passed an ~interactive?~ argument,
+indicating whether ~org-store-link~ was called interactively.
+
*** ~org-priority=show~ command no longer adjusts for scheduled/deadline
In agenda views, ~org-priority=show~ command previously displayed the
@@ -361,6 +367,18 @@ 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 when storing a specific link by
+passing a prefix argument to ~org-store-link~.
+
+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).
+
** New and changed options
*** New variable ~org-clock-out-removed-last-clock~
@@ -544,6 +562,22 @@ Currently implemented options are:
The capture template expansion element =%K= creates links using
~org-store-link~, which respects the values of ~org-id-link-to-use-id~.
+*** New option ~org-id-link-consider-parent-id~ to allow =id:= links to parent headlines
+
+For =id:= links, when this option is enabled, ~org-store-link~ will
+look for ids from parent/ancestor headlines, if the current headline
+does not have an id.
+
+Combined with the new ability for =id:= links to use search strings
+for precise link targets (when =org-id-link-use-context= is =t=, which
+is the default), this allows linking to specific headlines without
+requiring every headline to have an id property, as long as the
+headline is unique within a subtree that does have an id property.
+
+By giving files top-level id properties, links to headlines in the
+file can be made more robust by using the file id instead of the file
+path.
+
** New features
*** =ob-plantuml.el=: Support tikz file format output
@@ -808,6 +842,11 @@ as the function can also act on objects.
*** ~org-export-get-parent~ is renamed to ~org-element-parent~ and moved to =lisp/org-element.el=
*** ~org-export-get-parent-element~ is renamed to ~org-element-parent-element~ and moved to =lisp/org-element.el=
+*** New optional argument for ~org-id-get~ and ~org-id-get-create~
+
+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.el b/lisp/ol.el
index 6480b780d..b6f5c7ce7 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,44 @@ 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.
+
+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?)
+ ;; XXX: The store function used (< Org 9.7) to accept no
+ ;; arguments; provide backward compatibility support for
+ ;; them.
+ (wrong-number-of-arguments
+ (funcall f)))
+ ;; XXX: return value is not link's plist, so we
+ ;; store the new value before it is modified. It
+ ;; would be cleaner to ask store link functions to
+ ;; return the plist instead.
+ (push (cons f (copy-sequence org-store-link-plist))
+ results-alist)))
+ (pcase results-alist
+ (`nil nil)
+ (`((,_ . ,_)) t) ;single choice: nothing to do
+ (`((,name . ,_) . ,_)
+ ;; Reinstate link plist associated to the chosen
+ ;; function.
+ (apply #'org-link-store-props
+ (cdr (assoc-string
+ (completing-read
+ (format "Store link with (default %s): " name)
+ (mapcar #'car results-alist)
+ nil t nil nil (symbol-name name))
+ results-alist)))
+ t))))
+
\f
;;; Public API
@@ -1335,6 +1372,57 @@ priority cookie or tag."
(org-link--normalize-string
(or string (org-get-heading t t t t)))))
+(defun org-link-precise-link-target (&optional relative-to)
+ "Determine search string and description for storing a link.
+
+If a search string is found, return cons cell (SEARCH-STRING
+. DESC). Otherwise, return nil.
+
+If there is an active region, the contents is used (see
+`org-link--context-from-region').
+
+In org-mode buffers, if point is at a named element (e.g. a
+source block), the name is used. If within a heading, the current
+heading is used.
+
+If none of those finds a suitable search string, the current line
+is used as the search string.
+
+Optional argument RELATIVE-TO specifies the buffer position where
+the search will start from. If the search target that would be
+returned is already at this location, return nil to avoid
+unnecessary search strings (for example, when using search
+strings to find targets within org-id links)."
+ (let ((result
+ (cond
+ ((derived-mode-p 'org-mode)
+ (let* ((element (org-element-at-point))
+ (name (org-element-property :name element))
+ (heading (org-element-lineage element 'headline t)))
+ (cond
+ ((let ((region (org-link--context-from-region)))
+ (and region (cons (org-link--normalize-string region t) nil))))
+ (name
+ (cons name name))
+ ((org-before-first-heading-p)
+ (cons (org-link--normalize-string (org-current-line-string) t) nil))
+ ((and heading
+ (> (org-element-begin heading) (or relative-to 0)))
+ (cons (org-link-heading-search-string)
+ (org-link--normalize-string
+ (org-get-heading t t t t)))))))
+
+ ;; Not in an org-mode buffer
+ (t
+ (cons (org-link--normalize-string
+ (or (org-link--context-from-region) (org-current-line-string))
+ t)
+ nil)))))
+
+ ;; Only use search option if there is some text.
+ (when (org-string-nw-p (car result))
+ result)))
+
(defun org-link-open-as-file (path in-emacs)
"Pretend PATH is a file name and open it.
@@ -1557,36 +1645,17 @@ 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
+ (let ((org-link-context-for-files (org-xor org-link-context-for-files
+ (equal arg '(4))))
+ link cpltxt desc search custom-id 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. If more than one can generate a link from
+ ;; current location, ask which one to use. Negate
+ ;; `org-context-in-file-links' when given a single prefix arg.
((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 +1706,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 +1715,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,12 +1733,20 @@ non-nil."
(setq cpltxt (concat "file:" file)
link cpltxt)))
+ ;; Try `org-create-file-search-functions`. If any are
+ ;; successful, create a file link to the current buffer with
+ ;; the provided search string. (sets `link` and `cpltxt` to
+ ;; the same thing; it looks like the intention originally was
+ ;; that cpltxt was a description, which might have been set by
+ ;; the search-function (removed in switch to lexical binding)).
((setq search (run-hook-with-args-until-success
'org-create-file-search-functions))
(setq link (concat "file:" (abbreviate-file-name buffer-file-name)
"::" search))
(setq cpltxt (or link))) ;; description
+ ;; Main logic for storing built-in link types in org-mode
+ ;; buffers
((and (buffer-file-name (buffer-base-buffer)) (derived-mode-p 'org-mode))
(org-with-limited-levels
(setq custom-id (org-entry-get nil "CUSTOM_ID"))
@@ -1687,71 +1766,33 @@ non-nil."
desc nil
;; Do not append #CUSTOM_ID link below.
custom-id nil))
- ((and (featurep 'org-id)
- (or (eq org-id-link-to-org-use-id t)
- (and interactive?
- (or (eq org-id-link-to-org-use-id 'create-if-interactive)
- (and (eq org-id-link-to-org-use-id
- 'create-if-interactive-and-no-custom-id)
- (not custom-id))))
- (and org-id-link-to-org-use-id (org-entry-get nil "ID"))))
- ;; Store a link using the ID at point
- (setq link (condition-case nil
- (prog1 (org-id-store-link)
- (setq desc (plist-get org-store-link-plist :description)))
- (error
- ;; Probably before first headline, link only to file
- (concat "file:"
- (abbreviate-file-name
- (buffer-file-name (buffer-base-buffer))))))))
- (t
+ (t
;; Just link to current headline.
(setq cpltxt (concat "file:"
(abbreviate-file-name
(buffer-file-name (buffer-base-buffer)))))
- ;; Add a context search string.
- (when (org-xor org-link-context-for-files (equal arg '(4)))
- (let* ((element (org-element-at-point))
- (name (org-element-property :name element))
- (context
- (cond
- ((let ((region (org-link--context-from-region)))
- (and region (org-link--normalize-string region t))))
- (name)
- ((org-before-first-heading-p)
- (org-link--normalize-string (org-current-line-string) t))
- (t (org-link-heading-search-string)))))
- (when (org-string-nw-p context)
- (setq cpltxt (format "%s::%s" cpltxt context))
- (setq desc
- (or name
- ;; Although description is not a search
- ;; string, use `org-link--normalize-string'
- ;; to prettify it (contiguous white spaces)
- ;; and remove volatile contents (statistics
- ;; cookies).
- (and (not (org-before-first-heading-p))
- (org-link--normalize-string
- (org-get-heading t t t t)))
- "NONE")))))
- (setq link cpltxt)))))
-
+ (when org-link-context-for-files
+ (pcase (org-link-precise-link-target)
+ (`nil nil)
+ (`(,search-string . ,search-desc)
+ (setq cpltxt (format "%s::%s" cpltxt search-string))
+ (setq desc search-desc))))
+ (setq link cpltxt)))))
+
+ ;; Buffer linked to file, but not an org-mode buffer.
((buffer-file-name (buffer-base-buffer))
;; Just link to this file here.
(setq cpltxt (concat "file:"
(abbreviate-file-name
(buffer-file-name (buffer-base-buffer)))))
;; Add a context search string.
- (when (org-xor org-link-context-for-files (equal arg '(4)))
- (let ((context (org-link--normalize-string
- (or (org-link--context-from-region)
- (org-current-line-string))
- t)))
- ;; Only use search option if there is some text.
- (when (org-string-nw-p context)
- (setq cpltxt (format "%s::%s" cpltxt context))
- (setq desc "NONE"))))
- (setq link cpltxt))
+ (when org-link-context-for-files
+ (pcase (org-link-precise-link-target)
+ (`nil nil)
+ (`(,search-string . ,search-desc)
+ (setq cpltxt (format "%s::%s" cpltxt search-string))
+ (setq desc search-desc))))
+ (setq link cpltxt))
(interactive?
(user-error "No method for storing a link from this buffer"))
diff --git a/lisp/org-id.el b/lisp/org-id.el
index fbe6a0ed0..f3175b23e 100644
--- a/lisp/org-id.el
+++ b/lisp/org-id.el
@@ -129,6 +129,49 @@ 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, 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' set to t, storing a link
+with point at \"Child 1\" will produce a link \"id:abc\" to
+\"Parent\".
+
+This is particularly useful with `org-id-link-use-context'
+enabled, as it allows linking to uniquely-named sub-entries
+within a parent entry with an ID, without requiring every
+sub-entry to have its own ID. In that case, the example link
+above would be \"id:abc::*Child 1\", which links directly to
+\"Child 1\" despite it not having its own ID property."
+ :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
@@ -258,14 +301,17 @@ This variable is only relevant when `org-id-track-globally' is set."
;;; The API functions
;;;###autoload
-(defun org-id-get-create (&optional force)
+(defun org-id-get-create (&optional force inherit)
"Create an ID for the current entry and return it.
If the entry already has an ID, just return it.
-With optional argument FORCE, force the creation of a new ID."
+With optional argument FORCE, force the creation of a new ID.
+With optional argument INHERIT, consider parents' IDs if the
+current entry does not have one."
(interactive "P")
(when force
- (org-entry-put (point) "ID" nil))
- (org-id-get (point) 'create))
+ (org-entry-put (point) "ID" nil)
+ (setq inherit nil))
+ (org-id-get (point) 'create nil inherit))
;;;###autoload
(defun org-id-copy ()
@@ -280,15 +326,16 @@ This is useful when working with contents in a temporary buffer
that will be copied back to the original.")
;;;###autoload
-(defun org-id-get (&optional epom create prefix)
+(defun org-id-get (&optional epom create prefix inherit)
"Get the ID property of the entry at EPOM.
EPOM is an element, marker, or buffer position.
If EPOM is nil, refer to the entry at point.
If the entry does not have an ID, the function returns nil.
+If INHERIT is non-nil, parents' IDs are also considered.
However, when CREATE is non-nil, create an ID if none is present already.
PREFIX will be passed through to `org-id-new'.
In any case, the ID of the entry is returned."
- (let ((id (org-entry-get epom "ID")))
+ (let ((id (org-entry-get epom "ID" (and inherit t))))
(cond
((and id (stringp id) (string-match "\\S-" id))
id)
@@ -707,14 +754,26 @@ optional argument MARKERP, return the position as a new marker."
(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 `org-id-link-consider-parent-id' is non-nil, ID properties
+are inherited from parent entries."
(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))
+ (let* ((link (concat "id:" (org-id-get-create nil org-id-link-consider-parent-id)))
+ (id-location (or (and org-entry-property-inherited-from
+ (marker-position org-entry-property-inherited-from))
+ (save-excursion (org-back-to-heading-or-point-min) (point))))
(case-fold-search nil)
(desc (save-excursion
- (org-back-to-heading-or-point-min t)
+ (goto-char id-location)
(cond ((org-before-first-heading-p)
(let ((keywords (org-collect-keywords '("TITLE"))))
(if keywords
@@ -726,14 +785,59 @@ or filename if no title."
(match-string 4)
(match-string 0)))
(t link)))))
+ (when (and org-link-context-for-files org-id-link-use-context)
+ (pcase (org-link-precise-link-target id-location)
+ (`nil nil)
+ (`(,search-string . ,search-desc)
+ (setq link (concat link "::" search-string))
+ (setq desc search-desc))))
(org-link-store-props :link link :description desc :type "id")
link)))
-(defun org-id-open (id _)
- "Go to the entry with id ID."
- (org-mark-ring-push)
- (let ((m (org-id-find id 'marker))
- cmd)
+;;;###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."
+ (interactive "p")
+ (when (and (buffer-file-name (buffer-base-buffer))
+ (derived-mode-p 'org-mode)
+ (or (eq org-id-link-to-org-use-id t)
+ (and interactive?
+ (or (eq org-id-link-to-org-use-id 'create-if-interactive)
+ (and (eq org-id-link-to-org-use-id
+ 'create-if-interactive-and-no-custom-id)
+ (not (org-entry-get nil "CUSTOM_ID")))))
+ (and org-id-link-to-org-use-id
+ (org-entry-get nil "ID" org-id-link-consider-parent-id))))
+ (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 +854,16 @@ 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)))
(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/testing/lisp/test-ol.el b/testing/lisp/test-ol.el
index e0cec0854..fa8d15c2b 100644
--- a/testing/lisp/test-ol.el
+++ b/testing/lisp/test-ol.el
@@ -381,6 +381,132 @@ See https://github.com/yantar92/org/issues/4."
(equal (format "[[file:%s::*foo bar][foo bar]]" file file)
(org-store-link nil)))))))
+(ert-deftest test-org-link/precise-link-target ()
+ "Test `org-link-precise-link-target` specifications."
+ (should
+ (equal '("*H1" . "H1")
+ (org-test-with-temp-text "* H1<point>\n* H2\n"
+ (org-link-precise-link-target))))
+ (should
+ (equal '("foo" . "foo")
+ (org-test-with-temp-text "* H1\n#+name: foo<point>\n#+begin_example\nhi\n#+end_example\n"
+ (org-link-precise-link-target))))
+ (should
+ (equal '("Text" . nil)
+ (org-test-with-temp-text "\nText<point>\n* H1\n"
+ (org-link-precise-link-target))))
+ (should
+ (equal nil
+ (org-test-with-temp-text "\n<point>\n* H1\n"
+ (org-link-precise-link-target))))
+ ;; relative to a heading
+ (should
+ (equal nil
+ (org-test-with-temp-text "* H1<point>\n* H2\n"
+ (org-link-precise-link-target 1))))
+ (should
+ (equal '("*H2" . "H2")
+ (org-test-with-temp-text "* H1\n* H2<point>\n"
+ (org-link-precise-link-target 1))))
+ (should
+ (equal nil
+ (org-test-with-temp-text "* H1\n* H2<point>\n"
+ (org-link-precise-link-target 6))))
+ )
+
+(defmacro test-ol-stored-link-with-text (text &rest body)
+ "Return :link and :description from link stored in body."
+ (declare (indent 1))
+ `(let (org-store-link-plist)
+ (org-test-with-temp-text-in-file ,text
+ ,@body
+ (list (plist-get org-store-link-plist :link)
+ (plist-get org-store-link-plist :description)))))
+
+(ert-deftest test-org-link/id-store-link ()
+ "Test `org-id-store-link' specifications."
+ (let ((org-id-link-to-org-use-id nil))
+ (should
+ (equal '(nil nil)
+ (test-ol-stored-link-with-text "* H1\n:PROPERTIES:\n:ID: abc\n:END:\n"
+ (org-id-store-link-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))))))
+
+(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-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)))))
+ ;; when not using context, description should be the parent/file
+ (let ((org-id-link-consider-parent-id t)
+ (org-id-link-use-context nil))
+ (should
+ (equal '("id:abc" "H1")
+ (test-ol-stored-link-with-text "* H1\n:PROPERTIES:\n:ID: abc\n:END:\n** H2\n<point>"
+ (org-id-store-link))))
+ (should
+ (let ((result (test-ol-stored-link-with-text ":PROPERTIES:\n:ID: top\n:END:\n:* H1\n<point>"
+ (org-id-store-link))))
+ (equal "id:top" (car result))
+ ;; strip random buffer file name
+ (equal "org-test" (substring (cadr result) 0 8))))
+ (should
+ (equal '("id:top" "title")
+ (test-ol-stored-link-with-text ":PROPERTIES:\n:ID: top\n:END:\n#+TITLE: title\n\n:* H1\n<point>"
+ (org-id-store-link))))))
+
\f
;;; Radio Targets
next prev parent reply other threads:[~2023-12-17 19:08 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 ` Rick Lupton [this message]
2023-12-18 12:27 ` [PATCH v2] " Ihor Radchenko
2024-01-02 16:13 ` Rick Lupton
2024-01-03 14:17 ` Ihor Radchenko
2024-01-28 22:47 ` Rick Lupton
2024-01-29 0:20 ` Samuel Wales
2024-01-29 13:06 ` Ihor Radchenko
2024-01-30 0:03 ` Samuel Wales
2024-02-03 15:08 ` Ihor Radchenko
2024-01-29 13:00 ` Ihor Radchenko
2024-01-31 18:11 ` Rick Lupton
2024-02-01 12:13 ` Ihor Radchenko
2024-02-01 16:37 ` Rick Lupton
2024-02-03 13:10 ` Ihor Radchenko
2024-02-08 8:24 ` [PATCH] lisp/ol.el: Improve docstring Rick Lupton
2024-02-08 14:52 ` Ihor Radchenko
2024-02-08 8:46 ` [PATCH v2] org-id: allow using parent's existing id in links to headlines Rick Lupton
2024-02-08 13:02 ` Ihor Radchenko
2024-02-08 22:30 ` Rick Lupton
2024-02-09 12:09 ` Ihor Radchenko
2024-02-09 12:47 ` Rick Lupton
2024-02-09 12:57 ` Ihor Radchenko
2024-02-24 10:48 ` Bastien Guerry
2024-02-24 13:02 ` Ihor Radchenko
2024-02-24 15:57 ` Rick Lupton
2024-03-05 14:05 ` Stefan
2024-03-05 14:51 ` Ihor Radchenko
2023-11-04 23:01 ` [PATCH] " Rick Lupton
2023-11-05 12:31 ` Ihor Radchenko
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.orgmode.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=c98a38b0-6dea-4b5c-b00f-a39ea922537f@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).