diff lisp/org/org-id.el @ 100267:c851df8e004e

2008-12-07 Carsten Dominik <[e-mail]> * org-id.el (org-id-locations-file): Wrap file name with `convert-standard-filename'. (org-id-files): New variable. (org-id-use-hash): New option. (org-id-update-id-locations): Also search in all files current listed in `org-id-files'. Convert the resulting alist to a hash if the user customation says so. (org-id-locations-save): Handle he case if `org-id-locations' is a hash. (org-id-locations-load): Convert the alist to a hash. (org-id-add-location): Handle the hast case. (kill-emacs-hook): Make sure id locations are saved when Emacs is exited. (org-id-hash-to-alist, org-id-alist-to-hash) (org-id-paste-tracker): New functions. 2008-12-07 Carsten Dominik <[e-mail]> * org-agenda.el (org-agenda-goto-calendar): Remove duplicate let bindings of calendar variables. * org-table.el (org-table-find-row-type): Renamed from `org-find-row-type'. (org-table-rewrite-old-row-references): Renamed from `org-rewrite-old-row-references'. (org-table-shift-refpart): Renamed from `org-shift-refpart'. (org-table-cleanup-narrow-column-properties): Renamed from `org-cleanup-narrow-column-properties'. 2008-12-07 Carsten Dominik <[e-mail]> * org-table.el (org-find-row-type): New arguments DESC and CLINE, for better error messages. (org-table-get-descriptor-line): Supply the new arguments to `org-find-row-type'. (org-table-error-on-row-ref-crossing-hline): New option. * org.el (org-target-link-regexp): Make buffer-local. (org-move-subtree-down): Fix bug with trees at beginning of buffer. 2008-12-07 Carsten Dominik <[e-mail]> * org-faces.el (org-set-tag-faces): New function. (org-tags-special-faces-re): New variable. * org.el (org-font-lock-add-tag-faces, org-get-tag-face): New functions. * org-faces.el (org-tag-faces): New option. (org-tag): Mention `org-tag-faces' in the docstring. 2008-12-07 Carsten Dominik <[e-mail]> * org-exp.el (org-export-html-style-default): Implement new quoting. * org-jsinfo.el (org-infojs-template): Implement new quoting. * org-w3m.el (w3m-minor-mode-hook): Also add the special copy command to the `w3m-minor-mode-map'. * org-archive.el (org-archive-to-archive-sibling): Protect `this-command' to avoid appending kills during archiving. * org-exp.el (org-export-with-priority): New variable. (org-export-add-options-to-plist): Use `org-export-plist-vars' instead of internal list of strings and properties. (org-print-icalendar-entries): Retrieve the location property with inheritance. 2008-12-07 Carsten Dominik <[e-mail]> * org-exp.el (org-export-with-todo-keywords): New option. (org-export-plist-vars): Include also the keys for the #+OPTIONS line. (org-default-export-plist, org-export-add-options-to-plist) (org-export-as-ascii, org-export-as-html): Use the new structure of `org-export-plist-vars'. * org.el (org-map-entries): Return all values. 2008-12-07 Carsten Dominik <[e-mail]> * org.el (org-matcher-time): Recognize more special values. * org-gnus.el (fboundp): Fix defvaralias for XEmacs. 2008-12-07 Carsten Dominik <[e-mail]> * org.el (org-tags-exclude-from-inheritance): New option. (org-tag-inherit-p, org-remove-uniherited-tags): Respect `org-tags-exclude-from-inheritance'. * org-agenda.el (org-agenda-show-inherited-tags): New option. (org-format-agenda-item): Add inherited tags to the agenda line string, and make sure that properties are kept when downcasing the tags list. (org-agenda-add-inherited-tags): New function. (org-downcase-keep-props): New function. * org.el (org-scan-tags): Mark inherited tags with a text property. (org-get-tags-at): Mark inherited tags with a text property. (org-add-prop-inherited): New function. * org-agenda.el (org-agenda-add-inherited-tags): New function. (org-agenda-show-inherited-tags): New option. 2008-12-07 Carsten Dominik <[e-mail]> * org.el (org-modules): Add org-w3m to the default modules. * org-table.el (orgtbl-self-insert-command): Make S-SPC work in orgtbl-mode. (orgtabl-create-or-convert-from-region): New command. * org-exp.el (org-export-as-ascii): Remove the handling of targets. (org-export-ascii-preprocess): Handle targets already in this function. 2008-12-07 Carsten Dominik <[e-mail]> * org-timer.el (org-timer-start-time): Define this variable. (org-timer-item): Make argument optional. * org-list.el (org-insert-item): Automatically insert a timer item if the current list is a timer list. * org-timer.el: New file. * org-publish.el (org-publish-org-index): Only exclude the index file in the main directory from being added to the site-map. (org-publish-get-project-from-filename): If the current project is a component, start publishing from the parent project. 2008-12-07 Carsten Dominik <[e-mail]> * org-table.el (orgtbl-ret): Fix RET at beginning-of-buffer. * org-publish.el (org-publish-org-index): Improve removal of temporary buffers.

--- a/lisp/org/org-id.el	Sun Dec 07 18:34:56 2008 +0000
+++ b/lisp/org/org-id.el	Sun Dec 07 18:36:02 2008 +0000
@@ -1,10 +1,10 @@
-;;; org-id.el --- Global identifier for Org-mode entries
+;;; org-id.el --- Global identifiers for Org-mode entries
 ;; Copyright (C) 2008 Free Software Foundation, Inc.
 ;;
 ;; Author: Carsten Dominik <carsten at orgmode dot org>
 ;; Keywords: outlines, hypermedia, calendar, wp
 ;; Homepage: http://orgmode.org
-;; Version: 6.13a
+;; Version: 6.14
 ;;
 ;; This file is part of GNU Emacs.
 ;;
@@ -116,17 +116,42 @@
   :group 'org-id
   :type 'boolean)
 
+(defcustom org-id-track-globally t
+  "Non-nil means, track ID's trhough files, so that links work globally.
+This work by maintaining a hash table for ID's and writing this table
+to disk when exiting Emacs.  Because of this, it works best if you use
+a single Emacs process, not many.
+
+When nil, ID's are not tracked.  Links to ID's will still work within
+a buffer, but not if the entry is located in another file.
+ID's can still be used if the entry with the id is in the same file as
+the link."
+  :group 'org-id
+  :type 'boolean)
+
 (defcustom org-id-locations-file (convert-standard-filename
-				  "~/.org-id-locations")
-  "The file for remembering the last ID number generated."
+				  "~/.emacs.d/.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 ID's in those files.")
+  "List of files with ID's in those files.
+Depending on `org-id-use-hash' this can also be a hash table mapping ID's
+to files.")
+
+(defvar org-id-files nil
+  "List of files that contain ID's.")
 
 (defcustom org-id-extra-files 'org-agenda-text-search-extra-files
-  "Files to be searched for ID's, besides the agenda files."
+  "Files to be searched for ID's, besides the agenda files.
+When Org reparses files to remake the list of files and ID's it is tracking,
+it will normally scan the agenda files, the archives related to agenda files,
+any files that are listed as ID containing in the current register, and
+any Org-mode files currently visited by Emacs.
+You can list additional files here.
+This variable is only relevant when `org-id-track-globally' is set."
   :group 'org-id
   :type
   '(choice
@@ -134,6 +159,14 @@
     (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.
+This is a possibility to reduce overhead, but it measn 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."
+  :group 'org-id
+  :type 'boolean)
+
 ;;; The API functions
 
 ;;;###autoload
@@ -145,13 +178,13 @@
   (when force
     (org-entry-put (point) "ID" nil))
   (org-id-get (point) 'create))
-  
+
 ;;;###autoload
 (defun org-id-copy ()
   "Copy the ID of the entry at point to the kill ring.
 Create an ID if necessary."
   (interactive)
-  (kill-new (org-id-get nil 'create)))  
+  (kill-new (org-id-get nil 'create)))
 
 ;;;###autoload
 (defun org-id-get (&optional pom create prefix)
@@ -180,10 +213,10 @@
 eligible.
 It 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 
+	 (org-refile-use-outline-path
 	  (if (caar org-refile-targets) 'file t))
 	 (spos (org-refile-get-location "Entry: "))
-	 (pom (and spos (move-marker (make-marker) (nth 3 spos) 
+	 (pom (and spos (move-marker (make-marker) (nth 3 spos)
 				     (get-file-buffer (nth 1 spos))))))
     (prog1 (org-id-get pom 'create)
       (move-marker pom nil))))
@@ -202,14 +235,14 @@
 (defun org-id-goto (id)
   "Switch to the buffer containing the entry with id ID.
 Move the cursor to that entry in that buffer."
-  (interactive)
+  (interactive "sID: ")
   (let ((m (org-id-find id 'marker)))
     (unless m
       (error "Cannot find entry with ID \"%s\"" id))
     (switch-to-buffer (marker-buffer m))
     (goto-char m)
     (move-marker m nil)
-    (org-show-context)))    
+    (org-show-context)))
 
 ;;;###autoload
 (defun org-id-find (id &optional markerp)
@@ -326,77 +359,153 @@
 
 ;; Storing ID locations (files)
 
-(defun org-id-update-id-locations ()
+(defun org-id-update-id-locations (&optional files check)
   "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)))
-	org-agenda-new-buffers
-	file ids reg found id)
-    (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)))))
-    (org-release-buffers org-agenda-new-buffers)
-    (setq org-agenda-new-buffers nil)
-    (setq org-id-locations reg)
-    (org-id-locations-save)))
+  (if (not org-id-track-globally)
+      (error "Please turn on `org-id-track-globally' if you want to track id's.")
+    (let ((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-mode buffers
+		(delq nil
+		      (mapcar (lambda (b)
+				(with-current-buffer b
+				  (and (org-mode-p) (buffer-file-name))))
+			      (buffer-list)))
+		;; All files known to have id's
+		org-id-files)))
+	  org-agenda-new-buffers
+	  file nfiles tfile ids reg found id seen (ndup 0))
+      (setq nfiles (length files))
+      (while (setq file (pop files))
+	(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)
+	  (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)
+		      (progn
+			(message "Duplicate ID \"%s\"" id)
+			(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 ID's found, check *Messages* buffer" ndup)
+	(message "%d unique files scanned for ID's" (length org-id-files)))
+      org-id-locations)))
 
 (defun org-id-locations-save ()
   "Save `org-id-locations' in `org-id-locations-file'."
-  (with-temp-file org-id-locations-file
-    (print org-id-locations (current-buffer))))
+  (when org-id-track-globally
+    (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))))))
 
 (defun org-id-locations-load ()
   "Read the data from `org-id-locations-file'."
   (setq org-id-locations nil)
-  (with-temp-buffer
-    (condition-case nil
-        (progn
-          (insert-file-contents-literally org-id-locations-file)
-          (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."
-                org-id-locations-file)))))
+  (when org-id-track-globally
+    (with-temp-buffer
+      (condition-case nil
+	  (progn
+	    (insert-file-contents-literally org-id-locations-file)
+	    (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."
+		  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)
   "Add the ID with location FILE to the database of ID loations."
-  (when (and id file) ; don't error when called from a buffer with no file
+  ;; 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))
-    (catch 'exit
-      (let ((locs org-id-locations) list)
-	(while (setq list (pop locs))
-	  (when (equal (file-truename file) (file-truename (car list)))
-	    (setcdr list (cons id (cdr list)))
-	    (throw 'exit t))))
-      (push (list file id) org-id-locations))
-    (org-id-locations-save)))
+    (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)
+
+(defun org-id-hash-to-alist (hash)
+  "Turn an org-id hash into an alist, so that it can be written to a file."
+  (let (res x)
+    (maphash
+     (lambda (k v)
+       (if (setq x (member v res))
+	   (push k (cdr x))
+	 (push (list v k) res)))
+     hash)
+    res))
+
+(defun org-id-alist-to-hash (list)
+  "Turn an org-id location list into a hash table."
+  (let ((res (make-hash-table
+	      :test 'equal
+	      :size (apply '+ (mapcar 'length list))))
+	f i)
+    (mapc
+     (lambda (x)
+       (setq f (car x))
+       (mapc (lambda (i) (puthash i f res)) (cdr x)))
+     list)
+    res))
+
+(defun org-id-paste-tracker (txt &optional buffer-or-file)
+  "Update any ID's in TXT and assign BUFFER-OR-FILE to them."
+  (when org-id-track-globally
+    (save-match-data
+      (setq buffer-or-file (or buffer-or-file (current-buffer)))
+      (when (bufferp buffer-or-file)
+	(setq buffer-or-file (or (buffer-base-buffer buffer-or-file)
+				 buffer-or-file))
+	(setq buffer-or-file (buffer-file-name buffer-or-file)))
+      (when buffer-or-file
+	(let ((fname (abbreviate-file-name buffer-or-file))
+	      (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)))))))
 
 ;; Finding entries with specified id
 
 (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))
-  (catch 'found
-    (mapc (lambda (x) (if (member id (cdr x))
-			  (throw 'found (car x))))
-	  org-id-locations)
-    nil))
+  (or (gethash id org-id-locations)
+      ;; ball back on current buffer
+      (buffer-file-name (or (buffer-base-buffer (current-buffer))
+			    (current-buffer)))))
 
 (defun org-id-find-id-in-file (id file &optional markerp)
   "Return the position of the entry ID in FILE.
@@ -415,8 +524,35 @@
 		(move-marker (make-marker) pos buf)
 	      (cons file 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'.
+
+(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))
+
+(org-add-link-type "id" 'org-id-open)
+
 (provide 'org-id)
 
 ;;; org-id.el ends here
 
 ;; arch-tag: e5abaca4-e16f-4b25-832a-540cfb63a712
+
+