Browse Source

Cleaning up attachment support.

Among other things, introduce a security query before deleting
the entire attachment directory.  And add a new method to delete
a single attachment.
Carsten Dominik 16 years ago
parent
commit
82f1c863ee
3 changed files with 62 additions and 30 deletions
  1. 2 0
      doc/org.texi
  2. 8 0
      lisp/ChangeLog
  3. 52 30
      lisp/org-attach.el

+ 2 - 0
doc/org.texi

@@ -5190,12 +5190,14 @@ to select a command:
 @item a 
 Select a file and move it into the task's attachment directory.  The file
 will be copied, moved, or linked, depending on @code{org-attach-method}.
+Note that hard links are not supported on all systems.
 
 @kindex C-c C-a c
 @kindex C-c C-a m 
 @kindex C-c C-a l 
 @item c/m/l
 Attach a file using the copy/move/link method.
+Note that hard links are not supported on all systems.
 
 @kindex C-c C-a n
 @item n

+ 8 - 0
lisp/ChangeLog

@@ -1,3 +1,11 @@
+2008-10-09  Carsten Dominik  <dominik@science.uva.nl>
+
+	* org-attach.el (org-attach-delete-all): Renamed from
+	`org-attch-delete'.  Add a security query before deleting the
+	entire directory.  New optional argument FORCE can overrule the
+	security query.
+	(org-attach-delete-one): New command.
+
 2008-10-08  Carsten Dominik  <dominik@science.uva.nl>
 
 	* org-attach.el (org-attach-file-list): Fix bug with directory.

+ 52 - 30
lisp/org-attach.el

@@ -36,8 +36,7 @@
 ;; user, ever.  UUIDs are generated by a mechanism defined in the variable
 ;; `org-id-method'.
 
-;; Ideas:  Store region or kill as an attachment.
-;;         Support drag-and-drop 
+;;; Code:
 
 (eval-when-compile
   (require 'cl))
@@ -46,7 +45,7 @@
 
 (defgroup org-attach nil
   "Options concerning entry attachments in Org-mode."
-  :tag "Org Remember"
+  :tag "Org Attach"
   :group 'org)
 
 (defcustom org-attach-directory "data/"
@@ -72,12 +71,13 @@ This is not really needed, so you may set this to nil if you don't want it."
 	  (string :tag "Tag")))
 
 (defcustom org-attach-method 'cp
-  "Preferred method to attach a file.
+  "The preferred method to attach a file.
 Allowed values are:
 
 mv    rename the file to move it into the attachment directory
 cp    copy the file
-mv    create a hard link when possible.  If not, fall back to copy."
+ln    create a hard 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)
@@ -122,10 +122,11 @@ O       Like \"o\", but force opening in Emacs.
 f       Open current task's attachment directory.
 F       Like \"f\", but force using dired in Emacs.
 
+d       Delete one attachment, you will be prompted for a file name.
 D       Delete all of a task's attachments.  A safer way is
         to open the directory in dired and delete from there.")))
 	  (shrink-window-if-larger-than-buffer (get-buffer-window "*Org Attach*"))
-	  (message "Select command: [azoOfFD^a]")
+	  (message "Select command: [acmlzoOfFdD]")
 	  (setq c (read-char-exclusive))
 	  (and (get-buffer "*Org Attach*") (kill-buffer "*Org Attach*"))))
       (cond
@@ -142,8 +143,10 @@ D       Delete all of a task's attachments.  A safer way is
        ((eq c ?O)            (call-interactively 'org-attach-open-in-emacs))
        ((memq c '(?f ?\C-f)) (call-interactively 'org-attach-reveal))
        ((memq c '(?F))       (call-interactively 'org-attach-reveal-in-emacs))
-       ((eq c ?D)            (call-interactively 'org-attach-delete))
-       ((eq c ?q)            ((message "Abort")))
+       ((memq c '(?d ?\C-d)) (call-interactively
+			      'org-attach-delete-one))
+       ((eq c ?D)            (call-interactively 'org-attach-delete-all))
+       ((eq c ?q)            (message "Abort"))
        (t (error "No such attachment command %c" c))))))
 
 (defun org-attach-dir (&optional create-if-not-exists-p)
@@ -170,7 +173,8 @@ the directory and the corresponding ID will be created."
 	     attach-dir)))))
 
 (defun org-attach-commit ()
-  "Commit changes to git if available."
+  "Commit changes to git if `org-attach-directory' is properly initialized.
+This checks for the existence of a \".git\" directory in that directory."
   (let ((dir (expand-file-name org-attach-directory)))
     (if (file-exists-p (expand-file-name ".git" dir))
 	(shell-command
@@ -180,7 +184,7 @@ the directory and the corresponding ID will be created."
 		 " git commit -m 'Synchronized attachments')")))))
   
 (defun org-attach-tag (&optional off)
-  "Turn the autotag on."
+  "Turn the autotag on or (if OFF is set) off."
   (when org-attach-auto-tag
     (save-excursion
       (org-back-to-heading t)
@@ -191,8 +195,9 @@ the directory and the corresponding ID will be created."
   (org-attach-tag 'off))
 
 (defun org-attach-attach (file &optional visit-dir method)
-  "Move FILE into the attachment directory of the current task.
-If VISIT-DIR is non-nil, visit the direcory with dired."
+  "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'."
   (interactive "fFile to keep as an attachment: \nP")
   (setq method (or method org-attach-method))
   (let ((basename (file-name-nondirectory file)))
@@ -204,11 +209,7 @@ If VISIT-DIR is non-nil, visit the direcory with dired."
       (cond
        ((eq method 'mv)	(rename-file file fname))
        ((eq method 'cp)	(copy-file file fname))
-       ((eq method 'ln) 
-	(require 'eshell)
-	(require 'esh-opt)
-	(require 'em-unix)
-	(eshell/ln file fname)))
+       ((eq method 'ln) (add-name-to-file file fname)))
       (org-attach-commit)
       (org-attach-tag)
       (if visit-dir
@@ -216,12 +217,18 @@ If VISIT-DIR is non-nil, visit the direcory with dired."
 	(message "File \"%s\" is now a task attachment." basename)))))
 
 (defun org-attach-attach-cp ()
+  "Attach a file by copying it."
   (interactive)
   (let ((org-attach-method 'cp)) (call-interactively 'org-attach-attach)))
 (defun org-attach-attach-mv ()
+  "Attach a file by moving (renaming) it."
   (interactive)
   (let ((org-attach-method 'mv)) (call-interactively 'org-attach-attach)))
 (defun org-attach-attach-ln ()
+  "Attach a file by creating a hard link to it.
+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-new (file)
@@ -236,20 +243,41 @@ The attachment is created as an Emacs buffer."
     (find-file (expand-file-name file attach-dir))
     (message "New attachment %s" file)))
 
-(defun org-attach-delete ()
+(defun org-attach-delete-one (&optional file)
+  "Delete a single attachment."
+  (interactive)
+  (let* ((attach-dir (org-attach-dir t))
+	 (files (org-attach-file-list attach-dir))
+	 (file (or file
+		   (completing-read
+		    "Delete attachment: "
+		    (mapcar (lambda (f)
+			      (list (file-name-nondirectory f)))
+			    files)))))
+    (setq file (expand-file-name file attach-dir))
+    (unless (file-exists-p file)
+      (error "No such attachment: %s" file))
+    (delete-file file)))
+
+(defun org-attach-delete-all (&optional force)
   "Delete all attachments from the current task.
+This actually deletes the entire attachment directory.
 A safer way is to open the directory in dired and delete from there."
-  (interactive)
+  (interactive "P")
   (when org-attach-file-list-property
     (org-entry-delete (point) org-attach-file-list-property))
   (let ((attach-dir (org-attach-dir)))
-    (if attach-dir
-	(shell-command (format "rm -fr %s" attach-dir))))
-  (org-attach-commit)
-  (org-attach-untag))
+    (when 
+	(and attach-dir
+	     (or force
+		 (y-or-n-p "Are you sure you want to remove all attachments of this entry? ")))
+      (shell-command (format "rm -fr %s" attach-dir))
+      (message "Attachment directory removed")
+      (org-attach-commit)
+      (org-attach-untag))))
 
 (defun org-attach-sync ()
-  "Synchonize the current tasks with its attachments.
+  "Synchronize the current tasks with its attachments.
 This can be used after files have been added externally."
   (interactive)
   (org-attach-commit)
@@ -306,12 +334,6 @@ See `org-attach-open'."
   (interactive)
   (org-attach-open 'in-emacs))
 
-(defun org-attach-open-single-attachment (&optional in-emacs)
-  (interactive)
-  (let* ((attach-dir (org-attach-dir t))
-	 (file (read-file-name "Open attachment: " attach-dir nil t)))
-    (org-open-file file in-emacs)))
-
 (provide 'org-attach)
 
 ;;; org-attach.el ends here