org-registry.el 9.0 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272
  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. ;;; Commentary:
  28. ;;
  29. ;; This library add a registry to your Org setup.
  30. ;;
  31. ;; Org files are full of links inserted with `org-store-link'. This links
  32. ;; point to e-mail, webpages, files, dirs, info pages, man pages, etc.
  33. ;; Actually, they come from potentially *everywhere* since Org lets you
  34. ;; define your own storing/following functions.
  35. ;;
  36. ;; So, what if you are on a e-mail, webpage or whatever and want to know if
  37. ;; this buffer has already been linked to somewhere in your agenda files?
  38. ;;
  39. ;; This is were org-registry comes in handy.
  40. ;;
  41. ;; M-x org-registry-show will tell you the name of the file
  42. ;; C-u M-x org-registry-show will directly jump to the file
  43. ;;
  44. ;; In case there are several files where the link lives in:
  45. ;;
  46. ;; M-x org-registry-show will display them in a new window
  47. ;; C-u M-x org-registry-show will prompt for a file to visit
  48. ;;
  49. ;; Add this to your Org configuration:
  50. ;;
  51. ;; (require 'org-registry)
  52. ;; (org-registry-initialize)
  53. ;;
  54. ;; If you want to update the registry with newly inserted links in the
  55. ;; current buffer: M-x org-registry-update
  56. ;;
  57. ;; If you want this job to be done each time you save an Org buffer,
  58. ;; hook 'org-registry-update to the local 'after-save-hook in org-mode:
  59. ;;
  60. ;; (org-registry-insinuate)
  61. ;;; Code:
  62. (eval-when-compile
  63. (require 'cl))
  64. (defgroup org-registry nil
  65. "A registry for Org."
  66. :group 'org)
  67. (defcustom org-registry-file
  68. (concat (getenv "HOME") "/.org-registry.el")
  69. "The Org registry file."
  70. :group 'org-registry
  71. :type 'file)
  72. (defcustom org-registry-find-file 'find-file-other-window
  73. "How to find visit files."
  74. :type 'function
  75. :group 'org-registry)
  76. (defvar org-registry-alist nil
  77. "An alist containing the Org registry.")
  78. ;;;###autoload
  79. (defun org-registry-show (&optional visit)
  80. "Show Org files where there are links pointing to the current
  81. buffer."
  82. (interactive "P")
  83. (org-registry-initialize)
  84. (let* ((blink (or (org-remember-annotation) ""))
  85. (link (when (string-match org-bracket-link-regexp blink)
  86. (match-string-no-properties 1 blink)))
  87. (desc (or (and (string-match org-bracket-link-regexp blink)
  88. (match-string-no-properties 3 blink)) "No description"))
  89. (files (org-registry-assoc-all link))
  90. file point selection tmphist)
  91. (cond ((and files visit)
  92. ;; result(s) to visit
  93. (cond ((< 1 (length files))
  94. ;; more than one result
  95. (setq tmphist (mapcar (lambda(entry)
  96. (format "%s (%d) [%s]"
  97. (nth 3 entry) ; file
  98. (nth 2 entry) ; point
  99. (nth 1 entry))) files))
  100. (setq selection (completing-read "File: " tmphist
  101. nil t nil 'tmphist))
  102. (string-match "\\(.+\\) (\\([0-9]+\\))" selection)
  103. (setq file (match-string 1 selection))
  104. (setq point (string-to-number (match-string 2 selection))))
  105. ((eq 1 (length files))
  106. ;; just one result
  107. (setq file (nth 3 (car files)))
  108. (setq point (nth 2 (car files)))))
  109. ;; visit the (selected) file
  110. (funcall org-registry-find-file file)
  111. (goto-char point)
  112. (unless (org-before-first-heading-p)
  113. (org-show-context)))
  114. ((and files (not visit))
  115. ;; result(s) to display
  116. (cond ((eq 1 (length files))
  117. ;; show one file
  118. (message "Link in file %s (%d) [%s]"
  119. (nth 3 (car files))
  120. (nth 2 (car files))
  121. (nth 1 (car files))))
  122. (t (org-registry-display-files files link))))
  123. (t (message "No link to this in org-agenda-files")))))
  124. (defun org-registry-display-files (files link)
  125. "Display files in a separate window."
  126. (switch-to-buffer-other-window
  127. (get-buffer-create " *Org registry info*"))
  128. (erase-buffer)
  129. (insert (format "Files pointing to %s:\n\n" link))
  130. (let (file)
  131. (while (setq file (pop files))
  132. (insert (format "%s (%d) [%s]\n" (nth 3 file)
  133. (nth 2 file) (nth 1 file)))))
  134. (shrink-window-if-larger-than-buffer)
  135. (other-window 1))
  136. (defun org-registry-assoc-all (link &optional registry)
  137. "Return all associated entries of LINK in the registry."
  138. (org-registry-find-all
  139. (lambda (entry) (string= link (car entry)))
  140. registry))
  141. (defun org-registry-find-all (test &optional registry)
  142. "Return all entries satisfying `test' in the registry."
  143. (delq nil
  144. (mapcar
  145. (lambda (x) (and (funcall test x) x))
  146. (or registry org-registry-alist))))
  147. ;;;###autoload
  148. (defun org-registry-visit ()
  149. "If an Org file contains a link to the current location, visit
  150. this file."
  151. (interactive)
  152. (org-registry-show t))
  153. ;;;###autoload
  154. (defun org-registry-initialize (&optional from-scratch)
  155. "Initialize `org-registry-alist'.
  156. If FROM-SCRATCH is non-nil or the registry does not exist yet,
  157. create a new registry from scratch and eval it. If the registry
  158. exists, eval `org-registry-file' and make it the new value for
  159. `org-registry-alist'."
  160. (interactive "P")
  161. (if (or from-scratch (not (file-exists-p org-registry-file)))
  162. ;; create a new registry
  163. (let ((files org-agenda-files) file)
  164. (while (setq file (pop files))
  165. (setq file (expand-file-name file))
  166. (mapc (lambda (entry)
  167. (add-to-list 'org-registry-alist entry))
  168. (org-registry-get-entries file)))
  169. (when from-scratch
  170. (org-registry-create org-registry-alist)))
  171. ;; eval the registry file
  172. (with-temp-buffer
  173. (insert-file-contents org-registry-file)
  174. (eval-buffer))))
  175. ;;;###autoload
  176. (defun org-registry-insinuate ()
  177. "Call `org-registry-update' after saving in Org-mode.
  178. Use with caution. This could slow down things a bit."
  179. (interactive)
  180. (add-hook 'org-mode-hook
  181. (lambda() (add-hook 'after-save-hook
  182. 'org-registry-update t t))))
  183. (defun org-registry-get-entries (file)
  184. "List Org links in FILE that will be put in the registry."
  185. (let (bufstr result)
  186. (with-temp-buffer
  187. (insert-file-contents file)
  188. (goto-char (point-min))
  189. (while (re-search-forward org-angle-link-re nil t)
  190. (let* ((point (match-beginning 0))
  191. (link (match-string-no-properties 0))
  192. (desc (match-string-no-properties 0)))
  193. (add-to-list 'result (list link desc point file))))
  194. (goto-char (point-min))
  195. (while (re-search-forward org-bracket-link-regexp nil t)
  196. (let* ((point (match-beginning 0))
  197. (link (match-string-no-properties 1))
  198. (desc (or (match-string-no-properties 3) "No description")))
  199. (add-to-list 'result (list link desc point file)))))
  200. ;; return the list of new entries
  201. result))
  202. ;;;###autoload
  203. (defun org-registry-update ()
  204. "Update the registry for the current Org file."
  205. (interactive)
  206. (unless (eq major-mode 'org-mode) (error "Not in org-mode"))
  207. (let* ((from-file (expand-file-name (buffer-file-name)))
  208. (new-entries (org-registry-get-entries from-file)))
  209. (with-temp-buffer
  210. (unless (file-exists-p org-registry-file)
  211. (org-registry-initialize t))
  212. (find-file org-registry-file)
  213. (goto-char (point-min))
  214. (while (re-search-forward (concat from-file "\")$") nil t)
  215. (let ((end (1+ (match-end 0)))
  216. (beg (progn (re-search-backward "^(\"" nil t)
  217. (match-beginning 0))))
  218. (delete-region beg end)))
  219. (goto-char (point-min))
  220. (re-search-forward "^(\"" nil t)
  221. (goto-char (match-beginning 0))
  222. (mapc (lambda (elem)
  223. (insert (with-output-to-string (prin1 elem)) "\n"))
  224. new-entries)
  225. (save-buffer)
  226. (kill-buffer (current-buffer)))
  227. (message (format "Org registry updated for %s"
  228. (file-name-nondirectory from-file)))))
  229. (defun org-registry-create (entries)
  230. "Create `org-registry-file' with ENTRIES."
  231. (let (entry)
  232. (with-temp-buffer
  233. (find-file org-registry-file)
  234. (erase-buffer)
  235. (insert
  236. (with-output-to-string
  237. (princ ";; -*- emacs-lisp -*-\n")
  238. (princ ";; Org registry\n")
  239. (princ ";; You shouldn't try to modify this buffer manually\n\n")
  240. (princ "(setq org-registry-alist\n'(\n")
  241. (while entries
  242. (when (setq entry (pop entries))
  243. (prin1 entry)
  244. (princ "\n")))
  245. (princ "))\n")))
  246. (save-buffer)
  247. (kill-buffer (current-buffer))))
  248. (message "Org registry created"))
  249. (provide 'org-registry)
  250. ;;; User Options, Variables
  251. ;;; org-registry.el ends here