X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fmm-archive.el;h=d88e159900bd405955da43ae14fe384196708c30;hb=aaa6f741d48c765c5af9312004d6d49e14c9304c;hp=c141fdb504cc054d84f75df358addb5932ce8bf0;hpb=9a274e2717761b1e96dfd82c66a0133fe31c3315;p=gnus

diff --git a/lisp/mm-archive.el b/lisp/mm-archive.el
index c141fdb50..d88e15990 100644
--- a/lisp/mm-archive.el
+++ b/lisp/mm-archive.el
@@ -1,6 +1,6 @@
 ;;; mm-archive.el --- Functions for parsing archive files as MIME
 
-;; Copyright (C) 2012  Free Software Foundation, Inc.
+;; Copyright (C) 2012-2015 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; This file is part of GNU Emacs.
@@ -22,14 +22,22 @@
 
 ;;; Code:
 
+(require 'mm-decode)
+(eval-when-compile
+  (autoload 'gnus-recursive-directory-files "gnus-util")
+  (autoload 'mailcap-extension-to-mime "mailcap"))
+
 (defvar mm-archive-decoders
-  '(("application/ms-tnef" "tnef" "-f" "-" "-C")
-    ("application/x-gtar-compressed" "tar" "xzf" "-" "-C")
-    ("application/x-tar" "tar" "xf" "-" "-C")))
+  '(("application/ms-tnef" t "tnef" "-f" "-" "-C")
+    ("application/zip" nil "unzip" "-j" "-x" "%f" "-d")
+    ("application/x-gtar-compressed" nil "tar" "xzf" "-" "-C")
+    ("application/x-tar" nil "tar" "xf" "-" "-C")))
+
+(defun mm-archive-decoders () mm-archive-decoders)
 
 (defun mm-dissect-archive (handle)
-  (let ((decoder (cdr (assoc (car (mm-handle-type handle))
-			     mm-archive-decoders)))
+  (let ((decoder (cddr (assoc (car (mm-handle-type handle))
+			      mm-archive-decoders)))
 	(dir (mm-make-temp-file
 	      (expand-file-name "emm." mm-tmp-directory) 'dir)))
     (set-file-modes dir #o700)
@@ -37,45 +45,63 @@
 	(progn
 	  (mm-with-unibyte-buffer
 	    (mm-insert-part handle)
-	    (apply 'call-process-region (point-min) (point-max) (car decoder)
-		   nil (get-buffer-create "*tnef*")
-		   nil (append (cdr decoder) (list dir))))
+	    (if (member "%f" decoder)
+		(let ((file (expand-file-name "mail.zip" dir)))
+		  (write-region (point-min) (point-max) file nil 'silent)
+		  (setq decoder (copy-sequence decoder))
+		  (setcar (member "%f" decoder) file)
+		  (apply 'call-process (car decoder) nil nil nil
+			 (append (cdr decoder) (list dir)))
+		  (delete-file file))
+	      (apply 'call-process-region (point-min) (point-max) (car decoder)
+		     nil (get-buffer-create "*tnef*")
+		     nil (append (cdr decoder) (list dir)))))
 	  `("multipart/mixed"
 	    ,handle
-	    ,@(mm-archive-list-files dir)))
-      (dolist (file (directory-files dir))
-	(unless (member file '("." ".."))
-	  (ignore-errors
-	    (delete-file (expand-file-name file dir)))))
-      (ignore-errors
-	(delete-directory dir)))))
+	    ,@(mm-archive-list-files (gnus-recursive-directory-files dir))))
+      (delete-directory dir t))))
 
-(defun mm-archive-list-files (dir)
+(defun mm-archive-list-files (files)
   (let ((handles nil)
 	type disposition)
-    (dolist (file (directory-files dir))
-      (unless (member file '("." ".."))
-	(with-temp-buffer
-	  (when (string-match "\\.\\([^.]+\\)$" file)
-	    (setq type (mailcap-extension-to-mime (match-string 1 file))))
-	  (unless type
-	    (setq type "application/octet-stream"))
-	  (setq disposition
-		(if (string-match "^image/\\|^text/" type)
-		    "inline"
-		  "attachment"))
-	  (insert (format "Content-type: %s\n" type))
-	  (insert "Content-Transfer-Encoding: 8bit\n\n")
-	  (insert-file-contents (expand-file-name file dir))
-	  (push
-	   (mm-make-handle (mm-copy-to-buffer)
-			   (list type)
-			   '8bit nil
-			   `(,disposition (filename . ,file))
-			   nil nil nil)
-	   handles))))
+    (dolist (file files)
+      (with-temp-buffer
+	(when (string-match "\\.\\([^.]+\\)$" file)
+	  (setq type (mailcap-extension-to-mime (match-string 1 file))))
+	(unless type
+	  (setq type "application/octet-stream"))
+	(setq disposition
+	      (if (string-match "^image/\\|^text/" type)
+		  "inline"
+		"attachment"))
+	(insert (format "Content-type: %s\n" type))
+	(insert "Content-Transfer-Encoding: 8bit\n\n")
+	(insert-file-contents file)
+	(push
+	 (mm-make-handle (mm-copy-to-buffer)
+			 (list type)
+			 '8bit nil
+			 `(,disposition (filename . ,file))
+			 nil nil nil)
+	 handles)))
     handles))
 
+(defun mm-archive-dissect-and-inline (handle)
+  (let ((start (point-marker)))
+    (save-restriction
+      (narrow-to-region (point) (point))
+      (dolist (handle (cddr (mm-dissect-archive handle)))
+	(goto-char (point-max))
+	(mm-display-inline handle))
+      (goto-char (point-max))
+      (mm-handle-set-undisplayer
+       handle
+       `(lambda ()
+	  (let ((inhibit-read-only t)
+		(end ,(point-marker)))
+	    (remove-images ,start end)
+	    (delete-region ,start end)))))))
+
 (provide 'mm-archive)
 
 ;; mm-archive.el ends here