Org-roam search for backlinks

org-roam-search.el

;;; -*- lexical-binding: t -*-

(defun org-roam-search ()
  "Search for backlinks for a given article in a new buffer."
  (interactive)
  (let* ((source-org-roam-directory org-roam-directory)
         (completions (org-roam--get-title-path-completions))
         (title (completing-read "File: " completions))
         (file-path (cdr (assoc title completions)))
         (buf-name (format "*org-roam-search-%s*" title))
         (buf (get-buffer buf-name)))
    (unless buf
      (setq buf (get-buffer-create buf-name)))
    (with-current-buffer buf
      (org-roam-search-mode)
      (make-local-variable 'org-return-follows-link)
      (setq org-return-follows-link t)
      (setq-local org-roam-directory source-org-roam-directory)
      (setq-local default-directory source-org-roam-directory)
      (org-roam--search-setup file-path title)
      (setq buffer-read-only t))
    (switch-to-buffer-other-window buf)))

(define-derived-mode org-roam-search-mode org-mode
  '("Org-roam search" (:eval (spinner-print org-roam--spinner)))
  "Major mode for Org-roam search results buffers.")

(define-key org-roam-search-mode-map [mouse-1] 'org-roam-search-open-at-point)
(define-key org-roam-search-mode-map (kbd "RET") 'org-roam-search-open-at-point)

(defun org-roam-search-open-at-point ()
  "Open a link at point.

When point is on an org-roam link, open the link in the org-roam window.

When point is on the org-roam preview text, open the link in the org-roam
window, and navigate to the point.

If item at point is not org-roam specific, default to Org behaviour."
  (interactive)
  (let ((context (org-element-context)))
    (catch 'ret
      ;; Org-roam link
      (when (and (eq (org-element-type context) 'link)
                 (string= "file" (org-element-property :type context))
                 (org-roam--org-roam-file-p (file-truename (org-element-property :path context))))
        (org-roam--find-file-other-window (org-element-property :path context))
        (org-show-context)
        (throw 'ret t))
      ;; Org-roam preview text
      (when-let ((file-from (get-text-property (point) 'file-from))
                 (p (get-text-property (point) 'file-from-point)))
        (org-roam--find-file-other-window file-from)
        (goto-char p)
        (org-show-context)
        (throw 'ret t))
      ;; Default to default org behaviour
      (push-button))))

(defvar-local org-roam--reference-file nil)
(defvar-local org-roam--reference-title nil)
(defvar-local org-roam--spinner nil)
(defvar-local org-roam--full-reference nil)

(defun org-roam--find-file-other-window (file)
  "Open FILE in the window `org-roam' was called from."
  (if (and org-roam-last-window (window-valid-p org-roam-last-window))
      (progn (with-selected-window org-roam-last-window
               (find-file file))
             (select-window org-roam-last-window))
    (find-file-other-window file)))

(define-button-type 'org-roam-search-term
  'action #'org-roam--reference-file
  'help-echo "Change search term")

(defun org-roam--reference-file (_button)
  (let* ((completions (org-roam--get-title-path-completions))
         (title (completing-read "File: " completions))
         (file-path (cdr (assoc title completions)))
         (buf-name (format "*org-roam-search-%s*" title))
         (buf (current-buffer)))
    (rename-buffer buf-name t)
    (org-roam--search-setup file-path title)))

(define-button-type 'org-roam-toggle-reference-level
  'action #'org-roam--full-reference
  'help-echo "Toggle include full references")

(defun org-roam--full-reference (_button)
  (setq org-roam--full-reference (not org-roam--full-reference))
  (org-roam--search-setup org-roam--reference-file org-roam--reference-title)
  (goto-char (point-min)))

(defun org-roam--write-heading ()
  (let ((start-pos (point))
        (inhibit-read-only t))
    (insert (propertize "Article: " 'font-lock-face 'font-lock-comment-face)
            (propertize org-roam--reference-title 'font-lock-face 'org-document-title)
            " "
            (make-text-button "change" nil :type 'org-roam-search-term)
            "\n"

            (propertize "References: " 'font-lock-face 'font-lock-comment-face)
            (if org-roam--full-reference "full" "partial")
            " "
            (make-text-button "toggle" nil :type 'org-roam-toggle-reference-level)
            "\n")))

(defun org-roam--add-references ()
  (let ((start-pos (point))
        (inhibit-read-only t))
    (if-let* ((backlinks (org-roam--get-backlinks org-roam--reference-file))
              (grouped-backlinks (--group-by (nth 0 it) backlinks)))
        (progn
          (insert (format "\n* Backlinks\n"))
          (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)))
              (cond (org-roam--full-reference
                     (let ((start (point)))
                       (insert (f-read-text file-from))
                       (org-map-region 'org-demote start (point))
                       (org-map-region 'org-demote start (point))))

                    (t (dolist (backlink bls)
                         (pcase-let ((`(,file-from ,file-to ,props) backlink))
                           (insert (propertize
                                    (s-trim (s-replace "\n" " "
                                                       (plist-get props :content)))
                                    'font-lock-face 'org-block
                                    'help-echo "mouse-1: visit backlinked note"
                                    'file-from file-from
                                    'file-from-point (plist-get props :point)))
                           (insert "\n\n"))))))))
      (insert "\n* No backlinks!"))))

(defun org-roam--search-setup (file-path title)
  (let ((inhibit-read-only t))
    (setq org-roam--reference-file file-path)
    (setq org-roam--reference-title title)
    (erase-buffer)
    (org-roam--write-heading)
    (org-roam--add-references)))