diff options
| -rw-r--r-- | lisp/ldg-post.el | 14 | ||||
| -rw-r--r-- | lisp/ldg-regex.el | 404 |
2 files changed, 250 insertions, 168 deletions
diff --git a/lisp/ldg-post.el b/lisp/ldg-post.el index 30edd035..c762e51b 100644 --- a/lisp/ldg-post.el +++ b/lisp/ldg-post.el @@ -50,7 +50,7 @@ to choose from." (account-len (length account)) (pos (point))) (goto-char (line-beginning-position)) - (when (re-search-forward ledger-regex-post-line (line-end-position) t) + (when (re-search-forward ledger-post-line-regexp (line-end-position) t) (let ((existing-len (length (match-string 3)))) (goto-char (match-beginning 3)) (delete-region (match-beginning 3) (match-end 3)) @@ -76,13 +76,13 @@ to choose from." (goto-char beg) (when (< end (line-end-position)) (goto-char (line-beginning-position)) - (if (looking-at ledger-regex-post-line) + (if (looking-at ledger-post-line-regexp) (ledger-post-align-amount))))) (defun ledger-post-edit-amount () (interactive) (goto-char (line-beginning-position)) - (when (re-search-forward ledger-regex-post-line (line-end-position) t) + (when (re-search-forward ledger-post-line-regexp (line-end-position) t) (goto-char (match-end 3)) (when (re-search-forward "[-.,0-9]+" (line-end-position) t) (let ((val (match-string 0))) @@ -96,16 +96,16 @@ to choose from." (defun ledger-post-prev-xact () (interactive) (backward-paragraph) - (when (re-search-backward ledger-regex-xact-line nil t) + (when (re-search-backward ledger-xact-line-regexp nil t) (goto-char (match-beginning 0)) - (re-search-forward ledger-regex-post-line) + (re-search-forward ledger-post-line-regexp) (goto-char (match-end 3)))) (defun ledger-post-next-xact () (interactive) - (when (re-search-forward ledger-regex-xact-line nil t) + (when (re-search-forward ledger-xact-line-regexp nil t) (goto-char (match-beginning 0)) - (re-search-forward ledger-regex-post-line) + (re-search-forward ledger-post-line-regexp) (goto-char (match-end 3)))) (defun ledger-post-setup () diff --git a/lisp/ldg-regex.el b/lisp/ldg-regex.el index 14c41f63..0db19197 100644 --- a/lisp/ldg-regex.el +++ b/lisp/ldg-regex.el @@ -1,167 +1,249 @@ (require 'rx) -(defconst ledger-regex-date - (let ((sep '(or ?- (any ?. ?/)))) ; can't do (any ?- ?. ?/) due to bug - (rx (group - (and (? (= 4 num) - (eval sep)) - (and num (? num)) - (eval sep) - (and num (? num)))))) +(eval-when-compile + (require 'cl)) + +(defmacro ledger-define-regexp (name regex docs &rest args) + "Simplify the creation of a Ledger regex and helper functions." + (let ((defs + (list + `(defconst + ,(intern (concat "ledger-" (symbol-name name) "-regexp")) + ,(eval regex)))) + (addend 0) last-group) + (if (null args) + (progn + (nconc + defs + (list + `(defconst + ,(intern + (concat "ledger-regex-" (symbol-name name) "-group")) + 1))) + (nconc + defs + (list + `(defconst + ,(intern (concat "ledger-regex-" (symbol-name name) + "-group--count")) + 1))) + (nconc + defs + (list + `(defmacro + ,(intern (concat "ledger-regex-" (symbol-name name))) + (&optional string) + ,(format "Return the match string for the %s" name) + (match-string + ,(intern (concat "ledger-regex-" (symbol-name name) + "-group")) + string))))) + + (dolist (arg args) + (let (var grouping target) + (if (symbolp arg) + (setq var arg target arg) + (assert (listp arg)) + (if (= 2 (length arg)) + (setq var (car arg) + target (cadr arg)) + (setq var (car arg) + grouping (cadr arg) + target (caddr arg)))) + + (if (and last-group + (not (eq last-group (or grouping target)))) + (incf addend + (symbol-value + (intern-soft (concat "ledger-regex-" + (symbol-name last-group) + "-group--count"))))) + (nconc + defs + (list + `(defconst + ,(intern (concat "ledger-regex-" (symbol-name name) + "-group-" (symbol-name var))) + ,(+ addend + (symbol-value + (intern-soft + (if grouping + (concat "ledger-regex-" (symbol-name grouping) + "-group-" (symbol-name target)) + (concat "ledger-regex-" (symbol-name target) + "-group")))))))) + (nconc + defs + (list + `(defmacro + ,(intern (concat "ledger-regex-" (symbol-name name) + "-" (symbol-name var))) + (&optional string) + ,(format "Return the sub-group match for the %s %s." + name var) + (match-string + ,(intern (concat "ledger-regex-" (symbol-name name) + "-group-" (symbol-name var))) + string)))) + + (setq last-group (or grouping target)))) + + (nconc defs + (list + `(defconst ,(intern (concat "ledger-regex-" (symbol-name name) + "-group--count")) + ,(length args))))) + + (cons 'progn defs))) + +(put 'ledger-define-regexp 'lisp-indent-function 2) + +(ledger-define-regexp date + (let ((sep '(or ?- (any ?. ?/)))) ; can't do (any ?- ?. ?/) due to bug + (rx (group + (and (? (= 4 num) + (eval sep)) + (and num (? num)) + (eval sep) + (and num (? num)))))) "Match a single date, in its 'written' form.") -(defconst ledger-regex-date-group 1) -(defconst ledger-regex-date-group--count 1) - -(defconst ledger-regex-full-date - (macroexpand - `(rx (and (regexp ,ledger-regex-date) - (? (and ?= (regexp ,ledger-regex-date)))))) - "Match a compound date, of the form ACTUAL=EFFECTIVE") - -(defconst ledger-regex-full-date-group-actual - ledger-regex-date-group) -(defconst ledger-regex-full-date-group-effective - (+ ledger-regex-date-group--count - ledger-regex-date-group)) -(defconst ledger-regex-full-date-group--count - (* 2 ledger-regex-date-group--count)) - -(defconst ledger-regex-state - (rx (group (any ?! ?*)))) - -(defconst ledger-regex-state-group 1) -(defconst ledger-regex-state-group--count 1) - -(defconst ledger-regex-code - (rx (and ?\( (group (+? (not (any ?\))))) ?\)))) - -(defconst ledger-regex-code-group 1) -(defconst ledger-regex-code-group--count 1) - -(defconst ledger-regex-long-space - (rx (and (*? space) - (or (and ? (or ? ?\t)) ?\t)))) - -(defconst ledger-regex-note - (rx (group (+ nonl)))) - -(defconst ledger-regex-note-group 1) -(defconst ledger-regex-note-group--count 1) - -(defconst ledger-regex-end-note - (macroexpand `(rx (and (regexp ,ledger-regex-long-space) ?\; - (regexp ,ledger-regex-note))))) - -(defconst ledger-regex-end-note-group - ledger-regex-note-group) -(defconst ledger-regex-end-note-group--count - ledger-regex-note-group--count) - -(defconst ledger-regex-full-note - (macroexpand `(rx (and line-start (+ space) - ?\; (regexp ,ledger-regex-note))))) - -(defconst ledger-regex-full-note-group - ledger-regex-note-group) -(defconst ledger-regex-full-note-group--count - ledger-regex-note-group--count) - -(defconst ledger-regex-xact-line - (macroexpand - `(rx (and line-start - (regexp ,ledger-regex-full-date) - (? (and (+ space) (regexp ,ledger-regex-state))) - (? (and (+ space) (regexp ,ledger-regex-code))) - (+ space) (+? nonl) - (? (regexp ,ledger-regex-end-note)) - line-end)))) - -(defconst ledger-regex-xact-line-group-actual-date - ledger-regex-full-date-group-actual) -(defconst ledger-regex-xact-line-group-effective-date - ledger-regex-full-date-group-effective) -(defconst ledger-regex-xact-line-group-state - (+ ledger-regex-full-date-group--count - ledger-regex-state-group)) -(defconst ledger-regex-xact-line-group-code - (+ ledger-regex-full-date-group--count - ledger-regex-state-group--count - ledger-regex-code-group)) -(defconst ledger-regex-xact-line-group-note - (+ ledger-regex-full-date-group--count - ledger-regex-state-group--count - ledger-regex-code-group--count - ledger-regex-note-group)) -(defconst ledger-regex-full-note-group--count - (+ ledger-regex-full-date-group--count - ledger-regex-state-group--count - ledger-regex-code-group--count - ledger-regex-note-group--count)) - -(defun ledger-regex-xact-line-actual-date - (&optional string) - (match-string ledger-regex-xact-line-group-actual-date string)) - -(defconst ledger-regex-account - (rx (group (and (not (any ?:)) (*? nonl))))) - -(defconst ledger-regex-full-account - (macroexpand - `(rx (and (group (? (any ?\[ ?\)))) - (regexp ,ledger-regex-account) - (? (any ?\] ?\))))))) - -(defconst ledger-regex-commodity - (rx (or (and ?\" (+ (not (any ?\"))) ?\") - (not (any space ?\n - digit - ?- ?\[ ?\] - ?. ?, ?\; ?+ ?* ?/ ?^ ?? ?: ?& ?| ?! ?= - ?\< ?\> ?\{ ?\} ?\( ?\) ?@))))) - -(defconst ledger-regex-amount - (rx (and (? ?-) - (and (+ digit) - (*? (and (any ?. ?,) (+ digit)))) - (? (and (any ?. ?,) (+ digit)))))) - -(defconst ledger-regex-commoditized-amount - (macroexpand - `(rx (or (and (regexp ,ledger-regex-commodity) - (*? space) - (regexp ,ledger-regex-amount)) - (and (regexp ,ledger-regex-amount) - (*? space) - (regexp ,ledger-regex-commodity)))))) - -(defconst ledger-regex-commodity-annotations - (macroexpand - `(rx (* (+ space) - (or (and ?\{ (regexp ,ledger-regex-commoditized-amount) ?\}) - (and ?\[ (regexp ,ledger-regex-date) ?\]) - (and ?\( (not (any ?\))) ?\))))))) - -(defconst ledger-regex-cost - (macroexpand - `(rx (and (or "@" "@@") (+ space) - (regexp ,ledger-regex-commoditized-amount))))) - -(defconst ledger-regex-balance-assertion - (macroexpand - `(rx (and ?= (+ space) - (regexp ,ledger-regex-commoditized-amount))))) - -(defconst ledger-regex-full-amount - (macroexpand `(rx (group (+? (not (any ?\;))))))) - -(defconst ledger-regex-post-line - (macroexpand - `(rx (and line-start - (? (and (+ space) (regexp ,ledger-regex-state))) - (+ space) (regexp ,ledger-regex-full-account) - (+ space) (regexp ,ledger-regex-full-amount) - (? (regexp ,ledger-regex-end-note)) - line-end)))) +(ledger-define-regexp full-date + (macroexpand + `(rx (and (regexp ,ledger-date-regexp) + (? (and ?= (regexp ,ledger-date-regexp)))))) + "Match a compound date, of the form ACTUAL=EFFECTIVE" + (actual date) + (effective date)) + +(ledger-define-regexp state + (rx (group (any ?! ?*))) + "Match a transaction or posting's \"state\" character.") + +(ledger-define-regexp code + (rx (and ?\( (group (+? (not (any ?\))))) ?\))) + "Match the transaction code.") + +(ledger-define-regexp long-space + (rx (and (*? space) + (or (and ? (or ? ?\t)) ?\t))) + "Match a \"long space\".") + +(ledger-define-regexp note + (rx (group (+ nonl))) + "") + +(ledger-define-regexp end-note + (macroexpand + `(rx (and (regexp ,ledger-long-space-regexp) ?\; + (regexp ,ledger-note-regexp)))) + "") + +(ledger-define-regexp full-note + (macroexpand + `(rx (and line-start (+ space) + ?\; (regexp ,ledger-note-regexp)))) + "") + +(ledger-define-regexp xact-line + (macroexpand + `(rx (and line-start + (regexp ,ledger-full-date-regexp) + (? (and (+ space) (regexp ,ledger-state-regexp))) + (? (and (+ space) (regexp ,ledger-code-regexp))) + (+ space) (+? nonl) + (? (regexp ,ledger-end-note-regexp)) + line-end))) + "Match a transaction's first line (and optional notes)." + (actual-date full-date actual) + (effective-date full-date effective) + state + code + (note end-note)) + +(ledger-define-regexp account + (rx (group (and (not (any ?:)) (*? nonl)))) + "") + +(ledger-define-regexp account-kind + (rx (group (? (any ?\[ ?\))))) + "") + +(ledger-define-regexp full-account + (macroexpand + `(rx (and (regexp ,ledger-account-kind-regexp) + (regexp ,ledger-account-regexp) + (? (any ?\] ?\)))))) + "" + (kind account-kind) + (name account)) + +(ledger-define-regexp commodity + (rx (group + (or (and ?\" (+ (not (any ?\"))) ?\") + (not (any space ?\n + digit + ?- ?\[ ?\] + ?. ?, ?\; ?+ ?* ?/ ?^ ?? ?: ?& ?| ?! ?= + ?\< ?\> ?\{ ?\} ?\( ?\) ?@))))) + "") + +(ledger-define-regexp amount + (rx (group + (and (? ?-) + (and (+ digit) + (*? (and (any ?. ?,) (+ digit)))) + (? (and (any ?. ?,) (+ digit)))))) + "") + +(ledger-define-regexp commoditized-amount + (macroexpand + `(rx (group + (or (and (regexp ,ledger-commodity-regexp) + (*? space) + (regexp ,ledger-amount-regexp)) + (and (regexp ,ledger-amount-regexp) + (*? space) + (regexp ,ledger-commodity-regexp)))))) + "") + +(ledger-define-regexp commodity-annotations + (macroexpand + `(rx (* (+ space) + (or (and ?\{ (regexp ,ledger-commoditized-amount-regexp) ?\}) + (and ?\[ (regexp ,ledger-date-regexp) ?\]) + (and ?\( (not (any ?\))) ?\)))))) + "") + +(ledger-define-regexp cost + (macroexpand + `(rx (and (or "@" "@@") (+ space) + (regexp ,ledger-commoditized-amount-regexp)))) + "") + +(ledger-define-regexp balance-assertion + (macroexpand + `(rx (and ?= (+ space) + (regexp ,ledger-commoditized-amount-regexp)))) + "") + +(ledger-define-regexp full-amount + (macroexpand `(rx (group (+? (not (any ?\;)))))) + "") + +(ledger-define-regexp post-line + (macroexpand + `(rx (and line-start + (? (and (+ space) (regexp ,ledger-state-regexp))) + (+ space) (regexp ,ledger-full-account-regexp) + (+ space) (regexp ,ledger-full-amount-regexp) + (? (regexp ,ledger-end-note-regexp)) + line-end))) + "" + state + (account-kind full-account kind) + (account-name full-account name) + (amount full-amount) + (note end-note)) (provide 'ldg-regex) |