Skip to content

Commit 57de7d8

Browse files
DamienCassoubcc32
DamienCassou
and
bcc32
authored
ledger-xact: Add ledger-xact-fill to insert missing amount (#421)
* ledger-post: Add ledger-post-fill to insert missing amount --------- Co-authored-by: Aaron L. Zeng <[email protected]>
1 parent 38fde57 commit 57de7d8

File tree

3 files changed

+261
-0
lines changed

3 files changed

+261
-0
lines changed

‎ledger-commodities.el

+4
Original file line numberDiff line numberDiff line change
@@ -115,6 +115,10 @@ directly."
115115
(list (+ (car c1) (car c2)) (cadr c1)))
116116
(t (error "Can't add different commodities: %S + %S" c1 c2))))
117117

118+
(defun ledger-negate-commodity (c)
119+
"Return the negative of the commoditized amount C."
120+
(list (- (car c)) (cadr c)))
121+
118122
(defun ledger-strip (str char)
119123
"Return STR with CHAR removed."
120124
(replace-regexp-in-string char "" str))

‎ledger-post.el

+54
Original file line numberDiff line numberDiff line change
@@ -27,6 +27,10 @@
2727
(require 'ledger-navigate)
2828

2929
(declare-function calc-renumber-stack "calc" ())
30+
(declare-function ledger-add-commodity "ledger-commodities" (c1 c2))
31+
(declare-function ledger-commodity-to-string "ledger-commodities" (c1))
32+
(declare-function ledger-negate-commodity "ledger-commodities" (c))
33+
(declare-function ledger-split-commodity-string "ledger-commodities" (str))
3034
(declare-function ledger-string-to-number "ledger-commodities" (str &optional decimal-comma))
3135

3236
;;; Code:
@@ -188,6 +192,56 @@ the amount and return to ledger."
188192
(push-mark (point) 'nomsg)
189193
(calc))))
190194

195+
(defun ledger-post-xact-total ()
196+
"Return (TOTAL . MISSING-POSITIONS) for the transaction at point.
197+
198+
TOTAL is a commoditized amount representing the total amount of
199+
the postings in the transaction.
200+
201+
MISSING-POSITIONS is a list of positions in the buffer where the
202+
transaction do not have an amount specified (such postings do not
203+
contribute to TOTAL). Specifically, the positions are at the end
204+
of the account name on such posting lines.
205+
206+
Error if the commodities do not match."
207+
(save-excursion
208+
(pcase-let ((`(,begin ,end) (ledger-navigate-find-xact-extents (point))))
209+
(goto-char begin)
210+
(cl-loop
211+
while (re-search-forward ledger-post-line-regexp end t)
212+
for account-end = (match-end ledger-regex-post-line-group-account)
213+
for amount-string = (when-let ((amount-string (match-string ledger-regex-post-line-group-amount)))
214+
(unless (string-empty-p (string-trim amount-string))
215+
amount-string))
216+
if (not amount-string)
217+
collect account-end into missing-positions
218+
else
219+
collect (ledger-split-commodity-string amount-string) into amounts
220+
finally return (cons (if amounts
221+
(cl-reduce #'ledger-add-commodity amounts)
222+
'(0 nil))
223+
missing-positions)))))
224+
225+
(defun ledger-post-fill ()
226+
"Find a posting with no amount and insert it.
227+
228+
Even if ledger allows for one missing amount per transaction, you
229+
might want to insert it anyway."
230+
(interactive)
231+
(pcase-let* ((`(,total . ,missing-positions) (ledger-post-xact-total))
232+
(missing-amount (ledger-negate-commodity total))
233+
(amounts-balance (< (abs (car missing-amount)) 0.0001)))
234+
(pcase missing-positions
235+
('() (unless amounts-balance
236+
(user-error "Postings do not balance, but no posting to fill")))
237+
(`(,missing-pos)
238+
(if amounts-balance
239+
(user-error "Missing amount but amounts balance already")
240+
(goto-char missing-pos)
241+
(insert " " (ledger-commodity-to-string missing-amount))
242+
(ledger-post-align-xact (point))))
243+
(_ (user-error "More than one posting with missing amount")))))
244+
191245
(provide 'ledger-post)
192246

193247

‎test/post-test.el

+203
Original file line numberDiff line numberDiff line change
@@ -454,6 +454,209 @@ http://bugs.ledger-cli.org/show_bug.cgi?id=946"
454454
" ))))
455455

456456

457+
(ert-deftest ledger-post/test-post-xact-total-001 ()
458+
"Basic functionality test for `ledger-post-xact-total'."
459+
:tags '(post)
460+
461+
;; one amount missing
462+
(ledger-tests-with-temp-file
463+
"\
464+
2013-05-01 foo
465+
Expenses:Foo $10
466+
Assets:Bar
467+
"
468+
469+
(should
470+
(equal (ledger-post-xact-total)
471+
'((10 "$") . (83)))))
472+
473+
;; one amount missing with trailing spaces
474+
(ledger-tests-with-temp-file
475+
"\
476+
2013-05-01 foo
477+
Expenses:Foo $10
478+
Assets:Bar \n"
479+
480+
(should
481+
(equal (ledger-post-xact-total)
482+
'((10 "$") . (83)))))
483+
484+
;; all amounts missing
485+
(ledger-tests-with-temp-file
486+
"\
487+
2013-05-01 foo
488+
Expenses:Foo
489+
Assets:Bar
490+
"
491+
492+
(should
493+
(equal (ledger-post-xact-total)
494+
'((0 nil) . (32 47)))))
495+
496+
;; no amounts missing
497+
(ledger-tests-with-temp-file
498+
"\
499+
2013-05-01 foo
500+
Expenses:Foo $10
501+
Assets:Bar $-10
502+
"
503+
504+
(should
505+
(equal (ledger-post-xact-total)
506+
'((0 "$") . nil)))))
507+
508+
509+
(ert-deftest ledger-post/test-post-xact-total-002 ()
510+
"`ledger-post-xact-total' error cases."
511+
:tags '(post)
512+
513+
;; mismatched commodities
514+
(ledger-tests-with-temp-file
515+
"\
516+
2013-05-01 foo
517+
Expenses:Foo $10
518+
Expenses:Baz 10 €
519+
Assets:Bar
520+
"
521+
(should (string-prefix-p
522+
"Can’t add different commodities"
523+
(cadr (should-error (ledger-post-xact-total)))))))
524+
525+
526+
(ert-deftest ledger-post/test-post-fill-001 ()
527+
"Basic functionality test for `ledger-post-fill'."
528+
:tags '(post)
529+
530+
(ledger-tests-with-temp-file
531+
"\
532+
2013-05-01 foo
533+
Expenses:Foo $10
534+
Assets:Bar
535+
"
536+
(ledger-post-fill)
537+
(should
538+
(equal (buffer-string)
539+
"\
540+
2013-05-01 foo
541+
Expenses:Foo $10
542+
Assets:Bar $ -10
543+
")))
544+
545+
;; trailing spaces
546+
(ledger-tests-with-temp-file
547+
"\
548+
2013-05-01 foo
549+
Expenses:Foo $10
550+
Assets:Bar \n"
551+
(ledger-post-fill)
552+
(should
553+
(equal (buffer-string)
554+
"\
555+
2013-05-01 foo
556+
Expenses:Foo $10
557+
Assets:Bar $ -10 \n")))
558+
559+
;; no commodity
560+
(ledger-tests-with-temp-file
561+
"\
562+
2013-05-01 foo
563+
Expenses:Foo 10
564+
Assets:Bar
565+
"
566+
(ledger-post-fill)
567+
(should
568+
(equal (buffer-string)
569+
"\
570+
2013-05-01 foo
571+
Expenses:Foo 10
572+
Assets:Bar -10
573+
")))
574+
575+
;; does not interfere with comments on posting line
576+
(ledger-tests-with-temp-file
577+
"\
578+
2013-05-01 foo
579+
Expenses:Foo 10
580+
Assets:Bar ; Payee: bar
581+
"
582+
(ledger-post-fill)
583+
(should
584+
(equal (buffer-string)
585+
"\
586+
2013-05-01 foo
587+
Expenses:Foo 10
588+
Assets:Bar -10 ; Payee: bar
589+
")))
590+
591+
;; no posting with missing amounts, but they balance
592+
(ledger-tests-with-temp-file
593+
"\
594+
2013-05-01 foo
595+
Expenses:Foo $10
596+
Assets:Bar $-10
597+
"
598+
(ledger-post-fill)
599+
(should
600+
(equal (buffer-string)
601+
"\
602+
2013-05-01 foo
603+
Expenses:Foo $10
604+
Assets:Bar $-10
605+
"))))
606+
607+
608+
(ert-deftest ledger-post/test-post-fill-002 ()
609+
"`ledger-post-fill' error cases."
610+
:tags '(post)
611+
612+
;; mismatched commodities
613+
(ledger-tests-with-temp-file
614+
"\
615+
2013-05-01 foo
616+
Expenses:Foo $10
617+
Expenses:Baz 10 €
618+
Assets:Bar
619+
"
620+
(should (string-prefix-p
621+
"Can’t add different commodities"
622+
(cadr (should-error (ledger-post-fill))))))
623+
624+
;; more than one missing amount
625+
(ledger-tests-with-temp-file
626+
"\
627+
2013-05-01 foo
628+
Expenses:Foo $10
629+
Expenses:Baz
630+
Assets:Bar
631+
"
632+
(should (string-equal
633+
(cadr (should-error (ledger-post-fill)))
634+
"More than one posting with missing amount")))
635+
636+
;; no missing amount, and amounts don't balance
637+
(ledger-tests-with-temp-file
638+
"\
639+
2013-05-01 foo
640+
Expenses:Foo $10
641+
Expenses:Baz $5
642+
"
643+
(should (string-equal
644+
(cadr (should-error (ledger-post-fill)))
645+
"Postings do not balance, but no posting to fill")))
646+
647+
;; missing amount but amounts balance already
648+
(ledger-tests-with-temp-file
649+
"\
650+
2013-05-01 foo
651+
Expenses:Foo $-10
652+
Expenses:Baz $5
653+
Expenses:Bar $5
654+
Expenses:Bla
655+
"
656+
(should (string-equal
657+
(cadr (should-error (ledger-post-fill)))
658+
"Missing amount but amounts balance already"))))
659+
457660
(provide 'post-test)
458661

459662
;;; post-test.el ends here

0 commit comments

Comments
 (0)