Merge remote-tracking branch 'origin/no-gnus'
[gnus] / lisp / mm-decode.el
index 0961738..1278d11 100644 (file)
@@ -29,6 +29,7 @@
 
 (require 'mail-parse)
 (require 'mm-bodies)
+(require 'mm-archive)
 (eval-when-compile (require 'cl)
                   (require 'term))
 
@@ -248,6 +249,8 @@ before the external MIME handler is invoked."
     ("message/partial" mm-inline-partial identity)
     ("message/external-body" mm-inline-external-body identity)
     ("text/.*" mm-inline-text identity)
+    ("application/x-.?tar\\(-.*\\)?" mm-archive-dissect-and-inline identity)
+    ("application/zip" mm-archive-dissect-and-inline identity)
     ("audio/wav" mm-inline-audio
      (lambda (handle)
        (and (or (featurep 'nas-sound) (featurep 'native-sound))
@@ -297,6 +300,9 @@ before the external MIME handler is invoked."
     "application/pgp-signature" "application/x-pkcs7-signature"
     "application/pkcs7-signature" "application/x-pkcs7-mime"
     "application/pkcs7-mime"
+    "application/x-gtar-compressed"
+    "application/x-tar"
+    "application/zip"
     ;; Mutt still uses this even though it has already been withdrawn.
     "application/pgp")
   "List of media types that are to be displayed inline.
@@ -653,8 +659,25 @@ Postpone undisplaying of viewers for types in
            (if (equal "text/plain" (car ctl))
                (assoc 'format ctl)
              t))
-    (mm-make-handle
-     (mm-copy-to-buffer) ctl cte nil cdl description nil id)))
+    ;; Guess what the type of application/octet-stream parts should
+    ;; really be.
+    (let ((filename (cdr (assq 'filename (cdr cdl)))))
+      (when (and (equal (car ctl) "application/octet-stream")
+                filename
+                (string-match "\\.\\([^.]+\\)$" filename))
+       (let ((new-type (mailcap-extension-to-mime (match-string 1 filename))))
+         (when new-type
+           (setcar ctl new-type)))))
+    (let ((handle
+          (mm-make-handle
+           (mm-copy-to-buffer) ctl cte nil cdl description nil id))
+         (decoder (assoc (car ctl) mm-archive-decoders)))
+      (if (and decoder
+              ;; Do automatic decoding
+              (cadr decoder)
+              (executable-find (caddr decoder)))
+         (mm-dissect-archive handle)
+       handle))))
 
 (defun mm-dissect-multipart (ctl from)
   (goto-char (point-min))
@@ -918,46 +941,38 @@ external if displayed external."
                                   shell-command-switch command)
                    (set-process-sentinel
                     (get-buffer-process buffer)
-                    (lexical-let ;; Don't use `let'.
-                        ;; Function used to remove temp file and directory.
-                        ((fn `(lambda nil
-                                ;; Don't use `ignore-errors'.
-                                (condition-case nil
-                                    (delete-file ,file)
-                                  (error))
-                                (condition-case nil
-                                    (delete-directory
-                                     ,(file-name-directory file))
-                                  (error))))
-                         ;; Form uses to kill the process buffer and
-                         ;; remove the undisplayer.
-                         (fm `(progn
-                                (kill-buffer ,buffer)
-                                ,(macroexpand
-                                  (list 'mm-handle-set-undisplayer
-                                        (list 'quote handle)
-                                        nil))))
-                         ;; Message to be issued when the process exits.
-                         (done (format "Displaying %s...done" command))
-                         ;; In particular, the timer object (which is
-                         ;; a vector in Emacs but is a list in XEmacs)
-                         ;; requires that it is lexically scoped.
-                         (timer (run-at-time 30.0 nil 'ignore)))
-                      (if (featurep 'xemacs)
-                          (lambda (process state)
-                            (when (eq 'exit (process-status process))
-                              (if (memq timer itimer-list)
-                                  (set-itimer-function timer fn)
-                                (funcall fn))
-                              (ignore-errors (eval fm))
-                              (message "%s" done)))
-                        (lambda (process state)
-                          (when (eq 'exit (process-status process))
-                            (if (memq timer timer-list)
-                                (timer-set-function timer fn)
-                              (funcall fn))
-                            (ignore-errors (eval fm))
-                            (message "%s" done)))))))
+                    (lexical-let ((outbuf outbuf)
+                                  (file file)
+                                  (buffer buffer)
+                                  (command command)
+                                  (handle handle))
+                      (run-at-time
+                       30.0 nil
+                       (lambda ()
+                         (ignore-errors
+                           (delete-file file))
+                         (ignore-errors
+                           (delete-directory (file-name-directory file)))))
+                      (lambda (process state)
+                        (when (eq (process-status process) 'exit)
+                          (condition-case nil
+                              (delete-file file)
+                            (error))
+                          (condition-case nil
+                              (delete-directory (file-name-directory file))
+                            (error))
+                          (when (buffer-live-p outbuf)
+                            (with-current-buffer outbuf
+                              (let ((buffer-read-only nil)
+                                    (point (point)))
+                                (forward-line 2)
+                                (mm-insert-inline
+                                 handle (with-current-buffer buffer
+                                          (buffer-string)))
+                                (goto-char point))))
+                          (when (buffer-live-p buffer)
+                            (kill-buffer buffer)))
+                        (message "Displaying %s...done" command)))))
                (mm-handle-set-external-undisplayer
                 handle (cons file buffer)))
              (message "Displaying %s..." command))
@@ -1762,6 +1777,8 @@ If RECURSIVE, search recursively."
         (while (search-forward "­" nil t)
           (replace-match "" t t))
         (libxml-parse-html-region (point-min) (point-max))))
+      (unless (bobp)
+       (insert "\n"))
       (mm-handle-set-undisplayer
        handle
        `(lambda ()