-;;; 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.14
+;; Version: 6.15a
;;
;; This file is part of GNU Emacs.
;;
;; Org has a builtin method that uses a compact encoding of the creation
;; time of the ID, with microsecond accuracy. This virtually
;; guarantees globally unique identifiers, even if several people are
-;; creating ID's 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 exernal method `uuidgen' is supported, if installed
;; on the system.
;;
:tag "Org ID"
:group 'org)
-(defcustom org-id-method 'org
- "The method that should be used to create new ID's.
-An ID will consist of the prefix specified in `org-id-prefix', and a unique
-part created by the method this variable specifies.
+(defcustom org-id-method
+ (condition-case nil
+ (if (string-match "\\`[-0-9a-fA-F]\\{36\\}\\'"
+ (org-trim (shell-command-to-string "uuidgen")))
+ 'uuidgen
+ 'org)
+ (error 'org))
+ "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 methd `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.
Allowed values are:
-org Org's own internal method, using an encoding of the current time,
- and the current domain of the computer. This method will
- honor the variable `org-id-include-domain'.
+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."
:group 'org-id
(const :tag "No prefix")
(string :tag "Prefix")))
-(defcustom org-id-include-domain t
+(defcustom org-id-include-domain nil
"Non-nil means, add the domain name to new IDs.
-This ensures global uniqueness of ID's, and is also suggested by
+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."
+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)
+
+(defcustom org-id-track-globally t
+ "Non-nil means, track IDs trhough 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.
+
+When nil, IDs are not tracked. Links to IDs will still work within
+a buffer, but not if the entry is located in another file.
+IDs 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 IDs in those files.
+Depending on `org-id-use-hash' this can also be a hash table mapping IDs
+to files.")
+
+(defvar org-id-files nil
+ "List of files that contain IDs.")
(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 IDs, besides the agenda files.
+When Org reparses files to remake the list of files and IDs 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
(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
(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))
;; Storing ID locations (files)
-(defun org-id-update-id-locations ()
- "Scan relevant files for ID's.
-Store the relation between files and corresponding ID's."
+(defun org-id-update-id-locations (&optional files)
+ "Scan relevant files for IDs.
+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 iinformation about duplicate IDs."
(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 IDs.")
+ (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 IDs
+ 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\", also in file %s"
+ id (car (delq
+ nil
+ (mapcar
+ (lambda (x)
+ (if (member id (cdr x)) (car x)))
+ reg))))
+ (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)))
(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))
+ (setcdr x (cons 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 IDs 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.
(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)
+ (let ((m (org-id-find id 'marker)))
+ (unless m
+ (error "Cannot find entry with ID \"%s\"" id))
+ (if (not (equal (current-buffer) (marker-buffer m)))
+ (switch-to-buffer-other-window (marker-buffer m)))
+ (goto-char m)
+ (move-marker m nil)
+ (org-show-context)))
+
+(org-add-link-type "id" 'org-id-open)
+
(provide 'org-id)
;;; org-id.el ends here
;; arch-tag: e5abaca4-e16f-4b25-832a-540cfb63a712
+
+
HCoop / bpt / emacs.git / blobdiff