From 55dcd93f265c0c927ab746d088b3405aaa85d539 Mon Sep 17 00:00:00 2001
From: Katsumi Yamaoka <yamaoka@jpl.org>
Date: Wed, 10 Dec 2008 10:03:11 +0000
Subject: [PATCH] * rfc2047.el (rfc2047-charset-to-coding-system): Add new
 argument `allow-override' which says whether to use
 `mm-charset-override-alist'. (rfc2047-decode-encoded-words): Use it.

* mm-util.el (mm-charset-override-alist): Fix custom type;
add `(gb2312 . gbk)' to choices.
---
 lisp/ChangeLog  |  9 +++++++++
 lisp/mm-util.el | 45 ++++++++++++++++++++++++++++++++++++---------
 lisp/rfc2047.el | 12 ++++++++----
 3 files changed, 53 insertions(+), 13 deletions(-)

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index cc0eb3933..e1563f71e 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,12 @@
+2008-12-10  Katsumi Yamaoka  <yamaoka@jpl.org>
+
+	* rfc2047.el (rfc2047-charset-to-coding-system): Add new argument
+	`allow-override' which says whether to use `mm-charset-override-alist'.
+	(rfc2047-decode-encoded-words): Use it.
+
+	* mm-util.el (mm-charset-override-alist): Fix custom type;
+	add `(gb2312 . gbk)' to choices.
+
 2008-12-04  Katsumi Yamaoka  <yamaoka@jpl.org>
 
 	* mm-view.el (mm-inline-text-html-render-with-w3m): Make it simple and
diff --git a/lisp/mm-util.el b/lisp/mm-util.el
index 383b1b879..4630cefc2 100644
--- a/lisp/mm-util.el
+++ b/lisp/mm-util.el
@@ -397,15 +397,42 @@ Unless LIST is given, `mm-codepage-ibm-list' is used."
 You may add pairs like (iso-8859-1 . windows-1252) here,
 i.e. treat iso-8859-1 as windows-1252.  windows-1252 is a
 superset of iso-8859-1."
-  :type '(list (set :inline t
-		    (const (iso-8859-1 . windows-1252))
-		    (const (iso-8859-8 . windows-1255))
-		    (const (iso-8859-9 . windows-1254))
-		    (const (undecided  . windows-1252)))
-	       (repeat :inline t
-		       :tag "Other options"
-		       (cons (symbol :tag "From charset")
-			     (symbol :tag "To charset"))))
+  :type
+  '(list
+    :convert-widget
+    (lambda (widget)
+      (let ((defaults
+	      (delq nil
+		    (mapcar (lambda (pair)
+			      (if (mm-charset-to-coding-system (cdr pair))
+				  pair))
+			    '((gb2312 . gbk)
+			      (iso-8859-1 . windows-1252)
+			      (iso-8859-8 . windows-1255)
+			      (iso-8859-9 . windows-1254)
+			      (undecided  . windows-1252)))))
+	    (val (copy-sequence (default-value 'mm-charset-override-alist)))
+	    pair rest)
+	(while val
+	  (push (if (and (prog1
+			     (setq pair (assq (caar val) defaults))
+			   (setq defaults (delq pair defaults)))
+			 (equal (car val) pair))
+		    `(const ,pair)
+		  `(cons :format "%v"
+			 (const :format "(%v" ,(caar val))
+			 (symbol :size 3 :format " . %v)\n" ,(cdar val))))
+		rest)
+	  (setq val (cdr val)))
+	(while defaults
+	  (push `(const ,(pop defaults)) rest))
+	(widget-convert
+	 'list
+	 `(set :inline t :format "%v" ,@(nreverse rest))
+	 `(repeat :inline t :tag "Other options"
+		  (cons :format "%v"
+			(symbol :size 3 :format "(%v")
+			(symbol :size 3 :format " . %v)\n")))))))
   :version "22.1" ;; Gnus 5.10.9
   :group 'mime)
 
diff --git a/lisp/rfc2047.el b/lisp/rfc2047.el
index ea5274798..fb1c3606e 100644
--- a/lisp/rfc2047.el
+++ b/lisp/rfc2047.el
@@ -902,9 +902,13 @@ them.")
 	    (error
 	     (goto-char beg))))))))
 
-(defun rfc2047-charset-to-coding-system (charset)
+(defun rfc2047-charset-to-coding-system (charset &optional allow-override)
   "Return coding-system corresponding to MIME CHARSET.
-If your Emacs implementation can't decode CHARSET, return nil."
+If your Emacs implementation can't decode CHARSET, return nil.
+
+If allow-override is given, use `mm-charset-override-alist' to
+map undesired charset names to their replacement.  This should
+only be used for decoding, not for encoding."
   (when (stringp charset)
     (setq charset (intern (downcase charset))))
   (when (or (not charset)
@@ -912,7 +916,7 @@ If your Emacs implementation can't decode CHARSET, return nil."
 	    (memq 'gnus-all mail-parse-ignored-charsets)
 	    (memq charset mail-parse-ignored-charsets))
     (setq charset mail-parse-charset))
-  (let ((cs (mm-charset-to-coding-system charset)))
+  (let ((cs (mm-charset-to-coding-system charset nil allow-override)))
     (cond ((eq cs 'ascii)
 	   (setq cs (or (mm-charset-to-coding-system mail-parse-charset)
 			'raw-text)))
@@ -933,7 +937,7 @@ ENCODED-WORD)."
     (while words
       (setq word (pop words))
       (if (and (setq cs (rfc2047-charset-to-coding-system
-			 (setq charset (car word))))
+			 (setq charset (car word)) t))
 	       (condition-case code
 		   (cond ((char-equal ?B (nth 1 word))
 			  (setq text (base64-decode-string
-- 
2.34.1