org-roam-mode.el (28441B)
1 ;;; org-roam-mode.el --- Major mode for special Org-roam buffers -*- lexical-binding: t -*- 2 3 ;; Copyright © 2020-2022 Jethro Kuan <jethrokuan95@gmail.com> 4 5 ;; Author: Jethro Kuan <jethrokuan95@gmail.com> 6 ;; URL: https://github.com/org-roam/org-roam 7 ;; Keywords: org-mode, roam, convenience 8 ;; Version: 2.2.2 9 ;; Package-Requires: ((emacs "26.1") (dash "2.13") (org "9.4") (emacsql "3.0.0") (emacsql-sqlite "1.0.0") (magit-section "3.0.0")) 10 11 ;; This file is NOT part of GNU Emacs. 12 13 ;; This program is free software; you can redistribute it and/or modify 14 ;; it under the terms of the GNU General Public License as published by 15 ;; the Free Software Foundation; either version 3, or (at your option) 16 ;; any later version. 17 ;; 18 ;; This program is distributed in the hope that it will be useful, 19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 21 ;; GNU General Public License for more details. 22 ;; 23 ;; You should have received a copy of the GNU General Public License 24 ;; along with GNU Emacs; see the file COPYING. If not, write to the 25 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 26 ;; Boston, MA 02110-1301, USA. 27 28 ;;; Commentary: 29 ;; 30 ;; This module implements `org-roam-mode', which is a major mode that used by 31 ;; special Org-roam buffers to display various content in a section-like manner 32 ;; about the nodes and relevant to them information (e.g. backlinks) with which 33 ;; the user can interact with. 34 ;; 35 ;;; Code: 36 (require 'org-roam) 37 38 ;;;; Declarations 39 (defvar org-ref-buffer-hacked) 40 41 ;;; Options 42 (defcustom org-roam-mode-sections (list #'org-roam-backlinks-section 43 #'org-roam-reflinks-section) 44 "A list of sections for the `org-roam-mode' based buffers. 45 Each section is a function that is passed the an `org-roam-node' 46 for which the section will be constructed for as the first 47 argument. Normally this node is `org-roam-buffer-current-node'. 48 The function may also accept other optional arguments. Each item 49 in the list is either: 50 51 1. A function, which is called only with the `org-roam-node' as the argument 52 2. A list, containing the function and the optional arguments. 53 54 For example, one can add 55 56 (org-roam-backlinks-section :unique t) 57 58 to the list to pass :unique t to the section-rendering function." 59 :group 'org-roam 60 :type `(repeat (choice (symbol :tag "Function") 61 (list :tag "Function with arguments" 62 (symbol :tag "Function") 63 (repeat :tag "Arguments" :inline t (sexp :tag "Arg")))))) 64 65 (defcustom org-roam-buffer-postrender-functions (list) 66 "Functions to run after the Org-roam buffer is rendered. 67 Each function accepts no arguments, and is run with the Org-roam 68 buffer as the current buffer." 69 :group 'org-roam 70 :type 'hook) 71 72 (defcustom org-roam-preview-function #'org-roam-preview-default-function 73 "The preview function to use to populate the Org-roam buffer. 74 75 The function takes no arguments, but the point is temporarily set 76 to the exact location of the backlink." 77 :group 'org-roam 78 :type 'function) 79 80 (defcustom org-roam-preview-postprocess-functions (list #'org-roam-strip-comments) 81 "A list of functions to postprocess the preview content. 82 83 Each function takes a single argument, the string for the preview 84 content, and returns the post-processed string. The functions are 85 applied in order of appearance in the list." 86 :group 'org-roam 87 :type 'hook) 88 89 ;;; Faces 90 (defface org-roam-header-line 91 `((((class color) (background light)) 92 ,@(and (>= emacs-major-version 27) '(:extend t)) 93 :foreground "DarkGoldenrod4" 94 :weight bold) 95 (((class color) (background dark)) 96 ,@(and (>= emacs-major-version 27) '(:extend t)) 97 :foreground "LightGoldenrod2" 98 :weight bold)) 99 "Face for the `header-line' in some Org-roam modes." 100 :group 'org-roam-faces) 101 102 (defface org-roam-title 103 '((t :weight bold)) 104 "Face for Org-roam titles." 105 :group 'org-roam-faces) 106 107 (defface org-roam-olp 108 '((((class color) (background light)) :foreground "grey60") 109 (((class color) (background dark)) :foreground "grey40")) 110 "Face for the OLP of the node." 111 :group 'org-roam-faces) 112 113 (defface org-roam-preview-heading 114 `((((class color) (background light)) 115 ,@(and (>= emacs-major-version 27) '(:extend t)) 116 :background "grey80" 117 :foreground "grey30") 118 (((class color) (background dark)) 119 ,@(and (>= emacs-major-version 27) '(:extend t)) 120 :background "grey25" 121 :foreground "grey70")) 122 "Face for preview headings." 123 :group 'org-roam-faces) 124 125 (defface org-roam-preview-heading-highlight 126 `((((class color) (background light)) 127 ,@(and (>= emacs-major-version 27) '(:extend t)) 128 :background "grey75" 129 :foreground "grey30") 130 (((class color) (background dark)) 131 ,@(and (>= emacs-major-version 27) '(:extend t)) 132 :background "grey35" 133 :foreground "grey70")) 134 "Face for current preview headings." 135 :group 'org-roam-faces) 136 137 (defface org-roam-preview-heading-selection 138 `((((class color) (background light)) 139 ,@(and (>= emacs-major-version 27) '(:extend t)) 140 :inherit org-roam-preview-heading-highlight 141 :foreground "salmon4") 142 (((class color) (background dark)) 143 ,@(and (>= emacs-major-version 27) '(:extend t)) 144 :inherit org-roam-preview-heading-highlight 145 :foreground "LightSalmon3")) 146 "Face for selected preview headings." 147 :group 'org-roam-faces) 148 149 (defface org-roam-preview-region 150 `((t :inherit bold 151 ,@(and (>= emacs-major-version 27) 152 (list :extend (ignore-errors (face-attribute 'region :extend)))))) 153 "Face used by `org-roam-highlight-preview-region-using-face'. 154 155 This face is overlaid over text that uses other hunk faces, 156 and those normally set the foreground and background colors. 157 The `:foreground' and especially the `:background' properties 158 should be avoided here. Setting the latter would cause the 159 loss of information. Good properties to set here are `:weight' 160 and `:slant'." 161 :group 'org-roam-faces) 162 163 (defface org-roam-dim 164 '((((class color) (background light)) :foreground "grey60") 165 (((class color) (background dark)) :foreground "grey40")) 166 "Face for the dimmer part of the widgets." 167 :group 'org-roam-faces) 168 169 ;;; Major mode 170 (defvar org-roam-mode-map 171 (let ((map (make-sparse-keymap))) 172 (set-keymap-parent map magit-section-mode-map) 173 (define-key map [C-return] 'org-roam-buffer-visit-thing) 174 (define-key map (kbd "C-m") 'org-roam-buffer-visit-thing) 175 (define-key map [remap revert-buffer] 'org-roam-buffer-refresh) 176 map) 177 "Parent keymap for all keymaps of modes derived from `org-roam-mode'.") 178 179 (define-derived-mode org-roam-mode magit-section-mode "Org-roam" 180 "Major mode for displaying relevant information about Org-roam nodes. 181 This mode is used by special Org-roam buffers, such as persistent 182 `org-roam-buffer' and dedicated Org-roam buffers 183 \(`org-roam-buffer-display-dedicated'), which render the 184 information in a section-like manner (see 185 `org-roam-mode-sections'), with which the user can 186 interact with." 187 :group 'org-roam 188 (face-remap-add-relative 'header-line 'org-roam-header-line)) 189 190 ;;; Buffers 191 (defvar org-roam-buffer-current-node nil 192 "The node for which an `org-roam-mode' based buffer displays its contents. 193 This set both, locally and globally. Normally the local value is 194 only set in the `org-roam-mode' based buffers, while the global 195 value shows the current node in the persistent `org-roam-buffer'.") 196 197 (put 'org-roam-buffer-current-node 'permanent-local t) 198 199 (defvar org-roam-buffer-current-directory nil 200 "The `org-roam-directory' value of `org-roam-buffer-current-node'. 201 Set both, locally and globally in the same way as 202 `org-roam-buffer-current-node'.") 203 204 (put 'org-roam-buffer-current-directory 'permanent-local t) 205 206 ;;;; Library 207 (defun org-roam-buffer-visit-thing () 208 "This is a placeholder command. 209 Where applicable, section-specific keymaps bind another command 210 which visits the thing at point." 211 (interactive) 212 (user-error "There is no thing at point that could be visited")) 213 214 (defun org-roam-buffer-file-at-point (&optional assert) 215 "Return the file at point in the current `org-roam-mode' based buffer. 216 If ASSERT, throw an error." 217 (if-let ((file (magit-section-case 218 (org-roam-node-section (org-roam-node-file (oref it node))) 219 (org-roam-grep-section (oref it file)) 220 (org-roam-preview-section (oref it file)) 221 (t (cl-assert (derived-mode-p 'org-roam-mode)))))) 222 file 223 (when assert 224 (user-error "No file at point")))) 225 226 (defun org-roam-buffer-refresh () 227 "Refresh the contents of the currently selected Org-roam buffer." 228 (interactive) 229 (cl-assert (derived-mode-p 'org-roam-mode)) 230 (save-excursion (org-roam-buffer-render-contents))) 231 232 (defun org-roam-buffer-render-contents () 233 "Recompute and render the contents of an Org-roam buffer. 234 Assumes that the current buffer is an `org-roam-mode' based 235 buffer." 236 (let ((inhibit-read-only t)) 237 (erase-buffer) 238 (org-roam-mode) 239 (setq-local default-directory org-roam-buffer-current-directory) 240 (setq-local org-roam-directory org-roam-buffer-current-directory) 241 (org-roam-buffer-set-header-line-format 242 (org-roam-node-title org-roam-buffer-current-node)) 243 (magit-insert-section (org-roam) 244 (magit-insert-heading) 245 (dolist (section org-roam-mode-sections) 246 (pcase section 247 ((pred functionp) 248 (funcall section org-roam-buffer-current-node)) 249 (`(,fn . ,args) 250 (apply fn (cons org-roam-buffer-current-node args))) 251 (_ 252 (user-error "Invalid `org-roam-mode-sections' specification"))))) 253 (run-hooks 'org-roam-buffer-postrender-functions) 254 (goto-char 0))) 255 256 (defun org-roam-buffer-set-header-line-format (string) 257 "Set the header-line using STRING. 258 If the `face' property of any part of STRING is already set, then 259 that takes precedence. Also pad the left side of STRING so that 260 it aligns with the text area." 261 (setq-local header-line-format 262 (concat (propertize " " 'display '(space :align-to 0)) 263 string))) 264 265 ;;;; Dedicated buffer 266 ;;;###autoload 267 (defun org-roam-buffer-display-dedicated (node) 268 "Launch NODE dedicated Org-roam buffer. 269 Unlike the persistent `org-roam-buffer', the contents of this 270 buffer won't be automatically changed and will be held in place. 271 272 In interactive calls prompt to select NODE, unless called with 273 `universal-argument', in which case NODE will be set to 274 `org-roam-node-at-point'." 275 (interactive 276 (list (if current-prefix-arg 277 (org-roam-node-at-point 'assert) 278 (org-roam-node-read nil nil nil 'require-match)))) 279 (let ((buffer (get-buffer-create (org-roam-buffer--dedicated-name node)))) 280 (with-current-buffer buffer 281 (setq-local org-roam-buffer-current-node node) 282 (setq-local org-roam-buffer-current-directory org-roam-directory) 283 (org-roam-buffer-render-contents)) 284 (display-buffer buffer))) 285 286 (defun org-roam-buffer--dedicated-name (node) 287 "Construct buffer name for NODE dedicated Org-roam buffer." 288 (let ((title (org-roam-node-title node)) 289 (filename (file-relative-name (org-roam-node-file node) org-roam-directory))) 290 (format "*org-roam: %s<%s>*" title filename))) 291 292 (defun org-roam-buffer-dedicated-p (&optional buffer) 293 "Return t if an Org-roam BUFFER is a node dedicated one. 294 See `org-roam-buffer-display-dedicated' for more details. 295 If BUFFER is nil, default it to `current-buffer'." 296 (or buffer (setq buffer (current-buffer))) 297 (string-match-p (concat "^" (regexp-quote "*org-roam: ")) 298 (buffer-name buffer))) 299 300 ;;;; Persistent buffer 301 (defvar org-roam-buffer "*org-roam*" 302 "The persistent Org-roam buffer name. Must be surround with \"*\". 303 The content inside of this buffer will be automatically updated 304 to the nearest node at point that comes from the current buffer. 305 To toggle its display use `org-roam-buffer-toggle' command.") 306 307 (defun org-roam-buffer-toggle () 308 "Toggle display of the persistent `org-roam-buffer'." 309 (interactive) 310 (pcase (org-roam-buffer--visibility) 311 ('visible 312 (progn 313 (quit-window nil (get-buffer-window org-roam-buffer)) 314 (remove-hook 'post-command-hook #'org-roam-buffer--redisplay-h))) 315 ((or 'exists 'none) 316 (progn 317 (display-buffer (get-buffer-create org-roam-buffer)) 318 (org-roam-buffer-persistent-redisplay))))) 319 320 (define-inline org-roam-buffer--visibility () 321 "Return the current visibility state of the persistent `org-roam-buffer'. 322 Valid states are 'visible, 'exists and 'none." 323 (declare (side-effect-free t)) 324 (inline-quote 325 (cond 326 ((get-buffer-window org-roam-buffer) 'visible) 327 ((get-buffer org-roam-buffer) 'exists) 328 (t 'none)))) 329 330 (defun org-roam-buffer-persistent-redisplay () 331 "Recompute contents of the persistent `org-roam-buffer'. 332 Has no effect when there's no `org-roam-node-at-point'." 333 (when-let ((node (org-roam-node-at-point))) 334 (unless (equal node org-roam-buffer-current-node) 335 (setq org-roam-buffer-current-node node 336 org-roam-buffer-current-directory org-roam-directory) 337 (with-current-buffer (get-buffer-create org-roam-buffer) 338 (org-roam-buffer-render-contents) 339 (add-hook 'kill-buffer-hook #'org-roam-buffer--persistent-cleanup-h nil t))))) 340 341 (defun org-roam-buffer--persistent-cleanup-h () 342 "Clean-up global state that's dedicated for the persistent `org-roam-buffer'." 343 (setq-default org-roam-buffer-current-node nil 344 org-roam-buffer-current-directory nil)) 345 346 (add-hook 'org-roam-find-file-hook #'org-roam-buffer--setup-redisplay-h) 347 (defun org-roam-buffer--setup-redisplay-h () 348 "Setup automatic redisplay of the persistent `org-roam-buffer'." 349 (add-hook 'post-command-hook #'org-roam-buffer--redisplay-h nil t)) 350 351 (defun org-roam-buffer--redisplay-h () 352 "Reconstruct the persistent `org-roam-buffer'. 353 This needs to be quick or infrequent, because this designed to 354 run at `post-command-hook'." 355 (and (get-buffer-window org-roam-buffer) 356 (org-roam-buffer-persistent-redisplay))) 357 358 ;;; Sections 359 ;;;; Node 360 (defvar org-roam-node-map 361 (let ((map (make-sparse-keymap))) 362 (set-keymap-parent map org-roam-mode-map) 363 (define-key map [remap org-roam-buffer-visit-thing] 'org-roam-node-visit) 364 map) 365 "Keymap for `org-roam-node-section's.") 366 367 (defclass org-roam-node-section (magit-section) 368 ((keymap :initform 'org-roam-node-map) 369 (node :initform nil)) 370 "A `magit-section' used by `org-roam-mode' to outline NODE in its own heading.") 371 372 (cl-defun org-roam-node-insert-section (&key source-node point properties) 373 "Insert section for a link from SOURCE-NODE to some other node. 374 The other node is normally `org-roam-buffer-current-node'. 375 376 SOURCE-NODE is an `org-roam-node' that links or references with 377 the other node. 378 379 POINT is a character position where the link is located in 380 SOURCE-NODE's file. 381 382 PROPERTIES (a plist) contains additional information about the 383 link. 384 385 Despite the name, this function actually inserts 2 sections at 386 the same time: 387 388 1. `org-roam-node-section' for a heading that describes 389 SOURCE-NODE. Acts as a parent section of the following one. 390 391 2. `org-roam-preview-section' for a preview content that comes 392 from SOURCE-NODE's file for the link (that references the 393 other node) at POINT. Acts a child section of the previous 394 one." 395 (magit-insert-section section (org-roam-node-section) 396 (let ((outline (if-let ((outline (plist-get properties :outline))) 397 (mapconcat #'org-link-display-format outline " > ") 398 "Top"))) 399 (insert (concat (propertize (org-roam-node-title source-node) 400 'font-lock-face 'org-roam-title) 401 (format " (%s)" 402 (propertize outline 'font-lock-face 'org-roam-olp))))) 403 (magit-insert-heading) 404 (oset section node source-node) 405 (magit-insert-section section (org-roam-preview-section) 406 (insert (org-roam-fontify-like-in-org-mode 407 (org-roam-preview-get-contents (org-roam-node-file source-node) point)) 408 "\n") 409 (oset section file (org-roam-node-file source-node)) 410 (oset section point point) 411 (insert ?\n)))) 412 413 ;;;; Preview 414 (defvar org-roam-preview-map 415 (let ((map (make-sparse-keymap))) 416 (set-keymap-parent map org-roam-mode-map) 417 (define-key map [remap org-roam-buffer-visit-thing] 'org-roam-preview-visit) 418 map) 419 "Keymap for `org-roam-preview-section's.") 420 421 (defclass org-roam-preview-section (magit-section) 422 ((keymap :initform 'org-roam-preview-map) 423 (file :initform nil) 424 (point :initform nil)) 425 "A `magit-section' used by `org-roam-mode' to contain preview content. 426 The preview content comes from FILE, and the link as at POINT.") 427 428 (defun org-roam-preview-visit (file point &optional other-window) 429 "Visit FILE at POINT and return the visited buffer. 430 With OTHER-WINDOW non-nil do so in another window. 431 In interactive calls OTHER-WINDOW is set with 432 `universal-argument'." 433 (interactive (list (org-roam-buffer-file-at-point 'assert) 434 (oref (magit-current-section) point) 435 current-prefix-arg)) 436 (let ((buf (find-file-noselect file)) 437 (display-buffer-fn (if other-window 438 #'switch-to-buffer-other-window 439 #'pop-to-buffer-same-window))) 440 (funcall display-buffer-fn buf) 441 (with-current-buffer buf 442 (widen) 443 (goto-char point)) 444 (when (org-invisible-p) (org-show-context)) 445 buf)) 446 447 (defun org-roam-preview-default-function () 448 "Return the preview content at point. 449 450 This function returns the all contents under the current 451 headline, up to the next headline." 452 (let ((beg (save-excursion 453 (org-roam-end-of-meta-data t) 454 (point))) 455 (end (save-excursion 456 (org-next-visible-heading 1) 457 (point)))) 458 (string-trim (buffer-substring-no-properties beg end)))) 459 460 (defun org-roam-preview-get-contents (file pt) 461 "Get preview content for FILE at PT." 462 (save-excursion 463 (org-roam-with-temp-buffer file 464 (org-with-wide-buffer 465 (goto-char pt) 466 (let ((s (funcall org-roam-preview-function))) 467 (dolist (fn org-roam-preview-postprocess-functions) 468 (setq s (funcall fn s))) 469 s))))) 470 471 ;;;; Backlinks 472 (cl-defstruct (org-roam-backlink (:constructor org-roam-backlink-create) 473 (:copier nil)) 474 source-node target-node 475 point properties) 476 477 (cl-defmethod org-roam-populate ((backlink org-roam-backlink)) 478 "Populate BACKLINK from database." 479 (setf (org-roam-backlink-source-node backlink) 480 (org-roam-populate (org-roam-backlink-source-node backlink)) 481 (org-roam-backlink-target-node backlink) 482 (org-roam-populate (org-roam-backlink-target-node backlink))) 483 backlink) 484 485 (cl-defun org-roam-backlinks-get (node &key unique) 486 "Return the backlinks for NODE. 487 488 When UNIQUE is nil, show all positions where references are found. 489 When UNIQUE is t, limit to unique sources." 490 (let* ((sql (if unique 491 [:select :distinct [source dest pos properties] 492 :from links 493 :where (= dest $s1) 494 :and (= type "id") 495 :group :by source 496 :having (funcall min pos)] 497 [:select [source dest pos properties] 498 :from links 499 :where (= dest $s1) 500 :and (= type "id")])) 501 (backlinks (org-roam-db-query sql (org-roam-node-id node)))) 502 (cl-loop for backlink in backlinks 503 collect (pcase-let ((`(,source-id ,dest-id ,pos ,properties) backlink)) 504 (org-roam-populate 505 (org-roam-backlink-create 506 :source-node (org-roam-node-create :id source-id) 507 :target-node (org-roam-node-create :id dest-id) 508 :point pos 509 :properties properties)))))) 510 511 (defun org-roam-backlinks-sort (a b) 512 "Default sorting function for backlinks A and B. 513 Sorts by title." 514 (string< (org-roam-node-title (org-roam-backlink-source-node a)) 515 (org-roam-node-title (org-roam-backlink-source-node b)))) 516 517 (cl-defun org-roam-backlinks-section (node &key (unique nil) (show-backlink-p nil)) 518 "The backlinks section for NODE. 519 520 When UNIQUE is nil, show all positions where references are found. 521 When UNIQUE is t, limit to unique sources. 522 523 When SHOW-BACKLINK-P is not null, only show backlinks for which 524 this predicate is not nil." 525 (when-let ((backlinks (seq-sort #'org-roam-backlinks-sort (org-roam-backlinks-get node :unique unique)))) 526 (magit-insert-section (org-roam-backlinks) 527 (magit-insert-heading "Backlinks:") 528 (dolist (backlink backlinks) 529 (when (or (null show-backlink-p) 530 (and (not (null show-backlink-p)) 531 (funcall show-backlink-p backlink))) 532 (org-roam-node-insert-section 533 :source-node (org-roam-backlink-source-node backlink) 534 :point (org-roam-backlink-point backlink) 535 :properties (org-roam-backlink-properties backlink)))) 536 (insert ?\n)))) 537 538 ;;;; Reflinks 539 (cl-defstruct (org-roam-reflink (:constructor org-roam-reflink-create) 540 (:copier nil)) 541 source-node ref 542 point properties) 543 544 (cl-defmethod org-roam-populate ((reflink org-roam-reflink)) 545 "Populate REFLINK from database." 546 (setf (org-roam-reflink-source-node reflink) 547 (org-roam-populate (org-roam-reflink-source-node reflink))) 548 reflink) 549 550 (defun org-roam-reflinks-get (node) 551 "Return the reflinks for NODE." 552 (let ((refs (org-roam-db-query [:select :distinct [refs:ref links:source links:pos links:properties] 553 :from refs 554 :left-join links 555 :where (= refs:node-id $s1) 556 :and (= links:dest refs:ref) 557 :union 558 :select :distinct [refs:ref citations:node-id 559 citations:pos citations:properties] 560 :from refs 561 :left-join citations 562 :where (= refs:node-id $s1) 563 :and (= citations:cite-key refs:ref)] 564 (org-roam-node-id node))) 565 links) 566 (pcase-dolist (`(,ref ,source-id ,pos ,properties) refs) 567 (push (org-roam-populate 568 (org-roam-reflink-create 569 :source-node (org-roam-node-create :id source-id) 570 :ref ref 571 :point pos 572 :properties properties)) links)) 573 links)) 574 575 (defun org-roam-reflinks-sort (a b) 576 "Default sorting function for reflinks A and B. 577 Sorts by title." 578 (string< (org-roam-node-title (org-roam-reflink-source-node a)) 579 (org-roam-node-title (org-roam-reflink-source-node b)))) 580 581 (defun org-roam-reflinks-section (node) 582 "The reflinks section for NODE." 583 (when-let ((refs (org-roam-node-refs node)) 584 (reflinks (seq-sort #'org-roam-reflinks-sort (org-roam-reflinks-get node)))) 585 (magit-insert-section (org-roam-reflinks) 586 (magit-insert-heading "Reflinks:") 587 (dolist (reflink reflinks) 588 (org-roam-node-insert-section 589 :source-node (org-roam-reflink-source-node reflink) 590 :point (org-roam-reflink-point reflink) 591 :properties (org-roam-reflink-properties reflink))) 592 (insert ?\n)))) 593 594 ;;;; Grep 595 (defvar org-roam-grep-map 596 (let ((map (make-sparse-keymap))) 597 (set-keymap-parent map org-roam-mode-map) 598 (define-key map [remap org-roam-buffer-visit-thing] 'org-roam-grep-visit) 599 map) 600 "Keymap for Org-roam grep result sections.") 601 602 (defclass org-roam-grep-section (magit-section) 603 ((keymap :initform 'org-roam-grep-map) 604 (file :initform nil) 605 (row :initform nil) 606 (col :initform nil)) 607 "A `magit-section' used by `org-roam-mode' to contain grep output.") 608 609 (defun org-roam-grep-visit (file &optional other-window row col) 610 "Visit FILE at row ROW (if any) and column COL (if any). Return the buffer. 611 With OTHER-WINDOW non-nil (in interactive calls set with 612 `universal-argument') display the buffer in another window 613 instead." 614 (interactive (list (org-roam-buffer-file-at-point t) 615 current-prefix-arg 616 (oref (magit-current-section) row) 617 (oref (magit-current-section) col))) 618 (let ((buf (find-file-noselect file)) 619 (display-buffer-fn (if other-window 620 #'switch-to-buffer-other-window 621 #'pop-to-buffer-same-window))) 622 (funcall display-buffer-fn buf) 623 (with-current-buffer buf 624 (widen) 625 (goto-char (point-min)) 626 (when row 627 (forward-line (1- row))) 628 (when col 629 (forward-char (1- col)))) 630 (when (org-invisible-p) (org-show-context)) 631 buf)) 632 633 ;;;; Unlinked references 634 (defvar org-roam-unlinked-references-result-re 635 (rx (group (one-or-more anything)) 636 ":" 637 (group (one-or-more digit)) 638 ":" 639 (group (one-or-more digit)) 640 ":" 641 (group (zero-or-more anything))) 642 "Regex for the return result of a ripgrep query.") 643 644 (defun org-roam-unlinked-references-preview-line (file row) 645 "Return the preview line from FILE. 646 This is the ROW within FILE." 647 (with-temp-buffer 648 (insert-file-contents file) 649 (forward-line (1- row)) 650 (buffer-substring-no-properties 651 (save-excursion 652 (beginning-of-line) 653 (point)) 654 (save-excursion 655 (end-of-line) 656 (point))))) 657 658 (defun org-roam-unlinked-references-section (node) 659 "The unlinked references section for NODE. 660 References from FILE are excluded." 661 (when (and (executable-find "rg") 662 (org-roam-node-title node) 663 (not (string-match "PCRE2 is not available" 664 (shell-command-to-string "rg --pcre2-version")))) 665 (let* ((titles (cons (org-roam-node-title node) 666 (org-roam-node-aliases node))) 667 (rg-command (concat "rg -L -o --vimgrep -P -i " 668 (mapconcat (lambda (glob) (concat "-g " glob)) 669 (org-roam--list-files-search-globs org-roam-file-extensions) 670 " ") 671 (format " '\\[([^[]]++|(?R))*\\]%s' " 672 (mapconcat (lambda (title) 673 (format "|(\\b%s\\b)" (shell-quote-argument title))) 674 titles "")) 675 org-roam-directory)) 676 (results (split-string (shell-command-to-string rg-command) "\n")) 677 f row col match) 678 (magit-insert-section (unlinked-references) 679 (magit-insert-heading "Unlinked References:") 680 (dolist (line results) 681 (save-match-data 682 (when (string-match org-roam-unlinked-references-result-re line) 683 (setq f (match-string 1 line) 684 row (string-to-number (match-string 2 line)) 685 col (string-to-number (match-string 3 line)) 686 match (match-string 4 line)) 687 (when (and match 688 (not (file-equal-p (org-roam-node-file node) f)) 689 (member (downcase match) (mapcar #'downcase titles))) 690 (magit-insert-section section (org-roam-grep-section) 691 (oset section file f) 692 (oset section row row) 693 (oset section col col) 694 (insert (propertize (format "%s:%s:%s" 695 (truncate-string-to-width (file-name-base f) 15 nil nil t) 696 row col) 'font-lock-face 'org-roam-dim) 697 " " 698 (org-roam-fontify-like-in-org-mode 699 (org-roam-unlinked-references-preview-line f row)) 700 "\n")))))) 701 (insert ?\n))))) 702 703 (provide 'org-roam-mode) 704 ;;; org-roam-mode.el ends here