Browse Source

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.
Marco Wahl 1 year ago
parent
commit
5c382f2ee2
2 changed files with 61 additions and 130 deletions
  1. 8 37
      lisp/org-attach.el
  2. 53 93
      testing/lisp/test-org-attach.el

+ 8 - 37
lisp/org-attach.el

@@ -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)))
-
-(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))
+;;    (define-key dired-mode-map (kbd "C-c C-x a") #'org-attach-dired-to-subtree))))
 
-(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)

+ 53 - 93
testing/lisp/test-org-attach.el

@@ -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)