nnweb.el (nnweb-google-parse-1): Fix minor Y10k bug

[gnus] / lisp / mm-decode.el

diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el
index 6ec226f..8076b2e 100644 (file)
--- a/lisp/mm-decode.el
+++ b/lisp/mm-decode.el
@@ -1,6 +1,6 @@
 ;;; mm-decode.el --- Functions for decoding MIME things
 
-;; Copyright (C) 1998-2012  Free Software Foundation, Inc.
+;; Copyright (C) 1998-2012 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;;     MORIOKA Tomohiko <morioka@jaist.ac.jp>
@@ -29,7 +29,6 @@
 
 (require 'mail-parse)
 (require 'mm-bodies)
-(require 'mm-archive)
 (eval-when-compile (require 'cl)
                   (require 'term))
 
@@ -42,6 +41,10 @@
 (autoload 'mm-extern-cache-contents "mm-extern")
 (autoload 'mm-insert-inline "mm-view")
 
+(autoload 'mm-archive-decoders "mm-archive")
+(autoload 'mm-archive-dissect-and-inline "mm-archive")
+(autoload 'mm-dissect-archive "mm-archive")
+
 (defvar gnus-current-window-configuration)
 
 (add-hook 'gnus-exit-gnus-hook 'mm-destroy-postponed-undisplay-list)
@@ -249,6 +252,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))
@@ -276,7 +281,8 @@ before the external MIME handler is invoked."
                     (ignore-errors
                       (if (fboundp 'create-image)
                           (create-image (buffer-string) 'imagemagick 'data-p)
-                        (mm-create-image-xemacs (mm-handle-media-subtype handle))))))
+                        (mm-create-image-xemacs
+                         (mm-handle-media-subtype handle))))))
                (when image
                  (setcar (cdr handle) (list "image/imagemagick"))
                  (mm-image-fit-p handle)))))))
@@ -298,6 +304,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.
@@ -568,7 +577,9 @@ Postpone undisplaying of viewers for types in
 (autoload 'message-fetch-field "message")
 
 (defun mm-dissect-buffer (&optional no-strict-mime loose-mime from)
-  "Dissect the current buffer and return a list of MIME handles."
+  "Dissect the current buffer and return a list of MIME handles.
+If NO-STRICT-MIME, don't require the message to have a
+MIME-Version header before proceeding."
   (save-excursion
     (let (ct ctl type subtype cte cd description id result)
       (save-restriction
@@ -654,12 +665,23 @@ Postpone undisplaying of viewers for types in
            (if (equal "text/plain" (car ctl))
                (assoc 'format ctl)
              t))
+    ;; 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)))
+         (decoder (assoc (car ctl) (mm-archive-decoders))))
       (if (and decoder
-              (executable-find (cadr decoder)))
+              ;; Do automatic decoding
+              (cadr decoder)
+              (executable-find (caddr decoder)))
          (mm-dissect-archive handle)
        handle))))
 
@@ -1492,7 +1514,7 @@ be determined."
   (let ((image (mm-get-image handle)))
     (or (not image)
        (if (featurep 'xemacs)
-           ;; XEmacs' glyphs can actually tell us about their width, so
+           ;; XEmacs's glyphs can actually tell us about their width, so
            ;; let's be nice and smart about them.
            (or mm-inline-large-images
                (and (<= (glyph-width image) (window-pixel-width))
@@ -1756,6 +1778,10 @@ If RECURSIVE, search recursively."
                                    (string-to-number (match-string 2)))
                                  mm-extra-numeric-entities)))
             (replace-match (char-to-string char))))
+        ;; Remove "soft hyphens".
+        (goto-char (point-min))
+        (while (search-forward "­" nil t)
+          (replace-match "" t t))
         (libxml-parse-html-region (point-min) (point-max))))
       (unless (bobp)
        (insert "\n"))