contrib/lisp/org-registry.el

   1 ;;; org-registry.el --- a registry for Org links
   2 ;;
   3 ;; Copyright 2007, 2008 Bastien Guerry
   4 ;;
   5 ;; Emacs Lisp Archive Entry
   6 ;; Filename: org-registry.el
   7 ;; Version: 0.1a
   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
  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   (let ((reg (or org-registry-alist registry)) entry output)
 149     (while (setq entry (assoc link reg))
 150       (add-to-list 'output entry)
 151       (setq reg (delete entry reg)))
 152     (nreverse output)))
 153
 154 ;;;###autoload
 155 (defun org-registry-visit ()
 156   "If an Org file contains a link to the current location, visit
 157 this file."
 158   (interactive)
 159   (org-registry-show t))
 160
 161 ;;;###autoload
 162 (defun org-registry-initialize (&optional from-scratch)
 163   "Initialize `org-registry-alist'.
 164 If FROM-SCRATCH is non-nil or the registry does not exist yet,
 165 create a new registry from scratch and eval it. If the registry
 166 exists, eval `org-registry-file' and make it the new value for
 167 `org-registry-alist'."
 168   (interactive "P")
 169   (if (or from-scratch (not (file-exists-p org-registry-file)))
 170       ;; create a new registry
 171       (let ((files org-agenda-files) file)
 172         (while (setq file (pop files))
 173           (setq file (expand-file-name file))
 174           (mapc (lambda (entry)
 175                   (add-to-list 'org-registry-alist entry))
 176                 (org-registry-get-entries file)))
 177         (when from-scratch
 178           (org-registry-create org-registry-alist)))
 179     ;; eval the registry file
 180     (with-temp-buffer
 181       (insert-file-contents org-registry-file)
 182       (eval-buffer))))
 183
 184 ;;;###autoload
 185 (defun org-registry-insinuate ()
 186   "Call `org-registry-update' after saving in Org-mode.
 187 Use with caution.  This could slow down things a bit."
 188   (interactive)
 189   (add-hook 'org-mode-hook
 190             (lambda() (add-hook 'after-save-hook
 191                                 'org-registry-update t t))))
 192
 193 (defun org-registry-get-entries (file)
 194   "List Org links in FILE that will be put in the registry."
 195   (let (bufstr result)
 196     (with-temp-buffer
 197       (insert-file-contents file)
 198       (goto-char (point-min))
 199       (while (re-search-forward org-angle-link-re nil t)
 200         (let* ((point (match-beginning 0))
 201                (link (match-string-no-properties 0))
 202                (desc (match-string-no-properties 0)))
 203             (add-to-list 'result (list link desc point file))))
 204       (goto-char (point-min))
 205       (while (re-search-forward org-bracket-link-regexp nil t)
 206         (let* ((point (match-beginning 0))
 207                (link (match-string-no-properties 1))
 208                (desc (or (match-string-no-properties 3) "No description")))
 209             (add-to-list 'result (list link desc point file)))))
 210     ;; return the list of new entries
 211     result))
 212
 213 ;;;###autoload
 214 (defun org-registry-update ()
 215   "Update the registry for the current Org file."
 216   (interactive)
 217   (unless (org-mode-p) (error "Not in org-mode"))
 218   (let* ((from-file (expand-file-name (buffer-file-name)))
 219          (new-entries (org-registry-get-entries from-file)))
 220     (with-temp-buffer
 221       (unless (file-exists-p org-registry-file)
 222         (org-registry-initialize t))
 223       (find-file org-registry-file)
 224       (goto-char (point-min))
 225       (while (re-search-forward (concat from-file "\")$") nil t)
 226         (let ((end (1+ (match-end 0)))
 227               (beg (progn (re-search-backward "^(\"" nil t)
 228                           (match-beginning 0))))
 229         (delete-region beg end)))
 230       (goto-char (point-min))
 231       (re-search-forward "^(\"" nil t)
 232       (goto-char (match-beginning 0))
 233       (mapc (lambda (elem)
 234               (insert (with-output-to-string (prin1 elem)) "\n"))
 235             new-entries)
 236       (save-buffer)
 237       (kill-buffer (current-buffer)))
 238     (message (format "Org registry updated for %s"
 239                      (file-name-nondirectory from-file)))))
 240
 241 (defun org-registry-create (entries)
 242   "Create `org-registry-file' with ENTRIES."
 243   (let (entry)
 244     (with-temp-buffer
 245       (find-file org-registry-file)
 246       (erase-buffer)
 247       (insert
 248        (with-output-to-string
 249          (princ ";; -*- emacs-lisp -*-\n")
 250          (princ ";; Org registry\n")
 251          (princ ";; You shouldn't try to modify this buffer manually\n\n")
 252          (princ "(setq org-registry-alist\n'(\n")
 253          (while entries
 254            (when (setq entry (pop entries))
 255              (prin1 entry)
 256              (princ "\n")))
 257          (princ "))\n")))
 258       (save-buffer)
 259       (kill-buffer (current-buffer))))
 260   (message "Org registry created"))
 261
 262 (provide 'org-registry)
 263
 264 ;;;  User Options, Variables
 265
 266 ;;; org-registry.el ends here