lisp/org-id.el

   1 ;;; org-id.el --- Global identifier for Org-mode entries
   2 ;; Copyright (C) 2008 Free Software Foundation, Inc.
   3 ;;
   4 ;; Author: Carsten Dominik <carsten at orgmode dot org>
   5 ;; Keywords: outlines, hypermedia, calendar, wp
   6 ;; Homepage: http://orgmode.org
   7 ;; Version: 6.06a
   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 <http://www.gnu.org/licenses/>.
  23 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  24 ;;
  25 ;;; Commentary:
  26
  27 ;; This file implements globally unique identifiers for Org-mode 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") and a compact encoding
  33 ;; of the creation time of the ID, with microsecond accuracy.  This virtually
  34 ;; guarantees globally unique identifiers, even if several people are
  35 ;; creating ID's at the same time in files that will eventually be used
  36 ;; together.  Even higher security can be achieved by using different
  37 ;; prefix values for each collaborator or file.
  38 ;;
  39 ;; This file defines the following API:
  40 ;;
  41 ;; org-id-get-create
  42 ;;        Create an ID for the entry at point if it does not yet have one.
  43 ;;        Returns the ID (old or new).  This function can be used
  44 ;;        interactively, with prefix argument the creation of a new ID is
  45 ;;        forced, even if there was an old one.
  46 ;;
  47 ;; org-id-get
  48 ;;        Get the ID property of an entry.  Using appropriate arguments
  49 ;;        to the function, it can also create the ID for this entry.
  50 ;;
  51 ;; org-id-goto
  52 ;;        Command to go to a specific ID, this command can be used
  53 ;;        interactively.
  54 ;;
  55 ;; org-id-get-with-outline-path-completion
  56 ;;        Retrieve the ID of an entry, using outline path completion.
  57 ;;        This function can work for multiple files.
  58 ;;
  59 ;; org-id-get-with-outline-drilling
  60 ;;        Retrieve the ID of an entry, using outline path completion.
  61 ;;        This function only works for the current file.
  62 ;;
  63 ;; org-id-find
  64 ;;        Find the location of an entry with specific id.
  65 ;;
  66
  67 (require 'org)
  68
  69 (declare-function message-make-fqdn "message" ())
  70
  71 ;;; Customization
  72
  73 (defgroup org-id nil
  74   "Options concerning global entry identifiers in Org-mode."
  75   :tag "Org ID"
  76   :group 'org)
  77
  78 (defcustom org-id-prefix "Org"
  79   "The prefix for IDs.
  80
  81 This may be a string, or it can be nil to indicate that no prefix is required.
  82 When a string, the string should have no space characters as IDs are expected
  83 to have no space characters in them."
  84   :group 'org-id
  85   :type '(choice
  86           (const :tag "No prefix")
  87           (string :tag "Prefix")))
  88
  89 (defcustom org-id-include-domain t
  90   "Non-nil means, add the domain name to new IDs.
  91 This ensures global uniqueness of ID's, and is also suggested by
  92 RFC 2445 in combination with RFC 822."
  93   :group 'org-id
  94   :type 'boolean)
  95
  96 (defcustom org-id-locations-file "~/.org-id-locations"
  97   "The file for remembering the last ID number generated."
  98   :group 'org-id
  99   :type 'file)
 100
 101 (defvar org-id-locations nil
 102   "List of files with ID's in those files.")
 103
 104 (defcustom org-id-extra-files 'org-agenda-text-search-extra-files
 105   "Files to be searched for ID's, besides the agenda files."
 106   :group 'org-id
 107   :type
 108   '(choice
 109     (symbol :tag "Variable")
 110     (repeat :tag "List of files"
 111             (file))))
 112
 113 ;;; The API functions
 114
 115 ;;;###autoload
 116 (defun org-id-get-create (&optional force)
 117   "Create an ID for the current entry and return it.
 118 If the entry already has an ID, just return it.
 119 With optional argument FORCE, force the creation of a new ID."
 120   (interactive "P")
 121   (when force
 122     (org-entry-put (point) "ID" nil))
 123   (org-id-get (point) 'create))
 124
 125 ;;;###autoload
 126 (defun org-id-copy ()
 127   "Copy the ID of the entry at point to the kill ring.
 128 Create an ID if necessary."
 129   (interactive)
 130   (kill-new (org-id-get nil 'create)))
 131
 132 ;;;###autoload
 133 (defun org-id-get (&optional pom create prefix)
 134   "Get the ID property of the entry at point-or-marker POM.
 135 If POM is nil, refer to the entry at point.
 136 If the entry does not have an ID, the function returns nil.
 137 However, when CREATE is non nil, create an ID if none is present already.
 138 PREFIX will be passed through to `org-id-new'.
 139 In any case, the ID of the entry is returned."
 140   (let ((id (org-entry-get pom "ID")))
 141     (cond
 142      ((and id (stringp id) (string-match "\\S-" id))
 143       id)
 144      (create
 145       (setq id (org-id-new prefix))
 146       (org-entry-put pom "ID" id)
 147       (org-id-add-location id (buffer-file-name (buffer-base-buffer)))
 148       id)
 149      (t nil))))
 150
 151 ;;;###autoload
 152 (defun org-id-get-with-outline-path-completion (&optional targets)
 153   "Use outline-path-completion to retrieve the ID of an entry.
 154 TARGETS may be a setting for `org-refile-targets' to define the eligible
 155 headlines.  When omitted, all headlines in all agenda files are
 156 eligible.
 157 It returns the ID of the entry.  If necessary, the ID is created."
 158   (let* ((org-refile-targets (or targets '((nil . (:maxlevel . 10)))))
 159          (org-refile-use-outline-path
 160           (if (caar org-refile-targets) 'file t))
 161          (spos (org-refile-get-location "Entry: "))
 162          (pom (and spos (move-marker (make-marker) (nth 3 spos)
 163                                      (get-file-buffer (nth 1 spos))))))
 164     (prog1 (org-id-get pom 'create)
 165       (move-marker pom nil))))
 166
 167 ;;;###autoload
 168 (defun org-id-get-with-outline-drilling (&optional targets)
 169   "Use an outline-cycling interface to retrieve the ID of an entry.
 170 This only finds entries in the current buffer, using `org-get-location'.
 171 It returns the ID of the entry.  If necessary, the ID is created."
 172   (let* ((spos (org-get-location (current-buffer) org-goto-help))
 173          (pom (and spos (move-marker (make-marker) (car spos)))))
 174     (prog1 (org-id-get pom 'create)
 175       (move-marker pom nil))))
 176
 177 ;;;###autoload
 178 (defun org-id-goto (id)
 179   "Switch to the buffer containing the entry with id ID.
 180 Move the cursor to that entry in that buffer."
 181   (interactive)
 182   (let ((m (org-id-find id 'marker)))
 183     (unless m
 184       (error "Cannot find entry with ID \"%s\"" id))
 185     (switch-to-buffer (marker-buffer m))
 186     (goto-char m)
 187     (move-marker m nil)
 188     (org-show-context)))
 189
 190 ;;;###autoload
 191 (defun org-id-find (id &optional markerp)
 192   "Return the location of the entry with the id ID.
 193 The return value is a cons cell (file-name . position), or nil
 194 if there is no entry with that ID.
 195 With optional argument MARKERP, return the position as a new marker."
 196   (let ((file (org-id-find-id-file id))
 197         org-agenda-new-buffers where)
 198     (when file
 199       (setq where (org-id-find-id-in-file id file markerp)))
 200     (unless where
 201       (org-id-update-id-locations)
 202       (setq file (org-id-find-id-file id))
 203       (when file
 204         (setq where (org-id-find-id-in-file id file markerp))))
 205     where))
 206
 207 ;;; Internal functions
 208
 209 ;; Creating new IDs
 210
 211 (defun org-id-new (&optional prefix)
 212   "Create a new globally unique ID.
 213
 214 An ID consists of two parts separated by a colon:
 215 - a prefix
 216 - an encoding of the current time to micro-second accuracy
 217
 218 PREFIX can specify the prefix, the default is given by the variable
 219 `org-id-prefix'.  However, if PREFIX is the symbol `none', don't use any
 220 prefix even if `org-id-prefix' specifies one.
 221
 222 So a typical ID could look like \"Org:4nd91V40HI\"."
 223   (let* ((prefix (if (eq prefix 'none)
 224                      nil
 225                    (or prefix org-id-prefix)))
 226          (etime (org-id-time-to-b62))
 227          (postfix (if org-id-include-domain
 228                       (progn
 229                         (require 'message)
 230                         (concat "@" (message-make-fqdn))))))
 231     (if prefix
 232         (concat prefix ":" etime postfix)
 233       (concat etime postfix))))
 234
 235 (defun org-id-int-to-b62-one-digit (i)
 236   "Turn an integer between 0 and 61 into a single character 0..9, A..Z, a..z."
 237   (cond
 238    ((< i 10) (+ ?0 i))
 239    ((< i 36) (+ ?A i -10))
 240    ((< i 62) (+ ?a i -36))
 241    (t (error "Larger that 61"))))
 242
 243 (defun org-id-b62-to-int-one-digit (i)
 244   "Turn a character 0..9, A..Z, a..z into a number 0..61.
 245 The input I may be a character, or a single-letter string."
 246   (and (stringp i) (setq i (string-to-char i)))
 247   (cond
 248    ((and (>= i ?0) (<= i ?9)) (- i ?0))
 249    ((and (>= i ?A) (<= i ?Z)) (+ (- i ?A) 10))
 250    ((and (>= i ?a) (<= i ?z)) (+ (- i ?a) 36))
 251    (t (error "Invalid b62 letter"))))
 252
 253 (defun org-id-int-to-b62 (i &optional length)
 254   "Convert an integer to a base-62 number represented as a string."
 255   (let ((s ""))
 256     (while (> i 0)
 257       (setq s (concat (char-to-string
 258                        (org-id-int-to-b62-one-digit (mod i 62))) s)
 259             i (/ i 62)))
 260     (setq length (max 1 (or length 1)))
 261     (if (< (length s) length)
 262         (setq s (concat (make-string (- length (length s)) ?0) s)))
 263     s))
 264
 265 (defun org-id-b62-to-int (s)
 266   "Convert a base-62 string into the corresponding integer."
 267   (let ((r 0))
 268     (mapc (lambda (i) (setq r (+ (* r 62) (org-id-b62-to-int-one-digit i))))
 269           s)
 270     r))
 271
 272 (defun org-id-time-to-b62 (&optional time)
 273   "Encode TIME as a 10-digit string.
 274 This string holds the time to micro-second accuracy, and can be decoded
 275 using `org-id-decode'."
 276   (setq time (or time (current-time)))
 277   (concat (org-id-int-to-b62 (nth 0 time) 3)
 278           (org-id-int-to-b62 (nth 1 time) 3)
 279           (org-id-int-to-b62 (or (nth 2 time) 0) 4)))
 280
 281 (defun org-id-decode (id)
 282   "Split ID into the prefix and the time value that was used to create it.
 283 The return value is (prefix . time) where PREFIX is nil or a string,
 284 and time is the usual three-integer representation of time."
 285   (let (prefix time parts)
 286     (setq parts (org-split-string id ":"))
 287     (if (= 2 (length parts))
 288         (setq prefix (car parts) time (nth 1 parts))
 289       (setq prefix nil time (nth 0 parts)))
 290     (setq time (list (org-id-b62-to-int (substring time 0 3))
 291                      (org-id-b62-to-int (substring time 3 6))
 292                      (org-id-b62-to-int (substring time 6 10))))
 293     (cons prefix time)))
 294
 295 ;; Storing ID locations (files)
 296
 297 (defun org-id-update-id-locations ()
 298   "Scan relevant files for ID's.
 299 Store the relation between files and corresponding ID's."
 300   (interactive)
 301   (let ((files (append (org-agenda-files)
 302                        (if (symbolp org-id-extra-files)
 303                            (symbol-value org-id-extra-files)
 304                          org-id-extra-files)))
 305         org-agenda-new-buffers
 306         file ids reg found id)
 307     (while (setq file (pop files))
 308       (setq ids nil)
 309       (with-current-buffer (org-get-agenda-file-buffer file)
 310         (save-excursion
 311           (save-restriction
 312             (widen)
 313             (goto-char (point-min))
 314             (while (re-search-forward "^[ \t]*:ID:[ \t]+\\(\\S-+\\)[ \t]*$"
 315                                       nil t)
 316               (setq id (org-match-string-no-properties 1))
 317               (if (member id found)
 318                   (error "Duplicate ID \"%s\"" id))
 319               (push id found)
 320               (push id ids))
 321             (push (cons file ids) reg)))))
 322     (org-release-buffers org-agenda-new-buffers)
 323     (setq org-agenda-new-buffers nil)
 324     (setq org-id-locations reg)
 325     (org-id-locations-save)))
 326
 327 (defun org-id-locations-save ()
 328   "Save `org-id-locations' in `org-id-locations-file'."
 329   (with-temp-file org-id-locations-file
 330     (print org-id-locations (current-buffer))))
 331
 332 (defun org-id-locations-load ()
 333   "Read the data from `org-id-locations-file'."
 334   (setq org-id-locations nil)
 335   (with-temp-buffer
 336     (condition-case nil
 337         (progn
 338           (insert-file-contents-literally org-id-locations-file)
 339           (goto-char (point-min))
 340           (setq org-id-locations (read (current-buffer))))
 341       (error
 342        (message "Could not read org-id-values from %s. Setting it to nil."
 343                 org-id-locations-file)))))
 344
 345 (defun org-id-add-location (id file)
 346   "Add the ID with location FILE to the database of ID loations."
 347   (unless org-id-locations (org-id-locations-load))
 348   (catch 'exit
 349     (let ((locs org-id-locations) list)
 350       (while (setq list (pop locs))
 351         (when (equal (file-truename file) (file-truename (car list)))
 352           (setcdr list (cons id (cdr list)))
 353           (throw 'exit t))))
 354     (push (list file id) org-id-locations))
 355   (org-id-locations-save))
 356
 357 ;; Finding entries with specified id
 358
 359 (defun org-id-find-id-file (id)
 360   "Query the id database for the file in which this ID is located."
 361   (unless org-id-locations (org-id-locations-load))
 362   (catch 'found
 363     (mapc (lambda (x) (if (member id (cdr x))
 364                           (throw 'found (car x))))
 365           org-id-locations)
 366     nil))
 367
 368 (defun org-id-find-id-in-file (id file &optional markerp)
 369   "Return the position of the entry ID in FILE.
 370 If that files does not exist, or if it does not contain this ID,
 371 return nil.
 372 The position is returned as a cons cell (file-name . position).  With
 373 optional argument MARKERP, return the position as a new marker."
 374   (let (org-agenda-new-buffers m buf pos)
 375     (cond
 376      ((not file) nil)
 377      ((not (file-exists-p file)) nil)
 378      (t (with-current-buffer (setq buf (org-get-agenda-file-buffer file))
 379           (setq pos (org-find-entry-with-id id))
 380           (when pos
 381             (if markerp
 382                 (move-marker (make-marker) pos buf)
 383               (cons file pos))))))))
 384
 385 (provide 'org-id)
 386
 387 ;;; org-id.el ends here
 388
 389 ;; arch-tag: e5abaca4-e16f-4b25-832a-540cfb63a712