Mercurial > emacs
annotate lisp/org/org-id.el @ 97774:cf6404e22e31
*** empty log message ***
author | Eli Zaretskii <eliz@gnu.org> |
---|---|
date | Wed, 27 Aug 2008 20:21:31 +0000 |
parents | adc2dffbdfc3 |
children | e1cc41b9282d |
rev | line source |
---|---|
96045 | 1 ;;; org-id.el --- Global identifier for Org-mode entries |
2 ;; Copyright (C) 2008 Free Software Foundation, Inc. | |
3 ;; | |
4 ;; Author: Carsten Dominik <carsten at orgmode dot org> | |
5 ;; Keywords: outlines, hypermedia, calendar, wp | |
6 ;; Homepage: http://orgmode.org | |
97027
adc2dffbdfc3
2008-07-25 Carsten Dominik <dominik@science.uva.nl>
Carsten Dominik <dominik@science.uva.nl>
parents:
96975
diff
changeset
|
7 ;; Version: 6.06b |
96045 | 8 ;; |
9 ;; This file is part of GNU Emacs. | |
10 ;; | |
11 ;; GNU Emacs is free software: you can redistribute it and/or modify | |
12 ;; it under the terms of the GNU General Public License as published by | |
13 ;; the Free Software Foundation, either version 3 of the License, or | |
14 ;; (at your option) any later version. | |
15 | |
16 ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 ;; GNU General Public License for more details. | |
20 | |
21 ;; You should have received a copy of the GNU General Public License | |
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | |
23 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
24 ;; | |
25 ;;; Commentary: | |
26 | |
27 ;; This file implements globally unique identifiers for Org-mode entries. | |
28 ;; Identifiers are stored in the entry as an :ID: property. Functions | |
29 ;; are provided that create and retrieve such identifiers, and that find | |
30 ;; entries based on the identifier. | |
31 | |
32 ;; Identifiers consist of a prefix (default "Org") and a compact encoding | |
33 ;; of the creation time of the ID, with microsecond accuracy. This virtually | |
34 ;; guarantees globally unique identifiers, even if several people are | |
35 ;; creating ID's at the same time in files that will eventually be used | |
36 ;; together. Even higher security can be achieved by using different | |
37 ;; prefix values for each collaborator or file. | |
38 ;; | |
39 ;; This file defines the following API: | |
40 ;; | |
41 ;; org-id-get-create | |
42 ;; Create an ID for the entry at point if it does not yet have one. | |
43 ;; Returns the ID (old or new). This function can be used | |
44 ;; interactively, with prefix argument the creation of a new ID is | |
45 ;; forced, even if there was an old one. | |
46 ;; | |
47 ;; org-id-get | |
48 ;; Get the ID property of an entry. Using appropriate arguments | |
49 ;; to the function, it can also create the ID for this entry. | |
50 ;; | |
51 ;; org-id-goto | |
52 ;; Command to go to a specific ID, this command can be used | |
53 ;; interactively. | |
54 ;; | |
55 ;; org-id-get-with-outline-path-completion | |
56 ;; Retrieve the ID of an entry, using outline path completion. | |
57 ;; This function can work for multiple files. | |
58 ;; | |
59 ;; org-id-get-with-outline-drilling | |
60 ;; Retrieve the ID of an entry, using outline path completion. | |
61 ;; This function only works for the current file. | |
62 ;; | |
63 ;; org-id-find | |
64 ;; Find the location of an entry with specific id. | |
65 ;; | |
66 | |
67 (require 'org) | |
68 | |
69 (declare-function message-make-fqdn "message" ()) | |
70 | |
71 ;;; Customization | |
72 | |
73 (defgroup org-id nil | |
74 "Options concerning global entry identifiers in Org-mode." | |
75 :tag "Org ID" | |
76 :group 'org) | |
77 | |
78 (defcustom org-id-prefix "Org" | |
79 "The prefix for IDs. | |
80 | |
81 This may be a string, or it can be nil to indicate that no prefix is required. | |
82 When a string, the string should have no space characters as IDs are expected | |
83 to have no space characters in them." | |
84 :group 'org-id | |
85 :type '(choice | |
86 (const :tag "No prefix") | |
87 (string :tag "Prefix"))) | |
88 | |
89 (defcustom org-id-include-domain t | |
90 "Non-nil means, add the domain name to new IDs. | |
91 This ensures global uniqueness of ID's, and is also suggested by | |
92 RFC 2445 in combination with RFC 822." | |
93 :group 'org-id | |
94 :type 'boolean) | |
95 | |
96 (defcustom org-id-locations-file "~/.org-id-locations" | |
97 "The file for remembering the last ID number generated." | |
98 :group 'org-id | |
99 :type 'file) | |
100 | |
101 (defvar org-id-locations nil | |
102 "List of files with ID's in those files.") | |
103 | |
104 (defcustom org-id-extra-files 'org-agenda-text-search-extra-files | |
105 "Files to be searched for ID's, besides the agenda files." | |
106 :group 'org-id | |
107 :type | |
108 '(choice | |
109 (symbol :tag "Variable") | |
110 (repeat :tag "List of files" | |
111 (file)))) | |
112 | |
113 ;;; The API functions | |
114 | |
115 ;;;###autoload | |
116 (defun org-id-get-create (&optional force) | |
117 "Create an ID for the current entry and return it. | |
118 If the entry already has an ID, just return it. | |
119 With optional argument FORCE, force the creation of a new ID." | |
120 (interactive "P") | |
121 (when force | |
122 (org-entry-put (point) "ID" nil)) | |
123 (org-id-get (point) 'create)) | |
124 | |
125 ;;;###autoload | |
126 (defun org-id-copy () | |
127 "Copy the ID of the entry at point to the kill ring. | |
128 Create an ID if necessary." | |
129 (interactive) | |
130 (kill-new (org-id-get nil 'create))) | |
131 | |
132 ;;;###autoload | |
133 (defun org-id-get (&optional pom create prefix) | |
134 "Get the ID property of the entry at point-or-marker POM. | |
135 If POM is nil, refer to the entry at point. | |
136 If the entry does not have an ID, the function returns nil. | |
137 However, when CREATE is non nil, create an ID if none is present already. | |
138 PREFIX will be passed through to `org-id-new'. | |
139 In any case, the ID of the entry is returned." | |
140 (let ((id (org-entry-get pom "ID"))) | |
141 (cond | |
142 ((and id (stringp id) (string-match "\\S-" id)) | |
143 id) | |
144 (create | |
145 (setq id (org-id-new prefix)) | |
146 (org-entry-put pom "ID" id) | |
147 (org-id-add-location id (buffer-file-name (buffer-base-buffer))) | |
148 id) | |
149 (t nil)))) | |
150 | |
151 ;;;###autoload | |
152 (defun org-id-get-with-outline-path-completion (&optional targets) | |
153 "Use outline-path-completion to retrieve the ID of an entry. | |
154 TARGETS may be a setting for `org-refile-targets' to define the eligible | |
155 headlines. When omitted, all headlines in all agenda files are | |
156 eligible. | |
157 It returns the ID of the entry. If necessary, the ID is created." | |
158 (let* ((org-refile-targets (or targets '((nil . (:maxlevel . 10))))) | |
159 (org-refile-use-outline-path | |
160 (if (caar org-refile-targets) 'file t)) | |
161 (spos (org-refile-get-location "Entry: ")) | |
162 (pom (and spos (move-marker (make-marker) (nth 3 spos) | |
163 (get-file-buffer (nth 1 spos)))))) | |
164 (prog1 (org-id-get pom 'create) | |
165 (move-marker pom nil)))) | |
166 | |
167 ;;;###autoload | |
168 (defun org-id-get-with-outline-drilling (&optional targets) | |
169 "Use an outline-cycling interface to retrieve the ID of an entry. | |
170 This only finds entries in the current buffer, using `org-get-location'. | |
171 It returns the ID of the entry. If necessary, the ID is created." | |
172 (let* ((spos (org-get-location (current-buffer) org-goto-help)) | |
173 (pom (and spos (move-marker (make-marker) (car spos))))) | |
174 (prog1 (org-id-get pom 'create) | |
175 (move-marker pom nil)))) | |
176 | |
177 ;;;###autoload | |
178 (defun org-id-goto (id) | |
179 "Switch to the buffer containing the entry with id ID. | |
180 Move the cursor to that entry in that buffer." | |
181 (interactive) | |
182 (let ((m (org-id-find id 'marker))) | |
183 (unless m | |
184 (error "Cannot find entry with ID \"%s\"" id)) | |
185 (switch-to-buffer (marker-buffer m)) | |
186 (goto-char m) | |
187 (move-marker m nil) | |
188 (org-show-context))) | |
189 | |
190 ;;;###autoload | |
191 (defun org-id-find (id &optional markerp) | |
192 "Return the location of the entry with the id ID. | |
193 The return value is a cons cell (file-name . position), or nil | |
194 if there is no entry with that ID. | |
195 With optional argument MARKERP, return the position as a new marker." | |
196 (let ((file (org-id-find-id-file id)) | |
197 org-agenda-new-buffers where) | |
198 (when file | |
199 (setq where (org-id-find-id-in-file id file markerp))) | |
200 (unless where | |
201 (org-id-update-id-locations) | |
202 (setq file (org-id-find-id-file id)) | |
203 (when file | |
204 (setq where (org-id-find-id-in-file id file markerp)))) | |
205 where)) | |
206 | |
207 ;;; Internal functions | |
208 | |
209 ;; Creating new IDs | |
210 | |
211 (defun org-id-new (&optional prefix) | |
212 "Create a new globally unique ID. | |
213 | |
214 An ID consists of two parts separated by a colon: | |
215 - a prefix | |
216 - an encoding of the current time to micro-second accuracy | |
217 | |
218 PREFIX can specify the prefix, the default is given by the variable | |
219 `org-id-prefix'. However, if PREFIX is the symbol `none', don't use any | |
220 prefix even if `org-id-prefix' specifies one. | |
221 | |
222 So a typical ID could look like \"Org:4nd91V40HI\"." | |
223 (let* ((prefix (if (eq prefix 'none) | |
224 nil | |
225 (or prefix org-id-prefix))) | |
226 (etime (org-id-time-to-b62)) | |
227 (postfix (if org-id-include-domain | |
228 (progn | |
229 (require 'message) | |
230 (concat "@" (message-make-fqdn)))))) | |
231 (if prefix | |
232 (concat prefix ":" etime postfix) | |
233 (concat etime postfix)))) | |
234 | |
235 (defun org-id-int-to-b62-one-digit (i) | |
236 "Turn an integer between 0 and 61 into a single character 0..9, A..Z, a..z." | |
237 (cond | |
238 ((< i 10) (+ ?0 i)) | |
239 ((< i 36) (+ ?A i -10)) | |
240 ((< i 62) (+ ?a i -36)) | |
241 (t (error "Larger that 61")))) | |
242 | |
243 (defun org-id-b62-to-int-one-digit (i) | |
244 "Turn a character 0..9, A..Z, a..z into a number 0..61. | |
245 The input I may be a character, or a single-letter string." | |
246 (and (stringp i) (setq i (string-to-char i))) | |
247 (cond | |
248 ((and (>= i ?0) (<= i ?9)) (- i ?0)) | |
249 ((and (>= i ?A) (<= i ?Z)) (+ (- i ?A) 10)) | |
250 ((and (>= i ?a) (<= i ?z)) (+ (- i ?a) 36)) | |
251 (t (error "Invalid b62 letter")))) | |
252 | |
253 (defun org-id-int-to-b62 (i &optional length) | |
254 "Convert an integer to a base-62 number represented as a string." | |
255 (let ((s "")) | |
256 (while (> i 0) | |
257 (setq s (concat (char-to-string | |
258 (org-id-int-to-b62-one-digit (mod i 62))) s) | |
259 i (/ i 62))) | |
260 (setq length (max 1 (or length 1))) | |
261 (if (< (length s) length) | |
262 (setq s (concat (make-string (- length (length s)) ?0) s))) | |
263 s)) | |
264 | |
265 (defun org-id-b62-to-int (s) | |
266 "Convert a base-62 string into the corresponding integer." | |
267 (let ((r 0)) | |
268 (mapc (lambda (i) (setq r (+ (* r 62) (org-id-b62-to-int-one-digit i)))) | |
269 s) | |
270 r)) | |
271 | |
272 (defun org-id-time-to-b62 (&optional time) | |
273 "Encode TIME as a 10-digit string. | |
274 This string holds the time to micro-second accuracy, and can be decoded | |
275 using `org-id-decode'." | |
276 (setq time (or time (current-time))) | |
277 (concat (org-id-int-to-b62 (nth 0 time) 3) | |
278 (org-id-int-to-b62 (nth 1 time) 3) | |
279 (org-id-int-to-b62 (or (nth 2 time) 0) 4))) | |
280 | |
281 (defun org-id-decode (id) | |
282 "Split ID into the prefix and the time value that was used to create it. | |
283 The return value is (prefix . time) where PREFIX is nil or a string, | |
284 and time is the usual three-integer representation of time." | |
285 (let (prefix time parts) | |
286 (setq parts (org-split-string id ":")) | |
287 (if (= 2 (length parts)) | |
288 (setq prefix (car parts) time (nth 1 parts)) | |
289 (setq prefix nil time (nth 0 parts))) | |
290 (setq time (list (org-id-b62-to-int (substring time 0 3)) | |
291 (org-id-b62-to-int (substring time 3 6)) | |
292 (org-id-b62-to-int (substring time 6 10)))) | |
293 (cons prefix time))) | |
294 | |
295 ;; Storing ID locations (files) | |
296 | |
297 (defun org-id-update-id-locations () | |
298 "Scan relevant files for ID's. | |
299 Store the relation between files and corresponding ID's." | |
300 (interactive) | |
301 (let ((files (append (org-agenda-files) | |
302 (if (symbolp org-id-extra-files) | |
303 (symbol-value org-id-extra-files) | |
304 org-id-extra-files))) | |
305 org-agenda-new-buffers | |
306 file ids reg found id) | |
307 (while (setq file (pop files)) | |
308 (setq ids nil) | |
309 (with-current-buffer (org-get-agenda-file-buffer file) | |
310 (save-excursion | |
311 (save-restriction | |
312 (widen) | |
313 (goto-char (point-min)) | |
314 (while (re-search-forward "^[ \t]*:ID:[ \t]+\\(\\S-+\\)[ \t]*$" | |
315 nil t) | |
316 (setq id (org-match-string-no-properties 1)) | |
317 (if (member id found) | |
318 (error "Duplicate ID \"%s\"" id)) | |
319 (push id found) | |
320 (push id ids)) | |
321 (push (cons file ids) reg))))) | |
322 (org-release-buffers org-agenda-new-buffers) | |
323 (setq org-agenda-new-buffers nil) | |
324 (setq org-id-locations reg) | |
325 (org-id-locations-save))) | |
326 | |
327 (defun org-id-locations-save () | |
328 "Save `org-id-locations' in `org-id-locations-file'." | |
329 (with-temp-file org-id-locations-file | |
330 (print org-id-locations (current-buffer)))) | |
331 | |
332 (defun org-id-locations-load () | |
333 "Read the data from `org-id-locations-file'." | |
334 (setq org-id-locations nil) | |
335 (with-temp-buffer | |
336 (condition-case nil | |
337 (progn | |
338 (insert-file-contents-literally org-id-locations-file) | |
339 (goto-char (point-min)) | |
340 (setq org-id-locations (read (current-buffer)))) | |
341 (error | |
342 (message "Could not read org-id-values from %s. Setting it to nil." | |
343 org-id-locations-file))))) | |
344 | |
345 (defun org-id-add-location (id file) | |
346 "Add the ID with location FILE to the database of ID loations." | |
347 (unless org-id-locations (org-id-locations-load)) | |
348 (catch 'exit | |
349 (let ((locs org-id-locations) list) | |
350 (while (setq list (pop locs)) | |
351 (when (equal (file-truename file) (file-truename (car list))) | |
352 (setcdr list (cons id (cdr list))) | |
353 (throw 'exit t)))) | |
354 (push (list file id) org-id-locations)) | |
355 (org-id-locations-save)) | |
356 | |
357 ;; Finding entries with specified id | |
358 | |
359 (defun org-id-find-id-file (id) | |
360 "Query the id database for the file in which this ID is located." | |
361 (unless org-id-locations (org-id-locations-load)) | |
362 (catch 'found | |
363 (mapc (lambda (x) (if (member id (cdr x)) | |
364 (throw 'found (car x)))) | |
365 org-id-locations) | |
366 nil)) | |
367 | |
368 (defun org-id-find-id-in-file (id file &optional markerp) | |
369 "Return the position of the entry ID in FILE. | |
370 If that files does not exist, or if it does not contain this ID, | |
371 return nil. | |
372 The position is returned as a cons cell (file-name . position). With | |
373 optional argument MARKERP, return the position as a new marker." | |
374 (let (org-agenda-new-buffers m buf pos) | |
375 (cond | |
376 ((not file) nil) | |
377 ((not (file-exists-p file)) nil) | |
378 (t (with-current-buffer (setq buf (org-get-agenda-file-buffer file)) | |
379 (setq pos (org-find-entry-with-id id)) | |
380 (when pos | |
381 (if markerp | |
382 (move-marker (make-marker) pos buf) | |
383 (cons file pos)))))))) | |
384 | |
385 (provide 'org-id) | |
386 | |
387 ;;; org-id.el ends here | |
388 | |
96052 | 389 ;; arch-tag: e5abaca4-e16f-4b25-832a-540cfb63a712 |