From 3af5fb99b5a91c25b929490767e4a17bf07be875 Mon Sep 17 00:00:00 2001 From: "Aaron L. Zeng" Date: Sun, 1 Feb 2026 06:46:22 -0500 Subject: [PATCH 1/2] Rename local variable to match its actual contents Also remove some slightly overly-verbose comments. --- ledger-occur.el | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/ledger-occur.el b/ledger-occur.el index 4b23b0f6..40447303 100644 --- a/ledger-occur.el +++ b/ledger-occur.el @@ -145,19 +145,17 @@ Argument OVL-BOUNDS contains bounds for the transactions to be left visible." "Return a list of bounds for transactions matching REGEX." (save-excursion (goto-char (point-min)) - ;; Set initial values for variables - (let (lines) - ;; Search loop + (let (all-bounds) (while (not (eobp)) ;; if something found (when-let* ((endpoint (re-search-forward regex nil 'end)) (bounds (ledger-navigate-find-element-extents endpoint))) - (push bounds lines) + (push bounds all-bounds) ;; Move to the end of the xact, no need to search inside it more. ;; Defensive: if extent end is at or before point, advance past the ;; match end so the loop can never wedge. (goto-char (max (cadr bounds) (1+ (match-end 0)))))) - (nreverse lines)))) + (nreverse all-bounds)))) (defun ledger-occur-compress-matches (buffer-matches) "Identify sequential xacts to reduce number of overlays required. From 863bacf1d6916e104ec46f1e1bcdba55c968eca0 Mon Sep 17 00:00:00 2001 From: "Aaron L. Zeng" Date: Sun, 1 Feb 2026 07:14:42 -0500 Subject: [PATCH 2/2] occur: Allow ledger-occur to specify multiple combined filters - C-c C-f when narrowing is already in effect no longer immediately clears it - C-c C-f may be used to specify additional filters which are ANDed with previous ones - C-u C-c C-f may be used to pop the most recently-specified filter - C-u C-u C-c C-f may be used to remove all filters without prompting - ledger-occur-mode no longer automatically disables itself when there are no matches, as the user may simply wish to remove a single filter from the list --- ledger-occur.el | 91 ++++++++++++++++++++++++++++++--------------- test/occur-test.el | 55 ++++++++++++++++++++++++--- test/test-helper.el | 2 +- 3 files changed, 111 insertions(+), 37 deletions(-) diff --git a/ledger-occur.el b/ledger-occur.el index 40447303..eb1acf9e 100644 --- a/ledger-occur.el +++ b/ledger-occur.el @@ -45,26 +45,25 @@ This uses `ledger-occur-xact-face'." (defvar ledger-occur-history nil "History of previously searched expressions for the prompt.") -(defvar-local ledger-occur-current-regex nil +(defvar-local ledger-occur-current-regexes nil "Pattern currently applied to narrow the buffer.") (defvar ledger-occur-mode-map (let ((map (make-sparse-keymap))) (define-key map (kbd "C-c C-g") #'ledger-occur-refresh) - (define-key map (kbd "C-c C-f") #'ledger-occur-mode) map) "Keymap used by `ledger-occur-mode'.") (define-minor-mode ledger-occur-mode - "A minor mode which display only transactions matching a pattern. -The pattern is given by `ledger-occur-current-regex'." + "A minor mode which display only transactions matching a list of patterns. +The patterns are given by `ledger-occur-current-regexes'." :init-value nil - :lighter (:eval (format " Ledger-Narrow(%s)" ledger-occur-current-regex)) - :keymap ledger-occur-mode-map - (if (and ledger-occur-current-regex ledger-occur-mode) + :lighter (:eval (format " Ledger-Narrow(%s)" ledger-occur-current-regexes)) + (if (and ledger-occur-current-regexes ledger-occur-mode) (progn (ledger-occur-refresh) ;; Clear overlays after revert-buffer and similar commands. (add-hook 'change-major-mode-hook #'ledger-occur-remove-overlays nil t)) + (setq ledger-occur-current-regexes nil) (ledger-occur-remove-overlays) (message "Showing all transactions"))) @@ -72,25 +71,42 @@ The pattern is given by `ledger-occur-current-regex'." "Re-apply the current narrowing expression." (interactive) (let ((matches (ledger-occur-compress-matches - (ledger-occur-find-matches ledger-occur-current-regex)))) - (if matches - (ledger-occur-create-overlays matches) - (message "No matches found for '%s'" ledger-occur-current-regex) - (ledger-occur-mode -1)))) + (ledger-occur-find-matches ledger-occur-current-regexes)))) + (ledger-occur-create-overlays matches) + (unless matches + (message "No matches found for:\n%s\n\n%s" + (string-join ledger-occur-current-regexes "\n") + (substitute-command-keys "Press \\[universal-argument] \\[ledger-occur] to remove the most recent filter."))))) (defun ledger-occur (regex) "Show only transactions in the current buffer which match REGEX. -This command hides all xact in the current buffer except those -matching REGEX. If REGEX is nil or empty, turn off any narrowing -currently active." +If filtering is already in effect, further filter the shown +transactions, so that only transactions which match all of the REGEX +filters specified so far are displayed. + +This command hides all xact in the current buffer except those matching +REGEX. If REGEX is the symbol `pop', or a prefix argument has been +provided interactively, remove the most recently-added REGEX filter +instead. If REGEX is nil or empty, or with two prefix arguments, turn +off any narrowing currently active." (interactive - (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))) + (cond + ((equal current-prefix-arg '(16)) (list nil)) + (current-prefix-arg (list 'pop)) + (t (list (read-regexp "Regexp" (ledger-occur-prompt) 'ledger-occur-history))))) + (cond + ((eq regex 'pop) + (pop ledger-occur-current-regexes) + (if ledger-occur-current-regexes + (ledger-occur-mode 1) + (ledger-occur-mode -1))) + ((or (null regex) + (zerop (length regex))) ; empty regex, clear narrowing + (ledger-occur-mode -1)) + (t + (push regex ledger-occur-current-regexes) + (ledger-occur-mode 1)))) (defun ledger-occur-prompt () "Return the default value of the prompt. @@ -141,20 +157,35 @@ Argument OVL-BOUNDS contains bounds for the transactions to be left visible." (remove-overlays (point-min) (point-max) ledger-occur-overlay-property-name t)) -(defun ledger-occur-find-matches (regex) - "Return a list of bounds for transactions matching REGEX." +(defun ledger-occur-find-matches (regexes) + "Return a list of bounds for transactions matching REGEXES. + +REGEXES must be non-nil. + +Only transactions whose bodies match all of the regexps in REGEXES are +included in the return value. The occurrences may be in any order." + ;; Check the regexes in the order that they were specified by the user. In + ;; some edge cases, this may produce different behavior than without reversing + ;; `regexes'. + (setq regexes (reverse regexes)) (save-excursion (goto-char (point-min)) (let (all-bounds) (while (not (eobp)) - ;; if something found - (when-let* ((endpoint (re-search-forward regex nil 'end)) + ;; if something found, check that the remaining regexes all match + (when-let* ((endpoint (re-search-forward (car regexes) nil 'end)) (bounds (ledger-navigate-find-element-extents endpoint))) - (push bounds all-bounds) - ;; Move to the end of the xact, no need to search inside it more. - ;; Defensive: if extent end is at or before point, advance past the - ;; match end so the loop can never wedge. - (goto-char (max (cadr bounds) (1+ (match-end 0)))))) + (when (cl-every + (lambda (regex) + (save-excursion + (goto-char (car bounds)) + (re-search-forward regex (cadr bounds) t))) + (cdr regexes)) + (push bounds all-bounds) + ;; Move to the end of the xact, no need to search inside it more. + ;; Defensive: if extent end is at or before point, advance past the + ;; match end so the loop can never wedge. + (goto-char (max (cadr bounds) (1+ (match-end 0))))))) (nreverse all-bounds)))) (defun ledger-occur-compress-matches (buffer-matches) diff --git a/test/occur-test.el b/test/occur-test.el index d4175bcd..e26aa03b 100644 --- a/test/occur-test.el +++ b/test/occur-test.el @@ -124,6 +124,21 @@ https://github.com/ledger/ledger-mode/issues/54" ;; no matches (ledger-occur "zzzzzz") + (should (equal (ledger-test-visible-buffer-string) "")) + + ;; remove last filter + (ledger-occur 'pop) + (should + (equal (ledger-test-visible-buffer-string) + "\ + +2024-03-15 Employer + * Assets:Checking $2000.00 + Income:Salary +")) + + ;; turn off filtering entirely + (ledger-occur nil) (should (equal (ledger-test-visible-buffer-string) "\ @@ -215,12 +230,40 @@ https://github.com/ledger/ledger-mode/issues/415" Expenses:Food:Groceries $50 Assets:Checking " - (cl-letf (((symbol-function 'read-regexp) - (lambda (&rest _) "Groceries"))) - (call-interactively #'ledger-occur) - (should ledger-occur-mode) - (should (equal "Groceries" ledger-occur-current-regex))))) - + (let ((user-inputs '("Groceries" "Checking" "Groceries" "Checking"))) + (cl-letf (((symbol-function 'read-regexp) + (lambda (&rest _) (pop user-inputs)))) + (call-interactively #'ledger-occur) + (should ledger-occur-mode) + (should (equal '("Groceries") ledger-occur-current-regexes)) + + ;; second call adds a new filter + (call-interactively #'ledger-occur) + (should ledger-occur-mode) + (should (equal '("Checking" "Groceries") ledger-occur-current-regexes)) + + ;; with prefix argument, pops a filter + (let ((current-prefix-arg '(4))) + (call-interactively #'ledger-occur)) + (should ledger-occur-mode) + (should (equal '("Groceries") ledger-occur-current-regexes)) + + (let ((current-prefix-arg '(4))) + (call-interactively #'ledger-occur)) + (should-not ledger-occur-mode) + (should (null ledger-occur-current-regexes)) + + ;; add both filters back + (call-interactively #'ledger-occur) + (call-interactively #'ledger-occur) + (should (equal '("Checking" "Groceries") ledger-occur-current-regexes)) + (should ledger-occur-mode) + + ;; double prefix argument removes all filtering + (let ((current-prefix-arg '(16))) + (call-interactively #'ledger-occur)) + (should-not ledger-occur-mode) + (should (null ledger-occur-current-regexes)))))) (ert-deftest ledger-occur/test-prompt-region () "`ledger-occur-prompt' returns active region when single-line." diff --git a/test/test-helper.el b/test/test-helper.el index 1a17bf0a..d45eb728 100644 --- a/test/test-helper.el +++ b/test/test-helper.el @@ -134,7 +134,7 @@ always located at the beginning of buffer." (defun ledger-test-visible-buffer-substring (start end) "Same as `buffer-substring', but excludes invisible text. The two arguments START and END are character positions." - (let (str) + (let ((str "")) (while (< start end) (let ((next-pos (next-char-property-change start end))) (when (not (invisible-p start))