X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fmm-archive.el;h=7cfa4659fd997ed443d06a52cd29a567e0d0b0c9;hb=873ba7b51ddfb07246cd874b7de72662308236c9;hp=d8f47dfc411fdaea0c5df937047dc76a0dc3922b;hpb=c8262557b3e9277ce42d13affb13aa50b5ae85cb;p=gnus diff --git a/lisp/mm-archive.el b/lisp/mm-archive.el index d8f47dfc4..7cfa4659f 100644 --- a/lisp/mm-archive.el +++ b/lisp/mm-archive.el @@ -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,9 +45,17 @@ (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 (gnus-recursive-directory-files dir)))) @@ -60,7 +76,7 @@ "attachment")) (insert (format "Content-type: %s\n" type)) (insert "Content-Transfer-Encoding: 8bit\n\n") - (insert-file-contents (expand-file-name file dir)) + (insert-file-contents file) (push (mm-make-handle (mm-copy-to-buffer) (list type) @@ -70,6 +86,22 @@ 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