-
Notifications
You must be signed in to change notification settings - Fork 4
/
Copy pathorg-listcruncher.el
354 lines (320 loc) · 14.7 KB
/
org-listcruncher.el
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
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
;;; org-listcruncher.el --- Planning tool - Parse Org mode lists into table -*- lexical-binding: t; -*-
;; Author: Derek Feichtinger <[email protected]>
;; Keywords: convenience
;; Package-Requires: ((seq "2.3") (emacs "26.1"))
;; Homepage: https://github.com/dfeich/org-listcruncher
;; Version: 1.4
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; org-listcruncher is a planning tool that allows the conversion of
;; an Org mode list to an Org table (a list of lists). The table can
;; be used by other Org tables or Org code blocks for further
;; calculations.
;;
;; Example:
;;
;; #+NAME: lstTest
;; - item: item X modified by replacing values (amount: 15, recurrence: 1, end-year: 2020)
;; - modification of item X (amount: 20)
;; - another modification of item X (other: 500)
;; - modification of the modification (other: 299)
;; - illustrating inheritance (recurrence: 2, end-year: 2024)
;; - item: item A. Some longer explanation that may run over
;; multiple lines (amount: 10)
;; - item: item B (amount: 20)
;; - item: item C (amount: 30)
;; - a modification to item C (amount: 25, recurrence: 3)
;; - item: item Y modified by operations (amount: 50, recurrence: 4, end-year: 2026)
;; - modification by an operation (amount: +50)
;; - modification by an operation (amount: *1.5)
;; - item: item Z entered in scientific format (amount: 1e3, recurrence: 3, end-year: 2025)
;; - modification by an operation (amount: -1e2)
;;
;; We can use org-listcruncher to convert this list into a table
;;
;; #+NAME: src-example1
;; #+BEGIN_SRC elisp :results value :var listname="lstTest" :exports both
;; (org-listcruncher-to-table listname)
;; #+END_SRC
;;
;; #+RESULTS: src-example1
;; | description | other | amount | recurrence | end-year |
;; |-------------------------------------+-------+--------+------------+----------|
;; | item X modified by replacing values | 299 | 20 | 1 | 2020 |
;; | item A | | 10 | 2 | 2024 |
;; | item B | | 20 | 2 | 2024 |
;; | item C | | 25 | 3 | 2024 |
;; | item Y modified by operations | | 150.0 | 4 | 2026 |
;; | item Z entered in scientific format | | 900.0 | 3 | 2025 |
;;
;; The parsing and consolidation functions for producing the table can be modified by
;; the user. Please refer to the README and to the documentation strings of the
;; functions.
;;; Code:
(require 'org)
(require 'cl-lib)
(require 'seq)
(defgroup org-listcruncher nil
"Parses Org mode lists according to a parsing function and yields an org table structure."
:group 'org)
(defcustom org-listcruncher-parse-fn #'org-listcruncher-parseitem-default
"Function used for parsing list items.
The function receives a list item as its single argument. It must
return a list (OUTP, DESCR, VARLST), where OUTP is a boolean
indicating whether this list item will become a table row, DESCR
is its description string appearing in the table, VARLST is the
list of key/value pairs corresponding to the column name /
values. Simple example functions for this purpose can be generated
using the `org-listcruncher-mk-parseitem-default' generator
function."
:group 'org-listcruncher
:type 'function)
(defcustom org-listcruncher-consolidate-fn #'org-listcruncher-consolidate-default
"Function for consolidating a sequence of values for a certain key.
The function must accept two arguments: KEY and LIST. The KEY is
the key selecting the (KEY VALUE) pairs from the given LIST. The
function must return a single value based on consolidating the
VALUEs from the given key-value pairs. Refer to the default
function `org-listcruncher-consolidate-default'."
:group 'org-listcruncher
:type 'function )
;; TODO: make parentheses definitions a parameter
;;;###autoload
(cl-defun org-listcruncher-mk-parseitem-default (&key (tag "\\*?item:\\*?")
(endtag ".")
(bra "(")
(ket ")"))
"List item default parsing function generator for org-listcruncher.
This generator can be used to produce a family of parsing
functions with similar structure. It returns a parsing function
that will take a list item line as its only argument.
The generated parsing functions all share the following features.
1. Whether a list item will become a table row is defined by a matching
TAG at the beginning of the list item. Default is \"item:\" and allowing
for org bold markers.
2. The row's description is defined by the string following the TAG up to
a) a character contained in the ENDTAG argument or
b) the opening parenthesis BRA used for beginning the key/value pairs.
The default for ENDTAG is \".\".
3. The key/value pairs are separated by commas, and a key is separated from
its value by a colon key1: val1, key2: val2. The default brackets are
\"(\" and \")\".
The resulting function can be modified by the following keyword arguments:
- TAG REGEXP defines the REGEXP used for identifying whether a line will become
a table row.
- ENDTAG STRING: Each character contained in that string will act as a
terminator for the description of an item.
- The BRA and KET keywords can be used to define strings defining the opening
and closing parentheses to be used for enclosing the key/value pairs
The given strings will get regexp quoted."
(lambda (line)
(let (outp descr varstr varlst)
;; TODO: I should make the expression for the key:val list more restrictive
(if (string-match
(concat
"^ *\\(" tag "\\)?" ;; tag
" *\\([^" endtag bra "]*\\)" ;; description terminated by endtag or bra
"[^" bra "]*" ;; ignore everything until a bracket expression begins
;; key/val pairs
"\\\(" (regexp-quote bra) "\\\(\\\(\\\([^:,)]+\\\):\\\([^,)]+\\\),?\\\)+\\\)"
(regexp-quote ket) "\\\)?")
line)
(progn
(setq outp (if (match-string 1 line) t nil)
descr (replace-regexp-in-string " *$" "" (match-string 2 line))
varstr (match-string 4 line))))
(when varstr
(setq varlst
(cl-loop for elem in (split-string varstr ", *")
if (string-match "\\([^:]+\\): *\\(.*\\)" elem)
collect (list (match-string 1 elem)
(match-string 2 elem)) into result
finally return result)))
(list outp descr varlst))))
(defun org-listcruncher-parseitem-default (line)
"List item default parsing function for org-listcruncher.
Parses the given list item LINE."
(funcall (org-listcruncher-mk-parseitem-default) line))
(defun org-listcruncher--calc-orgtable (tbl)
"Aligns and calculates table functions of the given org table.
The table given in TBL will be processed using the standard
org mode `org-table-align' and `org-table-recalculate' functions.
The resulting table is returned in a string."
(with-temp-buffer
(erase-buffer)
(insert tbl)
(goto-char (point-min))
(org-mode)
(while
(search-forward-regexp org-table-any-line-regexp nil t)
(org-table-align)
(org-table-recalculate 'iterate)
(goto-char (org-table-end)))
(buffer-string)))
(defun org-listcruncher--sparse-to-table (sparselst &optional order)
"Return list of all unique keys of the list of alists in SPARSELST.
If a list is provided in the ORDER argument, the table columns
will be ordered according to this list. The list may contain only
a subset of the items. The remaining columns will be added in the
original order."
(let* ((keylst
;; list of all unique keys of the list of alists in SPARSELST
(cl-loop for alst in sparselst
with reslst = nil
collect (mapcar (lambda (kvpair) (car kvpair)) alst) into reslst
finally return (seq-uniq (apply #'append reslst))))
(orderedlst (append order
(cl-loop for elm in order
do (setq keylst (delete elm keylst))
finally return keylst)))
;; for each key, find var values in each given row in sparselist
(rows
(cl-loop for alst in sparselst
with reslst = nil
collect (mapcar (lambda (key)
(apply org-listcruncher-consolidate-fn
(list key alst)))
orderedlst) into reslst
finally return reslst)))
(if rows
(append `(,orderedlst) '(hline) rows)
nil)))
;;;###autoload
(cl-defun org-listcruncher-to-table (listname
&key (parsefn org-listcruncher-parse-fn)
(order nil)
(formula nil))
"Return a table structure based on parsing the Org list with name LISTNAME.
Optional keyword arguments: The user may use the PARSEFN
FUNCTION argument to define another parsing function for the list
items. The ORDER keyword takes a list containing column names as
its argument for defining the output table's desired columns
order. The list may contain only a subset of the items. The
remaining columns will be added in the original order.
If FORMULA is non-nil the given Calc formula will be calculated
by org spreadsheet functions (what usually would follow the
#+TBLFM: in an org spreadsheet table). The result is no longer a
Lisp table structure but a string containing the fully formatted
table."
(let* ((lst
(save-excursion
(goto-char (point-min))
(unless (search-forward-regexp (concat "^[ \t]*#\\\+NAME: .*" listname) nil t)
(error "No list of this name found: %s" listname))
(forward-line 1)
(org-list-to-lisp)))
(tbl
(org-listcruncher--sparse-to-table
(cadr (org-listcruncher--parselist lst parsefn nil nil))
order)))
(if formula
(org-listcruncher--calc-orgtable
(orgtbl-to-orgtbl (append tbl '(hline ("")))
`(:tend ,(concat "#+TBLFM: " formula))))
tbl)))
(defun org-listcruncher--parselist (lst parsefn inheritvars resultlst)
"Parse an org list into a table structure.
LST is a list as produced from `org-list-to-lisp'. PARSEFN is the
parsing function for the list items. INHERITVARS is an
association list of (varname value) pairs that constitute the
inherited variable values from the parent. RESULTLST contains the
current result structure in form of a list of association
lists. Each contained association list corresponds to a later
table row."
(let ((ltype (car lst))
(itemstructs (cdr lst))
retvarlst)
(setq retvarlst
(cl-loop for struct in itemstructs
with joinedsubvarlst = nil
do (let ((itemtext (car struct))
(sublist (cadr struct))
itemvarlst subtreevarlst outvarlst)
;; parse this item
(let* ((prsitem (apply parsefn `(,itemtext)))
(outp (car prsitem))
(descr (nth 1 prsitem))
(itemvarlst (nth 2 prsitem)))
;; (princ (format "DEBUG: item [%s] varlst: %s\n" descr itemvarlst))
;; if item has a sublist, recurse with this sublist and get varlst of this tree
(when sublist
(let ((parseresult (org-listcruncher--parselist sublist
parsefn
(append itemvarlst inheritvars)
resultlst)))
(setq subtreevarlst (car parseresult))
(setq resultlst (cadr parseresult)))
;;(princ (format "DEBUG: received subtreevarlst %s\n" subtreevarlst))
)
;; only prepare an output line if this item is flagged as an output item
(when outp
;; the current item's description always is placed first in the list
(setq outvarlst (append `(("description" ,descr)) subtreevarlst itemvarlst inheritvars))
(setq resultlst (append resultlst (list outvarlst))))
;; accumulate all item's varlists for returning to parent item
(setq joinedsubvarlst (append subtreevarlst itemvarlst joinedsubvarlst))))
;; we return the consolidated varlst of this tree
finally return joinedsubvarlst))
(list retvarlst resultlst)))
(defun org-listcruncher-consolidate-default (key lst)
"Return consolidated value for KEY out of the list LST of key-value pairs.
The list is given in reverse order (stack), i.e. the newest item
is at the beginning.
Example list:\n '((\"key\" \"+=10\") (\"key\" \"50\") (\"otherkey\"
\"hello\"))
When calling the function on this list with the KEY
argument set to \"key\" it will return 60."
(let* ((values (cl-loop for kv in lst
if (equal key (car kv))
collect (cadr kv) into reslst
finally return (nreverse reslst)))
(result (pop values)))
(cl-loop for v in values
if (string-match "^\\\([+/*]=?\\\|-=\\\)\\\([0-9.]+\\\(e[0-9+]\\\)?\\\)" v)
do (progn
(when (eq (type-of result) 'string)
(setq result (string-to-number result)))
(setq result (apply (pcase (match-string 1 v)
((or "+=" "+") '+)
("-=" '-)
((or "/=" "/") '/)
((or "*=" "*") '*))
(list result
(string-to-number (match-string 2 v))))))
else if (string-match "^\\(+\\|-\\)=\\(.*\\)" v)
do (progn (when (or (integerp result) (floatp result))
(setq result (number-to-string result)))
(pcase (match-string 1 v)
("+" (setq result (concat result " " (match-string 2 v))))
("-" (setq result
(mapconcat
'identity
(remove (match-string 2 v) (split-string result " "))
" ")))))
else
do (setq result v))
(or result "")))
;;;###autoload
(cl-defun org-listcruncher-get-field (listname row col &key (parsefn org-listcruncher-parse-fn))
"Return field defined by ROW,COL from the table derived from LISTNAME.
The given list with LISTNAME is parsed by listcruncher to obtain a table.
The field is defined by the two strings for ROW and COL, where the ROW string
corresponds to the contents of the item's \"description\" column and the COL
string corresponds to the column's name."
(let* ((tbl (org-listcruncher-to-table listname :parsefn parsefn))
(colnames (car tbl))
(colidx (cl-position col colnames :test #'equal)))
(nth colidx (assoc row tbl))))
(provide 'org-listcruncher)
;;; org-listcruncher.el ends here