summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMarco Wahl <marcowahlsoft@gmail.com>2017-11-15 11:25:51 +0100
committerMarco Wahl <marcowahlsoft@gmail.com>2017-11-15 11:25:51 +0100
commit615b1470315edb7b3fc40c4f34ebe5a3b31c37b1 (patch)
treedfff2de475df6711c81b6c77b1ca9c5cc08d95b6
parentc029c4d45dd22da0023217735ded084a8e28f2fa (diff)
downloadorg-mode-615b1470315edb7b3fc40c4f34ebe5a3b31c37b1.tar.gz
org-attach: Attach files specified in a dired buffer.
* 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.
-rw-r--r--lisp/org-attach.el80
-rw-r--r--testing/lisp/test-org-attach.el129
2 files changed, 209 insertions, 0 deletions
diff --git a/lisp/org-attach.el b/lisp/org-attach.el
index cd6b413..8973dde 100644
--- a/lisp/org-attach.el
+++ b/lisp/org-attach.el
@@ -577,6 +577,86 @@ This function is called by `org-archive-hook'. The option
org-attach-archive-delete)
(org-attach-delete-all t)))
+
+;; Attach from dired.
+
+;; Suggestion to activate shortcuts for dired. Add the following
+;; lines to the emacs config file.
+
+;; (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))
+
+(defun org-attach-dired-marked-files-in-dired ()
+ "Return list of marked files in dired."
+ (cl-assert (eq 'dired-mode major-mode))
+ (delq nil
+ (mapcar
+ (lambda (f) (if (file-directory-p f) nil f)) ;; don't attach directories
+ (nreverse (dired-map-over-marks (dired-get-filename) nil)))))
+
+(defun org-attach-dired-marked-files-or-file-at-cursor-in-dired ()
+ "Return list of marked files in dired or file at cursor as one
+element list. Else return nil."
+ (cl-assert (eq 'dired-mode major-mode))
+ (or (org-attach-dired-marked-files-in-dired)
+ (list (dired-get-filename 'no-dir t))))
+
+(defun org-attach-dired-attach-to-next-best-subtree (files)
+ "Attach FILES marked or current file in dired to subtree in other window.
+Precondition: Point must be in a dired buffer.
+Idea taken from `gnus-dired-attach'."
+ (interactive
+ (list (org-attach-dired-marked-files-or-file-at-cursor-in-dired)))
+ (unless (eq major-mode 'dired-mode)
+ (user-error "This command must be triggered in a dired buffer."))
+ (let ((start-win (selected-window))
+ (other-win
+ (get-window-with-predicate
+ (lambda (window)
+ (with-current-buffer (window-buffer window)
+ (eq major-mode 'org-mode))))))
+ (unless other-win
+ (user-error
+ "Can't attach to subtree. There is no window in Org-mode"))
+ (select-window other-win)
+ (org-attach-attach-files files)
+ (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)
(provide 'org-attach)
diff --git a/testing/lisp/test-org-attach.el b/testing/lisp/test-org-attach.el
new file mode 100644
index 0000000..6e416e6
--- /dev/null
+++ b/testing/lisp/test-org-attach.el
@@ -0,0 +1,129 @@
+;;; 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