denote-refs.el (13127B)
1 ;;; denote-refs.el --- Show links and backlinks in Denote notes -*- lexical-binding: t; -*- 2 3 ;; Copyright (C) 2022 Akib Azmain Turja. 4 5 ;; Author: Akib Azmain Turja <akib@disroot.org> 6 ;; Created: 2022-12-18 7 ;; Version: 0.1.2 8 ;; Package-Requires: ((emacs "28.1") (denote "1.1.0")) 9 ;; Keywords: hypermedia, outlines, files 10 ;; URL: https://codeberg.org/akib/emacs-denote-refs 11 12 ;; This file is not part of GNU Emacs. 13 14 ;; This file 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 ;; For a full copy of the GNU General Public License 25 ;; see <https://www.gnu.org/licenses/>. 26 27 ;;; Commentary: 28 29 ;; Denote-Refs shows the list of linked file and backlinks to current 30 ;; file. This list is shown just below the front matter of your note. 31 ;; To enable do M-x denote-refs-mode. You can also enable it in your 32 ;; `denote-directory' with .dir-locals.el. 33 34 ;;; Code: 35 36 (require 'denote) 37 (require 'subr-x) 38 39 (defgroup denote-refs nil 40 "Show links and backlinks in Denote notes." 41 :group 'denote 42 :link '(url-link "https://codeberg.org/akib/emacs-denote-refs") 43 :prefix "denote-refs-") 44 45 (defcustom denote-refs-update-delay '(0.2 1 60) 46 "Idle delay before updating reference lists. 47 48 The value is a list of form (FIRST INIT MAINTAIN). FIRST the delay 49 before initializing the reference lists just after enabling the mode. 50 INIT the delay before initializing the reference lists for the first 51 time, used if the initialization was interrupted. MAINTAIN the delay 52 before updating the reference lists to keep the lists to updated." 53 :type '(list (number :tag "Delay after mode enabled") 54 (number :tag "Delay before initialization") 55 (number :tag "Delay after initialized"))) 56 57 (defcustom denote-refs-sections '(links backlinks) 58 "The sections to show. 59 60 Available sections are `links' and `backlinks', which shows the list 61 of linked file and the list of backlinks respectively." 62 :type '(repeat (choice (const :tag "Links" links) 63 (const :tag "Backlinks" backlinks)))) 64 65 (defvar denote-refs--links 'not-ready 66 "Alist of linked files. 67 68 The key is the path relative to user option `denote-directory', and 69 the key is the absolute path.") 70 71 (defvar denote-refs--backlinks 'not-ready 72 "Alist of backlinks. 73 74 The key is the path relative to user option `denote-directory', and 75 the key is the absolute path.") 76 77 (defvar denote-refs--schedule-idle-update-timer nil 78 "Timer to schedule updating references while idle.") 79 80 (defvar denote-refs--idle-update-timers nil 81 "Timer to update references while idle.") 82 83 (defun denote-refs--render (section) 84 "Render SECTION." 85 (let ((refs (pcase section 86 ('links denote-refs--links) 87 ('backlinks denote-refs--backlinks)))) 88 (cond 89 ;; There's no comment syntax in `text-mode', so just follow 90 ;; `org-mode'. 91 ((derived-mode-p 'org-mode 'text-mode) 92 ;; Insert references count. 93 (insert (if (or (eq refs 'not-ready) 94 (eq refs 'error)) 95 (format "# ... %s\n" (if (eq section 'links) 96 "links" 97 "backlinks")) 98 (format "# %i %s%s\n" (length refs) 99 (if (eq section 'links) 100 "link" 101 "backlink") 102 (pcase (length refs) 103 (0 "") 104 (1 ":") 105 (_ "s:"))))) 106 ;; Insert reference list. 107 (when (listp refs) 108 (dolist (ref refs) 109 (insert "# ") 110 (insert-button (car ref) 111 'help-echo (cdr ref) 112 'face 'denote-faces-link 113 'action (lambda (_) 114 (funcall denote-link-button-action 115 (cdr ref)))) 116 (insert ?\n)))) 117 ((derived-mode-p 'markdown-mode) 118 ;; Insert references count. 119 (insert (if (or (eq refs 'not-ready) 120 (eq refs 'error)) 121 (format "<!-- ... %s -->\n" (if (eq section 'links) 122 "links" 123 "backlinks")) 124 (format "<!-- %i %s%s\n" (length refs) 125 (if (eq section 'links) 126 "link" 127 "backlink") 128 (pcase (length refs) 129 (0 " -->") 130 (1 ":") 131 (_ "s:"))))) 132 ;; Insert reference list. 133 (when (listp refs) 134 (while refs 135 (let ((ref (pop refs))) 136 (insert " ") 137 (insert-button 138 (car ref) 139 'help-echo (cdr ref) 140 'face 'denote-faces-link 141 'action (lambda (_) 142 (funcall denote-link-button-action 143 (cdr ref)))) 144 (unless refs 145 (insert " -->")) 146 (insert ?\n)))))))) 147 148 (defun denote-refs--goto-end-of-front-matter () 149 "Go to the end of front matter of the note." 150 ;; All default front matters end with at least an empty line. But 151 ;; advanced users can change that. So we keep this code in separate 152 ;; function for them to advice. 153 (goto-char (point-min)) 154 (search-forward "\n\n")) 155 156 (defun denote-refs--remove () 157 "Remove the references shown." 158 ;; We ignore errors, because `denote-refs--goto-end-of-front-matter' 159 ;; might fail. 160 (ignore-errors 161 (save-excursion 162 (denote-refs--goto-end-of-front-matter) 163 (when (get-text-property (point) 'denote-refs--sections) 164 (let ((end (or (next-single-property-change 165 (point) 'denote-refs--sections) 166 (point-max)))) 167 (when (< end (point-max)) 168 (setq end (1+ end))) 169 (let ((inhibit-read-only t)) 170 (with-silent-modifications 171 (delete-region (point) end)))))))) 172 173 (defun denote-refs--show () 174 "Show references." 175 ;; We ignore errors, because `denote-refs--goto-end-of-front-matter' 176 ;; might fail. 177 (ignore-errors 178 (denote-refs--remove) 179 (save-excursion 180 (denote-refs--goto-end-of-front-matter) 181 (let ((begin (point)) 182 (inhibit-read-only t)) 183 (with-silent-modifications 184 (dolist (section denote-refs-sections) 185 (pcase-exhaustive section 186 ('links 187 (denote-refs--render 'links)) 188 ('backlinks 189 (denote-refs--render 'backlinks)))) 190 (put-text-property begin (point) 'read-only t) 191 (put-text-property begin (point) 'denote-refs--sections t) 192 (insert ?\n)))))) 193 194 (defun denote-refs--make-path-relative (path) 195 "Return a cons of relative and absolute version of PATH. 196 197 The car is PATH relative to user option `denote-directory'." 198 (cons (string-remove-prefix (denote-directory) path) path)) 199 200 (defun denote-refs--fetch () 201 "Fetch reference information." 202 (dolist (section (seq-uniq denote-refs-sections)) 203 (pcase-exhaustive section 204 ('links 205 (setq denote-refs--links 206 (condition-case-unless-debug nil 207 (and (buffer-file-name) 208 (file-exists-p (buffer-file-name)) 209 (mapcar #'denote-refs--make-path-relative 210 (delete-dups 211 (denote-link--expand-identifiers 212 (denote--link-in-context-regexp 213 (denote-filetype-heuristics 214 (buffer-file-name))))))) 215 (error 'error)))) 216 ('backlinks 217 (setq denote-refs--backlinks 218 (condition-case-unless-debug nil 219 (and (buffer-file-name) 220 (file-exists-p (buffer-file-name)) 221 (mapcar 222 #'denote-refs--make-path-relative 223 (delete (buffer-file-name) 224 (denote--retrieve-files-in-xrefs 225 (denote-retrieve-filename-identifier 226 (buffer-file-name)))))) 227 (error 'error))))))) 228 229 (defun denote-refs-update () 230 "Update Denote references shown." 231 (interactive) 232 (denote-refs--fetch) 233 (denote-refs--show)) 234 235 (defun denote-refs--idle-update (buffer) 236 "Update Denote references shown on BUFFER, but don't block." 237 (when (buffer-live-p buffer) 238 (with-current-buffer buffer 239 (while-no-input 240 (denote-refs-update)) 241 (denote-refs--show)))) 242 243 (defun denote-refs-update-all () 244 "Update Denote references shown on all buffers." 245 (interactive) 246 (dolist (buffer (buffer-list)) 247 (when (buffer-local-value 'denote-refs-mode buffer) 248 (with-current-buffer buffer 249 (denote-refs-update))))) 250 251 (defun denote-refs--fix-xref--collect-matches (fn hit &rest args) 252 "Advice around `xref--collect-match' to ignore reference lists. 253 254 FN is the original definition of `xref--collect-matches', HIT and ARGS 255 are it's arguments." 256 (let* ((file (cadr hit)) 257 (file (and file (concat xref--hits-remote-id file))) 258 (buf (xref--find-file-buffer file))) 259 (if (and buf (buffer-local-value 'denote-refs-mode buf)) 260 (progn 261 (with-current-buffer buf 262 (denote-refs--remove)) 263 (unwind-protect 264 (apply fn hit args) 265 (with-current-buffer buf 266 (denote-refs--show)))) 267 (apply fn hit args)))) 268 269 (defun denote-refs--schedule-idle-update () 270 "Schedule updating Denote references shown." 271 (mapc #'cancel-timer denote-refs--idle-update-timers) 272 (setq denote-refs--idle-update-timers nil) 273 (and (eq (while-no-input 274 (dolist (buffer (buffer-list)) 275 (when (buffer-local-value 'denote-refs-mode buffer) 276 (with-current-buffer buffer 277 (push 278 (run-with-idle-timer 279 (if (or (eq denote-refs--links 'not-ready) 280 (eq denote-refs--backlinks 'not-ready)) 281 (cadr denote-refs-update-delay) 282 (caddr denote-refs-update-delay)) 283 nil #'denote-refs--idle-update buffer) 284 denote-refs--idle-update-timers)))) 285 'finish) 286 'finish) 287 (not denote-refs--idle-update-timers) 288 (progn 289 (advice-remove #'xref--collect-matches 290 #'denote-refs--fix-xref--collect-matches) 291 (cancel-timer denote-refs--schedule-idle-update-timer)))) 292 293 (defun denote-refs--before-write-region (_ _) 294 "Make sure `write-region' doesn't write the reference lists." 295 (let ((buf (get-buffer-create " *denote-refs-tmp-write-region*")) 296 (str (buffer-string))) 297 (set-buffer buf) 298 (let ((inhibit-read-only t)) 299 (erase-buffer)) 300 (insert str) 301 (denote-refs--remove))) 302 303 ;;;###autoload 304 (define-minor-mode denote-refs-mode 305 "Toggle showing links and backlinks in Denote notes." 306 :lighter " Denote-Refs" 307 (let ((locals '(denote-refs--links denote-refs--backlinks))) 308 (if denote-refs-mode 309 (progn 310 (mapc #'make-local-variable locals) 311 (denote-refs--show) 312 (add-hook 'write-region-annotate-functions 313 #'denote-refs--before-write-region nil t) 314 (add-hook 'org-capture-prepare-finalize-hook 315 #'denote-refs--remove nil t) 316 ;; This runs just once, so we don't bother to keep track of 317 ;; it. ;) 318 (run-with-idle-timer 319 (car denote-refs-update-delay) nil 320 #'denote-refs--idle-update (current-buffer)) 321 (advice-add #'xref--collect-matches :around 322 #'denote-refs--fix-xref--collect-matches) 323 ;; This timer takes care of reverting the advice and also 324 ;; canceling the timer itself. 325 (when denote-refs--schedule-idle-update-timer 326 (cancel-timer denote-refs--schedule-idle-update-timer)) 327 (setq denote-refs--schedule-idle-update-timer 328 (run-with-idle-timer 329 (min (cadr denote-refs-update-delay) 330 (caddr denote-refs-update-delay)) 331 t #'denote-refs--schedule-idle-update))) 332 (denote-refs--remove) 333 (remove-hook 'before-save-hook #'denote-refs--remove t) 334 (remove-hook 'after-save-hook #'denote-refs--show t) 335 (remove-hook 'org-capture-prepare-finalize-hook 336 #'denote-refs--remove t) 337 (mapc #'kill-local-variable locals)))) 338 339 (provide 'denote-refs) 340 ;;; denote-refs.el ends here