test-org-archive.el 5.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141
  1. ;;; test-org-archive.el --- Test for Org Archive -*- lexical-binding: t; -*-
  2. ;; Copyright (C) 2017 Jay Kamat
  3. ;; Author: Jay Kamat <jaygkamat@gmail.com>
  4. ;; This program is free software; you can redistribute it and/or modify
  5. ;; it under the terms of the GNU General Public License as published by
  6. ;; the Free Software Foundation, either version 3 of the License, or
  7. ;; (at your option) any later version.
  8. ;; This program is distributed in the hope that it will be useful,
  9. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. ;; GNU General Public License for more details.
  12. ;; You should have received a copy of the GNU General Public License
  13. ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
  14. ;;; Code:
  15. (ert-deftest test-org-archive/update-status-cookie ()
  16. "Test archiving properly updating status cookies."
  17. ;; Test org-archive-subtree with two children.
  18. (should
  19. (equal
  20. "Top [0%]"
  21. (org-test-with-temp-text-in-file
  22. "* Top [%]\n** DONE One\n** TODO Two"
  23. (forward-line)
  24. (org-archive-subtree)
  25. (forward-line -1)
  26. (org-element-property :title (org-element-at-point)))))
  27. ;; Test org-archive-subtree with one child.
  28. (should
  29. (equal
  30. "Top [100%]"
  31. (org-test-with-temp-text-in-file "* Top [%]\n** TODO Two"
  32. (forward-line)
  33. (org-archive-subtree)
  34. (forward-line -1)
  35. (org-element-property :title (org-element-at-point)))))
  36. ;; Test org-archive-to-archive-sibling with two children.
  37. (should
  38. (equal
  39. "Top [100%]"
  40. (org-test-with-temp-text "* Top [%]\n<point>** TODO One\n** DONE Two"
  41. (org-archive-to-archive-sibling)
  42. (forward-line -1)
  43. (org-element-property :title (org-element-at-point)))))
  44. ;; Test org-archive-to-archive-sibling with two children.
  45. (should
  46. (equal
  47. "Top [0%]"
  48. (org-test-with-temp-text "* Top [%]\n<point>** DONE Two"
  49. (org-archive-to-archive-sibling)
  50. (forward-line -1)
  51. (org-element-property :title (org-element-at-point))))))
  52. (ert-deftest test-org-archive/to-archive-sibling ()
  53. "Test `org-archive-to-archive-sibling' specifications."
  54. ;; Archive sibling before or after archive heading.
  55. (should
  56. (equal "* Archive :ARCHIVE:\n** H\n"
  57. (org-test-with-temp-text "* H\n* Archive :ARCHIVE:\n"
  58. (let ((org-archive-sibling-heading "Archive")
  59. (org-archive-tag "ARCHIVE"))
  60. (org-archive-to-archive-sibling)
  61. (goto-char (point-min))
  62. (buffer-substring-no-properties
  63. (point) (line-beginning-position 3))))))
  64. (should
  65. (equal "* Archive :ARCHIVE:\n** H\n"
  66. (org-test-with-temp-text "* Archive :ARCHIVE:\n<point>* H\n"
  67. (let ((org-archive-sibling-heading "Archive")
  68. (org-archive-tag "ARCHIVE"))
  69. (org-archive-to-archive-sibling)
  70. (goto-char (point-min))
  71. (buffer-substring-no-properties
  72. (point) (line-beginning-position 3))))))
  73. ;; When there is no sibling archive heading, create it.
  74. (should
  75. (equal "* Archive :ARCHIVE:\n** H\n"
  76. (org-test-with-temp-text "* H\n"
  77. (let ((org-archive-sibling-heading "Archive")
  78. (org-archive-tag "ARCHIVE"))
  79. (org-archive-to-archive-sibling)
  80. (goto-char (point-min))
  81. (buffer-substring-no-properties
  82. (point) (line-beginning-position 3))))))
  83. ;; Ignore non-sibling archive headings.
  84. (should
  85. (equal "* Archive :ARCHIVE:\n* Top\n** Archive :ARCHIVE:\n*** H\n"
  86. (org-test-with-temp-text "* Archive :ARCHIVE:\n* Top\n<point>** H\n"
  87. (let ((org-archive-sibling-heading "Archive")
  88. (org-archive-tag "ARCHIVE"))
  89. (org-archive-to-archive-sibling)
  90. (goto-char (point-min))
  91. (buffer-substring-no-properties
  92. (point) (line-beginning-position 5))))))
  93. ;; When archiving a heading, leave point on next heading.
  94. (should
  95. (equal "* H2"
  96. (org-test-with-temp-text "* H1\n* H2\n* Archive :ARCHIVE:\n"
  97. (let ((org-archive-sibling-heading "Archive")
  98. (org-archive-tag "ARCHIVE"))
  99. (org-archive-to-archive-sibling)
  100. (buffer-substring-no-properties (point) (line-end-position))))))
  101. (should
  102. (equal "* H2"
  103. (org-test-with-temp-text "* Archive :ARCHIVE:\n<point>* H1\n* H2\n"
  104. (let ((org-archive-sibling-heading "Archive")
  105. (org-archive-tag "ARCHIVE"))
  106. (org-archive-to-archive-sibling)
  107. (buffer-substring-no-properties (point) (line-end-position))))))
  108. ;; If `org-archive-reversed-order' is nil, archive as the last
  109. ;; child. Otherwise, archive as the first one.
  110. (should
  111. (equal "* Archive :ARCHIVE:\n** A\n"
  112. (org-test-with-temp-text "* H\n* Archive :ARCHIVE:\n** A\n"
  113. (let ((org-archive-sibling-heading "Archive")
  114. (org-archive-tag "ARCHIVE")
  115. (org-archive-reversed-order nil))
  116. (org-archive-to-archive-sibling)
  117. (goto-char (point-min))
  118. (buffer-substring-no-properties
  119. (point) (line-beginning-position 3))))))
  120. (should
  121. (equal "* Archive :ARCHIVE:\n** H\n"
  122. (org-test-with-temp-text "* H\n* Archive :ARCHIVE:\n** A\n"
  123. (let ((org-archive-sibling-heading "Archive")
  124. (org-archive-tag "ARCHIVE")
  125. (org-archive-reversed-order t))
  126. (org-archive-to-archive-sibling)
  127. (goto-char (point-min))
  128. (buffer-substring-no-properties
  129. (point) (line-beginning-position 3)))))))
  130. (provide 'test-org-archive)
  131. ;;; test-org-archive.el ends here