Replace org-mode-p with usual (eq major-mode 'org-mode) check
[org-mode.git] / contrib / lisp / org-registry.el
1 ;;; org-registry.el --- a registry for Org links
2 ;;
3 ;; Copyright 2007-2011 Bastien Guerry
4 ;;
5 ;; Emacs Lisp Archive Entry
6 ;; Filename: org-registry.el
7 ;; Version: 0.1a
8 ;; Author: Bastien Guerry <bzg AT gnu DOT org>
9 ;; Maintainer: Bastien Guerry <bzg AT gnu 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
13 ;;
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)
17 ;; any later version.
18 ;;
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.
23 ;;
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.
27
28 ;;; Commentary:
29 ;;
30 ;; This library add a registry to your Org setup.
31 ;;
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.
36 ;;
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?
39 ;;
40 ;; This is were org-registry comes in handy.
41 ;;
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
44 ;;
45 ;; In case there are several files where the link lives in:
46 ;;
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
49 ;;
50 ;; Add this to your Org configuration:
51 ;;
52 ;; (require 'org-registry)
53 ;; (org-registry-initialize)
54 ;;
55 ;; If you want to update the registry with newly inserted links in the
56 ;; current buffer: M-x org-registry-update
57 ;;
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:
60 ;;
61 ;; (org-registry-insinuate)
62
63 ;;; Code:
64
65 (eval-when-compile
66   (require 'cl))
67
68 (defgroup org-registry nil
69   "A registry for Org."
70   :group 'org)
71
72 (defcustom org-registry-file
73   (concat (getenv "HOME") "/.org-registry.el")
74   "The Org registry file."
75   :group 'org-registry
76   :type 'file)
77
78 (defcustom org-registry-find-file 'find-file-other-window
79   "How to find visit files."
80   :type 'function
81   :group 'org-registry)
82
83 (defvar org-registry-alist nil
84   "An alist containing the Org registry.")
85
86 ;;;###autoload
87 (defun org-registry-show (&optional visit)
88   "Show Org files where there are links pointing to the current
89 buffer."
90   (interactive "P")
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]"
105                                                   (nth 3 entry) ; file
106                                                   (nth 2 entry) ; point
107                                                   (nth 1 entry))) files))
108                   (setq selection (completing-read "File: " tmphist
109                                                    nil t nil '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))
114                   ;; just one result
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)
119            (goto-char point)
120            (unless (org-before-first-heading-p)
121              (org-show-context)))
122           ((and files (not visit))
123            ;; result(s) to display
124            (cond  ((eq 1 (length files))
125                    ;; show one file
126                    (message "Link in file %s (%d) [%s]"
127                             (nth 3 (car files))
128                             (nth 2 (car files))
129                             (nth 1 (car files))))
130                   (t (org-registry-display-files files link))))
131           (t (message "No link to this in org-agenda-files")))))
132
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*"))
137   (erase-buffer)
138   (insert (format "Files pointing to %s:\n\n" link))
139   (let (file)
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)
144   (other-window 1))
145
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)))
150    registry))
151
152 (defun org-registry-find-all (test &optional registry)
153   "Return all entries satisfying `test' in the registry."
154   (delq nil 
155         (mapcar 
156          (lambda (x) (and (funcall test x) x)) 
157          (or registry org-registry-alist))))
158
159 ;;;###autoload
160 (defun org-registry-visit ()
161   "If an Org file contains a link to the current location, visit
162 this file."
163   (interactive)
164   (org-registry-show t))
165
166 ;;;###autoload
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'."
173   (interactive "P")
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)))
182         (when from-scratch
183           (org-registry-create org-registry-alist)))
184     ;; eval the registry file
185     (with-temp-buffer
186       (insert-file-contents org-registry-file)
187       (eval-buffer))))
188
189 ;;;###autoload
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."
193   (interactive)
194   (add-hook 'org-mode-hook
195             (lambda() (add-hook 'after-save-hook
196                                 'org-registry-update t t))))
197
198 (defun org-registry-get-entries (file)
199   "List Org links in FILE that will be put in the registry."
200   (let (bufstr result)
201     (with-temp-buffer
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
216     result))
217
218 ;;;###autoload
219 (defun org-registry-update ()
220   "Update the registry for the current Org file."
221   (interactive)
222   (unless (eq major-mode 'org-mode) (error "Not in org-mode"))
223   (let* ((from-file (expand-file-name (buffer-file-name)))
224          (new-entries (org-registry-get-entries from-file)))
225     (with-temp-buffer
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))
238       (mapc (lambda (elem)
239               (insert (with-output-to-string (prin1 elem)) "\n"))
240             new-entries)
241       (save-buffer)
242       (kill-buffer (current-buffer)))
243     (message (format "Org registry updated for %s"
244                      (file-name-nondirectory from-file)))))
245
246 (defun org-registry-create (entries)
247   "Create `org-registry-file' with ENTRIES."
248   (let (entry)
249     (with-temp-buffer
250       (find-file org-registry-file)
251       (erase-buffer)
252       (insert
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")
258          (while entries
259            (when (setq entry (pop entries))
260              (prin1 entry)
261              (princ "\n")))
262          (princ "))\n")))
263       (save-buffer)
264       (kill-buffer (current-buffer))))
265   (message "Org registry created"))
266
267 (provide 'org-registry)
268
269 ;;;  User Options, Variables
270
271 ;;; org-registry.el ends here