?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
org-table: Fix shrunk hlines
[org-mode/org-tableheadings.git] / testing / lisp / test-org-table.el
blobecef7ea8e2a7e9259079c9889a55783a41bf842a
1 ;;; test-org-table.el --- tests for org-table.el
2
3 ;; Copyright (c) David Maus
4 ;; Authors: David Maus, Michael Brand
5
6 ;; This file is not part of GNU Emacs.
7
8 ;; This program is free software; you can redistribute it and/or modify
9 ;; it under the terms of the GNU General Public License as published by
10 ;; the Free Software Foundation, either version 3 of the License, or
11 ;; (at your option) any later version.
12
13 ;; This program is distributed in the hope that it will be useful,
14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 ;; GNU General Public License for more details.
17
18 ;; You should have received a copy of the GNU General Public License
19 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
20
21 ;;;; Comments:
22
23 ;; Template test file for Org tests. Many tests are also a howto
24 ;; example collection as a user documentation, more or less all those
25 ;; using `org-test-table-target-expect'. See also the doc string of
26 ;; `org-test-table-target-expect'.
27
28 ;;; Code:
29
30 (require 'org-table) ; `org-table-make-reference'
31
32 (ert-deftest test-org-table/simple-formula/no-grouping/no-title-row ()
33 "Simple sum without grouping rows, without title row."
34 (org-test-table-target-expect
35 "
36 | 2 |
37 | 4 |
38 | 8 |
39 | replace |
40 "
41 "
42 | 2 |
43 | 4 |
44 | 8 |
45 | 14 |
46 "
47 1
48 ;; Calc formula
49 "#+TBLFM: @>$1 = vsum(@<..@>>)"
50 ;; Lisp formula
51 "#+TBLFM: @>$1 = '(+ @<..@>>); N"))
52
53 (ert-deftest test-org-table/simple-formula/no-grouping/with-title-row ()
54 "Simple sum without grouping rows, with title row."
55 (org-test-table-target-expect
56 "
57 | foo |
58 |---------|
59 | 2 |
60 | 4 |
61 | 8 |
62 | replace |
63 "
64 "
65 | foo |
66 |-----|
67 | 2 |
68 | 4 |
69 | 8 |
70 | 14 |
71 "
72 1
73 ;; Calc formula
74 "#+TBLFM: @>$1 = vsum(@I..@>>)"
75 ;; Lisp formula
76 "#+TBLFM: @>$1 = '(+ @I..@>>); N"))
77
78 (ert-deftest test-org-table/simple-formula/with-grouping/no-title-row ()
79 "Simple sum with grouping rows, how not to do."
80 ;; The first example has a problem, see the second example in this
81 ;; ert-deftest.
82 (org-test-table-target-expect
83 "
84 | 2 |
85 | 4 |
86 | 8 |
87 |---------|
88 | replace |
89 "
90 "
91 | 2 |
92 | 4 |
93 | 8 |
94 |----|
95 | 14 |
96 "
97 1
98 ;; Calc formula
99 "#+TBLFM: $1 = vsum(@<..@>>)"
100 ;; Lisp formula
101 "#+TBLFM: $1 = '(+ @<..@>>); N")
102
103 ;; The problem is that the first three rows with the summands are
104 ;; considered the header and therefore column formulas are not
105 ;; applied on them as shown below. Also export behaves unexpected.
106 ;; See next ert-deftest how to group rows right.
107 (org-test-table-target-expect
108 "
109 | 2 | header |
110 | 4 | header |
111 | 8 | header |
112 |---------+---------|
113 | replace | replace |
114 "
115 "
116 | 2 | header |
117 | 4 | header |
118 | 8 | header |
119 |----+--------|
120 | 14 | 28 |
121 "
122 2
123 ;; Calc formula
124 "#+TBLFM: @>$1 = vsum(@<..@>>) :: $2 = 2 * $1"
125 ;; Lisp formula
126 "#+TBLFM: @>$1 = '(+ @<..@>>); N :: $2 = '(* 2 $1); N"))
127
128 (ert-deftest test-org-table/simple-formula/with-grouping/with-title-row ()
129 "Simple sum with grouping rows, how to do it right."
130 ;; Always add a top row with the column names separated by hline to
131 ;; get the desired header when you want to group rows.
132 (org-test-table-target-expect
133 "
134 | foo | bar |
135 |---------+---------|
136 | 2 | replace |
137 | 4 | replace |
138 | 8 | replace |
139 |---------+---------|
140 | replace | replace |
141 "
142 "
143 | foo | bar |
144 |-----+-----|
145 | 2 | 4 |
146 | 4 | 8 |
147 | 8 | 16 |
148 |-----+-----|
149 | 14 | 28 |
150 "
151 2
152 ;; Calc formula
153 "#+TBLFM: @>$1 = vsum(@I..@>>) :: $2 = 2 * $1"
154 ;; Lisp formula
155 "#+TBLFM: @>$1 = '(+ @I..@>>); N :: $2 = '(* 2 $1); N"))
156
157 (defconst references/target-normal "
158 | 0 | 1 | replace | replace | replace | replace | replace | replace |
159 | z | 1 | replace | replace | replace | replace | replace | replace |
160 | | 1 | replace | replace | replace | replace | replace | replace |
161 | | | replace | replace | replace | replace | replace | replace |
162 "
163 "Normal numbers and non-numbers for Lisp and Calc formula.")
164
165 (defconst references/target-special "
166 | nan | 1 | replace | replace | replace | replace | replace | replace |
167 | uinf | 1 | replace | replace | replace | replace | replace | replace |
168 | -inf | 1 | replace | replace | replace | replace | replace | replace |
169 | inf | 1 | replace | replace | replace | replace | replace | replace |
170 "
171 "Special numbers for Calc formula.")
172
173 (ert-deftest test-org-table/references/mode-string-EL ()
174 "Basic: Assign field reference, sum of field references, sum
175 and len of simple range reference (no row) and complex range
176 reference (with row). Mode string EL."
177 ;; Empty fields are kept during parsing field but lost as list
178 ;; elements within Lisp formula syntactically when used literally
179 ;; and not enclosed with " within fields, see last columns with len.
180 (org-test-table-target-expect
181 references/target-normal
182 ;; All the #ERROR show that for Lisp calculations N has to be used.
183 "
184 | 0 | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
185 | z | 1 | z | #ERROR | #ERROR | #ERROR | 2 | 2 |
186 | | 1 | | 1 | 1 | 1 | 1 | 1 |
187 | | | | 0 | 0 | 0 | 0 | 0 |
188 "
189 1 (concat
190 "#+TBLFM: $3 = '(identity \"$1\"); EL :: $4 = '(+ $1 $2); EL :: "
191 "$5 = '(+ $1..$2); EL :: $6 = '(+ @0$1..@0$2); EL :: "
192 "$7 = '(length '($1..$2)); EL :: $8 = '(length '(@0$1..@0$2)); EL"))
193
194 ;; Empty fields are kept during parsing field _and_ as list elements
195 ;; within Lisp formula syntactically even when used literally when
196 ;; enclosed with " within fields, see last columns with len.
197 (org-test-table-target-expect
198 "
199 | \"0\" | \"1\" | repl | repl | repl | repl | repl | repl |
200 | \"z\" | \"1\" | repl | repl | repl | repl | repl | repl |
201 | \"\" | \"1\" | repl | repl | repl | repl | repl | repl |
202 | \"\" | \"\" | repl | repl | repl | repl | repl | repl |
203 "
204 "
205 | \"0\" | \"1\" | \"0\" | 1 | #ERROR | #ERROR | 2 | 2 |
206 | \"z\" | \"1\" | \"z\" | 1 | #ERROR | #ERROR | 2 | 2 |
207 | \"\" | \"1\" | \"\" | 1 | #ERROR | #ERROR | 2 | 2 |
208 | \"\" | \"\" | \"\" | 0 | #ERROR | #ERROR | 2 | 2 |
209 "
210 1 (concat
211 "#+TBLFM: $3 = '(concat \"\\\"\" $1 \"\\\"\"); EL :: "
212 "$4 = '(+ (string-to-number $1) (string-to-number $2)); EL :: "
213 "$5 = '(+ $1..$2); EL :: $6 = '(+ @0$1..@0$2); EL :: "
214 "$7 = '(length '($1..$2)); EL :: $8 = '(length '(@0$1..@0$2)); EL")))
215
216 (ert-deftest test-org-table/references/mode-string-E ()
217 "Basic: Assign field reference, sum of field references, sum
218 and len of simple range reference (no row) and complex range
219 reference (with row). Mode string E."
220 (let ((lisp
221 (concat
222 "#+TBLFM: $3 = '(identity $1); E :: $4 = '(+ $1 $2); E :: "
223 "$5 = '(+ $1..$2); E :: $6 = '(+ @0$1..@0$2); E :: "
224 "$7 = '(length '($1..$2)); E :: $8 = '(length '(@0$1..@0$2)); E"))
225 (calc
226 (concat
227 "#+TBLFM: $3 = $1; E :: $4 = $1 + $2; E :: "
228 "$5 = vsum($1..$2); E :: $6 = vsum(@0$1..@0$2); E :: "
229 "$7 = vlen($1..$2); E :: $8 = vlen(@0$1..@0$2); E")))
230 (org-test-table-target-expect
231 references/target-normal
232 ;; All the #ERROR show that for Lisp calculations N has to be used.
233 "
234 | 0 | 1 | 0 | #ERROR | #ERROR | #ERROR | 2 | 2 |
235 | z | 1 | z | #ERROR | #ERROR | #ERROR | 2 | 2 |
236 | | 1 | | #ERROR | #ERROR | #ERROR | 2 | 2 |
237 | | | | #ERROR | #ERROR | #ERROR | 2 | 2 |
238 "
239 1 lisp)
240 (org-test-table-target-expect
241 references/target-normal
242 "
243 | 0 | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
244 | z | 1 | z | z + 1 | z + 1 | z + 1 | 2 | 2 |
245 | | 1 | nan | nan | nan | nan | 2 | 2 |
246 | | | nan | nan | nan | nan | 2 | 2 |
247 "
248 1 calc)
249 (org-test-table-target-expect
250 references/target-special
251 "
252 | nan | 1 | nan | nan | nan | nan | 2 | 2 |
253 | uinf | 1 | uinf | uinf | uinf | uinf | 2 | 2 |
254 | -inf | 1 | -inf | -inf | -inf | -inf | 2 | 2 |
255 | inf | 1 | inf | inf | inf | inf | 2 | 2 |
256 "
257 1 calc)))
258
259 (ert-deftest test-org-table/references/mode-string-EN ()
260 "Basic: Assign field reference, sum of field references, sum
261 and len of simple range reference (no row) and complex range
262 reference (with row). Mode string EN."
263 (let ((lisp (concat
264 "#+TBLFM: $3 = '(identity $1); EN :: $4 = '(+ $1 $2); EN :: "
265 "$5 = '(+ $1..$2); EN :: $6 = '(+ @0$1..@0$2); EN :: "
266 "$7 = '(length '($1..$2)); EN :: "
267 "$8 = '(length '(@0$1..@0$2)); EN"))
268 (calc (concat
269 "#+TBLFM: $3 = $1; EN :: $4 = $1 + $2; EN :: "
270 "$5 = vsum($1..$2); EN :: $6 = vsum(@0$1..@0$2); EN :: "
271 "$7 = vlen($1..$2); EN :: $8 = vlen(@0$1..@0$2); EN")))
272 (org-test-table-target-expect
273 references/target-normal
274 "
275 | 0 | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
276 | z | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
277 | | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
278 | | | 0 | 0 | 0 | 0 | 2 | 2 |
279 "
280 1 lisp calc)
281 (org-test-table-target-expect
282 references/target-special
283 "
284 | nan | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
285 | uinf | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
286 | -inf | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
287 | inf | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
288 "
289 1 calc)))
290
291 (ert-deftest test-org-table/references/mode-string-L ()
292 "Basic: Assign field reference, sum of field references, sum
293 and len of simple range reference (no row) and complex range
294 reference (with row). Mode string L."
295 (org-test-table-target-expect
296 references/target-normal
297 ;; All the #ERROR show that for Lisp calculations N has to be used.
298 "
299 | 0 | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
300 | z | 1 | z | #ERROR | #ERROR | #ERROR | 2 | 2 |
301 | | 1 | | 1 | 1 | 1 | 1 | 1 |
302 | | | | 0 | 0 | 0 | 0 | 0 |
303 "
304 1 (concat
305 "#+TBLFM: $3 = '(identity \"$1\"); L :: $4 = '(+ $1 $2); L :: "
306 "$5 = '(+ $1..$2); L :: $6 = '(+ @0$1..@0$2); L :: "
307 "$7 = '(length '($1..$2)); L :: $8 = '(length '(@0$1..@0$2)); L")))
308
309 (ert-deftest test-org-table/references/mode-string-none ()
310 "Basic: Assign field reference, sum of field references, sum
311 and len of simple range reference (no row) and complex range
312 reference (with row). No mode string."
313 (let ((lisp (concat
314 "#+TBLFM: $3 = '(identity $1) :: $4 = '(+ $1 $2) :: "
315 "$5 = '(+ $1..$2) :: $6 = '(+ @0$1..@0$2) :: "
316 "$7 = '(length '($1..$2)) :: $8 = '(length '(@0$1..@0$2))"))
317 (calc (concat
318 "#+TBLFM: $3 = $1 :: $4 = $1 + $2 :: "
319 "$5 = vsum($1..$2) :: $6 = vsum(@0$1..@0$2) :: "
320 "$7 = vlen($1..$2) :: $8 = vlen(@0$1..@0$2)")))
321 (org-test-table-target-expect
322 references/target-normal
323 ;; All the #ERROR show that for Lisp calculations N has to be used.
324 "
325 | 0 | 1 | 0 | #ERROR | #ERROR | #ERROR | 2 | 2 |
326 | z | 1 | z | #ERROR | #ERROR | #ERROR | 2 | 2 |
327 | | 1 | | #ERROR | #ERROR | #ERROR | 1 | 1 |
328 | | | | #ERROR | 0 | 0 | 0 | 0 |
329 "
330 1 lisp)
331 (org-test-table-target-expect
332 references/target-normal
333 "
334 | 0 | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
335 | z | 1 | z | z + 1 | z + 1 | z + 1 | 2 | 2 |
336 | | 1 | 0 | 1 | 1 | 1 | 1 | 1 |
337 | | | 0 | 0 | 0 | 0 | 0 | 0 |
338 "
339 1 calc)
340 (org-test-table-target-expect
341 references/target-special
342 "
343 | nan | 1 | nan | nan | nan | nan | 2 | 2 |
344 | uinf | 1 | uinf | uinf | uinf | uinf | 2 | 2 |
345 | -inf | 1 | -inf | -inf | -inf | -inf | 2 | 2 |
346 | inf | 1 | inf | inf | inf | inf | 2 | 2 |
347 "
348 1 calc)))
349
350 (ert-deftest test-org-table/references/mode-string-N ()
351 "Basic: Assign field reference, sum of field references, sum
352 and len of simple range reference (no row) and complex range
353 reference (with row). Mode string N."
354 (let ((lisp
355 (concat
356 "#+TBLFM: $3 = '(identity $1); N :: $4 = '(+ $1 $2); N :: "
357 "$5 = '(+ $1..$2); N :: $6 = '(+ @0$1..@0$2); N :: "
358 "$7 = '(length '($1..$2)); N :: $8 = '(length '(@0$1..@0$2)); N"))
359 (calc
360 (concat
361 "#+TBLFM: $3 = $1; N :: $4 = $1 + $2; N :: "
362 "$5 = vsum($1..$2); N :: $6 = vsum(@0$1..@0$2); N :: "
363 "$7 = vlen($1..$2); N :: $8 = vlen(@0$1..@0$2); N")))
364 (org-test-table-target-expect
365 references/target-normal
366 "
367 | 0 | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
368 | z | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
369 | | 1 | 0 | 1 | 1 | 1 | 1 | 1 |
370 | | | 0 | 0 | 0 | 0 | 0 | 0 |
371 "
372 1 lisp calc)
373 (org-test-table-target-expect
374 references/target-special
375 "
376 | nan | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
377 | uinf | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
378 | -inf | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
379 | inf | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
380 "
381 1 calc)))
382
383 (ert-deftest test-org-table/lisp-return-value ()
384 "Basic: Return value of Lisp formulas."
385 (org-test-table-target-expect
386 "
387 | | nil | (list) | '() |
388 |-------------------------+-------------+--------+-----|
389 | type-of, no L | replace (r) | r | r |
390 | type-of identity, no L | r | r | r |
391 | identity, no L | r | r | r |
392 |-------------------------+-------------+--------+-----|
393 | type-of \"@1\" | r | r | r |
394 | type-of (identity \"@1\") | r | r | r |
395 | identity \"@1\" | r | r | r |
396 |-------------------------+-------------+--------+-----|
397 | type-of @1 | r | r | r |
398 | type-of (identity @1) | r | r | r |
399 | identity @1 | r | r | r |
400 "
401 "
402 | | nil | (list) | '() |
403 |-------------------------+--------+--------+--------|
404 | type-of, no L | string | string | string |
405 | type-of identity, no L | string | string | string |
406 | identity, no L | nil | (list) | '() |
407 |-------------------------+--------+--------+--------|
408 | type-of \"@1\" | string | string | string |
409 | type-of (identity \"@1\") | string | string | string |
410 | identity \"@1\" | nil | (list) | '() |
411 |-------------------------+--------+--------+--------|
412 | type-of @1 | symbol | symbol | symbol |
413 | type-of (identity @1) | symbol | symbol | symbol |
414 | identity @1 | nil | nil | nil |
415 "
416 1 (concat "#+TBLFM: @2$<<..@2$> = '(type-of @1) :: "
417 "@3$<<..@3$> = '(type-of (identity @1)) :: "
418 "@4$<<..@4$> = '(identity @1) :: @5$<<..@>$> = '(@0$1); L")))
419
420 (ert-deftest test-org-table/compare ()
421 "Basic: Compare field references in Calc."
422 (org-test-table-target-expect
423 "
424 | | 0 | z | | nan | uinf | -inf | inf |
425 |------+------+------+------+------+------+------+------|
426 | 0 | repl | repl | repl | repl | repl | repl | repl |
427 | z | repl | repl | repl | repl | repl | repl | repl |
428 | | repl | repl | repl | repl | repl | repl | repl |
429 | nan | repl | repl | repl | repl | repl | repl | repl |
430 | uinf | repl | repl | repl | repl | repl | repl | repl |
431 | -inf | repl | repl | repl | repl | repl | repl | repl |
432 | inf | repl | repl | repl | repl | repl | repl | repl |
433 "
434 "
435 | | 0 | z | | nan | uinf | -inf | inf |
436 |------+---+---+---+-----+------+------+-----|
437 | 0 | x | | | | | | |
438 | z | | x | | | | | |
439 | | | | x | | | | |
440 | nan | | | | x | | | |
441 | uinf | | | | | x | | |
442 | -inf | | | | | | x | |
443 | inf | | | | | | | x |
444 "
445 1
446 ;; Compare field reference ($1) with field reference (@1)
447 "#+TBLFM: @<<$<<..@>$> = if(\"$1\" == \"@1\", x, string(\"\")); E"
448 ;; Compare field reference ($1) with absolute term
449 (concat "#+TBLFM: "
450 "$2 = if(\"$1\" == \"(0)\" , x, string(\"\")); E :: "
451 "$3 = if(\"$1\" == \"(z)\" , x, string(\"\")); E :: "
452 "$4 = if(\"$1\" == \"nan\" , x, string(\"\")); E :: "
453 "$5 = if(\"$1\" == \"(nan)\" , x, string(\"\")); E :: "
454 "$6 = if(\"$1\" == \"(uinf)\", x, string(\"\")); E :: "
455 "$7 = if(\"$1\" == \"(-inf)\", x, string(\"\")); E :: "
456 "$8 = if(\"$1\" == \"(inf)\" , x, string(\"\")); E"))
457
458 ;; Check field reference converted from an empty field: Despite this
459 ;; field reference will not end up in a result, Calc evaluates it.
460 ;; Make sure that also then there is no Calc error.
461 (org-test-table-target-expect
462 "
463 | 0 | replace |
464 | z | replace |
465 | | replace |
466 | nan | replace |
467 "
468 "
469 | 0 | 1 |
470 | z | z + 1 |
471 | | |
472 | nan | nan |
473 "
474 1 "#+TBLFM: $2 = if(\"$1\" == \"nan\", string(\"\"), $1 + 1); E"))
475
476 (ert-deftest test-org-table/empty-field ()
477 "Examples how to deal with empty fields."
478 ;; Test if one field is empty, else do a calculation
479 (org-test-table-target-expect
480 "
481 | -1 | replace |
482 | 0 | replace |
483 | | replace |
484 "
485 "
486 | -1 | 0 |
487 | 0 | 1 |
488 | | |
489 "
490 1
491 ;; Calc formula
492 "#+TBLFM: $2 = if(\"$1\" == \"nan\", string(\"\"), $1 + 1); E"
493 ;; Lisp formula
494 "#+TBLFM: $2 = '(if (eq \"$1\" \"\") \"\" (1+ $1)); L")
495
496 ;; Test if several fields are empty, else do a calculation
497 (org-test-table-target-expect
498 "
499 | 1 | 2 | replace |
500 | 4 | | replace |
501 | | 8 | replace |
502 | | | replace |
503 "
504 "
505 | 1 | 2 | 3 |
506 | 4 | | |
507 | | 8 | |
508 | | | |
509 "
510 1
511 ;; Calc formula
512 (concat "#+TBLFM: $3 = if(\"$1\" == \"nan\" || \"$2\" == \"nan\", "
513 "string(\"\"), $1 + $2); E")
514 ;; Lisp formula
515 (concat "#+TBLFM: $3 = '(if (or (eq \"$1\" \"\") (eq \"$2\" \"\")) "
516 "\"\" (+ $1 $2)); L"))
517
518 ;; $2: Use $1 + 0.5 if $1 available, else only reformat $2 if $2 available
519 (org-test-table-target-expect
520 "
521 | 1.5 | 0 |
522 | 3.5 | |
523 | | 5 |
524 | | |
525 "
526 "
527 | 1.5 | 2.0 |
528 | 3.5 | 4.0 |
529 | | 5.0 |
530 | | |
531 "
532 1
533 ;; Calc formula
534 (concat "#+TBLFM: $2 = if(\"$1\" == \"nan\", "
535 "if(\"$2\" == \"nan\", string(\"\"), $2 +.0), $1 + 0.5); E f-1")
536 ;; Lisp formula not implemented yet
537 )
538
539 ;; Empty fields in simple and complex range reference
540 (org-test-table-target-expect
541 "
542 | | | | | repl | repl | repl | repl | repl | repl |
543 | | | 5 | 7 | repl | repl | repl | repl | repl | repl |
544 | 1 | 3 | 5 | 7 | repl | repl | repl | repl | repl | repl |
545 "
546 "
547 | | | | | | | | | 0 | 0 |
548 | | | 5 | 7 | | | 6 | 6 | 3 | 3 |
549 | 1 | 3 | 5 | 7 | 4 | 4 | 4 | 4 | 4 | 4 |
550 "
551 1
552 ;; Calc formula
553 (concat
554 "#+TBLFM: "
555 "$5 = if(typeof(vmean($1..$4)) == 12, "
556 "string(\"\"), vmean($1..$4)); E :: "
557 "$6 = if(typeof(vmean(@0$1..@0$4)) == 12, "
558 "string(\"\"), vmean(@0$1..@0$4)); E :: "
559 "$7 = if(\"$1..$4\" == \"[]\", string(\"\"), vmean($1..$4)) :: "
560 "$8 = if(\"@0$1..@0$4\" == \"[]\", string(\"\"), vmean(@0$1..@0$4)) :: "
561 "$9 = vmean($1..$4); EN :: "
562 "$10 = vmean(@0$1..@0$4); EN")
563 ;; Lisp formula
564 (concat
565 "#+TBLFM: "
566 "$5 = '(let ((l '($1..$4))) (if (member \"\" l) \"\" "
567 "(/ (apply '+ (mapcar 'string-to-number l)) (length l)))); E :: "
568 "$6 = '(let ((l '(@0$1..@0$4))) (if (member \"\" l) \"\" "
569 "(/ (apply '+ (mapcar 'string-to-number l)) (length l)))); E :: "
570 "$7 = '(let ((l '($1..$4))) "
571 "(if l (/ (apply '+ l) (length l)) \"\")); N :: "
572 "$8 = '(let ((l '(@0$1..@0$4))) "
573 "(if l (/ (apply '+ l) (length l)) \"\")); N :: "
574 "$9 = '(/ (+ $1..$4) (length '($1..$4))); EN :: "
575 "$10 = '(/ (+ @0$1..@0$4) (length '(@0$1..@0$4))); EN")
576 ))
577
578 (ert-deftest test-org-table/copy-field ()
579 "Experiments on how to copy one field into another field.
580 See also `test-org-table/remote-reference-access'."
581 (let ((target "
582 | 0 | replace |
583 | a b | replace |
584 | c d | replace |
585 | | replace |
586 | 2012-12 | replace |
587 | [2012-12-31 Mon] | replace |
588 "))
589 ;; Lisp formula to copy literally
590 (org-test-table-target-expect
591 target
592 "
593 | 0 | 0 |
594 | a b | a b |
595 | c d | c d |
596 | | |
597 | 2012-12 | 2012-12 |
598 | [2012-12-31 Mon] | [2012-12-31 Mon] |
599 "
600 1 "#+TBLFM: $2 = '(identity $1)")
601
602 ;; Calc formula to copy quite literally
603 (org-test-table-target-expect
604 target
605 "
606 | 0 | 0 |
607 | a b | a b |
608 | c d | c d |
609 | | |
610 | 2012-12 | 2012-12 |
611 | [2012-12-31 Mon] | [2012-12-31 Mon] |
612 "
613 1 (concat "#+TBLFM: $2 = if(\"$1\" == \"nan\", "
614 "string(\"\"), string(subvec(\"$1\", 2, vlen(\"$1\")))); E"))
615
616 ;; Calc formula simple
617 (org-test-table-target-expect
618 target
619 "
620 | 0 | 0 |
621 | a b | a b |
622 | c d | c d |
623 | | |
624 | 2012-12 | 2000 |
625 | [2012-12-31 Mon] | [2012-12-31 Mon] |
626 "
627 1 "#+TBLFM: $2 = if(\"$1\" == \"nan\", string(\"\"), $1); E")))
628
629 (ert-deftest test-org-table/sub-total ()
630 "Grouped rows with sub-total.
631 Begin range with \"@II\" to handle multiline header. Convert
632 integer to float with \"+.0\" for sub-total of items c1 and c2.
633 Sum empty fields as value zero but without ignoring them for
634 \"vlen\" with format specifier \"EN\". Format possibly empty
635 results with the Calc formatter \"f-1\" instead of the printf
636 formatter \"%.1f\"."
637 (org-test-table-target-expect
638 "
639 |-------+---------+---------|
640 | Item | Item | Sub- |
641 | name | value | total |
642 |-------+---------+---------|
643 | a1 | 4.1 | replace |
644 | a2 | 8.2 | replace |
645 | a3 | | replace |
646 |-------+---------+---------|
647 | b1 | 16.0 | replace |
648 |-------+---------+---------|
649 | c1 | 32 | replace |
650 | c2 | 64 | replace |
651 |-------+---------+---------|
652 | Total | replace | replace |
653 |-------+---------+---------|
654 "
655 "
656 |-------+-------+-------|
657 | Item | Item | Sub- |
658 | name | value | total |
659 |-------+-------+-------|
660 | a1 | 4.1 | |
661 | a2 | 8.2 | |
662 | a3 | | 12.3 |
663 |-------+-------+-------|
664 | b1 | 16.0 | 16.0 |
665 |-------+-------+-------|
666 | c1 | 32 | |
667 | c2 | 64 | 96.0 |
668 |-------+-------+-------|
669 | Total | 124.3 | |
670 |-------+-------+-------|
671 "
672 1 (concat "#+TBLFM: @>$2 = vsum(@II..@>>) ::"
673 "$3 = if(vlen(@0..@+I) == 1, "
674 "vsum(@-I$2..@+I$2) +.0, string(\"\")); EN f-1 :: "
675 "@>$3 = string(\"\")")))
676
677 (ert-deftest test-org-table/org-lookup-all ()
678 "Use `org-lookup-all' for several GROUP BY as in SQL and for ranking.
679 See also URL `https://orgmode.org/worg/org-tutorials/org-lookups.html'."
680 (let ((data "
681 #+NAME: data
682 | Purchase | Product | Shop | Rating |
683 |----------+---------+------+--------|
684 | a | p1 | s1 | 1 |
685 | b | p1 | s2 | 4 |
686 | c | p2 | s1 | 2 |
687 | d | p3 | s2 | 8 |
688 "))
689
690 ;; Product rating and ranking by average purchase from "#+NAME: data"
691 (org-test-table-target-expect
692 (concat data "
693 | Product | Rating | Ranking |
694 |---------+---------+---------|
695 | p1 | replace | replace |
696 | p2 | replace | replace |
697 | p3 | replace | replace |
698 ")
699 (concat data "
700 | Product | Rating | Ranking |
701 |---------+--------+---------|
702 | p1 | 2.5 | 2 |
703 | p2 | 2.0 | 3 |
704 | p3 | 8.0 | 1 |
705 ")
706 2 (concat
707 "#+TBLFM: $2 = '(let ((all (org-lookup-all '$1 "
708 "'(remote(data, @I$2..@>$2)) '(remote(data, @I$4..@>$4))))) "
709 "(/ (apply '+ all) (length all) 1.0)); L :: "
710 "$3 = '(+ 1 (length (org-lookup-all $2 '(@I$2..@>$2) nil '<))); N"))
711
712 ;; Shop rating and ranking by average purchase from "#+NAME: data"
713 (org-test-table-target-expect
714 (concat data "
715 | Shop | Rating | Ranking |
716 |------+---------+---------|
717 | s1 | replace | replace |
718 | s2 | replace | replace |
719 ")
720 (concat data "
721 | Shop | Rating | Ranking |
722 |------+--------+---------|
723 | s1 | 1.5 | 2 |
724 | s2 | 6.0 | 1 |
725 ")
726 2 (concat
727 "#+TBLFM: $2 = '(let ((all (org-lookup-all '$1 "
728 "'(remote(data, @I$3..@>$3)) '(remote(data, @I$4..@>$4))))) "
729 "(/ (apply '+ all) (length all) 1.0)); L :: "
730 "$3 = '(+ 1 (length (org-lookup-all $2 '(@I$2..@>$2) nil '<))); N"))))
731
732 (ert-deftest test-org-table/org-table-make-reference/mode-string-EL ()
733 ;; For Lisp formula only
734 (should (equal "0" (org-table-make-reference "0" t nil 'literal)))
735 (should (equal "z" (org-table-make-reference "z" t nil 'literal)))
736 (should (equal "" (org-table-make-reference "" t nil 'literal)))
737 (should (equal "0 1" (org-table-make-reference '("0" "1") t nil 'literal)))
738 (should (equal "z 1" (org-table-make-reference '("z" "1") t nil 'literal)))
739 (should (equal " 1" (org-table-make-reference '("" "1") t nil 'literal)))
740 (should (equal " " (org-table-make-reference '("" "") t nil 'literal))))
741
742 (ert-deftest test-org-table/org-table-make-reference/mode-string-E ()
743 ;; For Lisp formula
744 (should (equal "\"0\"" (org-table-make-reference "0" t nil t)))
745 (should (equal "\"z\"" (org-table-make-reference "z" t nil t)))
746 (should (equal"\"\"" (org-table-make-reference "" t nil t)))
747 (should (equal "\"0\" \"1\"" (org-table-make-reference '("0""1") t nil t)))
748 (should (equal "\"z\" \"1\"" (org-table-make-reference '("z""1") t nil t)))
749 (should (equal"\"\" \"1\"" (org-table-make-reference '("""1") t nil t)))
750 (should (equal"\"\" \"\""(org-table-make-reference '("""" ) t nil t)))
751 ;; For Calc formula
752 (should (equal "(0)" (org-table-make-reference "0" t nil nil)))
753 (should (equal "(z)" (org-table-make-reference "z" t nil nil)))
754 (should (equal "nan" (org-table-make-reference "" t nil nil)))
755 (should (equal "[0,1]" (org-table-make-reference '("0" "1") t nil nil)))
756 (should (equal "[z,1]" (org-table-make-reference '("z" "1") t nil nil)))
757 (should (equal "[nan,1]" (org-table-make-reference '("" "1") t nil nil)))
758 (should (equal "[nan,nan]" (org-table-make-reference '("" "") t nil nil)))
759 ;; For Calc formula, special numbers
760 (should (equal "(nan)" (org-table-make-reference "nan" t nil nil)))
761 (should (equal "(uinf)" (org-table-make-reference "uinf" t nil nil)))
762 (should (equal "(-inf)" (org-table-make-reference "-inf" t nil nil)))
763 (should (equal "(inf)" (org-table-make-reference "inf" t nil nil)))
764 (should (equal "[nan,1]" (org-table-make-reference '("nan" "1") t nil nil)))
765 (should (equal "[uinf,1]" (org-table-make-reference '("uinf" "1") t nil nil)))
766 (should (equal "[-inf,1]" (org-table-make-reference '("-inf" "1") t nil nil)))
767 (should (equal "[inf,1]" (org-table-make-reference '("inf" "1") t nil nil))))
768
769 (ert-deftest test-org-table/org-table-make-reference/mode-string-EN ()
770 ;; For Lisp formula
771 (should (equal "0" (org-table-make-reference "0" t t t)))
772 (should (equal "0" (org-table-make-reference "z" t t t)))
773 (should (equal "0" (org-table-make-reference "" t t t)))
774 (should (equal "0 1" (org-table-make-reference '("0" "1") t t t)))
775 (should (equal "0 1" (org-table-make-reference '("z" "1") t t t)))
776 (should (equal "0 1" (org-table-make-reference '("" "1") t t t)))
777 (should (equal "0 0" (org-table-make-reference '("" "" ) t t t)))
778 ;; For Calc formula
779 (should (equal "(0)" (org-table-make-reference "0" t t nil)))
780 (should (equal "(0)" (org-table-make-reference "z" t t nil)))
781 (should (equal "(0)" (org-table-make-reference "" t t nil)))
782 (should (equal "[0,1]" (org-table-make-reference '("0" "1") t t nil)))
783 (should (equal "[0,1]" (org-table-make-reference '("z" "1") t t nil)))
784 (should (equal "[0,1]" (org-table-make-reference '("" "1") t t nil)))
785 (should (equal "[0,0]" (org-table-make-reference '("" "" ) t t nil)))
786 ;; For Calc formula, special numbers
787 (should (equal "(0)" (org-table-make-reference "nan" t t nil)))
788 (should (equal "(0)" (org-table-make-reference "uinf" t t nil)))
789 (should (equal "(0)" (org-table-make-reference "-inf" t t nil)))
790 (should (equal "(0)" (org-table-make-reference "inf" t t nil)))
791 (should (equal "[0,1]" (org-table-make-reference '( "nan" "1") t t nil)))
792 (should (equal "[0,1]" (org-table-make-reference '("uinf" "1") t t nil)))
793 (should (equal "[0,1]" (org-table-make-reference '("-inf" "1") t t nil)))
794 (should (equal "[0,1]" (org-table-make-reference '( "inf" "1") t t nil))))
795
796 (ert-deftest test-org-table/org-table-make-reference/mode-string-L ()
797 ;; For Lisp formula only
798 (should (equal "0" (org-table-make-reference "0" nil nil 'literal)))
799 (should (equal "z" (org-table-make-reference "z" nil nil 'literal)))
800 (should (equal "" (org-table-make-reference "" nil nil 'literal)))
801 (should (equal "0 1" (org-table-make-reference '("0" "1") nil nil 'literal)))
802 (should (equal "z 1" (org-table-make-reference '("z" "1") nil nil 'literal)))
803 (should (equal "1" (org-table-make-reference '("" "1") nil nil 'literal)))
804 (should (equal "" (org-table-make-reference '("" "" ) nil nil 'literal))))
805
806 (ert-deftest test-org-table/org-table-make-reference/mode-string-none ()
807 ;; For Lisp formula
808 (should (equal "\"0\"" (org-table-make-reference "0" nil nil t)))
809 (should (equal "\"z\"" (org-table-make-reference "z" nil nil t)))
810 (should (equal "" (org-table-make-reference "" nil nil t)))
811 (should (equal "\"0\" \"1\"" (org-table-make-reference '("0" "1") nil nil t)))
812 (should (equal "\"z\" \"1\"" (org-table-make-reference '("z" "1") nil nil t)))
813 (should (equal "\"1\"" (org-table-make-reference '("" "1") nil nil t)))
814 (should (equal "" (org-table-make-reference '("" "" ) nil nil t)))
815 ;; For Calc formula
816 (should (equal "(0)" (org-table-make-reference "0" nil nil nil)))
817 (should (equal "(z)" (org-table-make-reference "z" nil nil nil)))
818 (should (equal "(0)" (org-table-make-reference "" nil nil nil)))
819 (should (equal "[0,1]" (org-table-make-reference '("0" "1") nil nil nil)))
820 (should (equal "[z,1]" (org-table-make-reference '("z" "1") nil nil nil)))
821 (should (equal "[1]" (org-table-make-reference '("" "1") nil nil nil)))
822 (should (equal "[]" (org-table-make-reference '("" "" ) nil nil nil)))
823 ;; For Calc formula, special numbers
824 (should (equal "(nan)" (org-table-make-reference "nan" nil nil nil)))
825 (should (equal "(uinf)" (org-table-make-reference "uinf" nil nil nil)))
826 (should (equal "(-inf)" (org-table-make-reference "-inf" nil nil nil)))
827 (should (equal "(inf)" (org-table-make-reference "inf" nil nil nil)))
828 (should (equal "[nan,1]" (org-table-make-reference '( "nan" "1") nil nil nil)))
829 (should (equal "[uinf,1]" (org-table-make-reference '("uinf" "1") nil nil nil)))
830 (should (equal "[-inf,1]" (org-table-make-reference '("-inf" "1") nil nil nil)))
831 (should (equal "[inf,1]" (org-table-make-reference '( "inf" "1") nil nil nil))))
832
833 (ert-deftest test-org-table/org-table-make-reference/mode-string-N ()
834 ;; For Lisp formula
835 (should (equal "0" (org-table-make-reference "0" nil t t)))
836 (should (equal "0" (org-table-make-reference "z" nil t t)))
837 (should (equal "" (org-table-make-reference "" nil t t)))
838 (should (equal "0 1" (org-table-make-reference '("0" "1") nil t t)))
839 (should (equal "0 1" (org-table-make-reference '("z" "1") nil t t)))
840 (should (equal "1" (org-table-make-reference '("" "1") nil t t)))
841 (should (equal "" (org-table-make-reference '("" "" ) nil t t)))
842 ;; For Calc formula
843 (should (equal "(0)" (org-table-make-reference "0" nil t nil)))
844 (should (equal "(0)" (org-table-make-reference "z" nil t nil)))
845 (should (equal "(0)" (org-table-make-reference "" nil t nil)))
846 (should (equal "[0,1]" (org-table-make-reference '("0" "1") nil t nil)))
847 (should (equal "[0,1]" (org-table-make-reference '("z" "1") nil t nil)))
848 (should (equal "[1]" (org-table-make-reference '("" "1") nil t nil)))
849 (should (equal "[]" (org-table-make-reference '("" "" ) nil t nil)))
850 ;; For Calc formula, special numbers
851 (should (equal "(0)" (org-table-make-reference "nan" nil t nil)))
852 (should (equal "(0)" (org-table-make-reference "uinf" nil t nil)))
853 (should (equal "(0)" (org-table-make-reference "-inf" nil t nil)))
854 (should (equal "(0)" (org-table-make-reference "inf" nil t nil)))
855 (should (equal "[0,1]" (org-table-make-reference '( "nan" "1") nil t nil)))
856 (should (equal "[0,1]" (org-table-make-reference '("uinf" "1") nil t nil)))
857 (should (equal "[0,1]" (org-table-make-reference '("-inf" "1") nil t nil)))
858 (should (equal "[0,1]" (org-table-make-reference '( "inf" "1") nil t nil))))
859
860 (ert-deftest test-org-table/org-table-convert-refs-to-an/1 ()
861 "Simple reference @2$1."
862 (should
863 (string= "A2" (org-table-convert-refs-to-an "@2$1"))))
864
865 ;; TODO: Test broken
866 ;; (ert-deftest test-org-table/org-table-convert-refs-to-an/2 ()
867 ;; "Self reference @1$1."
868 ;; (should
869 ;; (string= "A1 = $0" (org-table-convert-refs-to-an "@1$1 = $0"))))
870
871 (ert-deftest test-org-table/org-table-convert-refs-to-an/3 ()
872 "Remote reference."
873 (should
874 (string= "C& = remote(FOO, @@#B&)" (org-table-convert-refs-to-an "$3 = remote(FOO, @@#$2)"))))
875
876 (ert-deftest test-org-table/org-table-convert-refs-to-rc/1 ()
877 "Simple reference @2$1."
878 (should
879 (string= "@2$1" (org-table-convert-refs-to-rc "A2"))))
880
881 (ert-deftest test-org-table/org-table-convert-refs-to-rc/2 ()
882 "Self reference $0."
883 (should
884 (string= "@1$1 = $0" (org-table-convert-refs-to-rc "A1 = $0"))))
885
886 ;; TODO: Test Broken
887 ;; (ert-deftest test-org-table/org-table-convert-refs-to-rc/3 ()
888 ;; "Remote reference."
889 ;; (should
890 ;; (string= "$3 = remote(FOO, @@#$2)" (org-table-convert-refs-to-rc "C& = remote(FOO, @@#B&)"))))
891
892 (ert-deftest test-org-table/remote-reference-access ()
893 "Access to remote reference.
894 See also `test-org-table/copy-field'."
895 (org-test-table-target-expect
896 "
897 #+NAME: table
898 | | x 42 | |
899
900 | replace | replace |
901 "
902 "
903 #+NAME: table
904 | | x 42 | |
905
906 | x 42 | 84 x |
907 "
908 1 (concat "#+TBLFM: "
909 ;; Copy text without calculation: Use Lisp formula
910 "$1 = '(identity remote(table, @1$2)) :: "
911 ;; Do a calculation: Use Calc (or Lisp ) formula
912 "$2 = 2 * remote(table, @1$2)")))
913
914 (ert-deftest test-org-table/remote-reference-indirect ()
915 "Access to remote reference with indirection of name or ID."
916 (let ((source-tables "
917 #+NAME: 2012
918 | amount |
919 |--------|
920 | 1 |
921 | 2 |
922 |--------|
923 | 3 |
924 #+TBLFM: @>$1 = vsum(@I..@II)
925
926 #+NAME: 2013
927 | amount |
928 |--------|
929 | 4 |
930 | 8 |
931 |--------|
932 | 12 |
933 #+TBLFM: @>$1 = vsum(@I..@II)
934 "))
935
936 ;; Read several remote references from same column
937 (org-test-table-target-expect
938 (concat source-tables "
939 #+NAME: summary
940 | year | amount |
941 |-------+---------|
942 | 2012 | replace |
943 | 2013 | replace |
944 |-------+---------|
945 | total | replace |
946 ")
947 (concat source-tables "
948 #+NAME: summary
949 | year | amount |
950 |-------+--------|
951 | 2012 | 3 |
952 | 2013 | 12 |
953 |-------+--------|
954 | total | 15 |
955 ")
956 1
957 ;; Calc formula
958 "#+TBLFM: @<<$2..@>>$2 = remote($<, @>$1) :: @>$2 = vsum(@I..@II)"
959 ;; Lisp formula
960 (concat "#+TBLFM: @<<$2..@>>$2 = '(identity remote($<, @>$1)); N :: "
961 "@>$2 = '(+ @I..@II); N"))
962
963 ;; Read several remote references from same row
964 (org-test-table-target-expect
965 (concat source-tables "
966 #+NAME: summary
967 | year | 2012 | 2013 | total |
968 |--------+---------+---------+---------|
969 | amount | replace | replace | replace |
970 ")
971 (concat source-tables "
972 #+NAME: summary
973 | year | 2012 | 2013 | total |
974 |--------+------+------+-------|
975 | amount | 3 | 12 | 15 |
976 ")
977 1
978 ;; Calc formula
979 "#+TBLFM: @2$<<..@2$>> = remote(@<, @>$1) :: @2$> = vsum($<<..$>>)"
980 ;; Lisp formula
981 (concat "#+TBLFM: @2$<<..@2$>> = '(identity remote(@<, @>$1)); N :: "
982 "@2$> = '(+ $<<..$>>); N"))))
983
984 (ert-deftest test-org-table/org-at-TBLFM-p ()
985 (org-test-with-temp-text-in-file
986 "
987 | 1 |
988 | 2 |
989 #+TBLFM: $2=$1*2
990
991 "
992 (goto-char (point-min))
993 (forward-line 2)
994 (should (equal (org-at-TBLFM-p) nil))
995
996 (goto-char (point-min))
997 (forward-line 3)
998 (should (equal (org-at-TBLFM-p) t))
999
1000 (goto-char (point-min))
1001 (forward-line 4)
1002 (should (equal (org-at-TBLFM-p) nil))))
1003
1004 (ert-deftest test-org-table/org-table-TBLFM-begin ()
1005 (org-test-with-temp-text-in-file
1006 "
1007 | 1 |
1008 | 2 |
1009 #+TBLFM: $2=$1*2
1010
1011 "
1012 (goto-char (point-min))
1013 (should (equal (org-table-TBLFM-begin)
1014 nil))
1015
1016 (goto-char (point-min))
1017 (forward-line 1)
1018 (should (equal (org-table-TBLFM-begin)
1019 nil))
1020
1021 (goto-char (point-min))
1022 (forward-line 3)
1023 (should (= (org-table-TBLFM-begin)
1024 14))
1025
1026 (goto-char (point-min))
1027 (forward-line 4)
1028 (should (= (org-table-TBLFM-begin)
1029 14))
1030
1031 ))
1032
1033 (ert-deftest test-org-table/org-table-TBLFM-begin-for-multiple-TBLFM-lines ()
1034 "For multiple #+TBLFM lines."
1035 (org-test-with-temp-text-in-file
1036 "
1037 | 1 |
1038 | 2 |
1039 #+TBLFM: $2=$1*1
1040 #+TBLFM: $2=$1*2
1041
1042 "
1043 (goto-char (point-min))
1044 (should (equal (org-table-TBLFM-begin)
1045 nil))
1046
1047 (goto-char (point-min))
1048 (forward-line 1)
1049 (should (equal (org-table-TBLFM-begin)
1050 nil))
1051
1052 (goto-char (point-min))
1053 (forward-line 3)
1054 (should (= (org-table-TBLFM-begin)
1055 14))
1056
1057 (goto-char (point-min))
1058 (forward-line 4)
1059 (should (= (org-table-TBLFM-begin)
1060 14))
1061
1062 (goto-char (point-min))
1063 (forward-line 5)
1064 (should (= (org-table-TBLFM-begin)
1065 14))
1066
1067 ))
1068
1069 (ert-deftest test-org-table/org-table-TBLFM-begin-for-pultiple-TBLFM-lines-blocks ()
1070 (org-test-with-temp-text-in-file
1071 "
1072 | 1 |
1073 | 2 |
1074 #+TBLFM: $2=$1*1
1075 #+TBLFM: $2=$1*2
1076
1077 | 6 |
1078 | 7 |
1079 #+TBLFM: $2=$1*1
1080 #+TBLFM: $2=$1*2
1081
1082 "
1083 (goto-char (point-min))
1084 (should (equal (org-table-TBLFM-begin)
1085 nil))
1086
1087 (goto-char (point-min))
1088 (forward-line 1)
1089 (should (equal (org-table-TBLFM-begin)
1090 nil))
1091
1092 (goto-char (point-min))
1093 (forward-line 3)
1094 (should (= (org-table-TBLFM-begin)
1095 14))
1096
1097 (goto-char (point-min))
1098 (forward-line 4)
1099 (should (= (org-table-TBLFM-begin)
1100 14))
1101
1102 (goto-char (point-min))
1103 (forward-line 5)
1104 (should (= (org-table-TBLFM-begin)
1105 14))
1106
1107 (goto-char (point-min))
1108 (forward-line 6)
1109 (should (= (org-table-TBLFM-begin)
1110 14))
1111
1112 (goto-char (point-min))
1113 (forward-line 8)
1114 (should (= (org-table-TBLFM-begin)
1115 61))
1116
1117 (goto-char (point-min))
1118 (forward-line 9)
1119 (should (= (org-table-TBLFM-begin)
1120 61))
1121
1122 (goto-char (point-min))
1123 (forward-line 10)
1124 (should (= (org-table-TBLFM-begin)
1125 61))))
1126
1127 (ert-deftest test-org-table/org-table-calc-current-TBLFM ()
1128 (org-test-with-temp-text-in-file
1129 "
1130 | 1 | |
1131 | 2 | |
1132 #+TBLFM: $2=$1*1
1133 #+TBLFM: $2=$1*2
1134 #+TBLFM: $2=$1*3
1135 "
1136 (let ((got (progn (goto-char (point-min))
1137 (forward-line 3)
1138 (org-table-calc-current-TBLFM)
1139 (buffer-string)))
1140 (expect "
1141 | 1 | 1 |
1142 | 2 | 2 |
1143 #+TBLFM: $2=$1*1
1144 #+TBLFM: $2=$1*2
1145 #+TBLFM: $2=$1*3
1146 "))
1147 (should (string= got
1148 expect)))
1149
1150 (let ((got (progn (goto-char (point-min))
1151 (forward-line 4)
1152 (org-table-calc-current-TBLFM)
1153 (buffer-string)))
1154 (expect "
1155 | 1 | 2 |
1156 | 2 | 4 |
1157 #+TBLFM: $2=$1*1
1158 #+TBLFM: $2=$1*2
1159 #+TBLFM: $2=$1*3
1160 "))
1161 (should (string= got
1162 expect)))))
1163
1164 (ert-deftest test-org-table/org-table-calc-current-TBLFM-when-stop-because-of-error ()
1165 "org-table-calc-current-TBLFM should preserve the input as it was."
1166 (org-test-with-temp-text-in-file
1167 "
1168 | 1 | 1 |
1169 | 2 | 2 |
1170 #+TBLFM: $2=$1*1
1171 #+TBLFM: $2=$1*2::$2=$1*2
1172 #+TBLFM: $2=$1*3
1173 "
1174 (let ((expect "
1175 | 1 | 1 |
1176 | 2 | 2 |
1177 #+TBLFM: $2=$1*1
1178 #+TBLFM: $2=$1*2::$2=$1*2
1179 #+TBLFM: $2=$1*3
1180 "))
1181 (goto-char (point-min))
1182 (forward-line 4)
1183 (should-error (org-table-calc-current-TBLFM))
1184 (setq got (buffer-string))
1185 (message "%s" got)
1186 (should (string= got
1187 expect)))))
1188
1189 ;;; Radio Tables
1190
1191 (ert-deftest test-org-table/to-generic ()
1192 "Test `orgtbl-to-generic' specifications."
1193 ;; Test :hline parameter.
1194 (should
1195 (equal "a\nb"
1196 (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
1197 '(:hline nil))))
1198 (should
1199 (equal "a\n~\nb"
1200 (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
1201 '(:hline "~"))))
1202 ;; Test :sep parameter.
1203 (should
1204 (equal "a!b\nc!d"
1205 (orgtbl-to-generic
1206 (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
1207 '(:sep "!"))))
1208 ;; Test :hsep parameter.
1209 (should
1210 (equal "a!b\nc?d"
1211 (orgtbl-to-generic
1212 (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
1213 '(:sep "?" :hsep "!"))))
1214 ;; Test :tstart parameter.
1215 (should
1216 (equal "<begin>\na"
1217 (orgtbl-to-generic (org-table-to-lisp "| a |") '(:tstart "<begin>"))))
1218 (should
1219 (equal "<begin>\na"
1220 (orgtbl-to-generic (org-table-to-lisp "| a |")
1221 '(:tstart (lambda () "<begin>")))))
1222 (should
1223 (equal "a"
1224 (orgtbl-to-generic (org-table-to-lisp "| a |")
1225 '(:tstart "<begin>" :splice t))))
1226 ;; Test :tend parameter.
1227 (should
1228 (equal "a\n<end>"
1229 (orgtbl-to-generic (org-table-to-lisp "| a |") '(:tend "<end>"))))
1230 (should
1231 (equal "a\n<end>"
1232 (orgtbl-to-generic (org-table-to-lisp "| a |")
1233 '(:tend (lambda () "<end>")))))
1234 (should
1235 (equal "a"
1236 (orgtbl-to-generic (org-table-to-lisp "| a |")
1237 '(:tend "<end>" :splice t))))
1238 ;; Test :lstart parameter.
1239 (should
1240 (equal "> a"
1241 (orgtbl-to-generic
1242 (org-table-to-lisp "| a |") '(:lstart "> "))))
1243 (should
1244 (equal "> a"
1245 (orgtbl-to-generic (org-table-to-lisp "| a |")
1246 '(:lstart (lambda () "> ")))))
1247 ;; Test :llstart parameter.
1248 (should
1249 (equal "> a\n>> b"
1250 (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
1251 '(:lstart "> " :llstart ">> "))))
1252 ;; Test :hlstart parameter.
1253 (should
1254 (equal "!> a\n> b"
1255 (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
1256 '(:lstart "> " :hlstart "!> "))))
1257 ;; Test :hllstart parameter.
1258 (should
1259 (equal "!> a\n!!> b\n> c"
1260 (orgtbl-to-generic (org-table-to-lisp "| a |\n| b |\n|---|\n| c |")
1261 '(:lstart "> " :hlstart "!> " :hllstart "!!> "))))
1262 ;; Test :lend parameter.
1263 (should
1264 (equal "a <"
1265 (orgtbl-to-generic (org-table-to-lisp "| a |") '(:lend " <"))))
1266 ;; Test :llend parameter.
1267 (should
1268 (equal "a <\nb <<"
1269 (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
1270 '(:lend " <" :llend " <<"))))
1271 ;; Test :hlend parameter.
1272 (should
1273 (equal "a <!\nb <"
1274 (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
1275 '(:lend " <" :hlend " <!"))))
1276 ;; Test :hllend parameter.
1277 (should
1278 (equal "a <!\nb <!!\nc <"
1279 (orgtbl-to-generic (org-table-to-lisp "| a |\n| b |\n|---|\n| c |")
1280 '(:lend " <" :hlend " <!" :hllend " <!!"))))
1281 ;; Test :lfmt parameter.
1282 (should
1283 (equal "a!b"
1284 (orgtbl-to-generic (org-table-to-lisp "| a | b |")
1285 '(:lfmt "%s!%s"))))
1286 (should
1287 (equal "a+b"
1288 (orgtbl-to-generic
1289 (org-table-to-lisp "| a | b |")
1290 '(:lfmt (lambda (c) (concat (car c) "+" (cadr c)))))))
1291 (should
1292 (equal "a!b"
1293 (orgtbl-to-generic (org-table-to-lisp "| a | b |")
1294 '(:lfmt "%s!%s" :lstart ">" :lend "<" :sep " "))))
1295 ;; Test :llfmt parameter.
1296 (should
1297 (equal "a!b"
1298 (orgtbl-to-generic (org-table-to-lisp "| a | b |")
1299 '(:llfmt "%s!%s"))))
1300 (should
1301 (equal "a!b\nc+d"
1302 (orgtbl-to-generic
1303 (org-table-to-lisp "| a | b |\n| c | d |")
1304 '(:lfmt "%s!%s" :llfmt (lambda (c) (concat (car c) "+" (cadr c)))))))
1305 (should
1306 (equal "a!b"
1307 (orgtbl-to-generic (org-table-to-lisp "| a | b |")
1308 '(:llfmt "%s!%s" :lstart ">" :lend "<" :sep " "))))
1309 ;; Test :hlfmt parameter.
1310 (should
1311 (equal "a!b\ncd"
1312 (orgtbl-to-generic
1313 (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
1314 '(:hlfmt "%s!%s"))))
1315 (should
1316 (equal "a+b\ncd"
1317 (orgtbl-to-generic
1318 (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
1319 '(:hlfmt (lambda (c) (concat (car c) "+" (cadr c)))))))
1320 (should
1321 (equal "a!b\n>c d<"
1322 (orgtbl-to-generic
1323 (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
1324 '(:hlfmt "%s!%s" :lstart ">" :lend "<" :sep " "))))
1325 ;; Test :hllfmt parameter.
1326 (should
1327 (equal "a!b\ncd"
1328 (orgtbl-to-generic
1329 (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
1330 '(:hllfmt "%s!%s"))))
1331 (should
1332 (equal "a+b\ncd"
1333 (orgtbl-to-generic
1334 (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
1335 '(:hllfmt (lambda (c) (concat (car c) "+" (cadr c)))))))
1336 (should
1337 (equal "a!b\n>c d<"
1338 (orgtbl-to-generic
1339 (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
1340 '(:hllfmt "%s!%s" :lstart ">" :lend "<" :sep " "))))
1341 ;; Test :fmt parameter.
1342 (should
1343 (equal ">a<\n>b<"
1344 (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
1345 '(:fmt ">%s<"))))
1346 (should
1347 (equal ">a<b"
1348 (orgtbl-to-generic (org-table-to-lisp "| a | b |")
1349 '(:fmt (1 ">%s<" 2 (lambda (c) c))))))
1350 (should
1351 (equal "a b"
1352 (orgtbl-to-generic (org-table-to-lisp "| a | b |")
1353 '(:fmt (2 " %s")))))
1354 (should
1355 (equal ">a<"
1356 (orgtbl-to-generic (org-table-to-lisp "| a |")
1357 '(:fmt (lambda (c) (format ">%s<" c))))))
1358 ;; Test :hfmt parameter.
1359 (should
1360 (equal ">a<\nb"
1361 (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
1362 '(:hfmt ">%s<"))))
1363 (should
1364 (equal ">a<b\ncd"
1365 (orgtbl-to-generic
1366 (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
1367 '(:hfmt (1 ">%s<" 2 identity)))))
1368 (should
1369 (equal "a b\ncd"
1370 (orgtbl-to-generic
1371 (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
1372 '(:hfmt (2 " %s")))))
1373 (should
1374 (equal ">a<\nb"
1375 (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
1376 '(:hfmt (lambda (c) (format ">%s<" c))))))
1377 ;; Test :efmt parameter.
1378 (should
1379 (equal "2x10^3"
1380 (orgtbl-to-generic (org-table-to-lisp "| 2e3 |")
1381 '(:efmt "%sx10^%s"))))
1382 (should
1383 (equal "2x10^3"
1384 (orgtbl-to-generic (org-table-to-lisp "| 2e3 |")
1385 '(:efmt (lambda (m e) (concat m "x10^" e))))))
1386 (should
1387 (equal "2x10^3"
1388 (orgtbl-to-generic (org-table-to-lisp "| 2e3 |")
1389 '(:efmt (1 "%sx10^%s")))))
1390 (should
1391 (equal "2x10^3"
1392 (orgtbl-to-generic
1393 (org-table-to-lisp "| 2e3 |")
1394 '(:efmt (1 (lambda (m e) (format "%sx10^%s" m e)))))))
1395 (should
1396 (equal "2e3"
1397 (orgtbl-to-generic (org-table-to-lisp "| 2e3 |") '(:efmt nil))))
1398 ;; Test :skip parameter.
1399 (should
1400 (equal "cd"
1401 (orgtbl-to-generic
1402 (org-table-to-lisp "| \ | <c> |\n| a | b |\n|---+---|\n| c | d |")
1403 '(:skip 2))))
1404 ;; Test :skipcols parameter.
1405 (should
1406 (equal "a\nc"
1407 (orgtbl-to-generic
1408 (org-table-to-lisp "| a | b |\n| c | d |") '(:skipcols (2)))))
1409 (should
1410 (equal "a\nc"
1411 (orgtbl-to-generic
1412 (org-table-to-lisp
1413 "| / | <c> | <c> |\n| # | a | b |\n|---+---+---|\n| | c | d |")
1414 '(:skipcols (2)))))
1415 ;; Test :raw parameter.
1416 (when (featurep 'ox-latex)
1417 (should
1418 (string-match-p
1419 "/a/"
1420 (orgtbl-to-generic (org-table-to-lisp "| /a/ | b |")
1421 '(:backend latex :raw t)))))
1422 ;; Hooks are ignored.
1423 (should
1424 (equal
1425 "a\nb"
1426 (let* ((fun-list (list (lambda (backend) (search-forward "a") (insert "hook"))))
1427 (org-export-before-parsing-hook fun-list)
1428 (org-export-before-processing-hook fun-list))
1429 (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
1430 '(:hline nil)))))
1431 ;; User-defined export filters are ignored.
1432 (should
1433 (equal
1434 "a\nb"
1435 (let ((org-export-filter-table-cell-functions (list (lambda (c b i) "filter"))))
1436 (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
1437 '(:hline nil)))))
1438 ;; Macros, even if unknown, are returned as-is.
1439 (should
1440 (equal "{{{macro}}}"
1441 (orgtbl-to-generic (org-table-to-lisp "| {{{macro}}} |") nil))))
1442
1443 (ert-deftest test-org-table/to-latex ()
1444 "Test `orgtbl-to-latex' specifications."
1445 (should
1446 (equal "\\begin{tabular}{l}\na\\\\\n\\end{tabular}"
1447 (orgtbl-to-latex (org-table-to-lisp "| a |") nil)))
1448 ;; Test :environment parameter.
1449 (should
1450 (equal "\\begin{tabularx}{l}\na\\\\\n\\end{tabularx}"
1451 (orgtbl-to-latex (org-table-to-lisp "| a |")
1452 '(:environment "tabularx"))))
1453 ;; Test :booktabs parameter.
1454 (should
1455 (string-match-p
1456 "\\toprule" (orgtbl-to-latex (org-table-to-lisp "| a |") '(:booktabs t))))
1457 ;; Handle LaTeX snippets.
1458 (should
1459 (equal "\\begin{tabular}{l}\n\\(x\\)\\\\\n\\end{tabular}"
1460 (orgtbl-to-latex (org-table-to-lisp "| $x$ |") nil)))
1461 ;; Test pseudo objects and :raw parameter.
1462 (should
1463 (string-match-p
1464 "\\$x\\$" (orgtbl-to-latex (org-table-to-lisp "| $x$ |") '(:raw t)))))
1465
1466 (ert-deftest test-org-table/to-html ()
1467 "Test `orgtbl-to-html' specifications."
1468 (should
1469 (equal (orgtbl-to-html (org-table-to-lisp "| a |") nil)
1470 "<table border=\"2\" cellspacing=\"0\" cellpadding=\"6\" rules=\"groups\" frame=\"hsides\">
1471
1472
1473 <colgroup>
1474 <col class=\"org-left\" />
1475 </colgroup>
1476 <tbody>
1477 <tr>
1478 <td class=\"org-left\">a</td>
1479 </tr>
1480 </tbody>
1481 </table>"))
1482 ;; Test :attributes parameter.
1483 (should
1484 (string-match-p
1485 "<table>"
1486 (orgtbl-to-html (org-table-to-lisp "| a |") '(:attributes nil))))
1487 (should
1488 (string-match-p
1489 "<table border=\"2\">"
1490 (orgtbl-to-html (org-table-to-lisp "| a |") '(:attributes (:border "2"))))))
1491
1492 (ert-deftest test-org-table/to-texinfo ()
1493 "Test `orgtbl-to-texinfo' specifications."
1494 (should
1495 (equal "@multitable {a}\n@item a\n@end multitable"
1496 (orgtbl-to-texinfo (org-table-to-lisp "| a |") nil)))
1497 ;; Test :columns parameter.
1498 (should
1499 (equal "@multitable @columnfractions .4 .6\n@item a\n@tab b\n@end multitable"
1500 (orgtbl-to-texinfo (org-table-to-lisp "| a | b |")
1501 '(:columns ".4 .6"))))
1502 (should
1503 (equal "@multitable @columnfractions .4 .6\n@item a\n@tab b\n@end multitable"
1504 (orgtbl-to-texinfo (org-table-to-lisp "| a | b |")
1505 '(:columns "@columnfractions .4 .6"))))
1506 (should
1507 (equal "@multitable {xxx} {xx}\n@item a\n@tab b\n@end multitable"
1508 (orgtbl-to-texinfo (org-table-to-lisp "| a | b |")
1509 '(:columns "{xxx} {xx}")))))
1510
1511 (ert-deftest test-org-table/to-orgtbl ()
1512 "Test `orgtbl-to-orgtbl' specifications."
1513 (should
1514 (equal "| a | b |\n|---+---|\n| c | d |"
1515 (orgtbl-to-orgtbl
1516 (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |") nil))))
1517
1518 (ert-deftest test-org-table/to-unicode ()
1519 "Test `orgtbl-to-unicode' specifications."
1520 (should
1521 (equal "━━━\n a \n━━━"
1522 (orgtbl-to-unicode (org-table-to-lisp "| a |") nil)))
1523 ;; Test :narrow parameter.
1524 (should
1525 (equal "━━━━\n => \n━━━━"
1526 (orgtbl-to-unicode (org-table-to-lisp "| <2> |\n| xxx |")
1527 '(:narrow t)))))
1528
1529 (ert-deftest test-org-table/send-region ()
1530 "Test `orgtbl-send-table' specifications."
1531 ;; Error when not at a table.
1532 (should-error
1533 (org-test-with-temp-text "Paragraph"
1534 (orgtbl-send-table)))
1535 ;; Error when destination is missing.
1536 (should-error
1537 (org-test-with-temp-text "#+ORGTBL: SEND\n<point>| a |"
1538 (orgtbl-send-table)))
1539 ;; Error when transformation function is not specified.
1540 (should-error
1541 (org-test-with-temp-text "
1542 # BEGIN RECEIVE ORGTBL table
1543 # END RECEIVE ORGTBL table
1544 #+ORGTBL: SEND table
1545 <point>| a |"
1546 (orgtbl-send-table)))
1547 ;; Standard test.
1548 (should
1549 (equal "| a |\n|---|\n| b |\n"
1550 (org-test-with-temp-text "
1551 # BEGIN RECEIVE ORGTBL table
1552 # END RECEIVE ORGTBL table
1553 #+ORGTBL: SEND table orgtbl-to-orgtbl :hlines nil
1554 <point>| a |\n|---|\n| b |"
1555 (orgtbl-send-table)
1556 (goto-char (point-min))
1557 (buffer-substring-no-properties
1558 (search-forward "# BEGIN RECEIVE ORGTBL table\n")
1559 (progn (search-forward "# END RECEIVE ORGTBL table")
1560 (match-beginning 0))))))
1561 ;; Allow multiple receiver locations.
1562 (should
1563 (org-test-with-temp-text "
1564 # BEGIN RECEIVE ORGTBL table
1565 # END RECEIVE ORGTBL table
1566
1567 #+ORGTBL: SEND table orgtbl-to-orgtbl :hlines nil
1568 <point>| a |
1569
1570 # BEGIN RECEIVE ORGTBL table
1571 # END RECEIVE ORGTBL table"
1572 (orgtbl-send-table)
1573 (goto-char (point-min))
1574 (search-forward "| a |" nil t 3))))
1575
1576 \f
1577 ;;; Align
1578
1579 (ert-deftest test-org-table/align ()
1580 "Test `org-table-align' specifications."
1581 ;; Regular test.
1582 (should
1583 (equal "| a |\n"
1584 (org-test-with-temp-text "| a |"
1585 (org-table-align)
1586 (buffer-string))))
1587 ;; Preserve alignment.
1588 (should
1589 (equal " | a |\n"
1590 (org-test-with-temp-text " | a |"
1591 (org-table-align)
1592 (buffer-string))))
1593 ;; Handle horizontal lines.
1594 (should
1595 (equal "| 123 |\n|-----|\n"
1596 (org-test-with-temp-text "| 123 |\n|-|"
1597 (org-table-align)
1598 (buffer-string))))
1599 (should
1600 (equal "| a | b |\n|---+---|\n"
1601 (org-test-with-temp-text "| a | b |\n|-+-|"
1602 (org-table-align)
1603 (buffer-string))))
1604 ;; Handle empty fields.
1605 (should
1606 (equal "| a | bc |\n| bcd | |\n"
1607 (org-test-with-temp-text "| a | bc |\n| bcd | |"
1608 (org-table-align)
1609 (buffer-string))))
1610 (should
1611 (equal "| abc | bc |\n| | bcd |\n"
1612 (org-test-with-temp-text "| abc | bc |\n| | bcd |"
1613 (org-table-align)
1614 (buffer-string))))
1615 ;; Handle missing fields.
1616 (should
1617 (equal "| a | b |\n| c | |\n"
1618 (org-test-with-temp-text "| a | b |\n| c |"
1619 (org-table-align)
1620 (buffer-string))))
1621 (should
1622 (equal "| a | b |\n|---+---|\n"
1623 (org-test-with-temp-text "| a | b |\n|---|"
1624 (org-table-align)
1625 (buffer-string))))
1626 ;; Alignment is done to the right when the ratio of numbers in the
1627 ;; column is superior to `org-table-number-fraction'.
1628 (should
1629 (equal "| 1 |\n| 12 |\n| abc |"
1630 (org-test-with-temp-text "| 1 |\n| 12 |\n| abc |"
1631 (let ((org-table-number-fraction 0.5)) (org-table-align))
1632 (buffer-string))))
1633 (should
1634 (equal "| 1 |\n| ab |\n| abc |"
1635 (org-test-with-temp-text "| 1 |\n| ab |\n| abc |"
1636 (let ((org-table-number-fraction 0.5)) (org-table-align))
1637 (buffer-string))))
1638 ;; Obey to alignment cookies.
1639 (should
1640 (equal "| <r> |\n| ab |\n| abc |"
1641 (org-test-with-temp-text "| <r> |\n| ab |\n| abc |"
1642 (let ((org-table-number-fraction 0.5)) (org-table-align))
1643 (buffer-string))))
1644 (should
1645 (equal "| <l> |\n| 12 |\n| 123 |"
1646 (org-test-with-temp-text "| <l> |\n| 12 |\n| 123 |"
1647 (let ((org-table-number-fraction 0.5)) (org-table-align))
1648 (buffer-string))))
1649 (should
1650 (equal "| <c> |\n| 1 |\n| 123 |"
1651 (org-test-with-temp-text "| <c> |\n| 1 |\n| 123 |"
1652 (let ((org-table-number-fraction 0.5)) (org-table-align))
1653 (buffer-string)))))
1654
1655 (ert-deftest test-org-table/align-buffer-tables ()
1656 "Align all tables when updating buffer."
1657 (let ((before "
1658 | a b |
1659
1660 | c d |
1661 ")
1662 (after "
1663 | a b |
1664
1665 | c d |
1666 "))
1667 (should (equal (org-test-with-temp-text before
1668 (org-table-recalculate-buffer-tables)
1669 (buffer-string))
1670 after))
1671 (should (equal (org-test-with-temp-text before
1672 (org-table-iterate-buffer-tables)
1673 (buffer-string))
1674 after))))
1675
1676 \f
1677 ;;; Sorting
1678
1679 (ert-deftest test-org-table/sort-lines ()
1680 "Test `org-table-sort-lines' specifications."
1681 ;; Sort numerically.
1682 (should
1683 (equal "| 1 | 2 |\n| 2 | 4 |\n| 5 | 3 |\n"
1684 (org-test-with-temp-text "| <point>1 | 2 |\n| 5 | 3 |\n| 2 | 4 |\n"
1685 (org-table-sort-lines nil ?n)
1686 (buffer-string))))
1687 (should
1688 (equal "| 5 | 3 |\n| 2 | 4 |\n| 1 | 2 |\n"
1689 (org-test-with-temp-text "| <point>1 | 2 |\n| 5 | 3 |\n| 2 | 4 |\n"
1690 (org-table-sort-lines nil ?N)
1691 (buffer-string))))
1692 ;; Sort alphabetically. Enforce the C locale for consistent results.
1693 (let ((original-string-collate-lessp (symbol-function 'string-collate-lessp)))
1694 (cl-letf (((symbol-function 'string-collate-lessp)
1695 (lambda (s1 s2 &optional locale ignore-case)
1696 (funcall original-string-collate-lessp
1697 s1 s2 "C" ignore-case))))
1698 (should
1699 (equal "| a | x |\n| B | 4 |\n| c | 3 |\n"
1700 (org-test-with-temp-text "| <point>a | x |\n| c | 3 |\n| B | 4 |\n"
1701 (org-table-sort-lines nil ?a)
1702 (buffer-string))))
1703 (should
1704 (equal "| c | 3 |\n| B | 4 |\n| a | x |\n"
1705 (org-test-with-temp-text "| <point>a | x |\n| c | 3 |\n| B | 4 |\n"
1706 (org-table-sort-lines nil ?A)
1707 (buffer-string))))
1708 ;; Sort alphabetically with case.
1709 (should
1710 (equal "| C |\n| a |\n| b |\n"
1711 (org-test-with-temp-text "| <point>a |\n| C |\n| b |\n"
1712 (org-table-sort-lines t ?a)
1713 (buffer-string))))
1714 (should
1715 (equal "| C |\n| b |\n| a |\n"
1716 (org-test-with-temp-text "| <point>a |\n| C |\n| b |\n"
1717 (org-table-sort-lines nil ?A)
1718 (buffer-string))))))
1719 ;; Sort by time (timestamps)
1720 (should
1721 (equal
1722 "| <2008-08-08 sat.> |\n| <2012-03-29 thu.> |\n| <2014-03-04 tue.> |\n"
1723 (org-test-with-temp-text
1724 "| <2014-03-04 tue.> |\n| <2008-08-08 sat.> |\n| <2012-03-29 thu.> |\n"
1725 (org-table-sort-lines nil ?t)
1726 (buffer-string))))
1727 (should
1728 (equal
1729 "| <2014-03-04 tue.> |\n| <2012-03-29 thu.> |\n| <2008-08-08 sat.> |\n"
1730 (org-test-with-temp-text
1731 "| <2014-03-04 tue.> |\n| <2008-08-08 sat.> |\n| <2012-03-29 thu.> |\n"
1732 (org-table-sort-lines nil ?T)
1733 (buffer-string))))
1734 ;; Sort by time (HH:MM values)
1735 (should
1736 (equal "| 1:00 |\n| 17:00 |\n| 114:00 |\n"
1737 (org-test-with-temp-text "| 114:00 |\n| 17:00 |\n| 1:00 |\n"
1738 (org-table-sort-lines nil ?t)
1739 (buffer-string))))
1740 (should
1741 (equal "| 114:00 |\n| 17:00 |\n| 1:00 |\n"
1742 (org-test-with-temp-text "| 114:00 |\n| 17:00 |\n| 1:00 |\n"
1743 (org-table-sort-lines nil ?T)
1744 (buffer-string))))
1745 ;; Sort by time (durations)
1746 (should
1747 (equal "| 1d 3:00 |\n| 28:00 |\n"
1748 (org-test-with-temp-text "| 28:00 |\n| 1d 3:00 |\n"
1749 (org-table-sort-lines nil ?t)
1750 (buffer-string))))
1751 ;; Sort with custom functions.
1752 (should
1753 (equal "| 22 |\n| 15 |\n| 18 |\n"
1754 (org-test-with-temp-text "| 15 |\n| 22 |\n| 18 |\n"
1755 (org-table-sort-lines nil ?f
1756 (lambda (s) (% (string-to-number s) 10))
1757 #'<)
1758 (buffer-string))))
1759 (should
1760 (equal "| 18 |\n| 15 |\n| 22 |\n"
1761 (org-test-with-temp-text "| 15 |\n| 22 |\n| 18 |\n"
1762 (org-table-sort-lines nil ?F
1763 (lambda (s) (% (string-to-number s) 10))
1764 #'<)
1765 (buffer-string))))
1766 ;; Sort according to current column.
1767 (should
1768 (equal "| 1 | 2 |\n| 7 | 3 |\n| 5 | 4 |\n"
1769 (org-test-with-temp-text "| 1 | <point>2 |\n| 5 | 4 |\n| 7 | 3 |\n"
1770 (org-table-sort-lines nil ?n)
1771 (buffer-string))))
1772 ;; Sort between horizontal separators if possible.
1773 (should
1774 (equal
1775 "| 9 | 8 |\n|---+---|\n| 5 | 3 |\n| 7 | 4 |\n|---+---|\n| 1 | 2 |\n"
1776 (org-test-with-temp-text
1777 "| 9 | 8 |\n|---+---|\n| <point>7 | 4 |\n| 5 | 3 |\n|---+---|\n| 1 | 2 |\n"
1778 (org-table-sort-lines nil ?n)
1779 (buffer-string)))))
1780
1781 \f
1782 ;;; Formulas
1783
1784 (ert-deftest test-org-table/eval-formula ()
1785 "Test `org-table-eval-formula' specifications."
1786 ;; Error when not on a table field.
1787 (should-error
1788 (org-test-with-temp-text "Text"
1789 (org-table-eval-formula)))
1790 (should-error
1791 (org-test-with-temp-text "| a |\n|---|<point>"
1792 (org-table-eval-formula)))
1793 (should-error
1794 (org-test-with-temp-text "| a |\n#+TBLFM:<point>"
1795 (org-table-eval-formula)))
1796 ;; Handle @<, @>, $< and $>.
1797 (should
1798 (equal "| 1 |\n| 1 |"
1799 (org-test-with-temp-text "| <point> |\n| 1 |"
1800 (org-table-eval-formula nil "@>" nil nil t)
1801 (buffer-string))))
1802 (should
1803 (equal "| 1 |\n| 1 |"
1804 (org-test-with-temp-text "| 1 |\n| <point> |"
1805 (org-table-eval-formula nil "@<" nil nil t)
1806 (buffer-string))))
1807 (should
1808 (equal "| 1 | 1 |"
1809 (org-test-with-temp-text "| <point> | 1 |"
1810 (org-table-eval-formula nil "$>" nil nil t)
1811 (buffer-string))))
1812 (should
1813 (equal "| 1 | 1 |"
1814 (org-test-with-temp-text "| 1 | <point> |"
1815 (org-table-eval-formula nil "$<" nil nil t)
1816 (buffer-string)))))
1817
1818 (ert-deftest test-org-table/field-formula-outside-table ()
1819 "Test `org-table-formula-create-columns' variable."
1820 ;; Refuse to create column if variable is nil.
1821 (should-error
1822 (org-test-with-temp-text "
1823 | 2 |
1824 | 4 |
1825 | 8 |
1826 <point>#+TBLFM: @1$2=5"
1827 (let ((org-table-formula-create-columns nil))
1828 (org-table-calc-current-TBLFM))
1829 (buffer-string))
1830 :type (list 'error 'user-error))
1831 ;; If the variable is non-nil, field formulas and columns formulas
1832 ;; can create tables.
1833 (should
1834 (equal
1835 "
1836 | 2 | 5 |
1837 | 4 | |
1838 | 8 | |
1839 #+TBLFM: @1$2=5"
1840 (org-test-with-temp-text "
1841 | 2 |
1842 | 4 |
1843 | 8 |
1844 <point>#+TBLFM: @1$2=5"
1845 (let ((org-table-formula-create-columns t))
1846 (org-table-calc-current-TBLFM))
1847 (buffer-string))))
1848 (should
1849 (equal
1850 "
1851 | 2 | | 15 |
1852 | 4 | | 15 |
1853 | 8 | | 15 |
1854 #+TBLFM: $3=15"
1855 (org-test-with-temp-text "
1856 | 2 |
1857 | 4 |
1858 | 8 |
1859 <point>#+TBLFM: $3=15"
1860 (let ((org-table-formula-create-columns t))
1861 (org-table-calc-current-TBLFM))
1862 (buffer-string)))))
1863
1864 (ert-deftest test-org-table/duration ()
1865 "Test durations in table formulas."
1866 ;; Durations in cells.
1867 (should
1868 (string-match "| 2:12 | 1:47 | 03:59:00 |"
1869 (org-test-with-temp-text "
1870 | 2:12 | 1:47 | |
1871 <point>#+TBLFM: @1$3=$1+$2;T"
1872 (org-table-calc-current-TBLFM)
1873 (buffer-string))))
1874 (should
1875 (string-match "| 2:12 | 1:47 | 03:59 |"
1876 (org-test-with-temp-text "
1877 | 2:12 | 1:47 | |
1878 <point>#+TBLFM: @1$3=$1+$2;U"
1879 (org-table-calc-current-TBLFM)
1880 (buffer-string))))
1881 (should
1882 (string-match "| 3:02:20 | -2:07:00 | 0.92 |"
1883 (org-test-with-temp-text "
1884 | 3:02:20 | -2:07:00 | |
1885 <point>#+TBLFM: @1$3=$1+$2;t"
1886 (org-table-calc-current-TBLFM)
1887 (buffer-string))))
1888 ;; Durations set through properties.
1889 (should
1890 (string-match "| 16:00:00 |"
1891 (org-test-with-temp-text "* H
1892 :PROPERTIES:
1893 :time_constant: 08:00:00
1894 :END:
1895
1896 | |
1897 <point>#+TBLFM: $1=2*$PROP_time_constant;T"
1898 (org-table-calc-current-TBLFM)
1899 (buffer-string))))
1900 (should
1901 (string-match "| 16.00 |"
1902 (org-test-with-temp-text "* H
1903 :PROPERTIES:
1904 :time_constant: 08:00:00
1905 :END:
1906
1907 | |
1908 <point>#+TBLFM: $1=2*$PROP_time_constant;t"
1909 (org-table-calc-current-TBLFM)
1910 (buffer-string)))))
1911
1912 (ert-deftest test-org-table/end-on-hline ()
1913 "Test with a table ending on a hline."
1914 (should
1915 (equal
1916 (org-test-with-temp-text
1917 "
1918 | 1 | 2 | 3 |
1919 | 4 | 5 | 6 |
1920 | | | |
1921 |---+---+---|
1922 <point>#+TBLFM: @3$2..@3$>=vsum(@1..@2)"
1923 (org-table-calc-current-TBLFM)
1924 (buffer-string))
1925 "
1926 | 1 | 2 | 3 |
1927 | 4 | 5 | 6 |
1928 | | 7 | 9 |
1929 |---+---+---|
1930 #+TBLFM: @3$2..@3$>=vsum(@1..@2)")))
1931
1932 (ert-deftest test-org-table/named-field ()
1933 "Test formula with a named field."
1934 (should
1935 (string-match-p
1936 "| +| +1 +|"
1937 (org-test-with-temp-text "
1938 | | |
1939 | ^ | name |
1940 <point>#+TBLFM: $name=1"
1941 (org-table-calc-current-TBLFM)
1942 (buffer-string))))
1943 (should
1944 (string-match-p
1945 "| +| +1 +|"
1946 (org-test-with-temp-text "
1947 | _ | name |
1948 | | |
1949 <point>#+TBLFM: $name=1"
1950 (org-table-calc-current-TBLFM)
1951 (buffer-string)))))
1952
1953 (ert-deftest test-org-table/named-column ()
1954 "Test formula with a named field."
1955 (should
1956 (string-match-p
1957 "| +| +1 +| +1 +|"
1958 (org-test-with-temp-text "
1959 | ! | name | |
1960 | | 1 | |
1961 <point>#+TBLFM: @2$3=$name"
1962 (org-table-calc-current-TBLFM)
1963 (buffer-string)))))
1964
1965 (ert-deftest test-org-table/formula-priority ()
1966 "Test field formula priority over column formula."
1967 ;; Field formulas bind stronger than column formulas.
1968 (should
1969 (equal
1970 "| 1 | 3 |\n| 2 | 99 |\n"
1971 (org-test-with-temp-text
1972 "| 1 | |\n| 2 | |\n<point>#+tblfm: $2=3*$1::@2$2=99"
1973 (org-table-calc-current-TBLFM)
1974 (buffer-substring-no-properties (point-min) (point)))))
1975 ;; When field formula is removed, table formulas is applied again.
1976 (should
1977 (equal
1978 "| 1 | 3 |\n| 2 | 6 |\n"
1979 (org-test-with-temp-text
1980 "| 1 | |\n| 2 | |\n#+tblfm: $2=3*$1<point>::@2$2=99"
1981 (org-table-calc-current-TBLFM)
1982 (delete-region (point) (line-end-position))
1983 (org-table-calc-current-TBLFM)
1984 (buffer-substring-no-properties (point-min) (line-beginning-position))))))
1985
1986 (ert-deftest test-org-table/tab-indent ()
1987 "Test named fields with tab indentation."
1988 (should
1989 (string-match-p
1990 "| # | 111 |"
1991 (org-test-with-temp-text
1992 "
1993 | ! | sum | | a | b | c |
1994 |---+------+------+---+----+-----|
1995 | # | 1011 | 1000 | 1 | 10 | 100 |
1996 <point>#+TBLFM: $2=$a+$b+$c
1997 "
1998 (org-table-calc-current-TBLFM)
1999 (buffer-string)))))
2000
2001 (ert-deftest test-org-table/first-rc ()
2002 "Test \"$<\" and \"@<\" constructs in formulas."
2003 (should
2004 (string-match-p
2005 "| 1 | 2 |"
2006 (org-test-with-temp-text
2007 "| | 2 |
2008 <point>#+TBLFM: $<=1"
2009 (org-table-calc-current-TBLFM)
2010 (buffer-string))))
2011 (should
2012 (string-match-p
2013 "| 2 |\n| 2 |"
2014 (org-test-with-temp-text
2015 "| 2 |\n| |
2016 <point>#+TBLFM: @2$1=@<"
2017 (org-table-calc-current-TBLFM)
2018 (buffer-string)))))
2019
2020 (ert-deftest test-org-table/last-rc ()
2021 "Test \"$>\" and \"@>\" constructs in formulas."
2022 (should
2023 (string-match-p
2024 "| 2 | 1 |"
2025 (org-test-with-temp-text
2026 "| 2 | |\n<point>#+TBLFM: $>=1"
2027 (org-table-calc-current-TBLFM)
2028 (buffer-string))))
2029 (should
2030 (string-match-p
2031 "| 2 |\n| 2 |"
2032 (org-test-with-temp-text
2033 "| 2 |\n| |\n<point>#+TBLFM: @>$1=@<"
2034 (org-table-calc-current-TBLFM)
2035 (buffer-string)))))
2036
2037 (ert-deftest test-org-table/time-stamps ()
2038 "Test time-stamps handling."
2039 ;; Standard test.
2040 (should
2041 (string-match-p
2042 "| 1 |"
2043 (org-test-with-temp-text
2044 "| <2016-07-07 Sun> | <2016-07-08 Fri> | |\n<point>#+TBLFM: $3=$2-$1"
2045 (org-table-calc-current-TBLFM)
2046 (buffer-string))))
2047 ;; Handle locale specific time-stamps.
2048 (should
2049 (string-match-p
2050 "| 1 |"
2051 (org-test-with-temp-text
2052 "| <2016-07-07 Do> | <2016-07-08 Fr> | |\n<point>#+TBLFM: $3=$2-$1"
2053 (org-table-calc-current-TBLFM)
2054 (buffer-string)))))
2055
2056
2057 (ert-deftest test-org-table/orgtbl-ascii-draw ()
2058 "Test `orgtbl-ascii-draw'."
2059 ;; First value: Make sure that an integer input value is converted to a
2060 ;; float before division. Further values: Show some float input value
2061 ;; ranges corresponding to the same bar width.
2062 (should
2063 (equal
2064 (org-test-with-temp-text
2065 "
2066 | Value | <l> |
2067 |----------+---------|
2068 | 19 | replace |
2069 |----------+---------|
2070 | -0.50001 | replace |
2071 | -0.49999 | replace |
2072 | 0.49999 | replace |
2073 | 0.50001 | replace |
2074 | 1.49999 | replace |
2075 | 22.50001 | replace |
2076 | 23.49999 | replace |
2077 | 23.50001 | replace |
2078 | 24.49999 | replace |
2079 | 24.50001 | replace |
2080 <point>#+TBLFM: $2 = '(orgtbl-ascii-draw $1 0 24 3 \" 12345678\")"
2081 (org-table-calc-current-TBLFM)
2082 (buffer-string))
2083 "
2084 | Value | <l> |
2085 |----------+-----------|
2086 | 19 | 883 |
2087 |----------+-----------|
2088 | -0.50001 | too small |
2089 | -0.49999 | |
2090 | 0.49999 | |
2091 | 0.50001 | 1 |
2092 | 1.49999 | 1 |
2093 | 22.50001 | 887 |
2094 | 23.49999 | 887 |
2095 | 23.50001 | 888 |
2096 | 24.49999 | 888 |
2097 | 24.50001 | too large |
2098 #+TBLFM: $2 = '(orgtbl-ascii-draw $1 0 24 3 \" 12345678\")"))
2099 ;; Draw bars with a bullet. The bullet does not count in the parameter
2100 ;; WIDTH of `orgtbl-ascii-draw'.
2101 (should
2102 (equal
2103 (org-test-with-temp-text
2104 "
2105 | -1 | replace |
2106 | 0 | replace |
2107 | 1 | replace |
2108 | 2 | replace |
2109 | 3 | replace |
2110 | 4 | replace |
2111 <point>#+TBLFM: $2 = '(orgtbl-ascii-draw $1 0 3 3 \"$-\")"
2112 (org-table-calc-current-TBLFM)
2113 (buffer-string))
2114 "
2115 | -1 | too small |
2116 | 0 | $ |
2117 | 1 | -$ |
2118 | 2 | --$ |
2119 | 3 | ---$ |
2120 | 4 | too large |
2121 #+TBLFM: $2 = '(orgtbl-ascii-draw $1 0 3 3 \"$-\")")))
2122
2123 (ert-deftest test-org-table/single-rowgroup ()
2124 "Test column formula in a table with a single rowgroup."
2125 (should
2126 (equal
2127 "
2128 |---+---|
2129 | 1 | 0 |
2130 |---+---|
2131 #+TBLFM: $2=$1-1"
2132 (org-test-with-temp-text "
2133 |---+---|
2134 | 1 | |
2135 |---+---|
2136 <point>#+TBLFM: $2=$1-1"
2137 (org-table-calc-current-TBLFM)
2138 (buffer-string))))
2139 (should
2140 (equal
2141 "
2142 | 1 | 0 |
2143 #+TBLFM: $2=$1-1"
2144 (org-test-with-temp-text "
2145 | 1 | |
2146 <point>#+TBLFM: $2=$1-1"
2147 (org-table-calc-current-TBLFM)
2148 (buffer-string)))))
2149
2150 \f
2151 ;;; Navigation
2152
2153 (ert-deftest test-org-table/next-field ()
2154 "Test `org-table-next-field' specifications."
2155 ;; Regular test.
2156 (should
2157 (equal
2158 "b"
2159 (org-test-with-temp-text "| a<point> | b |"
2160 (org-table-next-field)
2161 (org-trim (org-table-get-field)))))
2162 ;; Create new rows as needed.
2163 (should
2164 (equal
2165 "| a |\n| |\n"
2166 (org-test-with-temp-text "| a<point> |"
2167 (org-table-next-field)
2168 (buffer-string))))
2169 ;; Jump over hlines, if `org-table-tab-jumps-over-hlines' is
2170 ;; non-nil.
2171 (should
2172 (equal
2173 "b"
2174 (org-test-with-temp-text "| a<point> |\n|---|\n| b |"
2175 (let ((org-table-tab-jumps-over-hlines t)) (org-table-next-field))
2176 (org-trim (org-table-get-field)))))
2177 ;; If `org-table-tab-jumps-over-hlines' is nil, however, create
2178 ;; a new row before the rule.
2179 (should
2180 (equal
2181 "| a |\n| |\n|---|\n| b |"
2182 (org-test-with-temp-text "| a<point> |\n|---|\n| b |"
2183 (let ((org-table-tab-jumps-over-hlines nil)) (org-table-next-field))
2184 (buffer-string)))))
2185
2186 (ert-deftest test-org-table/previous-field ()
2187 "Test `org-table-previous-field' specifications."
2188 ;; Regular tests.
2189 (should
2190 (eq ?a
2191 (org-test-with-temp-text "| a | <point>b |"
2192 (org-table-previous-field)
2193 (char-after))))
2194 (should
2195 (eq ?a
2196 (org-test-with-temp-text "| a |\n| <point>b |"
2197 (org-table-previous-field)
2198 (char-after))))
2199 ;; Find previous field across horizontal rules.
2200 (should
2201 (eq ?a
2202 (org-test-with-temp-text "| a |\n|---|\n| <point>b |"
2203 (org-table-previous-field)
2204 (char-after))))
2205 ;; When called on a horizontal rule, find previous data field.
2206 (should
2207 (eq ?b
2208 (org-test-with-temp-text "| a | b |\n|---+-<point>--|"
2209 (org-table-previous-field)
2210 (char-after))))
2211 ;; Error when at first field. Make sure to preserve original
2212 ;; position.
2213 (should-error
2214 (org-test-with-temp-text "| <point> a|"
2215 (org-table-previous-field)))
2216 (should-error
2217 (org-test-with-temp-text "|---|\n| <point>a |"
2218 (org-table-previous-field)))
2219 (should
2220 (eq ?a
2221 (org-test-with-temp-text "|---|\n| <point>a |"
2222 (ignore-errors (org-table-previous-field))
2223 (char-after)))))
2224
2225 \f
2226 ;;; Inserting rows, inserting columns
2227
2228 (ert-deftest test-org-table/insert-column ()
2229 "Test `org-table-insert-column' specifications."
2230 ;; Error when outside a table.
2231 (should-error
2232 (org-test-with-temp-text "Paragraph"
2233 (org-table-insert-column)))
2234 ;; Insert new column after current one.
2235 (should
2236 (equal "| a | |\n"
2237 (org-test-with-temp-text "| a |"
2238 (org-table-insert-column)
2239 (buffer-string))))
2240 (should
2241 (equal "| a | | b |\n"
2242 (org-test-with-temp-text "| <point>a | b |"
2243 (org-table-insert-column)
2244 (buffer-string))))
2245 ;; Move point into the newly created column.
2246 (should
2247 (equal " |"
2248 (org-test-with-temp-text "| <point>a |"
2249 (org-table-insert-column)
2250 (buffer-substring-no-properties (point) (line-end-position)))))
2251 (should
2252 (equal " | b |"
2253 (org-test-with-temp-text "| <point>a | b |"
2254 (org-table-insert-column)
2255 (buffer-substring-no-properties (point) (line-end-position)))))
2256 ;; Handle missing vertical bar in the last column.
2257 (should
2258 (equal "| a | |\n"
2259 (org-test-with-temp-text "| a"
2260 (org-table-insert-column)
2261 (buffer-string))))
2262 (should
2263 (equal " |"
2264 (org-test-with-temp-text "| <point>a"
2265 (org-table-insert-column)
2266 (buffer-substring-no-properties (point) (line-end-position)))))
2267 ;; Handle column insertion when point is before first column.
2268 (should
2269 (equal " | a | |\n"
2270 (org-test-with-temp-text " | a |"
2271 (org-table-insert-column)
2272 (buffer-string))))
2273 (should
2274 (equal " | a | | b |\n"
2275 (org-test-with-temp-text " | a | b |"
2276 (org-table-insert-column)
2277 (buffer-string)))))
2278
2279
2280 \f
2281 ;;; Moving rows, moving columns
2282
2283 (ert-deftest test-org-table/move-row-down ()
2284 "Test `org-table-move-row-down' specifications."
2285 ;; Error out when row cannot be moved, e.g., it is the last row in
2286 ;; the table.
2287 (should-error
2288 (org-test-with-temp-text "| a |"
2289 (org-table-move-row-down)))
2290 (should-error
2291 (org-test-with-temp-text "| a |\n"
2292 (org-table-move-row-down)))
2293 (should-error
2294 (org-test-with-temp-text "| a |\n| <point>b |"
2295 (org-table-move-row-down)))
2296 ;; Move data lines.
2297 (should
2298 (equal "| b |\n| a |\n"
2299 (org-test-with-temp-text "| a |\n| b |\n"
2300 (org-table-move-row-down)
2301 (buffer-string))))
2302 (should
2303 (equal "|---|\n| a |\n"
2304 (org-test-with-temp-text "| a |\n|---|\n"
2305 (org-table-move-row-down)
2306 (buffer-string))))
2307 ;; Move hlines.
2308 (should
2309 (equal "| b |\n|---|\n"
2310 (org-test-with-temp-text "|---|\n| b |\n"
2311 (org-table-move-row-down)
2312 (buffer-string))))
2313 (should
2314 (equal "|---|\n|---|\n"
2315 (org-test-with-temp-text "|---|\n|---|\n"
2316 (org-table-move-row-down)
2317 (buffer-string))))
2318 ;; Move rows even without a final newline.
2319 (should
2320 (equal "| b |\n| a |\n"
2321 (org-test-with-temp-text "| a |\n| b |"
2322 (org-table-move-row-down)
2323 (buffer-string)))))
2324
2325 (ert-deftest test-org-table/move-row-up ()
2326 "Test `org-table-move-row-up' specifications."
2327 ;; Error out when row cannot be moved, e.g., it is the first row in
2328 ;; the table.
2329 (should-error
2330 (org-test-with-temp-text "| a |"
2331 (org-table-move-row-up)))
2332 (should-error
2333 (org-test-with-temp-text "| a |\n"
2334 (org-table-move-row-up)))
2335 ;; Move data lines.
2336 (should
2337 (equal "| b |\n| a |\n"
2338 (org-test-with-temp-text "| a |\n| <point>b |\n"
2339 (org-table-move-row-up)
2340 (buffer-string))))
2341 (should
2342 (equal "| b |\n|---|\n"
2343 (org-test-with-temp-text "|---|\n| <point>b |\n"
2344 (org-table-move-row-up)
2345 (buffer-string))))
2346 ;; Move hlines.
2347 (should
2348 (equal "|---|\n| a |\n"
2349 (org-test-with-temp-text "| a |\n|<point>---|\n"
2350 (org-table-move-row-up)
2351 (buffer-string))))
2352 (should
2353 (equal "|---|\n|---|\n"
2354 (org-test-with-temp-text "|---|\n|<point>---|\n"
2355 (org-table-move-row-up)
2356 (buffer-string))))
2357 ;; Move rows even without a final newline.
2358 (should
2359 (equal "| b |\n| a |\n"
2360 (org-test-with-temp-text "| a |\n| <point>b |"
2361 (org-table-move-row-up)
2362 (buffer-string)))))
2363
2364
2365 \f
2366 ;;; Shrunk columns
2367
2368 (ert-deftest test-org-table/toggle-column-width ()
2369 "Test `org-table-toggle-columns-width' specifications."
2370 ;; Error when not at a column.
2371 (should-error
2372 (org-test-with-temp-text "<point>a"
2373 (org-table-toggle-column-width)))
2374 ;; A shrunk column is overlaid with
2375 ;; `org-table-shrunk-column-indicator'.
2376 (should
2377 (equal org-table-shrunk-column-indicator
2378 (org-test-with-temp-text "| <point>a |"
2379 (org-table-toggle-column-width)
2380 (overlay-get (car (overlays-at (point))) 'display))))
2381 (should
2382 (equal org-table-shrunk-column-indicator
2383 (org-test-with-temp-text "| a |\n|-<point>--|"
2384 (org-table-toggle-column-width)
2385 (overlay-get (car (overlays-at (point))) 'display))))
2386 ;; Shrink every field in the same column.
2387 (should
2388 (equal org-table-shrunk-column-indicator
2389 (org-test-with-temp-text "| a |\n|-<point>--|"
2390 (org-table-toggle-column-width)
2391 (overlay-get (car (overlays-at (1+ (line-beginning-position 0))))
2392 'display))))
2393 ;; When column is already shrunk, expand it, i.e., remove overlays.
2394 (should-not
2395 (org-test-with-temp-text "| <point>a |"
2396 (org-table-toggle-column-width)
2397 (org-table-toggle-column-width)
2398 (overlays-in (point-min) (point-max))))
2399 (should-not
2400 (org-test-with-temp-text "| a |\n| <point>b |"
2401 (org-table-toggle-column-width)
2402 (org-table-toggle-column-width)
2403 (overlays-in (point-min) (point-max))))
2404 ;; With a column width cookie, limit overlay to the specified number
2405 ;; of characters.
2406 (should
2407 (equal "| abc"
2408 (org-test-with-temp-text "| <3> |\n| <point>abcd |"
2409 (org-table-toggle-column-width)
2410 (buffer-substring (line-beginning-position)
2411 (overlay-start
2412 (car (overlays-in (line-beginning-position)
2413 (line-end-position))))))))
2414 (should
2415 (equal "| a "
2416 (org-test-with-temp-text "| <3> |\n| <point>a |"
2417 (org-table-toggle-column-width)
2418 (buffer-substring (line-beginning-position)
2419 (overlay-start
2420 (car (overlays-in (line-beginning-position)
2421 (line-end-position))))))))
2422 (should
2423 (equal (concat "----" org-table-shrunk-column-indicator)
2424 (org-test-with-temp-text "| <3> |\n|--<point>----|"
2425 (org-table-toggle-column-width)
2426 (overlay-get
2427 (car (overlays-in (line-beginning-position)
2428 (line-end-position)))
2429 'display))))
2430 ;; Width only takes into account visible characters.
2431 (should
2432 (equal "| [[http"
2433 (org-test-with-temp-text "| <4> |\n| <point>[[http://orgmode.org]] |"
2434 (org-table-toggle-column-width)
2435 (buffer-substring (line-beginning-position)
2436 (overlay-start
2437 (car (overlays-in (line-beginning-position)
2438 (line-end-position))))))))
2439 ;; Before the first column or after the last one, ask for columns
2440 ;; ranges.
2441 (should
2442 (catch :exit
2443 (org-test-with-temp-text "| a |"
2444 (cl-letf (((symbol-function 'read-string)
2445 (lambda (&rest_) (throw :exit t))))
2446 (org-table-toggle-column-width)
2447 nil))))
2448 (should
2449 (catch :exit
2450 (org-test-with-temp-text "| a |<point>"
2451 (cl-letf (((symbol-function 'read-string)
2452 (lambda (&rest_) (throw :exit t))))
2453 (org-table-toggle-column-width)
2454 nil))))
2455 ;; When optional argument ARG is a string, toggle specified columns.
2456 (should
2457 (equal org-table-shrunk-column-indicator
2458 (org-test-with-temp-text "| <point>a | b |"
2459 (org-table-toggle-column-width "2")
2460 (overlay-get (car (overlays-at (- (point-max) 2))) 'display))))
2461 (should
2462 (equal '("b" "c")
2463 (org-test-with-temp-text "| a | b | c | d |"
2464 (org-table-toggle-column-width "2-3")
2465 (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
2466 (overlays-in (point-min) (point-max)))
2467 #'string-lessp))))
2468 (should
2469 (equal '("b" "c" "d")
2470 (org-test-with-temp-text "| a | b | c | d |"
2471 (org-table-toggle-column-width "2-")
2472 (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
2473 (overlays-in (point-min) (point-max)))
2474 #'string-lessp))))
2475 (should
2476 (equal '("a" "b")
2477 (org-test-with-temp-text "| a | b | c | d |"
2478 (org-table-toggle-column-width "-2")
2479 (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
2480 (overlays-in (point-min) (point-max)))
2481 #'string-lessp))))
2482 (should
2483 (equal '("a" "b" "c" "d")
2484 (org-test-with-temp-text "| a | b | c | d |"
2485 (org-table-toggle-column-width "-")
2486 (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
2487 (overlays-in (point-min) (point-max)))
2488 #'string-lessp))))
2489 (should
2490 (equal '("a" "d")
2491 (org-test-with-temp-text "| a | b | c | d |"
2492 (org-table-toggle-column-width "1-3")
2493 (org-table-toggle-column-width "2-4")
2494 (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
2495 (overlays-in (point-min) (point-max)))
2496 #'string-lessp))))
2497 ;; When ARG is (16), remove any column overlay.
2498 (should-not
2499 (org-test-with-temp-text "| <point>a |"
2500 (org-table-toggle-column-width)
2501 (org-table-toggle-column-width '(16))
2502 (overlays-in (point-min) (point-max))))
2503 (should-not
2504 (org-test-with-temp-text "| a | b | c | d |"
2505 (org-table-toggle-column-width "-")
2506 (org-table-toggle-column-width '(16))
2507 (overlays-in (point-min) (point-max)))))
2508
2509 (ert-deftest test-org-table/shrunk-columns ()
2510 "Test behaviour of shrunk column."
2511 ;; Edition automatically expands a shrunk column.
2512 (should-not
2513 (org-test-with-temp-text "| <point>a |"
2514 (org-table-toggle-column-width)
2515 (insert "a")
2516 (overlays-in (point-min) (point-max))))
2517 ;; Other columns are not changed.
2518 (should
2519 (org-test-with-temp-text "| <point>a | b |"
2520 (org-table-toggle-column-width "-")
2521 (insert "a")
2522 (overlays-in (point-min) (point-max))))
2523 ;; Moving a shrunk column doesn't alter its state.
2524 (should
2525 (equal "a"
2526 (org-test-with-temp-text "| <point>a | b |"
2527 (org-table-toggle-column-width)
2528 (org-table-move-column-right)
2529 (overlay-get (car (overlays-at (point))) 'help-echo))))
2530 (should
2531 (equal "a"
2532 (org-test-with-temp-text "| <point>a |\n| b |"
2533 (org-table-toggle-column-width)
2534 (org-table-move-row-down)
2535 (overlay-get (car (overlays-at (point))) 'help-echo))))
2536 ;; State is preserved upon inserting a column.
2537 (should
2538 (equal '("a")
2539 (org-test-with-temp-text "| <point>a |"
2540 (org-table-toggle-column-width)
2541 (org-table-insert-column)
2542 (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
2543 (overlays-in (point-min) (point-max)))
2544 #'string-lessp))))
2545 ;; State is preserved upon deleting a column.
2546 (should
2547 (equal '("a" "c")
2548 (org-test-with-temp-text "| a | <point>b | c |"
2549 (org-table-toggle-column-width "-")
2550 (org-table-delete-column)
2551 (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
2552 (overlays-in (point-min) (point-max)))
2553 #'string-lessp))))
2554 ;; State is preserved upon deleting a row.
2555 (should
2556 (equal '("b1" "b2")
2557 (org-test-with-temp-text "| a1 | a2 |\n| b1 | b2 |"
2558 (org-table-toggle-column-width "-")
2559 (org-table-kill-row)
2560 (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
2561 (overlays-in (point-min) (point-max)))
2562 #'string-lessp))))
2563 (should
2564 (equal '("a1" "a2")
2565 (org-test-with-temp-text "| a1 | a2 |\n| <point>b1 | b2 |"
2566 (org-table-toggle-column-width "-")
2567 (org-table-kill-row)
2568 (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
2569 (overlays-in (point-min) (point-max)))
2570 #'string-lessp))))
2571 ;; State is preserved upon inserting a row or hline.
2572 (should
2573 (equal '("" "a1" "b1")
2574 (org-test-with-temp-text "| a1 | a2 |\n| <point>b1 | b2 |"
2575 (org-table-toggle-column-width)
2576 (org-table-insert-row)
2577 (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
2578 (overlays-in (point-min) (point-max)))
2579 #'string-lessp))))
2580 (should
2581 (equal '("a1" "b1")
2582 (org-test-with-temp-text "| a1 | a2 |\n| <point>b1 | b2 |"
2583 (org-table-toggle-column-width)
2584 (org-table-insert-hline)
2585 (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
2586 (overlays-in (point-min) (point-max)))
2587 #'string-lessp))))
2588 ;; State is preserved upon sorting a column for all the columns but
2589 ;; the one being sorted.
2590 (should
2591 (equal '("a2" "b2")
2592 (org-test-with-temp-text "| <point>a1 | a2 |\n| <point>b1 | b2 |"
2593 (org-table-toggle-column-width "-")
2594 (org-table-sort-lines nil ?A)
2595 (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
2596 (overlays-in (point-min) (point-max)))
2597 #'string-lessp))))
2598 ;; State is preserved upon replacing a field non-interactively.
2599 (should
2600 (equal '("a")
2601 (org-test-with-temp-text "| <point>a |"
2602 (org-table-toggle-column-width)
2603 (org-table-get-field nil "b")
2604 (mapcar (lambda (o) (overlay-get o 'help-echo))
2605 (overlays-in (point-min) (point-max))))))
2606 ;; Moving to next field doesn't change shrunk state.
2607 (should
2608 (equal "a"
2609 (org-test-with-temp-text "| <point>a | b |"
2610 (org-table-toggle-column-width)
2611 (org-table-next-field)
2612 (overlay-get (car (overlays-at (1+ (line-beginning-position))))
2613 'help-echo))))
2614 (should
2615 (equal "b"
2616 (org-test-with-temp-text "| a | <point>b |"
2617 (org-table-toggle-column-width)
2618 (goto-char 2)
2619 (org-table-next-field)
2620 (overlay-get (car (overlays-at (point))) 'help-echo))))
2621 ;; Aligning table doesn't alter shrunk state.
2622 (should
2623 (equal "a"
2624 (org-test-with-temp-text "| <point>a | b |"
2625 (org-table-toggle-column-width)
2626 (org-table-align)
2627 (overlay-get (car (overlays-at (1+ (line-beginning-position))))
2628 'help-echo))))
2629 (should
2630 (equal "b"
2631 (org-test-with-temp-text "|---+-----|\n| a | <point>b |"
2632 (org-table-toggle-column-width)
2633 (org-table-align)
2634 (overlay-get (car (overlays-at (point)))
2635 'help-echo))))
2636 (should
2637 (equal
2638 '("b")
2639 (org-test-with-temp-text "|---+-----|\n| a | <point>b |"
2640 (org-table-toggle-column-width)
2641 (org-table-align)
2642 (mapcar (lambda (o) (overlay-get o 'help-echo))
2643 (overlays-in (line-beginning-position) (line-end-position)))))))
2644
2645
2646 \f
2647 ;;; Miscellaneous
2648
2649 (ert-deftest test-org-table/current-column ()
2650 "Test `org-table-current-column' specifications."
2651 (should
2652 (= 1 (org-test-with-temp-text "| <point>a |"
2653 (org-table-current-column))))
2654 (should
2655 (= 1 (org-test-with-temp-text "|-<point>--|"
2656 (org-table-current-column))))
2657 (should
2658 (= 2 (org-test-with-temp-text "| 1 | <point>2 |"
2659 (org-table-current-column))))
2660 (should
2661 (= 2 (org-test-with-temp-text "|---+-<point>--|"
2662 (org-table-current-column)))))
2663
2664 (ert-deftest test-org-table/get-field ()
2665 "Test `org-table-get-field' specifications."
2666 ;; Regular test.
2667 (should
2668 (equal " a "
2669 (org-test-with-temp-text "| <point>a |" (org-table-get-field))))
2670 ;; Get field in open last column.
2671 (should
2672 (equal " a "
2673 (org-test-with-temp-text "| <point>a " (org-table-get-field))))
2674 ;; Get empty field.
2675 (should
2676 (equal ""
2677 (org-test-with-temp-text "|<point>|" (org-table-get-field))))
2678 (should
2679 (equal " "
2680 (org-test-with-temp-text "| <point>|" (org-table-get-field))))
2681 ;; Outside the table, return the empty string.
2682 (should
2683 (equal ""
2684 (org-test-with-temp-text "<point>| a |" (org-table-get-field))))
2685 (should
2686 (equal ""
2687 (org-test-with-temp-text "| a |<point>" (org-table-get-field))))
2688 ;; With optional N argument, select a particular column in current
2689 ;; row.
2690 (should
2691 (equal " 3 "
2692 (org-test-with-temp-text "| 1 | 2 | 3 |" (org-table-get-field 3))))
2693 (should
2694 (equal " 4 "
2695 (org-test-with-temp-text "| 1 | 2 |\n<point>| 3 | 4 |"
2696 (org-table-get-field 2))))
2697 ;; REPLACE optional argument is used to replace selected field.
2698 (should
2699 (equal "| foo |"
2700 (org-test-with-temp-text "| <point>1 |"
2701 (org-table-get-field nil " foo ")
2702 (buffer-string))))
2703 (should
2704 (equal "| 1 | 2 | foo |"
2705 (org-test-with-temp-text "| 1 | 2 | 3 |"
2706 (org-table-get-field 3 " foo ")
2707 (buffer-string))))
2708 (should
2709 (equal " 4 "
2710 (org-test-with-temp-text "| 1 | 2 |\n<point>| 3 | 4 |"
2711 (org-table-get-field 2))))
2712 ;; An empty REPLACE string clears the field.
2713 (should
2714 (equal "| |"
2715 (org-test-with-temp-text "| <point>1 |"
2716 (org-table-get-field nil "")
2717 (buffer-string))))
2718 ;; When using REPLACE still return old value.
2719 (should
2720 (equal " 1 "
2721 (org-test-with-temp-text "| <point>1 |"
2722 (org-table-get-field nil " foo ")))))
2723
2724 (provide 'test-org-table)
2725
2726 ;;; test-org-table.el ends here
org-mode fork for development of tableheadings