Support entries with effective dates in ledger-iterate-entries

1 files changed, 35 insertions, 20 deletions

diff --git a/lisp/ledger.el b/lisp/ledger.el
index 8e4de270..c2407261 100644
--- a/lisp/ledger.el
+++ b/lisp/ledger.el
@@ -152,31 +152,46 @@ customizable to ease retro-entry.")
   "Start a ledger session with the current month, but make it
 customizable to ease retro-entry.")
 
+(defvar ledger-rx-constituents
+  (append (list (cons 'date
+                      (rx (opt (group (= 4 digit)) (in "./"))
+                          (group (1+ digit)) (in "./")
+                          (group (1+ digit))))
+                (cons 'opt-mark
+                      (rx (opt (group "*") (1+ blank)))))
+          rx-constituents))
+
+(defmacro ledger-rx (&rest body)
+  `(let ((rx-constituents ledger-rx-constituents))
+     (rx ,@body)))
+
+(defun ledger--iterate-dispatch (nyear nmonth nday nmark ndesc)
+  (let ((start (point))
+        (year (match-string nyear))
+        (month (string-to-number (match-string nmonth)))
+        (day (string-to-number (match-string nday)))
+        (mark (match-string nmark))
+        (desc (match-string ndesc)))
+    (if (and year (> (length year) 0))
+        (setq year (string-to-number year)))
+    (funcall callback start
+             (encode-time 0 0 0 day month
+                          (or year current-year))
+             mark desc)))
+
 (defun ledger-iterate-entries (callback)
   (goto-char (point-min))
   (let* ((now (current-time))
 	 (current-year (nth 5 (decode-time now))))
     (while (not (eobp))
-      (when (looking-at
-	     (concat "\\(Y\\s-+\\([0-9]+\\)\\|"
-		     "\\([0-9]\\{4\\}+\\)?[./]?"
-		     "\\([0-9]+\\)[./]\\([0-9]+\\)\\s-+"
-		     "\\(\\*\\s-+\\)?\\(.+\\)\\)"))
-	(let ((found (match-string 2)))
-	  (if found
-	      (setq current-year (string-to-number found))
-	    (let ((start (match-beginning 0))
-		  (year (match-string 3))
-		  (month (string-to-number (match-string 4)))
-		  (day (string-to-number (match-string 5)))
-		  (mark (match-string 6))
-		  (desc (match-string 7)))
-	      (if (and year (> (length year) 0))
-		  (setq year (string-to-number year)))
-	      (funcall callback start
-		       (encode-time 0 0 0 day month
-				    (or year current-year))
-		       mark desc)))))
+      (cond ((looking-at (rx "Y" (1+ blank) (group (1+ digit))))
+             (setq current-year (string-to-number (match-string 1))))
+
+            ((looking-at (ledger-rx date "=" date (1+ blank) opt-mark (group (1+ nonl))))
+             (ledger--iterate-dispatch 1 2 3 7 8))
+
+            ((looking-at (ledger-rx date (1+ blank) opt-mark (group (1+ nonl))))
+             (ledger--iterate-dispatch 1 2 3 4 5)))
       (forward-line))))
 
 (defun ledger-time-less-p (t1 t2)