tec/org-mode
tec
/
org-mode
forked from mirrors/org-mode
1
0
Fork 0
Code Pull Requests Releases Activity

Add support for creating symbolic links in org-attach

This commit is contained in:
John Wiegley 2012-04-12 13:20:39 -05:00
parent 165d34af6a
commit 0c302d412c
1 changed files with 18 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
lisp/org-attach.el
View File

@ -78,12 +78,15 @@ Allowed values are:
mv rename the file to move it into the attachment directory
cp copy the file
ln create a hard link. Note that this is not supported
on all systems, and then the result is not defined.
lns create a symbol link. Note that this is not supported
on all systems, and then the result is not defined."
:group 'org-attach
:type '(choice
(const :tag "Copy" cp)
(const :tag "Move/Rename" mv)
(const :tag "Link" ln)))
(const :tag "Hard Link" ln)
(const :tag "Symbol Link" lns)))
(defcustom org-attach-expert nil
"Non-nil means do not show the splash buffer with the attach dispatcher."
@ -130,7 +133,7 @@ Shows a list of commands and prompts for another key to execute a command."
(princ "Select an Attachment Command:
a Select a file and attach it to the task, using `org-attach-method'.
c/m/l Attach a file using copy/move/link method.
c/m/l/y Attach a file using copy/move/link/symbolic-link method.
n Create a new attachment, as an Emacs buffer.
z Synchronize the current task with its attachment
directory, in case you added attachments yourself.
@ -158,6 +161,8 @@ i Make children of the current entry inherit its attachment directory.")))
(let ((org-attach-method 'mv)) (call-interactively 'org-attach-attach)))
((memq c '(?l ?\C-l))
(let ((org-attach-method 'ln)) (call-interactively 'org-attach-attach)))
((memq c '(?y ?\C-y))
(let ((org-attach-method 'lns)) (call-interactively 'org-attach-attach)))
((memq c '(?n ?\C-n)) (call-interactively 'org-attach-new))
((memq c '(?z ?\C-z)) (call-interactively 'org-attach-sync))
((memq c '(?o ?\C-o)) (call-interactively 'org-attach-open))
@ -282,7 +287,8 @@ Only do this when `org-attach-store-link-p' is non-nil."
(defun org-attach-attach (file &optional visit-dir method)
"Move/copy/link FILE into the attachment directory of the current task.
If VISIT-DIR is non-nil, visit the directory with dired.
METHOD may be `cp', `mv', or `ln', default taken from `org-attach-method'."
METHOD may be `cp', `mv', `ln', or `lns' default taken from
`org-attach-method'."
(interactive "fFile to keep as an attachment: \nP")
(setq method (or method org-attach-method))
(let ((basename (file-name-nondirectory file)))
@ -294,7 +300,8 @@ METHOD may be `cp', `mv', or `ln', default taken from `org-attach-method'."
(cond
((eq method 'mv) (rename-file file fname))
((eq method 'cp) (copy-file file fname))
((eq method 'ln) (add-name-to-file file fname)))
((eq method 'ln) (add-name-to-file file fname))
((eq method 'lns) (make-symbolic-link file fname)))
(org-attach-commit)
(org-attach-tag)
(cond ((eq org-attach-store-link-p 'attached)
@ -319,6 +326,13 @@ Beware that this does not work on systems that do not support hard links.
On some systems, this apparently does copy the file instead."
(interactive)
(let ((org-attach-method 'ln)) (call-interactively 'org-attach-attach)))
(defun org-attach-attach-lns ()
"Attach a file by creating a symbolic link to it.
Beware that this does not work on systems that do not support symbolic links.
On some systems, this apparently does copy the file instead."
(interactive)
(let ((org-attach-method 'lns)) (call-interactively 'org-attach-attach)))
(defun org-attach-new (file)
"Create a new attachment FILE for the current task.