[emacs] Simplify and tidy up ledger-occur

Introducing a proper minor mode saves a lot of the hand-rolled fiddling
about, like managing the overlay lifecycle and the modeline.

3 files changed, 39 insertions, 71 deletions

diff --git a/lisp/ledger-mode.el b/lisp/ledger-mode.el
index ac75ea3c..12eb6414 100644
--- a/lisp/ledger-mode.el
+++ b/lisp/ledger-mode.el
@@ -337,7 +337,6 @@ With a prefix argument, remove the effective date."
 	(add-hook 'after-save-hook 'ledger-report-redo)
 
   (add-hook 'post-command-hook 'ledger-highlight-xact-under-point nil t)
-  (add-hook 'before-revert-hook 'ledger-occur-remove-all-overlays nil t)
 
   (ledger-init-load-init-file)
   (setq comment-start ";")
diff --git a/lisp/ledger-occur.el b/lisp/ledger-occur.el
index 8965cce1..4cda43b8 100644
--- a/lisp/ledger-occur.el
+++ b/lisp/ledger-occur.el
@@ -29,6 +29,9 @@
 
 ;;; Code:
 
+(require 'cl)
+(require 'ledger-navigate)
+
 (defconst ledger-occur-overlay-property-name 'ledger-occur-custom-buffer-grep)
 
 (defcustom ledger-occur-use-face-shown t
@@ -38,79 +41,54 @@
 (make-variable-buffer-local 'ledger-occur-use-face-shown)
 
 
-(defvar ledger-occur-mode-name nil
-  "name of the minor mode, shown in the mode-line")
-
-(make-variable-buffer-local 'ledger-occur-mode-name)
-
-(or (assq 'ledger-occur-mode-name minor-mode-alist)
-    (nconc minor-mode-alist
-           (list '(ledger-occur-mode-name ledger-occur-mode-name))))
-
 (defvar ledger-occur-history nil
   "History of previously searched expressions for the prompt.")
 
-
-(defun ledger-occur-remove-all-overlays ()
-  "Remove all overlays from the ledger buffer."
-  (interactive)
-  (remove-overlays))
-
-(defun ledger-occur-mode (regex buffer)
-  "Highlight transactions that match REGEX in BUFFER, hiding others.
-
-When REGEX is nil, unhide everything, and remove higlight"
-  (set-buffer buffer)
-	(let (matches)
-		(if (or (not regex)
-						(zerop (length regex)))  ; empty regex, or already have narrowed, clear narrowing
-				(progn
-					(setq ledger-occur-mode-name nil)
-					(ledger-occur-remove-overlays))
-			(if (not (setq matches (ledger-occur-compress-matches (ledger-occur-find-matches regex))))
-					(progn  ; regex couldn't be found
-						(message "No matches found for '%s'" regex)
-						(setq ledger-occur-mode-name nil)
-						(ledger-occur-remove-overlays))
-				(setq ledger-occur-mode-name
-							(concat " Ledger-Narrowed: " regex))
-				(ledger-occur-create-overlays matches)
-				(if (get-buffer-window buffer)
-						(select-window (get-buffer-window buffer))))))
-	(force-mode-line-update)
-  (recenter))
-
+(defvar ledger-occur-current-regex nil
+  "Pattern currently applied to narrow the buffer.")
+(make-variable-buffer-local 'ledger-occur-current-regex)
+
+(define-minor-mode ledger-occur-mode
+  "A minor mode which display only transactions matching `ledger-occur-current-regex'."
+  nil (:eval (format " Ledger-Narrow(%s)" ledger-occur-current-regex)) nil
+  (if ledger-occur-mode
+      (let ((matches (ledger-occur-compress-matches
+                      (ledger-occur-find-matches ledger-occur-current-regex))))
+        (unless matches
+          (error "No matches found for '%s'" ledger-occur-current-regex))
+        (ledger-occur-create-overlays matches))
+    (ledger-occur-remove-overlays)))
 
 (defun ledger-occur (regex)
-  "Perform a simple grep in current buffer for the regular expression REGEX.
+  "Show only transactions in the current buffer which match REGEX.
 
-   This command hides all xact from the current buffer except
-   those containing the regular expression REGEX.  A second call
-   of the function unhides lines again"
+This command hides all xact in the current buffer except those
+matching REGEX.  When called interactively, a second call of the
+function redisplays the hidden transactions."
   (interactive
-   (if ledger-occur-mode-name
+   (if ledger-occur-mode
        (list nil)
-     (list (read-string (concat "Regexp<" (ledger-occur-prompt) ">: ")
-                        nil 'ledger-occur-history (ledger-occur-prompt)))))
-  (ledger-occur-mode regex (current-buffer)))
+     (list (read-regexp "Regexp" (ledger-occur-prompt) 'ledger-occur-history))))
+  (if (or (null regex)
+          (zerop (length regex)))  ; empty regex, or already have narrowed, clear narrowing
+      (ledger-occur-mode -1)
+    (setq ledger-occur-current-regex regex)
+    (ledger-occur-mode 1)))
 
 (defun ledger-occur-prompt ()
   "Return the default value of the prompt.
 
    Default value for prompt is a current word or active
    region(selection), if its size is 1 line"
-  (let ((prompt
-         (if (and transient-mark-mode
-                  mark-active)
-             (let ((pos1 (region-beginning))
-                   (pos2 (region-end)))
-               ;; Check if the start and the of an active region is on
-               ;; the same line
-               (if (= (line-number-at-pos pos1)
-                      (line-number-at-pos pos2))
-                   (buffer-substring-no-properties pos1 pos2)))
-           (current-word))))
-    prompt))
+  (if (use-region-p)
+      (let ((pos1 (region-beginning))
+            (pos2 (region-end)))
+        ;; Check if the start and the of an active region is on
+        ;; the same line
+        (if (= (line-number-at-pos pos1)
+               (line-number-at-pos pos2))
+            (buffer-substring-no-properties pos1 pos2)))
+    (current-word)))
 
 
 (defun ledger-occur-make-visible-overlay (beg end)
@@ -137,15 +115,6 @@ Argument OVL-BOUNDS contains bounds for the transactions to be left visible."
       (setq end (cadr visible)))
     (ledger-occur-make-invisible-overlay (1+ end) (point-max))))
 
-(defun ledger-occur-quit-buffer (buffer)
-  "Quits hidings transaction in the given BUFFER.
-Used for coordinating `ledger-occur' with other buffers, like reconcile."
-  (set-buffer buffer)
-  (setq ledger-occur-mode nil)
-  (force-mode-line-update)
-  (ledger-occur-remove-overlays)
-  (recenter))
-
 (defun ledger-occur-remove-overlays ()
   "Remove the transaction hiding overlays."
   (interactive)
diff --git a/lisp/ledger-reconcile.el b/lisp/ledger-reconcile.el
index 61e2ba6f..5a10e89d 100644
--- a/lisp/ledger-reconcile.el
+++ b/lisp/ledger-reconcile.el
@@ -304,7 +304,7 @@ and exit reconcile mode"
         (with-current-buffer buf
           (remove-hook 'after-save-hook 'ledger-reconcile-refresh-after-save t)
           (when ledger-narrow-on-reconcile
-            (ledger-occur-quit-buffer buf)
+            (ledger-occur-mode -1)
             (ledger-highlight-xact-under-point))))))
 
 (defun ledger-marker-where-xact-is (emacs-xact posting)
@@ -481,7 +481,7 @@ moved and recentered.  If they aren't strange things happen."
 			(with-current-buffer rbuf
 				(save-excursion
 					(if ledger-narrow-on-reconcile
-							(ledger-occur-mode account ledger-buf)))
+							(ledger-occur account)))
 				(if (> (ledger-reconcile-refresh) 0)
 						(ledger-reconcile-change-target))
 				(ledger-display-balance)))))