From 529617291722a08fcd9206ba9fdf2d0aec2579b2 Mon Sep 17 00:00:00 2001 From: "Aaron L. Zeng" Date: Tue, 19 Mar 2024 00:14:00 -0400 Subject: [PATCH 1/6] Add regression test for #54 --- test/occur-test.el | 51 +++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 46 insertions(+), 5 deletions(-) diff --git a/test/occur-test.el b/test/occur-test.el index afa6242ff..072d334b9 100644 --- a/test/occur-test.el +++ b/test/occur-test.el @@ -35,7 +35,7 @@ http://bugs.ledger-cli.org/show_bug.cgi?id=246" :tags '(occur regress) (ledger-tests-with-temp-file - "2011/01/02 Grocery Store + "2011/01/02 Grocery Store Expenses:Food:Groceries $ 65.00 * Assets:Checking @@ -43,14 +43,55 @@ http://bugs.ledger-cli.org/show_bug.cgi?id=246" * Assets:Checking $ 2000.00 Income:Salary " - (ledger-occur "Groceries") - (should - (equal (ledger-test-visible-buffer-string) - "2011/01/02 Grocery Store + (ledger-occur "Groceries") + (should + (equal (ledger-test-visible-buffer-string) + "2011/01/02 Grocery Store Expenses:Food:Groceries $ 65.00 * Assets:Checking ")))) +(ert-deftest ledger-occur/test-002 () + "Regression test for #54. +https://github.com/ledger/ledger-mode/issues/54" + :tags '(occur regress) + + (ledger-tests-with-temp-file + "\ +2024-03-12 Grocery Store + Expenses:Food:Groceries $50 + Assets:Checking + +2024-03-15 Employer + * Assets:Checking $2000.00 + Income:Salary + +2024-03-19 Grocery Store + Expenses:Food:Groceries $50 + Assets:Checking +" + (ledger-occur "Groceries") + (should + (equal (ledger-test-visible-buffer-string) + "\ +2024-03-12 Grocery Store + Expenses:Food:Groceries $50 + Assets:Checking + +2024-03-19 Grocery Store + Expenses:Food:Groceries $50 + Assets:Checking +")) + + (setq ledger-occur-use-face-shown t) + (goto-char (point-min)) + (search-forward "2024-03-12") + (should (eq (get-char-property (point) 'font-lock-face) + 'ledger-occur-xact-face)) + (search-forward "2024-03-19") + (should (eq (get-char-property (point) 'font-lock-face) + 'ledger-occur-xact-face)))) + (provide 'occur-test) From 6d608e06fda42ccc2ad7fd140366fe936fe73bc9 Mon Sep 17 00:00:00 2001 From: "Aaron L. Zeng" Date: Tue, 19 Mar 2024 01:02:24 -0400 Subject: [PATCH 2/6] occur-test: Add some tests for more situations --- test/occur-test.el | 48 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 48 insertions(+) diff --git a/test/occur-test.el b/test/occur-test.el index 072d334b9..377e254f4 100644 --- a/test/occur-test.el +++ b/test/occur-test.el @@ -93,6 +93,54 @@ https://github.com/ledger/ledger-mode/issues/54" 'ledger-occur-xact-face)))) +(ert-deftest ledger-occur/test-003 () + "Additional tests for various edge cases." + :tags '(occur regress) + + (ledger-tests-with-temp-file + "\ +2024-03-12 Grocery Store + Expenses:Food:Groceries $50 + Assets:Checking + +2024-03-15 Employer + * Assets:Checking $2000.00 + Income:Salary + +2024-03-19 Grocery Store + Expenses:Food:Groceries $50 + Assets:Checking +" + ;; invisible on both sides of a visible portion + (ledger-occur "Employer") + (should + (equal (ledger-test-visible-buffer-string) + "\ + +2024-03-15 Employer + * Assets:Checking $2000.00 + Income:Salary +")) + + ;; no matches + (ledger-occur "zzzzzz") + (should + (equal (ledger-test-visible-buffer-string) + "\ +2024-03-12 Grocery Store + Expenses:Food:Groceries $50 + Assets:Checking + +2024-03-15 Employer + * Assets:Checking $2000.00 + Income:Salary + +2024-03-19 Grocery Store + Expenses:Food:Groceries $50 + Assets:Checking +")))) + + (provide 'occur-test) ;;; occur-test.el ends here From c0dc822d3730370e17924c92de43b00550fb50c1 Mon Sep 17 00:00:00 2001 From: "Aaron L. Zeng" Date: Tue, 19 Mar 2024 00:14:22 -0400 Subject: [PATCH 3/6] ledger-occur-create-overlays: Fix missing last visible overlay Fix #54 --- ledger-occur.el | 1 + 1 file changed, 1 insertion(+) diff --git a/ledger-occur.el b/ledger-occur.el index 7a37e1a2f..fae527dd3 100644 --- a/ledger-occur.el +++ b/ledger-occur.el @@ -128,6 +128,7 @@ Argument OVL-BOUNDS contains bounds for the transactions to be left visible." (ledger-occur-make-invisible-overlay (1+ end) (1- (car visible))) (setq beg (car visible)) (setq end (cadr visible))) + (ledger-occur-make-visible-overlay beg end) (ledger-occur-make-invisible-overlay (1+ end) (point-max)))) (defun ledger-occur-remove-overlays () From 1cede0a9a22025a415d3f8a9ad1936e714d1526c Mon Sep 17 00:00:00 2001 From: "Aaron L. Zeng" Date: Tue, 19 Mar 2024 01:02:55 -0400 Subject: [PATCH 4/6] ledger-occur: Simplify overlay creation loop --- ledger-occur.el | 25 +++++++++++++------------ 1 file changed, 13 insertions(+), 12 deletions(-) diff --git a/ledger-occur.el b/ledger-occur.el index fae527dd3..672a84411 100644 --- a/ledger-occur.el +++ b/ledger-occur.el @@ -106,30 +106,31 @@ currently active." (defun ledger-occur-make-visible-overlay (beg end) - (let ((ovl (make-overlay beg end (current-buffer)))) + "Make an overlay for a visible portion of the buffer, from BEG to END." + (let ((ovl (make-overlay beg end))) (overlay-put ovl ledger-occur-overlay-property-name t) (when ledger-occur-use-face-shown (overlay-put ovl 'font-lock-face 'ledger-occur-xact-face)))) (defun ledger-occur-make-invisible-overlay (beg end) - (let ((ovl (make-overlay beg end (current-buffer)))) + "Make an overlay for an invisible portion of the buffer, from BEG to END." + (let ((ovl (make-overlay beg end))) (overlay-put ovl ledger-occur-overlay-property-name t) (overlay-put ovl 'invisible t))) (defun ledger-occur-create-overlays (ovl-bounds) "Create the overlays for the visible transactions. Argument OVL-BOUNDS contains bounds for the transactions to be left visible." - (let* ((beg (caar ovl-bounds)) - (end (cl-cadar ovl-bounds))) - (ledger-occur-remove-overlays) - (ledger-occur-make-invisible-overlay (point-min) (1- beg)) - (dolist (visible (cdr ovl-bounds)) + (ledger-occur-remove-overlays) + (let ((end-of-last-visible (point-min))) + (pcase-dolist (`(,beg ,end) ovl-bounds) + ;; keep newline before xact visible, but do not highlight it with + ;; `ledger-occur-xact-face' + (ledger-occur-make-invisible-overlay end-of-last-visible (1- beg)) (ledger-occur-make-visible-overlay beg end) - (ledger-occur-make-invisible-overlay (1+ end) (1- (car visible))) - (setq beg (car visible)) - (setq end (cadr visible))) - (ledger-occur-make-visible-overlay beg end) - (ledger-occur-make-invisible-overlay (1+ end) (point-max)))) + ;; keep newline after xact visible + (setq end-of-last-visible (1+ end))) + (ledger-occur-make-invisible-overlay end-of-last-visible (point-max)))) (defun ledger-occur-remove-overlays () "Remove the transaction hiding overlays." From 271d2da9124047478a2221a601a31dc811ad6747 Mon Sep 17 00:00:00 2001 From: "Aaron L. Zeng" Date: Tue, 19 Mar 2024 00:42:27 -0400 Subject: [PATCH 5/6] ledger-occur-prompt: Reword docstring --- ledger-occur.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/ledger-occur.el b/ledger-occur.el index 672a84411..1aa6ffb0b 100644 --- a/ledger-occur.el +++ b/ledger-occur.el @@ -92,8 +92,8 @@ currently active." (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" +Default value for prompt is the active region, if it is one line +long, otherwise it is the word at point." (if (use-region-p) (let ((pos1 (region-beginning)) (pos2 (region-end))) From c3e3bff09d26303151aa3ddde3535a2320f220c3 Mon Sep 17 00:00:00 2001 From: "Aaron L. Zeng" Date: Tue, 19 Mar 2024 00:43:57 -0400 Subject: [PATCH 6/6] ledger-occur-compress-matches: Appease checkdoc --- ledger-occur.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/ledger-occur.el b/ledger-occur.el index 1aa6ffb0b..d48cdaf55 100644 --- a/ledger-occur.el +++ b/ledger-occur.el @@ -155,7 +155,9 @@ Argument OVL-BOUNDS contains bounds for the transactions to be left visible." (nreverse lines)))) (defun ledger-occur-compress-matches (buffer-matches) - "identify sequential xacts to reduce number of overlays required" + "Identify sequential xacts to reduce number of overlays required. + +BUFFER-MATCHES should be a list of (BEG END) lists." (if buffer-matches (let ((points (list)) (current-beginning (caar buffer-matches))