Mercurial > emacs
diff lisp/gnus/mm-decode.el @ 87300:b968c7f9a8b4
Merge from gnus--devo--0
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-955
| author | Miles Bader <miles@gnu.org> |
|---|---|
| date | Sun, 16 Dec 2007 04:31:33 +0000 |
| parents | 23ea76295829 |
| children | 0cbc451989a7 2fcaae6177a5 |
line wrap: on
line diff
--- a/lisp/gnus/mm-decode.el Sat Dec 15 11:37:25 2007 +0000 +++ b/lisp/gnus/mm-decode.el Sun Dec 16 04:31:33 2007 +0000 @@ -1239,9 +1239,39 @@ (mm-save-part-to-file handle file) file)))) +(defun mm-add-meta-html-tag (handle &optional charset) + "Add meta html tag to specify CHARSET of HANDLE in the current buffer. +CHARSET defaults to the one HANDLE specifies. Existing meta tag that +specifies charset will not be modified. Return t if meta tag is added +or replaced." + (when (equal (mm-handle-media-type handle) "text/html") + (when (or charset + (setq charset (mail-content-type-get (mm-handle-type handle) + 'charset))) + (setq charset (format "\ +<meta http-equiv=\"Content-Type\" content=\"text/html; charset=%s\">" charset)) + (let ((case-fold-search t)) + (goto-char (point-min)) + (if (re-search-forward "\ +<meta\\s-+http-equiv=[\"']?content-type[\"']?\\s-+content=[\"']\ +text/\\(\\sw+\\)\\(?:\;\\s-*charset=\\(.+?\\)\\)?[\"'][^>]*>" nil t) + (if (and (match-beginning 2) + (string-match "\\`html\\'" (match-string 1))) + ;; Don't modify existing meta tag. + nil + ;; Replace it with the one specifying charset. + (replace-match charset) + t) + (if (re-search-forward "<head>\\s-*" nil t) + (insert charset "\n") + (re-search-forward "<html\\(?:\\s-+[^>]+\\|\\s-*\\)>\\s-*" nil t) + (insert "<head>\n" charset "\n</head>\n")) + t))))) + (defun mm-save-part-to-file (handle file) (mm-with-unibyte-buffer (mm-insert-part handle) + (mm-add-meta-html-tag handle) (let ((current-file-modes (default-file-modes))) (set-default-file-modes mm-attachment-file-modes) (unwind-protect @@ -1258,6 +1288,7 @@ (read-string "Shell command on MIME part: " mm-last-shell-command))) (mm-with-unibyte-buffer (mm-insert-part handle) + (mm-add-meta-html-tag handle) (let ((coding-system-for-write 'binary)) (shell-command-on-region (point-min) (point-max) command nil)))))