summaryrefslogtreecommitdiff
path: root/lisp
diff options
context:
space:
mode:
authorCraig Earls <enderw88@gmail.com>2013-04-04 12:35:43 -0700
committerCraig Earls <enderw88@gmail.com>2013-04-04 12:35:43 -0700
commit896d1cc3ec22659f296efa03c962abe69e5dd6e1 (patch)
treeb6b51ee7e068d90e3394fb89802f306c3cdacc61 /lisp
parent712665e5b4b748c554174a13d5a66f5cab1c97fd (diff)
parent2e78e61be7ba6aa73c56c157405e45ed30990b31 (diff)
downloadfork-ledger-896d1cc3ec22659f296efa03c962abe69e5dd6e1.tar.gz
fork-ledger-896d1cc3ec22659f296efa03c962abe69e5dd6e1.tar.bz2
fork-ledger-896d1cc3ec22659f296efa03c962abe69e5dd6e1.zip
Merge branch 'next' into ledger-mode-automatic-transactions
Diffstat (limited to 'lisp')
-rw-r--r--lisp/ldg-commodities.el36
-rw-r--r--lisp/ldg-complete.el7
-rw-r--r--lisp/ldg-fonts.el55
-rw-r--r--lisp/ldg-init.el4
-rw-r--r--lisp/ldg-mode.el55
-rw-r--r--lisp/ldg-new.el2
-rw-r--r--lisp/ldg-post.el23
-rw-r--r--lisp/ldg-reconcile.el17
-rw-r--r--lisp/ldg-regex.el79
-rw-r--r--lisp/ldg-sort.el5
-rw-r--r--lisp/ldg-xact.el55
11 files changed, 204 insertions, 134 deletions
diff --git a/lisp/ldg-commodities.el b/lisp/ldg-commodities.el
index 842613c6..031bddeb 100644
--- a/lisp/ldg-commodities.el
+++ b/lisp/ldg-commodities.el
@@ -26,6 +26,8 @@
;;; Code:
+(require 'ldg-regex)
+
(defcustom ledger-reconcile-default-commodity "$"
"The default commodity for use in target calculations in ledger reconcile."
:type 'string
@@ -36,13 +38,13 @@
Returns a list with (value commodity)."
(if (> (length str) 0)
(let ((number-regex (if (assoc "decimal-comma" ledger-environment-alist)
- "-?[1-9][0-9.]*[,]?[0-9]*"
- "-?[1-9][0-9,]*[.]?[0-9]*")))
+ ledger-amount-decimal-comma-regex
+ ledger-amount-decimal-period-regex)))
(with-temp-buffer
(insert str)
(goto-char (point-min))
(cond
- ((re-search-forward "\"\\(.*\\)\"" nil t)
+ ((re-search-forward "\"\\(.*\\)\"" nil t) ; look for quoted commodities
(let ((com (delete-and-extract-region
(match-beginning 1)
(match-end 1))))
@@ -127,25 +129,15 @@ longer ones are after the value."
(concat commodity " " val))))
(defun ledger-read-commodity-string (prompt)
- "Return a commoditizd value (val 'comm') from COMM.
-Assumes a space between the value and the commodity."
- (let ((parts (split-string (read-from-minibuffer
- (concat prompt " (" ledger-reconcile-default-commodity "): ")))))
- (if parts
- (if (/= (length parts) 2) ;;assume a number was entered and
- ;;use default commodity
- (list (string-to-number (car parts))
- ledger-reconcile-default-commodity)
- (let ((valp1 (string-to-number (car parts)))
- (valp2 (string-to-number (cadr parts))))
- (cond ((and (= valp1 valp2) (= 0 valp1)) ;; means neither contained a valid number (both = 0)
- (list 0 ""))
- ((and (/= 0 valp1) (= valp2 0))
- (list valp1 (cadr parts)))
- ((and (/= 0 valp2) (= valp1 0))
- (list valp2 (car parts)))
- (t
- (error "Cannot understand commodity"))))))))
+ (let ((str (read-from-minibuffer
+ (concat prompt " (" ledger-reconcile-default-commodity "): ")))
+ comm)
+ (if (> (length str) 0)
+ (progn
+ (setq comm (ledger-split-commodity-string str))
+ (if (cadr comm)
+ comm
+ (list (car comm) ledger-reconcile-default-commodity))))))
(provide 'ldg-commodities)
diff --git a/lisp/ldg-complete.el b/lisp/ldg-complete.el
index fe27e91d..f01e6e90 100644
--- a/lisp/ldg-complete.el
+++ b/lisp/ldg-complete.el
@@ -52,8 +52,7 @@
(save-excursion
(goto-char (point-min))
(while (re-search-forward
- (concat "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+"
- "\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)") 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)
@@ -70,7 +69,7 @@ Return tree structure"
(save-excursion
(goto-char (point-min))
(while (re-search-forward
- "^[ \t]+\\([*!]\\s-+\\)?[[(]?\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)" nil t)
+ ledger-account-any-status-regex nil t)
(unless (and (>= origin (match-beginning 0))
(< origin (match-end 0)))
(setq account-elements
@@ -154,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-account-any-status-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 3a7d1e0a..d83e7f9b 100644
--- a/lisp/ldg-fonts.el
+++ b/lisp/ldg-fonts.el
@@ -26,18 +26,20 @@
;;; Code:
+(require 'ldg-regex)
+
(defgroup ledger-faces nil "Ledger mode highlighting" :group 'ledger)
-(defface ledger-font-uncleared-face
+(defface ledger-font-payee-uncleared-face
`((t :foreground "#dc322f" :weight bold ))
"Default face for Ledger"
:group 'ledger-faces)
-(defface ledger-font-cleared-face
+(defface ledger-font-payee-cleared-face
`((t :foreground "#657b83" :weight normal ))
"Default face for cleared (*) transactions"
:group 'ledger-faces)
-(defface ledger-font-highlight-face
+(defface ledger-font-xact-highlight-face
`((t :background "#eee8d5"))
"Default face for transaction under point"
:group 'ledger-faces)
@@ -48,7 +50,7 @@
:group 'ledger-faces)
(defface ledger-font-other-face
- `((t :foreground "yellow" ))
+ `((t :foreground "#657b83" :weight bold))
"Default face for other transactions"
:group 'ledger-faces)
@@ -57,8 +59,18 @@
"Face for Ledger accounts"
:group 'ledger-faces)
+(defface ledger-font-posting-account-cleared-face
+ `((t :foreground "#657b83" ))
+ "Face for Ledger accounts"
+ :group 'ledger-faces)
+
+(defface ledger-font-posting-account-pending-face
+ `((t :foreground "#cb4b16" ))
+ "Face for Ledger accounts"
+ :group 'ledger-faces)
+
(defface ledger-font-posting-amount-face
- `((t :foreground "yellow" ))
+ `((t :foreground "#cb4b16" ))
"Face for Ledger amounts"
:group 'ledger-faces)
@@ -99,19 +111,30 @@
(defvar ledger-font-lock-keywords
- '(("^[0-9]+[-/.=][-/.=0-9]+\\s-\\!\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\(\\( ;\\| ;\\|$\\)\\)" 2 'ledger-font-pending-face)
- ("^[0-9]+[-/.=][-/.=0-9]+\\s-\\*\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\(\\( ;\\| ;\\|$\\)\\)" 2 'ledger-font-cleared-face)
- ("^[0-9]+[-/.=][-/.=0-9]+\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\(\\( ;\\| ;\\|$\\)\\)" 2 'ledger-font-uncleared-face)
- ("^\\s-+\\([*]\\s-*\\)?\\(\\([[(]\\)?[^*:
- ]+?:\\([^]);
- ]\\|\\s-\\)+?\\([])]\\)?\\)\\( \\| \\|$\\)"
- 2 'ledger-font-posting-account-face) ; works
- ("\\( \\| \\|^\\)\\(;.*\\)" 2 'ledger-font-comment-face) ; works
- ("^\\([~=].+\\)" 1 ledger-font-other-face)
- ("^\\([A-Za-z]+ .+\\)" 1 ledger-font-other-face))
+ `( ;; (,ledger-other-entries-regex 1
+ ;; ledger-font-other-face)
+ (,ledger-comment-regex 2
+ 'ledger-font-comment-face)
+ (,ledger-payee-pending-regex 2
+ 'ledger-font-payee-pending-face) ; Works
+ (,ledger-payee-cleared-regex 2
+ 'ledger-font-payee-cleared-face) ; Works
+ (,ledger-payee-uncleared-regex 2
+ 'ledger-font-payee-uncleared-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.")
+
-
+;; (defvar ledger-font-lock-keywords
+;; `( (,ledger-other-entries-regex 1
+;; ledger-font-other-face))
+;; "Expressions to highlight in Ledger mode.")
+
(provide 'ldg-fonts)
;;; ldg-fonts.el ends here
diff --git a/lisp/ldg-init.el b/lisp/ldg-init.el
index 8e657323..29839c9e 100644
--- a/lisp/ldg-init.el
+++ b/lisp/ldg-init.el
@@ -22,6 +22,8 @@
;;; Commentary:
;; Determine the ledger environment
+(require 'ldg-regex)
+
(defcustom ledger-init-file-name "~/.ledgerrc"
"Location of the ledger initialization file. nil if you don't have one"
:group 'ledger-exec)
@@ -32,7 +34,7 @@
(with-current-buffer file
(setq ledger-environment-alist nil)
(goto-char (point-min))
- (while (re-search-forward "^--.+?\\($\\|[ ]\\)" nil t )
+ (while (re-search-forward ledger-init-string-regex nil t )
(let ((matchb (match-beginning 0)) ;; save the match data, string-match stamp on it
(matche (match-end 0)))
(end-of-line)
diff --git a/lisp/ldg-mode.el b/lisp/ldg-mode.el
index e9e233af..f0af4383 100644
--- a/lisp/ldg-mode.el
+++ b/lisp/ldg-mode.el
@@ -92,7 +92,7 @@ Can be pcomplete, or align-posting"
(ledger-init-load-init-file)
- (setq indent-region-function 'ledger-post-align-postings)
+ (set (make-local-variable 'indent-region-function) 'ledger-post-align-postings)
(let ((map (current-local-map)))
(define-key map [(control ?c) (control ?a)] 'ledger-add-transaction)
@@ -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)
@@ -146,7 +146,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 "--"))
@@ -174,43 +174,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."
@@ -229,7 +192,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 "/"))))
@@ -240,12 +203,12 @@ correct chronological place in the buffer."
exit-code)
(unless insert-at-point
(let ((date (car args)))
- (if (string-match "\\([0-9]+\\)[-/]\\([0-9]+\\)[-/]\\([0-9]+\\)" 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-new.el b/lisp/ldg-new.el
index db16e03e..b018d217 100644
--- a/lisp/ldg-new.el
+++ b/lisp/ldg-new.el
@@ -32,6 +32,7 @@
;;; Commentary:
;; Load up the ledger mode
+(require 'ldg-regex)
(require 'esh-util)
(require 'esh-arg)
(require 'ldg-commodities)
@@ -43,7 +44,6 @@
(require 'ldg-occur)
(require 'ldg-post)
(require 'ldg-reconcile)
-(require 'ldg-regex)
(require 'ldg-report)
(require 'ldg-sort)
(require 'ldg-state)
diff --git a/lisp/ldg-post.el b/lisp/ldg-post.el
index 554b8578..18a70b1a 100644
--- a/lisp/ldg-post.el
+++ b/lisp/ldg-post.el
@@ -115,43 +115,38 @@ PROMPT is a string to prompt with. CHOICES is a list of
(delete-char 1)))))))
(goto-char pos)))
-(defvar ledger-post-amount-regex
- (concat "\\( \\|\t\\| \t\\)[ \t]*-?"
- "\\([A-Z$€£_]+ *\\)?"
- "\\(-?[0-9,]+?\\)"
- "\\(.[0-9]+\\)?"
- "\\( *[[:word:]€£_\"]+\\)?"
- "\\([ \t]*[@={]@?[^\n;]+?\\)?"
- "\\([ \t]+;.+?\\|[ \t]*\\)?$"))
+
(defsubst ledger-next-amount (&optional end)
"Move point to the next amount, as long as it is not past END.
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)
(match-end 3)) (point))))
-(defvar ledger-post-account-regex
- "\\(^[ \t]+\\)\\(.+?\\)\\( \\|\n\\)")
(defun ledger-next-account (&optional end)
"Move point to the beginning of the next account, or status marker (!*), as long as it is not past END.
Return the column of the beginning of the account and leave point
at beginning of account"
(if (> end (point))
- (when (re-search-forward ledger-post-account-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))
+ (if (match-beginning 1)
+ (goto-char (match-beginning 1))
+ (goto-char (match-beginning 2)))
(current-column))))
(defun ledger-post-align-postings (&optional beg end)
"Align all accounts and amounts within region, if there is no
region align the posting on the current line."
(interactive)
+ (assert (eq major-mode 'ledger-mode))
+
(save-excursion
(if (or (not (mark))
(not (use-region-p)))
@@ -254,7 +249,7 @@ BEG, END, and LEN control how far it can align."
(defun ledger-post-setup ()
"Configure `ledger-mode' to auto-align postings."
(add-hook 'after-change-functions 'ledger-post-maybe-align t t)
- (add-hook 'after-save-hook #'(lambda () (setq ledger-post-current-list nil))))
+ (add-hook 'after-save-hook #'(lambda () (setq ledger-post-current-list nil)) t t))
(defun ledger-post-read-account-with-prompt (prompt)
diff --git a/lisp/ldg-reconcile.el b/lisp/ldg-reconcile.el
index bec6d175..ff808485 100644
--- a/lisp/ldg-reconcile.el
+++ b/lisp/ldg-reconcile.el
@@ -62,6 +62,16 @@ reconcile-finish will mark all pending posting cleared."
:type 'boolean
:group 'ledger-reconcile)
+(defcustom ledger-reconcile-default-date-format "%Y/%m/%d"
+ "Default date format for the reconcile buffer"
+ :type 'string
+ :group 'ledger-reconcile)
+
+(defcustom ledger-reconcile-target-prompt-string "Target amount for reconciliation "
+ "Default prompt for recon target prompt"
+ :type 'string
+ :group 'ledger-reconcile)
+
(defun ledger-reconcile-get-cleared-or-pending-balance ()
"Calculate the cleared or pending balance of the account."
@@ -217,8 +227,7 @@ Return the number of uncleared xacts found."
(set-buffer-modified-p nil)
(ledger-display-balance)
(goto-char curpoint)
- ;; (ledger-reconcile-visit t)
- )))
+ (ledger-reconcile-visit t))))
(defun ledger-reconcile-finish ()
"Mark all pending posting or transactions as cleared.
@@ -299,7 +308,7 @@ POSTING is used in `ledger-clear-whole-transactions' is nil."
(insert (format "%s %-4s %-30s %-30s %15s\n"
(format-time-string (if date-format
date-format
- "%Y/%m/%d") (nth 2 xact))
+ ledger-reconcile-default-date-format) (nth 2 xact))
(if (nth 3 xact)
(nth 3 xact)
"")
@@ -409,7 +418,7 @@ moved and recentered. If they aren't strange things happen."
(defun ledger-reconcile-change-target ()
"Change the target amount for the reconciliation process."
(interactive)
- (setq ledger-target (ledger-read-commodity-string "Set reconciliation target")))
+ (setq ledger-target (ledger-read-commodity-string ledger-reconcile-target-prompt-string)))
(define-derived-mode ledger-reconcile-mode text-mode "Reconcile"
"A mode for reconciling ledger entries."
diff --git a/lisp/ldg-regex.el b/lisp/ldg-regex.el
index 97fd6e2c..1b338012 100644
--- a/lisp/ldg-regex.el
+++ b/lisp/ldg-regex.el
@@ -24,8 +24,53 @@
(eval-when-compile
(require 'cl))
-(defvar ledger-date-regex
- "\\([0-9]+\\)[/-]\\([0-9]+\\)[/-]\\([0-9]+\\)")
+(defconst ledger-amount-decimal-comma-regex
+ "-?[1-9][0-9.]*[,]?[0-9]*")
+
+(defconst ledger-amount-decimal-period-regex
+ "-?[1-9][0-9.]*[.]?[0-9]*")
+
+(defconst ledger-other-entries-regex
+ "\\(^[~=A-Za-z].+\\)+")
+
+;\\|^\\([A-Za-z] .+\\)\\)
+
+(defconst ledger-comment-regex
+ "\\( \\| \\|^\\)\\(;.*\\)")
+
+(defconst ledger-payee-any-status-regex
+ "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)")
+
+(defconst ledger-payee-pending-regex
+ "^[0-9]+[-/.=][-/.=0-9]+\\s-\\!\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\(;\\|$\\)")
+
+(defconst ledger-payee-cleared-regex
+ "^[0-9]+[-/.=][-/.=0-9]+\\s-\\*\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\(;\\|$\\)")
+
+(defconst ledger-payee-uncleared-regex
+ "^[0-9]+[-/.=][-/.=0-9]+\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\(;\\|$\\)")
+
+(defconst ledger-init-string-regex
+ "^--.+?\\($\\|[ ]\\)")
+
+(defconst ledger-account-any-status-regex
+ "^[ \t]+\\([*!]\\s-+\\)?\\([[(]?.+?\\)\\(\t\\|\n\\| [ \t]\\)")
+
+(defconst ledger-account-pending-regex
+ "\\(^[ \t]+\\)\\(!.+?\\)\\( \\|$\\)")
+
+(defconst ledger-account-cleared-regex
+ "\\(^[ \t]+\\)\\(\\*.+?\\)\\( \\|$\\)")
+
+(defconst ledger-amount-regex
+ (concat "\\( \\|\t\\| \t\\)[ \t]*-?"
+ "\\([A-Z$€£_]+ *\\)?"
+ "\\(-?[0-9,]+?\\)"
+ "\\(.[0-9]+\\)?"
+ "\\( *[[:word:]€£_\"]+\\)?"
+ "\\([ \t]*[@={]@?[^\n;]+?\\)?"
+ "\\([ \t]+;.+?\\|[ \t]*\\)?$"))
+
(defmacro ledger-define-regexp (name regex docs &rest args)
"Simplify the creation of a Ledger regex and helper functions."
@@ -122,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 ?! ?*)))
@@ -235,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 ?\))) ?\))))))
"")
@@ -271,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 5119db5d..f426a7ef 100644
--- a/lisp/ldg-sort.el
+++ b/lisp/ldg-sort.el
@@ -28,9 +28,8 @@
(defun ledger-next-record-function ()
"Move point to next transaction."
- (if (re-search-forward
- (concat "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+"
- "\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)") 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 d6ccc2bf..31b9818f 100644
--- a/lisp/ldg-xact.el
+++ b/lisp/ldg-xact.el
@@ -53,7 +53,7 @@ within the transaction."
(defun ledger-highlight-xact-under-point ()
"Move the highlight overlay to the current transaction."
-(if ledger-highlight-xact-under-point
+ (if ledger-highlight-xact-under-point
(let ((exts (ledger-find-xact-extents (point)))
(ovl highlight-overlay))
(if (not highlight-overlay)
@@ -63,7 +63,7 @@ within the transaction."
(cadr exts)
(current-buffer) t nil)))
(move-overlay ovl (car exts) (cadr exts)))
- (overlay-put ovl 'face 'ledger-font-highlight-face)
+ (overlay-put ovl 'face 'ledger-font-xact-highlight-face)
(overlay-put ovl 'priority 100))))
(defun ledger-xact-payee ()
@@ -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)