sfos/ledger
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Have a working candidate search

Browse source
This commit is contained in:
Craig Earls 2013-03-18 15:01:35 -07:00
parent 5324afbd9b
commit adfd6bafc3
1 changed files with 16 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

19
lisp/ldg-auto.el
View file

@ -264,7 +264,16 @@ returns true if the date meets the requirements"
(ledger-auto-split-constraints descriptor))) (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 ;; Test harnesses for use in ielm
;; ;;
@ -277,11 +286,15 @@ returns true if the date meets the requirements"
(defun ledger-auto-test-predict () (defun ledger-auto-test-predict ()
(let ((today (current-time)) (let ((today (current-time))
test-date) test-date items)
(loop for day from 0 to ledger-auto-look-forward by 1 do (loop for day from 0 to ledger-auto-look-forward by 1 do
(setq test-date (time-add today (days-to-time day))) (setq test-date (time-add today (days-to-time day)))
(message "date: %S" (decode-time test-date))))) ;;(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) (provide 'ldg-auto)