From: hmurata <hmurata>
Date: Mon, 5 Feb 2007 13:32:57 +0000 (+0000)
Subject: (wl-summary-extract-attachments): New command.
X-Git-Tag: wl-2_15_6-fixes~91
X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=b0ac79f0ccdf11be40156f97af175855852b6d3e;p=elisp%2Fwanderlust.git

(wl-summary-extract-attachments): New command.
(wl-summary-extract-attachments-1): New internal function.
---

diff --git a/wl/ChangeLog b/wl/ChangeLog
index 5fe7c10..2253176 100644
--- a/wl/ChangeLog
+++ b/wl/ChangeLog
@@ -1,3 +1,8 @@
+2007-02-05  Hiroya Murata  <lapis-lazuli@pop06.odn.ne.jp>
+
+	* wl-mime.el (wl-summary-extract-attachments): New command.
+	(wl-summary-extract-attachments-1): New internal function.
+
 2007-01-14  Hiroya Murata  <lapis-lazuli@pop06.odn.ne.jp>
 
 	* wl-expire.el (wl-expire-folder): New function (split from
diff --git a/wl/wl-mime.el b/wl/wl-mime.el
index befea05..d64d10f 100644
--- a/wl/wl-mime.el
+++ b/wl/wl-mime.el
@@ -757,6 +757,44 @@ With ARG, ask destination folder."
       (setq wl-mime-save-directory (file-name-directory filename))
       (mime-write-entity-content entity filename))))
 
+(defun wl-summary-extract-attachments-1 (message-entity directory number)
+  ;; returns new number.
+  (let (children filename)
+    (cond
+     ((setq children (mime-entity-children message-entity))
+      (dolist (entity children)
+	(setq number
+	      (wl-summary-extract-attachments-1 entity directory number))))
+     ((and (eq (mime-content-disposition-type
+		(mime-entity-content-disposition message-entity))
+	       'attachment)
+	   (setq filename (mime-entity-safe-filename message-entity)))
+      (let ((full (expand-file-name filename directory)))
+	(when (or (not (file-exists-p full))
+		  (yes-or-no-p
+		   (format "File %s exists. Save anyway? " filename)))
+	  (message "Extracting...%s" (setq number (+ 1 number)))
+	  (mime-write-entity-content message-entity full)))))
+    number))
+
+(defun wl-summary-extract-attachments (directory)
+  "Extract attachment parts in MIME format into the DIRECTORY."
+  (interactive
+   (let* ((default (or wl-mime-save-directory
+		       wl-temporary-file-directory))
+	  (directory (read-directory-name "Extract to " default default t)))
+     (list (if (> (length directory) 0) directory default))))
+  (unless (and (file-writable-p directory)
+	       (file-directory-p directory))
+    (error "%s is not writable" directory))
+  (save-excursion
+    (wl-summary-set-message-buffer-or-redisplay)
+    (let ((entity (get-text-property (point-min) 'mime-view-entity)))
+      (when entity
+	(message "Extracting...")
+	(wl-summary-extract-attachments-1 entity directory 0)
+	(message "Extracting...done")))))
+
 ;;; Yet another combine method.
 (defun wl-mime-combine-message/partial-pieces (entity situation)
   "Internal method for wl to combine message/partial messages automatically."