1
;;; org-registry.el --- a registry for Org links
3
;; Copyright 2007, 2008 Bastien Guerry
5
;; Emacs Lisp Archive Entry
6
;; Filename: org-registry.el
8
;; Author: Bastien Guerry <bzg AT altern DOT org>
9
;; Maintainer: Bastien Guerry <bzg AT altern DOT org>
10
;; Keywords: org, wp, registry
11
;; Description: Shows Org files where the current buffer is linked
12
;; URL: http://www.cognition.ens.fr/~guerry/u/org-registry.el
14
;; This program is free software; you can redistribute it and/or modify
15
;; it under the terms of the GNU General Public License as published by
16
;; the Free Software Foundation; either version 3, or (at your option)
19
;; This program is distributed in the hope that it will be useful,
20
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22
;; GNU General Public License for more details.
24
;; You should have received a copy of the GNU General Public License
25
;; along with this program; if not, write to the Free Software
26
;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
30
;; This library add a registry to your Org setup.
32
;; Org files are full of links inserted with `org-store-link'. This links
33
;; point to e-mail, webpages, files, dirs, info pages, man pages, etc.
34
;; Actually, they come from potentially *everywhere* since Org lets you
35
;; define your own storing/following functions.
37
;; So, what if you are on a e-mail, webpage or whatever and want to know if
38
;; this buffer has already been linked to somewhere in your agenda files?
40
;; This is were org-registry comes in handy.
42
;; M-x org-registry-show will tell you the name of the file
43
;; C-u M-x org-registry-show will directly jump to the file
45
;; In case there are several files where the link lives in:
47
;; M-x org-registry-show will display them in a new window
48
;; C-u M-x org-registry-show will prompt for a file to visit
50
;; Add this to your Org configuration:
52
;; (require 'org-registry)
53
;; (org-registry-initialize)
55
;; If you want to update the registry with newly inserted links in the
56
;; current buffer: M-x org-registry-update
58
;; If you want this job to be done each time you save an Org buffer,
59
;; hook 'org-registry-update to the local 'after-save-hook in org-mode:
61
;; (org-registry-insinuate)
68
(defgroup org-registry nil
72
(defcustom org-registry-file
73
(concat (getenv "HOME") "/.org-registry.el")
74
"The Org registry file."
78
(defcustom org-registry-find-file 'find-file-other-window
79
"How to find visit files."
83
(defvar org-registry-alist nil
84
"An alist containing the Org registry.")
87
(defun org-registry-show (&optional visit)
88
"Show Org files where there are links pointing to the current
91
(org-registry-initialize)
92
(let* ((blink (or (org-remember-annotation) ""))
93
(link (when (string-match org-bracket-link-regexp blink)
94
(match-string-no-properties 1 blink)))
95
(desc (or (and (string-match org-bracket-link-regexp blink)
96
(match-string-no-properties 3 blink)) "No description"))
97
(files (org-registry-assoc-all link))
98
file point selection tmphist)
99
(cond ((and files visit)
100
;; result(s) to visit
101
(cond ((< 1 (length files))
102
;; more than one result
103
(setq tmphist (mapcar (lambda(entry)
104
(format "%s (%d) [%s]"
106
(nth 2 entry) ; point
107
(nth 1 entry))) files))
108
(setq selection (completing-read "File: " tmphist
110
(string-match "\\(.+\\) (\\([0-9]+\\))" selection)
111
(setq file (match-string 1 selection))
112
(setq point (string-to-number (match-string 2 selection))))
113
((eq 1 (length files))
115
(setq file (nth 3 (car files)))
116
(setq point (nth 2 (car files)))))
117
;; visit the (selected) file
118
(funcall org-registry-find-file file)
120
(unless (org-before-first-heading-p)
122
((and files (not visit))
123
;; result(s) to display
124
(cond ((eq 1 (length files))
126
(message "Link in file %s (%d) [%s]"
129
(nth 1 (car files))))
130
(t (org-registry-display-files files link))))
131
(t (message "No link to this in org-agenda-files")))))
133
(defun org-registry-display-files (files link)
134
"Display files in a separate window."
135
(switch-to-buffer-other-window
136
(get-buffer-create " *Org registry info*"))
138
(insert (format "Files pointing to %s:\n\n" link))
140
(while (setq file (pop files))
141
(insert (format "%s (%d) [%s]\n" (nth 3 file)
142
(nth 2 file) (nth 1 file)))))
143
(shrink-window-if-larger-than-buffer)
146
(defun org-registry-assoc-all (link &optional registry)
147
"Return all associated entries of LINK in the registry."
148
(org-registry-find-all
149
(lambda (entry) (string= link (car entry)))
152
(defun org-registry-find-all (test &optional registry)
153
"Return all entries satisfying `test' in the registry."
156
(lambda (x) (and (funcall test x) x))
157
(or registry org-registry-alist))))
160
(defun org-registry-visit ()
161
"If an Org file contains a link to the current location, visit
164
(org-registry-show t))
167
(defun org-registry-initialize (&optional from-scratch)
168
"Initialize `org-registry-alist'.
169
If FROM-SCRATCH is non-nil or the registry does not exist yet,
170
create a new registry from scratch and eval it. If the registry
171
exists, eval `org-registry-file' and make it the new value for
172
`org-registry-alist'."
174
(if (or from-scratch (not (file-exists-p org-registry-file)))
175
;; create a new registry
176
(let ((files org-agenda-files) file)
177
(while (setq file (pop files))
178
(setq file (expand-file-name file))
179
(mapc (lambda (entry)
180
(add-to-list 'org-registry-alist entry))
181
(org-registry-get-entries file)))
183
(org-registry-create org-registry-alist)))
184
;; eval the registry file
186
(insert-file-contents org-registry-file)
190
(defun org-registry-insinuate ()
191
"Call `org-registry-update' after saving in Org-mode.
192
Use with caution. This could slow down things a bit."
194
(add-hook 'org-mode-hook
195
(lambda() (add-hook 'after-save-hook
196
'org-registry-update t t))))
198
(defun org-registry-get-entries (file)
199
"List Org links in FILE that will be put in the registry."
202
(insert-file-contents file)
203
(goto-char (point-min))
204
(while (re-search-forward org-angle-link-re nil t)
205
(let* ((point (match-beginning 0))
206
(link (match-string-no-properties 0))
207
(desc (match-string-no-properties 0)))
208
(add-to-list 'result (list link desc point file))))
209
(goto-char (point-min))
210
(while (re-search-forward org-bracket-link-regexp nil t)
211
(let* ((point (match-beginning 0))
212
(link (match-string-no-properties 1))
213
(desc (or (match-string-no-properties 3) "No description")))
214
(add-to-list 'result (list link desc point file)))))
215
;; return the list of new entries
219
(defun org-registry-update ()
220
"Update the registry for the current Org file."
222
(unless (org-mode-p) (error "Not in org-mode"))
223
(let* ((from-file (expand-file-name (buffer-file-name)))
224
(new-entries (org-registry-get-entries from-file)))
226
(unless (file-exists-p org-registry-file)
227
(org-registry-initialize t))
228
(find-file org-registry-file)
229
(goto-char (point-min))
230
(while (re-search-forward (concat from-file "\")$") nil t)
231
(let ((end (1+ (match-end 0)))
232
(beg (progn (re-search-backward "^(\"" nil t)
233
(match-beginning 0))))
234
(delete-region beg end)))
235
(goto-char (point-min))
236
(re-search-forward "^(\"" nil t)
237
(goto-char (match-beginning 0))
239
(insert (with-output-to-string (prin1 elem)) "\n"))
242
(kill-buffer (current-buffer)))
243
(message (format "Org registry updated for %s"
244
(file-name-nondirectory from-file)))))
246
(defun org-registry-create (entries)
247
"Create `org-registry-file' with ENTRIES."
250
(find-file org-registry-file)
253
(with-output-to-string
254
(princ ";; -*- emacs-lisp -*-\n")
255
(princ ";; Org registry\n")
256
(princ ";; You shouldn't try to modify this buffer manually\n\n")
257
(princ "(setq org-registry-alist\n'(\n")
259
(when (setq entry (pop entries))
264
(kill-buffer (current-buffer))))
265
(message "Org registry created"))
267
(provide 'org-registry)
269
;;; User Options, Variables
271
;;; org-registry.el ends here
added
removed
src/org-6.34c/contrib/lisp/org-registry.el
