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
167 lines
6.6 KiB
;;; nroam-backlinks.el --- Backlink section for nroam.el -*- lexical-binding: t; -*-
|
|
|
|
;; Copyright (C) 2021 Nicolas Petton
|
|
|
|
;; Author: Nicolas Petton <nico@petton.fr>
|
|
|
|
;; 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
|
|
;; 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 this program. If not, see <https://www.gnu.org/licenses/>.
|
|
|
|
;;; 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)
|
|
(nroam-backlinks--hide-drawers)))
|
|
|
|
(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)
|
|
"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'.
|
|
(save-excursion
|
|
(while (re-search-forward org-drawer-regexp nil t)
|
|
(let* ((pair (get-char-property-and-overlay (line-beginning-position)
|
|
'invisible))
|
|
(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)))
|
|
buf
|
|
(nroam-backlinks--init-work-buffer)))
|
|
|
|
(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)))
|
|
buf))
|
|
|
|
(provide 'nroam-backlinks)
|
|
;;; nroam-backlinks.el ends here
|