org-id.el (27516B)
1 ;;; org-id.el --- Global identifiers for Org entries -*- lexical-binding: t; -*- 2 ;; 3 ;; Copyright (C) 2008-2023 Free Software Foundation, Inc. 4 ;; 5 ;; Author: Carsten Dominik <carsten.dominik@gmail.com> 6 ;; Keywords: outlines, hypermedia, calendar, wp 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 (default "Org" 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'. 35 ;; Org has a builtin method that uses a compact encoding of the creation 36 ;; time of the ID, with microsecond accuracy. This virtually 37 ;; guarantees globally unique identifiers, even if several people are 38 ;; creating 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-refile) 78 (require 'ol) 79 80 (declare-function message-make-fqdn "message" ()) 81 (declare-function org-goto-location "org-goto" (&optional _buf help)) 82 ;; Declared inside `org-element-with-disabled-cache' macro. 83 (declare-function org-element--cache-active-p "org-element.el" (&optional called-from-cache-change-func-p)) 84 85 ;;; Customization 86 87 (defgroup org-id nil 88 "Options concerning global entry identifiers in Org mode." 89 :tag "Org ID" 90 :group 'org) 91 92 (defcustom org-id-link-to-org-use-id nil 93 "Non-nil means storing a link to an Org file will use entry IDs. 94 \\<org-mode-map> 95 The variable can have the following values: 96 97 t Create an ID if needed to make a link to the current entry. 98 99 create-if-interactive 100 If `org-store-link' is called directly (interactively, as a user 101 command), do create an ID to support the link. But when doing the 102 job for capture, only use the ID if it already exists. The 103 purpose of this setting is to avoid proliferation of unwanted 104 IDs, just because you happen to be in an Org file when you 105 call `org-capture' that automatically and preemptively creates a 106 link. If you do want to get an ID link in a capture template to 107 an entry not having an ID, create it first by explicitly creating 108 a link to it, using `\\[org-store-link]' first. 109 110 create-if-interactive-and-no-custom-id 111 Like create-if-interactive, but do not create an ID if there is 112 a CUSTOM_ID property defined in the entry. 113 114 use-existing 115 Use existing ID, do not create one. 116 117 nil Never use an ID to make a link, instead link using a text search for 118 the headline text." 119 :group 'org-link-store 120 :group 'org-id 121 :version "24.3" 122 :type '(choice 123 (const :tag "Create ID to make link" t) 124 (const :tag "Create if storing link interactively" 125 create-if-interactive) 126 (const :tag "Create if storing link interactively and no CUSTOM_ID is present" 127 create-if-interactive-and-no-custom-id) 128 (const :tag "Only use existing" use-existing) 129 (const :tag "Do not use ID to create link" nil))) 130 131 (defcustom org-id-uuid-program "uuidgen" 132 "The uuidgen program." 133 :group 'org-id 134 :type 'string) 135 136 (defcustom org-id-ts-format "%Y%m%dT%H%M%S.%6N" 137 "Timestamp format for IDs generated using `ts' `org-id-method'. 138 The format should be suitable to pass as an argument to `format-time-string'. 139 140 Defaults to ISO8601 timestamps without separators and without 141 timezone, local time and precision down to 1e-6 seconds." 142 :type 'string 143 :package-version '(Org . "9.5")) 144 145 (defcustom org-id-method 'uuid 146 "The method that should be used to create new IDs. 147 148 An ID will consist of the optional prefix specified in `org-id-prefix', 149 and a unique part created by the method this variable specifies. 150 151 Allowed values are: 152 153 org Org's own internal method, using an encoding of the current time to 154 microsecond accuracy, and optionally the current domain of the 155 computer. See the variable `org-id-include-domain'. 156 157 uuid Create random (version 4) UUIDs. If the program defined in 158 `org-id-uuid-program' is available it is used to create the ID. 159 Otherwise an internal functions is used. 160 161 ts Create ID's based on timestamps as specified in `org-id-ts-format'." 162 :group 'org-id 163 :type '(choice 164 (const :tag "Org's internal method" org) 165 (const :tag "external: uuidgen" uuid) 166 (const :tag "Timestamp with format `org-id-ts-format'" ts))) 167 168 (defcustom org-id-prefix nil 169 "The prefix for IDs. 170 171 This may be a string, or it can be nil to indicate that no prefix is required. 172 When a string, the string should have no space characters as IDs are expected 173 to have no space characters in them." 174 :group 'org-id 175 :type '(choice 176 (const :tag "No prefix") 177 (string :tag "Prefix"))) 178 179 (defcustom org-id-include-domain nil 180 "Non-nil means add the domain name to new IDs. 181 This ensures global uniqueness of IDs, and is also suggested by 182 the relevant RFCs. This is relevant only if `org-id-method' is 183 `org' or `ts'. When uuidgen is used, the domain will never be added. 184 185 The default is to not use this because we have no really good way to get 186 the true domain, and Org entries will normally not be shared with enough 187 people to make this necessary." 188 :group 'org-id 189 :type 'boolean) 190 191 (defcustom org-id-track-globally t 192 "Non-nil means track IDs through files, so that links work globally. 193 This work by maintaining a hash table for IDs and writing this table 194 to disk when exiting Emacs. Because of this, it works best if you use 195 a single Emacs process, not many. 196 197 When nil, IDs are not tracked. Links to IDs will still work within 198 a buffer, but not if the entry is located in another file. 199 IDs can still be used if the entry with the id is in the same file as 200 the link." 201 :group 'org-id 202 :type 'boolean) 203 204 (defcustom org-id-locations-file (locate-user-emacs-file ".org-id-locations") 205 "The file for remembering in which file an ID was defined. 206 This variable is only relevant when `org-id-track-globally' is set." 207 :group 'org-id 208 :type 'file) 209 210 (defcustom org-id-locations-file-relative nil 211 "Determine if `org-id-locations' should be stored as relative links. 212 Non-nil means that links to locations are stored as links 213 relative to the location of where `org-id-locations-file' is 214 stored. 215 216 Nil means to store absolute paths to files. 217 218 This customization is useful when folders are shared across 219 systems but mounted at different roots. Relative path to 220 `org-id-locations-file' still has to be maintained across 221 systems." 222 :group 'org-id 223 :type 'boolean 224 :package-version '(Org . "9.3")) 225 226 (defvar org-id-locations nil 227 "List of files with IDs in those files.") 228 229 (defvar org-id-files nil 230 "List of files that contain IDs.") 231 232 (defcustom org-id-extra-files 'org-agenda-text-search-extra-files 233 "Files to be searched for IDs, besides the agenda files. 234 When Org reparses files to remake the list of files and IDs it is tracking, 235 it will normally scan the agenda files, the archives related to agenda files, 236 any files that are listed as ID containing in the current register, and 237 any Org file currently visited by Emacs. 238 You can list additional files here. 239 This variable is only relevant when `org-id-track-globally' is set." 240 :group 'org-id 241 :type 242 '(choice 243 (symbol :tag "Variable") 244 (repeat :tag "List of files" 245 (file)))) 246 247 (defcustom org-id-search-archives t 248 "Non-nil means search also the archive files of agenda files for entries. 249 This is a possibility to reduce overhead, but it means that entries moved 250 to the archives can no longer be found by ID. 251 This variable is only relevant when `org-id-track-globally' is set." 252 :group 'org-id 253 :type 'boolean) 254 255 ;;; The API functions 256 257 ;;;###autoload 258 (defun org-id-get-create (&optional force) 259 "Create an ID for the current entry and return it. 260 If the entry already has an ID, just return it. 261 With optional argument FORCE, force the creation of a new ID." 262 (interactive "P") 263 (when force 264 (org-entry-put (point) "ID" nil)) 265 (org-id-get (point) 'create)) 266 267 ;;;###autoload 268 (defun org-id-copy () 269 "Copy the ID of the entry at point to the kill ring. 270 Create an ID if necessary." 271 (interactive) 272 (org-kill-new (org-id-get nil 'create))) 273 274 (defvar org-id-overriding-file-name nil 275 "Tell `org-id-get' to use this as the file name when creating an ID. 276 This is useful when working with contents in a temporary buffer 277 that will be copied back to the original.") 278 279 ;;;###autoload 280 (defun org-id-get (&optional pom create prefix) 281 "Get the ID property of the entry at point-or-marker POM. 282 If POM is nil, refer to the entry at point. 283 If the entry does not have an ID, the function returns nil. 284 However, when CREATE is non-nil, create an ID if none is present already. 285 PREFIX will be passed through to `org-id-new'. 286 In any case, the ID of the entry is returned." 287 (org-with-point-at pom 288 (let ((id (org-entry-get nil "ID"))) 289 (cond 290 ((and id (stringp id) (string-match "\\S-" id)) 291 id) 292 (create 293 (setq id (org-id-new prefix)) 294 (org-entry-put pom "ID" id) 295 (org-id-add-location id 296 (or org-id-overriding-file-name 297 (buffer-file-name (buffer-base-buffer)))) 298 id))))) 299 300 ;;;###autoload 301 (defun org-id-get-with-outline-path-completion (&optional targets) 302 "Use `outline-path-completion' to retrieve the ID of an entry. 303 TARGETS may be a setting for `org-refile-targets' to define 304 eligible headlines. When omitted, all headlines in the current 305 file are eligible. This function returns the ID of the entry. 306 If necessary, the ID is created." 307 (let* ((org-refile-targets (or targets '((nil . (:maxlevel . 10))))) 308 (org-refile-use-outline-path 309 (if (caar org-refile-targets) 'file t)) 310 (org-refile-target-verify-function nil) 311 (spos (org-refile-get-location "Entry")) 312 (pom (and spos (move-marker (make-marker) (or (nth 3 spos) 1) 313 (get-file-buffer (nth 1 spos)))))) 314 (prog1 (org-id-get pom 'create) 315 (move-marker pom nil)))) 316 317 ;;;###autoload 318 (defun org-id-get-with-outline-drilling () 319 "Use an outline-cycling interface to retrieve the ID of an entry. 320 This only finds entries in the current buffer, using `org-goto-location'. 321 It returns the ID of the entry. If necessary, the ID is created." 322 (let* ((spos (org-goto-location)) 323 (pom (and spos (move-marker (make-marker) (car spos))))) 324 (prog1 (org-id-get pom 'create) 325 (move-marker pom nil)))) 326 327 ;;;###autoload 328 (defun org-id-goto (id) 329 "Switch to the buffer containing the entry with id ID. 330 Move the cursor to that entry in that buffer." 331 (interactive "sID: ") 332 (let ((m (org-id-find id 'marker))) 333 (unless m 334 (error "Cannot find entry with ID \"%s\"" id)) 335 (pop-to-buffer-same-window (marker-buffer m)) 336 (goto-char m) 337 (move-marker m nil) 338 (org-fold-show-context))) 339 340 ;;;###autoload 341 (defun org-id-find (id &optional markerp) 342 "Return the location of the entry with the id ID. 343 The return value is a cons cell (file-name . position), or nil 344 if there is no entry with that ID. 345 With optional argument MARKERP, return the position as a new marker." 346 (cond 347 ((symbolp id) (setq id (symbol-name id))) 348 ((numberp id) (setq id (number-to-string id)))) 349 (let ((file (org-id-find-id-file id)) 350 org-agenda-new-buffers where) 351 (when file 352 (setq where (org-id-find-id-in-file id file markerp))) 353 (unless where 354 (org-id-update-id-locations nil t) 355 (setq file (org-id-find-id-file id)) 356 (when file 357 (setq where (org-id-find-id-in-file id file markerp)))) 358 where)) 359 360 ;;; Internal functions 361 362 ;; Creating new IDs 363 364 ;;;###autoload 365 (defun org-id-new (&optional prefix) 366 "Create a new globally unique ID. 367 368 An ID consists of two parts separated by a colon: 369 - a prefix 370 - a unique part that will be created according to `org-id-method'. 371 372 PREFIX can specify the prefix, the default is given by the variable 373 `org-id-prefix'. However, if PREFIX is the symbol `none', don't use any 374 prefix even if `org-id-prefix' specifies one. 375 376 So a typical ID could look like \"Org:4nd91V40HI\"." 377 (let* ((prefix (if (eq prefix 'none) 378 "" 379 (concat (or prefix org-id-prefix) ":"))) 380 unique) 381 (if (equal prefix ":") (setq prefix "")) 382 (cond 383 ((memq org-id-method '(uuidgen uuid)) 384 (setq unique (org-trim (shell-command-to-string org-id-uuid-program))) 385 (unless (org-uuidgen-p unique) 386 (setq unique (org-id-uuid)))) 387 ((eq org-id-method 'org) 388 (let* ((etime (org-reverse-string (org-id-time-to-b36))) 389 (postfix (when org-id-include-domain 390 (require 'message) 391 (concat "@" (message-make-fqdn))))) 392 (setq unique (concat etime postfix)))) 393 ((eq org-id-method 'ts) 394 (let ((ts (format-time-string org-id-ts-format)) 395 (postfix (when org-id-include-domain 396 (require 'message) 397 (concat "@" (message-make-fqdn))))) 398 (setq unique (concat ts postfix)))) 399 (t (error "Invalid `org-id-method'"))) 400 (concat prefix unique))) 401 402 (defun org-id-uuid () 403 "Return string with random (version 4) UUID." 404 (let ((rnd (md5 (format "%s%s%s%s%s%s%s" 405 (random) 406 (org-time-convert-to-list nil) 407 (user-uid) 408 (emacs-pid) 409 (user-full-name) 410 user-mail-address 411 (recent-keys))))) 412 (format "%s-%s-4%s-%s%s-%s" 413 (substring rnd 0 8) 414 (substring rnd 8 12) 415 (substring rnd 13 16) 416 (format "%x" 417 (logior 418 #b10000000 419 (logand 420 #b10111111 421 (string-to-number 422 (substring rnd 16 18) 16)))) 423 (substring rnd 18 20) 424 (substring rnd 20 32)))) 425 426 (defun org-id-int-to-b36-one-digit (integer) 427 "Convert INTEGER between 0 and 61 into a single character 0..9, A..Z, a..z." 428 (cond 429 ((< integer 10) (+ ?0 integer)) 430 ((< integer 36) (+ ?a integer -10)) 431 (t (error "Larger that 35")))) 432 433 (defun org-id-b36-to-int-one-digit (i) 434 "Convert character 0..9, A..Z, a..z into a number 0..61. 435 The input I may be a character, or a single-letter string." 436 (and (stringp i) (setq i (string-to-char i))) 437 (cond 438 ((and (>= i ?0) (<= i ?9)) (- i ?0)) 439 ((and (>= i ?a) (<= i ?z)) (+ (- i ?a) 10)) 440 (t (error "Invalid b36 letter")))) 441 442 (defun org-id-int-to-b36 (integer &optional length) 443 "Convert an INTEGER to a base-36 number represented as a string. 444 The returned string is padded with leading zeros to LENGTH if necessary." 445 (let ((s "") 446 (i integer)) 447 (while (> i 0) 448 (setq s (concat (char-to-string 449 (org-id-int-to-b36-one-digit (mod i 36))) s) 450 i (/ i 36))) 451 (setq length (max 1 (or length 1))) 452 (if (< (length s) length) 453 (setq s (concat (make-string (- length (length s)) ?0) s))) 454 s)) 455 456 (defun org-id-b36-to-int (string) 457 "Convert a base-36 STRING into the corresponding integer." 458 (let ((r 0)) 459 (mapc (lambda (i) (setq r (+ (* r 36) (org-id-b36-to-int-one-digit i)))) 460 string) 461 r)) 462 463 (defun org-id-time-to-b36 (&optional time) 464 "Encode TIME as a 12-digit string. 465 This string holds the time to micro-second accuracy, and can be decoded 466 using `org-id-decode'." 467 ;; FIXME: If TIME represents N seconds after the epoch, then 468 ;; this encoding assumes 0 <= N < 110075314176 = (* (expt 36 4) 65536), 469 ;; i.e., that TIME is from 1970-01-01 00:00:00 to 5458-02-23 20:09:36 UTC. 470 (setq time (org-time-convert-to-list nil)) 471 (concat (org-id-int-to-b36 (nth 0 time) 4) 472 (org-id-int-to-b36 (nth 1 time) 4) 473 (org-id-int-to-b36 (nth 2 time) 4))) 474 475 (defun org-id-decode (id) 476 "Split ID into the prefix and the time value that was used to create it. 477 The return value is (prefix . time) where PREFIX is nil or a string, 478 and TIME is a Lisp time value (HI LO USEC)." 479 (let (prefix time parts) 480 (setq parts (org-split-string id ":")) 481 (if (= 2 (length parts)) 482 (setq prefix (car parts) time (nth 1 parts)) 483 (setq prefix nil time (nth 0 parts))) 484 (setq time (org-reverse-string time)) 485 (setq time (list (org-id-b36-to-int (substring time 0 4)) 486 (org-id-b36-to-int (substring time 4 8)) 487 (org-id-b36-to-int (substring time 8 12)))) 488 (cons prefix time))) 489 490 ;; Storing ID locations (files) 491 492 ;;;###autoload 493 (defun org-id-update-id-locations (&optional files silent) 494 "Scan relevant files for IDs. 495 Store the relation between files and corresponding IDs. 496 This will scan all agenda files, all associated archives, all open Org 497 files, and all files currently mentioned in `org-id-locations'. 498 When FILES is given, scan also these files. 499 If SILENT is non-nil, messages are suppressed." 500 (interactive) 501 (unless org-id-track-globally 502 (error "Please turn on `org-id-track-globally' if you want to track IDs")) 503 (setq org-id-locations nil) 504 (let* ((files 505 (delete-dups 506 (mapcar #'file-truename 507 (cl-remove-if-not 508 ;; Default `org-id-extra-files' value contains 509 ;; `agenda-archives' symbol. 510 #'stringp 511 (append 512 ;; Agenda files and all associated archives. 513 (org-agenda-files t org-id-search-archives) 514 ;; Explicit extra files. 515 (if (symbolp org-id-extra-files) 516 (symbol-value org-id-extra-files) 517 org-id-extra-files) 518 ;; All files known to have IDs. 519 org-id-files 520 ;; All Org files open in Emacs. 521 (mapcar #'buffer-file-name (org-buffer-list 'files t)) 522 ;; Additional files from function call. 523 files))))) 524 (nfiles (length files)) 525 (id-regexp 526 (rx (seq bol (0+ (any "\t ")) ":ID:" (1+ " ") (not (any " "))))) 527 (seen-ids nil) 528 (ndup 0) 529 (i 0)) 530 (with-temp-buffer 531 (org-element-with-disabled-cache 532 (delay-mode-hooks 533 (org-mode) 534 (dolist (file files) 535 (when (file-exists-p file) 536 (unless silent 537 (cl-incf i) 538 (message "Finding ID locations (%d/%d files): %s" i nfiles file)) 539 (insert-file-contents file nil nil nil 'replace) 540 (let ((ids nil) 541 (case-fold-search t)) 542 (org-with-point-at 1 543 (while (re-search-forward id-regexp nil t) 544 (when (org-at-property-p) 545 (push (org-entry-get (point) "ID") ids))) 546 (when ids 547 (push (cons (abbreviate-file-name file) ids) 548 org-id-locations) 549 (dolist (id ids) 550 (cond 551 ((not (member id seen-ids)) (push id seen-ids)) 552 (silent nil) 553 (t 554 (message "Duplicate ID %S" id) 555 (cl-incf ndup)))))))))))) 556 (setq org-id-files (mapcar #'car org-id-locations)) 557 (org-id-locations-save) 558 ;; Now convert to a hash table. 559 (setq org-id-locations (org-id-alist-to-hash org-id-locations)) 560 (when (and (not silent) (> ndup 0)) 561 (warn "WARNING: %d duplicate IDs found, check *Messages* buffer" ndup)) 562 (message "%d files scanned, %d files contains IDs, and %d IDs found." 563 nfiles (length org-id-files) (hash-table-count org-id-locations)) 564 org-id-locations)) 565 566 (defun org-id-locations-save () 567 "Save `org-id-locations' in `org-id-locations-file'." 568 (when (and org-id-track-globally org-id-locations) 569 (let ((out (if (hash-table-p org-id-locations) 570 (org-id-hash-to-alist org-id-locations) 571 org-id-locations))) 572 (when (and org-id-locations-file-relative out) 573 (setq out (mapcar 574 (lambda (item) 575 (if (file-name-absolute-p (car item)) 576 (cons (file-relative-name 577 (car item) (file-name-directory 578 org-id-locations-file)) 579 (cdr item)) 580 item)) 581 out))) 582 (with-temp-file org-id-locations-file 583 (let ((print-level nil) 584 (print-length nil)) 585 (print out (current-buffer))))))) 586 587 (defun org-id-locations-load () 588 "Read the data from `org-id-locations-file'." 589 (setq org-id-locations nil) 590 (when org-id-track-globally 591 (with-temp-buffer 592 (condition-case nil 593 (progn 594 (insert-file-contents org-id-locations-file) 595 (setq org-id-locations (read (current-buffer))) 596 (let ((loc (file-name-directory org-id-locations-file))) 597 (mapc (lambda (item) 598 (unless (file-name-absolute-p (car item)) 599 (setf (car item) (expand-file-name (car item) loc)))) 600 org-id-locations))) 601 (error 602 (message "Could not read `org-id-locations' from %s, setting it to nil" 603 org-id-locations-file)))) 604 (setq org-id-files (mapcar 'car org-id-locations)) 605 (setq org-id-locations (org-id-alist-to-hash org-id-locations)))) 606 607 (defun org-id-add-location (id file) 608 "Add the ID with location FILE to the database of ID locations." 609 ;; Only if global tracking is on, and when the buffer has a file 610 (unless file 611 (error "`org-id-get' expects a file-visiting buffer")) 612 (let ((afile (abbreviate-file-name file))) 613 (when (and org-id-track-globally id) 614 (unless org-id-locations (org-id-locations-load)) 615 (puthash id afile org-id-locations) 616 (unless (member afile org-id-files) 617 (add-to-list 'org-id-files afile))))) 618 619 (unless noninteractive 620 (add-hook 'kill-emacs-hook 'org-id-locations-save)) 621 622 (defun org-id-hash-to-alist (hash) 623 "Turn an org-id HASH into an alist. 624 This is to be able to write it to a file." 625 (let (res x) 626 (maphash 627 (lambda (k v) 628 (if (setq x (assoc v res)) 629 (setcdr x (cons k (cdr x))) 630 (push (list v k) res))) 631 hash) 632 res)) 633 634 (defun org-id-alist-to-hash (list) 635 "Turn an org-id location LIST into a hash table." 636 (let ((res (make-hash-table 637 :test 'equal 638 :size (apply '+ (mapcar 'length list)))) 639 f) 640 (mapc 641 (lambda (x) 642 (setq f (car x)) 643 (mapc (lambda (i) (puthash i f res)) (cdr x))) 644 list) 645 res)) 646 647 (defun org-id-paste-tracker (txt &optional buffer-or-file) 648 "Update any ids in TXT and assign BUFFER-OR-FILE to them." 649 (when org-id-track-globally 650 (save-match-data 651 (setq buffer-or-file (or buffer-or-file (current-buffer))) 652 (when (bufferp buffer-or-file) 653 (setq buffer-or-file (or (buffer-base-buffer buffer-or-file) 654 buffer-or-file)) 655 (setq buffer-or-file (buffer-file-name buffer-or-file))) 656 (when buffer-or-file 657 (let ((fname (abbreviate-file-name buffer-or-file)) 658 (s 0)) 659 (while (string-match "^[ \t]*:ID:[ \t]+\\([^ \t\n\r]+\\)" txt s) 660 (setq s (match-end 0)) 661 (org-id-add-location (match-string 1 txt) fname))))))) 662 663 ;; Finding entries with specified id 664 665 ;;;###autoload 666 (defun org-id-find-id-file (id) 667 "Query the id database for the file in which ID is located." 668 (unless org-id-locations (org-id-locations-load)) 669 (or (and org-id-locations 670 (hash-table-p org-id-locations) 671 (gethash id org-id-locations)) 672 ;; Fall back on current buffer 673 (buffer-file-name (or (buffer-base-buffer (current-buffer)) 674 (current-buffer))))) 675 676 (defun org-id-find-id-in-file (id file &optional markerp) 677 "Return the position of the entry ID in FILE. 678 679 If that files does not exist, or if it does not contain this ID, 680 return nil. 681 682 The position is returned as a cons cell (file-name . position). With 683 optional argument MARKERP, return the position as a new marker." 684 (cond 685 ((not file) nil) 686 ((not (file-exists-p file)) nil) 687 (t 688 (let* ((visiting (find-buffer-visiting file)) 689 (buffer (or visiting (find-file-noselect file)))) 690 (unwind-protect 691 (with-current-buffer buffer 692 (let ((pos (org-find-entry-with-id id))) 693 (cond 694 ((null pos) nil) 695 (markerp (move-marker (make-marker) pos buffer)) 696 (t (cons file pos))))) 697 ;; Remove opened buffer in the process. 698 (unless (or visiting markerp) (kill-buffer buffer))))))) 699 700 ;; id link type 701 702 ;; Calling the following function is hard-coded into `org-store-link', 703 ;; so we do have to add it to `org-store-link-functions'. 704 705 ;;;###autoload 706 (defun org-id-store-link () 707 "Store a link to the current entry, using its ID. 708 709 If before first heading store first title-keyword as description 710 or filename if no title." 711 (interactive) 712 (when (and (buffer-file-name (buffer-base-buffer)) (derived-mode-p 'org-mode)) 713 (let* ((link (concat "id:" (org-id-get-create))) 714 (case-fold-search nil) 715 (desc (save-excursion 716 (org-back-to-heading-or-point-min t) 717 (cond ((org-before-first-heading-p) 718 (let ((keywords (org-collect-keywords '("TITLE")))) 719 (if keywords 720 (cadr (assoc "TITLE" keywords)) 721 (file-name-nondirectory 722 (buffer-file-name (buffer-base-buffer)))))) 723 ((looking-at org-complex-heading-regexp) 724 (if (match-end 4) 725 (match-string 4) 726 (match-string 0))) 727 (t link))))) 728 (org-link-store-props :link link :description desc :type "id") 729 link))) 730 731 (defun org-id-open (id _) 732 "Go to the entry with id ID." 733 (org-mark-ring-push) 734 (let ((m (org-id-find id 'marker)) 735 cmd) 736 (unless m 737 (error "Cannot find entry with ID \"%s\"" id)) 738 ;; Use a buffer-switching command in analogy to finding files 739 (setq cmd 740 (or 741 (cdr 742 (assq 743 (cdr (assq 'file org-link-frame-setup)) 744 '((find-file . switch-to-buffer) 745 (find-file-other-window . switch-to-buffer-other-window) 746 (find-file-other-frame . switch-to-buffer-other-frame)))) 747 'switch-to-buffer-other-window)) 748 (if (not (equal (current-buffer) (marker-buffer m))) 749 (funcall cmd (marker-buffer m))) 750 (goto-char m) 751 (move-marker m nil) 752 (org-fold-show-context))) 753 754 (org-link-set-parameters "id" :follow #'org-id-open) 755 756 (provide 'org-id) 757 758 ;; Local variables: 759 ;; generated-autoload-file: "org-loaddefs.el" 760 ;; End: 761 762 ;;; org-id.el ends here