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:
(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))))

View file

@ -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-xact-payee-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-complete-account-regex nil t)
(unless (and (>= origin (match-beginning 0))
(< origin (match-end 0)))
(setq account-elements

View file

@ -29,17 +29,17 @@
(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)
@ -50,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)
@ -70,7 +70,7 @@
:group 'ledger-faces)
(defface ledger-font-posting-amount-face
`((t :foreground "yellow" ))
`((t :foreground "#cb4b16" ))
"Face for Ledger amounts"
:group 'ledger-faces)
@ -111,20 +111,30 @@
(defvar ledger-font-lock-keywords
`((,ledger-payee-pending-regex 2 'ledger-font-pending-face)
(,ledger-payee-cleared-regex 2 'ledger-font-cleared-face)
(,ledger-payee-uncleared-regex 2 'ledger-font-uncleared-face)
(,ledger-posting-account-cleared-regex
2 'ledger-font-posting-account-cleared-face)
(,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-comment-regex 2 'ledger-font-comment-face) ; works
(,ledger-other-entries-regex 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-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.")
;; (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

View file

@ -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)

View file

@ -238,7 +238,7 @@ 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-regex date)
(setq date
(encode-time 0 0 0 (string-to-number (match-string 3 date))
(string-to-number (match-string 2 date))

View file

@ -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)

View file

@ -115,14 +115,7 @@ 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.
@ -135,8 +128,6 @@ point at beginning of the commodity."
(- (or (match-end 4)
(match-end 3)) (point))))
(defvar ledger-post-account-regex
"\\(^[ \t]+\\)\\([!*]?.+?\\)\\( \\|$\\)")
(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.

View file

@ -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."
@ -299,7 +309,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 +419,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."

View file

@ -24,11 +24,23 @@
(eval-when-compile
(require 'cl))
(defvar ledger-other-entries-regex
"^\\(\\([~=].+\\)\\|\\(^\\([A-Za-z]+ .+\\)\\)\\)")
(defvar ledger-amount-decimal-comma-regex
"-?[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-payee-pending-regex
"^[0-9]+[-/.=][-/.=0-9]+\\s-\\!\\s-+\\(([^)]+)\\s-+\\)?\\([^*].+?\\)\\(\\( ;\\| ;\\|$\\)\\)")
@ -38,19 +50,40 @@
(defvar ledger-payee-uncleared-regex
"^[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
"\\(^[ \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
"\\(^[ \t]+\\)\\(!.+?\\)\\( \\|$\\)")
(defvar ledger-date-regex
"\\([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)
"Simplify the creation of a Ledger regex and helper functions."
(let ((defs

View file

@ -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-sort-next-record-regex
nil t)
(goto-char (match-beginning 0))
(goto-char (point-max))))

View file

@ -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 ()