Commit | Line | Data |
---|---|---|
47ffc456 CD |
1 | ;;; org-attach.el --- Manage file attachments to org-mode tasks |
2 | ||
73b0cd50 | 3 | ;; Copyright (C) 2008-2011 Free Software Foundation, Inc. |
47ffc456 CD |
4 | |
5 | ;; Author: John Wiegley <johnw@newartisans.com> | |
6 | ;; Keywords: org data task | |
acedf35c | 7 | ;; Version: 7.4 |
47ffc456 CD |
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 | |
c8d0cf5c | 29 | ;; lives in the same directory as the org file itself. If this data |
47ffc456 CD |
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 | ;;; Code: | |
40 | ||
41 | (eval-when-compile | |
42 | (require 'cl)) | |
43 | (require 'org-id) | |
44 | (require 'org) | |
45 | ||
46 | (defgroup org-attach nil | |
47 | "Options concerning entry attachments in Org-mode." | |
48 | :tag "Org Attach" | |
49 | :group 'org) | |
50 | ||
51 | (defcustom org-attach-directory "data/" | |
52 | "The directory where attachments are stored. | |
53 | If this is a relative path, it will be interpreted relative to the directory | |
54 | where the Org file lives." | |
55 | :group 'org-attach | |
33306645 | 56 | :type 'directory) |
47ffc456 CD |
57 | |
58 | (defcustom org-attach-auto-tag "ATTACH" | |
59 | "Tag that will be triggered automatically when an entry has an attachment." | |
60 | :group 'org-attach | |
61 | :type '(choice | |
62 | (const :tag "None" nil) | |
63 | (string :tag "Tag"))) | |
64 | ||
65 | (defcustom org-attach-file-list-property "Attachments" | |
66 | "The property used to keep a list of attachment belonging to this entry. | |
0bd48b37 CD |
67 | This is not really needed, so you may set this to nil if you don't want it. |
68 | Also, for entries where children inherit the directory, the list of | |
69 | attachments is not kept in this property." | |
47ffc456 CD |
70 | :group 'org-attach |
71 | :type '(choice | |
72 | (const :tag "None" nil) | |
73 | (string :tag "Tag"))) | |
74 | ||
75 | (defcustom org-attach-method 'cp | |
76 | "The preferred method to attach a file. | |
77 | Allowed values are: | |
78 | ||
79 | mv rename the file to move it into the attachment directory | |
80 | cp copy the file | |
81 | ln create a hard link. Note that this is not supported | |
82 | on all systems, and then the result is not defined." | |
83 | :group 'org-attach | |
84 | :type '(choice | |
85 | (const :tag "Copy" cp) | |
86 | (const :tag "Move/Rename" mv) | |
87 | (const :tag "Link" ln))) | |
88 | ||
89 | (defcustom org-attach-expert nil | |
90 | "Non-nil means do not show the splash buffer with the attach dispatcher." | |
91 | :group 'org-attach | |
92 | :type 'boolean) | |
93 | ||
0bd48b37 | 94 | (defcustom org-attach-allow-inheritance t |
ed21c5c8 | 95 | "Non-nil means allow attachment directories be inherited." |
0bd48b37 CD |
96 | :group 'org-attach |
97 | :type 'boolean) | |
c8d0cf5c | 98 | |
0bd48b37 CD |
99 | |
100 | (defvar org-attach-inherited nil | |
101 | "Indicates if the last access to the attachment directory was inherited.") | |
102 | ||
47ffc456 CD |
103 | ;;;###autoload |
104 | (defun org-attach () | |
105 | "The dispatcher for attachment commands. | |
106 | Shows a list of commands and prompts for another key to execute a command." | |
107 | (interactive) | |
108 | (let (c marker) | |
109 | (when (eq major-mode 'org-agenda-mode) | |
110 | (setq marker (or (get-text-property (point) 'org-hd-marker) | |
111 | (get-text-property (point) 'org-marker))) | |
112 | (unless marker | |
113 | (error "No task in current line"))) | |
114 | (save-excursion | |
115 | (when marker | |
116 | (set-buffer (marker-buffer marker)) | |
117 | (goto-char marker)) | |
118 | (org-back-to-heading t) | |
119 | (save-excursion | |
120 | (save-window-excursion | |
121 | (unless org-attach-expert | |
122 | (with-output-to-temp-buffer "*Org Attach*" | |
123 | (princ "Select an Attachment Command: | |
124 | ||
125 | a Select a file and attach it to the task, using `org-attach-method'. | |
126 | c/m/l Attach a file using copy/move/link method. | |
127 | n Create a new attachment, as an Emacs buffer. | |
128 | z Synchronize the current task with its attachment | |
129 | directory, in case you added attachments yourself. | |
130 | ||
131 | o Open current task's attachments. | |
132 | O Like \"o\", but force opening in Emacs. | |
133 | f Open current task's attachment directory. | |
134 | F Like \"f\", but force using dired in Emacs. | |
135 | ||
136 | d Delete one attachment, you will be prompted for a file name. | |
137 | D Delete all of a task's attachments. A safer way is | |
0bd48b37 CD |
138 | to open the directory in dired and delete from there. |
139 | ||
140 | s Set a specific attachment directory for this entry. | |
141 | i Make children of the current entry inherit its attachment directory."))) | |
93b62de8 | 142 | (org-fit-window-to-buffer (get-buffer-window "*Org Attach*")) |
47ffc456 CD |
143 | (message "Select command: [acmlzoOfFdD]") |
144 | (setq c (read-char-exclusive)) | |
145 | (and (get-buffer "*Org Attach*") (kill-buffer "*Org Attach*")))) | |
146 | (cond | |
147 | ((memq c '(?a ?\C-a)) (call-interactively 'org-attach-attach)) | |
148 | ((memq c '(?c ?\C-c)) | |
149 | (let ((org-attach-method 'cp)) (call-interactively 'org-attach-attach))) | |
150 | ((memq c '(?m ?\C-m)) | |
151 | (let ((org-attach-method 'mv)) (call-interactively 'org-attach-attach))) | |
152 | ((memq c '(?l ?\C-l)) | |
153 | (let ((org-attach-method 'ln)) (call-interactively 'org-attach-attach))) | |
154 | ((memq c '(?n ?\C-n)) (call-interactively 'org-attach-new)) | |
155 | ((memq c '(?z ?\C-z)) (call-interactively 'org-attach-sync)) | |
156 | ((memq c '(?o ?\C-o)) (call-interactively 'org-attach-open)) | |
157 | ((eq c ?O) (call-interactively 'org-attach-open-in-emacs)) | |
158 | ((memq c '(?f ?\C-f)) (call-interactively 'org-attach-reveal)) | |
159 | ((memq c '(?F)) (call-interactively 'org-attach-reveal-in-emacs)) | |
160 | ((memq c '(?d ?\C-d)) (call-interactively | |
161 | 'org-attach-delete-one)) | |
162 | ((eq c ?D) (call-interactively 'org-attach-delete-all)) | |
163 | ((eq c ?q) (message "Abort")) | |
0bd48b37 CD |
164 | ((memq c '(?s ?\C-s)) (call-interactively |
165 | 'org-attach-set-directory)) | |
166 | ((memq c '(?i ?\C-i)) (call-interactively | |
167 | 'org-attach-set-inherit)) | |
47ffc456 CD |
168 | (t (error "No such attachment command %c" c)))))) |
169 | ||
170 | (defun org-attach-dir (&optional create-if-not-exists-p) | |
171 | "Return the directory associated with the current entry. | |
0bd48b37 CD |
172 | This first checks for a local property ATTACH_DIR, and then for an inherited |
173 | property ATTACH_DIR_INHERIT. If neither exists, the default mechanism | |
174 | using the entry ID will be invoked to access the unique directory for the | |
175 | current entry. | |
47ffc456 | 176 | If the directory does not exist and CREATE-IF-NOT-EXISTS-P is non-nil, |
0bd48b37 CD |
177 | the directory and (if necessary) the corresponding ID will be created." |
178 | (let (attach-dir uuid inherit) | |
179 | (setq org-attach-inherited (org-entry-get nil "ATTACH_DIR_INHERIT")) | |
180 | (cond | |
181 | ((setq attach-dir (org-entry-get nil "ATTACH_DIR")) | |
182 | (org-attach-check-absolute-path attach-dir)) | |
183 | ((and org-attach-allow-inheritance | |
184 | (setq inherit (org-entry-get nil "ATTACH_DIR_INHERIT" t))) | |
185 | (setq attach-dir | |
186 | (save-excursion | |
187 | (save-restriction | |
188 | (widen) | |
189 | (goto-char org-entry-property-inherited-from) | |
190 | (let (org-attach-allow-inheritance) | |
191 | (org-attach-dir create-if-not-exists-p))))) | |
192 | (org-attach-check-absolute-path attach-dir) | |
193 | (setq org-attach-inherited t)) | |
194 | (t ; use the ID | |
195 | (org-attach-check-absolute-path nil) | |
196 | (setq uuid (org-id-get (point) create-if-not-exists-p)) | |
197 | (when (or uuid create-if-not-exists-p) | |
198 | (unless uuid (error "ID retrieval/creation failed")) | |
199 | (setq attach-dir (expand-file-name | |
200 | (format "%s/%s" | |
201 | (substring uuid 0 2) | |
202 | (substring uuid 2)) | |
203 | (expand-file-name org-attach-directory)))))) | |
204 | (when attach-dir | |
205 | (if (and create-if-not-exists-p | |
206 | (not (file-directory-p attach-dir))) | |
207 | (make-directory attach-dir t)) | |
208 | (and (file-exists-p attach-dir) | |
209 | attach-dir)))) | |
210 | ||
211 | (defun org-attach-check-absolute-path (dir) | |
8bfe682a | 212 | "Check if we have enough information to root the attachment directory. |
0bd48b37 CD |
213 | When DIR is given, check also if it is already absolute. Otherwise, |
214 | assume that it will be relative, and check if `org-attach-directory' is | |
215 | absolute, or if at least the current buffer has a file name. | |
216 | Throw an error if we cannot root the directory." | |
217 | (or (and dir (file-name-absolute-p dir)) | |
218 | (file-name-absolute-p org-attach-directory) | |
219 | (buffer-file-name (buffer-base-buffer)) | |
f924a367 | 220 | (error "Need absolute `org-attach-directory' to attach in buffers without filename"))) |
0bd48b37 CD |
221 | |
222 | (defun org-attach-set-directory () | |
223 | "Set the ATTACH_DIR property of the current entry. | |
224 | The property defines the directory that is used for attachments | |
225 | of the entry." | |
226 | (interactive) | |
227 | (let ((dir (org-entry-get nil "ATTACH_DIR"))) | |
228 | (setq dir (read-directory-name "Attachment directory: " dir)) | |
229 | (org-entry-put nil "ATTACH_DIR" dir))) | |
230 | ||
231 | (defun org-attach-set-inherit () | |
232 | "Set the ATTACH_DIR_INHERIT property of the current entry. | |
233 | The property defines the directory that is used for attachments | |
234 | of the entry and any children that do not explicitly define (by setting | |
235 | the ATTACH_DIR property) their own attachment directory." | |
236 | (interactive) | |
237 | (org-entry-put nil "ATTACH_DIR_INHERIT" "t") | |
238 | (message "Children will inherit attachment directory")) | |
47ffc456 CD |
239 | |
240 | (defun org-attach-commit () | |
241 | "Commit changes to git if `org-attach-directory' is properly initialized. | |
242 | This checks for the existence of a \".git\" directory in that directory." | |
243 | (let ((dir (expand-file-name org-attach-directory))) | |
ed21c5c8 CD |
244 | (when (file-exists-p (expand-file-name ".git" dir)) |
245 | (with-temp-buffer | |
246 | (cd dir) | |
247 | (shell-command "git add .") | |
248 | (shell-command "git ls-files --deleted" t) | |
4f91a816 SM |
249 | (mapc (lambda (file) |
250 | (unless (string= file "") | |
251 | (shell-command | |
252 | (concat "git rm \"" file "\"")))) | |
ed21c5c8 CD |
253 | (split-string (buffer-string) "\n")) |
254 | (shell-command "git commit -m 'Synchronized attachments'"))))) | |
ff4be292 | 255 | |
47ffc456 CD |
256 | (defun org-attach-tag (&optional off) |
257 | "Turn the autotag on or (if OFF is set) off." | |
258 | (when org-attach-auto-tag | |
259 | (save-excursion | |
260 | (org-back-to-heading t) | |
261 | (org-toggle-tag org-attach-auto-tag (if off 'off 'on))))) | |
262 | ||
263 | (defun org-attach-untag () | |
264 | "Turn the autotag off." | |
265 | (org-attach-tag 'off)) | |
266 | ||
267 | (defun org-attach-attach (file &optional visit-dir method) | |
268 | "Move/copy/link FILE into the attachment directory of the current task. | |
269 | If VISIT-DIR is non-nil, visit the directory with dired. | |
270 | METHOD may be `cp', `mv', or `ln', default taken from `org-attach-method'." | |
271 | (interactive "fFile to keep as an attachment: \nP") | |
272 | (setq method (or method org-attach-method)) | |
273 | (let ((basename (file-name-nondirectory file))) | |
0bd48b37 | 274 | (when (and org-attach-file-list-property (not org-attach-inherited)) |
47ffc456 CD |
275 | (org-entry-add-to-multivalued-property |
276 | (point) org-attach-file-list-property basename)) | |
277 | (let* ((attach-dir (org-attach-dir t)) | |
278 | (fname (expand-file-name basename attach-dir))) | |
279 | (cond | |
280 | ((eq method 'mv) (rename-file file fname)) | |
281 | ((eq method 'cp) (copy-file file fname)) | |
282 | ((eq method 'ln) (add-name-to-file file fname))) | |
283 | (org-attach-commit) | |
284 | (org-attach-tag) | |
285 | (if visit-dir | |
286 | (dired attach-dir) | |
287 | (message "File \"%s\" is now a task attachment." basename))))) | |
288 | ||
289 | (defun org-attach-attach-cp () | |
290 | "Attach a file by copying it." | |
291 | (interactive) | |
292 | (let ((org-attach-method 'cp)) (call-interactively 'org-attach-attach))) | |
293 | (defun org-attach-attach-mv () | |
294 | "Attach a file by moving (renaming) it." | |
295 | (interactive) | |
296 | (let ((org-attach-method 'mv)) (call-interactively 'org-attach-attach))) | |
297 | (defun org-attach-attach-ln () | |
298 | "Attach a file by creating a hard link to it. | |
299 | Beware that this does not work on systems that do not support hard links. | |
300 | On some systems, this apparently does copy the file instead." | |
301 | (interactive) | |
302 | (let ((org-attach-method 'ln)) (call-interactively 'org-attach-attach))) | |
303 | ||
304 | (defun org-attach-new (file) | |
305 | "Create a new attachment FILE for the current task. | |
306 | The attachment is created as an Emacs buffer." | |
307 | (interactive "sCreate attachment named: ") | |
0bd48b37 | 308 | (when (and org-attach-file-list-property (not org-attach-inherited)) |
47ffc456 CD |
309 | (org-entry-add-to-multivalued-property |
310 | (point) org-attach-file-list-property file)) | |
311 | (let ((attach-dir (org-attach-dir t))) | |
312 | (org-attach-tag) | |
313 | (find-file (expand-file-name file attach-dir)) | |
314 | (message "New attachment %s" file))) | |
315 | ||
316 | (defun org-attach-delete-one (&optional file) | |
317 | "Delete a single attachment." | |
318 | (interactive) | |
319 | (let* ((attach-dir (org-attach-dir t)) | |
320 | (files (org-attach-file-list attach-dir)) | |
321 | (file (or file | |
54a0dee5 | 322 | (org-icompleting-read |
47ffc456 CD |
323 | "Delete attachment: " |
324 | (mapcar (lambda (f) | |
325 | (list (file-name-nondirectory f))) | |
326 | files))))) | |
327 | (setq file (expand-file-name file attach-dir)) | |
328 | (unless (file-exists-p file) | |
329 | (error "No such attachment: %s" file)) | |
ed21c5c8 CD |
330 | (delete-file file) |
331 | (org-attach-commit))) | |
47ffc456 CD |
332 | |
333 | (defun org-attach-delete-all (&optional force) | |
334 | "Delete all attachments from the current task. | |
335 | This actually deletes the entire attachment directory. | |
336 | A safer way is to open the directory in dired and delete from there." | |
337 | (interactive "P") | |
0bd48b37 | 338 | (when (and org-attach-file-list-property (not org-attach-inherited)) |
47ffc456 CD |
339 | (org-entry-delete (point) org-attach-file-list-property)) |
340 | (let ((attach-dir (org-attach-dir))) | |
ff4be292 | 341 | (when |
47ffc456 CD |
342 | (and attach-dir |
343 | (or force | |
344 | (y-or-n-p "Are you sure you want to remove all attachments of this entry? "))) | |
345 | (shell-command (format "rm -fr %s" attach-dir)) | |
346 | (message "Attachment directory removed") | |
347 | (org-attach-commit) | |
348 | (org-attach-untag)))) | |
349 | ||
350 | (defun org-attach-sync () | |
351 | "Synchronize the current tasks with its attachments. | |
352 | This can be used after files have been added externally." | |
353 | (interactive) | |
354 | (org-attach-commit) | |
0bd48b37 | 355 | (when (and org-attach-file-list-property (not org-attach-inherited)) |
47ffc456 CD |
356 | (org-entry-delete (point) org-attach-file-list-property)) |
357 | (let ((attach-dir (org-attach-dir))) | |
358 | (when attach-dir | |
359 | (let ((files (org-attach-file-list attach-dir))) | |
360 | (and files (org-attach-tag)) | |
361 | (when org-attach-file-list-property | |
362 | (dolist (file files) | |
363 | (unless (string-match "^\\." file) | |
364 | (org-entry-add-to-multivalued-property | |
365 | (point) org-attach-file-list-property file)))))))) | |
366 | ||
367 | (defun org-attach-file-list (dir) | |
368 | "Return a list of files in the attachment directory. | |
369 | This ignores files starting with a \".\", and files ending in \"~\"." | |
370 | (delq nil | |
371 | (mapcar (lambda (x) (if (string-match "^\\." x) nil x)) | |
372 | (directory-files dir nil "[^~]\\'")))) | |
373 | ||
8bfe682a | 374 | (defun org-attach-reveal (&optional if-exists) |
47ffc456 | 375 | "Show the attachment directory of the current task in dired." |
8bfe682a CD |
376 | (interactive "P") |
377 | (let ((attach-dir (org-attach-dir (not if-exists)))) | |
378 | (and attach-dir (org-open-file attach-dir)))) | |
47ffc456 CD |
379 | |
380 | (defun org-attach-reveal-in-emacs () | |
381 | "Show the attachment directory of the current task. | |
382 | This will attempt to use an external program to show the directory." | |
383 | (interactive) | |
384 | (let ((attach-dir (org-attach-dir t))) | |
385 | (dired attach-dir))) | |
386 | ||
387 | (defun org-attach-open (&optional in-emacs) | |
388 | "Open an attachment of the current task. | |
389 | If there are more than one attachment, you will be prompted for the file name. | |
390 | This command will open the file using the settings in `org-file-apps' | |
391 | and in the system-specific variants of this variable. | |
392 | If IN-EMACS is non-nil, force opening in Emacs." | |
393 | (interactive "P") | |
394 | (let* ((attach-dir (org-attach-dir t)) | |
395 | (files (org-attach-file-list attach-dir)) | |
396 | (file (if (= (length files) 1) | |
397 | (car files) | |
54a0dee5 | 398 | (org-icompleting-read "Open attachment: " |
47ffc456 CD |
399 | (mapcar 'list files) nil t)))) |
400 | (org-open-file (expand-file-name file attach-dir) in-emacs))) | |
401 | ||
402 | (defun org-attach-open-in-emacs () | |
403 | "Open attachment, force opening in Emacs. | |
404 | See `org-attach-open'." | |
405 | (interactive) | |
406 | (org-attach-open 'in-emacs)) | |
407 | ||
93b62de8 CD |
408 | (defun org-attach-expand (file) |
409 | "Return the full path to the current entry's attachment file FILE. | |
410 | Basically, this adds the path to the attachment directory." | |
411 | (expand-file-name file (org-attach-dir))) | |
412 | ||
413 | (defun org-attach-expand-link (file) | |
414 | "Return a file link pointing to the current entry's attachment file FILE. | |
415 | Basically, this adds the path to the attachment directory, and a \"file:\" | |
416 | prefix." | |
417 | (concat "file:" (org-attach-expand file))) | |
418 | ||
47ffc456 CD |
419 | (provide 'org-attach) |
420 | ||
421 | ;;; org-attach.el ends here |