From 1baea0c4c2c528e78c4f3881d5c2650ac7bd73b6 Mon Sep 17 00:00:00 2001
From: Henrik Lissner <git@henrik.io>
Date: Wed, 20 Sep 2023 20:18:53 +0200
Subject: [PATCH] feat(beancount): add +beancount/occur command

Inspired by org-occur (or org-sparse-tree): hides all
transactions/directives in the buffer that don't involve a selected
account.
---
 modules/lang/beancount/autoload.el | 34 ++++++++++++++++++++++++++++++
 modules/lang/beancount/config.el   |  1 +
 2 files changed, 35 insertions(+)

diff --git a/modules/lang/beancount/autoload.el b/modules/lang/beancount/autoload.el
index 0f162a0c3..599620ca3 100644
--- a/modules/lang/beancount/autoload.el
+++ b/modules/lang/beancount/autoload.el
@@ -168,6 +168,40 @@ Updates the date to today."
         (beancount-insert-date)
         (insert transaction)))))
 
+;;;###autoload
+(defun +beancount/occur (account &optional disable?)
+  "Hide transactions that don't involve ACCOUNT.
+
+If DISABLE? (universal arg), reveal hidden accounts without prompting."
+  (interactive
+   (list (unless current-prefix-arg
+           ;; REVIEW: Could/should this be generalized to search for arbitrary
+           ;;   regexps, if desired?
+           (completing-read "Account: " #'beancount-account-completion-table))
+         current-prefix-arg))
+  (with-silent-modifications
+    (save-excursion
+      (setq header-line-format nil)
+      ;; TODO: Namespace these text-properties, in case of conflicts
+      (remove-text-properties (point-min) (point-max) '(invisible nil display nil))
+      (unless disable?
+        ;; TODO: Prettier header-line display
+        (setq header-line-format `("" "Filtering by account: " ,account))
+        (let ((start (point-min))
+              (placeholder (propertize "[...]\n" 'face 'shadow)))
+          (goto-char start)
+          (while (re-search-forward (concat "\\_<" (regexp-quote account) "\\_>") nil t)
+            (save-excursion
+              (seq-let (beg end) (beancount-find-transaction-extents (point))
+                ;; TODO: Highlight entry (ala org-occur)
+                (if (= beg end)
+                    (setq end (save-excursion (goto-char end) (1+ (eol)))))
+                (put-text-property start beg 'invisible t)
+                (put-text-property start beg 'display placeholder)
+                (setq start end))))
+          (put-text-property start (point-max) 'invisible t)
+          (put-text-property start (point-max) 'display placeholder))))))
+
 ;;;###autoload
 (defun +beancount/next-transaction (&optional count)
   "Jump to the start of the next COUNT-th transaction."
diff --git a/modules/lang/beancount/config.el b/modules/lang/beancount/config.el
index 86dac64c0..79e2cffc8 100644
--- a/modules/lang/beancount/config.el
+++ b/modules/lang/beancount/config.el
@@ -25,6 +25,7 @@
         :localleader
         "b" #'+beancount/balance
         "c" #'beancount-check
+        "s" #'+beancount/occur
         "l" #'beancount-linked
         "q" #'beancount-query
         "x" #'beancount-context