Fix copy-at-point and more regex consolidation and cleanup

7 files changed, 103 insertions, 109 deletions

diff --git a/lisp/ldg-complete.el b/lisp/ldg-complete.el
index 3462c0bb..0be4f438 100644
--- a/lisp/ldg-complete.el
+++ b/lisp/ldg-complete.el
@@ -52,7 +52,7 @@
     (save-excursion
       (goto-char (point-min))
       (while (re-search-forward
-              ledger-xact-payee-regex nil t)  ;; matches first line
+              ledger-payee-any-status-regex nil t)  ;; matches first line
         (unless (and (>= origin (match-beginning 0))
                      (< origin (match-end 0)))
           (setq payees-list (cons (match-string-no-properties 3)
@@ -69,7 +69,7 @@ Return tree structure"
     (save-excursion
       (goto-char (point-min))
       (while (re-search-forward
-              ledger-complete-account-regex nil t)
+              ledger-account-any-status-regex nil t)
         (unless (and (>= origin (match-beginning 0))
                      (< origin (match-end 0)))
           (setq account-elements
@@ -153,7 +153,7 @@ Does not use ledger xact"
 	  (setq rest-of-name (match-string 3))
           ;; Start copying the postings
 	  (forward-line)
-          (while (looking-at ledger-post-account-regex)
+          (while (looking-at ledger-complete-account-regex)
             (setq xacts (cons (buffer-substring-no-properties
                                (line-beginning-position)
                                (line-end-position))
diff --git a/lisp/ldg-fonts.el b/lisp/ldg-fonts.el
index 81b5b0bf..d83e7f9b 100644
--- a/lisp/ldg-fonts.el
+++ b/lisp/ldg-fonts.el
@@ -121,12 +121,12 @@
  				  'ledger-font-payee-cleared-face) ; Works
      (,ledger-payee-uncleared-regex 2 
  				    'ledger-font-payee-uncleared-face) ; Works
-     (,ledger-posting-account-cleared-regex 2 
- 					    'ledger-font-posting-account-cleared-face) ; Works
-     (,ledger-posting-account-pending-regex 2 
- 					    'ledger-font-posting-account-pending-face) ; Works
-     (,ledger-posting-account-all-regex 2 
- 					'ledger-font-posting-account-face)) ; Works
+     (,ledger-account-cleared-regex 2 
+ 	      			    'ledger-font-posting-account-cleared-face) ; Works
+     (,ledger-account-pending-regex 2 
+ 	      			    'ledger-font-posting-account-pending-face) ; Works
+     (,ledger-account-any-status-regex 2 
+				       'ledger-font-posting-account-face)) ; Works
   "Expressions to highlight in Ledger mode.")
     
 
diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el
index df9dda87..f1b434e9 100644
--- a/lisp/ldg-mode.el
+++ b/lisp/ldg-mode.el
@@ -101,7 +101,7 @@ Can be pcomplete, or align-posting"
       (define-key map [(control ?c) (control ?d)] 'ledger-delete-current-transaction)
       (define-key map [(control ?c) (control ?e)] 'ledger-toggle-current-transaction)
       (define-key map [(control ?c) (control ?f)] 'ledger-occur)
-      (define-key map [(control ?c) (control ?k)] 'ledger-copy-transaction)
+      (define-key map [(control ?c) (control ?k)] 'ledger-copy-transaction-at-point)
       (define-key map [(control ?c) (control ?m)] 'ledger-set-month)
       (define-key map [(control ?c) (control ?r)] 'ledger-reconcile)
       (define-key map [(control ?c) (control ?s)] 'ledger-sort-region)
@@ -144,7 +144,7 @@ Can be pcomplete, or align-posting"
       (define-key map [sort-reg] '(menu-item "Sort Region" ledger-sort-region :enable mark-active))
       (define-key map [align-reg] '(menu-item "Align Region" ledger-post-align-postings :enable mark-active))
       (define-key map [sep2] '(menu-item "--"))
-      (define-key map [copy-xact] '(menu-item "Copy Trans at Point" ledger-copy-transaction))
+      (define-key map [copy-xact] '(menu-item "Copy Trans at Point" ledger-copy-transaction-at-point))
       (define-key map [toggle-post] '(menu-item "Toggle Current Posting" ledger-toggle-current))
       (define-key map [toggle-xact] '(menu-item "Toggle Current Transaction" ledger-toggle-current-transaction))
       (define-key map [sep4] '(menu-item "--"))
@@ -172,43 +172,6 @@ Return the difference in the format of a time value."
     (list (- (car t1) (car t2) (if borrow 1 0))
           (- (+ (if borrow 65536 0) (cadr t1)) (cadr t2)))))
 
-(defun ledger-find-slot (moment)
-  "Find the right place in the buffer for a transaction at MOMENT.
-MOMENT is an encoded date"
-  (catch 'found
-    (ledger-iterate-transactions
-     (function
-      (lambda (start date mark desc)
-       (if (ledger-time-less-p moment date)
-	   (throw 'found t)))))))
-
-(defun ledger-iterate-transactions (callback)
-  "Iterate through each transaction call CALLBACK for each."
-  (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)))))
-      (forward-line))))
 
 (defun ledger-set-year (newyear)
   "Set ledger's idea of the current year to the prefix argument NEWYEAR."
@@ -227,7 +190,7 @@ MOMENT is an encoded date"
 (defun ledger-add-transaction (transaction-text &optional insert-at-point)
   "Use ledger xact TRANSACTION-TEXT to add a transaction to the buffer.
 If INSERT-AT-POINT is non-nil insert the transaction
-there, otherwise call `ledger-find-slot' to insert it at the
+there, otherwise call `ledger-xact-find-slot' to insert it at the
 correct chronological place in the buffer."
   (interactive (list
 		(read-string "Transaction: " (concat ledger-year "/" ledger-month "/"))))
@@ -238,12 +201,12 @@ correct chronological place in the buffer."
          exit-code)
     (unless insert-at-point
       (let ((date (car args)))
-        (if (string-match ledger-iso-date-regex date)
+        (if (string-match ledger-iso-date-regexp date)
             (setq date
-                  (encode-time 0 0 0 (string-to-number (match-string 3 date))
-                               (string-to-number (match-string 2 date))
-                               (string-to-number (match-string 1 date)))))
-        (ledger-find-slot date)))
+                  (encode-time 0 0 0 (string-to-number (match-string 4 date))
+                               (string-to-number (match-string 3 date))
+                               (string-to-number (match-string 2 date)))))
+        (ledger-xact-find-slot date)))
     (if (> (length args) 1)
 	(save-excursion
 	  (insert
diff --git a/lisp/ldg-post.el b/lisp/ldg-post.el
index 767a263a..88387fd1 100644
--- a/lisp/ldg-post.el
+++ b/lisp/ldg-post.el
@@ -122,7 +122,7 @@ PROMPT is a string to prompt with.  CHOICES is a list of
 Return the width of the amount field as an integer and leave
 point at beginning of the commodity."
   ;;(beginning-of-line)
-  (when (re-search-forward ledger-post-amount-regex end t)
+  (when (re-search-forward ledger-amount-regex end t)
     (goto-char (match-beginning 0))
     (skip-syntax-forward " ")
     (- (or (match-end 4)
@@ -134,7 +134,7 @@ point at beginning of the commodity."
 Return the column of the beginning of the account and leave point
 at beginning of account"
     (if (> end (point))
-	(when (re-search-forward ledger-posting-account-all-regex (1+ end) t)  
+	(when (re-search-forward ledger-account-any-status-regex (1+ end) t)  
 	  ;; the 1+ is to make sure we can catch the newline
 	  (goto-char (match-beginning 2))
 	  (current-column))))
diff --git a/lisp/ldg-regex.el b/lisp/ldg-regex.el
index 24a3ae23..95da77e2 100644
--- a/lisp/ldg-regex.el
+++ b/lisp/ldg-regex.el
@@ -24,58 +24,45 @@
 (eval-when-compile
   (require 'cl))
 
-(defvar ledger-amount-decimal-comma-regex
+(defconst ledger-amount-decimal-comma-regex
   "-?[1-9][0-9.]*[,]?[0-9]*")
 
-(defvar ledger-amount-decimal-period-regex
+(defconst ledger-amount-decimal-period-regex
   "-?[1-9][0-9.]*[.]?[0-9]*")
 
-(defvar ledger-other-entries-regex
+(defconst ledger-other-entries-regex
   "\\(^[~=A-Za-z].+\\)+")
 
 ;\\|^\\([A-Za-z] .+\\)\\)
 
-(defvar ledger-xact-payee-regex
-  (concat "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+"
-                      "\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)"))
-(defvar ledger-comment-regex
+(defconst ledger-comment-regex
   "\\(       \\|  \\|^\\)\\(;.*\\)")
 
-(defvar ledger-payee-pending-regex 
-  "^[0-9]+[-/.=][-/.=0-9]+\\s-\\!\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\(\\(        ;\\|  ;\\|$\\)\\)")
+(defconst ledger-payee-any-status-regex 
+  "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)")
 
-(defvar ledger-payee-cleared-regex
-  "^[0-9]+[-/.=][-/.=0-9]+\\s-\\*\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\(\\(        ;\\|  ;\\|$\\)\\)")
+(defconst ledger-payee-pending-regex 
+  "^[0-9]+[-/.=][-/.=0-9]+\\s-\\!\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\(;\\|$\\)")
 
-(defvar ledger-payee-uncleared-regex
-  "^[0-9]+[-/.=][-/.=0-9]+\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\(\\(        ;\\|  ;\\|$\\)\\)")
+(defconst ledger-payee-cleared-regex
+  "^[0-9]+[-/.=][-/.=0-9]+\\s-\\*\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\(;\\|$\\)")
 
-(defvar ledger-iso-date-regex
-  "\\([12][0-9]\\{3\\}\\)[-/]\\([0-9]\\{2\\}\\)[-/]\\([0-9]\\{2\\}\\)")
+(defconst ledger-payee-uncleared-regex
+  "^[0-9]+[-/.=][-/.=0-9]+\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\(;\\|$\\)")
 
-(defvar ledger-init-string-regex
+(defconst ledger-init-string-regex
   "^--.+?\\($\\|[ ]\\)")
 
-(defvar ledger-posting-account-all-regex
-  "\\(^[ \t]+\\)\\(.+?\\)\\(  \\|$\\)")  
+(defconst ledger-account-any-status-regex
+  "^[ \t]+\\([*!]\\s-+\\)?[[(]?\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)")  
 
-(defvar ledger-sort-next-record-regex
-  (concat "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+"
-	  "\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)"))
-
-(defvar ledger-posting-account-cleared-regex
-  "\\(^[ \t]+\\)\\(\\*.+?\\)\\(  \\|$\\)")  
-
-(defvar ledger-complete-account-regex
-  "^[ \t]+\\([*!]\\s-+\\)?[[(]?\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)")
-
-(defvar ledger-posting-account-pending-regex
+(defconst ledger-account-pending-regex
   "\\(^[ \t]+\\)\\(!.+?\\)\\(  \\|$\\)")  
 
-(defvar ledger-date-regex 
-  "\\([0-9]+\\)[/-]\\([0-9]+\\)[/-]\\([0-9]+\\)")
+(defconst ledger-account-cleared-regex
+  "\\(^[ \t]+\\)\\(\\*.+?\\)\\(  \\|$\\)")  
 
-(defvar ledger-post-amount-regex
+(defconst ledger-amount-regex
   (concat "\\(  \\|\t\\| \t\\)[ \t]*-?"
 	  "\\([A-Z$€£_]+ *\\)?"
 	  "\\(-?[0-9,]+?\\)"
@@ -84,6 +71,7 @@
 	  "\\([ \t]*[@={]@?[^\n;]+?\\)?"
 	  "\\([ \t]+;.+?\\|[ \t]*\\)?$"))
 
+
 (defmacro ledger-define-regexp (name regex docs &rest args)
   "Simplify the creation of a Ledger regex and helper functions."
   (let ((defs
@@ -179,23 +167,23 @@
 
 (put 'ledger-define-regexp 'lisp-indent-function 1)
 
-(ledger-define-regexp date
-  (let ((sep '(or ?- (any ?. ?/))))     ; can't do (any ?- ?. ?/) due to bug
+(ledger-define-regexp iso-date
+  ( let ((sep '(or ?-  ?/)))    
     (rx (group
-         (and (? (= 4 num)
-                 (eval sep))
-              (and num (? num))
+         (and (group (? (= 4 num)))
+	      (eval sep)
+              (group (and num (? num)))
               (eval sep)
-              (and num (? num))))))
+              (group (and num (? num)))))))
   "Match a single date, in its 'written' form.")
 
 (ledger-define-regexp full-date
   (macroexpand
-   `(rx (and (regexp ,ledger-date-regexp)
-             (? (and ?= (regexp ,ledger-date-regexp))))))
+   `(rx (and (regexp ,ledger-iso-date-regexp)
+             (? (and ?= (regexp ,ledger-iso-date-regexp))))))
   "Match a compound date, of the form ACTUAL=EFFECTIVE"
-  (actual date)
-  (effective date))
+  (actual iso-date)
+  (effective iso-date))
 
 (ledger-define-regexp state
   (rx (group (any ?! ?*)))
@@ -292,7 +280,7 @@
   (macroexpand
    `(rx (* (+ blank)
            (or (and ?\{ (regexp ,ledger-commoditized-amount-regexp) ?\})
-               (and ?\[ (regexp ,ledger-date-regexp) ?\])
+               (and ?\[ (regexp ,ledger-iso-date-regexp) ?\])
                (and ?\( (not (any ?\))) ?\))))))
   "")
 
@@ -328,4 +316,12 @@
   (amount full-amount)
   (note end-note))
 
+(defconst ledger-iterate-regex
+  (concat "\\(Y\\s-+\\([0-9]+\\)\\|"  ;; Catches a Y directive
+	  ledger-iso-date-regexp
+	  "\\([ *!]+\\)"  ;; mark
+	  "\\((.*)\\)"  ;; code
+	  "\\(.*\\)"   ;; desc
+	  "\\)"))
+
 (provide 'ldg-regex)
diff --git a/lisp/ldg-sort.el b/lisp/ldg-sort.el
index b106173b..f426a7ef 100644
--- a/lisp/ldg-sort.el
+++ b/lisp/ldg-sort.el
@@ -28,8 +28,8 @@
 
 (defun ledger-next-record-function ()
   "Move point to next transaction."
-  (if (re-search-forward ledger-sort-next-record-regex
-			 nil t)
+  (if (re-search-forward  ledger-payee-any-status-regex
+       			 nil t)
       (goto-char (match-beginning 0))
       (goto-char (point-max))))
 
diff --git a/lisp/ldg-xact.el b/lisp/ldg-xact.el
index 66d3f46f..31b9818f 100644
--- a/lisp/ldg-xact.el
+++ b/lisp/ldg-xact.el
@@ -76,6 +76,41 @@ within the transaction."
           (ledger-context-field-value context-info 'payee)
 	  nil))))
 
+(defun ledger-xact-find-slot (moment)
+  "Find the right place in the buffer for a transaction at MOMENT.
+MOMENT is an encoded date"
+  (catch 'found
+    (ledger-xact-iterate-transactions
+     (function
+      (lambda (start date mark desc)
+       (if (ledger-time-less-p moment date)
+	   (throw 'found t)))))))
+
+(defun ledger-xact-iterate-transactions (callback)
+  "Iterate through each transaction call CALLBACK for each."
+  (goto-char (point-min))
+  (let* ((now (current-time))
+         (current-year (nth 5 (decode-time now))))
+    (while (not (eobp))
+      (when (looking-at ledger-iterate-regex)
+        (let ((found-y-p (match-string 2)))  
+          (if found-y-p  
+              (setq current-year (string-to-number found-y-p)) ;; a Y directive was found
+	      (let ((start (match-beginning 0))
+		    (year (match-string 4))
+		    (month (string-to-number (match-string 5)))
+		    (day (string-to-number (match-string 6)))
+		    (mark (match-string 7))
+		    (code (match-string 8))
+		    (desc (match-string 9)))
+		(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)))))
+      (forward-line))))
+
 (defsubst ledger-goto-line (line-number)
   "Rapidly move point to line LINE-NUMBER."
   (goto-char (point-min)) 
@@ -106,17 +141,17 @@ within the transaction."
 	 (extents (ledger-find-xact-extents (point)))
 	 (transaction (buffer-substring-no-properties (car extents) (cadr extents)))
 	 encoded-date)
-    (if (string-match ledger-date-regex date)
+    (if (string-match ledger-iso-date-regexp date)
 	(setq encoded-date
-	      (encode-time 0 0 0 (string-to-number (match-string 3 date))
-			   (string-to-number (match-string 2 date))
-			   (string-to-number (match-string 1 date)))))
-    (ledger-find-slot encoded-date)
+	      (encode-time 0 0 0 (string-to-number (match-string 4 date))
+			   (string-to-number (match-string 3 date))
+			   (string-to-number (match-string 2 date)))))
+    (ledger-xact-find-slot encoded-date)
     (insert transaction "\n")
-    (backward-paragraph)
-    (re-search-forward ledger-date-regex)
+    (backward-paragraph 2)
+    (re-search-forward ledger-iso-date-regexp)
     (replace-match date)
-    (re-search-forward "[1-9][0-9]+\.[0-9]+")))
+    (ledger-next-amount)))
 
 (provide 'ldg-xact)