From: Francois Fleuret 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)