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