Implement a new link type "id:" to link to entry ids.

lisp/ChangeLog

@@ -345,6 +345,10 @@
 
 2008-11-14  Carsten Dominik  <carsten.dominik@gmail.com>
 
+	* org-exp.el (org-export-preprocess-string): Reorder so that we
+	can still see ID properties when we collect targets.
+	(org-export-target-internal-links): Also store targets for ID's.
+
 	* org.el (org-link-translation-function): New option.
 	(org-open-at-point): Call `org-link-translation-function' if
 	non-nil.
@@ -361,12 +365,20 @@
 
 2008-11-13  Carsten Dominik  <carsten.dominik@gmail.com>
 
-	* org-exp.el (org-icalendar-cleanup-string): Improve RFC2455
-	compliance as far as quoting is concerned.
+	* org-id.el (org-id-search-archives): New option.
+
+	* org.el (org-link-to-org-use-id): New option.
+	(org-store-link): Use `org-link-to-org-use-id'.
+	(org-id): Make org-id.el a standard component.
+
+2008-11-13  Carsten Dominik  <carsten.dominik@gmail.com>
 
 	* org.el (org-link-expand-abbrev): Implement %h as an escape for a
 	hexified version of the tag.
 
+	* org-exp.el (org-icalendar-cleanup-string): Improve RFC2455
+	compliance as far as quoting is concerned.
+
 	* org-vm.el (org-vm-follow-link): Require `vm-search'.
 
 	* org.el (org-up-heading-safe, org-forward-same-level): Always

lisp/org-exp.el

@@ -1468,6 +1468,9 @@ on this string to produce the exported version."
 
       ;; Handle source code snippets
       (org-export-replace-src-segments)
+      
+      ;; Find all headings and compute the targets for them
+      (setq target-alist (org-export-define-heading-targets target-alist))
 
       ;; Get rid of drawers
       (org-export-remove-or-extract-drawers drawers
@@ -1490,9 +1493,6 @@ on this string to produce the exported version."
       ;; Remove todo-keywords before exporting, if the user has requested so
       (org-export-remove-headline-metadata parameters)
 
-      ;; Find all headings and compute the targets for them
-      (setq target-alist (org-export-define-heading-targets target-alist))
-
       ;; Find targets in comments and move them out of comments,
       ;; but mark them as targets that should be invisible
       (setq target-alist (org-export-handle-invisible-targets target-alist))
@@ -1519,7 +1519,6 @@ on this string to produce the exported version."
       ;; Remove comment environment and comment subtrees
       (org-export-remove-comment-blocks-and-subtrees)
 
-
       ;; Find matches for radio targets and turn them into internal links
       (org-export-mark-radio-links)
 
@@ -1577,18 +1576,22 @@ on this string to produce the exported version."
 The new targets are added to TARGET-ALIST, which is also returned."
   (goto-char (point-min))
   (org-init-section-numbers)
-  (let ((re (concat "^" org-outline-regexp))
+  (let ((re (concat "^" org-outline-regexp
+		    "\\| [ \t]*:ID:[ \t]*\\([^ \t\r\n]+\\)"))
 	level target)
     (while (re-search-forward re nil t)
-      (setq level (org-reduced-level
-		   (save-excursion (goto-char (point-at-bol))
-				   (org-outline-level))))
-      (setq target (org-solidify-link-text
-		    (format "sec-%s" (org-section-number level))))
-      (push (cons target target) target-alist)
-      (add-text-properties
-       (point-at-bol) (point-at-eol)
-       (list 'target target))))
+      (if (match-end 1)
+	  (push (cons (org-match-string-no-properties 1)
+		      target) target-alist)
+	(setq level (org-reduced-level
+		     (save-excursion (goto-char (point-at-bol))
+				     (org-outline-level))))
+	(setq target (org-solidify-link-text
+		      (format "sec-%s" (org-section-number level))))
+	(push (cons target target) target-alist)
+	(add-text-properties
+	 (point-at-bol) (point-at-eol)
+	 (list 'target target)))))
   target-alist)
 
 (defun org-export-handle-invisible-targets (target-alist)
@@ -1617,9 +1620,11 @@ Mark them as invisible targets."
   target-alist)
 
 (defun org-export-target-internal-links (target-alist)
-  "Find all internal links and assign target to them.
+  "Find all internal links and assign targets to them.
 If a link has a fuzzy match (i.e. not a *dedicated* target match),
-let the link  point to the corresponding section."
+let the link  point to the corresponding section.
+This function also handles the id links, if they have a match in
+the current file."
   (goto-char (point-min))
   (while (re-search-forward org-bracket-link-regexp nil t)
     (org-if-unprotected
@@ -1631,6 +1636,8 @@ let the link  point to the corresponding section."
 	    (target
 	     (cond
 	      ((cdr (assoc slink target-alist)))
+	      ((and (string-match "^id:" link)
+		    (cdr (assoc (substring link 3) target-alist))))
 	      ((string-match org-link-types-re link) nil)
 	      ((or (file-name-absolute-p link)
 		   (string-match "^\\." link))

lisp/org-id.el

@@ -134,6 +134,14 @@ be added."
     (repeat :tag "List of files"
 	    (file))))
 
+(defcustom org-id-search-archives t
+  "Non-nil means, search also the archive files of agenda files for entries.
+It is possible that id searches might become too slow if a user has
+used org-mode and ids for many years.  This is why it is possibl to turn this
+off."
+  :group 'org-id
+  :type 'boolean)
+
 ;;; The API functions
 
 ;;;###autoload
@@ -326,31 +334,43 @@ and time is the usual three-integer representation of time."
 
 ;; Storing ID locations (files)
 
-(defun org-id-update-id-locations ()
+(defun org-id-update-id-locations (&optional files)
   "Scan relevant files for ID's.
-Store the relation between files and corresponding ID's."
+Store the relation between files and corresponding ID's.
+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."
   (interactive)
-  (let ((files (append (org-agenda-files)
-		       (if (symbolp org-id-extra-files)
-			   (symbol-value org-id-extra-files)
-			 org-id-extra-files)))
+  (let ((files
+	 (or files
+	     (append (org-agenda-files t org-id-search-archives)
+		     (if (symbolp org-id-extra-files)
+			 (symbol-value org-id-extra-files)
+		       org-id-extra-files)
+		     (mapcar 'car org-id-locations))))
 	org-agenda-new-buffers
-	file ids reg found id)
+	file nfiles tfile ids reg found id seen)
+    (setq nfiles (length files))
     (while (setq file (pop files))
-      (setq ids nil)
-      (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 (org-match-string-no-properties 1))
-	      (if (member id found)
-		  (error "Duplicate ID \"%s\"" id))
-	      (push id found)
-	      (push id ids))
-	    (push (cons file ids) reg)))))
+      (message "Finding ID locations (%d/%d files)"
+	       (- nfiles (length files)) nfiles)
+      (setq tfile (file-truename file))
+      (when (and (file-exists-p file) (not (member tfile seen)))
+	(push tfile seen)
+	(setq ids nil)
+	(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 (org-match-string-no-properties 1))
+		(if (member id found)
+		    (error "Duplicate ID \"%s\"" id))
+		(push id found)
+		(push id ids))
+	      (push (cons file ids) reg))))))
     (org-release-buffers org-agenda-new-buffers)
     (setq org-agenda-new-buffers nil)
     (setq org-id-locations reg)
@@ -415,8 +435,29 @@ optional argument MARKERP, return the position as a new marker."
 		(move-marker (make-marker) pos buf)
 	      (cons file pos))))))))
 
+(org-add-link-type "id" 'org-id-open)
+
+(defun org-id-store-link ()
+  "Store a link to the current entry, using it's 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))
+
+(defun org-id-open (id)
+  "Go to the entry with id ID."
+  (org-mark-ring-push)
+  (switch-to-buffer-other-window (current-buffer))
+  (org-id-goto id))
+
 (provide 'org-id)
 
 ;;; org-id.el ends here
 
 ;; arch-tag: e5abaca4-e16f-4b25-832a-540cfb63a712
+

lisp/org.el

@@ -956,6 +956,36 @@ It should match if the message is from the user him/herself."
   :group 'org-link-store
   :type 'regexp)
 
+(defcustom org-link-to-org-use-id 'create-if-interactive
+  "Non-nil means, storing a link to an Org file will use entry ID's.
+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 remember, only use the ID if it already exists.  The
+      purpose of this setting is to avoid proliferation of unwanted
+      ID's, just because you happen to be in an Org file when you
+      call `org-remember' that automatically and preemptively
+      creates a link.  If you do want to get an ID link in a remember
+      template to an entry not having an ID, create it first by
+      explicitly creating a link to it, using `C-c C-l' first.
+
+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
+  :type '(choice
+	  (const :tag "Create ID to make link" t)
+	  (const :tag "Create if string link interactively"
+		 'create-if-interactive)
+	  (const :tag "Only use existing" 'use-existing)
+	  (const :tag "Do not use ID to create link" nil)))
+
 (defcustom org-context-in-file-links t
   "Non-nil means, file links from `org-store-link' contain context.
 A search string will be added to the file name with :: as separator and
@@ -2806,11 +2836,12 @@ collapsed state."
 
 ;; Autoload ID code
 
+(declare-function org-id-store-link "org-id")
 (org-autoload "org-id"
  '(org-id-get-create org-id-new org-id-copy org-id-get
    org-id-get-with-outline-path-completion
    org-id-get-with-outline-drilling
-   org-id-goto org-id-find))
+   org-id-goto org-id-find org-id-store-link))
 
 ;;; Variables for pre-computed regular expressions, all buffer local
 
@@ -6202,29 +6233,43 @@ For file links, arg negates `org-context-in-file-links'."
 	    link (org-make-link cpltxt)))
 
      ((and buffer-file-name (org-mode-p))
-      ;; Just link to current headline
-      (setq cpltxt (concat "file:"
-			   (abbreviate-file-name buffer-file-name)))
-      ;; Add a context search string
-      (when (org-xor org-context-in-file-links arg)
-	;; Check if we are on a target
-	(if (org-in-regexp "<<\\(.*?\\)>>")
-	    (setq cpltxt (concat cpltxt "::" (match-string 1)))
-	  (setq txt (cond
-		     ((org-on-heading-p) nil)
-		     ((org-region-active-p)
-		      (buffer-substring (region-beginning) (region-end)))
-		     (t nil)))
-	  (when (or (null txt) (string-match "\\S-" txt))
-	    (setq cpltxt
-		  (concat cpltxt "::"
-			  (condition-case nil
-			      (org-make-org-heading-search-string txt)
-			    (error "")))
-		  desc "NONE"))))
-      (if (string-match "::\\'" cpltxt)
-	  (setq cpltxt (substring cpltxt 0 -2)))
-      (setq link (org-make-link cpltxt)))
+      (cond
+       ((or (eq org-link-to-org-use-id t)
+	    (and (eq org-link-to-org-use-id 'create-if-interactive)
+		 (interactive-p))
+	    (and org-link-to-org-use-id
+		 (condition-case nil (org-entry-get nil "ID") (error nil))))
+	;; We can make a link using the ID.
+	(setq link (condition-case nil
+		       (org-id-store-link)
+		     (error
+		      ;; probably before first headling, link to file only
+		      (concat "file:"
+			      (abbreviate-file-name buffer-file-name))))))
+       (t
+	;; Just link to current headline
+	(setq cpltxt (concat "file:"
+			     (abbreviate-file-name buffer-file-name)))
+	;; Add a context search string
+	(when (org-xor org-context-in-file-links arg)
+	  ;; Check if we are on a target
+	  (if (org-in-regexp "<<\\(.*?\\)>>")
+	      (setq cpltxt (concat cpltxt "::" (match-string 1)))
+	    (setq txt (cond
+		       ((org-on-heading-p) nil)
+		       ((org-region-active-p)
+			(buffer-substring (region-beginning) (region-end)))
+		       (t nil)))
+	    (when (or (null txt) (string-match "\\S-" txt))
+	      (setq cpltxt
+		    (concat cpltxt "::"
+			    (condition-case nil
+				(org-make-org-heading-search-string txt)
+			      (error "")))
+		    desc "NONE")))))
+       (if (string-match "::\\'" cpltxt)
+	   (setq cpltxt (substring cpltxt 0 -2)))
+       (setq link (org-make-link cpltxt))))
 
      ((buffer-file-name (buffer-base-buffer))
       ;; Just link to this file here.