1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
|
(require 'rx)
(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 1)
(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.")
(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 (*? blank)
(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 (+ blank)
?\; (regexp ,ledger-note-regexp))))
"")
(ledger-define-regexp xact-line
(macroexpand
`(rx (and line-start
(regexp ,ledger-full-date-regexp)
(? (and (+ blank) (regexp ,ledger-state-regexp)))
(? (and (+ blank) (regexp ,ledger-code-regexp)))
(+ blank) (+? 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 blank ?\[ ?\( ?: ?\;)) (*? 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 blank ?\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)
(*? blank)
(regexp ,ledger-amount-regexp))
(and (regexp ,ledger-amount-regexp)
(*? blank)
(regexp ,ledger-commodity-regexp))))))
"")
(ledger-define-regexp commodity-annotations
(macroexpand
`(rx (* (+ blank)
(or (and ?\{ (regexp ,ledger-commoditized-amount-regexp) ?\})
(and ?\[ (regexp ,ledger-date-regexp) ?\])
(and ?\( (not (any ?\))) ?\))))))
"")
(ledger-define-regexp cost
(macroexpand
`(rx (and (or "@" "@@") (+ blank)
(regexp ,ledger-commoditized-amount-regexp))))
"")
(ledger-define-regexp balance-assertion
(macroexpand
`(rx (and ?= (+ blank)
(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 (+ blank)
(? (and (regexp ,ledger-state-regexp) (* blank)))
(regexp ,ledger-full-account-regexp)
(? (and (regexp ,ledger-long-space-regexp)
(regexp ,ledger-full-amount-regexp)))
(? (regexp ,ledger-end-note-regexp))
line-end)))
""
state
(account-kind full-account kind)
(account full-account name)
(amount full-amount)
(note end-note))
(provide 'ldg-regex)
|
