Browse Source

Merge branch 'org-id-uuid' of git://github.com/dmj/dmj-org-mode

Carsten Dominik 15 years ago
parent
commit
7bb31a512e
2 changed files with 44 additions and 16 deletions
  1. 8 0
      lisp/ChangeLog
  2. 36 16
      lisp/org-id.el

+ 8 - 0
lisp/ChangeLog

@@ -29,6 +29,14 @@
 	`also-non-dangling-p' to `only-dangling-p', since due to a bug
 	`also-non-dangling-p' to `only-dangling-p', since due to a bug
 	this was the default behavior all along.
 	this was the default behavior all along.
 
 
+2010-05-16  David Maus  <dmaus@ictsoc.de>
+
+	* org-id.el (org-id-uuid): New function.  Return string with
+	random (version 4) UUID.
+	(org-id-method): Make 'uuid the new default value.
+	(org-id-new): Use `org-id-uuid' if call to uuidgen program
+	does not return a UUID.
+
 2010-05-15  Carsten Dominik  <carsten.dominik@gmail.com>
 2010-05-15  Carsten Dominik  <carsten.dominik@gmail.com>
 
 
 	* org-latex.el (org-export-latex-format-image): Add support
 	* org-latex.el (org-export-latex-format-image): Add support

+ 36 - 16
lisp/org-id.el

@@ -37,8 +37,9 @@
 ;; time of the ID, with microsecond accuracy.  This virtually
 ;; time of the ID, with microsecond accuracy.  This virtually
 ;; guarantees globally unique identifiers, even if several people are
 ;; guarantees globally unique identifiers, even if several people are
 ;; creating IDs at the same time in files that will eventually be used
 ;; 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:
 ;; This file defines the following API:
 ;;
 ;;
@@ -84,18 +85,9 @@
   :group 'org-id
   :group 'org-id
   :type 'string)
   :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.
   "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',
 An ID will consist of the optional prefix specified in `org-id-prefix',
 and a unique part created by the method this variable specifies.
 and a unique part created by the method this variable specifies.
 
 
@@ -105,11 +97,13 @@ org        Org's own internal method, using an encoding of the current time to
            microsecond accuracy, and optionally the current domain of the
            microsecond accuracy, and optionally the current domain of the
            computer.  See the variable `org-id-include-domain'.
            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
   :group 'org-id
   :type '(choice
   :type '(choice
 	  (const :tag "Org's internal method" org)
 	  (const :tag "Org's internal method" org)
-	  (const :tag "external: uuidgen" uuidgen)))
+	  (const :tag "external: uuidgen" uuid)))
 
 
 (defcustom org-id-prefix nil
 (defcustom org-id-prefix nil
   "The prefix for IDs.
   "The prefix for IDs.
@@ -306,8 +300,10 @@ So a typical ID could look like \"Org:4nd91V40HI\"."
 	 unique)
 	 unique)
     (if (equal prefix ":") (setq prefix ""))
     (if (equal prefix ":") (setq prefix ""))
     (cond
     (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)
      ((eq org-id-method 'org)
       (let* ((etime (org-id-reverse-string (org-id-time-to-b36)))
       (let* ((etime (org-id-reverse-string (org-id-time-to-b36)))
 	     (postfix (if org-id-include-domain
 	     (postfix (if org-id-include-domain
@@ -318,6 +314,30 @@ So a typical ID could look like \"Org:4nd91V40HI\"."
      (t (error "Invalid `org-id-method'")))
      (t (error "Invalid `org-id-method'")))
     (concat prefix unique)))
     (concat prefix unique)))
 
 
+(defun org-id-uuid ()
+  "Return string with random (version 4) UUID."
+  (let ((rnd (md5 (format "%s%s%s%s%s%s%s"
+			  (random t)
+			  (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-reverse-string (s)
 (defun org-id-reverse-string (s)
   (mapconcat 'char-to-string (nreverse (string-to-list s)) ""))
   (mapconcat 'char-to-string (nreverse (string-to-list s)) ""))