org-id.el (33594B)
1 ;;; org-id.el --- Global identifiers for Org entries -*- lexical-binding: t; -*- 2 ;; 3 ;; Copyright (C) 2008-2024 Free Software Foundation, Inc. 4 ;; 5 ;; Author: Carsten Dominik <carsten.dominik@gmail.com> 6 ;; Keywords: outlines, hypermedia, calendar, text 7 ;; URL: https://orgmode.org 8 ;; 9 ;; This file is part of GNU Emacs. 10 ;; 11 ;; GNU Emacs is free software: you can redistribute it and/or modify 12 ;; it under the terms of the GNU General Public License as published by 13 ;; the Free Software Foundation, either version 3 of the License, or 14 ;; (at your option) any later version. 15 16 ;; GNU Emacs is distributed in the hope that it will be useful, 17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19 ;; GNU General Public License for more details. 20 21 ;; You should have received a copy of the GNU General Public License 22 ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. 23 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 24 ;; 25 ;;; Commentary: 26 27 ;; This file implements globally unique identifiers for Org entries. 28 ;; Identifiers are stored in the entry as an :ID: property. Functions 29 ;; are provided that create and retrieve such identifiers, and that find 30 ;; entries based on the identifier. 31 32 ;; Identifiers consist of a prefix (given by the variable 33 ;; `org-id-prefix') and a unique part that can be created by a number 34 ;; of different methods, see the variable `org-id-method'. Org has a 35 ;; builtin method that uses a compact encoding of the creation time of 36 ;; the ID, with microsecond accuracy. This virtually guarantees 37 ;; globally unique identifiers, even if several people are creating 38 ;; IDs at the same time in files that will eventually be used 39 ;; together. 40 ;; 41 ;; By default Org uses UUIDs as global unique identifiers. 42 ;; 43 ;; This file defines the following API: 44 ;; 45 ;; org-id-get-create 46 ;; Create an ID for the entry at point if it does not yet have one. 47 ;; Returns the ID (old or new). This function can be used 48 ;; interactively, with prefix argument the creation of a new ID is 49 ;; forced, even if there was an old one. 50 ;; 51 ;; org-id-get 52 ;; Get the ID property of an entry. Using appropriate arguments 53 ;; to the function, it can also create the ID for this entry. 54 ;; 55 ;; org-id-goto 56 ;; Command to go to a specific ID, this command can be used 57 ;; interactively. 58 ;; 59 ;; org-id-get-with-outline-path-completion 60 ;; Retrieve the ID of an entry, using outline path completion. 61 ;; This function can work for multiple files. 62 ;; 63 ;; org-id-get-with-outline-drilling 64 ;; Retrieve the ID of an entry, using outline path completion. 65 ;; This function only works for the current file. 66 ;; 67 ;; org-id-find 68 ;; Find the location of an entry with specific id. 69 ;; 70 71 ;;; Code: 72 73 (require 'org-macs) 74 (org-assert-version) 75 76 (require 'org) 77 (require 'org-element-ast) 78 (require 'org-refile) 79 (require 'ol) 80 81 (declare-function message-make-fqdn "message" ()) 82 (declare-function org-goto-location "org-goto" (&optional _buf help)) 83 ;; Declared inside `org-element-with-disabled-cache' macro. 84 (declare-function org-element--cache-active-p "org-element.el" (&optional called-from-cache-change-func-p)) 85 86 ;;; Customization 87 88 (defgroup org-id nil 89 "Options concerning global entry identifiers in Org mode." 90 :tag "Org ID" 91 :group 'org) 92 93 (defcustom org-id-link-to-org-use-id nil 94 "Non-nil means storing a link to an Org file will use entry IDs. 95 \\<org-mode-map> 96 The variable can have the following values: 97 98 t Create an ID if needed to make a link to the current entry. 99 100 create-if-interactive 101 If `org-store-link' is called directly (interactively, as a user 102 command), do create an ID to support the link. But when doing the 103 job for capture, only use the ID if it already exists. The 104 purpose of this setting is to avoid proliferation of unwanted 105 IDs, just because you happen to be in an Org file when you 106 call `org-capture' that automatically and preemptively creates a 107 link. If you do want to get an ID link in a capture template to 108 an entry not having an ID, create it first by explicitly creating 109 a link to it, using `\\[org-store-link]' first. 110 111 create-if-interactive-and-no-custom-id 112 Like create-if-interactive, but do not create an ID if there is 113 a CUSTOM_ID property defined in the entry. 114 115 use-existing 116 Use existing ID, do not create one. 117 118 nil Never use an ID to make a link, instead link using a text search for 119 the headline text." 120 :group 'org-link-store 121 :group 'org-id 122 :version "24.3" 123 :type '(choice 124 (const :tag "Create ID to make link" t) 125 (const :tag "Create if storing link interactively" 126 create-if-interactive) 127 (const :tag "Create if storing link interactively and no CUSTOM_ID is present" 128 create-if-interactive-and-no-custom-id) 129 (const :tag "Only use existing" use-existing) 130 (const :tag "Do not use ID to create link" nil))) 131 132 (defcustom org-id-link-consider-parent-id nil 133 "Non-nil means storing a link to an Org entry considers inherited IDs. 134 135 When this option is non-nil and `org-id-link-use-context' is 136 enabled, ID properties inherited from parent entries will be 137 considered when storing an ID link. If no ID is found in this 138 way, a new one may be created as normal (see 139 `org-id-link-to-org-use-id'). 140 141 For example, given this org file: 142 143 * Parent 144 :PROPERTIES: 145 :ID: abc 146 :END: 147 ** Child 1 148 ** Child 2 149 150 With `org-id-link-consider-parent-id' and 151 `org-id-link-use-context' both enabled, storing a link with point 152 at \"Child 1\" will produce a link \"<id:abc::*Child 1>\". This 153 allows linking to uniquely-named sub-entries within a parent 154 entry with an ID, without requiring every sub-entry to have its 155 own ID." 156 :group 'org-link-store 157 :group 'org-id 158 :package-version '(Org . "9.7") 159 :type 'boolean) 160 161 (defcustom org-id-link-use-context t 162 "Non-nil means enables search string context in org-id links. 163 164 Search strings are added by `org-id-store-link' when both the 165 general option `org-link-context-for-files' and the org-id option 166 `org-id-link-use-context' are non-nil." 167 :group 'org-link-store 168 :group 'org-id 169 :package-version '(Org . "9.7") 170 :type 'boolean) 171 172 (defcustom org-id-uuid-program "uuidgen" 173 "The uuidgen program." 174 :group 'org-id 175 :type 'string) 176 177 (defcustom org-id-ts-format "%Y%m%dT%H%M%S.%6N" 178 "Timestamp format for IDs generated using `ts' `org-id-method'. 179 The format should be suitable to pass as an argument to `format-time-string'. 180 181 Defaults to ISO8601 timestamps without separators and without 182 timezone, local time and precision down to 1e-6 seconds." 183 :type 'string 184 :package-version '(Org . "9.5")) 185 186 (defcustom org-id-method 'uuid 187 "The method that should be used to create new IDs. 188 189 An ID will consist of the optional prefix specified in `org-id-prefix', 190 and a unique part created by the method this variable specifies. 191 192 Allowed values are: 193 194 org Org's own internal method, using an encoding of the current time to 195 microsecond accuracy, and optionally the current domain of the 196 computer. See the variable `org-id-include-domain'. 197 198 uuid Create random (version 4) UUIDs. If the program defined in 199 `org-id-uuid-program' is available it is used to create the ID. 200 Otherwise an internal functions is used. 201 202 ts Create ID's based on timestamps as specified in `org-id-ts-format'." 203 :group 'org-id 204 :type '(choice 205 (const :tag "Org's internal method" org) 206 (const :tag "external: uuidgen" uuid) 207 (const :tag "Timestamp with format `org-id-ts-format'" ts))) 208 209 (defcustom org-id-prefix nil 210 "The prefix for IDs. 211 212 This may be a string, or it can be nil to indicate that no prefix is required. 213 When a string, the string should have no space characters as IDs are expected 214 to have no space characters in them." 215 :group 'org-id 216 :type '(choice 217 (const :tag "No prefix") 218 (string :tag "Prefix"))) 219 220 (defcustom org-id-include-domain nil 221 "Non-nil means add the domain name to new IDs. 222 This ensures global uniqueness of IDs, and is also suggested by 223 the relevant RFCs. This is relevant only if `org-id-method' is 224 `org' or `ts'. When uuidgen is used, the domain will never be added. 225 226 The default is to not use this because we have no really good way to get 227 the true domain, and Org entries will normally not be shared with enough 228 people to make this necessary." 229 :group 'org-id 230 :type 'boolean) 231 232 (defcustom org-id-track-globally t 233 "Non-nil means track IDs through files, so that links work globally. 234 This work by maintaining a hash table for IDs and writing this table 235 to disk when exiting Emacs. Because of this, it works best if you use 236 a single Emacs process, not many. 237 238 When nil, IDs are not tracked. Links to IDs will still work within 239 a buffer, but not if the entry is located in another file. 240 IDs can still be used if the entry with the id is in the same file as 241 the link." 242 :group 'org-id 243 :type 'boolean) 244 245 (defcustom org-id-locations-file (locate-user-emacs-file ".org-id-locations") 246 "The file for remembering in which file an ID was defined. 247 This variable is only relevant when `org-id-track-globally' is set." 248 :group 'org-id 249 :type 'file) 250 251 (defcustom org-id-locations-file-relative nil 252 "Determine if `org-id-locations' should be stored as relative links. 253 Non-nil means that links to locations are stored as links 254 relative to the location of where `org-id-locations-file' is 255 stored. 256 257 Nil means to store absolute paths to files. 258 259 This customization is useful when folders are shared across 260 systems but mounted at different roots. Relative path to 261 `org-id-locations-file' still has to be maintained across 262 systems." 263 :group 'org-id 264 :type 'boolean 265 :package-version '(Org . "9.3")) 266 267 (defvar org-id-locations nil 268 "List of files with IDs in those files.") 269 (defvar org-id--locations-checksum nil 270 "Last checksum corresponding to ID files and their modifications.") 271 272 (defvar org-id-files nil 273 "List of files that contain IDs.") 274 275 (defcustom org-id-extra-files 'org-agenda-text-search-extra-files 276 "Files to be searched for IDs, besides the agenda files. 277 When Org reparses files to remake the list of files and IDs it is tracking, 278 it will normally scan the agenda files, the archives related to agenda files, 279 any files that are listed as ID containing in the current register, and 280 any Org file currently visited by Emacs. 281 You can list additional files here. 282 This variable is only relevant when `org-id-track-globally' is set." 283 :group 'org-id 284 :type 285 '(choice 286 (symbol :tag "Variable") 287 (repeat :tag "List of files" 288 (file)))) 289 290 (defcustom org-id-search-archives t 291 "Non-nil means search also the archive files of agenda files for entries. 292 This is a possibility to reduce overhead, but it means that entries moved 293 to the archives can no longer be found by ID. 294 This variable is only relevant when `org-id-track-globally' is set." 295 :group 'org-id 296 :type 'boolean) 297 298 ;;; The API functions 299 300 ;;;###autoload 301 (defun org-id-get-create (&optional force) 302 "Create an ID for the current entry and return it. 303 If the entry already has an ID, just return it. 304 With optional argument FORCE, force the creation of a new ID." 305 (interactive "P") 306 (when force 307 (org-entry-put (point) "ID" nil)) 308 (org-id-get (point) 'create)) 309 310 ;;;###autoload 311 (defun org-id-copy () 312 "Copy the ID of the entry at point to the kill ring. 313 Create an ID if necessary." 314 (interactive) 315 (org-kill-new (org-id-get nil 'create))) 316 317 (defvar org-id-overriding-file-name nil 318 "Tell `org-id-get' to use this as the file name when creating an ID. 319 This is useful when working with contents in a temporary buffer 320 that will be copied back to the original.") 321 322 ;;;###autoload 323 (defun org-id-get (&optional epom create prefix inherit) 324 "Get the ID of the entry at EPOM. 325 326 EPOM is an element, marker, or buffer position. If EPOM is nil, 327 refer to the entry at point. 328 329 If INHERIT is non-nil, ID properties inherited from parent 330 entries are considered. Otherwise, only ID properties on the 331 entry itself are considered. 332 333 When CREATE is nil, return the ID of the entry if found, 334 otherwise nil. When CREATE is non-nil, create an ID if none has 335 been found, and return the new ID. PREFIX will be passed through 336 to `org-id-new'." 337 (let ((id (org-entry-get epom "ID" (and inherit t)))) 338 (cond 339 ((and id (stringp id) (string-match "\\S-" id)) 340 id) 341 (create 342 (setq id (org-id-new prefix)) 343 (org-entry-put epom "ID" id) 344 (org-with-point-at epom 345 (org-id-add-location id 346 (or org-id-overriding-file-name 347 (buffer-file-name (buffer-base-buffer))))) 348 id)))) 349 350 ;;;###autoload 351 (defun org-id-get-with-outline-path-completion (&optional targets) 352 "Use `outline-path-completion' to retrieve the ID of an entry. 353 TARGETS may be a setting for `org-refile-targets' to define 354 eligible headlines. When omitted, all headlines in the current 355 file are eligible. This function returns the ID of the entry. 356 If necessary, the ID is created." 357 (let* ((org-refile-targets (or targets '((nil . (:maxlevel . 10))))) 358 (org-refile-use-outline-path 359 (if (caar org-refile-targets) 'file t)) 360 (org-refile-target-verify-function nil) 361 (spos (org-refile-get-location "Entry")) 362 (pom (and spos (move-marker (make-marker) (or (nth 3 spos) 1) 363 (get-file-buffer (nth 1 spos)))))) 364 (prog1 (org-id-get pom 'create) 365 (move-marker pom nil)))) 366 367 ;;;###autoload 368 (defun org-id-get-with-outline-drilling () 369 "Use an outline-cycling interface to retrieve the ID of an entry. 370 This only finds entries in the current buffer, using `org-goto-location'. 371 It returns the ID of the entry. If necessary, the ID is created." 372 (let* ((spos (org-goto-location)) 373 (pom (and spos (move-marker (make-marker) (car spos))))) 374 (prog1 (org-id-get pom 'create) 375 (move-marker pom nil)))) 376 377 ;;;###autoload 378 (defun org-id-goto (id) 379 "Switch to the buffer containing the entry with id ID. 380 Move the cursor to that entry in that buffer." 381 (interactive "sID: ") 382 (let ((m (org-id-find id 'marker))) 383 (unless m 384 (error "Cannot find entry with ID \"%s\"" id)) 385 (pop-to-buffer-same-window (marker-buffer m)) 386 (goto-char m) 387 (move-marker m nil) 388 (org-fold-show-context))) 389 390 ;;;###autoload 391 (defun org-id-find (id &optional markerp) 392 "Return the location of the entry with the id ID. 393 The return value is a cons cell (file-name . position), or nil 394 if there is no entry with that ID. 395 With optional argument MARKERP, return the position as a new marker." 396 (cond 397 ((symbolp id) (setq id (symbol-name id))) 398 ((numberp id) (setq id (number-to-string id)))) 399 (let ((file (org-id-find-id-file id)) 400 org-agenda-new-buffers where) 401 (when file 402 (setq where (org-id-find-id-in-file id file markerp))) 403 (unless where 404 (org-id-update-id-locations nil t) 405 (setq file (org-id-find-id-file id)) 406 (when file 407 (setq where (org-id-find-id-in-file id file markerp)))) 408 where)) 409 410 ;;; Internal functions 411 412 ;; Creating new IDs 413 414 ;;;###autoload 415 (defun org-id-new (&optional prefix) 416 "Create a new globally unique ID. 417 418 An ID consists of two parts separated by a colon: 419 - a prefix 420 - a unique part that will be created according to `org-id-method'. 421 422 PREFIX can specify the prefix, the default is given by the variable 423 `org-id-prefix'. However, if PREFIX is the symbol `none', don't use any 424 prefix even if `org-id-prefix' specifies one. 425 426 So a typical ID could look like \"Org:4nd91V40HI\"." 427 (let* ((prefix (if (eq prefix 'none) 428 "" 429 (concat (or prefix org-id-prefix) ":"))) 430 unique) 431 (if (equal prefix ":") (setq prefix "")) 432 (cond 433 ((memq org-id-method '(uuidgen uuid)) 434 (setq unique (org-trim (shell-command-to-string org-id-uuid-program))) 435 (unless (org-uuidgen-p unique) 436 (setq unique (org-id-uuid)))) 437 ((eq org-id-method 'org) 438 (let* ((etime (org-reverse-string (org-id-time-to-b36))) 439 (postfix (when org-id-include-domain 440 (require 'message) 441 (concat "@" (message-make-fqdn))))) 442 (setq unique (concat etime postfix)))) 443 ((eq org-id-method 'ts) 444 (let ((ts (format-time-string org-id-ts-format)) 445 (postfix (when org-id-include-domain 446 (require 'message) 447 (concat "@" (message-make-fqdn))))) 448 (setq unique (concat ts postfix)))) 449 (t (error "Invalid `org-id-method'"))) 450 (concat prefix unique))) 451 452 (defun org-id-int-to-b36-one-digit (integer) 453 "Convert INTEGER between 0 and 61 into a single character 0..9, A..Z, a..z." 454 (cond 455 ((< integer 10) (+ ?0 integer)) 456 ((< integer 36) (+ ?a integer -10)) 457 (t (error "Larger that 35")))) 458 459 (defun org-id-b36-to-int-one-digit (i) 460 "Convert character 0..9, A..Z, a..z into a number 0..61. 461 The input I may be a character, or a single-letter string." 462 (and (stringp i) (setq i (string-to-char i))) 463 (cond 464 ((and (>= i ?0) (<= i ?9)) (- i ?0)) 465 ((and (>= i ?a) (<= i ?z)) (+ (- i ?a) 10)) 466 (t (error "Invalid b36 letter")))) 467 468 (defun org-id-int-to-b36 (integer &optional length) 469 "Convert an INTEGER to a base-36 number represented as a string. 470 The returned string is padded with leading zeros to LENGTH if necessary." 471 (let ((s "") 472 (i integer)) 473 (while (> i 0) 474 (setq s (concat (char-to-string 475 (org-id-int-to-b36-one-digit (mod i 36))) s) 476 i (/ i 36))) 477 (setq length (max 1 (or length 1))) 478 (if (< (length s) length) 479 (setq s (concat (make-string (- length (length s)) ?0) s))) 480 s)) 481 482 (defun org-id-b36-to-int (string) 483 "Convert a base-36 STRING into the corresponding integer." 484 (let ((r 0)) 485 (mapc (lambda (i) (setq r (+ (* r 36) (org-id-b36-to-int-one-digit i)))) 486 string) 487 r)) 488 489 (defun org-id-time-to-b36 (&optional time) 490 "Encode TIME as a 12-digit string. 491 This string holds the time to micro-second accuracy, and can be decoded 492 using `org-id-decode'." 493 ;; FIXME: If TIME represents N seconds after the epoch, then 494 ;; this encoding assumes 0 <= N < 110075314176 = (* (expt 36 4) 65536), 495 ;; i.e., that TIME is from 1970-01-01 00:00:00 to 5458-02-23 20:09:36 UTC. 496 (setq time (org-time-convert-to-list nil)) 497 (concat (org-id-int-to-b36 (nth 0 time) 4) 498 (org-id-int-to-b36 (nth 1 time) 4) 499 (org-id-int-to-b36 (nth 2 time) 4))) 500 501 (defun org-id-decode (id) 502 "Split ID into the prefix and the time value that was used to create it. 503 The return value is (prefix . time) where PREFIX is nil or a string, 504 and TIME is a Lisp time value (HI LO USEC)." 505 (let (prefix time parts) 506 (setq parts (org-split-string id ":")) 507 (if (= 2 (length parts)) 508 (setq prefix (car parts) time (nth 1 parts)) 509 (setq prefix nil time (nth 0 parts))) 510 (setq time (org-reverse-string time)) 511 (setq time (list (org-id-b36-to-int (substring time 0 4)) 512 (org-id-b36-to-int (substring time 4 8)) 513 (org-id-b36-to-int (substring time 8 12)))) 514 (cons prefix time))) 515 516 ;; Storing ID locations (files) 517 518 ;;;###autoload 519 (defun org-id-update-id-locations (&optional files silent) 520 "Scan relevant files for IDs. 521 Store the relation between files and corresponding IDs. 522 This will scan all agenda files, all associated archives, all open Org 523 files, and all files currently mentioned in `org-id-locations'. 524 When FILES is given, scan also these files. 525 If SILENT is non-nil, messages are suppressed." 526 (interactive) 527 (unless org-id-track-globally 528 (error "Please turn on `org-id-track-globally' if you want to track IDs")) 529 (let* ((files 530 (delete-dups 531 (mapcar #'file-truename 532 (cl-remove-if-not 533 ;; Default `org-id-extra-files' value contains 534 ;; `agenda-archives' symbol. 535 #'stringp 536 (append 537 ;; Agenda files and all associated archives. 538 (org-agenda-files t org-id-search-archives) 539 ;; Explicit extra files. 540 (if (symbolp org-id-extra-files) 541 (symbol-value org-id-extra-files) 542 org-id-extra-files) 543 ;; All files known to have IDs. 544 org-id-files 545 ;; All Org files open in Emacs. 546 (mapcar #'buffer-file-name (org-buffer-list 'files t)) 547 ;; Additional files from function call. 548 files))))) 549 (nfiles (length files)) 550 (id-regexp 551 (rx (seq bol (0+ (any "\t ")) ":ID:" (1+ " ") (not (any " "))))) 552 (seen-ids (make-hash-table :test #'equal)) 553 (ndup 0) 554 (i 0) 555 (checksum 556 (mapcar 557 (lambda (f) 558 (when (file-exists-p f) 559 (list f (file-attribute-modification-time (file-attributes f))))) 560 (sort (copy-sequence files) #'string<)))) 561 (unless (equal checksum org-id--locations-checksum) ; Files have changed since the last update. 562 (setq org-id-locations nil) 563 (with-temp-buffer 564 (delay-mode-hooks 565 (org-mode) 566 (dolist (file files) 567 (when (file-exists-p file) 568 (unless silent 569 (cl-incf i) 570 (message "Finding ID locations (%d/%d files): %s" i nfiles file)) 571 (insert-file-contents file nil nil nil 'replace) 572 (let ((ids nil) 573 node 574 (case-fold-search t)) 575 (org-with-point-at 1 576 (while (re-search-forward id-regexp nil t) 577 (setq node (org-element-at-point)) 578 (when (org-element-type-p node 'node-property) 579 (push (org-element-property :value node) ids))) 580 (when ids 581 (push (cons (abbreviate-file-name file) ids) 582 org-id-locations) 583 (dolist (id ids) 584 (cond 585 ((not (gethash id seen-ids)) (puthash id t seen-ids)) 586 (silent nil) 587 (t 588 (message "Duplicate ID %S" id) 589 (cl-incf ndup))))))))))) 590 (setq org-id-files (mapcar #'car org-id-locations)) 591 (org-id-locations-save) 592 ;; Now convert to a hash table. 593 (setq org-id-locations (org-id-alist-to-hash org-id-locations)) 594 (setq org-id--locations-checksum checksum) 595 (when (and (not silent) (> ndup 0)) 596 (warn "WARNING: %d duplicate IDs found, check *Messages* buffer" ndup)) 597 (message "%d files scanned, %d files contains IDs, and %d IDs found." 598 nfiles (length org-id-files) (hash-table-count org-id-locations))) 599 org-id-locations)) 600 601 (defun org-id-locations-save () 602 "Save `org-id-locations' in `org-id-locations-file'." 603 (when (and org-id-track-globally org-id-locations) 604 (let ((out (if (hash-table-p org-id-locations) 605 (org-id-hash-to-alist org-id-locations) 606 org-id-locations))) 607 (when (and org-id-locations-file-relative out) 608 (setq out (mapcar 609 (lambda (item) 610 (if (file-name-absolute-p (car item)) 611 (cons (file-relative-name 612 (car item) (file-name-directory 613 org-id-locations-file)) 614 (cdr item)) 615 item)) 616 out))) 617 (with-temp-file org-id-locations-file 618 (let ((print-level nil) 619 (print-length nil)) 620 (print out (current-buffer))))))) 621 622 (defun org-id-locations-load () 623 "Read the data from `org-id-locations-file'." 624 (setq org-id-locations nil) 625 (when org-id-track-globally 626 (with-temp-buffer 627 (condition-case nil 628 (progn 629 (insert-file-contents org-id-locations-file) 630 (setq org-id-locations (read (current-buffer))) 631 (let ((loc (file-name-directory org-id-locations-file))) 632 (mapc (lambda (item) 633 (unless (file-name-absolute-p (car item)) 634 (setf (car item) (expand-file-name (car item) loc)))) 635 org-id-locations))) 636 (error 637 (message "Could not read `org-id-locations' from %s, setting it to nil" 638 org-id-locations-file)))) 639 (setq org-id-files (mapcar 'car org-id-locations)) 640 (setq org-id-locations (org-id-alist-to-hash org-id-locations)))) 641 642 (defun org-id-add-location (id file) 643 "Add the ID with location FILE to the database of ID locations." 644 ;; Only if global tracking is on, and when the buffer has a file 645 (unless file 646 (error "`org-id-get' expects a file-visiting buffer")) 647 (let ((afile (abbreviate-file-name file))) 648 (when (and org-id-track-globally id) 649 (unless org-id-locations (org-id-locations-load)) 650 (puthash id afile org-id-locations) 651 (unless (member afile org-id-files) 652 (add-to-list 'org-id-files afile))))) 653 654 (unless noninteractive 655 (add-hook 'kill-emacs-hook 'org-id-locations-save)) 656 657 (defun org-id-hash-to-alist (hash) 658 "Turn an org-id HASH into an alist. 659 This is to be able to write it to a file." 660 (let (res x) 661 (maphash 662 (lambda (k v) 663 (if (setq x (assoc v res)) 664 (setcdr x (cons k (cdr x))) 665 (push (list v k) res))) 666 hash) 667 res)) 668 669 (defun org-id-alist-to-hash (list) 670 "Turn an org-id location LIST into a hash table." 671 (let ((res (make-hash-table 672 :test 'equal 673 :size (apply '+ (mapcar 'length list)))) 674 f) 675 (mapc 676 (lambda (x) 677 (setq f (car x)) 678 (mapc (lambda (i) (puthash i f res)) (cdr x))) 679 list) 680 res)) 681 682 (defun org-id-paste-tracker (txt &optional buffer-or-file) 683 "Update any ids in TXT and assign BUFFER-OR-FILE to them." 684 (when org-id-track-globally 685 (save-match-data 686 (setq buffer-or-file (or buffer-or-file (current-buffer))) 687 (when (bufferp buffer-or-file) 688 (setq buffer-or-file (or (buffer-base-buffer buffer-or-file) 689 buffer-or-file)) 690 (setq buffer-or-file (buffer-file-name buffer-or-file))) 691 (when buffer-or-file 692 (let ((fname (abbreviate-file-name buffer-or-file)) 693 (s 0)) 694 (while (string-match "^[ \t]*:ID:[ \t]+\\([^ \t\n\r]+\\)" txt s) 695 (setq s (match-end 0)) 696 (org-id-add-location (match-string 1 txt) fname))))))) 697 698 ;; Finding entries with specified id 699 700 ;;;###autoload 701 (defun org-id-find-id-file (id) 702 "Query the id database for the file in which ID is located." 703 (unless org-id-locations (org-id-locations-load)) 704 (or (and org-id-locations 705 (hash-table-p org-id-locations) 706 (gethash id org-id-locations)) 707 ;; Fall back on current buffer 708 (buffer-file-name (or (buffer-base-buffer (current-buffer)) 709 (current-buffer))))) 710 711 (defun org-id-find-id-in-file (id file &optional markerp) 712 "Return the position of the entry ID in FILE. 713 714 If that files does not exist, or if it does not contain this ID, 715 return nil. 716 717 The position is returned as a cons cell (file-name . position). With 718 optional argument MARKERP, return the position as a new marker." 719 (cond 720 ((not file) nil) 721 ((not (file-exists-p file)) nil) 722 (t 723 (let* ((visiting (find-buffer-visiting file)) 724 (buffer (or visiting 725 (if markerp (find-file-noselect file) 726 (org-get-buffer-create " *Org ID temp*" t))))) 727 (unwind-protect 728 (with-current-buffer buffer 729 (unless (derived-mode-p 'org-mode) (org-mode)) 730 (unless (or visiting markerp) 731 (buffer-disable-undo) 732 ;; FIXME: In Emacs 27, `insert-file-contents' seemingly 733 ;; does not trigger modification hooks in some 734 ;; scenarios. This is manifested in test failures due 735 ;; to element cache losing track of the modifications. 736 (org-element-cache-reset) 737 (insert-file-contents file nil nil nil 'replace)) 738 (let ((pos (org-find-entry-with-id id))) 739 (cond 740 ((null pos) nil) 741 (markerp (move-marker (make-marker) pos buffer)) 742 (t (cons file pos))))) 743 ;; Clean temporarily buffer if we don't need to keep it. 744 (unless (or visiting markerp) 745 (with-current-buffer buffer (erase-buffer)))))))) 746 747 ;; id link type 748 749 (defun org-id--get-id-to-store-link (&optional create) 750 "Get or create the relevant ID for storing a link. 751 752 Optional argument CREATE is passed to `org-id-get'. 753 754 Inherited IDs are only considered when 755 `org-id-link-consider-parent-id', `org-id-link-use-context' and 756 `org-link-context-for-files' are all enabled, since inherited IDs 757 are confusing without the additional search string context. 758 759 Note that this function resets the 760 `org-entry-property-inherited-from' marker: it will either point 761 to nil (if the id was not inherited) or to the point it was 762 inherited from." 763 (let* ((inherit-id (and org-id-link-consider-parent-id 764 org-id-link-use-context 765 org-link-context-for-files))) 766 (move-marker org-entry-property-inherited-from nil) 767 (org-id-get nil create nil inherit-id))) 768 769 ;;;###autoload 770 (defun org-id-store-link () 771 "Store a link to the current entry, using its ID. 772 773 The link description is based on the heading, or if before the 774 first heading, the title keyword if available, or else the 775 filename. 776 777 When `org-link-context-for-files' and `org-id-link-use-context' 778 are non-nil, add a search string to the link. The link 779 description is then based on the search string target. 780 781 When in addition `org-id-link-consider-parent-id' is non-nil, the 782 ID can be inherited from a parent entry, with the search string 783 used to still link to the current location." 784 (interactive) 785 (when (and (buffer-file-name (buffer-base-buffer)) 786 (derived-mode-p 'org-mode)) 787 ;; Get the precise target first, in case looking for an id causes 788 ;; a properties drawer to be added at the current location. 789 (let* ((precise-target (and org-link-context-for-files 790 org-id-link-use-context 791 (org-link-precise-link-target))) 792 (link (concat "id:" (org-id--get-id-to-store-link 'create))) 793 (id-location (or (and org-entry-property-inherited-from 794 (marker-position org-entry-property-inherited-from)) 795 (save-excursion (org-back-to-heading-or-point-min t) (point)))) 796 (case-fold-search nil) 797 (desc (save-excursion 798 (goto-char id-location) 799 (cond ((org-before-first-heading-p) 800 (let ((keywords (org-collect-keywords '("TITLE")))) 801 (if keywords 802 (cadr (assoc "TITLE" keywords)) 803 (file-name-nondirectory 804 (buffer-file-name (buffer-base-buffer)))))) 805 ((looking-at org-complex-heading-regexp) 806 (if (match-end 4) 807 (match-string 4) 808 (match-string 0))) 809 (t link))))) 810 ;; Precise targets should be after id-location to avoid 811 ;; duplicating the current headline as a search string 812 (when (and precise-target 813 (> (nth 2 precise-target) id-location)) 814 (setq link (concat link "::" (nth 0 precise-target))) 815 (setq desc (nth 1 precise-target))) 816 (org-link-store-props :link link :description desc :type "id") 817 link))) 818 819 ;;;###autoload 820 (defun org-id-store-link-maybe (&optional interactive?) 821 "Store a link to the current entry using its ID if enabled. 822 823 The value of `org-id-link-to-org-use-id' determines whether an ID 824 link should be stored, using `org-id-store-link'. 825 826 Assume the function is called interactively if INTERACTIVE? is 827 non-nil." 828 (when (and (buffer-file-name (buffer-base-buffer)) 829 (derived-mode-p 'org-mode) 830 (or (eq org-id-link-to-org-use-id t) 831 (and interactive? 832 (or (eq org-id-link-to-org-use-id 'create-if-interactive) 833 (and (eq org-id-link-to-org-use-id 834 'create-if-interactive-and-no-custom-id) 835 (not (org-entry-get nil "CUSTOM_ID"))))) 836 ;; 'use-existing 837 (and org-id-link-to-org-use-id 838 (org-id--get-id-to-store-link)))) 839 (org-id-store-link))) 840 841 (defun org-id-open (link _) 842 "Go to the entry indicated by id link LINK. 843 844 The link can include a search string after \"::\", which is 845 passed to `org-link-search'. 846 847 For backwards compatibility with IDs that contain \"::\", if no 848 match is found for the ID, the full link string including \"::\" 849 will be tried as an ID." 850 (let* ((option (and (string-match "::\\(.*\\)\\'" link) 851 (match-string 1 link))) 852 (id (if (not option) link 853 (substring link 0 (match-beginning 0)))) 854 m cmd) 855 (org-mark-ring-push) 856 (setq m (org-id-find id 'marker)) 857 (when (and (not m) option) 858 ;; Backwards compatibility: if id is not found, try treating 859 ;; whole link as an id. 860 (setq m (org-id-find link 'marker)) 861 (when m 862 (setq option nil))) 863 (unless m 864 (error "Cannot find entry with ID \"%s\"" id)) 865 ;; Use a buffer-switching command in analogy to finding files 866 (setq cmd 867 (or 868 (cdr 869 (assq 870 (cdr (assq 'file org-link-frame-setup)) 871 '((find-file . switch-to-buffer) 872 (find-file-other-window . switch-to-buffer-other-window) 873 (find-file-other-frame . switch-to-buffer-other-frame)))) 874 'switch-to-buffer-other-window)) 875 (if (not (equal (current-buffer) (marker-buffer m))) 876 (funcall cmd (marker-buffer m))) 877 (goto-char m) 878 (move-marker m nil) 879 (when option 880 (save-restriction 881 (unless (org-before-first-heading-p) 882 (org-narrow-to-subtree)) 883 (org-link-search option nil nil 884 (org-element-lineage (org-element-at-point) 'headline t)))) 885 (org-fold-show-context))) 886 887 (org-link-set-parameters "id" 888 :follow #'org-id-open 889 :store #'org-id-store-link-maybe) 890 891 (provide 'org-id) 892 893 ;; Local variables: 894 ;; generated-autoload-file: "org-loaddefs.el" 895 ;; End: 896 897 ;;; org-id.el ends here