From: Francois Fleuret <francois@fleuret.org>
Date: Sat, 25 Jan 2014 19:17:28 +0000 (+0100)
Subject: Added my own version of vm-mime-save-all-files to generate on the fly different filen... 
X-Git-Url: https://fleuret.org/cgi-bin/gitweb/gitweb.cgi?a=commitdiff_plain;h=40f205380c5c7665513bae29ad0b8a785afbcc66;p=elisp.git

Added my own version of vm-mime-save-all-files to generate on the fly different filenames when the file already exists.
---

diff --git a/vm b/vm
index 519cb69..0f4a218 100644
--- a/vm
+++ b/vm
@@ -684,3 +684,96 @@ instance, someone in bbdb named \"Paul Smith\" would generate an alias
     (message "Wrote files to %s" dir)
     )
   )
+
+(defun ff/make-nonexisting-filename (filename)
+  (let ((root filename)
+        (extension "")
+        (result filename))
+    (when (file-exists-p result)
+      (when (string-match "^\\(.*\\)\\(\\.[^\\.]*\\)$" filename)
+        (setq root (match-string 1 filename)
+              extension (match-string 2 filename)))
+      (let ((n 0))
+        (while (file-exists-p (setq result (format "%s_%03d%s" root n extension)))
+          (setq n (+ n 1)))))
+    result))
+
+(defun ff/vm-mime-save-all-attachments (&optional count
+                                               directory
+                                               no-delete-after-saving)
+  "Save all attachments in the next COUNT messages or marked
+messages.  For the purpose of this function, an \"attachment\" is
+a mime part part which has \"attachment\" as its disposition or
+simply has an associated filename.  Any mime types that match
+`vm-mime-savable-types' but not `vm-mime-savable-type-exceptions'
+are also included.
+
+The attachments are saved to the specified DIRECTORY.  The
+variables `vm-all-attachments-directory' or
+`vm-mime-attachment-save-directory' can be used to set the
+default location.  When directory does not exist it will be
+created."
+  (interactive
+   (list current-prefix-arg
+         (vm-read-file-name
+          "Attachment directory: "
+          (or vm-mime-all-attachments-directory
+              vm-mime-attachment-save-directory
+              default-directory)
+          (or vm-mime-all-attachments-directory
+              vm-mime-attachment-save-directory
+              default-directory)
+          nil nil
+          vm-mime-save-all-attachments-history)))
+
+  (vm-check-for-killed-summary)
+  (if (interactive-p) (vm-follow-summary-cursor))
+
+  (let ((n 0))
+    (vm-mime-action-on-all-attachments
+     count
+     ;; the action to be performed BEGIN
+     (lambda (msg layout type file)
+       (let ((directory (if (functionp directory)
+                            (funcall directory msg)
+                          directory)))
+         (setq file
+	       (if file
+		   (expand-file-name (file-name-nondirectory file) directory)
+		 (vm-read-file-name
+		  (format "Save %s to file: " type)
+		  (or directory
+		      vm-mime-all-attachments-directory
+		      vm-mime-attachment-save-directory)
+		  (or directory
+		      vm-mime-all-attachments-directory
+		      vm-mime-attachment-save-directory)
+		  nil nil
+		  vm-mime-save-all-attachments-history)
+		 ))
+
+         (setq file (ff/make-nonexisting-filename file))
+
+         (when file
+           (message "Saving `%s%s" type (if file (format " (%s)" file) ""))
+           (make-directory (file-name-directory file) t)
+           (vm-mime-send-body-to-file layout file file)
+           (if vm-mime-delete-after-saving
+               (let ((vm-mime-confirm-delete nil))
+                 (vm-mime-discard-layout-contents
+		  layout (expand-file-name file))))
+           (setq n (+ 1 n)))))
+     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; the action to be performed END
+     ;; attachment filters
+     vm-mime-savable-types
+     vm-mime-savable-type-exceptions)
+
+    (when (interactive-p)
+      (vm-discard-cached-data)
+      (vm-preview-current-message))
+
+    (if (> n 0)
+        (message "%d attachment%s saved" n (if (= n 1) "" "s"))
+      (message "No attachments to be saved!"))))
+
+(define-key vm-summary-mode-map [(control c) (control s)] 'ff/vm-mime-save-all-attachments)