mirrors
/
org-mode
mirror of https://git.savannah.gnu.org/git/emacs/org-mode.git
0
0
Fork 1
Code Releases Activity

org-attach,test-org-attach: Refactoring. 

* lisp/org-attach.el (org-attach-dired-to-subtree): Renamed from
  `org-attach-dired-attach-to-next-best-subtree'.  Convenience
  functions have been dropped.

* testing/lisp/test-org-attach.el: Tests use
  `org-test-with-temp-text-in-file' now and are cleaner now.
This commit is contained in:
Marco Wahl 2017-11-15 14:39:26 +01:00
parent a49ac98f3f
commit 5c382f2ee2
2 changed files with 61 additions and 130 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
lisp/org-attach.el
View File

@ -580,27 +580,17 @@ This function is called by `org-archive-hook'. The option
;; Attach from dired.
;; Suggestion to activate shortcuts for dired. Add the following
;; lines to the emacs config file.
;; Add the following lines to the config file to get a binding for
;; dired-mode.
;; (add-hook
;; 'dired-mode-hook
;; (lambda ()
;; (define-key dired-mode-map (kbd "C-c C-x a") #'org-attach-dired-attach-to-next-best-subtree)
;; (define-key dired-mode-map (kbd "C-c C-x c") #'org-attach-dired-attach-to-next-best-subtree-cp)
;; (define-key dired-mode-map (kbd "C-c C-x m") #'org-attach-dired-attach-to-next-best-subtree-mv)
;; (define-key dired-mode-map (kbd "C-c C-x l") #'org-attach-dired-attach-to-next-best-subtree-ln)
;; (define-key dired-mode-map (kbd "C-c C-x s") #'org-attach-dired-attach-to-next-best-subtree-lns)))
;; (define-key dired-mode-map (kbd "C-c C-x a") #'org-attach-dired-to-subtree))))
(defun org-attach-attach-files (files &optional method)
"Move/copy/link FILES into the attachment directory of the current task.
METHOD may be `cp', `mv', `ln', `lns' or `url' default taken from
`org-attach-method'."
(setq method (or method org-attach-method))
(mapc (lambda (file) (org-attach-attach file nil method)) files))
(defun org-attach-dired-attach-to-next-best-subtree (files)
(defun org-attach-dired-to-subtree (files)
"Attach FILES marked or current file in dired to subtree in other window.
Takes the method given in `org-attach-method' for the attach action.
Precondition: Point must be in a dired buffer.
Idea taken from `gnus-dired-attach'."
(interactive
@ -615,31 +605,12 @@ Idea taken from `gnus-dired-attach'."
(eq major-mode 'org-mode))))))
(unless other-win
(user-error
"Can't attach to subtree. There is no window in Org-mode"))
"Can't attach to subtree. No window displaying an Org buffer"))
(select-window other-win)
(org-attach-attach-files files)
(dolist (file files)
(org-attach-attach file))
(select-window start-win)))
(defun org-attach-dired-attach-to-next-best-subtree-cp ()
(interactive)
(let ((org-attach-method 'cp))
(call-interactively #'org-attach-dired-attach-to-next-best-subtree)))
(defun org-attach-dired-attach-to-next-best-subtree-mv ()
(interactive)
(let ((org-attach-method 'mv))
(call-interactively #'org-attach-dired-attach-to-next-best-subtree)))
(defun org-attach-dired-attach-to-next-best-subtree-ln ()
(interactive)
(let ((org-attach-method 'ln))
(call-interactively #'org-attach-dired-attach-to-next-best-subtree)))
(defun org-attach-dired-attach-to-next-best-subtree-lns ()
(interactive)
(let ((org-attach-method 'lns))
(call-interactively #'org-attach-dired-attach-to-next-best-subtree)))
(add-hook 'org-archive-hook 'org-attach-archive-delete-maybe)

146
testing/lisp/test-org-attach.el
View File

@ -24,105 +24,65 @@
;;; Code:
(require 'org-test)
(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)))
(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 ()
"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)