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

Auto is now correctly scanning a ledger-auto buffer and returning useable functions

Browse source
This commit is contained in:
Craig Earls 2013-03-14 11:38:32 -07:00
parent f89665ba44
commit 4c9b8cb990
1 changed files with 28 additions and 19 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

47
lisp/ldg-auto.el
View file

@ -21,8 +21,8 @@
;;; Commentary: ;;; Commentary:
;; ;;
;; This module provides or automatically adding transactions to a ;; This module provides for automatically adding transactions to a
;; ledger buffer on a periodic basis. h Recurrence expressions are ;; ledger buffer on a periodic basis. Recurrence expressions are
;; inspired by Martin Fowler's "Recurring Events for Calendars", ;; inspired by Martin Fowler's "Recurring Events for Calendars",
;; martinfowler.com/apsupp/recurring.pdf ;; martinfowler.com/apsupp/recurring.pdf
@ -92,15 +92,14 @@ of date."
;; of days are ok ;; of days are ok
(between (eval day) 1 (ledger-auto-days-in-month (eval month) (eval year)))) (between (eval day) 1 (ledger-auto-days-in-month (eval month) (eval year))))
(between (eval day) 1 31)) ;; no month specified, assume 31 days. (between (eval day) 1 31)) ;; no month specified, assume 31 days.
`#'(lambda (date) `'(and ,(if (eval year)
(and ,(if (eval year) `(if (eq (nth 5 (decode-time date)) ,(eval year)) t)
`(if (eq (nth 5 (decode-time date)) ,(eval year)) t) `t)
`t) ,(if (eval month)
,(if (eval month) `(if (eq (nth 4 (decode-time date)) ,(eval month)) t)
`(if (eq (nth 4 (decode-time date)) ,(eval month)) t) `t)
`t) ,(if (eval day)
,(if (eval day) `(if (eq (nth 3 (decode-time date)) ,(eval day)) t)))
`(if (eq (nth 3 (decode-time date)) ,(eval day)) t))))
(error "ledger-auto-constraint-numerical-date-macro: date out of range %S %S %S" (eval year) (eval month) (eval day)))) (error "ledger-auto-constraint-numerical-date-macro: date out of range %S %S %S" (eval year) (eval month) (eval day))))
@ -155,6 +154,15 @@ For example every second Friday, regardless of month."
(setq xact-list (cons transaction xact-list)))) (setq xact-list (cons transaction xact-list))))
xact-list))) xact-list)))
(defun ledger-auto-replace-brackets ()
"Replace all brackets with parens"
(goto-char (point-min))
(while (search-forward "]" nil t)
(replace-match ")" nil t))
(goto-char (point-min))
(while (search-forward "[" nil t)
(replace-match "(" nil t)))
(defun ledger-auto-read-descriptor-tree (descriptor-string) (defun ledger-auto-read-descriptor-tree (descriptor-string)
"Take a date descriptor string and return a function that "Take a date descriptor string and return a function that
returns true if the date meets the requirements" returns true if the date meets the requirements"
@ -163,16 +171,14 @@ returns true if the date meets the requirements"
(let (pos) (let (pos)
;; Replace brackets with parens ;; Replace brackets with parens
(insert descriptor-string) (insert descriptor-string)
(goto-char (point-min)) (ledger-auto-replace-brackets)
(replace-string "[" "(")
(goto-char (point-min))
(replace-string "]" ")")
(goto-char (point-max)) (goto-char (point-max))
;; double quote all the descriptors for string processing later ;; double quote all the descriptors for string processing later
(while (re-search-backward (while (re-search-backward
(concat "\\(20[0-9][0-9]\\|[\*]\\)[/\\-]" ;; Year slot (concat "\\(20[0-9][0-9]\\|[\*]\\)[/\\-]" ;; Year slot
"\\([\*EO]\\|[0-9]+\\)[/\\-]" ;; Month slot "\\([\*EO]\\|[01][0-9]\\)[/\\-]" ;; Month slot
"\\([\*]\\|\\([0-9][0-9]\\)\\|" "\\([\*]\\|\\([0-3][0-9]\\)\\|"
"\\([0-5]" "\\([0-5]"
"\\(\\(Su\\)\\|" "\\(\\(Su\\)\\|"
"\\(Mo\\)\\|" "\\(Mo\\)\\|"
@ -193,17 +199,20 @@ returns true if the date meets the requirements"
(read (buffer-substring (point-min) (point-max)))))) (read (buffer-substring (point-min) (point-max))))))
(defun ledger-transform-auto-tree (tree) (defun ledger-transform-auto-tree (tree)
"Takes a lisp list of date descriptor strings, TREE, and returns a string with a lambda function of date."
;; use funcall to use the lambda function spit out here
(if (consp tree) (if (consp tree)
(let (result) (let (result)
(while (consp tree) (while (consp tree)
(let ((newcar (car tree))) (let ((newcar (car tree)))
(if (consp (car tree)) (if (consp newcar)
(setq newcar (ledger-transform-auto-tree (car tree)))) (setq newcar (ledger-transform-auto-tree (car tree))))
(if (consp newcar) (if (consp newcar)
(push newcar result) (push newcar result)
(push (ledger-auto-parse-date-descriptor newcar) result)) ) (push (ledger-auto-parse-date-descriptor newcar) result)) )
(setq tree (cdr tree))) (setq tree (cdr tree)))
(nconc (nreverse result) tree)))) `(lambda (date)
,(nconc (list 'or) (nreverse result) tree)))))
(defun ledger-auto-split-constraints (descriptor-string) (defun ledger-auto-split-constraints (descriptor-string)
"Return a list with the year, month and day fields split" "Return a list with the year, month and day fields split"