[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] Changes to emacs/lisp/gnus/mm-decode.el,v
|
From: |
Miles Bader |
|
Subject: |
[Emacs-diffs] Changes to emacs/lisp/gnus/mm-decode.el,v |
|
Date: |
Sun, 16 Dec 2007 04:31:35 +0000 |
CVSROOT: /cvsroot/emacs
Module name: emacs
Changes by: Miles Bader <miles> 07/12/16 04:31:33
Index: lisp/gnus/mm-decode.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/gnus/mm-decode.el,v
retrieving revision 1.47
retrieving revision 1.48
diff -u -b -r1.47 -r1.48
--- lisp/gnus/mm-decode.el 11 Dec 2007 05:41:13 -0000 1.47
+++ lisp/gnus/mm-decode.el 16 Dec 2007 04:31:31 -0000 1.48
@@ -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)))))