From f4e1c403b0c483b77e9ea501f56f77b9ffaf4144 Mon Sep 17 00:00:00 2001
From: Jim Myhrberg <contact@jimeh.me>
Date: Wed, 6 Oct 2021 01:33:25 +0100
Subject: [PATCH] feat(editor): add project-buffer marginalia annotator

This is useful for annotating completion-read buffer results which all
belong to a single project, as it removes the project root from the
file path field, showing a relative path to each buffer's file from the
project root.
---
 modules/editor/siren-marginalia.el | 50 +++++++++++++++++++++---------
 1 file changed, 36 insertions(+), 14 deletions(-)

diff --git a/modules/editor/siren-marginalia.el b/modules/editor/siren-marginalia.el
index 9f413ef..6e3a3f6 100644
--- a/modules/editor/siren-marginalia.el
+++ b/modules/editor/siren-marginalia.el
@@ -7,25 +7,47 @@
 ;;; Code:
 
 (use-package marginalia
+  :demand t
   :bind (:map minibuffer-local-map
          ("M-A" . marginalia-cycle))
-  :init
-  (marginalia-mode +1)
 
-  (defun siren-marginalia-setup ()
-    (interactive)
-    (mapc
-     (lambda (x)
-       (pcase (car x)
-         ;; Default command category to 'marginalia-annotate-binding instead of
-         ;; 'marginalia-annotate-command which has a slight performance impact
-         ;; when filtering M-x candidates.
-         ('command (setcdr x (cons 'marginalia-annotate-binding
-                                   (remq 'marginalia-annotate-binding (cdr x)))))))
-     marginalia-annotator-registry))
+  :init
+  (defun marginalia-annotate-project-buffer (cand)
+    "Annotate project buffer CAND with modification status, file name and major
+mode."
+    (when-let (buffer (get-buffer cand))
+      (marginalia--fields
+       ((marginalia--buffer-status buffer))
+       ((marginalia--project-buffer-file buffer)
+        :truncate (/ marginalia-truncate-width 2)
+        :face 'marginalia-file-name))))
+
+  (defun marginalia--project-buffer-file (buffer)
+    "Return the file or process name of BUFFER relative to project root, if it
+is within project root."
+    (let ((root (marginalia--project-root))
+          (file (marginalia--buffer-file buffer)))
+      (if (string-equal root file) file
+        (string-remove-prefix root file))))
 
   :config
-  (siren-marginalia-setup))
+  ;; Default command category to 'marginalia-annotate-binding instead of
+  ;; 'marginalia-annotate-command which has a slight performance impact when
+  ;; filtering M-x candidates.
+  (mapc
+   (lambda (x)
+     (pcase (car x)
+       ('command
+        (setcdr x (cons 'marginalia-annotate-binding
+                        (remq 'marginalia-annotate-binding (cdr x)))))))
+   marginalia-annotator-registry)
+
+  ;; Add project-buffer annotator.
+  (add-to-list 'marginalia-annotator-registry
+               '(project-buffer marginalia-annotate-project-buffer))
+
+  ;; Enable marginalia.
+  (marginalia-mode +1))
 
 (provide 'siren-marginalia)
 ;;; siren-marginalia.el ends here