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