org-registry.el 8.9 KB

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