Skip to content

Fix some small bugs in ledger-complete-at-point #472

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
bcc32 wants to merge 5 commits into
base: master
Choose a base branch
from
Open

Fix some small bugs in ledger-complete-at-point #472

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
5 commits
Select commit Hold shift + click to select a range
be9f08d
Use func-arity to refactor ledger-complete-at-point
bcc32 Jun 7, 2026
8fbd85f
Add regression tests for incorrect completion-at-point boundaries
bcc32 Jun 7, 2026
97bd687
Fix completion-at-point boundaries for payees and transaction comments
bcc32 Jun 7, 2026
844f5ed
Add regression tests for bad completion on correct account/payee string
bcc32 Jun 7, 2026
6ec47cd
Fix exclusion of account/payee at point in completion
bcc32 Jun 7, 2026
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
146 changes: 73 additions & 73 deletions ledger-complete.el
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -76,8 +76,7 @@ If nil, full account names are offered for completion."
(save-excursion
(goto-char (point-min))
(while (re-search-forward ledger-payee-name-or-directive-regex nil t)
(unless (and (>= origin (match-beginning 0))
(< origin (match-end 0)))
(unless (<= (match-beginning 0) origin (match-end 0))
(push (or (match-string-no-properties 1) (match-string-no-properties 2))
payees-list))))
;; to the list
Expand Down Expand Up @@ -108,46 +107,48 @@ Then one of the elements this function returns will be
\(\"Assets:Checking\"
(\"default\")
(\"assert\" . \"commodity == \"$\"\"))"
(save-excursion
(goto-char (point-min))
(let (account-list
(seen (make-hash-table :test #'equal :size 1)))
;; First, consider accounts declared with "account" directives, which may or
;; may not have associated data. The data is on the following lines up to a
;; line not starting with whitespace.
(while (re-search-forward ledger-account-directive-regex nil t)
(let ((account (match-string-no-properties 1))
(lines (buffer-substring-no-properties
(point)
(progn (ledger-navigate-next-xact-or-directive)
(point))))
data)
(dolist (d (split-string lines "\n"))
(setq d (string-trim d))
(unless (string= d "")
(if (string-match " " d)
(push (cons (substring d 0 (match-beginning 0))
(substring d (match-end 0) nil))
data)
(push (cons d nil) data))))
(push (cons account data) account-list)
(puthash account t seen)))
;; Next, gather all accounts declared in postings
(unless
;; FIXME: People who have set `ledger-flymake-be-pedantic' to non-nil
;; probably don't want accounts from postings, just those declared
;; with directives. But the name is a little misleading. Should we
;; make a ledger-mode-be-pedantic and use that instead?
(bound-and-true-p ledger-flymake-be-pedantic)
(ledger-xact-iterate-transactions
(lambda (_pos _date _state _payee)
(let ((end (save-excursion (ledger-navigate-end-of-xact))))
(while (re-search-forward ledger-account-any-status-regex end t)
(let ((account (match-string-no-properties 1)))
(unless (gethash account seen)
(puthash account t seen)
(push (cons account nil) account-list))))))))
(sort account-list (lambda (a b) (string-lessp (car a) (car b)))))))
(let ((orig-pos (point)))
(save-excursion
(goto-char (point-min))
(let (account-list
(seen (make-hash-table :test #'equal :size 1)))
;; First, consider accounts declared with "account" directives, which may or
;; may not have associated data. The data is on the following lines up to a
;; line not starting with whitespace.
(while (re-search-forward ledger-account-directive-regex nil t)
(let ((account (match-string-no-properties 1))
(lines (buffer-substring-no-properties
(point)
(progn (ledger-navigate-next-xact-or-directive)
(point))))
data)
(dolist (d (split-string lines "\n"))
(setq d (string-trim d))
(unless (string= d "")
(if (string-match " " d)
(push (cons (substring d 0 (match-beginning 0))
(substring d (match-end 0) nil))
data)
(push (cons d nil) data))))
(push (cons account data) account-list)
(puthash account t seen)))
;; Next, gather all accounts declared in postings
(unless
;; FIXME: People who have set `ledger-flymake-be-pedantic' to non-nil
;; probably don't want accounts from postings, just those declared
;; with directives. But the name is a little misleading. Should we
;; make a ledger-mode-be-pedantic and use that instead?
(bound-and-true-p ledger-flymake-be-pedantic)
(ledger-xact-iterate-transactions
(lambda (_pos _date _state _payee)
(let ((end (save-excursion (ledger-navigate-end-of-xact))))
(while (re-search-forward ledger-account-any-status-regex end t)
(unless (<= (match-beginning 1) orig-pos (match-end 1))
(let ((account (match-string-no-properties 1)))
(unless (gethash account seen)
(puthash account t seen)
(push (cons account nil) account-list)))))))))
(sort account-list (lambda (a b) (string-lessp (car a) (car b))))))))

(defun ledger-accounts-list-in-buffer ()
"Return a list of all known account names in the current buffer as strings.
Expand Down Expand Up @@ -308,14 +309,16 @@ an alist (ACCOUNT-ELEMENT . NODE)."
(eq 'comment (car (cdr (ledger-context-at-point))))
(save-excursion
(back-to-indentation)
(setq start (point)))
(setq collection (cons 'nullary #'ledger-comments-list)))
(setq start (point)
end (line-end-position)))
(setq collection #'ledger-comments-list))
(;; Payees
(eq 'transaction
(save-excursion
(prog1 (ledger-thing-at-point)
(setq start (point)))))
(setq collection (cons 'nullary #'ledger-payees-list)))
(setq end (line-end-position)
collection #'ledger-payees-list))
(;; Accounts
(save-excursion
(back-to-indentation)
Expand All @@ -327,37 +330,33 @@ an alist (ACCOUNT-ELEMENT . NODE)."
(line-end-position) t)
(- (match-beginning 0) end)))
realign-after t
collection (cons 'nullary
(if ledger-complete-in-steps
(lambda ()
(ledger-complete-account-next-steps start end))
#'ledger-accounts-list)))))
collection (if ledger-complete-in-steps
(lambda ()
(ledger-complete-account-next-steps start end))
#'ledger-accounts-list))))
(when collection
(let ((prefix (buffer-substring-no-properties start end)))
(list start end
(pcase collection
;; `func-arity' isn't available until Emacs 26, so we have to
;; manually track the arity of the functions.
(`(nullary . ,f)
;; a nullary function that returns a completion collection
(completion-table-with-cache
(lambda (_)
(cl-remove-if (apply-partially 'string= prefix) (funcall f)))))
((pred functionp)
;; a completion table
collection)
(_
;; a static completion collection
collection))
:exit-function (lambda (&rest _)
(when delete-suffix
(delete-char delete-suffix))
(when (and realign-after ledger-post-auto-align)
(ledger-post-align-postings (line-beginning-position) (line-end-position)))))))))
(list start end
(cond
((not (functionp collection))
;; a static completion collection
collection)
((equal '(0 . 0) (func-arity collection))
;; a nullary function that returns a completion collection
(completion-table-with-cache
(lambda (_) (funcall collection))))
(t
;; a programmed completion table
collection))
:exit-function (lambda (&rest _)
(when delete-suffix
(delete-char delete-suffix))
(when (and realign-after ledger-post-auto-align)
(ledger-post-align-postings (line-beginning-position) (line-end-position))))))))

(defun ledger-comments-list ()
"Collect comments from the buffer."
(let ((comments '()))
(let ((orig-pos (point))
(comments '()))
(save-excursion
(goto-char (point-min))
;; FIXME: This only catches comments at beginning of lines and starting
Expand All @@ -366,7 +365,8 @@ an alist (ACCOUNT-ELEMENT . NODE)."
;; transactions (the latter should be completed over separately).
;; TODO: Unify this regex with `ledger-comment-regex'
(while (re-search-forward "^[ \t]+\\(?1:;.+\\)$" nil t)
(push (match-string-no-properties 1) comments)))
(unless (<= (match-beginning 1) orig-pos (match-end 1))
(push (match-string-no-properties 1) comments))))
(sort (delete-dups comments) #'string-lessp)))

(defun ledger-fully-complete-xact ()
Expand Down
102 changes: 102 additions & 0 deletions test/complete-test.el
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -237,6 +237,23 @@ payee Bar Baz

2019/06/28 Foo Bar"))))

(ert-deftest ledger-complete/test-complete-payee-point-inside ()
"Completion boundaries are correct for payees."
:tags '(complete regress)
(ledger-tests-with-temp-file
"payee Foo Bar

2019/06/28 Foo Bar"
(goto-char (point-max))
(backward-word 1)
(let ((inhibit-interaction t)) ;require a unique match
(completion-at-point))
(should
(equal (buffer-string)
"payee Foo Bar

2019/06/28 Foo Bar"))))

(ert-deftest ledger-complete/test-find-accounts-in-buffer ()
:tags '(complete)
(let ((ledger "*** Expenses
Expand Down Expand Up @@ -481,6 +498,24 @@ Regression test for https://github.com/ledger/ledger-mode/pull/455."
" ; transaction comment"))))


(ert-deftest ledger-complete/complete-txn-comment-point-inside ()
"Completion uses correct boundaries for transaction comments."
:tags '(complete regress)
(ledger-tests-with-temp-file
"\
; file comment

2025/12/07 Grocery
Expenses:Groceries $10
; transaction comment
Liabilities:Credit Card"
(search-forward "transaction comment")
(backward-word 1)
(completion-at-point)
(should (equal (buffer-substring (line-beginning-position) (line-end-position))
" ; transaction comment"))))


;;; -------------------------------------------------------------------
;;; Coverage tests for previously uncovered branches
;;; -------------------------------------------------------------------
Expand Down Expand Up @@ -698,6 +733,73 @@ Covers the `user-error' branch."
(end-of-line)
(should-error (ledger-fully-complete-xact) :type 'user-error)))

(ert-deftest ledger-complete/exact-payee-present-in-buffer ()
"Completion may include the exact string at point if it is present elsewhere."
:tags '(complete regress)
(ledger-tests-with-temp-file "\
2026-01-01 Grocery Store
Expenses:Groceries $10
Assets:Cash

2026-01-02 Grocery Store 2
Expenses:Groceries $10
Assets:Cash

2026-01-03 Grocery Stor
Expenses:Groceries $10
Assets:Cash
"
(goto-char (point-max))
(forward-line -3)
(end-of-line)
;; uniquely completes to longest common prefix: "Grocery Store"
(let ((inhibit-interaction t))
(completion-at-point))
(should (equal
(buffer-substring-no-properties (line-beginning-position) (line-end-position))
"2026-01-03 Grocery Store"))
;; Since this is a valid payee somewhere else in the buffer, no need to
;; change it.
(let ((inhibit-interaction t))
(completion-at-point))
(should (equal
(buffer-substring-no-properties (line-beginning-position) (line-end-position))
"2026-01-03 Grocery Store"))))

(ert-deftest ledger-complete/exact-account-present-in-buffer ()
"Completion may include the exact string at point if it is present elsewhere."
:tags '(complete regress)
(ledger-tests-with-temp-file "\
2026-01-01 Grocery Store
Expenses:Groceries $10
Assets:Cash

2026-01-02 Grocery Store 2
Expenses:Groceries:Snacks $10
Assets:Cash

2026-01-03 Grocery Stor
Expenses:Groc $10
Assets:Cash
"
(let ((ledger-post-auto-align nil))
(goto-char (point-max))
(forward-line -2)
(forward-word 2)
;; uniquely completes to longest common prefix: "Expenses:Groceries"
(let ((inhibit-interaction t))
(completion-at-point))
(should (equal
(buffer-substring-no-properties (line-beginning-position) (line-end-position))
" Expenses:Groceries $10"))
;; Since this is a valid account somewhere else in the buffer, no need to
;; change it.
(let ((inhibit-interaction t))
(completion-at-point))
(should (equal
(buffer-substring-no-properties (line-beginning-position) (line-end-position))
" Expenses:Groceries $10")))))

(provide 'complete-test)

;;; complete-test.el ends here