all messages for Emacs-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
* Feedback on changes to org-id
@ 2016-09-03  0:24 Aaron Ecay
  2016-09-03  8:25 ` Nicolas Goaziou
  0 siblings, 1 reply; 9+ messages in thread
From: Aaron Ecay @ 2016-09-03  0:24 UTC (permalink / raw)
  To: Org-mode

[-- Attachment #1: Type: text/plain, Size: 3718 bytes --]

Hello all,

It’s an occasional project of mine to try to improve and refactor
aspects of org’s code.  I’ve been going through org-id recently.  The
following issues came up that I would appreciate feedback on:

1. org-id is not loaded by default; it is supposed to be selected by the
   user (see footnote 2 of (info "(org) Handling links")).  Yet, other
   org libraries rely on it, without requiring it (e.g. ox-icalendar).
   Also, at least one library (org-bibtex) reimplements bits of org-id’s
   internals to avoid requiring it explicitly.  Is there a good reason
   not to make org-id a core library, that is to require it
   unconditionally from org.el?

2. I would like to deprecate the org-id-method variable.  This allows
   choosing different methods of generating random IDs.  But one method
   is as good as another (they are random*...), so we can just always use
   a single method (powered by the elisp ‘random’ function).  Choosing
   this allows deprecating several other variables and functions, along
   with a soft dependency on the external uuidgen binary.  Any
   objections to this course of action?

(* Not all the values of org-id-method lead to IDs that are random in
the statistical sense.  But they are not meaningful from the user’s
point of view in any case.)

3. I would like to change the API of the org-id-get function.  The
   current signature is (&optional pom create prefix).  POM
   (i.e. position or marker) is a useless argument, because in the
   (relatively uncommon) case that callers are interested in a location
   other than (point) they can wrap the call in (org-with-point-at ...).
   PREFIX is similarly useless (and in fact unused in org’s code base)
   because a caller could let-bind org-id-prefix around the call.  The
   new signature would be (&optional create reset), which are both
   boolean arguments.  The question arises of how to make this change.
   Options I see:
   a. Hard breakage; code using the old calling convention will break.
   b. Introduce a new function under a new name, deprecate the old name
   c. Try to detect which calling convention is in use.
   Options (a) and (b) have drawbacks.  I would like to implement
   (c) by requiring the create and reset arguments, if given, to have
   values 'create and 'reset respectively.  The old and new calling
   conventions have identical semantics when both arguments are nil, so
   that case is not a problem.  With the new code, any other value for
   these arguments (besides nil and a same-named symbol) would indicate
   use of the old convention, and signal an error.  Comments?

4. A similar issue arises for org-id-find.  I would like it to always
   return a marker, rather than having an argument switch between a
   marker and a cons of filename and position.  (There are functions
   which return the filename or position individually, so returning both
   as a cons is useless from an API point of view).  There’s no good way
   to detect the old calling convention, however, so I think I have to
   introduce a new name.  (My draft patch is written instead with hard
   breakage, but stability of API is important so I will change that...)

There are other deprecations and renamings as well, but none of them
should break third-party code.  The resultant patch shrinks the codebase
by 60-ish lines and eliminates 3 defcustoms...baby steps.  A draft patch
is attached to this message; I expect to make further changes based on
feedback I receive, so detailed code review (while certainly always
appreciated!) can be postponed until the conceptual issues are
resolved.

Thanks,

-- 
Aaron Ecay

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Draft-changes-to-org-id.patch --]
[-- Type: text/x-diff, Size: 40398 bytes --]

From 925c6f4e920555c402be271443d167d60ccccdff Mon Sep 17 00:00:00 2001
From: Aaron Ecay <aaronecay@gmail.com>
Date: Fri, 2 Sep 2016 23:30:10 +0100
Subject: [PATCH] Draft changes to org-id

---
 contrib/lisp/org-drill.el |   2 +-
 contrib/lisp/org-index.el |  18 +-
 etc/ORG-NEWS              |  37 +++-
 lisp/ob-ref.el            |  15 +-
 lisp/org-attach.el        |   2 +-
 lisp/org-capture.el       |   4 +-
 lisp/org-colview.el       |   4 +-
 lisp/org-id.el            | 468 +++++++++++++++++++---------------------------
 lisp/org-mobile.el        |   6 +-
 lisp/org-table.el         |   2 +-
 lisp/org.el               |  11 +-
 lisp/ox-html.el           |   1 -
 lisp/ox-icalendar.el      |   2 +-
 lisp/ox.el                |   2 +-
 testing/org-test.el       |   5 +-
 15 files changed, 259 insertions(+), 320 deletions(-)

diff --git a/contrib/lisp/org-drill.el b/contrib/lisp/org-drill.el
index a78b806..b5ce306 100644
--- a/contrib/lisp/org-drill.el
+++ b/contrib/lisp/org-drill.el
@@ -2614,7 +2614,7 @@ STATUS is one of the following values:
                        "(slow, but only happens once)"))
       (sit-for 0.5)
       (setq warned-about-id-creation t))
-    (org-id-get-create) ; ensure drill entry has unique ID
+    (org-id-get 'create) ; ensure drill entry has unique ID
     (destructuring-bind (status due age)
         (org-drill-entry-status)
       (case status
diff --git a/contrib/lisp/org-index.el b/contrib/lisp/org-index.el
index c4341c8..ab86b01 100644
--- a/contrib/lisp/org-index.el
+++ b/contrib/lisp/org-index.el
@@ -1278,10 +1278,10 @@ Argument COLUMN and VALUE specify line to get."
 
   ;; Find node
   (let (marker)
-    (setq marker (org-id-find org-index-id 'marker))
+    (setq marker (org-id-find org-index-id))
     (unless marker (org-index--create-missing-index "Cannot find the node with id \"%s\" (as specified by variable org-index-id)." org-index-id))
     ; Try again with new node
-    (setq marker (org-id-find org-index-id 'marker))
+    (setq marker (org-id-find org-index-id))
     (unless marker (error "Could not create node"))
     (setq org-index--buffer (marker-buffer marker)
           org-index--point (marker-position marker))
@@ -1421,7 +1421,7 @@ Argument COLUMN and VALUE specify line to get."
 (defun org-index--refresh-parse-table ()
   "Fast refresh of selected results of parsing index table."
 
-  (setq org-index--point (marker-position (org-id-find org-index-id 'marker)))
+  (setq org-index--point (marker-position (org-id-find org-index-id)))
   (with-current-buffer org-index--buffer
     (save-excursion
       (org-index--go-below-hline))))
@@ -1741,7 +1741,7 @@ specify flag TEMPORARY for th new table temporary, maybe COMPARE it with existin
   Remark: These lines of explanation can be removed at any time.
 "))
 
-      (setq id (org-id-get-create))
+      (setq id (org-id-get 'create))
       (insert (format "
 
   | ref | category | keywords | tags | count | level | last-accessed | created | id  | yank |
@@ -2119,7 +2119,7 @@ CREATE-REF and TAG-WITH-REF if given."
                     (cons (format "Updated index line %s" ref) yank)
                   (cons "Updated index line" nil))))
 
-      (setq id (org-id-get-create))
+      (setq id (org-id-get 'create))
       (org-index--refresh-parse-table)
       (setq id-from-index (org-index--on 'id id id))
       (setq ref (org-index--on 'id id (org-index--get-or-set-field 'ref)))
@@ -2187,7 +2187,7 @@ CREATE-REF and TAG-WITH-REF if given."
           (setq ids (cons id ids))
           
           ;; check, if id is valid
-          (setq marker (org-id-find id t))
+          (setq marker (org-id-find id))
           (unless marker
             (org-table-goto-column (org-index--column-num 'id))
             (throw 'problem "This id cannot be found")))
@@ -2271,7 +2271,7 @@ CREATE-REF and TAG-WITH-REF if given."
   
   (let (marker point args)
 
-    (setq marker (org-id-find id t))
+    (setq marker (org-id-find id))
     ;; enter buffer and collect information
     (with-current-buffer (marker-buffer marker)
       (setq point (point))
@@ -2346,7 +2346,7 @@ Optional argument DEFAULTS gives default values."
     
     ;; Delete from node
     (when id
-      (let ((m (org-id-find id 'marker)))
+      (let ((m (org-id-find id)))
         (set-buffer (marker-buffer m))
         (goto-char m)
         (move-marker m nil)
@@ -2462,7 +2462,7 @@ If OTHER in separate window."
   
   (let (message marker)
 
-    (setq marker (org-id-find id t))
+    (setq marker (org-id-find id))
 
     (if marker
         (progn
diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS
index c90b37c..c31a8f9 100644
--- a/etc/ORG-NEWS
+++ b/etc/ORG-NEWS
@@ -175,7 +175,7 @@ details.
 This option tells the export process how to behave when encountering
 a broken internal link.  See its docstring for more information.
 
-**** Attributes support in custom language environments for LaTeX export 
+**** Attributes support in custom language environments for LaTeX export
 Custom language environments for LaTeX export can now define the
 string to be inserted during export, using attributes to indicate the
 position of the elements. See variable ~org-latex-custom-lang-environments~
@@ -381,8 +381,25 @@ etc... Links are now centralized in ~org-link-parameters~.
 ** New functions
 *** ~org-next-line-empty-p~
 It replaces the deprecated ~next~ argument to ~org-previous-line-empty-p~.
-*** ~org-show-children~ 
+*** ~org-show-children~
 It is a faster implementation of ~outline-show-children~.
+*** New and changed org-id functions
+The functions ~org-id--reset~ is added.
+
+~org-id-find-id-file~ is renamed to ~org-id-find-file-for~.
+Additionally, this function now returns nil rather than
+~(buffer-file-name)~ if the ID cannot be located.
+
+~org-id-paste-tracker~ is renamed to ~org-id--yank-tracker~ to match
+emacs terminology and conventions for private functions.
+
+~org-id--remove-location~ is added.  ~org-id--add-location~ is renamed
+from the previous single-dash name for consistency.
+
+~org-id-files~ is a function, whose use replaces the former variable
+of the same name.
+
+~org-id-find~ now always returns a marker.
 
 ** Removed functions
 *** ~org-agenda-filter-by-tag-refine~ has been removed.
@@ -424,6 +441,17 @@ Additionally, ~org-sublist~ is deprecated in favor of ~cl-subseq~.  Note
 the differences in indexing conventions: ~org-sublist~ is 1-based and
 end-inclusive; ~cl-subseq~ is 0-based and end-exclusive.
 
+*** ~org-id-get-create~ is deprecated
+Use ~org-id-get~ with the ~create~ argument instead.
+
+*** Several helper functions in org-id are removed
+The affected functions are:
+- ~org-id-int-to-b36-one-digit~
+- ~org-id-b36-to-int-one-digit~
+- ~org-id-int-to-b36~
+- ~org-id-b36-to-int~
+- ~org-id-time-to-b36~
+- ~org-id-decode~
 ** Removed options
 *** Remove all options related to ~ido~ or ~iswitchb~
 This includes ~org-completion-use-iswitchb~ and ~org-completion-use-ido~.
@@ -434,6 +462,11 @@ Two consecutive blank lines always terminate all levels of current
 plain list.
 *** ~fixltx2e~ is removed from ~org-latex-default-packages-alist~
 fixltx2e is obsolete, see LaTeX News 22.
+*** Remove several org-id options
+The options ~org-id-uuid-program~ and ~org-id-method~ are deprecated.
+Ids are now generated as version 4 UUIDs unconditionally.  The
+~org-id-include-domain~ variable used by the old internal method is
+also deprecated.
 ** Miscellaneous
 *** Allow multiple receiver locations in radio tables and lists
 *** Allow angular links within link descriptions
diff --git a/lisp/ob-ref.el b/lisp/ob-ref.el
index c109d89..ed85618 100644
--- a/lisp/ob-ref.el
+++ b/lisp/ob-ref.el
@@ -58,12 +58,11 @@
 (declare-function org-element-type "org-element" (element))
 (declare-function org-end-of-meta-data "org" (&optional full))
 (declare-function org-find-property "org" (property &optional value))
-(declare-function org-id-find-id-file "org-id" (id))
-(declare-function org-id-find-id-in-file "org-id" (id file &optional markerp))
 (declare-function org-in-commented-heading-p "org" (&optional no-inheritance))
 (declare-function org-narrow-to-subtree "org" ())
 (declare-function org-show-context "org" (&optional key))
 (declare-function org-trim "org" (s &optional keep-lead))
+(declare-function org-id-find "org-id" (id &optional markerp recursing))
 
 (defvar org-babel-ref-split-regexp
   "[ \f\t\n\r\v]*\\(.+?\\)[ \f\t\n\r\v]*=[ \f\t\n\r\v]*\\(.+\\)[ \f\t\n\r\v]*")
@@ -100,13 +99,11 @@ the variable."
 (defun org-babel-ref-goto-headline-id (id)
   (or (let ((h (org-find-property "CUSTOM_ID" id)))
 	(when h (goto-char h)))
-      (let* ((file (org-id-find-id-file id))
-	     (m (when file (org-id-find-id-in-file id file 'marker))))
-	(when (and file m)
-	  (message "file:%S" file)
-	  (pop-to-buffer-same-window (marker-buffer m))
-	  (goto-char m)
-	  (move-marker m nil)
+      (let* ((loc (org-id-find id)))
+	(when loc
+	  (pop-to-buffer-same-window (marker-buffer loc))
+	  (goto-char loc)
+	  (move-marker loc nil)
 	  (org-show-context)
 	  t))))
 
diff --git a/lisp/org-attach.el b/lisp/org-attach.el
index b03beb6..fd16774 100644
--- a/lisp/org-attach.el
+++ b/lisp/org-attach.el
@@ -244,7 +244,7 @@ the directory and (if necessary) the corresponding ID will be created."
       (setq org-attach-inherited t))
      (t					; use the ID
       (org-attach-check-absolute-path nil)
-      (setq uuid (org-id-get (point) create-if-not-exists-p))
+      (setq uuid (org-id-get (when create-if-not-exists-p 'create)))
       (when (or uuid create-if-not-exists-p)
 	(unless uuid (error "ID retrieval/creation failed"))
 	(setq attach-dir (expand-file-name
diff --git a/lisp/org-capture.el b/lisp/org-capture.el
index 32d323d..649fca6 100644
--- a/lisp/org-capture.el
+++ b/lisp/org-capture.el
@@ -879,10 +879,10 @@ Store them in the capture property list."
 	(let ((loc (org-id-find (nth 1 target))))
 	  (if (not loc)
 	      (error "Cannot find target ID \"%s\"" (nth 1 target))
-	    (set-buffer (org-capture-target-buffer (car loc)))
+	    (set-buffer (org-capture-target-buffer (marker-buffer loc)))
 	    (widen)
 	    (org-capture-put-target-region-and-position)
-	    (goto-char (cdr loc)))))
+	    (goto-char loc))))
 
        ((eq (car target) 'file+headline)
 	(set-buffer (org-capture-target-buffer (nth 1 target)))
diff --git a/lisp/org-colview.el b/lisp/org-colview.el
index a856a24..0e24265 100644
--- a/lisp/org-colview.el
+++ b/lisp/org-colview.el
@@ -1403,7 +1403,9 @@ PARAMS is a property list of parameters:
 		(user-error "No such file: %S" id-string)))
 	     ((and (let idpos (org-find-entry-with-id id)) (guard idpos))
 	      (setq view-pos idpos))
-	     ((let `(,filename . ,position) (org-id-find id))
+	     ((and (let filename (org-id-find-file-for id))
+		   (guard filename)
+		   (let position (org-id-find-id-in-file id filename)))
 	      (setq view-file filename)
 	      (setq view-pos position))
 	     (_ (user-error "Cannot find entry with :ID: %s" id)))
diff --git a/lisp/org-id.el b/lisp/org-id.el
index 1abbe01..e54c095 100644
--- a/lisp/org-id.el
+++ b/lisp/org-id.el
@@ -42,12 +42,6 @@
 ;;
 ;; This file defines the following API:
 ;;
-;; org-id-get-create
-;;        Create an ID for the entry at point if it does not yet have one.
-;;        Returns the ID (old or new).  This function can be used
-;;        interactively, with prefix argument the creation of a new ID is
-;;        forced, even if there was an old one.
-;;
 ;; org-id-get
 ;;        Get the ID property of an entry.  Using appropriate arguments
 ;;        to the function, it can also create the ID for this entry.
@@ -71,8 +65,7 @@
 ;;; Code:
 
 (require 'org)
-
-(declare-function message-make-fqdn "message" ())
+(require 'cl-lib)
 
 ;;; Customization
 
@@ -121,30 +114,13 @@ nil   Never use an ID to make a link, instead link using a text search for
 	  (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 'uuid
-  "The method that should be used to create new IDs.
-
-An ID will consist of the optional prefix specified in `org-id-prefix',
-and a unique part created by the method this variable specifies.
-
-Allowed values are:
+(defconst org-id-uuid-program nil
+  "Obsolete and unused.")
+(make-obsolete-variable 'org-id-uuid-program "it is no longer needed." "Org 9.0")
 
-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'.
-
-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" uuid)))
+(defconst org-id-method nil
+  "Obsolete and unused.")
+(make-obsolete-variable 'org-id-method "it is no longer needed." "Org 9.0")
 
 (defcustom org-id-prefix nil
   "The prefix for IDs.
@@ -157,17 +133,9 @@ to have no space characters in them."
 	  (const :tag "No prefix")
 	  (string :tag "Prefix")))
 
-(defcustom org-id-include-domain nil
-  "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
-be added.
-The default is to not use this because we have no really good way to get
-the true domain, and Org entries will normally not be shared with enough
-people to make this necessary."
-  :group 'org-id
-  :type 'boolean)
+(defconst org-id-include-domain nil
+  "Obsolete and ignored.")
+(make-obsolete-variable 'org-id-include-domain "it is no longer needed." "Org 9.0")
 
 (defcustom org-id-track-globally t
   "Non-nil means track IDs through files, so that links work globally.
@@ -192,8 +160,9 @@ This variable is only relevant when `org-id-track-globally' is set."
 (defvar org-id-locations nil
   "List of files with IDs in those files.")
 
-(defvar org-id-files nil
-  "List of files that contain IDs.")
+(defconst org-id-files nil
+  "Use the function instead.")
+(make-obsolete-variable 'org-id-files "use the identically-named function instead." "Org 9.0")
 
 (defcustom org-id-extra-files 'org-agenda-text-search-extra-files
   "Files to be searched for IDs, besides the agenda files.
@@ -221,14 +190,15 @@ This variable is only relevant when `org-id-track-globally' is set."
 ;;; The API functions
 
 ;;;###autoload
-(defun org-id-get-create (&optional force)
-  "Create an ID for the current entry and return it.
+(defun org-id-get-create (&optional arg)
+  "DEPRECATED -- use `org-id-get' instead.
+
+Create an ID for the current entry and return it.
 If the entry already has an ID, just return it.
 With optional argument FORCE, force the creation of a new ID."
   (interactive "P")
-  (when force
-    (org-entry-put (point) "ID" nil))
-  (org-id-get (point) 'create))
+  (org-id-get 'create (when arg 'reset)))
+(make-obsolete 'org-id-get-create 'org-id-get "Org 9.0")
 
 ;;;###autoload
 (defun org-id-copy ()
@@ -238,23 +208,25 @@ Create an ID if necessary."
   (org-kill-new (org-id-get nil 'create)))
 
 ;;;###autoload
-(defun org-id-get (&optional pom create prefix)
-  "Get the ID property of the entry at point-or-marker POM.
-If POM is nil, refer to the entry at point.
+(defun org-id-get (&optional create reset)
+  "Get the ID property of the entry at point.
+
 If the entry does not have an ID, the function returns nil.
-However, when CREATE is non nil, create an ID if none is present already.
-PREFIX will be passed through to `org-id-new'.
-In any case, the ID of the entry is returned."
-  (org-with-point-at pom
-    (let ((id (org-entry-get nil "ID")))
-      (cond
-       ((and id (stringp id) (string-match "\\S-" id))
-	id)
-       (create
-	(setq id (org-id-new prefix))
-	(org-entry-put pom "ID" id)
-	(org-id-add-location id (buffer-file-name (buffer-base-buffer)))
-	id)))))
+However, when CREATE is non-nil, create an ID if none is present
+already.  When RESET is non-nil, the function will remove any
+existing ID."
+  (interactive (list 'create (when current-prefix-arg 'reset)))
+  (when reset
+    (org-id--reset))
+  (let ((id (org-entry-get nil "ID")))
+    (cond
+     ((and id (org-string-nw-p id))
+      id)
+     (create
+      (setq id (org-id-new))
+      (org-entry-put nil "ID" id)
+      (org-id--add-location id (buffer-file-name (buffer-base-buffer)))
+      id))))
 
 ;;;###autoload
 (defun org-id-get-with-outline-path-completion (&optional targets)
@@ -270,7 +242,7 @@ If necessary, the ID is created."
 	 (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)
+    (prog1 (org-with-point-at pom (org-id-get 'create))
       (move-marker pom nil))))
 
 ;;;###autoload
@@ -280,7 +252,7 @@ This only finds entries in the current buffer, using `org-get-location'.
 It returns the ID of the entry.  If necessary, the ID is created."
   (let* ((spos (org-get-location (current-buffer) org-goto-help))
 	 (pom (and spos (move-marker (make-marker) (car spos)))))
-    (prog1 (org-id-get pom 'create)
+    (prog1 (org-with-point-at pom (org-id-get 'create))
       (move-marker pom nil))))
 
 ;;;###autoload
@@ -288,7 +260,7 @@ It returns the ID of the entry.  If necessary, the ID is created."
   "Switch to the buffer containing the entry with id ID.
 Move the cursor to that entry in that buffer."
   (interactive "sID: ")
-  (let ((m (org-id-find id 'marker)))
+  (let ((m (org-id-find id)))
     (unless m
       (error "Cannot find entry with ID \"%s\"" id))
     (pop-to-buffer-same-window (marker-buffer m))
@@ -297,24 +269,24 @@ Move the cursor to that entry in that buffer."
     (org-show-context)))
 
 ;;;###autoload
-(defun org-id-find (id &optional markerp)
+(defun org-id-find (id &optional markerp recursing)
   "Return the location of the entry with the id ID.
-The return value is a cons cell (file-name . position), or nil
-if there is no entry with that ID.
-With optional argument MARKERP, return the position as a new marker."
-  (cond
-   ((symbolp id) (setq id (symbol-name id)))
-   ((numberp id) (setq id (number-to-string id))))
-  (let ((file (org-id-find-id-file id))
-	org-agenda-new-buffers where)
-    (when file
-      (setq where (org-id-find-id-in-file id file markerp)))
-    (unless where
-      (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))))
-    where))
+
+The return value is a marker, or nil if there is no entry with
+that ID.
+
+RECURSING is used internally to detect recursive calls to this
+function."
+  (when markerp
+    (error "The `markerp' argument to `org-id-find' is deprecated."))
+  (let* ((file (org-id-find-file-for id))
+	 (where (and file (org-id-find-id-in-file id file))))
+    (if where
+	(move-marker (make-marker) where (or (find-buffer-visiting file)
+					     (find-file-noselect file)))
+      (unless recursing
+	(org-id-update-id-locations nil t)
+	(org-id-find id nil t)))))
 
 ;;; Internal functions
 
@@ -335,23 +307,9 @@ prefix even if `org-id-prefix' specifies one.
 So a typical ID could look like \"Org:4nd91V40HI\"."
   (let* ((prefix (if (eq prefix 'none)
 		     ""
-		   (concat (or prefix org-id-prefix) ":")))
-	 unique)
+		   (concat (or prefix org-id-prefix) ":"))))
     (if (equal prefix ":") (setq prefix ""))
-    (cond
-     ((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-reverse-string (org-id-time-to-b36)))
-	     (postfix (if org-id-include-domain
-			  (progn
-			    (require 'message)
-			    (concat "@" (message-make-fqdn))))))
-	(setq unique (concat etime postfix))))
-     (t (error "Invalid `org-id-method'")))
-    (concat prefix unique)))
+    (concat prefix (org-id-uuid))))
 
 (defun org-id-uuid ()
   "Return string with random (version 4) UUID."
@@ -377,64 +335,11 @@ So a typical ID could look like \"Org:4nd91V40HI\"."
 	    (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."
-  (cond
-   ((< i 10) (+ ?0 i))
-   ((< i 36) (+ ?a i -10))
-   (t (error "Larger that 35"))))
-
-(defun org-id-b36-to-int-one-digit (i)
-  "Turn a character 0..9, A..Z, a..z into a number 0..61.
-The input I may be a character, or a single-letter string."
-  (and (stringp i) (setq i (string-to-char i)))
-  (cond
-   ((and (>= i ?0) (<= i ?9)) (- i ?0))
-   ((and (>= i ?a) (<= i ?z)) (+ (- i ?a) 10))
-   (t (error "Invalid b36 letter"))))
-
-(defun org-id-int-to-b36 (i &optional length)
-  "Convert an integer to a base-36 number represented as a string."
-  (let ((s ""))
-    (while (> i 0)
-      (setq s (concat (char-to-string
-		       (org-id-int-to-b36-one-digit (mod i 36))) s)
-	    i (/ i 36)))
-    (setq length (max 1 (or length 1)))
-    (if (< (length s) length)
-	(setq s (concat (make-string (- length (length s)) ?0) s)))
-    s))
-
-(defun org-id-b36-to-int (s)
-  "Convert a base-36 string into the corresponding integer."
-  (let ((r 0))
-    (mapc (lambda (i) (setq r (+ (* r 36) (org-id-b36-to-int-one-digit i))))
-	  s)
-    r))
-
-(defun org-id-time-to-b36 (&optional time)
-  "Encode TIME as a 10-digit string.
-This string holds the time to micro-second accuracy, and can be decoded
-using `org-id-decode'."
-  (setq time (or time (current-time)))
-  (concat (org-id-int-to-b36 (nth 0 time) 4)
-	  (org-id-int-to-b36 (nth 1 time) 4)
-	  (org-id-int-to-b36 (or (nth 2 time) 0) 4)))
-
-(defun org-id-decode (id)
-  "Split ID into the prefix and the time value that was used to create it.
-The return value is (prefix . time) where PREFIX is nil or a string,
-and time is the usual three-integer representation of time."
-  (let (prefix time parts)
-    (setq parts (org-split-string id ":"))
-    (if (= 2 (length parts))
-	(setq prefix (car parts) time (nth 1 parts))
-      (setq prefix nil time (nth 0 parts)))
-    (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))))
-    (cons prefix time)))
+(defun org-id--reset ()
+  "Remove the ID from the entry at point.
+
+FIXME: this function does not remove the ID from the global tracking."
+  (org-entry-put nil "ID" nil))
 
 ;; Storing ID locations (files)
 
@@ -445,82 +350,80 @@ Store the relation between files and corresponding IDs.
 This will scan all agenda files, all associated archives, and all
 files currently mentioned in `org-id-locations'.
 When FILES is given, scan these files instead.
-When CHECK is given, prepare detailed information about duplicate IDs."
+When SILENT is non-nil, suppress messages in the minibuffer."
   (interactive)
-  (if (not org-id-track-globally)
-      (error "Please turn on `org-id-track-globally' if you want to track IDs")
-    (let* ((org-id-search-archives
-	    (or org-id-search-archives
-		(and (symbolp org-id-extra-files)
-		     (symbol-value org-id-extra-files)
-		     (member 'agenda-archives org-id-extra-files))))
-	   (files
-	    (or files
-		(append
-		 ;; Agenda files and all associated archives
-		 (org-agenda-files t org-id-search-archives)
-		 ;; Explicit extra files
-		 (if (symbolp org-id-extra-files)
-		     (symbol-value org-id-extra-files)
-		   org-id-extra-files)
-		 ;; Files associated with live Org buffers
-		 (delq nil
-		       (mapcar (lambda (b)
-				 (with-current-buffer b
-				   (and (derived-mode-p 'org-mode) (buffer-file-name))))
-			       (buffer-list)))
-		 ;; All files known to have IDs
-		 org-id-files)))
-	   org-agenda-new-buffers
-	   file nfiles tfile ids reg found id seen (ndup 0))
-      (when (member 'agenda-archives files)
-	(setq files (delq 'agenda-archives (copy-sequence files))))
-      (setq nfiles (length files))
-      (while (setq file (pop files))
-	(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)
-	  (setq ids nil)
+  (unless org-id-track-globally
+    (user-error "Please turn on `org-id-track-globally' if you want to track IDs"))
+  (setq org-id-locations nil)
+  (let* ((org-id-search-archives
+	  (or org-id-search-archives
+	      ;; `agenda-archives' is a funky bit inherited from the
+	      ;; semantics of `org-agenda-text-search-extra-files'.
+	      (and (symbolp org-id-extra-files)
+		   (memq 'agenda-archives (symbol-value org-id-extra-files)))))
+	 (files
+	  (or files
+	      (remq 'agenda-archives
+		    (append
+		     ;; Agenda files and all associated archives
+		     (org-agenda-files t org-id-search-archives)
+		     ;; Explicit extra files
+		     (if (symbolp org-id-extra-files)
+			 (symbol-value org-id-extra-files)
+		       org-id-extra-files)
+		     ;; Files associated with live Org buffers
+		     (delq nil
+			   (mapcar (lambda (b)
+				     (with-current-buffer b
+				       (and (derived-mode-p 'org-mode) (buffer-file-name))))
+				   (buffer-list)))
+		     ;; All files known to have IDs
+		     (org-id-files)))))
+	 (nfiles (length files))
+	 (n 0)
+	 (ndup 0)
+	 org-agenda-new-buffers
+	 all-ids done-files)
+    (dolist (file files)
+      (cl-incf n)
+      (unless silent
+	(message "Finding ID locations (%d/%d files): %s"
+		 n nfiles file))
+      (let ((tfile (file-truename file))
+	    ids)
+	(when (and (file-exists-p file) (not (member tfile done-files)))
+	  (push tfile done-files)
 	  (with-current-buffer (org-get-agenda-file-buffer file)
-	    (save-excursion
-	      (save-restriction
-		(widen)
-		(goto-char (point-min))
-		(while (re-search-forward "^[ \t]*:ID:[ \t]+\\(\\S-+\\)[ \t]*$"
-					  nil t)
-		  (setq id (match-string-no-properties 1))
-		  (if (member id found)
-		      (progn
-			(message "Duplicate ID \"%s\", also in file %s"
-				 id (or (car (delq
-					      nil
-					      (mapcar
-					       (lambda (x)
-						 (if (member id (cdr x))
-						     (car x)))
-					       reg)))
-					(buffer-file-name)))
-			(when (= ndup 0)
-			  (ding)
-			  (sit-for 2))
-			(setq ndup (1+ ndup)))
-		    (push id found)
-		    (push id ids)))
-		(push (cons (abbreviate-file-name file) ids) reg))))))
-      (org-release-buffers org-agenda-new-buffers)
-      (setq org-agenda-new-buffers nil)
-      (setq org-id-locations reg)
-      (setq org-id-files (mapcar 'car org-id-locations))
-      (org-id-locations-save) ;; this function can also handle the alist form
-      ;; now convert to a hash
-      (setq org-id-locations (org-id-alist-to-hash org-id-locations))
-      (if (> ndup 0)
-	  (message "WARNING: %d duplicate IDs found, check *Messages* buffer" ndup)
-	(message "%d unique files scanned for IDs" (length org-id-files)))
-      org-id-locations)))
+	    (org-with-wide-buffer
+	     (goto-char (point-min))
+	     (while (re-search-forward "^[ \t]*:ID:" nil t)
+	       (let ((id (org-id-get)))
+		 (when id
+		   (if (member id all-ids)
+		       (progn
+			 (message "Duplicate ID \"%s\", also in file %s"
+				  id
+				  (or (car (cl-find-if
+					    (lambda (x)
+					      (member id (cdr x)))
+					    org-id-locations))
+				      (buffer-file-name)))
+			 ;; TODO: bogus?
+			 (when (= ndup 0)
+			   (ding)
+			   (sit-for 2))
+			 (setq ndup (1+ ndup)))
+		     (push id all-ids)
+		     (push id ids)))))
+	     (push (cons (abbreviate-file-name file) ids) org-id-locations))))))
+    (org-release-buffers org-agenda-new-buffers)
+    (org-id-locations-save) ;; This function can also handle the alist form.
+    ;; Now convert to a hash.
+    (if (> ndup 0)
+	(message "WARNING: %d duplicate IDs found, check *Messages* buffer" ndup)
+      (message "%d unique files scanned for IDs" (length org-id-locations)))
+    (setq org-id-locations (org-id-alist-to-hash org-id-locations))
+    org-id-locations))
 
 (defun org-id-locations-save ()
   "Save `org-id-locations' in `org-id-locations-file'."
@@ -546,19 +449,30 @@ When CHECK is given, prepare detailed information about duplicate IDs."
 	(error
 	 (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))))
 
-(defun org-id-add-location (id file)
+(defun org-id--add-location (id file)
   "Add the ID with location FILE to the database of ID locations."
   ;; Only if global tracking is on, and when the buffer has a file
   (when (and org-id-track-globally id file)
     (unless org-id-locations (org-id-locations-load))
-    (puthash id (abbreviate-file-name file) org-id-locations)
-    (add-to-list 'org-id-files (abbreviate-file-name file))))
+    (puthash id (abbreviate-file-name file) org-id-locations)))
+(define-obsolete-function-alias 'org-id-add-location 'org-id--add-location "Org 9.0")
+
+(defun org-id--remove-location (id)
+  "Remove any location associated with ID from `org-id-locations'."
+  (remhash id org-id-locations))
+
+(defun org-id-files ()
+  (cl-typecase org-id-locations
+    (hash-table (cl-remove-duplicates (hash-table-values org-id-locations)))
+    (list (mapcar 'car org-id-locations))
+    (t (error "Unknown value for `org-id-locations'."))))
+
+;;; TODO: need org-id-remove-location
 
 (unless noninteractive
-  (add-hook 'kill-emacs-hook 'org-id-locations-save))
+  (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."
@@ -575,16 +489,17 @@ When CHECK is given, prepare detailed information about duplicate IDs."
   "Turn an org-id location list into a hash table."
   (let ((res (make-hash-table
 	      :test 'equal
-	      :size (apply '+ (mapcar 'length list))))
-	f)
-    (mapc
-     (lambda (x)
-       (setq f (car x))
-       (mapc (lambda (i) (puthash i f res)) (cdr x)))
-     list)
+	      :size (apply #'+ (mapcar #'length list)))))
+    (dolist (pair list)
+      (let ((file (car pair)))
+	(dolist (id (cdr pair))
+	  (puthash id file res))))
     res))
 
-(defun org-id-paste-tracker (txt &optional buffer-or-file)
+;;; TODO: make this function work on a region, rather than a span of
+;;; text?  Then we could use org-id-get and the parser.  But that
+;;; might make yanking more expensive.
+(defun org-id--yank-tracker (txt &optional buffer-or-file)
   "Update any IDs in TXT and assign BUFFER-OR-FILE to them."
   (when org-id-track-globally
     (save-match-data
@@ -598,64 +513,57 @@ When CHECK is given, prepare detailed information about duplicate IDs."
 	      (s 0))
 	  (while (string-match "^[ \t]*:ID:[ \t]+\\([^ \t\n\r]+\\)" txt s)
 	    (setq s (match-end 0))
-	    (org-id-add-location (match-string 1 txt) fname)))))))
+	    (org-id--add-location (match-string 1 txt) fname)))))))
 
 ;; Finding entries with specified id
 
 ;;;###autoload
-(defun org-id-find-id-file (id)
-  "Query the id database for the file in which this ID is located."
+(defun org-id-find-file-for (id)
+  "Query the id database for the file in which ID is located."
   (unless org-id-locations (org-id-locations-load))
-  (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)))))
+  (and org-id-locations
+       (hash-table-p org-id-locations)
+       (gethash id org-id-locations)))
+(define-obsolete-function-alias 'org-id-find-id-file 'org-id-find-file-for "Org 9.0")
 
 (defun org-id-find-id-in-file (id file &optional markerp)
   "Return the position of the entry ID in FILE.
-If that files does not exist, or if it does not contain this ID,
-return nil.
-The position is returned as a cons cell (file-name . position).  With
-optional argument MARKERP, return the position as a new marker."
-  (let (org-agenda-new-buffers buf pos)
-    (cond
-     ((not file) nil)
-     ((not (file-exists-p file)) nil)
-     (t (with-current-buffer (setq buf (org-get-agenda-file-buffer file))
-	  (setq pos (org-find-entry-with-id id))
-	  (when pos
-	    (if markerp
-		(move-marker (make-marker) pos buf)
-	      (cons file pos))))))))
+
+If that file does not exist, or if it does not contain this ID,
+return nil.  With optional argument MARKERP, return the position
+as a new marker."
+  ;; TODO: release agenda buffers
+  (when (file-exists-p file)
+    (with-current-buffer (org-get-agenda-file-buffer file)
+      (let ((pos (org-find-entry-with-id id)))
+	(when pos
+	  (if markerp
+	      (move-marker (make-marker) pos (current-buffer))
+	    pos))))))
 
 ;; id link type
 
 ;; Calling the following function is hard-coded into `org-store-link',
-;; so we do have to add it to `org-store-link-functions'.
+;; so we do not 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)
   (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))))
+    (let* ((link (concat "id:" (org-id-get 'create)))
+	   (desc (org-element-property :title
+				       (org-element-lineage
+					(org-element-at-point)
+					'(headline)
+					'with-self))))
       (org-store-link-props :link link :description desc :type "id")
       link)))
 
 (defun org-id-open (id)
   "Go to the entry with id ID."
   (org-mark-ring-push)
-  (let ((m (org-id-find id 'marker))
+  (let ((m (org-id-find id))
 	cmd)
     (unless m
       (error "Cannot find entry with ID \"%s\"" id))
diff --git a/lisp/org-mobile.el b/lisp/org-mobile.el
index 3b2bbf1..daa45bf 100644
--- a/lisp/org-mobile.el
+++ b/lisp/org-mobile.el
@@ -645,8 +645,8 @@ The table of checksums is written to the file mobile-checksums."
 	    (when (setq id
 			(if (bound-and-true-p
 			     org-mobile-force-id-on-agenda-items)
-			    (org-id-get m 'create)
-			  (or (org-entry-get m "ID")
+			    (org-with-point-at m (org-id-get 'create))
+			  (or (org-with-point-at m (org-id-get))
 			      (org-mobile-get-outline-path-link m))))
 	      (insert "   :PROPERTIES:\n   :ORIGINAL_ID: " id
 		      "\n   :END:\n")))))
@@ -955,7 +955,7 @@ is currently a noop.")
 
 (defun org-mobile-locate-entry (link)
   (if (string-match "\\`id:\\(.*\\)$" link)
-      (org-id-find (match-string 1 link) 'marker)
+      (buffer-file-name (marker-buffer (org-id-find (match-string 1 link))))
     (if (not (string-match "\\`olp:\\(.*?\\):\\(.*\\)$" link))
 					; not found with path, but maybe it is to be inserted
 					; in top level of the file?
diff --git a/lisp/org-table.el b/lisp/org-table.el
index 3e2e310..d80bb7f 100644
--- a/lisp/org-table.el
+++ b/lisp/org-table.el
@@ -5402,7 +5402,7 @@ list of the fields in the rectangle."
 		    (regexp-quote name-or-id) "[ \t]*$")
 	    nil t)
 	   (setq buffer (current-buffer) loc (match-beginning 0))
-	 (setq id-loc (org-id-find name-or-id 'marker))
+	 (setq id-loc (org-id-find name-or-id))
 	 (unless (and id-loc (markerp id-loc))
 	   (user-error "Can't find remote table \"%s\"" name-or-id))
 	 (setq buffer (marker-buffer id-loc)
diff --git a/lisp/org.el b/lisp/org.el
index bec8a99..56cc111 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -145,8 +145,7 @@ Stars are put in group 1 and the trimmed body in group 2.")
 (declare-function org-element-swap-A-B "org-element" (elem-a elem-b))
 (declare-function org-element-type "org-element" (element))
 (declare-function org-element-update-syntax "org-element" ())
-(declare-function org-id-find-id-file "org-id" (id))
-(declare-function org-id-get-create "org-id" (&optional force))
+(declare-function org-id-find-file-for "org-id" (id))
 (declare-function org-inlinetask-at-task-p "org-inlinetask" ())
 (declare-function org-inlinetask-outline-regexp "org-inlinetask" ())
 (declare-function org-inlinetask-toggle-visibility "org-inlinetask" ())
@@ -8805,7 +8804,7 @@ When REMOVE is non-nil, remove the subtree from the clipboard."
      ;; Paste
      (beginning-of-line (if (bolp) 1 2))
      (setq beg (point))
-     (and (fboundp 'org-id-paste-tracker) (org-id-paste-tracker txt))
+     (and (fboundp 'org-id--yank-tracker) (org-id--yank-tracker txt))
      (insert-before-markers txt)
      (unless (string-match "\n\\'" txt) (insert "\n"))
      (setq newend (point))
@@ -9000,7 +8999,7 @@ with the original repeater."
 	       (org-show-subtree)
 	       (and idprop (if org-clone-delete-id
 			       (org-entry-delete nil "ID")
-			     (org-id-get-create t)))
+			     (org-id-get 'create 'reset)))
 	       (unless (= n 0)
 		 (while (re-search-forward org-clock-re nil t)
 		   (kill-whole-line))
@@ -10364,7 +10363,7 @@ prepend or to append."
 			(let ((ll (car l)))
 			  (when (and (string-match "^id:\\(.+\\)$" ll)
 				     (equal f (expand-file-name
-					       (or (org-id-find-id-file
+					       (or (org-id-find-file-for
 						    (match-string 1 ll)) ""))))
 			    ll)))
 		      org-stored-links)))
@@ -16753,6 +16752,8 @@ When the target headline is found, return a marker to this location."
         (when (and (not m) (not visiting)) (kill-buffer buffer))
         (and m (throw 'found m))))))
 
+;;; TODO: Candidate for removal, as it is only called in one place,
+;;; and nearly duplicates functionality of of org-id
 (defun org-find-entry-with-id (ident)
   "Locate the entry that contains the ID property with exact value IDENT.
 IDENT can be a string, a symbol or a number, this function will search for
diff --git a/lisp/ox-html.el b/lisp/ox-html.el
index 309abde..f158882 100644
--- a/lisp/ox-html.el
+++ b/lisp/ox-html.el
@@ -39,7 +39,6 @@
 \f
 ;;; Function Declarations
 
-(declare-function org-id-find-id-file "org-id" (id))
 (declare-function htmlize-region "ext:htmlize" (beg end))
 (declare-function mm-url-decode-entities "mm-url" ())
 
diff --git a/lisp/ox-icalendar.el b/lisp/ox-icalendar.el
index ec07879..bafbcd3 100644
--- a/lisp/ox-icalendar.el
+++ b/lisp/ox-icalendar.el
@@ -293,7 +293,7 @@ a message if the file was modified."
      (lambda ()
        (let ((entry (org-element-at-point)))
 	 (unless (org-element-property :ID entry)
-	   (org-id-get-create)
+	   (org-id-get 'create)
 	   (setq modified-flag t)
 	   (forward-line))))
      nil nil 'comment)
diff --git a/lisp/ox.el b/lisp/ox.el
index aeb5d49..adf633c 100644
--- a/lisp/ox.el
+++ b/lisp/ox.el
@@ -1697,7 +1697,7 @@ Return updated plist."
 	   (lambda (l)
 	     (and (string= (org-element-property :type l) "id")
 		  (let* ((id (org-element-property :path l))
-			 (file (car (org-id-find id))))
+			 (file (org-id-find-file-for id)))
 		    (and file (cons id (file-relative-name file))))))))))
 
 (defun org-export--get-min-level (data options)
diff --git a/testing/org-test.el b/testing/org-test.el
index 844178e..3833d42 100644
--- a/testing/org-test.el
+++ b/testing/org-test.el
@@ -122,9 +122,8 @@ currently executed.")
 (defmacro org-test-at-id (id &rest body)
   "Run body after placing the point in the headline identified by ID."
   (declare (indent 1))
-  `(let* ((id-location (org-id-find ,id))
-	  (id-file (car id-location))
-	  (visited-p (get-file-buffer id-file))
+  `(let* ((id-file (org-id-find-file-for ,id))
+	  (visited-p (and id-file (get-file-buffer id-file)))
 	  to-be-removed)
      (unwind-protect
 	 (save-window-excursion
-- 
2.9.3


^ permalink raw reply related	[flat|nested] 9+ messages in thread
end of thread, other threads:[~2016-09-22 22:47 UTC | newest]

Thread overview: 9+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2016-09-03  0:24 Feedback on changes to org-id Aaron Ecay
2016-09-03  8:25 ` Nicolas Goaziou
2016-09-21 22:28   ` Aaron Ecay
2016-09-22  2:50     ` Adam Porter
2016-09-22  7:16       ` Rasmus
2016-09-22 14:19         ` Adam Porter
2016-09-22 15:47       ` Aaron Ecay
2016-09-22 17:07         ` Adam Porter
2016-09-22 22:47     ` Nicolas Goaziou

Code repositories for project(s) associated with this external index

	https://git.savannah.gnu.org/cgit/emacs.git
	https://git.savannah.gnu.org/cgit/emacs/org-mode.git

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.