diff options
| -rw-r--r-- | lisp/ldg-auto.el | 48 |
1 files changed, 48 insertions, 0 deletions
diff --git a/lisp/ldg-auto.el b/lisp/ldg-auto.el index 33a2cdba..ffc6ee7d 100644 --- a/lisp/ldg-auto.el +++ b/lisp/ldg-auto.el @@ -30,6 +30,16 @@ ;; function slot of the symbol VARNAME. Then use VARNAME as the ;; function without have to use funcall. +(defgroup ledger-auto nil + "Support for automatically recommendation transactions." + :group 'ledger) + +(defcustom ledger-auto-look-forward 14 + "Number of days auto look forward to recommend transactions" + :type 'integer + :group 'ledger-auto) + + (defsubst between (val low high) (and (>= val low) (<= val high))) @@ -132,6 +142,9 @@ For example every second Friday, regardless of month." "Return true if DATE is a holiday.") (defun ledger-auto-scan-transactions (auto-file) + "Scans AUTO_FILE and returns a list of transactions with date predicates. +The car of each item is a fuction of date that returns true if +the transaction should be logged for that day." (interactive "fFile name: ") (let ((xact-list (list))) (with-current-buffer @@ -211,6 +224,8 @@ returns true if the date meets the requirements" (push newcar result) (push (ledger-auto-parse-date-descriptor newcar) result)) ) (setq tree (cdr tree))) + + ;; tie up all the clauses in a big or and lambda `(lambda (date) ,(nconc (list 'or) (nreverse result) tree))))) @@ -248,6 +263,39 @@ returns true if the date meets the requirements" (ledger-auto-compile-constraints (ledger-auto-split-constraints descriptor))) + +(defun ledger-auto-list-upcoming-xacts (candidate-items early horizon) + "Search CANDIDATE-ITEMS for xacts that occur within the perios today - EARLY to today + HORIZON" + (let ((start-date (time-subtract (current-time) (days-to-time early))) + test-date items) + (loop for day from 0 to (+ early horizon) by 1 do + (setq test-date (time-add start-date (days-to-time day))) + (dolist (candidate candidate-items items) + (if (funcall (car candidate) test-date) + (setq items (append items (list test-date (cdr candidate))))))) + items)) +;; +;; Test harnesses for use in ielm +;; +(defvar auto-items) + +(defun ledger-auto-test-setup () + (setq auto-items + (ledger-auto-scan-transactions "~/FinanceData/ledger-auto.ledger"))) + + +(defun ledger-auto-test-predict () + (let ((today (current-time)) + test-date items) + + (loop for day from 0 to ledger-auto-look-forward by 1 do + (setq test-date (time-add today (days-to-time day))) + ;;(message "date: %S" (decode-time test-date)) + (dolist (item auto-items items) + (if (funcall (car item) test-date) + (setq items (append items (list (decode-time test-date) (cdr item))))))) + items)) + (provide 'ldg-auto) ;;; ldg-auto.el ends here |