diff --git a/ledger-sort.el b/ledger-sort.el index 1601a853..6fa128c5 100644 --- a/ledger-sort.el +++ b/ledger-sort.el @@ -59,13 +59,41 @@ (beginning-of-line) (insert "\n; Ledger-mode: End sort\n\n")) +(defconst ledger-sort--year-directive-regex + "^\\(?:Y\\|year\\)\\s-+\\([0-9]+\\)\\s-*$" + "Regex matching a `year NNNN' or `Y NNNN' directive at the start of a line. +The year number is captured in group 1.") + +(defun ledger-sort--preceding-year () + "Return the year from the most recent `year NNNN' or `Y NNNN' directive. +Searches backward from the start of the current line, ignoring any +restriction so that directives above a narrowed sort region are still +consulted. Returns a number, or nil if no such directive exists." + (save-excursion + (save-restriction + (widen) + (beginning-of-line) + (when (re-search-backward ledger-sort--year-directive-regex nil t) + (string-to-number (match-string 1)))))) + (defun ledger-sort-startkey () - "Return a numeric sort key based on the date of the xact beginning at point." + "Return a numeric sort key based on the date of the xact beginning at point. +Dates with a full four-digit year are parsed directly. Short dates of the +form M/D or MM/DD are interpreted relative to the most recent `year NNNN' +directive preceding the current transaction, falling back to the current +calendar year if no such directive exists." ;; Can use `time-convert' to return an integer instead of a floating-point ;; number, starting in Emacs 27. (float-time - (ledger-parse-iso-date - (buffer-substring-no-properties (point) (+ 10 (point)))))) + (cond + ((looking-at ledger-iso-date-regexp) + (ledger-parse-iso-date (match-string 0))) + ((looking-at "\\([0-9]\\{1,2\\}\\)[-/]\\([0-9]\\{1,2\\}\\)\\(?:[^-/0-9]\\|$\\)") + (let ((month (string-to-number (match-string 1))) + (day (string-to-number (match-string 2))) + (year (or (ledger-sort--preceding-year) + (nth 5 (decode-time))))) + (encode-time 0 0 0 day month year)))))) (defun ledger-sort-region (beg end) "Sort the region from BEG to END in chronological order." diff --git a/test/sort-test.el b/test/sort-test.el index 83a8c69c..7cb2cae8 100644 --- a/test/sort-test.el +++ b/test/sort-test.el @@ -211,6 +211,146 @@ http://bugs.ledger-cli.org/show_bug.cgi?id=260" (should (< first-pos mid-pos))))) +(ert-deftest ledger-sort/test-1068-year-directive () + "Regress test for Bug 1068 +https://github.com/ledger/ledger/issues/1068 + +Dates lacking a year component should be interpreted relative to the +preceding `year NNNN' directive when sorting." + :tags '(sort regress) + + (ledger-tests-with-temp-file + "year 2040 + +07/17 Payee B + Expenses:B $20.00 + Assets:Cash + +2040/07/15 Payee A + Expenses:A $10.00 + Assets:Cash +" + (ledger-sort-buffer) + (should (equal (buffer-string) + "year 2040 + +2040/07/15 Payee A + Expenses:A $10.00 + Assets:Cash + +07/17 Payee B + Expenses:B $20.00 + Assets:Cash +")))) + + +(ert-deftest ledger-sort/test-1068-Y-directive () + "Regress test for Bug 1068 +https://github.com/ledger/ledger/issues/1068 + +The `Y NNNN' form of the year directive should also be honored." + :tags '(sort regress) + + (ledger-tests-with-temp-file + "Y 2040 + +07/17 Payee B + Expenses:B $20.00 + Assets:Cash + +2040/07/15 Payee A + Expenses:A $10.00 + Assets:Cash +" + (ledger-sort-buffer) + (should (equal (buffer-string) + "Y 2040 + +2040/07/15 Payee A + Expenses:A $10.00 + Assets:Cash + +07/17 Payee B + Expenses:B $20.00 + Assets:Cash +")))) + + +(ert-deftest ledger-sort/test-1068-unpadded-dates () + "Regress test for Bug 1068 +https://github.com/ledger/ledger/issues/1068 + +Dates written without leading zeros (e.g. 2015/5/7) should sort +chronologically, not lexicographically." + :tags '(sort regress) + + (ledger-tests-with-temp-file + "2015/5/10 Payee A + Expenses:A $10.00 + Assets:Cash + +2015/5/7 Payee B + Expenses:B $20.00 + Assets:Cash +" + (ledger-sort-buffer) + (should (equal (buffer-string) + "2015/5/7 Payee B + Expenses:B $20.00 + Assets:Cash + +2015/5/10 Payee A + Expenses:A $10.00 + Assets:Cash +")))) + + +(ert-deftest ledger-sort/test-1068-year-directive-above-region () + "Regress test for Bug 1068 +https://github.com/ledger/ledger/issues/1068 + +A `year NNNN' directive preceding the sort region should still apply +when only a sub-region is sorted (so narrowing does not hide it)." + :tags '(sort regress) + + (ledger-tests-with-temp-file + "year 2040 + +2040/01/01 Prelude + Expenses:Foo $1.00 + Assets:Cash + +07/17 Payee B + Expenses:B $20.00 + Assets:Cash + +03/05 Payee A + Expenses:A $10.00 + Assets:Cash +" + ;; Sort only the last two transactions (below the year directive). + (goto-char (point-min)) + (search-forward "07/17") + (beginning-of-line) + (let ((region-start (point))) + (ledger-sort-region region-start (point-max))) + (should (equal (buffer-string) + "year 2040 + +2040/01/01 Prelude + Expenses:Foo $1.00 + Assets:Cash + +03/05 Payee A + Expenses:A $10.00 + Assets:Cash + +07/17 Payee B + Expenses:B $20.00 + Assets:Cash +")))) + + (provide 'sort-test) ;;; sort-test.el ends here