daniel/emacs
1
2
Fork 0
Code Issues 7 Pull Requests Projects Releases Wiki Activity

update packages

Browse Source
This commit is contained in:
Daniel Weschke
2025-06-22 17:08:08 +02:00
parent 54e5633369
commit 16a0a6db93
558 changed files with 68349 additions and 26568 deletions
Download Patch File Download Diff File Expand all files Collapse all files

301
lisp/org/org-id.el
View File

@@ -1,9 +1,9 @@
;;; org-id.el --- Global identifiers for Org entries -*- lexical-binding: t; -*-
;;
;; Copyright (C) 2008-2023 Free Software Foundation, Inc.
;; Copyright (C) 2008-2025 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten.dominik@gmail.com>
;; Keywords: outlines, hypermedia, calendar, wp
;; Keywords: outlines, hypermedia, calendar, text
;; URL: https://orgmode.org
;;
;; This file is part of GNU Emacs.
@@ -29,13 +29,13 @@
;; are provided that create and retrieve such identifiers, and that find
;; entries based on the identifier.
;; Identifiers consist of a prefix (default "Org" given by the variable
;; Identifiers consist of a prefix (given by the variable
;; `org-id-prefix') and a unique part that can be created by a number
;; of different methods, see the variable `org-id-method'.
;; Org has a builtin method that uses a compact encoding of the creation
;; time of the ID, with microsecond accuracy. This virtually
;; guarantees globally unique identifiers, even if several people are
;; creating IDs at the same time in files that will eventually be used
;; of different methods, see the variable `org-id-method'. Org has a
;; builtin method that uses a compact encoding of the creation time of
;; the ID, with microsecond accuracy. This virtually guarantees
;; globally unique identifiers, even if several people are creating
;; IDs at the same time in files that will eventually be used
;; together.
;;
;; By default Org uses UUIDs as global unique identifiers.
@@ -74,6 +74,7 @@
(org-assert-version)
(require 'org)
(require 'org-element-ast)
(require 'org-refile)
(require 'ol)
@@ -128,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
@@ -225,6 +266,8 @@ systems."
(defvar org-id-locations nil
"List of files with IDs in those files.")
(defvar org-id--locations-checksum nil
"Last checksum corresponding to ID files and their modifications.")
(defvar org-id-files nil
"List of files that contain IDs.")
@@ -277,25 +320,32 @@ 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 pom create prefix)
"Get the ID property of the entry at point-or-marker POM.
If POM 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."
(org-with-point-at pom
(let ((id (org-entry-get nil "ID")))
(cond
((and id (stringp id) (string-match "\\S-" id))
id)
(create
(setq id (org-id-new prefix))
(org-entry-put pom "ID" id)
(org-id-add-location 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)
(create
(setq id (org-id-new prefix))
(org-entry-put epom "ID" id)
(org-with-point-at epom
(org-id-add-location id
(or org-id-overriding-file-name
(buffer-file-name (buffer-base-buffer))))
id)))))
(buffer-file-name (buffer-base-buffer)))))
id))))
;;;###autoload
(defun org-id-get-with-outline-path-completion (&optional targets)
@@ -399,30 +449,6 @@ So a typical ID could look like \"Org:4nd91V40HI\"."
(t (error "Invalid `org-id-method'")))
(concat prefix unique)))
(defun org-id-uuid ()
"Return string with random (version 4) UUID."
(let ((rnd (md5 (format "%s%s%s%s%s%s%s"
(random)
(org-time-convert-to-list nil)
(user-uid)
(emacs-pid)
(user-full-name)
user-mail-address
(recent-keys)))))
(format "%s-%s-4%s-%s%s-%s"
(substring rnd 0 8)
(substring rnd 8 12)
(substring rnd 13 16)
(format "%x"
(logior
#b10000000
(logand
#b10111111
(string-to-number
(substring rnd 16 18) 16))))
(substring rnd 18 20)
(substring rnd 20 32))))
(defun org-id-int-to-b36-one-digit (integer)
"Convert INTEGER between 0 and 61 into a single character 0..9, A..Z, a..z."
(cond
@@ -500,7 +526,6 @@ If SILENT is non-nil, messages are suppressed."
(interactive)
(unless org-id-track-globally
(error "Please turn on `org-id-track-globally' if you want to track IDs"))
(setq org-id-locations nil)
(let* ((files
(delete-dups
(mapcar #'file-truename
@@ -524,11 +549,18 @@ If SILENT is non-nil, messages are suppressed."
(nfiles (length files))
(id-regexp
(rx (seq bol (0+ (any "\t ")) ":ID:" (1+ " ") (not (any " ")))))
(seen-ids nil)
(seen-ids (make-hash-table :test #'equal))
(ndup 0)
(i 0))
(with-temp-buffer
(org-element-with-disabled-cache
(i 0)
(checksum
(mapcar
(lambda (f)
(when (file-exists-p f)
(list f (file-attribute-modification-time (file-attributes f)))))
(sort (copy-sequence files) #'string<))))
(unless (equal checksum org-id--locations-checksum) ; Files have changed since the last update.
(setq org-id-locations nil)
(with-temp-buffer
(delay-mode-hooks
(org-mode)
(dolist (file files)
@@ -538,29 +570,32 @@ If SILENT is non-nil, messages are suppressed."
(message "Finding ID locations (%d/%d files): %s" i nfiles file))
(insert-file-contents file nil nil nil 'replace)
(let ((ids nil)
node
(case-fold-search t))
(org-with-point-at 1
(while (re-search-forward id-regexp nil t)
(when (org-at-property-p)
(push (org-entry-get (point) "ID") ids)))
(setq node (org-element-at-point))
(when (org-element-type-p node 'node-property)
(push (org-element-property :value node) ids)))
(when ids
(push (cons (abbreviate-file-name file) ids)
org-id-locations)
(dolist (id ids)
(cond
((not (member id seen-ids)) (push id seen-ids))
((not (gethash id seen-ids)) (puthash id t seen-ids))
(silent nil)
(t
(message "Duplicate ID %S" id)
(cl-incf ndup))))))))))))
(setq org-id-files (mapcar #'car org-id-locations))
(org-id-locations-save)
;; Now convert to a hash table.
(setq org-id-locations (org-id-alist-to-hash org-id-locations))
(when (and (not silent) (> ndup 0))
(warn "WARNING: %d duplicate IDs found, check *Messages* buffer" ndup))
(message "%d files scanned, %d files contains IDs, and %d IDs found."
nfiles (length org-id-files) (hash-table-count org-id-locations))
(cl-incf ndup)))))))))))
(setq org-id-files (mapcar #'car org-id-locations))
(org-id-locations-save)
;; Now convert to a hash table.
(setq org-id-locations (org-id-alist-to-hash org-id-locations))
(setq org-id--locations-checksum checksum)
(when (and (not silent) (> ndup 0))
(warn "WARNING: %d duplicate IDs found, check *Messages* buffer" ndup))
(message "%d files scanned, %d files contains IDs, and %d IDs found."
nfiles (length org-id-files) (hash-table-count org-id-locations)))
org-id-locations))
(defun org-id-locations-save ()
@@ -686,34 +721,81 @@ optional argument MARKERP, return the position as a new marker."
((not (file-exists-p file)) nil)
(t
(let* ((visiting (find-buffer-visiting file))
(buffer (or visiting (find-file-noselect file))))
(buffer (or visiting
(if markerp (find-file-noselect file)
(org-get-buffer-create " *Org ID temp*" t)))))
(unwind-protect
(with-current-buffer buffer
(unless (derived-mode-p 'org-mode) (org-mode))
(unless (or visiting markerp)
(buffer-disable-undo)
;; FIXME: In Emacs 27, `insert-file-contents' seemingly
;; does not trigger modification hooks in some
;; scenarios. This is manifested in test failures due
;; to element cache losing track of the modifications.
(org-element-cache-reset)
(insert-file-contents file nil nil nil 'replace))
(let ((pos (org-find-entry-with-id id)))
(cond
((null pos) nil)
(markerp (move-marker (make-marker) pos buffer))
(t (cons file pos)))))
;; Remove opened buffer in the process.
(unless (or visiting markerp) (kill-buffer buffer)))))))
;; Clean temporarily buffer if we don't need to keep it.
(unless (or visiting markerp)
(with-current-buffer buffer (erase-buffer))))))))
;; 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
@@ -725,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
@@ -749,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)