mirror of
https://github.com/org-roam/org-roam
synced 2025-08-01 12:17:21 -05:00
Detangle the codebase and change how dependencies are resolved to allow the package to better modularize and load itself without introducing circular dependencies, especially when autoloads involved.
684 lines
27 KiB
EmacsLisp
684 lines
27 KiB
EmacsLisp
;;; org-roam-mode.el --- Major mode for special Org-roam buffers -*- lexical-binding: t -*-
|
|
|
|
;; Copyright © 2020-2021 Jethro Kuan <jethrokuan95@gmail.com>
|
|
|
|
;; Author: Jethro Kuan <jethrokuan95@gmail.com>
|
|
;; URL: https://github.com/org-roam/org-roam
|
|
;; Keywords: org-mode, roam, convenience
|
|
;; Version: 2.0.0
|
|
;; Package-Requires: ((emacs "26.1") (dash "2.13") (f "0.17.2") (org "9.4") (emacsql "3.0.0") (emacsql-sqlite "1.0.0") (magit-section "2.90.1"))
|
|
|
|
;; This file is NOT part of GNU Emacs.
|
|
|
|
;; This program is free software; you can redistribute it and/or modify
|
|
;; it under the terms of the GNU General Public License as published by
|
|
;; the Free Software Foundation; either version 3, or (at your option)
|
|
;; any later version.
|
|
;;
|
|
;; This program is distributed in the hope that it will be useful,
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;; GNU General Public License for more details.
|
|
;;
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with GNU Emacs; see the file COPYING. If not, write to the
|
|
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
|
;; Boston, MA 02110-1301, USA.
|
|
|
|
;;; Commentary:
|
|
;;
|
|
;; This module implements `org-roam-mode', which is a major mode that used by
|
|
;; special Org-roam buffers to display various content in a section-like manner
|
|
;; about the nodes and relevant to them information (e.g. backlinks) with which
|
|
;; the user can interact with.
|
|
;;
|
|
;;; Code:
|
|
(require 'org-roam)
|
|
|
|
;;;; Declarations
|
|
(defvar org-ref-buffer-hacked)
|
|
|
|
;;; Options
|
|
(defcustom org-roam-mode-section-functions (list #'org-roam-backlinks-section
|
|
#'org-roam-reflinks-section)
|
|
"Functions that insert sections in the `org-roam-mode' based buffers.
|
|
Each function is called with one argument, which is an
|
|
`org-roam-node' for which the buffer will be constructed for.
|
|
Normally this node is `org-roam-buffer-current-node'."
|
|
:group 'org-roam
|
|
:type 'hook)
|
|
|
|
;;; Faces
|
|
(defface org-roam-header-line
|
|
`((((class color) (background light))
|
|
,@(and (>= emacs-major-version 27) '(:extend t))
|
|
:foreground "DarkGoldenrod4"
|
|
:weight bold)
|
|
(((class color) (background dark))
|
|
,@(and (>= emacs-major-version 27) '(:extend t))
|
|
:foreground "LightGoldenrod2"
|
|
:weight bold))
|
|
"Face for the `header-line' in some Org-roam modes."
|
|
:group 'org-roam-faces)
|
|
|
|
(defface org-roam-title
|
|
'((t :weight bold))
|
|
"Face for Org-roam titles."
|
|
:group 'org-roam-faces)
|
|
|
|
(defface org-roam-olp
|
|
'((((class color) (background light)) :foreground "grey60")
|
|
(((class color) (background dark)) :foreground "grey40"))
|
|
"Face for the OLP of the node."
|
|
:group 'org-roam-faces)
|
|
|
|
(defface org-roam-preview-heading
|
|
`((((class color) (background light))
|
|
,@(and (>= emacs-major-version 27) '(:extend t))
|
|
:background "grey80"
|
|
:foreground "grey30")
|
|
(((class color) (background dark))
|
|
,@(and (>= emacs-major-version 27) '(:extend t))
|
|
:background "grey25"
|
|
:foreground "grey70"))
|
|
"Face for preview headings."
|
|
:group 'org-roam-faces)
|
|
|
|
(defface org-roam-preview-heading-highlight
|
|
`((((class color) (background light))
|
|
,@(and (>= emacs-major-version 27) '(:extend t))
|
|
:background "grey75"
|
|
:foreground "grey30")
|
|
(((class color) (background dark))
|
|
,@(and (>= emacs-major-version 27) '(:extend t))
|
|
:background "grey35"
|
|
:foreground "grey70"))
|
|
"Face for current preview headings."
|
|
:group 'org-roam-faces)
|
|
|
|
(defface org-roam-preview-heading-selection
|
|
`((((class color) (background light))
|
|
,@(and (>= emacs-major-version 27) '(:extend t))
|
|
:inherit org-roam-preview-heading-highlight
|
|
:foreground "salmon4")
|
|
(((class color) (background dark))
|
|
,@(and (>= emacs-major-version 27) '(:extend t))
|
|
:inherit org-roam-preview-heading-highlight
|
|
:foreground "LightSalmon3"))
|
|
"Face for selected preview headings."
|
|
:group 'org-roam-faces)
|
|
|
|
(defface org-roam-preview-region
|
|
`((t :inherit bold
|
|
,@(and (>= emacs-major-version 27)
|
|
(list :extend (ignore-errors (face-attribute 'region :extend))))))
|
|
"Face used by `org-roam-highlight-preview-region-using-face'.
|
|
|
|
This face is overlaid over text that uses other hunk faces,
|
|
and those normally set the foreground and background colors.
|
|
The `:foreground' and especially the `:background' properties
|
|
should be avoided here. Setting the latter would cause the
|
|
loss of information. Good properties to set here are `:weight'
|
|
and `:slant'."
|
|
:group 'org-roam-faces)
|
|
|
|
(defface org-roam-dim
|
|
'((((class color) (background light)) :foreground "grey60")
|
|
(((class color) (background dark)) :foreground "grey40"))
|
|
"Face for the dimmer part of the widgets."
|
|
:group 'org-roam-faces)
|
|
|
|
;;; Major mode
|
|
(defvar org-roam-mode-map
|
|
(let ((map (make-sparse-keymap)))
|
|
(set-keymap-parent map magit-section-mode-map)
|
|
(define-key map [C-return] 'org-roam-buffer-visit-thing)
|
|
(define-key map (kbd "C-m") 'org-roam-buffer-visit-thing)
|
|
(define-key map [remap revert-buffer] 'org-roam-buffer-refresh)
|
|
map)
|
|
"Parent keymap for all keymaps of modes derived from `org-roam-mode'.")
|
|
|
|
(define-derived-mode org-roam-mode magit-section-mode "Org-roam"
|
|
"Major mode for displaying relevant information about Org-roam nodes.
|
|
This mode is used by special Org-roam buffers, such as persistent
|
|
`org-roam-buffer' and dedicated Org-roam buffers
|
|
\(`org-roam-buffer-display-dedicated'), which render the
|
|
information in a section-like manner (see
|
|
`org-roam-mode-section-functions'), with which the user can
|
|
interact with."
|
|
:group 'org-roam
|
|
(face-remap-add-relative 'header-line 'org-roam-header-line))
|
|
|
|
;;; Buffers
|
|
(defvar org-roam-buffer-current-node nil
|
|
"The node for which an `org-roam-mode' based buffer displays its contents.
|
|
This set both, locally and globally. Normally the local value is
|
|
only set in the `org-roam-mode' based buffers, while the global
|
|
value shows the current node in the persistent `org-roam-buffer'.")
|
|
|
|
(put 'org-roam-buffer-current-node 'permanent-local t)
|
|
|
|
(defvar org-roam-buffer-current-directory nil
|
|
"The `org-roam-directory' value of `org-roam-buffer-current-node'.
|
|
Set both, locally and globally in the same way as `org-roam-buffer-current-node'.")
|
|
|
|
(put 'org-roam-buffer-current-directory 'permanent-local t)
|
|
|
|
;;;; Library
|
|
(defun org-roam-buffer-visit-thing ()
|
|
"This is a placeholder command.
|
|
Where applicable, section-specific keymaps bind another command
|
|
which visits the thing at point."
|
|
(interactive)
|
|
(user-error "There is no thing at point that could be visited"))
|
|
|
|
(defun org-roam-buffer-file-at-point (&optional assert)
|
|
"Return the file at point in the current `org-roam-mode' based buffer.
|
|
If ASSERT, throw an error."
|
|
(if-let ((file (magit-section-case
|
|
(org-roam-node-section (org-roam-node-file (oref it node)))
|
|
(org-roam-grep-section (oref it file))
|
|
(org-roam-preview-section (oref it file))
|
|
(t (cl-assert (derived-mode-p 'org-roam-mode))))))
|
|
file
|
|
(when assert
|
|
(user-error "No file at point"))))
|
|
|
|
(defun org-roam-buffer-refresh ()
|
|
"Refresh the contents of the currently selected Org-roam buffer."
|
|
(interactive)
|
|
(cl-assert (derived-mode-p 'org-roam-mode))
|
|
(save-excursion (org-roam-buffer-render-contents)))
|
|
|
|
(defun org-roam-buffer-render-contents ()
|
|
"Recompute and render the contents of an Org-roam buffer.
|
|
Assumes that the current buffer is an `org-roam-mode' based
|
|
buffer."
|
|
(let ((inhibit-read-only t))
|
|
(erase-buffer)
|
|
(org-roam-mode)
|
|
(setq-local default-directory org-roam-buffer-current-directory)
|
|
(setq-local org-roam-directory org-roam-buffer-current-directory)
|
|
(org-roam-buffer-set-header-line-format
|
|
(org-roam-node-title org-roam-buffer-current-node))
|
|
(magit-insert-section (org-roam)
|
|
(magit-insert-heading)
|
|
(run-hook-with-args 'org-roam-mode-section-functions org-roam-buffer-current-node))
|
|
(goto-char 0)))
|
|
|
|
(defun org-roam-buffer-set-header-line-format (string)
|
|
"Set the header-line using STRING.
|
|
If the `face' property of any part of STRING is already set, then
|
|
that takes precedence. Also pad the left side of STRING so that
|
|
it aligns with the text area."
|
|
(setq-local header-line-format
|
|
(concat (propertize " " 'display '(space :align-to 0))
|
|
string)))
|
|
|
|
;;;; Dedicated buffer
|
|
;;;###autoload
|
|
(defun org-roam-buffer-display-dedicated (node)
|
|
"Launch NODE dedicated Org-roam buffer.
|
|
Unlike the persistent `org-roam-buffer', the contents of this
|
|
buffer won't be automatically changed and will be held in place.
|
|
|
|
In interactive calls prompt to select NODE, unless called with
|
|
`universal-argument', in which case NODE will be set to
|
|
`org-roam-node-at-point'."
|
|
(interactive
|
|
(list (if current-prefix-arg
|
|
(org-roam-node-at-point 'assert)
|
|
(org-roam-node-read nil nil nil 'require-match))))
|
|
(let ((buffer (get-buffer-create (org-roam-buffer--dedicated-name node))))
|
|
(with-current-buffer buffer
|
|
(setq-local org-roam-buffer-current-node node)
|
|
(setq-local org-roam-buffer-current-directory org-roam-directory)
|
|
(org-roam-buffer-render-contents))
|
|
(display-buffer buffer)))
|
|
|
|
(defun org-roam-buffer--dedicated-name (node)
|
|
"Construct buffer name for NODE dedicated Org-roam buffer."
|
|
(let ((title (org-roam-node-title node))
|
|
(filename (file-relative-name (org-roam-node-file node) org-roam-directory)))
|
|
(format "*org-roam: %s<%s>*" title filename)))
|
|
|
|
(defun org-roam-buffer-dedicated-p (&optional buffer)
|
|
"Return t if an Org-roam BUFFER is a node dedicated one.
|
|
See `org-roam-buffer-display-dedicated' for more details.
|
|
If BUFFER is nil, default it to `current-buffer'."
|
|
(or buffer (setq buffer (current-buffer)))
|
|
(string-match-p (concat "^" (regexp-quote "*org-roam: "))
|
|
(buffer-name buffer)))
|
|
|
|
;;;; Persistent buffer
|
|
(defvar org-roam-buffer "*org-roam*"
|
|
"The persistent Org-roam buffer name. Must be surround with \"*\".
|
|
The content inside of this buffer will be automatically updated
|
|
to the nearest node at point that comes from the current buffer.
|
|
To toggle its display use `org-roam-buffer-toggle' command.")
|
|
|
|
(defun org-roam-buffer-toggle ()
|
|
"Toggle display of the persistent `org-roam-buffer'."
|
|
(interactive)
|
|
(pcase (org-roam-buffer--visibility)
|
|
('visible
|
|
(progn
|
|
(delete-window (get-buffer-window org-roam-buffer))
|
|
(remove-hook 'post-command-hook #'org-roam-buffer--redisplay-h)))
|
|
((or 'exists 'none)
|
|
(progn
|
|
(display-buffer (get-buffer-create org-roam-buffer))
|
|
(org-roam-buffer-persistent-redisplay)))))
|
|
|
|
(define-inline org-roam-buffer--visibility ()
|
|
"Return the current visibility state of the persistent `org-roam-buffer'.
|
|
Valid states are 'visible, 'exists and 'none."
|
|
(declare (side-effect-free t))
|
|
(inline-quote
|
|
(cond
|
|
((get-buffer-window org-roam-buffer) 'visible)
|
|
((get-buffer org-roam-buffer) 'exists)
|
|
(t 'none))))
|
|
|
|
(defun org-roam-buffer-persistent-redisplay ()
|
|
"Recompute contents of the persistent `org-roam-buffer'.
|
|
Has no effect when there's no `org-roam-node-at-point'."
|
|
(when-let ((node (org-roam-node-at-point)))
|
|
(unless (equal node org-roam-buffer-current-node)
|
|
(setq org-roam-buffer-current-node node
|
|
org-roam-buffer-current-directory org-roam-directory)
|
|
(with-current-buffer (get-buffer-create org-roam-buffer)
|
|
(org-roam-buffer-render-contents)
|
|
(add-hook 'kill-buffer-hook #'org-roam-buffer--persistent-cleanup-h nil t)))))
|
|
|
|
(defun org-roam-buffer--persistent-cleanup-h ()
|
|
"Clean-up global state thats dedicated for the persistent `org-roam-buffer'."
|
|
(setq-default org-roam-buffer-current-node nil
|
|
org-roam-buffer-current-directory nil))
|
|
|
|
(add-hook 'org-roam-find-file-hook #'org-roam-buffer--setup-redisplay-h)
|
|
(defun org-roam-buffer--setup-redisplay-h ()
|
|
"Setup automatic redisplay of the persistent `org-roam-buffer'."
|
|
(add-hook 'post-command-hook #'org-roam-buffer--redisplay-h nil t))
|
|
|
|
(defun org-roam-buffer--redisplay-h ()
|
|
"Reconstruct the persistent `org-roam-buffer'.
|
|
This needs to be quick or infrequent, because this designed to
|
|
run at `post-command-hook'."
|
|
(and (get-buffer-window org-roam-buffer)
|
|
(org-roam-buffer-persistent-redisplay)))
|
|
|
|
;;; Sections
|
|
;;;; Node
|
|
(defvar org-roam-node-map
|
|
(let ((map (make-sparse-keymap)))
|
|
(set-keymap-parent map org-roam-mode-map)
|
|
(define-key map [remap org-roam-buffer-visit-thing] 'org-roam-node-visit)
|
|
map)
|
|
"Keymap for `org-roam-node-section's.")
|
|
|
|
(defclass org-roam-node-section (magit-section)
|
|
((keymap :initform 'org-roam-node-map)
|
|
(node :initform nil))
|
|
"A `magit-section' used by `org-roam-mode' to outline NODE in its own heading.")
|
|
|
|
(cl-defun org-roam-node-insert-section (&key source-node point properties)
|
|
"Insert section for a link from SOURCE-NODE to some other node.
|
|
The other node is normally `org-roam-buffer-current-node'.
|
|
|
|
SOURCE-NODE is an `org-roam-node' that links or references with
|
|
the other node.
|
|
|
|
POINT is a character position where the link is located in
|
|
SOURCE-NODE's file.
|
|
|
|
PROPERTIES (a plist) contains additional information about the
|
|
link.
|
|
|
|
Despite the name, this function actually inserts 2 sections at
|
|
the same time:
|
|
|
|
1. `org-roam-node-section' for a heading that describes
|
|
SOURCE-NODE. Acts as a parent section of the following one.
|
|
|
|
2. `org-roam-preview-section' for a preview content that comes
|
|
from SOURCE-NODE's file for the link (that references the
|
|
other node) at POINT. Acts a child section of the previous
|
|
one."
|
|
(magit-insert-section section (org-roam-node-section)
|
|
(let ((outline (if-let ((outline (plist-get properties :outline)))
|
|
(mapconcat #'org-link-display-format outline " > ")
|
|
"Top")))
|
|
(insert (concat (propertize (org-roam-node-title source-node)
|
|
'font-lock-face 'org-roam-title)
|
|
(format " (%s)"
|
|
(propertize outline 'font-lock-face 'org-roam-olp)))))
|
|
(magit-insert-heading)
|
|
(oset section node source-node)
|
|
(magit-insert-section section (org-roam-preview-section)
|
|
(insert (org-roam-fontify-like-in-org-mode
|
|
(org-roam-preview-get-contents (org-roam-node-file source-node) point))
|
|
"\n")
|
|
(oset section file (org-roam-node-file source-node))
|
|
(oset section point point)
|
|
(insert ?\n))))
|
|
|
|
;;;; Preview
|
|
(defvar org-roam-preview-map
|
|
(let ((map (make-sparse-keymap)))
|
|
(set-keymap-parent map org-roam-mode-map)
|
|
(define-key map [remap org-roam-buffer-visit-thing] 'org-roam-preview-visit)
|
|
map)
|
|
"Keymap for `org-roam-preview-section's.")
|
|
|
|
(defclass org-roam-preview-section (magit-section)
|
|
((keymap :initform 'org-roam-preview-map)
|
|
(file :initform nil)
|
|
(point :initform nil))
|
|
"A `magit-section' used by `org-roam-mode' to contain preview content.
|
|
The preview content comes from FILE, and the link as at POINT.")
|
|
|
|
(defun org-roam-preview-visit (file point &optional other-window)
|
|
"Visit FILE at POINT.
|
|
With prefix argument OTHER-WINDOW, visit the olp in another
|
|
window instead."
|
|
(interactive (list (org-roam-buffer-file-at-point 'assert)
|
|
(oref (magit-current-section) point)
|
|
current-prefix-arg))
|
|
(let ((buf (find-file-noselect file)))
|
|
(with-current-buffer buf
|
|
(widen)
|
|
(goto-char point))
|
|
(funcall (if other-window
|
|
#'switch-to-buffer-other-window
|
|
#'pop-to-buffer-same-window) buf)))
|
|
|
|
(defun org-roam-preview-get-contents (file point)
|
|
"Get preview content for FILE at POINT."
|
|
(save-excursion
|
|
(org-roam-with-temp-buffer file
|
|
(goto-char point)
|
|
(let ((elem (org-element-at-point)))
|
|
;; We want the parent element always
|
|
(while (org-element-property :parent elem)
|
|
(setq elem (org-element-property :parent elem)))
|
|
(pcase (car elem)
|
|
('headline ; show subtree
|
|
(org-roam-preview-get-entry-text (point-marker) most-positive-fixnum))
|
|
(_
|
|
(let ((begin (org-element-property :begin elem))
|
|
(end (org-element-property :end elem)))
|
|
(or (string-trim (buffer-substring-no-properties begin end))
|
|
(org-element-property :raw-value elem)))))))))
|
|
|
|
(defun org-roam-preview-get-entry-text (marker n-lines &optional indent)
|
|
"Extract entry text from MARKER, at most N-LINES lines.
|
|
This will ignore drawers etc, just get the text.
|
|
If INDENT is given, prefix every line with this string."
|
|
(let (txt ind)
|
|
(save-excursion
|
|
(with-current-buffer (marker-buffer marker)
|
|
(if (not (derived-mode-p 'org-mode))
|
|
(setq txt "")
|
|
(org-with-wide-buffer
|
|
(goto-char marker)
|
|
(end-of-line 1)
|
|
(setq txt (buffer-substring
|
|
(min (1+ (point)) (point-max))
|
|
(progn (outline-next-heading) (point))))
|
|
(with-temp-buffer
|
|
(insert txt)
|
|
(goto-char (point-min))
|
|
(while (org-activate-links (point-max))
|
|
(goto-char (match-end 0)))
|
|
(goto-char (point-min))
|
|
(while (re-search-forward org-link-bracket-re (point-max) t)
|
|
(set-text-properties (match-beginning 0) (match-end 0)
|
|
nil))
|
|
(goto-char (point-min))
|
|
(while (re-search-forward org-drawer-regexp nil t)
|
|
(delete-region
|
|
(match-beginning 0)
|
|
(progn (re-search-forward
|
|
"^[ \t]*:END:.*\n?" nil 'move)
|
|
(point))))
|
|
(goto-char (point-min))
|
|
(goto-char (point-max))
|
|
(skip-chars-backward " \t\n")
|
|
(when (looking-at "[ \t\n]+\\'") (replace-match ""))
|
|
|
|
;; find and remove min common indentation
|
|
(goto-char (point-min))
|
|
(untabify (point-min) (point-max))
|
|
(setq ind (current-indentation))
|
|
(while (not (eobp))
|
|
(unless (looking-at "[ \t]*$")
|
|
(setq ind (min ind (current-indentation))))
|
|
(beginning-of-line 2))
|
|
(goto-char (point-min))
|
|
(while (not (eobp))
|
|
(unless (looking-at "[ \t]*$")
|
|
(move-to-column ind)
|
|
(delete-region (point-at-bol) (point)))
|
|
(beginning-of-line 2))
|
|
(goto-char (point-min))
|
|
(when indent
|
|
(while (and (not (eobp)) (re-search-forward "^" nil t))
|
|
(replace-match indent t t)))
|
|
(goto-char (point-min))
|
|
(while (looking-at "[ \t]*\n") (replace-match ""))
|
|
(goto-char (point-max))
|
|
(when (> (org-current-line)
|
|
n-lines)
|
|
(org-goto-line (1+ n-lines))
|
|
(backward-char 1))
|
|
(setq txt (buffer-substring (point-min) (point))))))))
|
|
txt))
|
|
|
|
;;;; Backlinks
|
|
(cl-defstruct (org-roam-backlink (:constructor org-roam-backlink-create)
|
|
(:copier nil))
|
|
source-node target-node
|
|
point properties)
|
|
|
|
(cl-defmethod org-roam-populate ((backlink org-roam-backlink))
|
|
"Populate BACKLINK from database."
|
|
(setf (org-roam-backlink-source-node backlink)
|
|
(org-roam-populate (org-roam-backlink-source-node backlink))
|
|
(org-roam-backlink-target-node backlink)
|
|
(org-roam-populate (org-roam-backlink-target-node backlink)))
|
|
backlink)
|
|
|
|
(defun org-roam-backlinks-get (node)
|
|
"Return the backlinks for NODE."
|
|
(let ((backlinks (org-roam-db-query
|
|
[:select [source dest pos properties]
|
|
:from links
|
|
:where (= dest $s1)
|
|
:and (= type "id")]
|
|
(org-roam-node-id node))))
|
|
(cl-loop for backlink in backlinks
|
|
collect (pcase-let ((`(,source-id ,dest-id ,pos ,properties) backlink))
|
|
(org-roam-populate
|
|
(org-roam-backlink-create
|
|
:source-node (org-roam-node-create :id source-id)
|
|
:target-node (org-roam-node-create :id dest-id)
|
|
:point pos
|
|
:properties properties))))))
|
|
|
|
(defun org-roam-backlinks-sort (a b)
|
|
"Default sorting function for backlinks A and B.
|
|
Sorts by title."
|
|
(string< (org-roam-node-title (org-roam-backlink-source-node a))
|
|
(org-roam-node-title (org-roam-backlink-source-node b))))
|
|
|
|
(defun org-roam-backlinks-section (node)
|
|
"The backlinks section for NODE."
|
|
(when-let ((backlinks (seq-sort #'org-roam-backlinks-sort (org-roam-backlinks-get node))))
|
|
(magit-insert-section (org-roam-backlinks)
|
|
(magit-insert-heading "Backlinks:")
|
|
(dolist (backlink backlinks)
|
|
(org-roam-node-insert-section
|
|
:source-node (org-roam-backlink-source-node backlink)
|
|
:point (org-roam-backlink-point backlink)
|
|
:properties (org-roam-backlink-properties backlink)))
|
|
(insert ?\n))))
|
|
|
|
;;;; Reflinks
|
|
(cl-defstruct (org-roam-reflink (:constructor org-roam-reflink-create)
|
|
(:copier nil))
|
|
source-node ref
|
|
point properties)
|
|
|
|
(cl-defmethod org-roam-populate ((reflink org-roam-reflink))
|
|
"Populate REFLINK from database."
|
|
(setf (org-roam-reflink-source-node reflink)
|
|
(org-roam-populate (org-roam-reflink-source-node reflink)))
|
|
reflink)
|
|
|
|
(defun org-roam-reflinks-get (node)
|
|
"Return the reflinks for NODE."
|
|
(let ((refs (org-roam-db-query [:select [ref] :from refs
|
|
:where (= node-id $s1)]
|
|
(org-roam-node-id node)))
|
|
links)
|
|
(pcase-dolist (`(,ref) refs)
|
|
(pcase-dolist (`(,source-id ,pos ,properties) (org-roam-db-query
|
|
[:select [source pos properties]
|
|
:from links
|
|
:where (= dest $s1)]
|
|
ref))
|
|
(push (org-roam-populate
|
|
(org-roam-reflink-create
|
|
:source-node (org-roam-node-create :id source-id)
|
|
:ref ref
|
|
:point pos
|
|
:properties properties)) links)))
|
|
links))
|
|
|
|
(defun org-roam-reflinks-sort (a b)
|
|
"Default sorting function for reflinks A and B.
|
|
Sorts by title."
|
|
(string< (org-roam-node-title (org-roam-reflink-source-node a))
|
|
(org-roam-node-title (org-roam-reflink-source-node b))))
|
|
|
|
(defun org-roam-reflinks-section (node)
|
|
"The reflinks section for NODE."
|
|
(when (org-roam-node-refs node)
|
|
(let* ((reflinks (seq-sort #'org-roam-reflinks-sort (org-roam-reflinks-get node))))
|
|
(magit-insert-section (org-roam-reflinks)
|
|
(magit-insert-heading "Reflinks:")
|
|
(dolist (reflink reflinks)
|
|
(org-roam-node-insert-section
|
|
:source-node (org-roam-reflink-source-node reflink)
|
|
:point (org-roam-reflink-point reflink)
|
|
:properties (org-roam-reflink-properties reflink)))
|
|
(insert ?\n)))))
|
|
|
|
;;;; Grep
|
|
(defvar org-roam-grep-map
|
|
(let ((map (make-sparse-keymap)))
|
|
(set-keymap-parent map org-roam-mode-map)
|
|
(define-key map [remap org-roam-buffer-visit-thing] 'org-roam-grep-visit)
|
|
map)
|
|
"Keymap for Org-roam grep result sections.")
|
|
|
|
(defclass org-roam-grep-section (magit-section)
|
|
((keymap :initform 'org-roam-grep-map)
|
|
(file :initform nil)
|
|
(row :initform nil)
|
|
(col :initform nil))
|
|
"A `magit-section' used by `org-roam-mode' to contain grep output.")
|
|
|
|
(defun org-roam-grep-visit (file &optional other-window row col)
|
|
"Visits FILE. If ROW, move to the row, and if COL move to the COL.
|
|
With a prefix argument OTHER-WINDOW, display the buffer in
|
|
another window instead."
|
|
(interactive (list (org-roam-buffer-file-at-point t)
|
|
current-prefix-arg
|
|
(oref (magit-current-section) row)
|
|
(oref (magit-current-section) col)))
|
|
(let ((buf (find-file-noselect file)))
|
|
(with-current-buffer buf
|
|
(widen)
|
|
(goto-char (point-min))
|
|
(when row
|
|
(forward-line (1- row)))
|
|
(when col
|
|
(forward-char (1- col))))
|
|
(funcall (if other-window
|
|
#'switch-to-buffer-other-window
|
|
#'pop-to-buffer-same-window) buf)))
|
|
|
|
;;;; Unlinked references
|
|
(defvar org-roam-unlinked-references-result-re
|
|
(rx (group (one-or-more anything))
|
|
":"
|
|
(group (one-or-more digit))
|
|
":"
|
|
(group (one-or-more digit))
|
|
":"
|
|
(group (zero-or-more anything)))
|
|
"Regex for the return result of a ripgrep query.")
|
|
|
|
(defun org-roam-unlinked-references-preview-line (file row)
|
|
"Return the preview line from FILE.
|
|
This is the ROW within FILE."
|
|
(with-temp-buffer
|
|
(insert-file-contents file)
|
|
(forward-line (1- row))
|
|
(buffer-substring-no-properties
|
|
(save-excursion
|
|
(beginning-of-line)
|
|
(point))
|
|
(save-excursion
|
|
(end-of-line)
|
|
(point)))))
|
|
|
|
(defun org-roam-unlinked-references-section (node)
|
|
"The unlinked references section for NODE.
|
|
References from FILE are excluded."
|
|
(when (and (executable-find "rg")
|
|
(not (string-match "PCRE2 is not available"
|
|
(shell-command-to-string "rg --pcre2-version"))))
|
|
(let* ((titles (cons (org-roam-node-title node)
|
|
(org-roam-node-aliases node)))
|
|
(rg-command (concat "rg -o --vimgrep -P -i "
|
|
(mapconcat (lambda (glob) (concat "-g " glob))
|
|
(org-roam--list-files-search-globs org-roam-file-extensions)
|
|
" ")
|
|
(format " '\\[([^[]]++|(?R))*\\]%s' "
|
|
(mapconcat (lambda (title)
|
|
(format "|(\\b%s\\b)" (shell-quote-argument title)))
|
|
titles ""))
|
|
org-roam-directory))
|
|
(results (split-string (shell-command-to-string rg-command) "\n"))
|
|
f row col match)
|
|
(magit-insert-section (unlinked-references)
|
|
(magit-insert-heading "Unlinked References:")
|
|
(dolist (line results)
|
|
(save-match-data
|
|
(when (string-match org-roam-unlinked-references-result-re line)
|
|
(setq f (match-string 1 line)
|
|
row (string-to-number (match-string 2 line))
|
|
col (string-to-number (match-string 3 line))
|
|
match (match-string 4 line))
|
|
(when (and match
|
|
(not (f-equal-p (org-roam-node-file node) f))
|
|
(member (downcase match) (mapcar #'downcase titles)))
|
|
(magit-insert-section section (org-roam-grep-section)
|
|
(oset section file f)
|
|
(oset section row row)
|
|
(oset section col col)
|
|
(insert (propertize (format "%s:%s:%s"
|
|
(truncate-string-to-width (file-name-base f) 15 nil nil "...")
|
|
row col) 'font-lock-face 'org-roam-dim)
|
|
" "
|
|
(org-roam-fontify-like-in-org-mode
|
|
(org-roam-unlinked-references-preview-line f row))
|
|
"\n"))))))
|
|
(insert ?\n)))))
|
|
|
|
(provide 'org-roam-mode)
|
|
;;; org-roam-mode.el ends here
|