Merge pull request #13 from jgru/add-consult-buffer-source

Add consult-org-roam-buffer

consult-org-roam-buffer.el

@@ -0,0 +1,151 @@
+;;; consult-org-roam-buffer.el --- Consult-buffer integration for org-roam  -*- lexical-binding: t; -*-
+;; Copyright (C) 2022 jgru
+
+;; Author: apc <https://github.com/apc> and jgru <https://github.com/jgru>
+;; Created: October 7th, 2022
+;; SPDX-License-Identifier: GPL-3.0-or-later
+;; Version: 0.1
+;; Homepage: https://github.com/jgru/consult-org-roam
+;; Package-Requires: ((emacs "27.1") (org-roam "2.2.0") (consult "0.16"))
+
+;;; Commentary:
+
+;; This is a set of functions to add a custom source to consult-buffer
+;; for org-roam notes.
+
+;;; Code:
+
+;; ============================================================================
+;;;; Dependencies
+;; ============================================================================
+
+(require 'org-roam)
+(require 'consult)
+
+;; ============================================================================
+;;;; Customize definitions
+;; ============================================================================
+
+(defgroup consult-org-roam-buffer nil
+  "Consult buffer source for org-roam."
+  :group 'org
+  :group 'convenience
+  :prefix "consult-org-roam-buffer-")
+
+(defcustom consult-org-roam-buffer-narrow-key ?n
+  "Narrow key for consult-buffer"
+  :type 'key
+  :group 'consult-org-roam-buffer)
+
+(defcustom consult-org-roam-buffer-after-buffers nil
+  "If non-nil, display org-roam buffers right after non-org-roam buffers.
+  Otherwise, display org-roam buffers after any other visible default
+  source")
+
+;; ============================================================================
+;;;; Functions
+;; ============================================================================
+
+(defun consult-org-roam-buffer--state ()
+  (let ((preview (consult--buffer-preview)))
+    (lambda
+      (action cand)
+      (funcall preview action
+        (consult-org-roam-buffer--with-title cand))
+      (when
+        (and cand
+          (eq action 'return))
+        (consult--buffer-action
+          (consult-org-roam-buffer--with-title cand))))))
+
+(defun consult-org-roam-buffer--get-title (buffer)
+  "Get title of org-roam BUFFER."
+  (if (org-roam-buffer-p buffer)
+    (let* ((title
+             (with-current-buffer buffer
+               (org-roam-db--file-title)))
+            (filename (buffer-file-name buffer))
+            (fhash (consult-org-roam-db--file-hash filename)))
+      (if fhash
+        (progn
+          ;; Add hash to differentiate between notes with identical
+          ;; titles but make it invisible to not disturb the user
+          (add-text-properties 0 (length fhash) '(invisible t) fhash)
+          (concat title fhash))
+        ;; Handle edge cases where the org-roam buffer has not yet
+        ;; been written to disk (and DB)
+        (concat title " [File deleted]")))))
+
+(defun consult-org-roam-db--file-hash (fname)
+  "Retrieve the hash of FNAME from org-roam's db "
+  (let* ((fhash (org-roam-db-query
+                  [:select [hash]
+                    :from files
+                    :where (like file $s1)
+                    ]
+                  (concat "%" fname))))
+    (car (car fhash))))
+
+(defun consult-org-roam-buffer--add-title (buffer)
+  "Build a cons consisting of the BUFFER title and the BUFFER name"
+  (cons (consult-org-roam-buffer--get-title buffer) buffer))
+
+(defun consult-org-roam-buffer--update-open-buffer-list ()
+  "Generate an alist of the form `(TITLE . BUF)’, where TITLE is the title of an open org-roam buffer"
+  (setq org-roam-buffer-open-buffer-list
+    (mapcar #'consult-org-roam-buffer--add-title
+      (org-roam-buffer-list))))
+
+(defun consult-org-roam-buffer--with-title (title)
+  "Find buffer name with TITLE from among the list of open org-roam buffers"
+  (consult-org-roam-buffer--update-open-buffer-list)
+  (cdr (assoc title org-roam-buffer-open-buffer-list)))
+
+(defun consult-org-roam-buffer--get-roam-bufs ()
+  "Return list of currently open org-roam buffers"
+  (consult--buffer-query
+    :sort 'visibility
+    :as #'consult-org-roam-buffer--get-title
+    :filter t
+    :predicate (lambda (buf) (org-roam-buffer-p buf))))
+
+;; Define source for consult-buffer
+(defvar org-roam-buffer-source
+  `(:name     "Org-roam"
+     :hidden   nil
+     :narrow   ,consult-org-roam-buffer-narrow-key
+     :category org-roam-buffer
+     :annotate ,(lambda (cand)
+                  (f-filename
+                    (buffer-file-name
+                      (consult-org-roam-buffer--with-title cand))))
+     :state    ,#'consult-org-roam-buffer--state
+     :items    ,#'consult-org-roam-buffer--get-roam-bufs))
+
+(defun consult-org-roam-buffer-setup ()
+  ;; Remove potentially org-roam-buffer-source to avoid duplicate
+  (setq consult-buffer-sources
+    (delete 'org-roam-buffer-source consult-buffer-sources))
+  (if consult-org-roam-buffer-after-buffers
+    (let* ((idx (cl-position 'consult--source-buffer consult-buffer-sources :test 'equal))
+           (tail (nthcdr idx consult-buffer-sources)))
+      (setcdr
+       (nthcdr (1- idx) consult-buffer-sources)
+       (append (list 'org-roam-buffer-source) tail)))
+    (add-to-list 'consult-buffer-sources 'org-roam-buffer-source 'append)))
+
+(eval-after-load
+;; Customize consult--source-buffer to show org-roam buffers only in
+;; their dedicated section
+(consult-customize
+  consult--source-buffer
+  :items (lambda ()
+           (consult--buffer-query
+             :sort 'visibility
+             :as #'buffer-name
+             :predicate (lambda (buf) (not (org-roam-buffer-p buf))))))
+
+  (consult-org-roam-buffer-setup))
+
+(provide 'consult-org-roam-buffer)
+;;; consult-org-roam-buffer.el ends here

consult-org-roam.el

@@ -24,6 +24,7 @@
 
 (require 'org-roam)
 (require 'consult)
+(require 'consult-org-roam-buffer)
 
 ;; ============================================================================
 ;;;; Customize definitions
@@ -228,6 +229,7 @@ argument ARG indicates whether the mode should be enabled or disabled."
   ;; Add or remove advice when enabled respectively disabled
   (if consult-org-roam-mode
       (progn
+        (consult-org-roam-buffer-setup)
         (advice-add #'org-roam-node-read :override #'consult-org-roam-node-read)
         (advice-add #'org-roam-ref-read :override #'consult-org-roam-ref-read))
     (progn

readme.org

@@ -6,27 +6,31 @@
 #+html: <a href="https://melpa.org/#/consult-org-roam"><img alt="MELPA" src="https://melpa.org/packages/consult-org-roam-badge.svg"/></a>
 
 This is a collection of functions to operate [[https://github.com/org-roam/org-roam][org-roam]] with the help of
-[[https://github.com/minad/consult][consult]] and its live preview feature.
+[[https://github.com/minad/consult][consult]] and its live preview feature. You can use it to search, filter
+and find notes, preview backlinks as well as forward links, and sift
+through currently open org-roam buffers.
 
 * Overview and usage
+
+** =consult-org-roam.el=
 =consult-org-roam.el= provides several functions to connect [[https://github.com/org-roam/org-roam][org-roam]]
 to [[https://github.com/minad/consult][consult]]'s completing read interface. On the one hand, it provides
 the following standalone functions which enhance =org-roam='s
 capabilities:
 
-- =consult-org-roam-search= :: Search your roam-directory with grep
-  or [[https://github.com/BurntSushi/ripgrep][ripgrep]]
+- =consult-org-roam-file-find= :: Search your org-roam files with
+  consult's completing-read and its live preview
 - =consult-org-roam-backlinks= :: List backlinks to
   =org-roam-node-at-point= (e.g. currently open note) and sift through
   them with consult's completing-read and its live preview
 - =consult-org-roam-forward-links= :: List forward links contained in
   the currently opened note
-- =consult-org-roam-file-find= :: Search your org-roam files with
-  consult's completing-read and its live preview
+- =consult-org-roam-search= :: [[https://github.com/minad/consult#asynchronous-search][Asynchronously search]] your
+  roam-directory with [[https://www.gnu.org/software/grep/manual/grep.html][grep]] or [[https://github.com/BurntSushi/ripgrep][ripgrep]]
 
 On the other hand, it provides a minormode called
-=consult-org-roam-mode=. When activated =org-roam-node-read= is
-overridden which is used by =org-roam-node-find=,
+=consult-org-roam-mode=. When activated, =org-roam-node-read= is
+overridden, which is used by =org-roam-node-find=,
 =org-roam-node-insert= and =org-roam-refile=. By doing so, all
 functions utilizing completing-read resort to =consult= for performing
 completion. Furthermore, the same is done for =org-roam-ref-read= so
@@ -36,30 +40,49 @@ Eventually, you might want to suppress previewing for certain
 functions. This can be done by adding using
 =consult-customize=.
 
+** =consult-org-roam-buffer.el=
+=consult-org-roam-buffer.el= adds a new source to =consult-buffer= for
+narrowing the selection to the currently open org-roam buffers. The
+predefined narrow-key is =n= (for notes) but could be conveniently
+customized via =consult-org-roam-buffer-narrow-key=.
+
 * Installation
-Install it from Melpa
+You can install it from Melpa. If you are using =use-package=, the following
+snippet might serve as a viable starting point:
+
 #+begin_src elisp
 (use-package consult-org-roam
    :ensure t
+   :after org-roam
    :init
    (require 'consult-org-roam)
-   ;; Activate the minor-mode
+   ;; Activate the minor mode
    (consult-org-roam-mode 1)
    :custom
+   ;; Use `ripgrep' for searching with `consult-org-roam-search'
    (consult-org-roam-grep-func #'consult-ripgrep)
+   ;; Configure a custom narrow key for `consult-buffer'
+   (consult-org-roam-buffer-narrow-key ?r)
+   ;; Display org-roam buffers right after non-org-roam buffers
+   ;; in consult-buffer (and not down at the bottom)
+   (consult-org-roam-buffer-after-buffers t)
    :config
    ;; Eventually suppress previewing for certain functions
    (consult-customize
     consult-org-roam-forward-links
     :preview-key (kbd "M-."))
    :bind
+   ;; Define some convenient keybindings as an addition
    ("C-c n e" . consult-org-roam-file-find)
    ("C-c n b" . consult-org-roam-backlinks)
+   ("C-c n l" . consult-org-roam-forward-links)
    ("C-c n r" . consult-org-roam-search))
 #+end_src
 
 * Dependencies
-=consult-org-roam= is built on top of [[https://github.com/org-roam/org-roam][org-roam]] and [[https://github.com/minad/consult][consult]], it relies on its functionality.
+=consult-org-roam= is built on top of [[https://github.com/org-roam/org-roam][org-roam]] and [[https://github.com/minad/consult][consult]], it relies
+on its functionality.
 
-Furthermore, ensure that you have [[https://github.com/BurntSushi/ripgrep][ripgrep]] installed on your system, if
-you set =consult-org-roam-grep-func= to =#'consult-ripgrep=.
+Furthermore, ensure that you have at least [[https://www.gnu.org/software/grep/manual/grep.html][grep]] or [[https://github.com/BurntSushi/ripgrep][ripgrep]] installed
+on your system, and set =consult-org-roam-grep-func= to
+=#'consult-ripgrep= when using the latter.