]> code.delx.au - gnu-emacs/blobdiff - lisp/mail/rmailmm.el
delx.au / code / gnu-emacs / blobdiff
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Merge from origin/emacs-25
[gnu-emacs] / lisp / mail / rmailmm.el
diff --git a/lisp/mail/rmailmm.el b/lisp/mail/rmailmm.el
index 120d517f55ca63b2514b80304a28edb16a142288..9343b11806753e92e3e28412bcb99efa64d0cbef 100644 (file)
--- a/lisp/mail/rmailmm.el
+++ b/lisp/mail/rmailmm.el
@@ -1,6 +1,6 @@
 ;;; rmailmm.el --- MIME decoding and display stuff for RMAIL
 
-;; Copyright (C) 2006-2015 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2016 Free Software Foundation, Inc.
 
 ;; Author: Alexander Pohoyda
 ;;     Alex Schroeder
@@ -135,9 +135,10 @@ automatically display the image in the buffer."
   (cond ((fboundp 'libxml-parse-html-region) 'rmail-mime-render-html-shr)
        ((executable-find "lynx") 'rmail-mime-render-html-lynx)
        (t nil))
-  "Function to convert HTML to text.  Called with buffer containing HTML
-extracted from message in a temporary buffer.  Converts to text in current 
-buffer. If NIL, display HTML source."
+  "Function to convert HTML to text.
+Called with buffer containing HTML extracted from message in a
+temporary buffer.  Converts to text in current buffer.  If nil,
+display HTML source."
   :group 'rmail
   :version "25.1"
   :type '(choice function (const nil)))
@@ -171,7 +172,7 @@ The value is usually nil, and bound to non-nil while inserting
 MIME entities.")
 
 (defvar rmail-mime-searching nil
-  "Bound to T inside `rmail-search-mime-message' to suppress expensive 
+  "Bound to T inside `rmail-search-mime-message' to suppress expensive
 operations such as HTML decoding")
 
 ;;; MIME-entity object
@@ -189,7 +190,7 @@ A MIME-entity is a vector of 10 elements:
 TYPE and DISPOSITION correspond to MIME headers Content-Type and
 Content-Disposition respectively, and have this format:
 
-  \(VALUE (ATTRIBUTE . VALUE) (ATTRIBUTE . VALUE) ...)
+  (VALUE (ATTRIBUTE . VALUE) (ATTRIBUTE . VALUE) ...)
 
 Each VALUE is a string and each ATTRIBUTE is a string.
 
@@ -201,7 +202,7 @@ Content-Type: multipart/mixed;
 The corresponding TYPE argument must be:
 
 \(\"multipart/mixed\"
-  \(\"boundary\" . \"----=_NextPart_000_0104_01C617E4.BDEC4C40\"))
+  (\"boundary\" . \"----=_NextPart_000_0104_01C617E4.BDEC4C40\"))
 
 TRANSFER-ENCODING corresponds to MIME header
 Content-Transfer-Encoding, and is a lower-case string.
@@ -661,6 +662,7 @@ HEADER is a header component of a MIME-entity object (see
        (transfer-encoding (rmail-mime-entity-transfer-encoding entity))
        (charset (cdr (assq 'charset (cdr (rmail-mime-entity-type entity)))))
        (buffer (current-buffer))
+       (case-fold-search t)
        coding-system)
     (if charset (setq coding-system (coding-system-from-name charset)))
     (or (and coding-system (coding-system-p coding-system))
@@ -674,6 +676,22 @@ HEADER is a header component of a MIME-entity object (see
             (ignore-errors (base64-decode-region (point-min) (point-max))))
            ((string= transfer-encoding "quoted-printable")
             (quoted-printable-decode-region (point-min) (point-max))))
+      ;; Some broken MUAs state the charset only in the HTML <head>,
+      ;; so if we don't have a non-trivial coding-system at this
+      ;; point, make one last attempt to find it there.
+      (if (eq coding-system 'undecided)
+         (save-excursion
+           (goto-char (point-min))
+           (when (re-search-forward
+                  "^<html><head><meta[^;]*; charset=\\([-a-zA-Z0-9]+\\)"
+                  nil t)
+             (setq coding-system (coding-system-from-name (match-string 1)))
+             (or (and coding-system (coding-system-p coding-system))
+                 (setq coding-system 'undecided)))
+           ;; Finally, let them manually force decoding if they know it.
+           (if (and (eq coding-system 'undecided)
+                    (not (null coding-system-for-read)))
+               (setq coding-system coding-system-for-read))))
       (decode-coding-region (point-min) (point) coding-system)
       (if (and
           (or (not rmail-mime-coding-system) (consp rmail-mime-coding-system))
@@ -688,6 +706,9 @@ HEADER is a header component of a MIME-entity object (see
              (insert-buffer-substring source-buffer))
            (rmail-mime-fix-inserted-faces start)))))))
 
+(declare-function libxml-parse-html-region "xml.c"
+                 (start end &optional base-url discard-comments))
+
 (defun rmail-mime-render-html-shr (source-buffer)
   (let ((dom (with-current-buffer source-buffer
               (libxml-parse-html-region (point-min) (point-max))))
@@ -715,12 +736,12 @@ HEADER is a header component of a MIME-entity object (see
 (defun rmail-mime-fix-inserted-faces (start)
   (while (< start (point))
     (let ((face (get-text-property start 'face))
-         (next (next-single-property-change 
+         (next (next-single-property-change
                 start 'face (current-buffer) (point))))
       (if face                         ; anything to do?
          (put-text-property start next 'font-lock-face face))
       (setq start next))))
-    
+
 (defun rmail-mime-toggle-button (button)
   "Hide or show the body of the MIME-entity associated with BUTTON."
   (save-excursion
@@ -1098,11 +1119,11 @@ are the values of the respective parsed headers.  The latter should
 be lower-case.  The parsed headers for CONTENT-TYPE and CONTENT-DISPOSITION
 have the form
 
-  \(VALUE . ALIST)
+  (VALUE . ALIST)
 
 In other words:
 
-  \(VALUE (ATTRIBUTE . VALUE) (ATTRIBUTE . VALUE) ...)
+  (VALUE (ATTRIBUTE . VALUE) (ATTRIBUTE . VALUE) ...)
 
 VALUE is a string and ATTRIBUTE is a symbol.
 
@@ -1114,7 +1135,7 @@ Content-Type: multipart/mixed;
 The parsed header value:
 
 \(\"multipart/mixed\"
-  \(\"boundary\" . \"----=_NextPart_000_0104_01C617E4.BDEC4C40\"))"
+  (\"boundary\" . \"----=_NextPart_000_0104_01C617E4.BDEC4C40\"))"
   ;; Handle the content transfer encodings we know.  Unknown transfer
   ;; encodings will be passed on to the various handlers.
   (cond ((string= content-transfer-encoding "base64")
@@ -1539,7 +1560,7 @@ This is the usual value of `rmail-insert-mime-forwarded-message-function'."
 (provide 'rmailmm)
 
 ;; Local Variables:
-;; generated-autoload-file: "rmail.el"
+;; generated-autoload-file: "rmail-loaddefs.el"
 ;; End:
 
 ;;; rmailmm.el ends here