Rewrote ldg-regex with a macro (for simplicity)
This commit is contained in:
John Wiegley
parent
7ca8149ec5
commit
2af1360042
2 changed files with 232 additions and 150 deletions
|
|
@ -50,7 +50,7 @@ to choose from."
|
||||||
(account-len (length account))
|
(account-len (length account))
|
||||||
(pos (point)))
|
(pos (point)))
|
||||||
(goto-char (line-beginning-position))
|
(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))))
|
(let ((existing-len (length (match-string 3))))
|
||||||
(goto-char (match-beginning 3))
|
(goto-char (match-beginning 3))
|
||||||
(delete-region (match-beginning 3) (match-end 3))
|
(delete-region (match-beginning 3) (match-end 3))
|
||||||
|
|
@ -76,13 +76,13 @@ to choose from."
|
||||||
(goto-char beg)
|
(goto-char beg)
|
||||||
(when (< end (line-end-position))
|
(when (< end (line-end-position))
|
||||||
(goto-char (line-beginning-position))
|
(goto-char (line-beginning-position))
|
||||||
(if (looking-at ledger-regex-post-line)
|
(if (looking-at ledger-post-line-regexp)
|
||||||
(ledger-post-align-amount)))))
|
(ledger-post-align-amount)))))
|
||||||
|
|
||||||
(defun ledger-post-edit-amount ()
|
(defun ledger-post-edit-amount ()
|
||||||
(interactive)
|
(interactive)
|
||||||
(goto-char (line-beginning-position))
|
(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))
|
(goto-char (match-end 3))
|
||||||
(when (re-search-forward "[-.,0-9]+" (line-end-position) t)
|
(when (re-search-forward "[-.,0-9]+" (line-end-position) t)
|
||||||
(let ((val (match-string 0)))
|
(let ((val (match-string 0)))
|
||||||
|
|
@ -96,16 +96,16 @@ to choose from."
|
||||||
(defun ledger-post-prev-xact ()
|
(defun ledger-post-prev-xact ()
|
||||||
(interactive)
|
(interactive)
|
||||||
(backward-paragraph)
|
(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))
|
(goto-char (match-beginning 0))
|
||||||
(re-search-forward ledger-regex-post-line)
|
(re-search-forward ledger-post-line-regexp)
|
||||||
(goto-char (match-end 3))))
|
(goto-char (match-end 3))))
|
||||||
|
|
||||||
(defun ledger-post-next-xact ()
|
(defun ledger-post-next-xact ()
|
||||||
(interactive)
|
(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))
|
(goto-char (match-beginning 0))
|
||||||
(re-search-forward ledger-regex-post-line)
|
(re-search-forward ledger-post-line-regexp)
|
||||||
(goto-char (match-end 3))))
|
(goto-char (match-end 3))))
|
||||||
|
|
||||||
(defun ledger-post-setup ()
|
(defun ledger-post-setup ()
|
||||||
|
|
|
||||||
|
|
@ -1,6 +1,104 @@
|
||||||
(require 'rx)
|
(require 'rx)
|
||||||
|
|
||||||
(defconst ledger-regex-date
|
(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
|
(let ((sep '(or ?- (any ?. ?/)))) ; can't do (any ?- ?. ?/) due to bug
|
||||||
(rx (group
|
(rx (group
|
||||||
(and (? (= 4 num)
|
(and (? (= 4 num)
|
||||||
|
|
@ -10,158 +108,142 @@
|
||||||
(and num (? num))))))
|
(and num (? num))))))
|
||||||
"Match a single date, in its 'written' form.")
|
"Match a single date, in its 'written' form.")
|
||||||
|
|
||||||
(defconst ledger-regex-date-group 1)
|
(ledger-define-regexp full-date
|
||||||
(defconst ledger-regex-date-group--count 1)
|
|
||||||
|
|
||||||
(defconst ledger-regex-full-date
|
|
||||||
(macroexpand
|
(macroexpand
|
||||||
`(rx (and (regexp ,ledger-regex-date)
|
`(rx (and (regexp ,ledger-date-regexp)
|
||||||
(? (and ?= (regexp ,ledger-regex-date))))))
|
(? (and ?= (regexp ,ledger-date-regexp))))))
|
||||||
"Match a compound date, of the form ACTUAL=EFFECTIVE")
|
"Match a compound date, of the form ACTUAL=EFFECTIVE"
|
||||||
|
(actual date)
|
||||||
|
(effective date))
|
||||||
|
|
||||||
(defconst ledger-regex-full-date-group-actual
|
(ledger-define-regexp state
|
||||||
ledger-regex-date-group)
|
(rx (group (any ?! ?*)))
|
||||||
(defconst ledger-regex-full-date-group-effective
|
"Match a transaction or posting's \"state\" character.")
|
||||||
(+ 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
|
(ledger-define-regexp code
|
||||||
(rx (group (any ?! ?*))))
|
(rx (and ?\( (group (+? (not (any ?\))))) ?\)))
|
||||||
|
"Match the transaction code.")
|
||||||
|
|
||||||
(defconst ledger-regex-state-group 1)
|
(ledger-define-regexp long-space
|
||||||
(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)
|
(rx (and (*? space)
|
||||||
(or (and ? (or ? ?\t)) ?\t))))
|
(or (and ? (or ? ?\t)) ?\t)))
|
||||||
|
"Match a \"long space\".")
|
||||||
|
|
||||||
(defconst ledger-regex-note
|
(ledger-define-regexp note
|
||||||
(rx (group (+ nonl))))
|
(rx (group (+ nonl)))
|
||||||
|
"")
|
||||||
|
|
||||||
(defconst ledger-regex-note-group 1)
|
(ledger-define-regexp end-note
|
||||||
(defconst ledger-regex-note-group--count 1)
|
(macroexpand
|
||||||
|
`(rx (and (regexp ,ledger-long-space-regexp) ?\;
|
||||||
|
(regexp ,ledger-note-regexp))))
|
||||||
|
"")
|
||||||
|
|
||||||
(defconst ledger-regex-end-note
|
(ledger-define-regexp full-note
|
||||||
(macroexpand `(rx (and (regexp ,ledger-regex-long-space) ?\;
|
(macroexpand
|
||||||
(regexp ,ledger-regex-note)))))
|
`(rx (and line-start (+ space)
|
||||||
|
?\; (regexp ,ledger-note-regexp))))
|
||||||
|
"")
|
||||||
|
|
||||||
(defconst ledger-regex-end-note-group
|
(ledger-define-regexp xact-line
|
||||||
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
|
(macroexpand
|
||||||
`(rx (and line-start
|
`(rx (and line-start
|
||||||
(regexp ,ledger-regex-full-date)
|
(regexp ,ledger-full-date-regexp)
|
||||||
(? (and (+ space) (regexp ,ledger-regex-state)))
|
(? (and (+ space) (regexp ,ledger-state-regexp)))
|
||||||
(? (and (+ space) (regexp ,ledger-regex-code)))
|
(? (and (+ space) (regexp ,ledger-code-regexp)))
|
||||||
(+ space) (+? nonl)
|
(+ space) (+? nonl)
|
||||||
(? (regexp ,ledger-regex-end-note))
|
(? (regexp ,ledger-end-note-regexp))
|
||||||
line-end))))
|
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))
|
||||||
|
|
||||||
(defconst ledger-regex-xact-line-group-actual-date
|
(ledger-define-regexp account
|
||||||
ledger-regex-full-date-group-actual)
|
(rx (group (and (not (any ?:)) (*? nonl))))
|
||||||
(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
|
(ledger-define-regexp account-kind
|
||||||
(&optional string)
|
(rx (group (? (any ?\[ ?\)))))
|
||||||
(match-string ledger-regex-xact-line-group-actual-date string))
|
"")
|
||||||
|
|
||||||
(defconst ledger-regex-account
|
(ledger-define-regexp full-account
|
||||||
(rx (group (and (not (any ?:)) (*? nonl)))))
|
|
||||||
|
|
||||||
(defconst ledger-regex-full-account
|
|
||||||
(macroexpand
|
(macroexpand
|
||||||
`(rx (and (group (? (any ?\[ ?\))))
|
`(rx (and (regexp ,ledger-account-kind-regexp)
|
||||||
(regexp ,ledger-regex-account)
|
(regexp ,ledger-account-regexp)
|
||||||
(? (any ?\] ?\)))))))
|
(? (any ?\] ?\))))))
|
||||||
|
""
|
||||||
|
(kind account-kind)
|
||||||
|
(name account))
|
||||||
|
|
||||||
(defconst ledger-regex-commodity
|
(ledger-define-regexp commodity
|
||||||
(rx (or (and ?\" (+ (not (any ?\"))) ?\")
|
(rx (group
|
||||||
|
(or (and ?\" (+ (not (any ?\"))) ?\")
|
||||||
(not (any space ?\n
|
(not (any space ?\n
|
||||||
digit
|
digit
|
||||||
?- ?\[ ?\]
|
?- ?\[ ?\]
|
||||||
?. ?, ?\; ?+ ?* ?/ ?^ ?? ?: ?& ?| ?! ?=
|
?. ?, ?\; ?+ ?* ?/ ?^ ?? ?: ?& ?| ?! ?=
|
||||||
?\< ?\> ?\{ ?\} ?\( ?\) ?@)))))
|
?\< ?\> ?\{ ?\} ?\( ?\) ?@)))))
|
||||||
|
"")
|
||||||
|
|
||||||
(defconst ledger-regex-amount
|
(ledger-define-regexp amount
|
||||||
(rx (and (? ?-)
|
(rx (group
|
||||||
|
(and (? ?-)
|
||||||
(and (+ digit)
|
(and (+ digit)
|
||||||
(*? (and (any ?. ?,) (+ digit))))
|
(*? (and (any ?. ?,) (+ digit))))
|
||||||
(? (and (any ?. ?,) (+ digit))))))
|
(? (and (any ?. ?,) (+ digit))))))
|
||||||
|
"")
|
||||||
|
|
||||||
(defconst ledger-regex-commoditized-amount
|
(ledger-define-regexp commoditized-amount
|
||||||
(macroexpand
|
(macroexpand
|
||||||
`(rx (or (and (regexp ,ledger-regex-commodity)
|
`(rx (group
|
||||||
|
(or (and (regexp ,ledger-commodity-regexp)
|
||||||
(*? space)
|
(*? space)
|
||||||
(regexp ,ledger-regex-amount))
|
(regexp ,ledger-amount-regexp))
|
||||||
(and (regexp ,ledger-regex-amount)
|
(and (regexp ,ledger-amount-regexp)
|
||||||
(*? space)
|
(*? space)
|
||||||
(regexp ,ledger-regex-commodity))))))
|
(regexp ,ledger-commodity-regexp))))))
|
||||||
|
"")
|
||||||
|
|
||||||
(defconst ledger-regex-commodity-annotations
|
(ledger-define-regexp commodity-annotations
|
||||||
(macroexpand
|
(macroexpand
|
||||||
`(rx (* (+ space)
|
`(rx (* (+ space)
|
||||||
(or (and ?\{ (regexp ,ledger-regex-commoditized-amount) ?\})
|
(or (and ?\{ (regexp ,ledger-commoditized-amount-regexp) ?\})
|
||||||
(and ?\[ (regexp ,ledger-regex-date) ?\])
|
(and ?\[ (regexp ,ledger-date-regexp) ?\])
|
||||||
(and ?\( (not (any ?\))) ?\)))))))
|
(and ?\( (not (any ?\))) ?\))))))
|
||||||
|
"")
|
||||||
|
|
||||||
(defconst ledger-regex-cost
|
(ledger-define-regexp cost
|
||||||
(macroexpand
|
(macroexpand
|
||||||
`(rx (and (or "@" "@@") (+ space)
|
`(rx (and (or "@" "@@") (+ space)
|
||||||
(regexp ,ledger-regex-commoditized-amount)))))
|
(regexp ,ledger-commoditized-amount-regexp))))
|
||||||
|
"")
|
||||||
|
|
||||||
(defconst ledger-regex-balance-assertion
|
(ledger-define-regexp balance-assertion
|
||||||
(macroexpand
|
(macroexpand
|
||||||
`(rx (and ?= (+ space)
|
`(rx (and ?= (+ space)
|
||||||
(regexp ,ledger-regex-commoditized-amount)))))
|
(regexp ,ledger-commoditized-amount-regexp))))
|
||||||
|
"")
|
||||||
|
|
||||||
(defconst ledger-regex-full-amount
|
(ledger-define-regexp full-amount
|
||||||
(macroexpand `(rx (group (+? (not (any ?\;)))))))
|
(macroexpand `(rx (group (+? (not (any ?\;))))))
|
||||||
|
"")
|
||||||
|
|
||||||
(defconst ledger-regex-post-line
|
(ledger-define-regexp post-line
|
||||||
(macroexpand
|
(macroexpand
|
||||||
`(rx (and line-start
|
`(rx (and line-start
|
||||||
(? (and (+ space) (regexp ,ledger-regex-state)))
|
(? (and (+ space) (regexp ,ledger-state-regexp)))
|
||||||
(+ space) (regexp ,ledger-regex-full-account)
|
(+ space) (regexp ,ledger-full-account-regexp)
|
||||||
(+ space) (regexp ,ledger-regex-full-amount)
|
(+ space) (regexp ,ledger-full-amount-regexp)
|
||||||
(? (regexp ,ledger-regex-end-note))
|
(? (regexp ,ledger-end-note-regexp))
|
||||||
line-end))))
|
line-end)))
|
||||||
|
""
|
||||||
|
state
|
||||||
|
(account-kind full-account kind)
|
||||||
|
(account-name full-account name)
|
||||||
|
(amount full-amount)
|
||||||
|
(note end-note))
|
||||||
|
|
||||||
(provide 'ldg-regex)
|
(provide 'ldg-regex)
|
||||||
|
|
|
||||||
Loading…
Add table
Reference in a new issue