]> code.delx.au - gnu-emacs/blobdiff - lisp/org/org-id.el
Merge from origin/emacs-25
[gnu-emacs] / lisp / org / org-id.el
index 7e2c4286f408d02e8b44f1d0c09478fe399892c2..a6edfcf623967142fd597efbf91d26a684f6b96f 100644 (file)
@@ -1,11 +1,10 @@
 ;;; org-id.el --- Global identifiers for Org-mode entries
 ;;
-;; Copyright (C) 2008, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2016 Free Software Foundation, Inc.
 ;;
 ;; Author: Carsten Dominik <carsten at orgmode dot org>
 ;; Keywords: outlines, hypermedia, calendar, wp
 ;; Homepage: http://orgmode.org
-;; Version: 6.33x
 ;;
 ;; This file is part of GNU Emacs.
 ;;
@@ -37,8 +36,9 @@
 ;; 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.  As an external method `uuidgen' is supported, if installed
-;; on the system.
+;; together.
+;;
+;; By default Org uses UUIDs as global unique identifiers.
 ;;
 ;; This file defines the following API:
 ;;
 ;;        Find the location of an entry with specific id.
 ;;
 
+;;; Code:
+
 (require 'org)
 
 (declare-function message-make-fqdn "message" ())
+(declare-function org-pop-to-buffer-same-window
+                 "org-compat" (&optional buffer-or-name norecord label))
 
 ;;; Customization
 
   :tag "Org ID"
   :group 'org)
 
+(define-obsolete-variable-alias
+  'org-link-to-org-use-id 'org-id-link-to-org-use-id "24.3")
+(defcustom org-id-link-to-org-use-id nil
+  "Non-nil means storing a link to an Org file will use entry IDs.
+
+The variable can have the following values:
+
+t     Create an ID if needed to make a link to the current entry.
+
+create-if-interactive
+      If `org-store-link' is called directly (interactively, as a user
+      command), do create an ID to support the link.  But when doing the
+      job for capture, only use the ID if it already exists.  The
+      purpose of this setting is to avoid proliferation of unwanted
+      IDs, just because you happen to be in an Org file when you
+      call `org-capture' that automatically and preemptively creates a
+      link.  If you do want to get an ID link in a capture template to
+      an entry not having an ID, create it first by explicitly creating
+      a link to it, using `C-c C-l' first.
+
+create-if-interactive-and-no-custom-id
+      Like create-if-interactive, but do not create an ID if there is
+      a CUSTOM_ID property defined in the entry.
+
+use-existing
+      Use existing ID, do not create one.
+
+nil   Never use an ID to make a link, instead link using a text search for
+      the headline text."
+  :group 'org-link-store
+  :group 'org-id
+  :version "24.3"
+  :type '(choice
+         (const :tag "Create ID to make link" t)
+         (const :tag "Create if storing link interactively"
+                create-if-interactive)
+         (const :tag "Create if storing link interactively and no CUSTOM_ID is present"
+                create-if-interactive-and-no-custom-id)
+         (const :tag "Only use existing" use-existing)
+         (const :tag "Do not use ID to create link" nil)))
+
 (defcustom org-id-uuid-program "uuidgen"
   "The uuidgen program."
   :group 'org-id
   :type 'string)
 
-(defcustom org-id-method
-  (condition-case nil
-      (if (string-match "\\`[-0-9a-fA-F]\\{36\\}\\'"
-                       (org-trim (shell-command-to-string
-                                  org-id-uuid-program)))
-         'uuidgen
-       'org)
-    (error 'org))
+(defcustom org-id-method 'uuid
   "The method that should be used to create new IDs.
 
-If `uuidgen' is available on the system, it will be used as the default method.
-if not, the method `org' is used.
 An ID will consist of the optional prefix specified in `org-id-prefix',
 and a unique part created by the method this variable specifies.
 
@@ -105,11 +141,13 @@ org        Org's own internal method, using an encoding of the current time to
            microsecond accuracy, and optionally the current domain of the
            computer.  See the variable `org-id-include-domain'.
 
-uuidgen    Call the external command uuidgen."
+uuid       Create random (version 4) UUIDs.  If the program defined in
+           `org-id-uuid-program' is available it is used to create the ID.
+           Otherwise an internal functions is used."
   :group 'org-id
   :type '(choice
          (const :tag "Org's internal method" org)
-         (const :tag "external: uuidgen" uuidgen)))
+         (const :tag "external: uuidgen" uuid)))
 
 (defcustom org-id-prefix nil
   "The prefix for IDs.
@@ -123,7 +161,7 @@ to have no space characters in them."
          (string :tag "Prefix")))
 
 (defcustom org-id-include-domain nil
-  "Non-nil means, add the domain name to new IDs.
+  "Non-nil means add the domain name to new IDs.
 This ensures global uniqueness of IDs, and is also suggested by
 RFC 2445 in combination with RFC 822.  This is only relevant if
 `org-id-method' is `org'.  When uuidgen is used, the domain will never
@@ -135,7 +173,7 @@ people to make this necessary."
   :type 'boolean)
 
 (defcustom org-id-track-globally t
-  "Non-nil means, track IDs through files, so that links work globally.
+  "Non-nil means track IDs through files, so that links work globally.
 This work by maintaining a hash table for IDs and writing this table
 to disk when exiting Emacs.  Because of this, it works best if you use
 a single Emacs process, not many.
@@ -148,16 +186,14 @@ the link."
   :type 'boolean)
 
 (defcustom org-id-locations-file (convert-standard-filename
-                                 "~/.emacs.d/.org-id-locations")
+                                 (concat user-emacs-directory ".org-id-locations"))
   "The file for remembering in which file an ID was defined.
 This variable is only relevant when `org-id-track-globally' is set."
   :group 'org-id
   :type 'file)
 
 (defvar org-id-locations nil
-  "List of files with IDs in those files.
-Depending on `org-id-use-hash' this can also be a hash table mapping IDs
-to files.")
+  "List of files with IDs in those files.")
 
 (defvar org-id-files nil
   "List of files that contain IDs.")
@@ -178,7 +214,7 @@ This variable is only relevant when `org-id-track-globally' is set."
            (file))))
 
 (defcustom org-id-search-archives t
-  "Non-nil means, search also the archive files of agenda files for entries.
+  "Non-nil means search also the archive files of agenda files for entries.
 This is a possibility to reduce overhead, but it means that entries moved
 to the archives can no longer be found by ID.
 This variable is only relevant when `org-id-track-globally' is set."
@@ -221,21 +257,20 @@ In any case, the ID of the entry is returned."
        (setq id (org-id-new prefix))
        (org-entry-put pom "ID" id)
        (org-id-add-location id (buffer-file-name (buffer-base-buffer)))
-       id)
-       (t nil)))))
+       id)))))
 
 ;;;###autoload
 (defun org-id-get-with-outline-path-completion (&optional targets)
-  "Use outline-path-completion to retrieve the ID of an entry.
-TARGETS may be a setting for `org-refile-targets' to define the eligible
-headlines.  When omitted, all headlines in all agenda files are
-eligible.
-It returns the ID of the entry.  If necessary, the ID is created."
+  "Use `outline-path-completion' to retrieve the ID of an entry.
+TARGETS may be a setting for `org-refile-targets' to define
+eligible headlines.  When omitted, all headlines in the current
+file are eligible.  This function returns the ID of the entry.
+If necessary, the ID is created."
   (let* ((org-refile-targets (or targets '((nil . (:maxlevel . 10)))))
         (org-refile-use-outline-path
          (if (caar org-refile-targets) 'file t))
         (org-refile-target-verify-function nil)
-        (spos (org-refile-get-location "Entry"))
+        (spos (org-refile-get-location "Entry"))
         (pom (and spos (move-marker (make-marker) (nth 3 spos)
                                     (get-file-buffer (nth 1 spos))))))
     (prog1 (org-id-get pom 'create)
@@ -259,7 +294,7 @@ Move the cursor to that entry in that buffer."
   (let ((m (org-id-find id 'marker)))
     (unless m
       (error "Cannot find entry with ID \"%s\"" id))
-    (switch-to-buffer (marker-buffer m))
+    (org-pop-to-buffer-same-window (marker-buffer m))
     (goto-char m)
     (move-marker m nil)
     (org-show-context)))
@@ -278,7 +313,7 @@ With optional argument MARKERP, return the position as a new marker."
     (when file
       (setq where (org-id-find-id-in-file id file markerp)))
     (unless where
-      (org-id-update-id-locations)
+      (org-id-update-id-locations nil t)
       (setq file (org-id-find-id-file id))
       (when file
        (setq where (org-id-find-id-in-file id file markerp))))
@@ -288,6 +323,7 @@ With optional argument MARKERP, return the position as a new marker."
 
 ;; Creating new IDs
 
+;;;###autoload
 (defun org-id-new (&optional prefix)
   "Create a new globally unique ID.
 
@@ -306,10 +342,12 @@ So a typical ID could look like \"Org:4nd91V40HI\"."
         unique)
     (if (equal prefix ":") (setq prefix ""))
     (cond
-     ((eq org-id-method 'uuidgen)
-      (setq unique (org-trim (shell-command-to-string org-id-uuid-program))))
+     ((memq org-id-method '(uuidgen uuid))
+      (setq unique (org-trim (shell-command-to-string org-id-uuid-program)))
+      (unless (org-uuidgen-p unique)
+       (setq unique (org-id-uuid))))
      ((eq org-id-method 'org)
-      (let* ((etime (org-id-reverse-string (org-id-time-to-b36)))
+      (let* ((etime (org-reverse-string (org-id-time-to-b36)))
             (postfix (if org-id-include-domain
                          (progn
                            (require 'message)
@@ -318,8 +356,29 @@ So a typical ID could look like \"Org:4nd91V40HI\"."
      (t (error "Invalid `org-id-method'")))
     (concat prefix unique)))
 
-(defun org-id-reverse-string (s)
-  (mapconcat 'char-to-string (nreverse (string-to-list s)) ""))
+(defun org-id-uuid ()
+  "Return string with random (version 4) UUID."
+  (let ((rnd (md5 (format "%s%s%s%s%s%s%s"
+                         (random)
+                         (current-time)
+                         (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 (i)
   "Turn an integer between 0 and 61 into a single character 0..9, A..Z, a..z."
@@ -374,7 +433,7 @@ and time is the usual three-integer representation of time."
     (if (= 2 (length parts))
        (setq prefix (car parts) time (nth 1 parts))
       (setq prefix nil time (nth 0 parts)))
-    (setq time (org-id-reverse-string time))
+    (setq time (org-reverse-string time))
     (setq time (list (org-id-b36-to-int (substring time 0 4))
                     (org-id-b36-to-int (substring time 4 8))
                     (org-id-b36-to-int (substring time 8 12))))
@@ -382,7 +441,8 @@ and time is the usual three-integer representation of time."
 
 ;; Storing ID locations (files)
 
-(defun org-id-update-id-locations (&optional files)
+;;;###autoload
+(defun org-id-update-id-locations (&optional files silent)
   "Scan relevant files for IDs.
 Store the relation between files and corresponding IDs.
 This will scan all agenda files, all associated archives, and all
@@ -406,11 +466,11 @@ When CHECK is given, prepare detailed information about duplicate IDs."
                 (if (symbolp org-id-extra-files)
                     (symbol-value org-id-extra-files)
                   org-id-extra-files)
-             ;; Files associated with live org-mode buffers
+                ;; Files associated with live org-mode buffers
                 (delq nil
                       (mapcar (lambda (b)
                                 (with-current-buffer b
-                                  (and (org-mode-p) (buffer-file-name))))
+                                  (and (derived-mode-p 'org-mode) (buffer-file-name))))
                               (buffer-list)))
                 ;; All files known to have IDs
                 org-id-files)))
@@ -420,8 +480,9 @@ When CHECK is given, prepare detailed information about duplicate IDs."
        (setq files (delq 'agenda-archives (copy-sequence files))))
       (setq nfiles (length files))
       (while (setq file (pop files))
-       (message "Finding ID locations (%d/%d files): %s"
-                (- nfiles (length files)) nfiles file)
+       (unless silent
+         (message "Finding ID locations (%d/%d files): %s"
+                  (- nfiles (length files)) nfiles file))
        (setq tfile (file-truename file))
        (when (and (file-exists-p file) (not (member tfile seen)))
          (push tfile seen)
@@ -466,12 +527,14 @@ When CHECK is given, prepare detailed information about duplicate IDs."
 
 (defun org-id-locations-save ()
   "Save `org-id-locations' in `org-id-locations-file'."
-  (when org-id-track-globally
+  (when (and org-id-track-globally org-id-locations)
     (let ((out (if (hash-table-p org-id-locations)
                   (org-id-hash-to-alist org-id-locations)
                 org-id-locations)))
       (with-temp-file org-id-locations-file
-       (print out (current-buffer))))))
+       (let ((print-level nil)
+             (print-length nil))
+         (print out (current-buffer)))))))
 
 (defun org-id-locations-load ()
   "Read the data from `org-id-locations-file'."
@@ -484,7 +547,7 @@ When CHECK is given, prepare detailed information about duplicate IDs."
            (goto-char (point-min))
            (setq org-id-locations (read (current-buffer))))
        (error
-        (message "Could not read org-id-values from %s. Setting it to nil."
+        (message "Could not read org-id-values from %s.  Setting it to nil."
                  org-id-locations-file))))
     (setq org-id-files (mapcar 'car org-id-locations))
     (setq org-id-locations (org-id-alist-to-hash org-id-locations))))
@@ -497,7 +560,8 @@ When CHECK is given, prepare detailed information about duplicate IDs."
     (puthash id (abbreviate-file-name file) org-id-locations)
     (add-to-list 'org-id-files (abbreviate-file-name file))))
 
-(add-hook 'kill-emacs-hook 'org-id-locations-save)
+(unless noninteractive
+  (add-hook 'kill-emacs-hook 'org-id-locations-save))
 
 (defun org-id-hash-to-alist (hash)
   "Turn an org-id hash into an alist, so that it can be written to a file."
@@ -545,7 +609,9 @@ When CHECK is given, prepare detailed information about duplicate IDs."
 (defun org-id-find-id-file (id)
   "Query the id database for the file in which this ID is located."
   (unless org-id-locations (org-id-locations-load))
-  (or (gethash id org-id-locations)
+  (or (and org-id-locations
+          (hash-table-p org-id-locations)
+          (gethash id org-id-locations))
       ;; ball back on current buffer
       (buffer-file-name (or (buffer-base-buffer (current-buffer))
                            (current-buffer)))))
@@ -572,17 +638,22 @@ optional argument MARKERP, return the position as a new marker."
 ;; Calling the following function is hard-coded into `org-store-link',
 ;; so we do have to add it to `org-store-link-functions'.
 
+;;;###autoload
 (defun org-id-store-link ()
   "Store a link to the current entry, using its ID."
   (interactive)
-  (let* ((link (org-make-link "id:" (org-id-get-create)))
-        (desc (save-excursion
-                (org-back-to-heading t)
-                (or (and (looking-at org-complex-heading-regexp)
-                         (if (match-end 4) (match-string 4) (match-string 0)))
-                    link))))
-    (org-store-link-props :link link :description desc :type "id")
-    link))
+  (when (and (buffer-file-name (buffer-base-buffer)) (derived-mode-p 'org-mode))
+    (let* ((link (concat "id:" (org-id-get-create)))
+          (case-fold-search nil)
+          (desc (save-excursion
+                  (org-back-to-heading t)
+                  (or (and (looking-at org-complex-heading-regexp)
+                           (if (match-end 4)
+                               (match-string 4)
+                             (match-string 0)))
+                      link))))
+      (org-store-link-props :link link :description desc :type "id")
+      link)))
 
 (defun org-id-open (id)
   "Go to the entry with id ID."
@@ -611,8 +682,8 @@ optional argument MARKERP, return the position as a new marker."
 
 (provide 'org-id)
 
-;;; org-id.el ends here
-
-;; arch-tag: e5abaca4-e16f-4b25-832a-540cfb63a712
-
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
 
+;;; org-id.el ends here