Consolidated all major regexes into ldg-regex. Only major exception are the regex in ledger context at point.

This commit is contained in:
Craig Earls 2013-04-02 23:13:23 -07:00
parent 86d0fd87c4
commit 519e57ca1f
11 changed files with 91 additions and 45 deletions

View file

@ -26,6 +26,8 @@
;;; Code: ;;; Code:
(require 'ldg-regex)
(defcustom ledger-reconcile-default-commodity "$" (defcustom ledger-reconcile-default-commodity "$"
"The default commodity for use in target calculations in ledger reconcile." "The default commodity for use in target calculations in ledger reconcile."
:type 'string :type 'string
@ -36,13 +38,13 @@
Returns a list with (value commodity)." Returns a list with (value commodity)."
(if (> (length str) 0) (if (> (length str) 0)
(let ((number-regex (if (assoc "decimal-comma" ledger-environment-alist) (let ((number-regex (if (assoc "decimal-comma" ledger-environment-alist)
"-?[1-9][0-9.]*[,]?[0-9]*" ledger-amount-decimal-comma-regex
"-?[1-9][0-9,]*[.]?[0-9]*"))) ledger-amount-decimal-period-regex)))
(with-temp-buffer (with-temp-buffer
(insert str) (insert str)
(goto-char (point-min)) (goto-char (point-min))
(cond (cond
((re-search-forward "\"\\(.*\\)\"" nil t) ((re-search-forward "\"\\(.*\\)\"" nil t) ; look for quoted commodities
(let ((com (delete-and-extract-region (let ((com (delete-and-extract-region
(match-beginning 1) (match-beginning 1)
(match-end 1)))) (match-end 1))))

View file

@ -52,8 +52,7 @@
(save-excursion (save-excursion
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward (while (re-search-forward
(concat "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+" ledger-xact-payee-regex nil t) ;; matches first line
"\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)") nil t) ;; matches first line
(unless (and (>= origin (match-beginning 0)) (unless (and (>= origin (match-beginning 0))
(< origin (match-end 0))) (< origin (match-end 0)))
(setq payees-list (cons (match-string-no-properties 3) (setq payees-list (cons (match-string-no-properties 3)
@ -70,7 +69,7 @@ Return tree structure"
(save-excursion (save-excursion
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward (while (re-search-forward
"^[ \t]+\\([*!]\\s-+\\)?[[(]?\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)" nil t) ledger-complete-account-regex nil t)
(unless (and (>= origin (match-beginning 0)) (unless (and (>= origin (match-beginning 0))
(< origin (match-end 0))) (< origin (match-end 0)))
(setq account-elements (setq account-elements

View file

@ -29,17 +29,17 @@
(require 'ldg-regex) (require 'ldg-regex)
(defgroup ledger-faces nil "Ledger mode highlighting" :group 'ledger) (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 )) `((t :foreground "#dc322f" :weight bold ))
"Default face for Ledger" "Default face for Ledger"
:group 'ledger-faces) :group 'ledger-faces)
(defface ledger-font-cleared-face (defface ledger-font-payee-cleared-face
`((t :foreground "#657b83" :weight normal )) `((t :foreground "#657b83" :weight normal ))
"Default face for cleared (*) transactions" "Default face for cleared (*) transactions"
:group 'ledger-faces) :group 'ledger-faces)
(defface ledger-font-highlight-face (defface ledger-font-xact-highlight-face
`((t :background "#eee8d5")) `((t :background "#eee8d5"))
"Default face for transaction under point" "Default face for transaction under point"
:group 'ledger-faces) :group 'ledger-faces)
@ -50,7 +50,7 @@
:group 'ledger-faces) :group 'ledger-faces)
(defface ledger-font-other-face (defface ledger-font-other-face
`((t :foreground "yellow" )) `((t :foreground "#657b83" :weight bold))
"Default face for other transactions" "Default face for other transactions"
:group 'ledger-faces) :group 'ledger-faces)
@ -70,7 +70,7 @@
:group 'ledger-faces) :group 'ledger-faces)
(defface ledger-font-posting-amount-face (defface ledger-font-posting-amount-face
`((t :foreground "yellow" )) `((t :foreground "#cb4b16" ))
"Face for Ledger amounts" "Face for Ledger amounts"
:group 'ledger-faces) :group 'ledger-faces)
@ -111,20 +111,30 @@
(defvar ledger-font-lock-keywords (defvar ledger-font-lock-keywords
`((,ledger-payee-pending-regex 2 'ledger-font-pending-face) `( ;; (,ledger-other-entries-regex 1
(,ledger-payee-cleared-regex 2 'ledger-font-cleared-face) ;; ledger-font-other-face)
(,ledger-payee-uncleared-regex 2 'ledger-font-uncleared-face) (,ledger-comment-regex 2
(,ledger-posting-account-cleared-regex 'ledger-font-comment-face)
2 'ledger-font-posting-account-cleared-face) (,ledger-payee-pending-regex 2
(,ledger-posting-account-pending-regex 'ledger-font-payee-pending-face) ; Works
2 'ledger-font-posting-account-pending-face) ; works (,ledger-payee-cleared-regex 2
(,ledger-posting-account-all-regex 'ledger-font-payee-cleared-face) ; Works
2 'ledger-font-posting-account-face) ; works (,ledger-payee-uncleared-regex 2
(,ledger-comment-regex 2 'ledger-font-comment-face) ; works 'ledger-font-payee-uncleared-face) ; Works
(,ledger-other-entries-regex 1 ledger-font-other-face)) (,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
"Expressions to highlight in Ledger mode.") "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) (provide 'ldg-fonts)
;;; ldg-fonts.el ends here ;;; ldg-fonts.el ends here

View file

@ -22,6 +22,8 @@
;;; Commentary: ;;; Commentary:
;; Determine the ledger environment ;; Determine the ledger environment
(require 'ldg-regex)
(defcustom ledger-init-file-name "~/.ledgerrc" (defcustom ledger-init-file-name "~/.ledgerrc"
"Location of the ledger initialization file. nil if you don't have one" "Location of the ledger initialization file. nil if you don't have one"
:group 'ledger-exec) :group 'ledger-exec)
@ -32,7 +34,7 @@
(with-current-buffer file (with-current-buffer file
(setq ledger-environment-alist nil) (setq ledger-environment-alist nil)
(goto-char (point-min)) (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 (let ((matchb (match-beginning 0)) ;; save the match data, string-match stamp on it
(matche (match-end 0))) (matche (match-end 0)))
(end-of-line) (end-of-line)

View file

@ -238,7 +238,7 @@ correct chronological place in the buffer."
exit-code) exit-code)
(unless insert-at-point (unless insert-at-point
(let ((date (car args))) (let ((date (car args)))
(if (string-match "\\([0-9]+\\)[-/]\\([0-9]+\\)[-/]\\([0-9]+\\)" date) (if (string-match ledger-iso-date-regex date)
(setq date (setq date
(encode-time 0 0 0 (string-to-number (match-string 3 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 2 date))

View file

@ -32,6 +32,7 @@
;;; Commentary: ;;; Commentary:
;; Load up the ledger mode ;; Load up the ledger mode
(require 'ldg-regex)
(require 'esh-util) (require 'esh-util)
(require 'esh-arg) (require 'esh-arg)
(require 'ldg-commodities) (require 'ldg-commodities)
@ -43,7 +44,6 @@
(require 'ldg-occur) (require 'ldg-occur)
(require 'ldg-post) (require 'ldg-post)
(require 'ldg-reconcile) (require 'ldg-reconcile)
(require 'ldg-regex)
(require 'ldg-report) (require 'ldg-report)
(require 'ldg-sort) (require 'ldg-sort)
(require 'ldg-state) (require 'ldg-state)

View file

@ -115,14 +115,7 @@ PROMPT is a string to prompt with. CHOICES is a list of
(delete-char 1))))))) (delete-char 1)))))))
(goto-char pos))) (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) (defsubst ledger-next-amount (&optional end)
"Move point to the next amount, as long as it is not past END. "Move point to the next amount, as long as it is not past END.
@ -135,8 +128,6 @@ point at beginning of the commodity."
(- (or (match-end 4) (- (or (match-end 4)
(match-end 3)) (point)))) (match-end 3)) (point))))
(defvar ledger-post-account-regex
"\\(^[ \t]+\\)\\([!*]?.+?\\)\\( \\|$\\)")
(defun ledger-next-account (&optional end) (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. "Move point to the beginning of the next account, or status marker (!*), as long as it is not past END.

View file

@ -62,6 +62,16 @@ reconcile-finish will mark all pending posting cleared."
:type 'boolean :type 'boolean
:group 'ledger-reconcile) :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 () (defun ledger-reconcile-get-cleared-or-pending-balance ()
"Calculate the cleared or pending balance of the account." "Calculate the cleared or pending balance of the account."
@ -299,7 +309,7 @@ POSTING is used in `ledger-clear-whole-transactions' is nil."
(insert (format "%s %-4s %-30s %-30s %15s\n" (insert (format "%s %-4s %-30s %-30s %15s\n"
(format-time-string (if date-format (format-time-string (if date-format
date-format date-format
"%Y/%m/%d") (nth 2 xact)) ledger-reconcile-default-date-format) (nth 2 xact))
(if (nth 3 xact) (if (nth 3 xact)
(nth 3 xact) (nth 3 xact)
"") "")
@ -409,7 +419,7 @@ moved and recentered. If they aren't strange things happen."
(defun ledger-reconcile-change-target () (defun ledger-reconcile-change-target ()
"Change the target amount for the reconciliation process." "Change the target amount for the reconciliation process."
(interactive) (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" (define-derived-mode ledger-reconcile-mode text-mode "Reconcile"
"A mode for reconciling ledger entries." "A mode for reconciling ledger entries."

View file

@ -24,11 +24,23 @@
(eval-when-compile (eval-when-compile
(require 'cl)) (require 'cl))
(defvar ledger-other-entries-regex (defvar ledger-amount-decimal-comma-regex
"^\\(\\([~=].+\\)\\|\\(^\\([A-Za-z]+ .+\\)\\)\\)") "-?[1-9][0-9.]*[,]?[0-9]*")
(defvar ledger-amount-decimal-period-regex
"-?[1-9][0-9.]*[.]?[0-9]*")
(defvar 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 (defvar ledger-comment-regex
"\\( \\| \\|^\\)\\(;.*\\)") "\\( \\| \\|^\\)\\(;.*\\)")
(defvar ledger-payee-pending-regex (defvar ledger-payee-pending-regex
"^[0-9]+[-/.=][-/.=0-9]+\\s-\\!\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\(\\( ;\\| ;\\|$\\)\\)") "^[0-9]+[-/.=][-/.=0-9]+\\s-\\!\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\(\\( ;\\| ;\\|$\\)\\)")
@ -38,19 +50,40 @@
(defvar ledger-payee-uncleared-regex (defvar ledger-payee-uncleared-regex
"^[0-9]+[-/.=][-/.=0-9]+\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\(\\( ;\\| ;\\|$\\)\\)") "^[0-9]+[-/.=][-/.=0-9]+\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\(\\( ;\\| ;\\|$\\)\\)")
(defvar ledger-iso-date-regex
"\\([12][0-9]\\{3\\}\\)[-/]\\([0-9]\\{2\\}\\)[-/]\\([0-9]\\{2\\}\\)")
(defvar ledger-init-string-regex
"^--.+?\\($\\|[ ]\\)")
(defvar ledger-posting-account-all-regex (defvar ledger-posting-account-all-regex
"\\(^[ \t]+\\)\\(.+?\\)\\( \\|$\\)") "\\(^[ \t]+\\)\\(.+?\\)\\( \\|$\\)")
(defvar ledger-sort-next-record-regex
(concat "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+"
"\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)"))
(defvar ledger-posting-account-cleared-regex (defvar ledger-posting-account-cleared-regex
"\\(^[ \t]+\\)\\(\\*.+?\\)\\( \\|$\\)") "\\(^[ \t]+\\)\\(\\*.+?\\)\\( \\|$\\)")
(defvar ledger-complete-account-regex
"^[ \t]+\\([*!]\\s-+\\)?[[(]?\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)")
(defvar ledger-posting-account-pending-regex (defvar ledger-posting-account-pending-regex
"\\(^[ \t]+\\)\\(!.+?\\)\\( \\|$\\)") "\\(^[ \t]+\\)\\(!.+?\\)\\( \\|$\\)")
(defvar ledger-date-regex (defvar ledger-date-regex
"\\([0-9]+\\)[/-]\\([0-9]+\\)[/-]\\([0-9]+\\)") "\\([0-9]+\\)[/-]\\([0-9]+\\)[/-]\\([0-9]+\\)")
(defvar ledger-post-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) (defmacro ledger-define-regexp (name regex docs &rest args)
"Simplify the creation of a Ledger regex and helper functions." "Simplify the creation of a Ledger regex and helper functions."
(let ((defs (let ((defs

View file

@ -28,9 +28,8 @@
(defun ledger-next-record-function () (defun ledger-next-record-function ()
"Move point to next transaction." "Move point to next transaction."
(if (re-search-forward (if (re-search-forward ledger-sort-next-record-regex
(concat "^[0-9/.=-]+\\(\\s-+\\*\\)?\\(\\s-+(.*?)\\)?\\s-+" nil t)
"\\(.+?\\)\\(\t\\|\n\\| [ \t]\\)") nil t)
(goto-char (match-beginning 0)) (goto-char (match-beginning 0))
(goto-char (point-max)))) (goto-char (point-max))))

View file

@ -53,7 +53,7 @@ within the transaction."
(defun ledger-highlight-xact-under-point () (defun ledger-highlight-xact-under-point ()
"Move the highlight overlay to the current transaction." "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))) (let ((exts (ledger-find-xact-extents (point)))
(ovl highlight-overlay)) (ovl highlight-overlay))
(if (not highlight-overlay) (if (not highlight-overlay)
@ -63,7 +63,7 @@ within the transaction."
(cadr exts) (cadr exts)
(current-buffer) t nil))) (current-buffer) t nil)))
(move-overlay ovl (car exts) (cadr exts))) (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)))) (overlay-put ovl 'priority 100))))
(defun ledger-xact-payee () (defun ledger-xact-payee ()