mirror of
https://git.savannah.gnu.org/git/emacs/org-mode.git
synced 2024-09-05 17:43:01 +00:00
615b147031
* lisp/org-attach.el (org-attach-attach-files): New. (org-attach-dired-marked-files-in-dired): New (org-attach-dired-marked-files-or-file-at-cursor-in-dired): New. (org-attach-dired-attach-to-next-best-subtree): New command. (org-attach-dired-attach-to-next-best-subtree-cp): New command. (org-attach-dired-attach-to-next-best-subtree-mv): New command. (org-attach-dired-attach-to-next-best-subtree-ln): New command. (org-attach-dired-attach-to-next-best-subtree-lns): New command. * testing/lisp/test-org-attach.el: Tests.
130 lines
4 KiB
EmacsLisp
130 lines
4 KiB
EmacsLisp
;;; test-org-attach.el --- tests for org-attach.el -*- lexical-binding: t; -*-
|
||
|
||
;; Copyright (C) 2017
|
||
|
||
;; Author: Marco Wahl
|
||
;; Keywords: internal
|
||
|
||
;; This program is free software; you can redistribute it and/or modify
|
||
;; it under the terms of the GNU General Public License as published by
|
||
;; the Free Software Foundation, either version 3 of the License, or
|
||
;; (at your option) any later version.
|
||
|
||
;; This program is distributed in the hope that it will be useful,
|
||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
;; GNU General Public License for more details.
|
||
|
||
;; You should have received a copy of the GNU General Public License
|
||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||
|
||
;;; Commentary:
|
||
|
||
;;
|
||
|
||
;;; Code:
|
||
|
||
(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 ()
|
||
"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)))
|
||
|
||
(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))
|
||
|
||
|
||
(provide 'test-org-attach)
|
||
;;; test-org-attach.el ends here
|