|
@@ -24,105 +24,65 @@
|
|
|
|
|
|
;;; Code:
|
|
;;; Code:
|
|
|
|
|
|
|
|
+(require 'org-test)
|
|
(require 'org-attach)
|
|
(require 'org-attach)
|
|
|
|
|
|
-(defun touch (filename)
|
|
|
|
- "Make sure FILENAME exists."
|
|
|
|
- (find-file filename)
|
|
|
|
- (save-buffer)
|
|
|
|
- (kill-buffer))
|
|
|
|
-
|
|
|
|
(ert-deftest test-org-attach/dired-attach-to-next-best-subtree/1 ()
|
|
(ert-deftest test-org-attach/dired-attach-to-next-best-subtree/1 ()
|
|
"Attach file at point in dired to subtree."
|
|
"Attach file at point in dired to subtree."
|
|
-
|
|
|
|
- ;; prepare
|
|
|
|
- (let* ((tmpdir (make-temp-file "test-org-attach_" t "/"))
|
|
|
|
- (orgfilename (concat tmpdir "attach.org"))
|
|
|
|
- (a-filename (concat tmpdir "a")))
|
|
|
|
- (touch a-filename)
|
|
|
|
- (dired tmpdir)
|
|
|
|
- (delete-other-windows)
|
|
|
|
- (find-file-other-window orgfilename)
|
|
|
|
- (erase-buffer)
|
|
|
|
- (org-mode)
|
|
|
|
- (insert "* foo :foo:")
|
|
|
|
- (other-window 1)
|
|
|
|
- (assert (eq 'dired-mode major-mode))
|
|
|
|
- (dired-goto-file a-filename)
|
|
|
|
-
|
|
|
|
- ;;action
|
|
|
|
- (call-interactively #'org-attach-dired-attach-to-next-best-subtree)
|
|
|
|
- (find-file-other-window orgfilename)
|
|
|
|
- (beginning-of-buffer)
|
|
|
|
- (search-forward "* foo")
|
|
|
|
-
|
|
|
|
- ;; expectation. tag ATTACH has been appended.
|
|
|
|
- (should
|
|
|
|
- (reduce (lambda (x y) (or x y))
|
|
|
|
- (mapcar (lambda (x) (string-equal "ATTACH" x))
|
|
|
|
- (plist-get
|
|
|
|
- (plist-get
|
|
|
|
- (org-element-at-point) 'headline) :tags))))
|
|
|
|
-
|
|
|
|
- ;; cleanup
|
|
|
|
- (delete-directory tmpdir 'recursive)))
|
|
|
|
-
|
|
|
|
-
|
|
|
|
-;; Use a test core several times.
|
|
|
|
-(defmacro standard-core-test-org-attach/dired-attach-function-for-method (fun)
|
|
|
|
- "Create test core for FUN. Attach two marked files."
|
|
|
|
- `(let* ((tmpdir (make-temp-file "test-org-attach_" t "/"))
|
|
|
|
- (orgfilename (concat tmpdir "attach.org"))
|
|
|
|
- (a-filename (concat tmpdir "a"))
|
|
|
|
- (b-filename (concat tmpdir "b")))
|
|
|
|
- (touch a-filename)
|
|
|
|
- (touch b-filename)
|
|
|
|
- (dired tmpdir)
|
|
|
|
- (delete-other-windows)
|
|
|
|
- (find-file-other-window orgfilename)
|
|
|
|
- (org-mode)
|
|
|
|
- (insert "* foo :foo:")
|
|
|
|
- (other-window 1)
|
|
|
|
- (assert (eq 'dired-mode major-mode))
|
|
|
|
- (dired-goto-file a-filename)
|
|
|
|
- (dired-mark 1)
|
|
|
|
- (dired-goto-file b-filename)
|
|
|
|
- (dired-mark 1)
|
|
|
|
-
|
|
|
|
- ;; action
|
|
|
|
- (call-interactively #',fun)
|
|
|
|
- (find-file-other-window orgfilename)
|
|
|
|
- (beginning-of-buffer)
|
|
|
|
- (search-forward "* foo")
|
|
|
|
-
|
|
|
|
- ;; check
|
|
|
|
- (should
|
|
|
|
- (and (file-exists-p (concat (org-attach-dir) "/" "a"))
|
|
|
|
- (file-exists-p (concat (org-attach-dir) "/" "b"))))
|
|
|
|
-
|
|
|
|
- ;; cleanup
|
|
|
|
- (delete-directory tmpdir 'recursive)))
|
|
|
|
|
|
+ (should
|
|
|
|
+ (let ((a-filename (make-temp-file "a"))) ; file is an attach candidate.
|
|
|
|
+ (unwind-protect
|
|
|
|
+ (org-test-with-temp-text-in-file
|
|
|
|
+ "* foo :foo:"
|
|
|
|
+ (split-window)
|
|
|
|
+ (dired temporary-file-directory)
|
|
|
|
+ (assert (eq 'dired-mode major-mode))
|
|
|
|
+ (revert-buffer)
|
|
|
|
+ (dired-goto-file a-filename)
|
|
|
|
+ ; action
|
|
|
|
+ (call-interactively #'org-attach-dired-to-subtree)
|
|
|
|
+ ; check
|
|
|
|
+ (delete-window)
|
|
|
|
+ (assert (eq 'org-mode major-mode))
|
|
|
|
+ (beginning-of-buffer)
|
|
|
|
+ (search-forward "* foo")
|
|
|
|
+ ; expectation. tag ATTACH has been appended.
|
|
|
|
+ (reduce (lambda (x y) (or x y))
|
|
|
|
+ (mapcar (lambda (x) (string-equal "ATTACH" x))
|
|
|
|
+ (plist-get
|
|
|
|
+ (plist-get
|
|
|
|
+ (org-element-at-point) 'headline) :tags))))
|
|
|
|
+ (delete-file a-filename)))))
|
|
|
|
|
|
(ert-deftest test-org-attach/dired-attach-to-next-best-subtree/2 ()
|
|
(ert-deftest test-org-attach/dired-attach-to-next-best-subtree/2 ()
|
|
- "Attach two marked."
|
|
|
|
- (standard-core-test-org-attach/dired-attach-function-for-method
|
|
|
|
- org-attach-dired-attach-to-next-best-subtree))
|
|
|
|
-
|
|
|
|
-(ert-deftest test-org-attach/dired-attach-to-next-best-subtree-cp ()
|
|
|
|
- (standard-core-test-org-attach/dired-attach-function-for-method
|
|
|
|
- org-attach-dired-attach-to-next-best-subtree-cp))
|
|
|
|
-
|
|
|
|
-(ert-deftest test-org-attach/dired-attach-to-next-best-subtree-mv ()
|
|
|
|
- (standard-core-test-org-attach/dired-attach-function-for-method
|
|
|
|
- org-attach-dired-attach-to-next-best-subtree-mv))
|
|
|
|
-
|
|
|
|
-(ert-deftest test-org-attach/dired-attach-to-next-best-subtree-ln ()
|
|
|
|
- (standard-core-test-org-attach/dired-attach-function-for-method
|
|
|
|
- org-attach-dired-attach-to-next-best-subtree-mv))
|
|
|
|
-
|
|
|
|
-(ert-deftest test-org-attach/dired-attach-to-next-best-subtree-lns ()
|
|
|
|
- (standard-core-test-org-attach/dired-attach-function-for-method
|
|
|
|
- org-attach-dired-attach-to-next-best-subtree-lns))
|
|
|
|
|
|
+ "Attach 2 marked files."
|
|
|
|
+ (should
|
|
|
|
+ (let ((a-filename (make-temp-file "a"))
|
|
|
|
+ (b-filename (make-temp-file "b"))) ; attach candidates.
|
|
|
|
+ (unwind-protect
|
|
|
|
+ (org-test-with-temp-text-in-file
|
|
|
|
+ "* foo"
|
|
|
|
+ (split-window)
|
|
|
|
+ (dired temporary-file-directory)
|
|
|
|
+ (assert (eq 'dired-mode major-mode))
|
|
|
|
+ (revert-buffer)
|
|
|
|
+ (dired-goto-file a-filename)
|
|
|
|
+ (dired-mark 1)
|
|
|
|
+ (dired-goto-file b-filename)
|
|
|
|
+ (dired-mark 1)
|
|
|
|
+ ; action
|
|
|
|
+ (call-interactively #'org-attach-dired-to-subtree)
|
|
|
|
+ ; check
|
|
|
|
+ (delete-window)
|
|
|
|
+ (assert (eq 'org-mode major-mode))
|
|
|
|
+ (beginning-of-buffer)
|
|
|
|
+ (search-forward "* foo")
|
|
|
|
+ (and (file-exists-p (concat (org-attach-dir) "/"
|
|
|
|
+ (file-name-nondirectory a-filename)))
|
|
|
|
+ (file-exists-p (concat (org-attach-dir) "/"
|
|
|
|
+ (file-name-nondirectory b-filename)))))
|
|
|
|
+ (delete-file a-filename)
|
|
|
|
+ (delete-file b-filename)))))
|
|
|
|
|
|
|
|
|
|
(provide 'test-org-attach)
|
|
(provide 'test-org-attach)
|