lisp/org-attach.el

   1 ;;; org-attach.el --- Manage file attachments to org-mode tasks
   2
   3 ;; Copyright (C) 2008 Free Software Foundation, Inc.
   4
   5 ;; Author: John Wiegley <johnw@newartisans.com>
   6 ;; Keywords: org data task
   7 ;; Version: 6.08a
   8
   9 ;; This file is part of GNU Emacs.
  10 ;;
  11 ;; GNU Emacs is free software: you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation, either version 3 of the License, or
  14 ;; (at your option) any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  23
  24 ;;; Commentary:
  25
  26 ;; See the Org-mode manual for information on how to use it.
  27 ;;
  28 ;; Attachments are managed in a special directory called "data", which
  29 ;; lives in the directory given by `org-directory'.  If this data
  30 ;; directory is initialized as a Git repository, then org-attach will
  31 ;; automatically commit changes when it sees them.
  32 ;;
  33 ;; Attachment directories are identified using a UUID generated for the
  34 ;; task which has the attachments.  These are added as property to the
  35 ;; task when necessary, and should not be deleted or changed by the
  36 ;; user, ever.  UUIDs are generated by a mechanism defined in the variable
  37 ;; `org-id-method'.
  38
  39 ;; Ideas:  Store region or kill as an attachment.
  40 ;;         Support drag-and-drop
  41
  42 (eval-when-compile
  43   (require 'cl))
  44 (require 'org-id)
  45 (require 'org)
  46
  47 (defgroup org-attach nil
  48   "Options concerning entry attachments in Org-mode."
  49   :tag "Org Remember"
  50   :group 'org)
  51
  52 (defcustom org-attach-directory "data/"
  53   "The directory where attachments are stored.
  54 If this is a relative path, it will be interpreted relative to the directory
  55 where the Org file lives."
  56   :group 'org-attach
  57   :type 'direcory)
  58
  59 (defcustom org-attach-expert nil
  60   "Non-nil means do not show the splash buffer with the attach dispatcher."
  61   :group 'org-attach
  62   :type 'boolean)
  63
  64 ;;;###autoload
  65 (defun org-attach ()
  66   "The dispatcher for attachment commands.
  67 Shows a list of commands and prompts for another key to execute a command."
  68   (interactive)
  69   (let (c marker)
  70     (when (eq major-mode 'org-agenda-mode)
  71       (setq marker (or (get-text-property (point) 'org-hd-marker)
  72                        (get-text-property (point) 'org-marker)))
  73       (unless marker
  74         (error "No task in current line")))
  75     (save-excursion
  76       (when marker
  77         (set-buffer (marker-buffer marker))
  78         (goto-char marker))
  79       (org-back-to-heading t)
  80       (save-excursion
  81         (save-window-excursion
  82           (unless org-attach-expert
  83             (with-output-to-temp-buffer "*Org Attach*"
  84               (princ "Select an Attachment Command:
  85
  86 a    Select a file and move it into the task's attachment  directory.
  87 c    Create a new attachment, as an Emacs buffer.
  88 z    Synchronize the current task with its attachment
  89      directory, in case you added attachments yourself.
  90
  91 o    Open current task's attachments.
  92 O    Like \"o\", but force opening in Emacs.
  93 f    Open current task's attachment directory.
  94 F    Like \"f\", but force using dired in Emacs.
  95
  96 D    Delete all of a task's attachments.  A safer way is
  97      to open the directory in dired and delete from there.")))
  98           (shrink-window-if-larger-than-buffer (get-buffer-window "*Org Attach*"))
  99           (message "Select command: [azoOfFD^a]")
 100           (setq c (read-char-exclusive))
 101           (and (get-buffer "*Org Attach*") (kill-buffer "*Org Attach*"))))
 102       (cond
 103        ((memq c '(?a ?\C-a)) (call-interactively 'org-attach-attach))
 104        ((memq c '(?c ?\C-c)) (call-interactively 'org-attach-new))
 105        ((memq c '(?z ?\C-z)) (call-interactively 'org-attach-sync))
 106        ((memq c '(?o ?\C-o)) (call-interactively 'org-attach-open))
 107        ((eq c ?O)            (call-interactively 'org-attach-open-in-emacs))
 108        ((memq c '(?f ?\C-f)) (call-interactively 'org-attach-reveal))
 109        ((memq c '(?F))       (call-interactively 'org-attach-reveal-in-emacs))
 110        ((eq c ?D)            (call-interactively 'org-attach-delete))
 111        (t (error "No such attachment command %c" c))))))
 112
 113 (defun org-attach-dir (&optional create-if-not-exists-p)
 114   "Return the directory associated with the current entry.
 115 If the directory does not exist and CREATE-IF-NOT-EXISTS-P is non-nil,
 116 the directory and the corresponding ID will be created."
 117   (let ((uuid (org-id-get (point) create-if-not-exists-p)))
 118     (when (or uuid create-if-not-exists-p)
 119       (unless uuid
 120         (let ((uuid-string (shell-command-to-string "uuidgen")))
 121           (setf uuid-string
 122                 (substring uuid-string 0 (1- (length uuid-string))))
 123           (org-entry-put (point) "ID" uuid-string)
 124           (setf uuid uuid-string)))
 125       (let ((attach-dir (expand-file-name
 126                          (format "%s/%s"
 127                                  (substring uuid 0 2)
 128                                  (substring uuid 2))
 129                          (expand-file-name org-attach-directory))))
 130         (if (and create-if-not-exists-p
 131                  (not (file-directory-p attach-dir)))
 132             (make-directory attach-dir t))
 133         (and (file-exists-p attach-dir)
 134              attach-dir)))))
 135
 136 (defun org-attach-commit ()
 137   "Commit changes to git if available."
 138   (let ((dir (expand-file-name org-attach-directory)))
 139     (if (file-exists-p (expand-file-name ".git" dir))
 140         (shell-command
 141          (concat "(cd " dir "; "
 142                  " git add .; "
 143                  " git ls-files --deleted -z | xargs -0 git rm; "
 144                  " git commit -m 'Synchronized attachments')")))))
 145
 146 (defun org-attach-attach (file &optional visit-dir)
 147   "Move FILE into the attachment directory of the current task.
 148 If VISIT-DIR is non-nil, visit the direcory with dired."
 149   (interactive "fFile to keep as an attachment: \nP")
 150   (let ((basename (file-name-nondirectory file)))
 151     (org-entry-add-to-multivalued-property (point) "Attachments"
 152                                            basename)
 153     (let ((attach-dir (org-attach-dir t)))
 154       (rename-file file (expand-file-name basename attach-dir))
 155       (org-attach-commit)
 156       (if visit-dir
 157           (dired attach-dir)
 158         (message "File \"%s\" is now a task attachment." basename)))))
 159
 160 (defun org-attach-new (file)
 161   "Create a new attachment FILE for the current task.
 162 The attachment is created as an Emacs buffer."
 163   (interactive "sCreate attachment named: ")
 164   (org-entry-add-to-multivalued-property (point) "Attachments"
 165                                          file)
 166   (let ((attach-dir (org-attach-dir t)))
 167     (find-file (expand-file-name file attach-dir))
 168     (message "New attachment %s" file)))
 169
 170 (defun org-attach-delete ()
 171   "Delete all attachments from the current task.
 172 A safer way is to open the directory in dired and delete from there."
 173   (interactive)
 174   (org-entry-delete (point) "Attachments")
 175   (let ((attach-dir (org-attach-dir)))
 176     (if attach-dir
 177         (shell-command (format "rm -fr %s" attach-dir))))
 178   (org-attach-commit))
 179
 180 (defun org-attach-sync ()
 181   "Synchonize the current tasks with its attachments.
 182 This can be used after files have been added externally."
 183   (interactive)
 184   (org-attach-commit)
 185   (org-entry-delete (point) "Attachments")
 186   (let ((attach-dir (org-attach-dir)))
 187     (when attach-dir
 188       (let ((files (directory-files attach-dir)))
 189         (dolist (file files)
 190           (unless (string-match "^\\." file)
 191             (org-entry-add-to-multivalued-property
 192              (point) "Attachments" file)))))))
 193
 194 (defun org-attach-reveal ()
 195   "Show the attachment directory of the current task in dired."
 196   (interactive)
 197   (let ((attach-dir (org-attach-dir t)))
 198     (org-open-file attach-dir)))
 199
 200 (defun org-attach-reveal-in-emacs ()
 201   "Show the attachment directory of the current task.
 202 This will attempt to use an external program to show the directory."
 203   (interactive)
 204   (let ((attach-dir (org-attach-dir t)))
 205     (dired attach-dir)))
 206
 207 (defun org-attach-open (&optional in-emacs)
 208   "Open an attachment of the current task.
 209 If there are more than one attachment, you will be prompted for the file name.
 210 This command will open the file using the settings in `org-file-apps'
 211 and in the system-specific variants of this variable.
 212 If IN-EMACS is non-nil, force opening in Emacs."
 213   (interactive "P")
 214   (let* ((attach-dir (org-attach-dir t))
 215          (files (org-entry-get-multivalued-property (point) "Attachments"))
 216          (file (if (= (length files) 1)
 217                    (car files)
 218                  (completing-read "Attachment: " (mapcar 'list files) nil t))))
 219     (org-open-file (expand-file-name file attach-dir) in-emacs)))
 220
 221 (defun org-attach-open-in-emacs ()
 222   "Open attachment, force opening in Emacs.
 223 See `org-attach-open'."
 224   (org-attach-open 'in-emacs))
 225
 226
 227 (defun org-attach-open-single-attachment (&optional in-emacs)
 228   (interactive)
 229   (let* ((attach-dir (org-attach-dir t))
 230          (file (read-file-name "Attachment: " attach-dir nil t)))
 231     (org-open-file file in-emacs)))
 232
 233
 234 (provide 'org-attach)
 235
 236 ;;; org-attach.el ends here