org-registry.el (9163B)
1 ;;; org-registry.el --- a registry for Org links 2 ;; 3 ;; Copyright 2007-2021 Free Software Foundation, Inc. 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 ;; Homepage: https://git.sr.ht/~bzg/org-contrib 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 <https://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