267 lines
11 KiB
EmacsLisp
267 lines
11 KiB
EmacsLisp
|
;;; org-roam-buffer.el --- Roam Research replica with Org-mode -*- coding: utf-8; lexical-binding: t -*-
|
||
|
|
||
|
;; Copyright © 2020 Jethro Kuan <jethrokuan95@gmail.com>
|
||
|
|
||
|
;; Author: Jethro Kuan <jethrokuan95@gmail.com>
|
||
|
;; URL: https://github.com/jethrokuan/org-roam
|
||
|
;; Keywords: org-mode, roam, convenience
|
||
|
;; Version: 1.0.0-rc1
|
||
|
;; Package-Requires: ((emacs "26.1") (dash "2.13") (f "0.17.2") (s "1.12.0") (org "9.3") (emacsql "3.0.0") (emacsql-sqlite "1.0.0"))
|
||
|
|
||
|
;; 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 library provides the org-roam-buffer functionality for org-roam
|
||
|
;;; Code:
|
||
|
;;;; Library Requires
|
||
|
(require 'cl-lib)
|
||
|
(require 'dash)
|
||
|
(require 's)
|
||
|
|
||
|
(defvar org-roam-directory)
|
||
|
(defvar org-link-frame-setup)
|
||
|
(defvar org-return-follows-link)
|
||
|
(defvar org-roam-backlinks-mode)
|
||
|
(defvar org-roam-last-window)
|
||
|
(declare-function org-roam-db--ensure-built "org-roam-db")
|
||
|
(declare-function org-roam--extract-ref "org-roam")
|
||
|
(declare-function org-roam--get-title-or-slug "org-roam")
|
||
|
(declare-function org-roam--get-backlinks "org-roam")
|
||
|
(declare-function org-roam-backlinks-mode "org-roam")
|
||
|
|
||
|
(defcustom org-roam-buffer-position 'right
|
||
|
"Position of `org-roam' buffer.
|
||
|
Valid values are
|
||
|
* left,
|
||
|
* right,
|
||
|
* top,
|
||
|
* bottom."
|
||
|
:type '(choice (const left)
|
||
|
(const right)
|
||
|
(const top)
|
||
|
(const bottom))
|
||
|
:group 'org-roam)
|
||
|
|
||
|
(defcustom org-roam-buffer-width 0.33
|
||
|
"Width of `org-roam' buffer.
|
||
|
Has an effect if and only if `org-roam-buffer-position' is `left' or `right'."
|
||
|
:type 'number
|
||
|
:group 'org-roam)
|
||
|
|
||
|
(defcustom org-roam-buffer-height 0.27
|
||
|
"Height of `org-roam' buffer.
|
||
|
Has an effect if and only if `org-roam-buffer-position' is `top' or `bottom'."
|
||
|
:type 'number
|
||
|
:group 'org-roam)
|
||
|
|
||
|
|
||
|
(defcustom org-roam-buffer "*org-roam*"
|
||
|
"Org-roam buffer name."
|
||
|
:type 'string
|
||
|
:group 'org-roam)
|
||
|
|
||
|
(defcustom org-roam-buffer-prepare-hook '(org-roam-buffer--insert-title
|
||
|
org-roam-buffer--insert-backlinks
|
||
|
org-roam-buffer--insert-citelinks)
|
||
|
"Hook run in the `org-roam-buffer' before it is displayed."
|
||
|
:type 'hook
|
||
|
:group 'org-roam)
|
||
|
|
||
|
(defalias 'org-roam--current-buffer 'org-roam-buffer--current)
|
||
|
(make-obsolete-variable 'org-roam--current-buffer 'org-roam-buffer--current "2020/04/06")
|
||
|
(defvar org-roam-buffer--current nil
|
||
|
"Currently displayed file in `org-roam' buffer.")
|
||
|
|
||
|
(defun org-roam-buffer--insert-title ()
|
||
|
"Insert the org-roam-buffer title."
|
||
|
(insert (propertize (org-roam--get-title-or-slug
|
||
|
(buffer-file-name org-roam-buffer--current))
|
||
|
'font-lock-face
|
||
|
'org-document-title)))
|
||
|
|
||
|
(defun org-roam-buffer--insert-citelinks ()
|
||
|
"Insert citation backlinks for the current buffer."
|
||
|
(if-let* ((roam-key (with-temp-buffer
|
||
|
(insert-buffer-substring org-roam-buffer--current)
|
||
|
(org-roam--extract-ref)))
|
||
|
(key-backlinks (org-roam--get-backlinks (s-chop-prefix "cite:" roam-key)))
|
||
|
(grouped-backlinks (--group-by (nth 0 it) key-backlinks)))
|
||
|
(progn
|
||
|
(insert (format "\n\n* %d Cite backlinks\n"
|
||
|
(length key-backlinks)))
|
||
|
(dolist (group grouped-backlinks)
|
||
|
(let ((file-from (car group))
|
||
|
(bls (cdr group)))
|
||
|
(insert (format "** [[file:%s][%s]]\n"
|
||
|
file-from
|
||
|
(org-roam--get-title-or-slug file-from)))
|
||
|
(dolist (backlink bls)
|
||
|
(pcase-let ((`(,file-from _ ,props) backlink))
|
||
|
(insert (propertize
|
||
|
(s-trim (s-replace "\n" " "
|
||
|
(plist-get props :content)))
|
||
|
'help-echo "mouse-1: visit backlinked note"
|
||
|
'file-from file-from
|
||
|
'file-from-point (plist-get props :point)))
|
||
|
(insert "\n\n"))))))
|
||
|
(insert "\n\n* No cite backlinks!")))
|
||
|
|
||
|
(defun org-roam-buffer--insert-backlinks ()
|
||
|
"Insert the org-roam-buffer backlinks string for the current buffer."
|
||
|
(if-let* ((file-path (buffer-file-name org-roam-buffer--current))
|
||
|
(backlinks (org-roam--get-backlinks file-path))
|
||
|
(grouped-backlinks (--group-by (nth 0 it) backlinks)))
|
||
|
(progn
|
||
|
(insert (format "\n\n* %d Backlinks\n"
|
||
|
(length backlinks)))
|
||
|
(dolist (group grouped-backlinks)
|
||
|
(let ((file-from (car group))
|
||
|
(bls (cdr group)))
|
||
|
(insert (format "** [[file:%s][%s]]\n"
|
||
|
file-from
|
||
|
(org-roam--get-title-or-slug file-from)))
|
||
|
(dolist (backlink bls)
|
||
|
(pcase-let ((`(,file-from _ ,props) backlink))
|
||
|
(insert (propertize
|
||
|
(s-trim (s-replace "\n" " "
|
||
|
(plist-get props :content)))
|
||
|
'help-echo "mouse-1: visit backlinked note"
|
||
|
'file-from file-from
|
||
|
'file-from-point (plist-get props :point)))
|
||
|
(insert "\n\n"))))))
|
||
|
(insert "\n\n* No backlinks!")))
|
||
|
|
||
|
(defalias 'org-roam-update 'org-roam-buffer-update)
|
||
|
(make-obsolete 'org-roam-update 'org-roam-buffer-update "2020/04/06")
|
||
|
(defun org-roam-buffer-update ()
|
||
|
"Update the `org-roam-buffer'."
|
||
|
(org-roam-db--ensure-built)
|
||
|
(let* ((source-org-roam-directory org-roam-directory))
|
||
|
(with-current-buffer org-roam-buffer
|
||
|
;; When dir-locals.el is used to override org-roam-directory,
|
||
|
;; org-roam-buffer should have a different local org-roam-directory and
|
||
|
;; default-directory, as relative links are relative from the overridden
|
||
|
;; org-roam-directory.
|
||
|
(setq-local org-roam-directory source-org-roam-directory)
|
||
|
(setq-local default-directory source-org-roam-directory)
|
||
|
;; Locally overwrite the file opening function to re-use the
|
||
|
;; last window org-roam was called from
|
||
|
(setq-local org-link-frame-setup
|
||
|
(cons '(file . org-roam--find-file) org-link-frame-setup))
|
||
|
(let ((inhibit-read-only t))
|
||
|
(erase-buffer)
|
||
|
(unless (eq major-mode 'org-mode)
|
||
|
(org-mode))
|
||
|
(unless org-roam-backlinks-mode
|
||
|
(org-roam-backlinks-mode))
|
||
|
(make-local-variable 'org-return-follows-link)
|
||
|
(setq org-return-follows-link t)
|
||
|
(run-hooks 'org-roam-buffer-prepare-hook)
|
||
|
(read-only-mode 1)))))
|
||
|
|
||
|
(defalias 'org-roam--maybe-update-buffer 'org-roam-buffer--update-maybe)
|
||
|
(make-obsolete 'org-roam--maybe-update-buffer 'org-roam-buffer--update-maybe "2020/04/06")
|
||
|
(cl-defun org-roam-buffer--update-maybe (&key redisplay)
|
||
|
"Reconstructs `org-roam-buffer'.
|
||
|
This needs to be quick or infrequent, because this is run at
|
||
|
`post-command-hook'. If REDISPLAY, force an update of
|
||
|
`org-roam-buffer'."
|
||
|
(let ((buffer (window-buffer)))
|
||
|
(when (and (or redisplay
|
||
|
(not (eq org-roam-buffer--current buffer)))
|
||
|
(eq 'visible (org-roam-buffer--visibility))
|
||
|
(buffer-local-value 'buffer-file-truename buffer))
|
||
|
(setq org-roam-buffer--current buffer)
|
||
|
(org-roam-buffer-update))))
|
||
|
|
||
|
;;;; Toggling the org-roam buffer
|
||
|
(defalias 'org-roam--current-visibility 'org-roam-buffer--visibility)
|
||
|
(make-obsolete 'org-roam--current-visibility 'org-roam-buffer--visibility "2020/04/06")
|
||
|
(define-inline org-roam-buffer--visibility ()
|
||
|
"Return whether the current visibility state of the 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))))
|
||
|
|
||
|
(defalias 'org-roam--set-width 'org-roam-buffer--set-width)
|
||
|
(make-obsolete 'org-roam--set-width 'org-roam-buffer--set-width "2020/04/06")
|
||
|
(defun org-roam-buffer--set-width (width)
|
||
|
"Set the width of `org-roam-buffer' to `WIDTH'."
|
||
|
(unless (one-window-p)
|
||
|
(let ((window-size-fixed)
|
||
|
(w (max width window-min-width)))
|
||
|
(cond
|
||
|
((> (window-width) w)
|
||
|
(shrink-window-horizontally (- (window-width) w)))
|
||
|
((< (window-width) w)
|
||
|
(enlarge-window-horizontally (- w (window-width))))))))
|
||
|
|
||
|
(defalias 'org-roam--set-height 'org-roam-buffer--set-height)
|
||
|
(make-obsolete 'org-roam--set-height 'org-roam-buffer--set-height "2020/04/06")
|
||
|
(defun org-roam-buffer--set-height (height)
|
||
|
"Set the height of `org-roam-buffer' to `HEIGHT'."
|
||
|
(unless (one-window-p)
|
||
|
(let ((window-size-fixed)
|
||
|
(h (max height window-min-height)))
|
||
|
(cond
|
||
|
((> (window-height) h)
|
||
|
(shrink-window (- (window-height) h)))
|
||
|
((< (window-height) h)
|
||
|
(enlarge-window (- h (window-height))))))))
|
||
|
|
||
|
(defalias 'org-roam--set-up-buffer 'org-roam-buffer--get-create)
|
||
|
(make-obsolete 'org-roam--set-up-buffer 'org-roam-buffer--get-create "2020/04/06")
|
||
|
(defun org-roam-buffer--get-create ()
|
||
|
"Set up the `org-roam' buffer at `org-roam-buffer-position'."
|
||
|
(let ((window (get-buffer-window))
|
||
|
(position
|
||
|
(if (member org-roam-buffer-position '(right left top bottom))
|
||
|
org-roam-buffer-position
|
||
|
(let ((text-quoting-style 'grave))
|
||
|
(lwarn '(org-roam) :error
|
||
|
"Invalid org-roam-buffer-position: %s. Defaulting to \\='right"
|
||
|
org-roam-buffer-position))
|
||
|
'right)))
|
||
|
(-> (get-buffer-create org-roam-buffer)
|
||
|
(display-buffer-in-side-window
|
||
|
`((side . ,position)))
|
||
|
(select-window))
|
||
|
(pcase position
|
||
|
((or 'right 'left)
|
||
|
(org-roam-buffer--set-width (round (* (frame-width) org-roam-buffer-width))))
|
||
|
((or 'top 'bottom)
|
||
|
(org-roam-buffer--set-height (round (* (frame-height) org-roam-buffer-height)))))
|
||
|
(select-window window)))
|
||
|
|
||
|
(defun org-roam-buffer-toggle-display ()
|
||
|
"Toggle display of the `org-roam-buffer'."
|
||
|
(interactive)
|
||
|
(setq org-roam-last-window (get-buffer-window))
|
||
|
(pcase (org-roam-buffer--visibility)
|
||
|
('visible (delete-window (get-buffer-window org-roam-buffer)))
|
||
|
((or 'exists 'none) (org-roam-buffer--get-create))))
|
||
|
|
||
|
(provide 'org-roam-buffer)
|
||
|
|
||
|
;;; org-roam-buffer.el ends here
|