1 ;;; test-org-table.el --- tests for org-table.el
3 ;; Copyright (c) David Maus
4 ;; Authors: David Maus, Michael Brand
6 ;; This file is not part of GNU Emacs.
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.
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.
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/>.
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'.
30 (require 'org-table
) ; `org-table-make-reference'
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
49 "#+TBLFM: @>$1 = vsum(@<..@>>)"
51 "#+TBLFM: @>$1 = '(+ @<..@>>); N"))
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
74 "#+TBLFM: @>$1 = vsum(@I..@>>)"
76 "#+TBLFM: @>$1 = '(+ @I..@>>); N"))
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
82 (org-test-table-target-expect
99 "#+TBLFM: $1 = vsum(@<..@>>)"
101 "#+TBLFM: $1 = '(+ @<..@>>); N")
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
112 |---------+---------|
113 | replace | replace |
124 "#+TBLFM: @>$1 = vsum(@<..@>>) :: $2 = 2 * $1"
126 "#+TBLFM: @>$1 = '(+ @<..@>>); N :: $2 = '(* 2 $1); N"))
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
135 |---------+---------|
139 |---------+---------|
140 | replace | replace |
153 "#+TBLFM: @>$1 = vsum(@I..@>>) :: $2 = 2 * $1"
155 "#+TBLFM: @>$1 = '(+ @I..@>>); N :: $2 = '(* 2 $1); N"))
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 |
163 "Normal numbers and non-numbers for Lisp and Calc formula.")
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 |
171 "Special numbers for Calc formula.")
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.
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 |
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"))
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
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 |
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 |
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")))
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."
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"))
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.
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 |
240 (org-test-table-target-expect
241 references
/target-normal
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 |
249 (org-test-table-target-expect
250 references
/target-special
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 |
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."
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"))
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
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 |
281 (org-test-table-target-expect
282 references
/target-special
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 |
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.
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 |
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")))
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."
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))"))
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.
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 |
331 (org-test-table-target-expect
332 references
/target-normal
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 |
340 (org-test-table-target-expect
341 references
/target-special
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 |
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."
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"))
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
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 |
373 (org-test-table-target-expect
374 references
/target-special
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 |
383 (ert-deftest test-org-table
/lisp-return-value
()
384 "Basic: Return value of Lisp formulas."
385 (org-test-table-target-expect
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 |
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 |
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")))
420 (ert-deftest test-org-table
/compare
()
421 "Basic: Compare field references in Calc."
422 (org-test-table-target-expect
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 |
435 | | 0 | z | | nan | uinf | -inf | inf |
436 |------+---+---+---+-----+------+------+-----|
437 | 0 | x | | | | | | |
438 | z | | x | | | | | |
440 | nan | | | | x | | | |
441 | uinf | | | | | x | | |
442 | -inf | | | | | | x | |
443 | inf | | | | | | | x |
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
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"))
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
474 1 "#+TBLFM: $2 = if(\"$1\" == \"nan\", string(\"\"), $1 + 1); E"))
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
492 "#+TBLFM: $2 = if(\"$1\" == \"nan\", string(\"\"), $1 + 1); E"
494 "#+TBLFM: $2 = '(if (eq \"$1\" \"\") \"\" (1+ $1)); L")
496 ;; Test if several fields are empty, else do a calculation
497 (org-test-table-target-expect
512 (concat "#+TBLFM: $3 = if(\"$1\" == \"nan\" || \"$2\" == \"nan\", "
513 "string(\"\"), $1 + $2); E")
515 (concat "#+TBLFM: $3 = '(if (or (eq \"$1\" \"\") (eq \"$2\" \"\")) "
516 "\"\" (+ $1 $2)); L"))
518 ;; $2: Use $1 + 0.5 if $1 available, else only reformat $2 if $2 available
519 (org-test-table-target-expect
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
539 ;; Empty fields in simple and complex range reference
540 (org-test-table-target-expect
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 |
547 | | | | | | | | | 0 | 0 |
548 | | | 5 | 7 | | | 6 | 6 | 3 | 3 |
549 | 1 | 3 | 5 | 7 | 4 | 4 | 4 | 4 | 4 | 4 |
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")
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")
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'."
586 | 2012-12 | replace |
587 | [2012-12-31 Mon] | replace |
589 ;; Lisp formula to copy literally
590 (org-test-table-target-expect
597 | 2012-12 | 2012-12 |
598 | [2012-12-31 Mon] | [2012-12-31 Mon] |
600 1 "#+TBLFM: $2 = '(identity $1)")
602 ;; Calc formula to copy quite literally
603 (org-test-table-target-expect
610 | 2012-12 | 2012-12 |
611 | [2012-12-31 Mon] | [2012-12-31 Mon] |
613 1 (concat "#+TBLFM: $2 = if(\"$1\" == \"nan\", "
614 "string(\"\"), string(subvec(\"$1\", 2, vlen(\"$1\")))); E"))
616 ;; Calc formula simple
617 (org-test-table-target-expect
625 | [2012-12-31 Mon] | [2012-12-31 Mon] |
627 1 "#+TBLFM: $2 = if(\"$1\" == \"nan\", string(\"\"), $1); E")))
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
637 (org-test-table-target-expect
639 |-------+---------+---------|
640 | Item | Item | Sub- |
641 | name | value | total |
642 |-------+---------+---------|
643 | a1 | 4.1 | replace |
644 | a2 | 8.2 | replace |
646 |-------+---------+---------|
647 | b1 | 16.0 | replace |
648 |-------+---------+---------|
649 | c1 | 32 | replace |
650 | c2 | 64 | replace |
651 |-------+---------+---------|
652 | Total | replace | replace |
653 |-------+---------+---------|
656 |-------+-------+-------|
657 | Item | Item | Sub- |
658 | name | value | total |
659 |-------+-------+-------|
663 |-------+-------+-------|
665 |-------+-------+-------|
668 |-------+-------+-------|
670 |-------+-------+-------|
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(\"\")")))
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'."
682 | Purchase | Product | Shop | Rating |
683 |----------+---------+------+--------|
690 ;; Product rating and ranking by average purchase from "#+NAME: data"
691 (org-test-table-target-expect
693 | Product | Rating | Ranking |
694 |---------+---------+---------|
695 | p1 | replace | replace |
696 | p2 | replace | replace |
697 | p3 | replace | replace |
700 | Product | Rating | Ranking |
701 |---------+--------+---------|
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"))
712 ;; Shop rating and ranking by average purchase from "#+NAME: data"
713 (org-test-table-target-expect
715 | Shop | Rating | Ranking |
716 |------+---------+---------|
717 | s1 | replace | replace |
718 | s2 | replace | replace |
721 | Shop | Rating | Ranking |
722 |------+--------+---------|
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"))))
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
))))
742 (ert-deftest test-org-table
/org-table-make-reference
/mode-string-E
()
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
)))
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
))))
769 (ert-deftest test-org-table
/org-table-make-reference
/mode-string-EN
()
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
)))
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
))))
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
))))
806 (ert-deftest test-org-table
/org-table-make-reference
/mode-string-none
()
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
)))
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
))))
833 (ert-deftest test-org-table
/org-table-make-reference
/mode-string-N
()
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
)))
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
))))
860 (ert-deftest test-org-table
/org-table-convert-refs-to-an
/1 ()
861 "Simple reference @2$1."
863 (string= "A2" (org-table-convert-refs-to-an "@2$1"))))
866 ;; (ert-deftest test-org-table/org-table-convert-refs-to-an/2 ()
867 ;; "Self reference @1$1."
869 ;; (string= "A1 = $0" (org-table-convert-refs-to-an "@1$1 = $0"))))
871 (ert-deftest test-org-table
/org-table-convert-refs-to-an
/3 ()
874 (string= "C& = remote(FOO, @@#B&)" (org-table-convert-refs-to-an "$3 = remote(FOO, @@#$2)"))))
876 (ert-deftest test-org-table
/org-table-convert-refs-to-rc
/1 ()
877 "Simple reference @2$1."
879 (string= "@2$1" (org-table-convert-refs-to-rc "A2"))))
881 (ert-deftest test-org-table
/org-table-convert-refs-to-rc
/2 ()
884 (string= "@1$1 = $0" (org-table-convert-refs-to-rc "A1 = $0"))))
887 ;; (ert-deftest test-org-table/org-table-convert-refs-to-rc/3 ()
888 ;; "Remote reference."
890 ;; (string= "$3 = remote(FOO, @@#$2)" (org-table-convert-refs-to-rc "C& = remote(FOO, @@#B&)"))))
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
900 | replace | replace |
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)")))
914 (ert-deftest test-org-table
/remote-reference-indirect
()
915 "Access to remote reference with indirection of name or ID."
916 (let ((source-tables "
924 #+TBLFM: @>$1 = vsum(@I..@II)
933 #+TBLFM: @>$1 = vsum(@I..@II)
936 ;; Read several remote references from same column
937 (org-test-table-target-expect
938 (concat source-tables
"
947 (concat source-tables
"
958 "#+TBLFM: @<<$2..@>>$2 = remote($<, @>$1) :: @>$2 = vsum(@I..@II)"
960 (concat "#+TBLFM: @<<$2..@>>$2 = '(identity remote($<, @>$1)); N :: "
961 "@>$2 = '(+ @I..@II); N"))
963 ;; Read several remote references from same row
964 (org-test-table-target-expect
965 (concat source-tables
"
967 | year | 2012 | 2013 | total |
968 |--------+---------+---------+---------|
969 | amount | replace | replace | replace |
971 (concat source-tables
"
973 | year | 2012 | 2013 | total |
974 |--------+------+------+-------|
975 | amount | 3 | 12 | 15 |
979 "#+TBLFM: @2$<<..@2$>> = remote(@<, @>$1) :: @2$> = vsum($<<..$>>)"
981 (concat "#+TBLFM: @2$<<..@2$>> = '(identity remote(@<, @>$1)); N :: "
982 "@2$> = '(+ $<<..$>>); N"))))
984 (ert-deftest test-org-table
/org-at-TBLFM-p
()
985 (org-test-with-temp-text-in-file
992 (goto-char (point-min))
994 (should (equal (org-at-TBLFM-p) nil
))
996 (goto-char (point-min))
998 (should (equal (org-at-TBLFM-p) t
))
1000 (goto-char (point-min))
1002 (should (equal (org-at-TBLFM-p) nil
))))
1004 (ert-deftest test-org-table
/org-table-TBLFM-begin
()
1005 (org-test-with-temp-text-in-file
1012 (goto-char (point-min))
1013 (should (equal (org-table-TBLFM-begin)
1016 (goto-char (point-min))
1018 (should (equal (org-table-TBLFM-begin)
1021 (goto-char (point-min))
1023 (should (= (org-table-TBLFM-begin)
1026 (goto-char (point-min))
1028 (should (= (org-table-TBLFM-begin)
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
1043 (goto-char (point-min))
1044 (should (equal (org-table-TBLFM-begin)
1047 (goto-char (point-min))
1049 (should (equal (org-table-TBLFM-begin)
1052 (goto-char (point-min))
1054 (should (= (org-table-TBLFM-begin)
1057 (goto-char (point-min))
1059 (should (= (org-table-TBLFM-begin)
1062 (goto-char (point-min))
1064 (should (= (org-table-TBLFM-begin)
1069 (ert-deftest test-org-table
/org-table-TBLFM-begin-for-pultiple-TBLFM-lines-blocks
()
1070 (org-test-with-temp-text-in-file
1083 (goto-char (point-min))
1084 (should (equal (org-table-TBLFM-begin)
1087 (goto-char (point-min))
1089 (should (equal (org-table-TBLFM-begin)
1092 (goto-char (point-min))
1094 (should (= (org-table-TBLFM-begin)
1097 (goto-char (point-min))
1099 (should (= (org-table-TBLFM-begin)
1102 (goto-char (point-min))
1104 (should (= (org-table-TBLFM-begin)
1107 (goto-char (point-min))
1109 (should (= (org-table-TBLFM-begin)
1112 (goto-char (point-min))
1114 (should (= (org-table-TBLFM-begin)
1117 (goto-char (point-min))
1119 (should (= (org-table-TBLFM-begin)
1122 (goto-char (point-min))
1124 (should (= (org-table-TBLFM-begin)
1127 (ert-deftest test-org-table
/org-table-calc-current-TBLFM
()
1128 (org-test-with-temp-text-in-file
1136 (let ((got (progn (goto-char (point-min))
1138 (org-table-calc-current-TBLFM)
1147 (should (string= got
1150 (let ((got (progn (goto-char (point-min))
1152 (org-table-calc-current-TBLFM)
1161 (should (string= got
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
1171 #+TBLFM: $2=$1*2::$2=$1*2
1178 #+TBLFM: $2=$1*2::$2=$1*2
1181 (goto-char (point-min))
1183 (should-error (org-table-calc-current-TBLFM))
1184 (setq got
(buffer-string))
1186 (should (string= got
1191 (ert-deftest test-org-table
/to-generic
()
1192 "Test `orgtbl-to-generic' specifications."
1193 ;; Test :hline parameter.
1196 (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
1200 (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
1202 ;; Test :sep parameter.
1206 (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
1208 ;; Test :hsep parameter.
1212 (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
1213 '(:sep
"?" :hsep
"!"))))
1214 ;; Test :tstart parameter.
1217 (orgtbl-to-generic (org-table-to-lisp "| a |") '(:tstart
"<begin>"))))
1220 (orgtbl-to-generic (org-table-to-lisp "| a |")
1221 '(:tstart
(lambda () "<begin>")))))
1224 (orgtbl-to-generic (org-table-to-lisp "| a |")
1225 '(:tstart
"<begin>" :splice t
))))
1226 ;; Test :tend parameter.
1229 (orgtbl-to-generic (org-table-to-lisp "| a |") '(:tend
"<end>"))))
1232 (orgtbl-to-generic (org-table-to-lisp "| a |")
1233 '(:tend
(lambda () "<end>")))))
1236 (orgtbl-to-generic (org-table-to-lisp "| a |")
1237 '(:tend
"<end>" :splice t
))))
1238 ;; Test :lstart parameter.
1242 (org-table-to-lisp "| a |") '(:lstart
"> "))))
1245 (orgtbl-to-generic (org-table-to-lisp "| a |")
1246 '(:lstart
(lambda () "> ")))))
1247 ;; Test :llstart parameter.
1250 (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
1251 '(:lstart
"> " :llstart
">> "))))
1252 ;; Test :hlstart parameter.
1255 (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
1256 '(:lstart
"> " :hlstart
"!> "))))
1257 ;; Test :hllstart parameter.
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.
1265 (orgtbl-to-generic (org-table-to-lisp "| a |") '(:lend
" <"))))
1266 ;; Test :llend parameter.
1269 (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
1270 '(:lend
" <" :llend
" <<"))))
1271 ;; Test :hlend parameter.
1274 (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
1275 '(:lend
" <" :hlend
" <!"))))
1276 ;; Test :hllend parameter.
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.
1284 (orgtbl-to-generic (org-table-to-lisp "| a | b |")
1289 (org-table-to-lisp "| a | b |")
1290 '(:lfmt
(lambda (c) (concat (car c
) "+" (cadr c
)))))))
1293 (orgtbl-to-generic (org-table-to-lisp "| a | b |")
1294 '(:lfmt
"%s!%s" :lstart
">" :lend
"<" :sep
" "))))
1295 ;; Test :llfmt parameter.
1298 (orgtbl-to-generic (org-table-to-lisp "| a | b |")
1299 '(:llfmt
"%s!%s"))))
1303 (org-table-to-lisp "| a | b |\n| c | d |")
1304 '(:lfmt
"%s!%s" :llfmt
(lambda (c) (concat (car c
) "+" (cadr c
)))))))
1307 (orgtbl-to-generic (org-table-to-lisp "| a | b |")
1308 '(:llfmt
"%s!%s" :lstart
">" :lend
"<" :sep
" "))))
1309 ;; Test :hlfmt parameter.
1313 (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
1314 '(:hlfmt
"%s!%s"))))
1318 (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
1319 '(:hlfmt
(lambda (c) (concat (car c
) "+" (cadr c
)))))))
1323 (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
1324 '(:hlfmt
"%s!%s" :lstart
">" :lend
"<" :sep
" "))))
1325 ;; Test :hllfmt parameter.
1329 (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
1330 '(:hllfmt
"%s!%s"))))
1334 (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
1335 '(:hllfmt
(lambda (c) (concat (car c
) "+" (cadr c
)))))))
1339 (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
1340 '(:hllfmt
"%s!%s" :lstart
">" :lend
"<" :sep
" "))))
1341 ;; Test :fmt parameter.
1344 (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
1348 (orgtbl-to-generic (org-table-to-lisp "| a | b |")
1349 '(:fmt
(1 ">%s<" 2 (lambda (c) c
))))))
1352 (orgtbl-to-generic (org-table-to-lisp "| a | b |")
1353 '(:fmt
(2 " %s")))))
1356 (orgtbl-to-generic (org-table-to-lisp "| a |")
1357 '(:fmt
(lambda (c) (format ">%s<" c
))))))
1358 ;; Test :hfmt parameter.
1361 (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
1366 (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
1367 '(:hfmt
(1 ">%s<" 2 identity
)))))
1371 (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
1372 '(:hfmt
(2 " %s")))))
1375 (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
1376 '(:hfmt
(lambda (c) (format ">%s<" c
))))))
1377 ;; Test :efmt parameter.
1380 (orgtbl-to-generic (org-table-to-lisp "| 2e3 |")
1381 '(:efmt
"%sx10^%s"))))
1384 (orgtbl-to-generic (org-table-to-lisp "| 2e3 |")
1385 '(:efmt
(lambda (m e
) (concat m
"x10^" e
))))))
1388 (orgtbl-to-generic (org-table-to-lisp "| 2e3 |")
1389 '(:efmt
(1 "%sx10^%s")))))
1393 (org-table-to-lisp "| 2e3 |")
1394 '(:efmt
(1 (lambda (m e
) (format "%sx10^%s" m e
)))))))
1397 (orgtbl-to-generic (org-table-to-lisp "| 2e3 |") '(:efmt nil
))))
1398 ;; Test :skip parameter.
1402 (org-table-to-lisp "| \ | <c> |\n| a | b |\n|---+---|\n| c | d |")
1404 ;; Test :skipcols parameter.
1408 (org-table-to-lisp "| a | b |\n| c | d |") '(:skipcols
(2)))))
1413 "| / | <c> | <c> |\n| # | a | b |\n|---+---+---|\n| | c | d |")
1415 ;; Test :raw parameter.
1416 (when (featurep 'ox-latex
)
1420 (orgtbl-to-generic (org-table-to-lisp "| /a/ | b |")
1421 '(:backend latex
:raw t
)))))
1422 ;; Hooks are ignored.
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 |")
1431 ;; User-defined export filters are ignored.
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 |")
1438 ;; Macros, even if unknown, are returned as-is.
1440 (equal "{{{macro}}}"
1441 (orgtbl-to-generic (org-table-to-lisp "| {{{macro}}} |") nil
))))
1443 (ert-deftest test-org-table
/to-latex
()
1444 "Test `orgtbl-to-latex' specifications."
1446 (equal "\\begin{tabular}{l}\na\\\\\n\\end{tabular}"
1447 (orgtbl-to-latex (org-table-to-lisp "| a |") nil
)))
1448 ;; Test :environment parameter.
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.
1456 "\\toprule" (orgtbl-to-latex (org-table-to-lisp "| a |") '(:booktabs t
))))
1457 ;; Handle LaTeX snippets.
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.
1464 "\\$x\\$" (orgtbl-to-latex (org-table-to-lisp "| $x$ |") '(:raw t
)))))
1466 (ert-deftest test-org-table
/to-html
()
1467 "Test `orgtbl-to-html' specifications."
1469 (equal (orgtbl-to-html (org-table-to-lisp "| a |") nil
)
1470 "<table border=\"2\" cellspacing=\"0\" cellpadding=\"6\" rules=\"groups\" frame=\"hsides\">
1474 <col class=\"org-left\" />
1478 <td class=\"org-left\">a</td>
1482 ;; Test :attributes parameter.
1486 (orgtbl-to-html (org-table-to-lisp "| a |") '(:attributes nil
))))
1489 "<table border=\"2\">"
1490 (orgtbl-to-html (org-table-to-lisp "| a |") '(:attributes
(:border
"2"))))))
1492 (ert-deftest test-org-table
/to-texinfo
()
1493 "Test `orgtbl-to-texinfo' specifications."
1495 (equal "@multitable {a}\n@item a\n@end multitable"
1496 (orgtbl-to-texinfo (org-table-to-lisp "| a |") nil
)))
1497 ;; Test :columns parameter.
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"))))
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"))))
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}")))))
1511 (ert-deftest test-org-table
/to-orgtbl
()
1512 "Test `orgtbl-to-orgtbl' specifications."
1514 (equal "| a | b |\n|---+---|\n| c | d |"
1516 (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |") nil
))))
1518 (ert-deftest test-org-table
/to-unicode
()
1519 "Test `orgtbl-to-unicode' specifications."
1521 (equal "━━━\n a \n━━━"
1522 (orgtbl-to-unicode (org-table-to-lisp "| a |") nil
)))
1523 ;; Test :narrow parameter.
1525 (equal "━━━━\n => \n━━━━"
1526 (orgtbl-to-unicode (org-table-to-lisp "| <2> |\n| xxx |")
1529 (ert-deftest test-org-table
/send-region
()
1530 "Test `orgtbl-send-table' specifications."
1531 ;; Error when not at a table.
1533 (org-test-with-temp-text "Paragraph"
1534 (orgtbl-send-table)))
1535 ;; Error when destination is missing.
1537 (org-test-with-temp-text "#+ORGTBL: SEND\n<point>| a |"
1538 (orgtbl-send-table)))
1539 ;; Error when transformation function is not specified.
1541 (org-test-with-temp-text "
1542 # BEGIN RECEIVE ORGTBL table
1543 # END RECEIVE ORGTBL table
1544 #+ORGTBL: SEND table
1546 (orgtbl-send-table)))
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 |"
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.
1563 (org-test-with-temp-text "
1564 # BEGIN RECEIVE ORGTBL table
1565 # END RECEIVE ORGTBL table
1567 #+ORGTBL: SEND table orgtbl-to-orgtbl :hlines nil
1570 # BEGIN RECEIVE ORGTBL table
1571 # END RECEIVE ORGTBL table"
1573 (goto-char (point-min))
1574 (search-forward "| a |" nil t
3))))
1579 (ert-deftest test-org-table
/align
()
1580 "Test `org-table-align' specifications."
1584 (org-test-with-temp-text "| a |"
1587 ;; Preserve alignment.
1590 (org-test-with-temp-text " | a |"
1593 ;; Handle horizontal lines.
1595 (equal "| 123 |\n|-----|\n"
1596 (org-test-with-temp-text "| 123 |\n|-|"
1600 (equal "| a | b |\n|---+---|\n"
1601 (org-test-with-temp-text "| a | b |\n|-+-|"
1604 ;; Handle empty fields.
1606 (equal "| a | bc |\n| bcd | |\n"
1607 (org-test-with-temp-text "| a | bc |\n| bcd | |"
1611 (equal "| abc | bc |\n| | bcd |\n"
1612 (org-test-with-temp-text "| abc | bc |\n| | bcd |"
1615 ;; Handle missing fields.
1617 (equal "| a | b |\n| c | |\n"
1618 (org-test-with-temp-text "| a | b |\n| c |"
1622 (equal "| a | b |\n|---+---|\n"
1623 (org-test-with-temp-text "| a | b |\n|---|"
1626 ;; Alignment is done to the right when the ratio of numbers in the
1627 ;; column is superior to `org-table-number-fraction'.
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))
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))
1638 ;; Obey to alignment cookies.
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))
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))
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))
1655 (ert-deftest test-org-table
/align-buffer-tables
()
1656 "Align all tables when updating buffer."
1667 (should (equal (org-test-with-temp-text before
1668 (org-table-recalculate-buffer-tables)
1671 (should (equal (org-test-with-temp-text before
1672 (org-table-iterate-buffer-tables)
1679 (ert-deftest test-org-table
/sort-lines
()
1680 "Test `org-table-sort-lines' specifications."
1681 ;; Sort numerically.
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
)
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
)
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
))))
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
)
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
)
1708 ;; Sort alphabetically with case.
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
)
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)
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
)
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
)
1734 ;; Sort by time (HH:MM values)
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
)
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
)
1745 ;; Sort by time (durations)
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
)
1751 ;; Sort with custom functions.
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))
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))
1766 ;; Sort according to current column.
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
)
1772 ;; Sort between horizontal separators if possible.
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
)
1784 (ert-deftest test-org-table
/eval-formula
()
1785 "Test `org-table-eval-formula' specifications."
1786 ;; Error when not on a table field.
1788 (org-test-with-temp-text "Text"
1789 (org-table-eval-formula)))
1791 (org-test-with-temp-text "| a |\n|---|<point>"
1792 (org-table-eval-formula)))
1794 (org-test-with-temp-text "| a |\n#+TBLFM:<point>"
1795 (org-table-eval-formula)))
1796 ;; Handle @<, @>, $< and $>.
1798 (equal "| 1 |\n| 1 |"
1799 (org-test-with-temp-text "| <point> |\n| 1 |"
1800 (org-table-eval-formula nil
"@>" nil nil t
)
1803 (equal "| 1 |\n| 1 |"
1804 (org-test-with-temp-text "| 1 |\n| <point> |"
1805 (org-table-eval-formula nil
"@<" nil nil t
)
1809 (org-test-with-temp-text "| <point> | 1 |"
1810 (org-table-eval-formula nil
"$>" nil nil t
)
1814 (org-test-with-temp-text "| 1 | <point> |"
1815 (org-table-eval-formula nil
"$<" nil nil t
)
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.
1822 (org-test-with-temp-text "
1826 <point>#+TBLFM: @1$2=5"
1827 (let ((org-table-formula-create-columns nil
))
1828 (org-table-calc-current-TBLFM))
1830 :type
(list 'error
'user-error
))
1831 ;; If the variable is non-nil, field formulas and columns formulas
1832 ;; can create tables.
1840 (org-test-with-temp-text "
1844 <point>#+TBLFM: @1$2=5"
1845 (let ((org-table-formula-create-columns t
))
1846 (org-table-calc-current-TBLFM))
1855 (org-test-with-temp-text "
1859 <point>#+TBLFM: $3=15"
1860 (let ((org-table-formula-create-columns t
))
1861 (org-table-calc-current-TBLFM))
1864 (ert-deftest test-org-table
/duration
()
1865 "Test durations in table formulas."
1866 ;; Durations in cells.
1868 (string-match "| 2:12 | 1:47 | 03:59:00 |"
1869 (org-test-with-temp-text "
1871 <point>#+TBLFM: @1$3=$1+$2;T"
1872 (org-table-calc-current-TBLFM)
1875 (string-match "| 2:12 | 1:47 | 03:59 |"
1876 (org-test-with-temp-text "
1878 <point>#+TBLFM: @1$3=$1+$2;U"
1879 (org-table-calc-current-TBLFM)
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)
1888 ;; Durations set through properties.
1890 (string-match "| 16:00:00 |"
1891 (org-test-with-temp-text "* H
1893 :time_constant: 08:00:00
1897 <point>#+TBLFM: $1=2*$PROP_time_constant;T"
1898 (org-table-calc-current-TBLFM)
1901 (string-match "| 16.00 |"
1902 (org-test-with-temp-text "* H
1904 :time_constant: 08:00:00
1908 <point>#+TBLFM: $1=2*$PROP_time_constant;t"
1909 (org-table-calc-current-TBLFM)
1912 (ert-deftest test-org-table
/end-on-hline
()
1913 "Test with a table ending on a hline."
1916 (org-test-with-temp-text
1922 <point>#+TBLFM: @3$2..@3$>=vsum(@1..@2)"
1923 (org-table-calc-current-TBLFM)
1930 #+TBLFM: @3$2..@3$>=vsum(@1..@2)")))
1932 (ert-deftest test-org-table
/named-field
()
1933 "Test formula with a named field."
1937 (org-test-with-temp-text "
1940 <point>#+TBLFM: $name=1"
1941 (org-table-calc-current-TBLFM)
1946 (org-test-with-temp-text "
1949 <point>#+TBLFM: $name=1"
1950 (org-table-calc-current-TBLFM)
1953 (ert-deftest test-org-table
/named-column
()
1954 "Test formula with a named field."
1958 (org-test-with-temp-text "
1961 <point>#+TBLFM: @2$3=$name"
1962 (org-table-calc-current-TBLFM)
1965 (ert-deftest test-org-table
/formula-priority
()
1966 "Test field formula priority over column formula."
1967 ;; Field formulas bind stronger than column formulas.
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.
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))))))
1986 (ert-deftest test-org-table
/tab-indent
()
1987 "Test named fields with tab indentation."
1991 (org-test-with-temp-text
1993 | ! | sum | | a | b | c |
1994 |---+------+------+---+----+-----|
1995 | # | 1011 | 1000 | 1 | 10 | 100 |
1996 <point>#+TBLFM: $2=$a+$b+$c
1998 (org-table-calc-current-TBLFM)
2001 (ert-deftest test-org-table
/first-rc
()
2002 "Test \"$<\" and \"@<\" constructs in formulas."
2006 (org-test-with-temp-text
2008 <point>#+TBLFM: $<=1"
2009 (org-table-calc-current-TBLFM)
2014 (org-test-with-temp-text
2016 <point>#+TBLFM: @2$1=@<"
2017 (org-table-calc-current-TBLFM)
2020 (ert-deftest test-org-table
/last-rc
()
2021 "Test \"$>\" and \"@>\" constructs in formulas."
2025 (org-test-with-temp-text
2026 "| 2 | |\n<point>#+TBLFM: $>=1"
2027 (org-table-calc-current-TBLFM)
2032 (org-test-with-temp-text
2033 "| 2 |\n| |\n<point>#+TBLFM: @>$1=@<"
2034 (org-table-calc-current-TBLFM)
2037 (ert-deftest test-org-table
/time-stamps
()
2038 "Test time-stamps handling."
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)
2047 ;; Handle locale specific time-stamps.
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)
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.
2064 (org-test-with-temp-text
2067 |----------+---------|
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)
2085 |----------+-----------|
2087 |----------+-----------|
2088 | -0.50001 | too small |
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'.
2103 (org-test-with-temp-text
2111 <point>#+TBLFM: $2 = '(orgtbl-ascii-draw $1 0 3 3 \"$-\")"
2112 (org-table-calc-current-TBLFM)
2121 #+TBLFM: $2 = '(orgtbl-ascii-draw $1 0 3 3 \"$-\")")))
2123 (ert-deftest test-org-table
/single-rowgroup
()
2124 "Test column formula in a table with a single rowgroup."
2132 (org-test-with-temp-text "
2136 <point>#+TBLFM: $2=$1-1"
2137 (org-table-calc-current-TBLFM)
2144 (org-test-with-temp-text "
2146 <point>#+TBLFM: $2=$1-1"
2147 (org-table-calc-current-TBLFM)
2153 (ert-deftest test-org-table
/next-field
()
2154 "Test `org-table-next-field' specifications."
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.
2166 (org-test-with-temp-text "| a<point> |"
2167 (org-table-next-field)
2169 ;; Jump over hlines, if `org-table-tab-jumps-over-hlines' is
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.
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))
2186 (ert-deftest test-org-table
/previous-field
()
2187 "Test `org-table-previous-field' specifications."
2191 (org-test-with-temp-text "| a | <point>b |"
2192 (org-table-previous-field)
2196 (org-test-with-temp-text "| a |\n| <point>b |"
2197 (org-table-previous-field)
2199 ;; Find previous field across horizontal rules.
2202 (org-test-with-temp-text "| a |\n|---|\n| <point>b |"
2203 (org-table-previous-field)
2205 ;; When called on a horizontal rule, find previous data field.
2208 (org-test-with-temp-text "| a | b |\n|---+-<point>--|"
2209 (org-table-previous-field)
2211 ;; Error when at first field. Make sure to preserve original
2214 (org-test-with-temp-text "| <point> a|"
2215 (org-table-previous-field)))
2217 (org-test-with-temp-text "|---|\n| <point>a |"
2218 (org-table-previous-field)))
2221 (org-test-with-temp-text "|---|\n| <point>a |"
2222 (ignore-errors (org-table-previous-field))
2226 ;;; Inserting rows, inserting columns
2228 (ert-deftest test-org-table
/insert-column
()
2229 "Test `org-table-insert-column' specifications."
2230 ;; Error when outside a table.
2232 (org-test-with-temp-text "Paragraph"
2233 (org-table-insert-column)))
2234 ;; Insert new column after current one.
2237 (org-test-with-temp-text "| a |"
2238 (org-table-insert-column)
2241 (equal "| a | | b |\n"
2242 (org-test-with-temp-text "| <point>a | b |"
2243 (org-table-insert-column)
2245 ;; Move point into the newly created column.
2248 (org-test-with-temp-text "| <point>a |"
2249 (org-table-insert-column)
2250 (buffer-substring-no-properties (point) (line-end-position)))))
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.
2259 (org-test-with-temp-text "| a"
2260 (org-table-insert-column)
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.
2270 (org-test-with-temp-text " | a |"
2271 (org-table-insert-column)
2274 (equal " | a | | b |\n"
2275 (org-test-with-temp-text " | a | b |"
2276 (org-table-insert-column)
2281 ;;; Moving rows, moving columns
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
2288 (org-test-with-temp-text "| a |"
2289 (org-table-move-row-down)))
2291 (org-test-with-temp-text "| a |\n"
2292 (org-table-move-row-down)))
2294 (org-test-with-temp-text "| a |\n| <point>b |"
2295 (org-table-move-row-down)))
2298 (equal "| b |\n| a |\n"
2299 (org-test-with-temp-text "| a |\n| b |\n"
2300 (org-table-move-row-down)
2303 (equal "|---|\n| a |\n"
2304 (org-test-with-temp-text "| a |\n|---|\n"
2305 (org-table-move-row-down)
2309 (equal "| b |\n|---|\n"
2310 (org-test-with-temp-text "|---|\n| b |\n"
2311 (org-table-move-row-down)
2314 (equal "|---|\n|---|\n"
2315 (org-test-with-temp-text "|---|\n|---|\n"
2316 (org-table-move-row-down)
2318 ;; Move rows even without a final newline.
2320 (equal "| b |\n| a |\n"
2321 (org-test-with-temp-text "| a |\n| b |"
2322 (org-table-move-row-down)
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
2330 (org-test-with-temp-text "| a |"
2331 (org-table-move-row-up)))
2333 (org-test-with-temp-text "| a |\n"
2334 (org-table-move-row-up)))
2337 (equal "| b |\n| a |\n"
2338 (org-test-with-temp-text "| a |\n| <point>b |\n"
2339 (org-table-move-row-up)
2342 (equal "| b |\n|---|\n"
2343 (org-test-with-temp-text "|---|\n| <point>b |\n"
2344 (org-table-move-row-up)
2348 (equal "|---|\n| a |\n"
2349 (org-test-with-temp-text "| a |\n|<point>---|\n"
2350 (org-table-move-row-up)
2353 (equal "|---|\n|---|\n"
2354 (org-test-with-temp-text "|---|\n|<point>---|\n"
2355 (org-table-move-row-up)
2357 ;; Move rows even without a final newline.
2359 (equal "| b |\n| a |\n"
2360 (org-test-with-temp-text "| a |\n| <point>b |"
2361 (org-table-move-row-up)
2368 (ert-deftest test-org-table
/toggle-column-width
()
2369 "Test `org-table-toggle-columns-width' specifications."
2370 ;; Error when not at a column.
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'.
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
))))
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.
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))))
2393 ;; When column is already shrunk, expand it, i.e., remove overlays.
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))))
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
2408 (org-test-with-temp-text "| <3> |\n| <point>abcd |"
2409 (org-table-toggle-column-width)
2410 (buffer-substring (line-beginning-position)
2412 (car (overlays-in (line-beginning-position)
2413 (line-end-position))))))))
2416 (org-test-with-temp-text "| <3> |\n| <point>a |"
2417 (org-table-toggle-column-width)
2418 (buffer-substring (line-beginning-position)
2420 (car (overlays-in (line-beginning-position)
2421 (line-end-position))))))))
2423 (equal (concat "----" org-table-shrunk-column-indicator
)
2424 (org-test-with-temp-text "| <3> |\n|--<point>----|"
2425 (org-table-toggle-column-width)
2427 (car (overlays-in (line-beginning-position)
2428 (line-end-position)))
2430 ;; Width only takes into account visible characters.
2433 (org-test-with-temp-text "| <4> |\n| <point>[[http://orgmode.org]] |"
2434 (org-table-toggle-column-width)
2435 (buffer-substring (line-beginning-position)
2437 (car (overlays-in (line-beginning-position)
2438 (line-end-position))))))))
2439 ;; Before the first column or after the last one, ask for columns
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)
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)
2455 ;; When optional argument ARG is a string, toggle specified columns.
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
))))
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)))
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)))
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)))
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)))
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)))
2497 ;; When ARG is (16), remove any column overlay.
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))))
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)))))
2509 (ert-deftest test-org-table
/shrunk-columns
()
2510 "Test behaviour of shrunk column."
2511 ;; Edition automatically expands a shrunk column.
2513 (org-test-with-temp-text "| <point>a |"
2514 (org-table-toggle-column-width)
2516 (overlays-in (point-min) (point-max))))
2517 ;; Other columns are not changed.
2519 (org-test-with-temp-text "| <point>a | b |"
2520 (org-table-toggle-column-width "-")
2522 (overlays-in (point-min) (point-max))))
2523 ;; Moving a shrunk column doesn't alter its state.
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
))))
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.
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)))
2545 ;; State is preserved upon deleting a column.
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)))
2554 ;; State is preserved upon deleting a row.
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)))
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)))
2571 ;; State is preserved upon inserting a row or hline.
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)))
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)))
2588 ;; State is preserved upon sorting a column for all the columns but
2589 ;; the one being sorted.
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)))
2598 ;; State is preserved upon replacing a field non-interactively.
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.
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))))
2616 (org-test-with-temp-text "| a | <point>b |"
2617 (org-table-toggle-column-width)
2619 (org-table-next-field)
2620 (overlay-get (car (overlays-at (point))) 'help-echo
))))
2621 ;; Aligning table doesn't alter shrunk state.
2624 (org-test-with-temp-text "| <point>a | b |"
2625 (org-table-toggle-column-width)
2627 (overlay-get (car (overlays-at (1+ (line-beginning-position))))
2631 (org-test-with-temp-text "|---+-----|\n| a | <point>b |"
2632 (org-table-toggle-column-width)
2634 (overlay-get (car (overlays-at (point)))
2639 (org-test-with-temp-text "|---+-----|\n| a | <point>b |"
2640 (org-table-toggle-column-width)
2642 (mapcar (lambda (o) (overlay-get o
'help-echo
))
2643 (overlays-in (line-beginning-position) (line-end-position)))))))
2649 (ert-deftest test-org-table
/current-column
()
2650 "Test `org-table-current-column' specifications."
2652 (= 1 (org-test-with-temp-text "| <point>a |"
2653 (org-table-current-column))))
2655 (= 1 (org-test-with-temp-text "|-<point>--|"
2656 (org-table-current-column))))
2658 (= 2 (org-test-with-temp-text "| 1 | <point>2 |"
2659 (org-table-current-column))))
2661 (= 2 (org-test-with-temp-text "|---+-<point>--|"
2662 (org-table-current-column)))))
2664 (ert-deftest test-org-table
/get-field
()
2665 "Test `org-table-get-field' specifications."
2669 (org-test-with-temp-text "| <point>a |" (org-table-get-field))))
2670 ;; Get field in open last column.
2673 (org-test-with-temp-text "| <point>a " (org-table-get-field))))
2677 (org-test-with-temp-text "|<point>|" (org-table-get-field))))
2680 (org-test-with-temp-text "| <point>|" (org-table-get-field))))
2681 ;; Outside the table, return the empty string.
2684 (org-test-with-temp-text "<point>| a |" (org-table-get-field))))
2687 (org-test-with-temp-text "| a |<point>" (org-table-get-field))))
2688 ;; With optional N argument, select a particular column in current
2692 (org-test-with-temp-text "| 1 | 2 | 3 |" (org-table-get-field 3))))
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.
2700 (org-test-with-temp-text "| <point>1 |"
2701 (org-table-get-field nil
" foo ")
2704 (equal "| 1 | 2 | foo |"
2705 (org-test-with-temp-text "| 1 | 2 | 3 |"
2706 (org-table-get-field 3 " foo ")
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.
2715 (org-test-with-temp-text "| <point>1 |"
2716 (org-table-get-field nil
"")
2718 ;; When using REPLACE still return old value.
2721 (org-test-with-temp-text "| <point>1 |"
2722 (org-table-get-field nil
" foo ")))))
2724 (provide 'test-org-table
)
2726 ;;; test-org-table.el ends here