test-org-attach.el 6.3 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175
  1. ;;; test-org-attach.el --- tests for org-attach.el -*- lexical-binding: t; -*-
  2. ;; Copyright (C) 2017, 2019
  3. ;; Author: Marco Wahl
  4. ;; Keywords: internal
  5. ;; This program is free software; you can redistribute it and/or modify
  6. ;; it under the terms of the GNU General Public License as published by
  7. ;; the Free Software Foundation, either version 3 of the License, or
  8. ;; (at your option) any later version.
  9. ;; This program is distributed in the hope that it will be useful,
  10. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. ;; GNU General Public License for more details.
  13. ;; You should have received a copy of the GNU General Public License
  14. ;; along with this program. If not, see <https://www.gnu.org/licenses/>.
  15. ;;; Commentary:
  16. ;;
  17. ;;; Code:
  18. (require 'org-test "../testing/org-test")
  19. (require 'org-attach)
  20. (eval-and-compile (require 'cl-lib))
  21. (ert-deftest test-org-attach/dir ()
  22. "Test `org-attach-get' specifications."
  23. (let ((org-file-apps '((t . emacs))))
  24. (should (equal "Text in fileA\n"
  25. (org-test-in-example-file org-test-attachments-file
  26. (goto-char 157) ;; First attachment link
  27. (org-open-at-point)
  28. (buffer-string))))
  29. (should-not (equal "Text in fileB\n"
  30. (org-test-in-example-file org-test-attachments-file
  31. (goto-char 219) ;; Second attachment link
  32. (let ((org-attach-use-inheritance nil))
  33. (org-open-at-point)
  34. (buffer-string)))))
  35. (should (equal "Text in fileB\n"
  36. (org-test-in-example-file org-test-attachments-file
  37. (goto-char 219) ;; Second attachment link
  38. (let ((org-attach-use-inheritance t))
  39. (org-open-at-point)
  40. (buffer-string)))))
  41. (should-not (equal "att1"
  42. (org-test-in-example-file org-test-attachments-file
  43. (goto-char 179) ;; H1.1
  44. (let ((org-attach-use-inheritance nil))
  45. (org-attach-dir)))))
  46. (should (equal "att1"
  47. (org-test-in-example-file org-test-attachments-file
  48. (goto-char 179) ;; H1.1
  49. (let ((org-attach-use-inheritance t))
  50. (org-attach-dir)))))
  51. (should (equal '("fileC" "fileD")
  52. (org-test-in-example-file org-test-attachments-file
  53. (goto-char 239) ;; H1.2
  54. (org-attach-file-list (org-attach-dir)))))
  55. (should (equal '("fileC" "fileD")
  56. (org-test-in-example-file org-test-attachments-file
  57. (goto-char 239) ;; H1.2
  58. (org-attach-file-list (org-attach-dir)))))
  59. (should (equal '("fileE")
  60. (org-test-in-example-file org-test-attachments-file
  61. (goto-char 289) ;; H2
  62. (let ((org-attach-id-dir "data/"))
  63. (org-attach-file-list (org-attach-dir))))))
  64. (should (equal "peek-a-boo\n"
  65. (org-test-in-example-file org-test-attachments-file
  66. (goto-char 289) ;; H2
  67. (let ((org-attach-id-dir "data/"))
  68. (org-attach-open-in-emacs)
  69. (buffer-string)))))
  70. (should (equal '("fileA" "fileB")
  71. (org-test-in-example-file org-test-attachments-file
  72. (goto-char 336) ;; H3
  73. (org-attach-file-list (org-attach-dir)))))
  74. ;; Test for folder not initialized in the filesystem
  75. (should-not (org-test-in-example-file org-test-attachments-file
  76. (goto-char 401) ;; H3.1
  77. (let ((org-attach-use-inheritance nil)
  78. (org-attach-id-dir "data/"))
  79. (org-attach-dir))))
  80. ;; Not yet initialized folder should be found if no-fs-check is
  81. ;; non-nil
  82. (should (equal "data/ab/cd12345"
  83. (org-test-in-example-file org-test-attachments-file
  84. (goto-char 401) ;; H3.1
  85. (let ((org-attach-use-inheritance nil)
  86. (org-attach-id-dir "data/"))
  87. (file-relative-name (org-attach-dir nil t))))))
  88. (should (equal '("fileA" "fileB")
  89. (org-test-in-example-file org-test-attachments-file
  90. (goto-char 401) ;; H3.1
  91. (let ((org-attach-use-inheritance t))
  92. ;; This is where it gets a bit sketchy...! DIR always has
  93. ;; priority over ID, even if ID is declared "higher up" in the
  94. ;; tree. This can potentially be revised. But it is also
  95. ;; pretty clean. DIR is always higher in priority than ID right
  96. ;; now, no matter the depth in the tree.
  97. (org-attach-file-list (org-attach-dir))))))))
  98. (ert-deftest test-org-attach/dired-attach-to-next-best-subtree/1 ()
  99. "Attach file at point in dired to subtree."
  100. (should
  101. (let ((a-filename (make-temp-file "a")) ; file is an attach candidate.
  102. (org-attach-id-dir "data/"))
  103. (unwind-protect
  104. (org-test-with-temp-text-in-file
  105. "* foo :foo:"
  106. (split-window)
  107. (let ((org-buffer (current-buffer))
  108. (_dired-buffer (dired temporary-file-directory)))
  109. (cl-assert (eq 'dired-mode major-mode))
  110. (revert-buffer)
  111. (dired-goto-file a-filename)
  112. ; action
  113. (call-interactively #'org-attach-dired-to-subtree)
  114. ; check
  115. (delete-window)
  116. (switch-to-buffer org-buffer)
  117. (cl-assert (eq 'org-mode major-mode)))
  118. (beginning-of-buffer)
  119. (search-forward "* foo")
  120. ; expectation. tag ATTACH has been appended.
  121. (cl-reduce (lambda (x y) (or x y))
  122. (mapcar (lambda (x) (string-equal "ATTACH" x))
  123. (plist-get
  124. (plist-get
  125. (org-element-at-point) 'headline)
  126. :tags))))
  127. (delete-file a-filename)))))
  128. (ert-deftest test-org-attach/dired-attach-to-next-best-subtree/2 ()
  129. "Attach 2 marked files."
  130. (should
  131. (let ((a-filename (make-temp-file "a"))
  132. (b-filename (make-temp-file "b")) ; attach candidates.
  133. (org-attach-id-dir "data/"))
  134. (unwind-protect
  135. (org-test-with-temp-text-in-file
  136. "* foo"
  137. (split-window)
  138. (let ((org-buffer (current-buffer))
  139. (_dired-buffer (dired temporary-file-directory)))
  140. (cl-assert (eq 'dired-mode major-mode))
  141. (revert-buffer)
  142. (dired-goto-file a-filename)
  143. (dired-mark 1)
  144. (dired-goto-file b-filename)
  145. (dired-mark 1)
  146. ; action
  147. (call-interactively #'org-attach-dired-to-subtree)
  148. ; check
  149. (delete-window)
  150. (switch-to-buffer org-buffer))
  151. (cl-assert (eq 'org-mode major-mode))
  152. (beginning-of-buffer)
  153. (search-forward "* foo")
  154. (and (file-exists-p (concat (org-attach-dir) "/"
  155. (file-name-nondirectory a-filename)))
  156. (file-exists-p (concat (org-attach-dir) "/"
  157. (file-name-nondirectory b-filename)))))
  158. (delete-file a-filename)
  159. (delete-file b-filename)))))
  160. (provide 'test-org-attach)
  161. ;;; test-org-attach.el ends here