Tiny refactoring
[org-mode.git] / testing / lisp / test-org-colview.el
blobf81dfa144ef8e7cca38b54f682bac4fed16e9fc1
1 ;;; test-org-colview.el --- Tests for org-colview.el -*- lexical-binding: t; -*-
3 ;; Copyright (C) 2016 Nicolas Goaziou
5 ;; Author: Nicolas Goaziou <mail@nicolasgoaziou.fr>
7 ;; This program is free software; you can redistribute it and/or modify
8 ;; it under the terms of the GNU General Public License as published by
9 ;; the Free Software Foundation, either version 3 of the License, or
10 ;; (at your option) any later version.
12 ;; This program is distributed in the hope that it will be useful,
13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 ;; GNU General Public License for more details.
17 ;; You should have received a copy of the GNU General Public License
18 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
20 ;;; Code:
22 ;;; Column view
24 (require 'cl-lib)
26 (ert-deftest test-org-colview/get-format ()
27 "Test `org-columns-get-format' specifications."
28 ;; Without any clue, use `org-columns-default-format'.
29 (should
30 (equal "%A"
31 (org-test-with-temp-text "* H"
32 (let ((org-columns-default-format "%A"))
33 (org-columns-get-format)))))
34 ;; If COLUMNS keyword is set, use it.
35 (should
36 (equal "%B"
37 (org-test-with-temp-text "#+COLUMNS: %B\n* H"
38 (let ((org-columns-default-format "%A"))
39 (org-columns-get-format)))))
40 (should
41 (equal "%B"
42 (org-test-with-temp-text "#+columns: %B\n* H"
43 (let ((org-columns-default-format "%A"))
44 (org-columns-get-format)))))
45 (should
46 (equal "%B"
47 (org-test-with-temp-text "* H\n#+COLUMNS: %B"
48 (let ((org-columns-default-format "%A"))
49 (org-columns-get-format)))))
50 ;; When :COLUMNS: property is set somewhere in the tree, use it over
51 ;; the previous ways.
52 (should
53 (equal
54 "%C"
55 (org-test-with-temp-text
56 "#+COLUMNS: %B\n* H\n:PROPERTIES:\n:COLUMNS: %C\n:END:\n** S\n<point>"
57 (let ((org-columns-default-format "%A"))
58 (org-columns-get-format)))))
59 ;; When optional argument is provided, prefer it.
60 (should
61 (equal
62 "%D"
63 (org-test-with-temp-text
64 "#+COLUMNS: %B\n* H\n:PROPERTIES:\n:COLUMNS: %C\n:END:\n** S\n<point>"
65 (let ((org-columns-default-format "%A"))
66 (org-columns-get-format "%D"))))))
68 (ert-deftest test-org-colview/columns-scope ()
69 "Test `org-columns' scope."
70 ;; Before the first headline, view all document.
71 (should
72 (equal
73 '("H1" "H2" "H3")
74 (org-test-with-temp-text "Top\n* H1\n** H2\n* H3"
75 (let ((org-columns-default-format "%ITEM")) (org-columns))
76 (org-map-entries
77 (lambda () (get-char-property (point) 'org-columns-value))))))
78 ;; When :COLUMNS: is set up in the hierarchy, view tree starting
79 ;; there.
80 (should
81 (equal
82 '(nil "H2" "H3" nil)
83 (org-test-with-temp-text
84 "* H1\n** H2\n:PROPERTIES:\n:COLUMNS: %ITEM\n:END:\n*** <point>H3\n* H4"
85 (let ((org-columns-default-format "%ITEM")) (org-columns))
86 (org-map-entries
87 (lambda () (get-char-property (point) 'org-columns-value))))))
88 ;; Otherwise, view tree starting at the current headline.
89 (should
90 (equal
91 '(nil "H2" "H3" nil)
92 (org-test-with-temp-text "Top\n* H1\n** <point>H2\n*** H3\n* H4"
93 (let ((org-columns-default-format "%ITEM")) (org-columns))
94 (org-map-entries
95 (lambda () (get-char-property (point) 'org-columns-value))))))
96 ;; With a non-nil prefix argument, always view all document.
97 (should
98 (equal
99 '("H1" "H2" "H3" "H4")
100 (org-test-with-temp-text
101 "* H1\n** H2\n:PROPERTIES:\n:COLUMNS: %ITEM\n:END:\n*** <point>H3\n* H4"
102 (let ((org-columns-default-format "%ITEM")) (org-columns t))
103 (org-map-entries
104 (lambda () (get-char-property (point) 'org-columns-value))))))
105 (should
106 (equal
107 '("H1" "H2" "H3" "H4")
108 (org-test-with-temp-text "Top\n* H1\n** <point>H2\n*** H3\n* H4"
109 (let ((org-columns-default-format "%ITEM")) (org-columns t))
110 (org-map-entries
111 (lambda () (get-char-property (point) 'org-columns-value)))))))
113 (ert-deftest test-org-colview/columns-width ()
114 "Test `org-columns' column widths."
115 ;; When a width is specified in the format, use it.
116 (should
117 (= 9
118 (org-test-with-temp-text "* H"
119 (let ((org-columns-default-format "%9ITEM")) (org-columns))
120 (aref org-columns-current-maxwidths 0))))
121 ;; Otherwise, use the width of the largest value in the column.
122 (should
123 (= 2
124 (org-test-with-temp-text
125 "* H\n:PROPERTIES:\n:P: X\n:END:\n** H2\n:PROPERTIES:\n:P: XX\n:END:"
126 (let ((org-columns-default-format "%P")) (org-columns))
127 (aref org-columns-current-maxwidths 0))))
128 ;; If the title is wider than the widest value, use title width
129 ;; instead.
130 (should
131 (= 4
132 (org-test-with-temp-text "* H"
133 (let ((org-columns-default-format "%ITEM")) (org-columns))
134 (aref org-columns-current-maxwidths 0))))
135 ;; Special case: stars do count for ITEM.
136 (should
137 (= 6
138 (org-test-with-temp-text "* Head"
139 (let ((org-columns-default-format "%ITEM")) (org-columns))
140 (aref org-columns-current-maxwidths 0))))
141 ;; Special case: width takes into account link narrowing in ITEM.
142 (should
143 (equal
144 '("* [123]" . 7)
145 (org-test-with-temp-text "* [[http://orgmode.org][123]]"
146 (let ((org-columns-default-format "%ITEM")) (org-columns))
147 (cons (get-char-property (point) 'org-columns-value-modified)
148 (aref org-columns-current-maxwidths 0)))))
149 ;; When a value is too wide for the current column, add ellipses.
150 ;; Take into consideration length of `org-columns-ellipses'.
151 (should
152 (equal "123.. |"
153 (org-test-with-temp-text "* H\n:PROPERTIES:\n:P: 123456\n:END:"
154 (let ((org-columns-default-format "%5P")
155 (org-columns-ellipses ".."))
156 (org-columns))
157 (org-trim (get-char-property (point) 'display)))))
158 (should
159 (equal "1234… |"
160 (org-test-with-temp-text "* H\n:PROPERTIES:\n:P: 123456\n:END:"
161 (let ((org-columns-default-format "%5P")
162 (org-columns-ellipses "…"))
163 (org-columns))
164 (org-trim (get-char-property (point) 'display))))))
166 (ert-deftest test-org-colview/columns-summary ()
167 "Test `org-columns' summary types."
168 ;; {+} and {+;format} add numbers.
169 (should
170 (equal
172 (org-test-with-temp-text
173 "* H
174 ** S1
175 :PROPERTIES:
176 :A: 1
177 :END:
178 ** S1
179 :PROPERTIES:
180 :A: 2
181 :END:"
182 (let ((org-columns-default-format "%A{+}")) (org-columns))
183 (get-char-property (point) 'org-columns-value-modified))))
184 (should
185 (equal
186 "3.0"
187 (org-test-with-temp-text
188 "* H
189 ** S1
190 :PROPERTIES:
191 :A: 1
192 :END:
193 ** S1
194 :PROPERTIES:
195 :A: 2
196 :END:"
197 (let ((org-columns-default-format "%A{+;%.1f}")) (org-columns))
198 (get-char-property (point) 'org-columns-value-modified))))
199 ;; {$} is a shortcut for {+;%.2f}.
200 (should
201 (equal
202 "3.60"
203 (org-test-with-temp-text
204 "* H
205 ** S1
206 :PROPERTIES:
207 :A: 1.50
208 :END:
209 ** S1
210 :PROPERTIES:
211 :A: 2.10
212 :END:"
213 (let ((org-columns-default-format "%A{$}")) (org-columns))
214 (get-char-property (point) 'org-columns-value-modified))))
215 ;; {:} sums times. Plain numbers are hours.
216 (should
217 (equal
218 "4:10"
219 (org-test-with-temp-text
220 "* H
221 ** S1
222 :PROPERTIES:
223 :A: 1:30
224 :END:
225 ** S1
226 :PROPERTIES:
227 :A: 2:40
228 :END:"
229 (let ((org-columns-default-format "%A{:}")) (org-columns))
230 (get-char-property (point) 'org-columns-value-modified))))
231 (should
232 (equal
233 "3:30"
234 (org-test-with-temp-text
235 "* H
236 ** S1
237 :PROPERTIES:
238 :A: 1:30
239 :END:
240 ** S1
241 :PROPERTIES:
242 :A: 2
243 :END:"
244 (let ((org-columns-default-format "%A{:}")) (org-columns))
245 (get-char-property (point) 'org-columns-value-modified))))
246 ;; {X}, {X/} and {X%} indicate checkbox status.
247 (should
248 (equal
249 "[ ]"
250 (org-test-with-temp-text
251 "* H
252 ** S1
253 :PROPERTIES:
254 :A: [ ]
255 :END:
256 ** S1
257 :PROPERTIES:
258 :A: [ ]
259 :END:"
260 (let ((org-columns-default-format "%A{X}")) (org-columns))
261 (get-char-property (point) 'org-columns-value-modified))))
262 (should
263 (equal
264 "[-]"
265 (org-test-with-temp-text
266 "* H
267 ** S1
268 :PROPERTIES:
269 :A: [ ]
270 :END:
271 ** S1
272 :PROPERTIES:
273 :A: [X]
274 :END:"
275 (let ((org-columns-default-format "%A{X}")) (org-columns))
276 (get-char-property (point) 'org-columns-value-modified))))
277 (should
278 (equal
279 "[X]"
280 (org-test-with-temp-text
281 "* H
282 ** S1
283 :PROPERTIES:
284 :A: [X]
285 :END:
286 ** S1
287 :PROPERTIES:
288 :A: [X]
289 :END:"
290 (let ((org-columns-default-format "%A{X}")) (org-columns))
291 (get-char-property (point) 'org-columns-value-modified))))
292 (should
293 (equal
294 "[1/2]"
295 (org-test-with-temp-text
296 "* H
297 ** S1
298 :PROPERTIES:
299 :A: [ ]
300 :END:
301 ** S1
302 :PROPERTIES:
303 :A: [X]
304 :END:"
305 (let ((org-columns-default-format "%A{X/}")) (org-columns))
306 (get-char-property (point) 'org-columns-value-modified))))
307 (should
308 (equal
309 "[50%]"
310 (org-test-with-temp-text
311 "* H
312 ** S1
313 :PROPERTIES:
314 :A: [ ]
315 :END:
316 ** S1
317 :PROPERTIES:
318 :A: [X]
319 :END:"
320 (let ((org-columns-default-format "%A{X%}")) (org-columns))
321 (get-char-property (point) 'org-columns-value-modified))))
322 ;; {min} is the smallest number in column, {max} the largest one.
323 ;; {mean} is the arithmetic mean of numbers in column.
324 (should
325 (equal
326 "42"
327 (org-test-with-temp-text
328 "* H
329 ** S1
330 :PROPERTIES:
331 :A: 99
332 :END:
333 ** S1
334 :PROPERTIES:
335 :A: 42
336 :END:"
337 (let ((org-columns-default-format "%A{min}")) (org-columns))
338 (get-char-property (point) 'org-columns-value-modified))))
339 (should
340 (equal
341 "99"
342 (org-test-with-temp-text
343 "* H
344 ** S1
345 :PROPERTIES:
346 :A: 99
347 :END:
348 ** S1
349 :PROPERTIES:
350 :A: 42
351 :END:"
352 (let ((org-columns-default-format "%A{max}")) (org-columns))
353 (get-char-property (point) 'org-columns-value-modified))))
354 (should
355 (equal
356 "51.0"
357 (org-test-with-temp-text
358 "* H
359 ** S1
360 :PROPERTIES:
361 :A: 60
362 :END:
363 ** S1
364 :PROPERTIES:
365 :A: 42
366 :END:"
367 (let ((org-columns-default-format "%A{mean}")) (org-columns))
368 (get-char-property (point) 'org-columns-value-modified))))
369 ;; {:min}, {:max} and {:mean} apply to time values.
370 (should
371 (equal
372 "1:20"
373 (org-test-with-temp-text
374 "* H
375 ** S1
376 :PROPERTIES:
377 :A: 4:40
378 :END:
379 ** S1
380 :PROPERTIES:
381 :A: 1:20
382 :END:"
383 (let ((org-columns-default-format "%A{:min}")) (org-columns))
384 (get-char-property (point) 'org-columns-value-modified))))
385 (should
386 (equal
387 "4:40"
388 (org-test-with-temp-text
389 "* H
390 ** S1
391 :PROPERTIES:
392 :A: 4:40
393 :END:
394 ** S1
395 :PROPERTIES:
396 :A: 1:20
397 :END:"
398 (let ((org-columns-default-format "%A{:max}")) (org-columns))
399 (get-char-property (point) 'org-columns-value-modified))))
400 (should
401 (equal
402 "3:00"
403 (org-test-with-temp-text
404 "* H
405 ** S1
406 :PROPERTIES:
407 :A: 4:40
408 :END:
409 ** S1
410 :PROPERTIES:
411 :A: 1:20
412 :END:"
413 (let ((org-columns-default-format "%A{:mean}")) (org-columns))
414 (get-char-property (point) 'org-columns-value-modified))))
415 ;; {@min}, {@max} and {@mean} apply to ages.
416 (should
417 (equal
418 "0d 00h 0m 0s"
419 (cl-letf (((symbol-function 'current-time)
420 (lambda ()
421 (apply #'encode-time
422 (org-parse-time-string "<2014-03-04 Tue>")))))
423 (org-test-with-temp-text
424 "* H
425 ** S1
426 :PROPERTIES:
427 :A: <2012-03-29 Thu>
428 :END:
429 ** S1
430 :PROPERTIES:
431 :A: <2014-03-04 Tue>
432 :END:"
433 (let ((org-columns-default-format "%A{@min}")) (org-columns))
434 (get-char-property (point) 'org-columns-value-modified)))))
435 (should
436 (equal
437 "705d 01h 0m 0s"
438 (cl-letf (((symbol-function 'current-time)
439 (lambda ()
440 (apply #'encode-time
441 (org-parse-time-string "<2014-03-04 Tue>")))))
442 (org-test-with-temp-text
443 "* H
444 ** S1
445 :PROPERTIES:
446 :A: <2012-03-29 Thu>
447 :END:
448 ** S1
449 :PROPERTIES:
450 :A: <2014-03-04 Tue>
451 :END:"
452 (let ((org-columns-default-format "%A{@max}")) (org-columns))
453 (get-char-property (point) 'org-columns-value-modified)))))
454 (should
455 (equal
456 "352d 12h 30m 0s"
457 (cl-letf (((symbol-function 'current-time)
458 (lambda ()
459 (apply #'encode-time
460 (org-parse-time-string "<2014-03-04 Tue>")))))
461 (org-test-with-temp-text
462 "* H
463 ** S1
464 :PROPERTIES:
465 :A: <2012-03-29 Thu>
466 :END:
467 ** S1
468 :PROPERTIES:
469 :A: <2014-03-04 Tue>
470 :END:"
471 (let ((org-columns-default-format "%A{@mean}")) (org-columns))
472 (get-char-property (point) 'org-columns-value-modified)))))
473 ;; If a time value is expressed as a duration, return a duration.
474 ;; If any of them follows H:MM:SS pattern, use it too.
475 (should
476 (equal
477 "1d 4:20"
478 (org-test-with-temp-text
479 "* H
480 ** S1
481 :PROPERTIES:
482 :A: 3d 3h
483 :END:
484 ** S1
485 :PROPERTIES:
486 :A: 1:20
487 :END:"
488 (let ((org-columns-default-format "%A{:}")
489 (org-time-clocksum-use-fractional nil)
490 (org-time-clocksum-format
491 '(:days "%dd " :hours "%d" :minutes ":%02d")))
492 (org-columns))
493 (get-char-property (point) 'org-columns-value-modified))))
494 (should
495 (equal
496 "6:00:10"
497 (org-test-with-temp-text
498 "* H
499 ** S1
500 :PROPERTIES:
501 :A: 4:40:10
502 :END:
503 ** S1
504 :PROPERTIES:
505 :A: 1:20
506 :END:"
507 (let ((org-columns-default-format "%A{:}")) (org-columns))
508 (get-char-property (point) 'org-columns-value-modified))))
509 ;; @min, @max and @mean also accept regular duration in
510 ;; a "?d ?h ?m ?s" format.
511 (should
512 (equal
513 "1d 10h 0m 0s"
514 (org-test-with-temp-text
515 "* H
516 ** S1
517 :PROPERTIES:
518 :A: 1d 10h 0m 0s
519 :END:
520 ** S1
521 :PROPERTIES:
522 :A: 5d 3h 0m 0s
523 :END:"
524 (let ((org-columns-default-format "%A{@min}")) (org-columns))
525 (get-char-property (point) 'org-columns-value-modified))))
526 ;; {est+} gives a low-high estimate using mean and standard
527 ;; deviation.
528 (should
529 (equal
530 "3-17"
531 (org-test-with-temp-text
532 "* H
533 ** S1
534 :PROPERTIES:
535 :A: 0-10
536 :END:
537 ** S1
538 :PROPERTIES:
539 :A: 0-10
540 :END:"
541 (let ((org-columns-default-format "%A{est+}")) (org-columns))
542 (get-char-property (point) 'org-columns-value-modified))))
543 ;; When using {est+} summary, a single number is understood as
544 ;; a degenerate range.
545 (should
546 (equal
547 "4-4"
548 (org-test-with-temp-text
549 "* H
550 ** S1
551 :PROPERTIES:
552 :A: 4
553 :END:
555 (let ((org-columns-default-format "%A{est+}")) (org-columns))
556 (get-char-property (point) 'org-columns-value-modified))))
557 ;; Allow custom summary types.
558 (should
559 (equal
560 "1|2"
561 (org-test-with-temp-text
562 "* H
563 ** S1
564 :PROPERTIES:
565 :A: 1
566 :END:
567 ** S1
568 :PROPERTIES:
569 :A: 2
570 :END:"
571 (let ((org-columns-summary-types
572 '(("custom" . (lambda (s _) (mapconcat #'identity s "|")))))
573 (org-columns-default-format "%A{custom}")) (org-columns))
574 (get-char-property (point) 'org-columns-value-modified))))
575 ;; Allow multiple summary types applied to the same property.
576 (should
577 (equal
578 '("42" "99")
579 (org-test-with-temp-text
580 "* H
581 ** S1
582 :PROPERTIES:
583 :A: 99
584 :END:
585 ** S1
586 :PROPERTIES:
587 :A: 42
588 :END:"
589 (let ((org-columns-default-format "%A{min} %A{max}")) (org-columns))
590 (list (get-char-property (point) 'org-columns-value-modified)
591 (get-char-property (1+ (point)) 'org-columns-value-modified)))))
592 ;; Allow mixing both summarized and non-summarized columns for
593 ;; a property. However, the first column takes precedence and
594 ;; updates the value.
595 (should
596 (equal
597 '("1000" "42")
598 (org-test-with-temp-text
599 "* H
600 :PROPERTIES:
601 :A: 1000
602 :END:
603 ** S1
604 :PROPERTIES:
605 :A: 99
606 :END:
607 ** S1
608 :PROPERTIES:
609 :A: 42
610 :END:"
611 (let ((org-columns-default-format "%A %A{min}")) (org-columns))
612 (list (get-char-property (point) 'org-columns-value-modified)
613 (get-char-property (1+ (point)) 'org-columns-value-modified)))))
614 (should
615 (equal
616 '("42" "42")
617 (org-test-with-temp-text
618 "* H
619 :PROPERTIES:
620 :A: 1000
621 :END:
622 ** S1
623 :PROPERTIES:
624 :A: 99
625 :END:
626 ** S1
627 :PROPERTIES:
628 :A: 42
629 :END:"
630 (let ((org-columns-default-format "%A{min} %A")) (org-columns))
631 (list (get-char-property (point) 'org-columns-value-modified)
632 (get-char-property (1+ (point)) 'org-columns-value-modified))))))
634 (ert-deftest test-org-colview/columns-new ()
635 "Test `org-columns-new' specifications."
636 ;; Insert new column at the left of the current one.
637 (should
638 (equal '("FOO" "ITEM")
639 (org-test-with-temp-text "* H"
640 (let ((org-columns-default-format "%ITEM")) (org-columns))
641 (org-columns-new nil "FOO" "FOO" nil nil nil)
642 (list (get-char-property (point) 'org-columns-key)
643 (get-char-property (1+ (point)) 'org-columns-key)))))
644 (should
645 (equal '("ITEM" "FOO" "BAR")
646 (org-test-with-temp-text "* H"
647 (let ((org-columns-default-format "%ITEM %BAR")) (org-columns))
648 (forward-char)
649 (org-columns-new nil "FOO" "FOO" nil nil nil)
650 (list (get-char-property (1- (point)) 'org-columns-key)
651 (get-char-property (point) 'org-columns-key)
652 (get-char-property (1+ (point)) 'org-columns-key)))))
653 ;; Update #+COLUMNS keyword if needed.
654 (should
655 (equal "#+COLUMNS: %FOO %ITEM"
656 (org-test-with-temp-text "#+COLUMNS: %ITEM\n<point>* H"
657 (let ((org-columns-default-format "%ITEM")) (org-columns))
658 (org-columns-new nil "FOO" "FOO" nil nil nil)
659 (goto-char (point-min))
660 (buffer-substring-no-properties (point) (line-end-position)))))
661 (should
662 (equal "#+COLUMNS: %ITEM %FOO %BAR"
663 (org-test-with-temp-text "#+COLUMNS: %ITEM %BAR\n<point>* H"
664 (let ((org-columns-default-format "%ITEM %BAR")) (org-columns))
665 (forward-char)
666 (org-columns-new nil "FOO" "FOO" nil nil nil)
667 (goto-char (point-min))
668 (buffer-substring-no-properties (point) (line-end-position)))))
669 ;; Mind case when updating #+COLUMNS.
670 (should
671 (equal "#+COLUMNS: %ITEM %Foo %BAR"
672 (org-test-with-temp-text "#+COLUMNS: %ITEM %BAR\n<point>* H"
673 (let ((org-columns-default-format "%ITEM %BAR")) (org-columns))
674 (forward-char)
675 (org-columns-new nil "Foo" "Foo" nil nil nil)
676 (goto-char (point-min))
677 (buffer-substring-no-properties (point) (line-end-position)))))
678 (should
679 (equal "#+columns: %ITEM %Foo %BAR"
680 (org-test-with-temp-text "#+columns: %ITEM %BAR\n<point>* H"
681 (let ((org-columns-default-format "%ITEM %BAR")) (org-columns))
682 (forward-char)
683 (org-columns-new nil "Foo" "Foo" nil nil nil)
684 (goto-char (point-min))
685 (buffer-substring-no-properties (point) (line-end-position)))))
686 ;; Also update :COLUMNS: properties.
687 (should
688 (equal "%FOO %ITEM"
689 (org-test-with-temp-text "* H\n:PROPERTIES:\n:COLUMNS: %ITEM\n:END:"
690 (let ((org-columns-default-format "%ITEM")) (org-columns))
691 (org-columns-new nil "FOO" "FOO" nil nil nil)
692 (org-entry-get nil "COLUMNS"))))
693 ;; If no keyword nor any property is available, insert one.
694 (should
695 (string-match-p (regexp-quote "#+COLUMNS: %FOO %ITEM")
696 (org-test-with-temp-text "* H"
697 (let ((org-columns-default-format "%ITEM")) (org-columns))
698 (org-columns-new nil "FOO" "FOO" nil nil nil)
699 (buffer-string)))))
701 (ert-deftest test-org-colview/columns-update ()
702 "Test `org-columns-update' specifications."
703 ;; Update display.
704 (should
705 (equal
706 "12 |"
707 (org-test-with-temp-text
708 "* H
709 :PROPERTIES:
710 :A: 1
711 :END:
713 (let ((org-columns-default-format "%5A")) (org-columns))
714 (search-forward "1")
715 (insert "2")
716 (org-columns-update "A")
717 (get-char-property (point-min) 'display))))
718 ;; Update is case-insensitive.
719 (should
720 (equal
721 "12 |"
722 (org-test-with-temp-text
723 "* H
724 :PROPERTIES:
725 :A: 1
726 :END:
728 (let ((org-columns-default-format "%5A")) (org-columns))
729 (search-forward "1")
730 (insert "2")
731 (org-columns-update "a")
732 (get-char-property (point-min) 'display))))
733 ;; Update stored values.
734 (should
735 (equal
736 '("12" "12")
737 (org-test-with-temp-text
738 "* H
739 :PROPERTIES:
740 :A: 1
741 :END:
743 (let ((org-columns-default-format "%5A")) (org-columns))
744 (search-forward "1")
745 (insert "2")
746 (org-columns-update "A")
747 (list (get-char-property (point-min) 'org-columns-value)
748 (get-char-property (point-min) 'org-columns-value-modified)))))
749 ;; When multiple columns are using the same property, value is
750 ;; updated according to the specifications of the first one.
751 (should
752 (equal
754 (org-test-with-temp-text
755 "* H
756 :PROPERTIES:
757 :A: 1
758 :END:
759 ** S
760 :PROPERTIES:
761 :A: 2
762 :END:"
763 (let ((org-columns-default-format "%A{min} %A")) (org-columns))
764 (org-columns-update "A")
765 (org-entry-get nil "A"))))
766 (should
767 (equal
769 (org-test-with-temp-text
770 "* H
771 :PROPERTIES:
772 :A: 1
773 :END:
774 ** S
775 :PROPERTIES:
776 :A: 2
777 :END:"
778 (let ((org-columns-default-format "%A %A{min}")) (org-columns))
779 (org-columns-update "A")
780 (org-entry-get nil "A"))))
781 ;; Ensure modifications propagate in upper levels even when multiple
782 ;; summary types apply to the same property.
783 (should
784 (equal
785 '("1" "22")
786 (org-test-with-temp-text
787 "* H
788 ** S1
789 :PROPERTIES:
790 :A: 1
791 :END:
792 ** S2
793 :PROPERTIES:
794 :A: <point>2
795 :END:"
796 (save-excursion
797 (goto-char (point-min))
798 (let ((org-columns-default-format "%A{min} %A{max}")) (org-columns)))
799 (insert "2")
800 (org-columns-update "A")
801 (list (get-char-property 1 'org-columns-value)
802 (get-char-property 2 'org-columns-value-modified)))))
803 ;; Ensure additional processing is done (e.g., ellipses, special
804 ;; keywords fontification...).
805 (should
806 (equal
807 "ve.. |"
808 (org-test-with-temp-text
809 "* H
810 :PROPERTIES:
811 :A: text
812 :END:
814 (let ((org-columns-default-format "%4A")
815 (org-columns-ellipses ".."))
816 (org-columns))
817 (search-forward ":A: ")
818 (insert "very long ")
819 (org-columns-update "A")
820 (get-char-property (point-min) 'display))))
821 ;; Values obtained from inline tasks are at the same level as those
822 ;; obtained from children of the current node.
823 (when (featurep 'org-inlinetask)
824 (should
825 (equal
827 (org-test-with-temp-text
828 "* H
829 *************** Inline task
830 :PROPERTIES:
831 :A: 2
832 :END:
833 *************** END
834 ** Children
835 :PROPERTIES:
836 :A: 3
837 :END:
839 (let ((org-columns-default-format "%A{min}")
840 (org-columns-ellipses "..")
841 (org-inlinetask-min-level 15))
842 (org-columns))
843 (get-char-property (point-min) 'org-columns-value)))))
844 ;; Handle `org-columns-modify-value-for-display-function', even with
845 ;; multiple titles for the same property.
846 (should
847 (equal '("foo" "bar")
848 (org-test-with-temp-text "* H"
849 (let ((org-columns-default-format "%ITEM %ITEM(Name)")
850 (org-columns-modify-value-for-display-function
851 (lambda (title value)
852 (pcase title ("ITEM" "foo") ("Name" "bar") (_ "baz")))))
853 (org-columns))
854 (list (get-char-property 1 'org-columns-value-modified)
855 (get-char-property 2 'org-columns-value-modified))))))
857 (ert-deftest test-org-colview/columns-move-left ()
858 "Test `org-columns-move-left' specifications."
859 ;; Error when trying to move the left-most column.
860 (should-error
861 (org-test-with-temp-text "* H"
862 (let ((org-columns-default-format "%ITEM")) (org-columns))
863 (org-columns-move-left)))
864 ;; Otherwise, move column to left and update display.
865 (should
866 (equal '("2" "1")
867 (org-test-with-temp-text "* H\n:PROPERTIES:\n:A: 1\n:B: 2\n:END:"
868 (let ((org-columns-default-format "%A %B")) (org-columns))
869 (forward-char)
870 (org-columns-move-left)
871 (list (get-char-property (point) 'org-columns-value)
872 (get-char-property (1+ (point)) 'org-columns-value)))))
873 ;; Handle multiple columns with the same property.
874 (should
875 (equal '("2" "1")
876 (org-test-with-temp-text
877 "* H
878 ** S1
879 :PROPERTIES:
880 :A: 1
881 :END:
882 ** S1
883 :PROPERTIES:
884 :A: 2
885 :END:"
886 (let ((org-columns-default-format "%ITEM %A{min} %A{max}"))
887 (org-columns))
888 (forward-char 2)
889 (org-columns-move-left)
890 (list (get-char-property (point) 'org-columns-value)
891 (get-char-property (1+ (point)) 'org-columns-value)))))
892 ;; Special case: do not update values even if move entails changing
893 ;; them.
894 (should
895 (equal "1"
896 (org-test-with-temp-text
897 "* H
898 :PROPERTIES:
899 :A: 1
900 :END:
901 ** S1
902 :PROPERTIES:
903 :A: 99
904 :END:"
905 (let ((org-columns-default-format "%A %A{max}"))
906 (org-columns))
907 (forward-char)
908 (org-columns-move-left)
909 ;; Since the first column matching a given property
910 ;; determines how a value is computed, the following
911 ;; should return "99" instead. However, this behavior is
912 ;; in practice surprising so we just ignore the value
913 ;; change. It can be computed later.
914 (org-entry-get (point) "A")))))
916 (ert-deftest test-org-colview/columns-move-right ()
917 "Test `org-columns-move-right' specifications."
918 ;; Error when trying to move the right-most column.
919 (should-error
920 (org-test-with-temp-text "* H"
921 (let ((org-columns-default-format "%ITEM")) (org-columns))
922 (org-columns-move-right)))
923 ;; Otherwise, move column to left and update display.
924 (should
925 (equal '("2" "1")
926 (org-test-with-temp-text "* H\n:PROPERTIES:\n:A: 1\n:B: 2\n:END:"
927 (let ((org-columns-default-format "%A %B")) (org-columns))
928 (org-columns-move-right)
929 (list (get-char-property (1- (point)) 'org-columns-value)
930 (get-char-property (point) 'org-columns-value)))))
931 ;; Handle multiple columns with the same property.
932 (should
933 (equal '("2" "1")
934 (org-test-with-temp-text
935 "* H
936 ** S1
937 :PROPERTIES:
938 :A: 1
939 :END:
940 ** S1
941 :PROPERTIES:
942 :A: 2
943 :END:"
944 (let ((org-columns-default-format "%ITEM %A{min} %A{max}"))
945 (org-columns))
946 (forward-char)
947 (org-columns-move-right)
948 (list (get-char-property (1- (point)) 'org-columns-value)
949 (get-char-property (point) 'org-columns-value)))))
950 ;; Special case: do not update values even if move entails changing
951 ;; them.
952 (should
953 (equal "1"
954 (org-test-with-temp-text
955 "* H
956 :PROPERTIES:
957 :A: 1
958 :END:
959 ** S1
960 :PROPERTIES:
961 :A: 99
962 :END:"
963 (let ((org-columns-default-format "%A %A{max}"))
964 (org-columns))
965 (org-columns-move-right)
966 ;; See `test-org-colview/columns-move-left' for an
967 ;; explanation.
968 (org-entry-get (point) "A")))))
970 (ert-deftest test-org-colview/columns-next-allowed-value ()
971 "Test `org-columns-next-allowed-value' specifications."
972 ;; Cannot shift "ITEM" property.
973 (should-error
974 (org-test-with-temp-text "* H"
975 (let ((org-columns-default-format "%ITEM")) (org-columns))
976 (org-columns-next-allowed-value)))
977 ;; Throw an error when allowed values are not defined.
978 (should-error
979 (org-test-with-temp-text "* H\n:PROPERTIES:\n:A: 1\n:END:"
980 (let ((org-columns-default-format "%A")) (org-columns))
981 (org-columns-next-allowed-value)))
982 ;; Throw an error when there's only one value to select.
983 (should-error
984 (org-test-with-temp-text "* H\n:PROPERTIES:\n:A: 1\n:A_ALL: 1\n:END:"
985 (let ((org-columns-default-format "%A")) (org-columns))
986 (org-columns-next-allowed-value)))
987 ;; By default select the next allowed value. Where there is no more
988 ;; value, start again from first possible one.
989 (should
990 (equal "2"
991 (org-test-with-temp-text
992 "* H\n:PROPERTIES:\n:A: 1\n:A_ALL: 1 2 3\n:END:"
993 (let ((org-columns-default-format "%A")) (org-columns))
994 (org-columns-next-allowed-value)
995 (org-entry-get (point) "A"))))
996 (should
997 (equal "3"
998 (org-test-with-temp-text
999 "* H\n:PROPERTIES:\n:A: 2\n:A_ALL: 1 2 3\n:END:"
1000 (let ((org-columns-default-format "%A")) (org-columns))
1001 (org-columns-next-allowed-value)
1002 (org-entry-get (point) "A"))))
1003 (should
1004 (equal "1"
1005 (org-test-with-temp-text
1006 "* H\n:PROPERTIES:\n:A: 3\n:A_ALL: 1 2 3\n:END:"
1007 (let ((org-columns-default-format "%A")) (org-columns))
1008 (org-columns-next-allowed-value)
1009 (org-entry-get (point) "A"))))
1010 ;; PREVIOUS argument moves backward.
1011 (should
1012 (equal "1"
1013 (org-test-with-temp-text
1014 "* H\n:PROPERTIES:\n:A: 2\n:A_ALL: 1 2 3\n:END:"
1015 (let ((org-columns-default-format "%A")) (org-columns))
1016 (org-columns-next-allowed-value 'previous)
1017 (org-entry-get (point) "A"))))
1018 (should
1019 (equal "2"
1020 (org-test-with-temp-text
1021 "* H\n:PROPERTIES:\n:A: 3\n:A_ALL: 1 2 3\n:END:"
1022 (let ((org-columns-default-format "%A")) (org-columns))
1023 (org-columns-next-allowed-value 'previous)
1024 (org-entry-get (point) "A"))))
1025 (should
1026 (equal "3"
1027 (org-test-with-temp-text
1028 "* H\n:PROPERTIES:\n:A: 1\n:A_ALL: 1 2 3\n:END:"
1029 (let ((org-columns-default-format "%A")) (org-columns))
1030 (org-columns-next-allowed-value 'previous)
1031 (org-entry-get (point) "A"))))
1032 ;; Select Nth element with optional argument NTH.
1033 (should
1034 (equal "1"
1035 (org-test-with-temp-text
1036 "* H\n:PROPERTIES:\n:A: 2\n:A_ALL: 1 2 3\n:END:"
1037 (let ((org-columns-default-format "%A")) (org-columns))
1038 (org-columns-next-allowed-value nil 1)
1039 (org-entry-get (point) "A"))))
1040 ;; If NTH is negative, go backwards, 0 being the last one and -1 the
1041 ;; penultimate.
1042 (should
1043 (equal "3"
1044 (org-test-with-temp-text
1045 "* H\n:PROPERTIES:\n:A: 2\n:A_ALL: 1 2 3\n:END:"
1046 (let ((org-columns-default-format "%A")) (org-columns))
1047 (org-columns-next-allowed-value nil 0)
1048 (org-entry-get (point) "A"))))
1049 (should
1050 (equal "2"
1051 (org-test-with-temp-text
1052 "* H\n:PROPERTIES:\n:A: 2\n:A_ALL: 1 2 3\n:END:"
1053 (let ((org-columns-default-format "%A")) (org-columns))
1054 (org-columns-next-allowed-value nil -1)
1055 (org-entry-get (point) "A"))))
1056 ;; Throw an error if NTH is greater than the number of allowed
1057 ;; values.
1058 (should-error
1059 (org-test-with-temp-text
1060 "* H\n:PROPERTIES:\n:A: 2\n:A_ALL: 1 2 3\n:END:"
1061 (let ((org-columns-default-format "%A")) (org-columns))
1062 (org-columns-next-allowed-value nil 4)
1063 (org-entry-get (point) "A")))
1064 ;; Pathological case: when shifting the value alters the current
1065 ;; heading, make sure all columns are still at their correct
1066 ;; location.
1067 (should
1068 (equal '("H" "" "" "" "TODO")
1069 (let ((org-todo-keywords '((sequence "TODO" "DONE"))))
1070 (org-test-with-temp-text "* H"
1071 (let ((org-columns-default-format "%ITEM %A %B %C %TODO"))
1072 (org-columns)
1073 (forward-char 4)
1074 (org-columns-next-allowed-value)
1075 (list (get-char-property (- (point) 4) 'org-columns-value)
1076 (get-char-property (- (point) 3) 'org-columns-value)
1077 (get-char-property (- (point) 2) 'org-columns-value)
1078 (get-char-property (- (point) 1) 'org-columns-value)
1079 (get-char-property (point) 'org-columns-value)))))))
1080 (should
1081 (equal '("H" "VERYLONGTODO")
1082 (let ((org-todo-keywords '((sequence "TODO" "VERYLONGTODO"))))
1083 (org-test-with-temp-text "* TODO H"
1084 (let ((org-columns-default-format "%ITEM %TODO"))
1085 (org-columns)
1086 (forward-char)
1087 (org-columns-next-allowed-value)
1088 (list (get-char-property (- (point) 1) 'org-columns-value)
1089 (get-char-property (point) 'org-columns-value))))))))
1093 ;;; Dynamic block
1095 (ert-deftest test-org-colview/dblock ()
1096 "Test the column view table."
1097 (should
1098 (equal
1099 "#+BEGIN: columnview
1100 | ITEM |
1101 |------|
1102 | H |
1103 #+END:"
1104 (org-test-with-temp-text
1105 "* H\n<point>#+BEGIN: columnview\n#+END:"
1106 (let ((org-columns-default-format "%ITEM")) (org-update-dblock))
1107 (buffer-substring-no-properties (point) (point-max)))))
1108 (should
1109 (equal
1110 "#+BEGIN: columnview
1111 | ITEM | A |
1112 |------+---|
1113 | H | 1 |
1114 #+END:"
1115 (org-test-with-temp-text
1116 "* H\n:PROPERTIES:\n:A: 1\n:END:\n<point>#+BEGIN: columnview\n#+END:"
1117 (let ((org-columns-default-format "%ITEM %A")) (org-update-dblock))
1118 (buffer-substring-no-properties (point) (point-max)))))
1119 ;; Properties are case insensitive.
1120 (should
1121 (equal
1122 "#+BEGIN: columnview
1123 | a |
1124 |---|
1125 | 1 |
1126 #+END:"
1127 (org-test-with-temp-text
1128 "* H\n:PROPERTIES:\n:A: 1\n:END:\n<point>#+BEGIN: columnview\n#+END:"
1129 (let ((org-columns-default-format "%a")) (org-update-dblock))
1130 (buffer-substring-no-properties (point) (point-max)))))
1131 ;; Test titles given to columns.
1132 (should
1133 (equal
1134 "#+BEGIN: columnview
1135 | Name | Prop |
1136 |------+------|
1137 | H | 1 |
1138 #+END:"
1139 (org-test-with-temp-text
1140 "* H\n:PROPERTIES:\n:A: 1\n:END:\n<point>#+BEGIN: columnview\n#+END:"
1141 (let ((org-columns-default-format "%ITEM(Name) %A(Prop)"))
1142 (org-update-dblock))
1143 (buffer-substring-no-properties (point) (point-max)))))
1144 ;; Test `:id' parameter
1145 (should
1146 (equal
1147 "#+BEGIN: columnview :id local
1148 | ITEM |
1149 |------|
1150 | H1 |
1151 | H1.1 |
1152 #+END:
1154 (org-test-with-temp-text
1155 "* H1\n<point>#+BEGIN: columnview :id local\n#+END:\n** H1.1\n* H2"
1156 (let ((org-columns-default-format "%ITEM")) (org-update-dblock))
1157 (buffer-substring-no-properties (point) (outline-next-heading)))))
1158 (should
1159 (equal
1160 "#+BEGIN: columnview :id global
1161 | ITEM |
1162 |------|
1163 | H1 |
1164 | H1.1 |
1165 | H2 |
1166 #+END:
1168 (org-test-with-temp-text
1169 "\n* H1\n<point>#+BEGIN: columnview :id global\n#+END:\n** H1.1\n* H2"
1170 (let ((org-columns-default-format "%ITEM")) (org-update-dblock))
1171 (buffer-substring-no-properties (point) (outline-next-heading)))))
1172 ;; Test `:hlines' parameter.
1173 (should
1174 (equal
1175 "#+BEGIN: columnview :hlines t :id global
1176 | ITEM |
1177 |------|
1178 | H |
1179 |------|
1180 | H2 |
1181 |------|
1182 | H2.1 |
1183 #+END:\n"
1184 (org-test-with-temp-text
1187 <point>#+BEGIN: columnview :hlines t :id global
1188 #+END:
1189 * H2
1190 ** H2.1"
1191 (let ((org-columns-default-format "%ITEM")) (org-update-dblock))
1192 (buffer-substring-no-properties (point) (outline-next-heading)))))
1193 (should
1194 (equal
1195 "#+BEGIN: columnview :hlines 1 :id global
1196 | ITEM |
1197 |------|
1198 | H |
1199 |------|
1200 | H2 |
1201 | H2.1 |
1202 #+END:\n"
1203 (org-test-with-temp-text
1206 <point>#+BEGIN: columnview :hlines 1 :id global
1207 #+END:
1208 * H2
1209 ** H2.1"
1210 (let ((org-columns-default-format "%ITEM")) (org-update-dblock))
1211 (buffer-substring-no-properties (point) (outline-next-heading)))))
1212 (should
1213 (equal
1214 "#+BEGIN: columnview :hlines 1 :id \"id\"
1215 | ITEM |
1216 |------|
1217 | H2 |
1218 | H2.1 |
1219 #+END:
1221 (org-test-with-temp-text
1224 <point>#+BEGIN: columnview :hlines 1 :id \"id\"
1225 #+END:
1226 * H2
1227 :PROPERTIES:
1228 :ID: id
1229 :END:
1230 ** H2.1"
1231 (let ((org-columns-default-format "%ITEM")) (org-update-dblock))
1232 (buffer-substring-no-properties (point) (outline-next-heading)))))
1233 (should
1234 (equal
1235 "#+BEGIN: columnview :hlines 1 :id id
1236 | ITEM |
1237 |------|
1238 | H2 |
1239 | H2.1 |
1240 #+END:
1242 (org-test-with-temp-text
1245 <point>#+BEGIN: columnview :hlines 1 :id id
1246 #+END:
1247 * H2
1248 :PROPERTIES:
1249 :ID: id
1250 :END:
1251 ** H2.1"
1252 (let ((org-columns-default-format "%ITEM")) (org-update-dblock))
1253 (buffer-substring-no-properties (point) (outline-next-heading)))))
1254 ;; Test `:indent' parameter.
1255 (should
1256 (equal
1257 "#+BEGIN: columnview :indent t
1258 | ITEM |
1259 |----------|
1260 | H1 |
1261 | \\_ H1.1 |
1262 #+END:
1264 (org-test-with-temp-text
1265 "* H1\n<point>#+BEGIN: columnview :indent t\n#+END:\n** H1.1"
1266 (let ((org-columns-default-format "%ITEM")) (org-update-dblock))
1267 (buffer-substring-no-properties (point) (outline-next-heading)))))
1268 (should
1269 (equal
1270 "#+BEGIN: columnview :indent t
1271 | Prop | Name |
1272 |------+----------|
1273 | | H1 |
1274 | | \\_ H1.1 |
1275 #+END:
1277 (org-test-with-temp-text
1278 "* H1\n<point>#+BEGIN: columnview :indent t\n#+END:\n** H1.1"
1279 (let ((org-columns-default-format "%A(Prop) %ITEM(Name)"))
1280 (org-update-dblock))
1281 (buffer-substring-no-properties (point) (outline-next-heading)))))
1282 ;; Test `:vlines' parameter.
1283 (should
1284 (equal
1285 "#+BEGIN: columnview :vlines t
1286 | | ITEM | A |
1287 |---+------+----|
1288 | | H | 1 |
1289 | / | <> | <> |
1290 #+END:"
1291 (org-test-with-temp-text
1292 "* H\n:PROPERTIES:\n:A: 1\n:END:\n<point>#+BEGIN: columnview :vlines t\n#+END:"
1293 (let ((org-columns-default-format "%ITEM %A")) (org-update-dblock))
1294 (buffer-substring-no-properties (point) (point-max)))))
1295 ;; Test `:skip-empty-rows' parameter.
1296 (should
1297 (equal
1298 "#+BEGIN: columnview :skip-empty-rows t
1299 | ITEM | A |
1300 |------+---|
1301 | H1.1 | 1 |
1302 #+END:
1304 (org-test-with-temp-text
1306 * H1
1307 <point>#+BEGIN: columnview :skip-empty-rows t
1308 #+END:
1309 ** H1.1
1310 :PROPERTIES:
1311 :A: 1
1312 :END:"
1313 (let ((org-columns-default-format "%ITEM %A")) (org-update-dblock))
1314 (buffer-substring-no-properties (point) (outline-next-heading)))))
1315 ;; Test `:format' parameter.
1316 (should
1317 (equal
1318 "#+BEGIN: columnview :format \"%ITEM(Name)\"
1319 | Name |
1320 |------|
1321 | H |
1322 #+END:"
1323 (org-test-with-temp-text
1324 "* H\n<point>#+BEGIN: columnview :format \"%ITEM(Name)\"\n#+END:"
1325 (let ((org-columns-default-format "%ITEM")) (org-update-dblock))
1326 (buffer-substring-no-properties (point) (point-max)))))
1327 ;; Test `:width' parameter
1328 (should
1329 (equal
1330 "#+BEGIN: columnview :width t
1331 | ITEM | A |
1332 |------------+---|
1333 | H | |
1334 | <10> | |
1335 #+END:"
1336 (org-test-with-temp-text
1337 "* H\n<point>#+BEGIN: columnview :width t\n#+END:"
1338 (let ((org-columns-default-format "%10ITEM %A")) (org-update-dblock))
1339 (buffer-substring-no-properties (point) (point-max)))))
1340 ;; When inserting ITEM values, make sure to clean sensitive
1341 ;; contents, like unique targets or forbidden inline src-blocks.
1342 (should
1343 (equal
1344 "#+BEGIN: columnview
1345 | ITEM |
1346 |------|
1347 | H 1 |
1348 #+END:"
1349 (org-test-with-temp-text
1350 "* H <<target>> 1\n<point>#+BEGIN: columnview\n#+END:"
1351 (let ((org-columns-default-format "%ITEM")) (org-update-dblock))
1352 (buffer-substring-no-properties (point) (point-max)))))
1353 (should
1354 (equal
1355 "#+BEGIN: columnview
1356 | ITEM |
1357 |------|
1358 | H 1 |
1359 #+END:"
1360 (org-test-with-temp-text
1361 "* H src_emacs-lisp{(+ 1 1)} 1\n<point>#+BEGIN: columnview\n#+END:"
1362 (let ((org-columns-default-format "%ITEM")) (org-update-dblock))
1363 (buffer-substring-no-properties (point) (point-max))))))
1365 (provide 'test-org-colview)
1366 ;;; test-org-colview.el ends here