Add support for creating symbolic links in org-attach

1 files changed, 18 insertions, 4 deletions

diff --git a/lisp/org-attach.el b/lisp/org-attach.el
index a87993f..cc6b593 100644
--- a/lisp/org-attach.el
+++ b/lisp/org-attach.el
@@ -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.