Skip to content

Commit

Permalink
Merge branch 'fix-54'
Browse files Browse the repository at this point in the history
  • Loading branch information
bcc32 committed Mar 21, 2024
2 parents cac2b3f + c3e3bff commit 6a09acd
Show file tree
Hide file tree
Showing 2 changed files with 112 additions and 19 deletions.
32 changes: 18 additions & 14 deletions ledger-occur.el
Original file line number Diff line number Diff line change
Expand Up @@ -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)))
Expand All @@ -106,29 +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-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."
Expand All @@ -153,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))
Expand Down
99 changes: 94 additions & 5 deletions test/occur-test.el
Original file line number Diff line number Diff line change
Expand Up @@ -35,22 +35,111 @@ 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
2011/01/05 Employer
* 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))))


(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)

Expand Down

0 comments on commit 6a09acd

Please sign in to comment.