Browse Source

Split nroam.el

* nroam-backlinks.el:
* nroam-utils.el: New files.
master
Nicolas Petton 1 month ago
parent
commit
c51e54957d
No known key found for this signature in database GPG Key ID: E8BCD7866AFCF978
3 changed files with 215 additions and 129 deletions
  1. +141
    -0
      nroam-backlinks.el
  2. +58
    -0
      nroam-utils.el
  3. +16
    -129
      nroam.el

+ 141
- 0
nroam-backlinks.el View File

@ -0,0 +1,141 @@
;;; nroam-backlinks.el --- Backlink section for nroam.el -*- lexical-binding: t; -*-
;; Copyright (C) 2021 Nicolas Petton
;; Author: Nicolas Petton <nico@petton.fr>
;; URL: https://github.com/NicolasPetton/nroam
;; Keywords: convenience, outlines
;; Version: 0.0.1
;; Package-Requires: ((emacs "26.1") (org-roam "1.2.3"))
;; 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-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."
(insert (format "* %s %s\n"
(if (= count 0) "No" count)
(nroam--pluralize count "linked reference"))))
(defun nroam-backlinks--insert-group (group)
"Insert all backlinks in GROUP."
(let ((file (car group))
(backlinks (cdr group)))
(insert (format "** %s\n"
(org-roam-format-link
file
(org-roam-db--get-title file)
"file")))
(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 (car elt))
(content (string-trim (cdr elt)))
(beg (point)))
(pcase type
('headline (progn
(org-paste-subtree 3 (nroam--fix-links content file))
(goto-char (point-max))))
(_ (insert (nroam--fix-links content file))))
(set-text-properties beg (point)
`(nroam-link t file ,file point ,point))
(insert "\n"))))
(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)))
(let ((begin (org-element-property :begin elt))
(end (org-element-property :end elt))
(type (org-element-type elt)))
`(,type . ,(buffer-substring begin end))))))
(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

+ 58
- 0
nroam-utils.el View File

@ -0,0 +1,58 @@
;;; nroam-utils.el --- Util functions for nroam -*- lexical-binding: t; -*-
;; Copyright (C) 2021 Nicolas Petton
;; Author: Nicolas Petton <nico@petton.fr>
;; URL: https://github.com/NicolasPetton/nroam
;; Keywords: convenience
;; Version: 0.0.1
;; Package-Requires: ((emacs "26.1") (org-roam "1.2.3"))
;; 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 utility functions used by other files in nroam.
;;; Code:
(require 'seq)
(require 'org-roam)
(defun nroam--pluralize (n thing)
"Pluralize the string THING if N>1."
(format "%s%s" thing (if (> n 1) "s" "")))
(defun nroam--ensure-empty-line ()
"Insert a newline character if the buffer does contain one before point."
(let ((inhibit-read-only t))
(unless (eq ?\n (char-before (1- (point)))) (insert "\n"))))
(defun nroam--do-separated-by-newlines (function sequence)
"Apply FUNCTION to each element of SEQUENCE.
Insert a single newline between each call to FUNCTION."
(seq-do-indexed (lambda (item index)
(unless (= index 0)
(delete-blank-lines)
(nroam--ensure-empty-line))
(funcall function item))
sequence))
(defun nroam--fix-links (content origin)
"Correct all relative links in CONTENT from ORIGIN.
Temporary fix until `org-roam' v2 is out."
(org-roam-buffer-expand-links content origin))
(provide 'nroam-utils)
;;; nroam-utils.el ends here

+ 16
- 129
nroam.el View File

@ -34,14 +34,27 @@
;;; Code:
(require 'org-roam)
(require 'org-roam-buffer)
(require 'org-element)
(require 'org-capture)
(require 'seq)
(require 'subr-x)
(require 'bookmark)
(require 'nroam-utils)
(require 'nroam-backlinks)
(defcustom nroam-sections nil
"List of functions to be called to insert sections in nroam buffers."
:group 'nroam
:type '(repeat function))
(defun nroam-register-section (function)
"Add FUNCTION as a section in nroam."
(add-to-list 'nroam-sections function t))
(defvar-local nroam-start-marker nil)
(defvar-local nroam-end-marker nil)
(defun nroam--handle-org-capture (&rest _)
"Setup the `org-capture' buffer.
@ -54,17 +67,6 @@ template."
(advice-add 'org-capture-place-template :before #'nroam--handle-org-capture)
(defcustom nroam-sections
'(nroam-backlinks-section)
"List of functions to be called to insert sections in nroam buffers."
:group 'nroam
:type '(repeat function))
(defvar-local nroam-start-marker nil)
(defvar-local nroam-end-marker nil)
(defvar nroam-work-buffer " *nroam-work*")
(defmacro with-nroam-markers (&rest body)
"Evaluate BODY.
Make the region inserted by BODY read-only, and marked with
@ -96,7 +98,6 @@ Make the region inserted by BODY read-only, and marked with
:keymap nroam-mode-map
(if nroam-mode
(progn
(nroam--init-work-buffer)
(add-hook 'before-save-hook #'nroam--prune nil t)
(add-hook 'after-save-hook #'nroam--update-maybe nil t)
(nroam--maybe-insert-immediately))
@ -135,26 +136,10 @@ Make the region inserted by BODY read-only, and marked with
(nroam--prune)
(nroam--insert))
(defun nroam-backlinks-section ()
"Insert org-roam backlinks for the current buffer."
(let* ((backlinks (nroam--get-backlinks))
(groups (seq-reverse (nroam--group-backlinks backlinks))))
(nroam--ensure-empty-line)
(nroam--insert-backlinks-heading (seq-length backlinks))
(nroam--do-separated-by-newlines #'nroam--insert-backlink-group groups)
(nroam--hide-drawers)))
(defun nroam--org-roam-file-p ()
"Return non-nil if the current buffer is an org-roam buffer."
(org-roam--org-roam-file-p))
(defun nroam--init-work-buffer ()
"Initiate nroam hidden buffer."
(get-buffer-create nroam-work-buffer)
(with-current-buffer nroam-work-buffer
(delay-mode-hooks
(org-mode))))
(defun nroam--point-at-section-p ()
"Return non-hil if point if on the backlinks section."
(when (nroam--sections-inserted-p)
@ -206,66 +191,6 @@ Make the region inserted by BODY read-only, and marked with
(narrow-to-region nroam-start-marker nroam-end-marker)
(org-set-startup-visibility))))
(defun nroam--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--group-backlinks (backlinks)
"Return BACKLINKS grouped by source file."
(seq-group-by #'car backlinks))
(defun nroam--insert-backlinks-heading (count)
"Insert the heading for the backlinks section with a COUNT."
(insert (format "* %s %s\n"
(if (= count 0) "No" count)
(nroam--pluralize count "linked reference"))))
(defun nroam--insert-backlink-group (group)
"Insert all backlinks in GROUP."
(let ((file (car group))
(backlinks (cdr group)))
(insert (format "** %s\n"
(org-roam-format-link
file
(org-roam-db--get-title file)
"file")))
(nroam--do-separated-by-newlines #'nroam--insert-backlink backlinks)))
(defun nroam--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--crawl-source file point))
(type (car elt))
(content (string-trim (cdr elt)))
(beg (point)))
(pcase type
('headline (progn
(org-paste-subtree 3 (nroam--fix-links content file))
(goto-char (point-max))))
(_ (insert (nroam--fix-links content file))))
(set-text-properties beg (point)
`(nroam-link t file ,file point ,point))
(insert "\n"))))
(defun nroam--crawl-source (file point)
"Return the source element in FILE at POINT."
(with-current-buffer nroam-work-buffer
(insert-file-contents file nil nil nil 'replace)
(goto-char point)
(let ((elt (org-element-at-point)))
(let ((begin (org-element-property :begin elt))
(end (org-element-property :end elt))
(type (org-element-type elt)))
`(,type . ,(buffer-substring begin end))))))
(defun nroam--fix-links (content origin)
"Correct all relative links in CONTENT from ORIGIN.
Temporary fix until `org-roam' v2 is out."
(org-roam-buffer-expand-links content origin))
(defun nroam--follow-link ()
"Follow backlink at point."
(when (get-text-property (point) 'nroam-link)
@ -274,45 +199,7 @@ Temporary fix until `org-roam' v2 is out."
(org-open-file file t)
(goto-char point))))
(defun nroam--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--pluralize (n thing)
"Pluralize the string THING if N>1."
(format "%s%s" thing (if (> n 1) "s" "")))
(defun nroam--ensure-empty-line ()
"Insert a newline character if the buffer does contain one before point."
(let ((inhibit-read-only t))
(unless (eq ?\n (char-before (1- (point)))) (insert "\n"))))
(defun nroam--do-separated-by-newlines (function sequence)
"Apply FUNCTION to each element of SEQUENCE.
Insert a single newline between each call to FUNCTION."
(seq-do-indexed (lambda (item index)
(unless (= index 0)
(delete-blank-lines)
(nroam--ensure-empty-line))
(funcall function item))
sequence))
(nroam-backlinks-register-section)
(provide 'nroam)
;;; nroam.el ends here

Loading…
Cancel
Save