diff options
-rw-r--r-- | nroam-backlinks.el | 141 | ||||
-rw-r--r-- | nroam-utils.el | 58 | ||||
-rw-r--r-- | nroam.el | 145 |
3 files changed, 215 insertions, 129 deletions
diff --git a/nroam-backlinks.el b/nroam-backlinks.el new file mode 100644 index 0000000..eeead22 --- /dev/null +++ b/nroam-backlinks.el @@ -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 diff --git a/nroam-utils.el b/nroam-utils.el new file mode 100644 index 0000000..b53eeac --- /dev/null +++ b/nroam-utils.el @@ -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 @@ -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 |