contrib/lisp/org-registry.el

   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
  13 ;;
  14 ;; This file is not part of GNU Emacs.
  15 ;;
  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.
  20 ;;
  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.
  25 ;;
  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/>.
  28
  29 ;;; Commentary:
  30 ;;
  31 ;; This library add a registry to your Org setup.
  32 ;;
  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.
  37 ;;
  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?
  40 ;;
  41 ;; This is were org-registry comes in handy.
  42 ;;
  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
  45 ;;
  46 ;; In case there are several files where the link lives in:
  47 ;;
  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
  50 ;;
  51 ;; Add this to your Org configuration:
  52 ;;
  53 ;; (require 'org-registry)
  54 ;; (org-registry-initialize)
  55 ;;
  56 ;; If you want to update the registry with newly inserted links in the
  57 ;; current buffer: M-x org-registry-update
  58 ;;
  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:
  61 ;;
  62 ;; (org-registry-insinuate)
  63
  64 ;;; Code:
  65
  66 (eval-when-compile
  67   (require 'cl))
  68
  69 (defgroup org-registry nil
  70   "A registry for Org."
  71   :group 'org)
  72
  73 (defcustom org-registry-file
  74   (concat (getenv "HOME") "/.org-registry.el")
  75   "The Org registry file."
  76   :group 'org-registry
  77   :type 'file)
  78
  79 (defcustom org-registry-find-file 'find-file-other-window
  80   "How to find visit files."
  81   :type 'function
  82   :group 'org-registry)
  83
  84 (defvar org-registry-alist nil
  85   "An alist containing the Org registry.")
  86
  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")))))
 133
 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))
 146
 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))
 152
 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))))
 159
 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))
 166
 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))))
 189
 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))))
 198
 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))
 218
 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)))))
 246
 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"))
 267
 268 (provide 'org-registry)
 269
 270 ;;;  User Options, Variables
 271
 272 ;;; org-registry.el ends here