mm-shr: Prefer charset specified in html meta tag

* lisp/gnus/mm-decode.el (mm-shr): Prefer charset specified in html
meta tag than mail-parse-charset in the case there is no charset spec
in MIME header.

1 files changed, 36 insertions, 32 deletions

diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el
index 989d4b8ea17..6b539399596 100644
--- a/lisp/gnus/mm-decode.el
+++ b/lisp/gnus/mm-decode.el
@@ -1793,40 +1793,44 @@ If RECURSIVE, search recursively."
                                       (buffer-string))))))
         (shr-inhibit-images mm-html-inhibit-images)
         (shr-blocked-images mm-html-blocked-images)
-        charset coding char)
-    (unless handle
-      (setq handle (mm-dissect-buffer t)))
-    (and (setq charset
-               (or (mail-content-type-get (mm-handle-type handle) 'charset)
-                   mail-parse-charset))
-         (setq coding (mm-charset-to-coding-system charset nil t))
-         (eq coding 'ascii)
-         (setq coding nil))
+        charset coding char document)
+    (mm-with-part (or handle (setq handle (mm-dissect-buffer t)))
+      (setq case-fold-search t)
+      (setq charset
+            (or (mail-content-type-get (mm-handle-type handle) 'charset)
+                (progn
+                  (goto-char (point-min))
+                  (and (re-search-forward "\
+<meta\\s-+http-equiv=[\"']?content-type[\"']?\\s-+content=[\"']?\
+text/\\(\\sw+\\)\\(?:;\\s-*charset=\\([^\t\n\r \"'>]+\\)\\)?[^>]*>" nil t)
+                       (setq coding
+                             (mm-charset-to-coding-system (match-string 2)
+                                                          nil t))
+                       (string-match "\\`html\\'" (match-string 1))))
+                mail-parse-charset))
+      (when (or coding
+                (setq coding (mm-charset-to-coding-system charset nil t)))
+        (insert (prog1
+                    (decode-coding-string (buffer-string) coding)
+                  (erase-buffer)
+                  (set-buffer-multibyte t))))
+      (goto-char (point-min))
+      (while (re-search-forward
+              "&#\\(?:x\\([89][0-9a-f]\\)\\|\\(1[2-5][0-9]\\)\\);" nil t)
+        (when (setq char
+                    (cdr (assq (if (match-beginning 1)
+                                   (string-to-number (match-string 1) 16)
+                                 (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))
+      (setq document (libxml-parse-html-region (point-min) (point-max))))
     (save-restriction
       (narrow-to-region (point) (point))
-      (shr-insert-document
-       (mm-with-part handle
-         (insert (prog1
-                     (if coding
-                         (decode-coding-string (buffer-string) coding)
-                       (buffer-string))
-                   (erase-buffer)
-                   (mm-enable-multibyte)))
-         (goto-char (point-min))
-         (setq case-fold-search t)
-         (while (re-search-forward
-                 "&#\\(?:x\\([89][0-9a-f]\\)\\|\\(1[2-5][0-9]\\)\\);" nil t)
-           (when (setq char
-                       (cdr (assq (if (match-beginning 1)
-                                      (string-to-number (match-string 1) 16)
-                                    (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))))
+      (shr-insert-document document)
       (unless (bobp)
         (insert "\n"))
       (mm-convert-shr-links)