Merge branch 'maint'
[org-mode/org-tableheadings.git] / contrib / lisp / org-registry.el
blob402ce308231827841df7a99d79a1d214ad86550e
1 ;;; org-registry.el --- a registry for Org links
2 ;;
3 ;; Copyright 2007-2014 Bastien Guerry
4 ;;
5 ;; Emacs Lisp Archive Entry
6 ;; Filename: org-registry.el
7 ;; Version: 0.1a
8 ;; Author: Bastien Guerry <bzg@gnu.org>
9 ;; Maintainer: Bastien Guerry <bzg@gnu.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 file is not part of GNU Emacs.
16 ;; This program is free software; you can redistribute it and/or modify
17 ;; it under the terms of the GNU General Public License as published by
18 ;; the Free Software Foundation; either version 3, or (at your option)
19 ;; any later version.
21 ;; This program is distributed in the hope that it will be useful,
22 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
23 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
24 ;; GNU General Public License for more details.
26 ;; You should have received a copy of the GNU General Public License
27 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
29 ;;; Commentary:
31 ;; This library add a registry to your Org setup.
33 ;; Org files are full of links inserted with `org-store-link'. This links
34 ;; point to e-mail, webpages, files, dirs, info pages, man pages, etc.
35 ;; Actually, they come from potentially *everywhere* since Org lets you
36 ;; define your own storing/following functions.
38 ;; So, what if you are on a e-mail, webpage or whatever and want to know if
39 ;; this buffer has already been linked to somewhere in your agenda files?
41 ;; This is were org-registry comes in handy.
43 ;; M-x org-registry-show will tell you the name of the file
44 ;; C-u M-x org-registry-show will directly jump to the file
46 ;; In case there are several files where the link lives in:
48 ;; M-x org-registry-show will display them in a new window
49 ;; C-u M-x org-registry-show will prompt for a file to visit
51 ;; Add this to your Org configuration:
53 ;; (require 'org-registry)
54 ;; (org-registry-initialize)
56 ;; If you want to update the registry with newly inserted links in the
57 ;; current buffer: M-x org-registry-update
59 ;; If you want this job to be done each time you save an Org buffer,
60 ;; hook 'org-registry-update to the local 'after-save-hook in org-mode:
62 ;; (org-registry-insinuate)
64 ;;; Code:
66 (eval-when-compile
67 (require 'cl))
69 (defgroup org-registry nil
70 "A registry for Org."
71 :group 'org)
73 (defcustom org-registry-file
74 (concat (getenv "HOME") "/.org-registry.el")
75 "The Org registry file."
76 :group 'org-registry
77 :type 'file)
79 (defcustom org-registry-find-file 'find-file-other-window
80 "How to find visit files."
81 :type 'function
82 :group 'org-registry)
84 (defvar org-registry-alist nil
85 "An alist containing the Org registry.")
87 ;;;###autoload
88 (defun org-registry-show (&optional visit)
89 "Show Org files where there are links pointing to the current
90 buffer."
91 (interactive "P")
92 (org-registry-initialize)
93 (let* ((blink (or (org-remember-annotation) ""))
94 (link (when (string-match org-bracket-link-regexp blink)
95 (match-string-no-properties 1 blink)))
96 (desc (or (and (string-match org-bracket-link-regexp blink)
97 (match-string-no-properties 3 blink)) "No description"))
98 (files (org-registry-assoc-all link))
99 file point selection tmphist)
100 (cond ((and files visit)
101 ;; result(s) to visit
102 (cond ((< 1 (length files))
103 ;; more than one result
104 (setq tmphist (mapcar (lambda(entry)
105 (format "%s (%d) [%s]"
106 (nth 3 entry) ; file
107 (nth 2 entry) ; point
108 (nth 1 entry))) files))
109 (setq selection (completing-read "File: " tmphist
110 nil t nil 'tmphist))
111 (string-match "\\(.+\\) (\\([0-9]+\\))" selection)
112 (setq file (match-string 1 selection))
113 (setq point (string-to-number (match-string 2 selection))))
114 ((eq 1 (length files))
115 ;; just one result
116 (setq file (nth 3 (car files)))
117 (setq point (nth 2 (car files)))))
118 ;; visit the (selected) file
119 (funcall org-registry-find-file file)
120 (goto-char point)
121 (unless (org-before-first-heading-p)
122 (org-show-context)))
123 ((and files (not visit))
124 ;; result(s) to display
125 (cond ((eq 1 (length files))
126 ;; show one file
127 (message "Link in file %s (%d) [%s]"
128 (nth 3 (car files))
129 (nth 2 (car files))
130 (nth 1 (car files))))
131 (t (org-registry-display-files files link))))
132 (t (message "No link to this in org-agenda-files")))))
134 (defun org-registry-display-files (files link)
135 "Display files in a separate window."
136 (switch-to-buffer-other-window
137 (get-buffer-create " *Org registry info*"))
138 (erase-buffer)
139 (insert (format "Files pointing to %s:\n\n" link))
140 (let (file)
141 (while (setq file (pop files))
142 (insert (format "%s (%d) [%s]\n" (nth 3 file)
143 (nth 2 file) (nth 1 file)))))
144 (shrink-window-if-larger-than-buffer)
145 (other-window 1))
147 (defun org-registry-assoc-all (link &optional registry)
148 "Return all associated entries of LINK in the registry."
149 (org-registry-find-all
150 (lambda (entry) (string= link (car entry)))
151 registry))
153 (defun org-registry-find-all (test &optional registry)
154 "Return all entries satisfying `test' in the registry."
155 (delq nil
156 (mapcar
157 (lambda (x) (and (funcall test x) x))
158 (or registry org-registry-alist))))
160 ;;;###autoload
161 (defun org-registry-visit ()
162 "If an Org file contains a link to the current location, visit
163 this file."
164 (interactive)
165 (org-registry-show t))
167 ;;;###autoload
168 (defun org-registry-initialize (&optional from-scratch)
169 "Initialize `org-registry-alist'.
170 If FROM-SCRATCH is non-nil or the registry does not exist yet,
171 create a new registry from scratch and eval it. If the registry
172 exists, eval `org-registry-file' and make it the new value for
173 `org-registry-alist'."
174 (interactive "P")
175 (if (or from-scratch (not (file-exists-p org-registry-file)))
176 ;; create a new registry
177 (let ((files org-agenda-files) file)
178 (while (setq file (pop files))
179 (setq file (expand-file-name file))
180 (mapc (lambda (entry)
181 (add-to-list 'org-registry-alist entry))
182 (org-registry-get-entries file)))
183 (when from-scratch
184 (org-registry-create org-registry-alist)))
185 ;; eval the registry file
186 (with-temp-buffer
187 (insert-file-contents org-registry-file)
188 (eval-buffer))))
190 ;;;###autoload
191 (defun org-registry-insinuate ()
192 "Call `org-registry-update' after saving in Org-mode.
193 Use with caution. This could slow down things a bit."
194 (interactive)
195 (add-hook 'org-mode-hook
196 (lambda() (add-hook 'after-save-hook
197 'org-registry-update t t))))
199 (defun org-registry-get-entries (file)
200 "List Org links in FILE that will be put in the registry."
201 (let (bufstr result)
202 (with-temp-buffer
203 (insert-file-contents file)
204 (goto-char (point-min))
205 (while (re-search-forward org-angle-link-re nil t)
206 (let* ((point (match-beginning 0))
207 (link (match-string-no-properties 0))
208 (desc (match-string-no-properties 0)))
209 (add-to-list 'result (list link desc point file))))
210 (goto-char (point-min))
211 (while (re-search-forward org-bracket-link-regexp nil t)
212 (let* ((point (match-beginning 0))
213 (link (match-string-no-properties 1))
214 (desc (or (match-string-no-properties 3) "No description")))
215 (add-to-list 'result (list link desc point file)))))
216 ;; return the list of new entries
217 result))
219 ;;;###autoload
220 (defun org-registry-update ()
221 "Update the registry for the current Org file."
222 (interactive)
223 (unless (eq major-mode 'org-mode) (error "Not in org-mode"))
224 (let* ((from-file (expand-file-name (buffer-file-name)))
225 (new-entries (org-registry-get-entries from-file)))
226 (with-temp-buffer
227 (unless (file-exists-p org-registry-file)
228 (org-registry-initialize t))
229 (find-file org-registry-file)
230 (goto-char (point-min))
231 (while (re-search-forward (concat from-file "\")$") nil t)
232 (let ((end (1+ (match-end 0)))
233 (beg (progn (re-search-backward "^(\"" nil t)
234 (match-beginning 0))))
235 (delete-region beg end)))
236 (goto-char (point-min))
237 (re-search-forward "^(\"" nil t)
238 (goto-char (match-beginning 0))
239 (mapc (lambda (elem)
240 (insert (with-output-to-string (prin1 elem)) "\n"))
241 new-entries)
242 (save-buffer)
243 (kill-buffer (current-buffer)))
244 (message (format "Org registry updated for %s"
245 (file-name-nondirectory from-file)))))
247 (defun org-registry-create (entries)
248 "Create `org-registry-file' with ENTRIES."
249 (let (entry)
250 (with-temp-buffer
251 (find-file org-registry-file)
252 (erase-buffer)
253 (insert
254 (with-output-to-string
255 (princ ";; -*- emacs-lisp -*-\n")
256 (princ ";; Org registry\n")
257 (princ ";; You shouldn't try to modify this buffer manually\n\n")
258 (princ "(setq org-registry-alist\n'(\n")
259 (while entries
260 (when (setq entry (pop entries))
261 (prin1 entry)
262 (princ "\n")))
263 (princ "))\n")))
264 (save-buffer)
265 (kill-buffer (current-buffer))))
266 (message "Org registry created"))
268 (provide 'org-registry)
270 ;;; User Options, Variables
272 ;;; org-registry.el ends here