;;; org-roam-search.el --- A search interface that works better with org-roam -*- lexical-binding: t; -*- ;; Copyright (C) 2022 Chris Barrett ;; Author: Chris Barrett ;; Package-Requires: ((emacs "27.1") (async "1.9.5") (dash "2.19.1") (org-roam "2.2.2") (pcre2el "1.8")) ;; Homepage: https://github.com/chrisbarrett/nursery ;; Version: 0.0.1-pre ;; 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 . ;;; Commentary: ;; Org-roam works best when your nodes are divided into many files, but this ;; makes the org-search functionality unsuitable. ripgrep does a better job, but ;; has the problem that it shows the raw filenames instead of the node title. ;; This implementation of search aims to surface matched text along with the ;; title of the relevant node. ;; This package exposes two commands, `org-roam-search' and ;; `org-roam-search-tags', that search your org-roam nodes with ripgrep and ;; display a buffer of matching nodes. ;; Example configuration: ;; ;; (use-package org-roam-search ;; :commands (org-roam-search) ;; :general ;; (:keymaps 'org-roam-mode-map :states '(normal motion) ;; "s" 'org-roam-search)) ;;; Code: (require 'async) (require 'dash) (require 'org-roam) (require 'org-roam-review) (require 'pcre2el) (defgroup org-roam-search nil "Node search interface for org-roam." :group 'productivity :prefix "org-roam-search-") (defcustom org-roam-search-ripgrep-program "rg" "Path to the ripgrep program for searching notes." :group 'org-roam-search :type 'string) (defvar org-roam-search-buffer-name "*org-roam-search*") (defvar org-roam-search-tags-buffer-name "*org-roam-search-tags*") (defun org-roam-search--highlight-matches (regexp) (save-excursion (goto-char (point-min)) (save-match-data (let ((transpiled-regexp (pcre-to-elisp regexp))) (while (search-forward-regexp transpiled-regexp nil t) (unless (seq-intersection (face-at-point nil t) '(magit-section-heading org-roam-review-instructions)) (let ((overlay (make-overlay (let ((pt (match-beginning 0))) (goto-char pt) (min pt (or (car (save-match-data (bounds-of-thing-at-point 'word))) (line-end-position)))) (let ((pt (match-end 0))) (goto-char pt) (max pt (or (cdr (save-match-data (bounds-of-thing-at-point 'word))) (line-beginning-position))))))) (overlay-put overlay 'face 'org-roam-search-highlight)))))))) (defun org-roam-search--match-previews (search-regexp node) (let ((hits)) (save-match-data (with-temp-buffer (insert-file-contents (org-roam-node-file node)) (let ((org-inhibit-startup t)) (org-mode)) (goto-char (point-min)) (org-roam-end-of-meta-data t) (while (search-forward-regexp search-regexp nil t) (let ((hit (list :pos (match-beginning 0) :olp (ignore-errors (org-get-outline-path t t)) :preview ;; Extracted from implementation of ;; `org-roam-preview-get-contents' (let ((s (funcall org-roam-preview-function))) (dolist (fn org-roam-preview-postprocess-functions) (setq s (funcall fn s))) (org-roam-fontify-like-in-org-mode s))))) (push hit hits))))) (->> (nreverse hits) ;; Take the first hit from each outline (seq-group-by (lambda (it) (plist-get it :olp))) (ht-from-alist) (ht-map (lambda (_key values) (car values)))))) (defun org-roam-search-make-insert-preview-fn (search-regexp) (lambda (node) (let ((hits-in-file (org-roam-search--match-previews search-regexp node))) (cond (hits-in-file (--each-indexed hits-in-file (magit-insert-section section (org-roam-preview-section) (-let [(&plist :olp :preview :pos) it] (when (and olp (< 1 (length olp))) (let ((start (point)) (heading (propertize (string-join olp " > ") 'face 'org-roam-title))) (insert heading) (fill-region start (point)) (insert "\n"))) (insert preview) (oset section file (org-roam-node-file node)) (oset section point pos) (insert "\n\n"))))) ((string-match-p search-regexp (org-roam-node-title node)) (insert (propertize "(Matched title)" 'font-lock-face 'font-lock-comment-face)) (insert "\n\n")) (t (magit-cancel-section)))))) (defvar org-roam-search-view-query-history nil) (defun org-roam-search--ripgrep-for-nodes (query) (let ((reporter (make-progress-reporter "Searching nodes")) (files (ht-create))) (async-wait (async-start-process "ripgrep" org-roam-search-ripgrep-program (lambda (_) (goto-char (point-min)) (while (not (eobp)) (progress-reporter-update reporter) (-when-let* ((line (buffer-substring (line-beginning-position) (line-end-position))) ((parsed &as &plist :type) (json-parse-string line :object-type 'plist)) ((&plist :data (&plist :path (&plist :text file) :absolute_offset pos)) (when (equal "match" type) parsed)) (file (expand-file-name file org-roam-directory))) (puthash file file files)) (forward-line))) "--smart-case" "--json" query org-roam-directory)) (progress-reporter-done reporter) (seq-filter (lambda (node) (ht-get files (org-roam-node-file node))) (org-roam-review-node-list)))) ;;;###autoload (defun org-roam-search (query) "Search `org-roam-directory' for nodes matching a query. QUERY is a PRCE regexp string that will be passed to ripgrep." (interactive (list (let* ((default (car org-roam-search-view-query-history)) (prompt (format "Search Roam%s: " (if default (format " (default \"%s\")" default) ""))) (input (string-trim (read-string prompt nil 'org-roam-search-view-query-history org-roam-search-view-query-history)))) (if (and (string-match-p (rx "|") input) (not (string-prefix-p "(" input))) (format "(%s)" input) input)))) (org-roam-review-display-buffer-and-select (org-roam-review-create-buffer :title (format "Search Results: %s" query) :placeholder "No search results" :buffer-name org-roam-search-buffer-name :nodes (lambda () (org-roam-search--ripgrep-for-nodes query)) :render (-lambda ((&plist :nodes :placeholder :root-section)) (cond ((null nodes) (insert placeholder) (newline)) (t (pcase-dolist (`(,_file . ,group) (seq-group-by #'org-roam-node-file nodes)) (when-let* ((top-node (-max-by (-on #'< #'org-roam-node-level) group) ) (node-id (org-roam-node-id top-node)) (heading (org-link-display-format (org-roam-node-title top-node)))) (magit-insert-section section (org-roam-node-section node-id t) (magit-insert-heading (concat (propertize heading 'font-lock-face 'magit-section-heading) " " (when-let* ((mat (org-roam-review-node-maturity top-node))) (alist-get mat org-roam-review-maturity-emoji-alist nil nil #'equal)))) (oset section parent root-section) (oset section node top-node) (oset section washer (lambda () (org-roam-review-insert-preview top-node) (org-roam-search--highlight-matches query) (magit-section-maybe-remove-visibility-indicator section)))))) (org-roam-search--highlight-matches query))))))) ;;;###autoload (defun org-roam-search-tags (query) "Search `org-roam-directory' for nodes matching a tags query. QUERY is an `org-tags-filter'." (interactive (list (org-tags-filter-read "Search by tags filter (+/-): "))) (org-roam-review-modify-tags query t) (org-roam-review-display-buffer-and-select (org-roam-review-create-buffer :title "Tag Search Results" :instructions "The list below contains nodes matching the given tags." :placeholder "No search results" :buffer-name org-roam-search-tags-buffer-name :sort (-on #'string-lessp #'org-roam-node-title)))) (provide 'org-roam-search) ;;; org-roam-search.el ends here