nroam is a supplementary package for org-roam that replaces the backlink side buffer of Org-roam. Instead, it displays org-roam backlinks at the end of org-roam buffers.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

167 lines
6.6 KiB

;;; nroam-backlinks.el --- Backlink section for nroam.el -*- lexical-binding: t; -*-
;; Copyright (C) 2021 Nicolas Petton
;; Author: Nicolas Petton <>
;; 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 of the License, 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
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <>.
;;; Commentary:
;; This library provides a backlinks nroam section for org-roam buffers.
;;; Code:
(require 'org)
(require 'org-element)
(require 'org-roam)
(require 'seq)
(require 'subr-x)
(require 'org-element)
(require 'nroam-utils)
(declare-function nroam-register-section "nroam.el")
(defvar nroam-backlinks--work-buffer-name " *nroam-work*")
(defun nroam-backlinks-register-section ()
"Register `nroam-backlinks-section'."
(nroam-register-section #'nroam-backlinks-section))
(defun nroam-backlinks-section ()
"Insert `org-roam' backlinks for the current buffer."
(let* ((backlinks (nroam-backlinks--get-backlinks))
(groups (seq-reverse (nroam-backlinks--group backlinks))))
(nroam-backlinks--insert-heading (seq-length backlinks))
(nroam--do-separated-by-newlines #'nroam-backlinks--insert-group groups)
(defun nroam-backlinks--get-backlinks ()
"Return a list of backlinks for the current buffer."
(if-let* ((file-path (buffer-file-name (current-buffer)))
(titles (org-roam--extract-titles)))
(org-roam--get-backlinks (cons file-path titles))))
(defun nroam-backlinks--group (backlinks)
"Return BACKLINKS grouped by source file."
(seq-group-by #'car backlinks))
(defun nroam-backlinks--insert-heading (count)
"Insert the heading for the backlinks section with a COUNT."
(let ((title (format "%s %s"
(if (= count 0) "No" count)
(nroam--pluralize count "linked reference"))))
(nroam--insert-heading 2 title)))
(defun nroam-backlinks--insert-group (group)
"Insert all backlinks in GROUP."
(let* ((file (car group))
(backlinks (cdr group))
(title (org-roam-format-link file
(org-roam-db--get-title file)
(nroam--insert-heading 3 title)
(nroam--do-separated-by-newlines #'nroam-backlinks--insert-backlink backlinks)))
(defun nroam-backlinks--insert-backlink (backlink)
"Insert the source element where BACKLINK is defined."
(seq-let (file _ props) backlink
(when-let* ((point (plist-get props :point))
(elt (nroam-backlinks--crawl-source file point))
(type (plist-get elt :type))
(content (nroam--fix-links (string-trim (plist-get elt :string)) file))
(beg (point)))
(let ((outline (plist-get elt :outline))
(full-outline (plist-get elt :full-outline)))
(if (eq type 'headline)
(nroam-backlinks--insert-backlink-subtree content outline)
(nroam-backlinks--insert-backlink-content content full-outline)))
(set-text-properties beg (point)
`(nroam-link t file ,file point ,point))
(insert "\n"))))
(defun nroam-backlinks--insert-backlink-subtree (content outline)
"Insert CONTENT as a heading with its subtree.
When OUTLINE is non-nil, insert it as a heading."
(nroam-backlinks--insert-backlink-breadcrumbs outline)
(nroam-backlinks--insert-subtree content (if outline 5 4)))
(defun nroam-backlinks--insert-backlink-content (content outline)
"Insert CONTENT with OUTLINE as a heading if non-nil."
(nroam-backlinks--insert-backlink-breadcrumbs outline)
(insert content))
(defun nroam-backlinks--insert-backlink-breadcrumbs (outline)
"Insert OUTLINE if non-nil as a breadcrumbs heading."
(when outline
(let ((str-outline (concat "* " (string-join outline ""))))
(nroam-backlinks--insert-subtree str-outline))))
(defun nroam-backlinks--insert-subtree (subtree &optional level)
"Insert SUBTREE as a LEVEL headline.
LEVEL defaults to 4 when nil."
(org-paste-subtree (or level 4) subtree)
(goto-char (point-max)))
(defun nroam-backlinks--crawl-source (file point)
"Return the source element in FILE at POINT."
(with-current-buffer (nroam-backlinks--work-buffer)
(insert-file-contents file nil nil nil 'replace)
(goto-char point)
(let* ((elt (org-element-at-point))
(begin (org-element-property :begin elt))
(end (org-element-property :end elt))
(type (org-element-type elt))
(outline (org-get-outline-path))
(full-outline (unless (org-before-first-heading-p)
(org-get-outline-path 'with-self))))
`(:type ,type
:string ,(buffer-substring begin end)
:outline ,outline
:full-outline ,full-outline))))
(defun nroam-backlinks--hide-drawers ()
"Fold all drawers starting at POINT in the current buffer."
;; Taken from `org-hide-drawer-all'.
(while (re-search-forward org-drawer-regexp nil t)
(let* ((pair (get-char-property-and-overlay (line-beginning-position)
(o (cdr-safe pair)))
(if (overlayp o) (goto-char (overlay-end o)) ;invisible drawer
(pcase (get-char-property-and-overlay (point) 'invisible)
(`(outline . ,o) (goto-char (overlay-end o))) ;already folded
(let* ((drawer (org-element-at-point))
(type (org-element-type drawer)))
(when (memq type '(drawer property-drawer))
(org-hide-drawer-toggle t nil drawer)
;; Make sure to skip drawer entirely or we might flag it
;; another time when matching its ending line with
;; `org-drawer-regexp'.
(goto-char (org-element-property :end drawer)))))))))))
(defun nroam-backlinks--work-buffer ()
"Return the hidden buffer used for crawling operations."
(if-let ((buf (get-buffer nroam-backlinks--work-buffer-name)))
(defun nroam-backlinks--init-work-buffer ()
"Initiate nroam hidden buffer."
(let ((buf (get-buffer-create nroam-backlinks--work-buffer-name)))
(with-current-buffer buf
(delay-mode-hooks (org-mode)))
(provide 'nroam-backlinks)
;;; nroam-backlinks.el ends here