diff options
| -rw-r--r-- | doc/ledger-mode.texi | 5 | ||||
| -rw-r--r-- | doc/ledger3.texi | 34 | ||||
| -rw-r--r-- | lisp/ldg-commodities.el | 36 | ||||
| -rw-r--r-- | lisp/ldg-complete.el | 7 | ||||
| -rw-r--r-- | lisp/ldg-fonts.el | 55 | ||||
| -rw-r--r-- | lisp/ldg-init.el | 4 | ||||
| -rw-r--r-- | lisp/ldg-mode.el | 55 | ||||
| -rw-r--r-- | lisp/ldg-new.el | 2 | ||||
| -rw-r--r-- | lisp/ldg-post.el | 23 | ||||
| -rw-r--r-- | lisp/ldg-reconcile.el | 17 | ||||
| -rw-r--r-- | lisp/ldg-regex.el | 79 | ||||
| -rw-r--r-- | lisp/ldg-sort.el | 5 | ||||
| -rw-r--r-- | lisp/ldg-xact.el | 55 |
13 files changed, 241 insertions, 136 deletions
diff --git a/doc/ledger-mode.texi b/doc/ledger-mode.texi index 70a5d97a..34c38dae 100644 --- a/doc/ledger-mode.texi +++ b/doc/ledger-mode.texi @@ -672,6 +672,11 @@ Default face for pending (!) transactions Default face for other transactions @item ledger-font-posting-account-face Face for Ledger accounts +@item ledger-font-posting-account-cleared-face +Face for cleared Ledger accounts +@item ledger-font-posting-account-pending-face +Face for Ledger pending accounts + @item ledger-font-posting-amount-face Face for Ledger amounts @item ledger-occur-narrowed-face diff --git a/doc/ledger3.texi b/doc/ledger3.texi index 3382ab33..91dd794f 100644 --- a/doc/ledger3.texi +++ b/doc/ledger3.texi @@ -75,6 +75,7 @@ twinkling in their father's CRT. * Reporting Commands:: * Command-line Syntax:: * Budgeting and Forecasting:: +* Time Keeping:: * Value Expressions:: * Format Strings:: * Extending with Python:: @@ -6389,7 +6390,7 @@ weekly last august @end smallexample -@node Budgeting and Forecasting, Value Expressions, Command-line Syntax, Top +@node Budgeting and Forecasting, Time Keeping, Command-line Syntax, Top @chapter Budgeting and Forecasting @menu @@ -6485,8 +6486,37 @@ only, and not against the running total: ledger --forecast "d<[2010]" bal ^assets ^liabilities @end example +@node Time Keeping, Value Expressions, Budgeting and Forecasting, Top +@chapter Time Keeping -@node Value Expressions, Format Strings, Budgeting and Forecasting, Top + +Ledger directly supports ``timelog'' entries, which have this form: + +@smallexample + i 2013/03/28 22:13:00 ACCOUNT[ PAYEE] + o 2013/03/29 03:39:00 +@end smallexample + +This records a check-in to the given ACCOUNT, and a check-out. You can +be checked-in to multiple accounts at a time, if you wish, and they can +span multiple days (use @code{--day-break} to break them up in the +report). The number of seconds between is accumulated as time to that +ACCOUNT. If the checkout uses a capital ``O'', the transaction is marked +``cleared''. You can use an optional PAYEE for whatever meaning you like. + +Now, there are a few ways to generate this information. You can use the +@file{timeclock.el} package, which is part of Emacs. Or you can write a +simple script in whichever language you prefer to emit similar +information. Or you can use Org-mode's time-clocking abilities and the +org2tc script developed by John Wiegly. + +These timelog entries can appear in a separate file, or directly in your +main ledger file. The initial "i" and "o" count as Ledger "directives", +and are accepted anywhere that ordinary transactions are. + + + +@node Value Expressions, Format Strings, Time Keeping, Top @chapter Value Expressions Ledger uses value expressions to make calculations for many different 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) |