Revert removal of `mm-hack-charsets' in Gnus

Revision: emacs@sv.gnu.org/emacs--devo--0--patch-1076

diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index 8b65a32aed3e90316728fd51fe25cff2aacc627a..93151d1389ebcafd67840ab0ab706234de67585d 100644 (file)
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,11 @@
+2008-02-24  Miles Bader  <miles@gnu.org>
+
+       * mm-util.el (mm-hack-charsets, mm-iso-8859-15-compatible)
+       (mm-iso-8859-x-to-15-table, mm-iso-8859-x-to-15-region)
+       (mm-find-mime-charset-region):
+       * mm-bodies.el (mm-encode-body):
+       * mml.el (mml-parse-1): Revert removal of `mm-hack-charsets'.
+
 2008-02-16  Reiner Steib  <Reiner.Steib@gmx.de>
 
        * mail-source.el (mail-source-delete-incoming): Change default.

diff --git a/lisp/gnus/mm-bodies.el b/lisp/gnus/mm-bodies.el
index be209a3e0048b2c7a7695509bdb7a4bcde044d97..90d4acbdcd77cf98888a4f7959c0099076507445 100644 (file)
--- a/lisp/gnus/mm-bodies.el
+++ b/lisp/gnus/mm-bodies.el
@@ -104,7 +104,8 @@ If no encoding was done, nil is returned."
                                     (mm-charset-to-coding-system charset))
            charset)
        (goto-char (point-min))
-       (let ((charsets (mm-find-mime-charset-region (point-min) (point-max))))
+       (let ((charsets (mm-find-mime-charset-region (point-min) (point-max)
+                                                    mm-hack-charsets)))
          (cond
           ;; No encoding.
           ((null charsets)

diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el
index 2f473ff184c43d652470fa0ecf35ae58aee5d9a1..8e625c936e464c737838a4ed7ea2352387004769 100644 (file)
--- a/lisp/gnus/mm-util.el
+++ b/lisp/gnus/mm-util.el
@@ -576,6 +576,36 @@ with Mule charsets.  It is completely useless for Emacs."
          (push (cons mime (delq 'ascii mule)) alist)))
       (setq mm-mime-mule-charset-alist (nreverse alist)))))
 
+(defvar mm-hack-charsets '(iso-8859-15 iso-2022-jp-2)
+  "A list of special charsets.
+Valid elements include:
+`iso-8859-15'    convert ISO-8859-1, -9 to ISO-8859-15 if ISO-8859-15 exists.
+`iso-2022-jp-2'  convert ISO-2022-jp to ISO-2022-jp-2 if ISO-2022-jp-2 exists."
+)
+
+(defvar mm-iso-8859-15-compatible
+  '((iso-8859-1 "\xA4\xA6\xA8\xB4\xB8\xBC\xBD\xBE")
+    (iso-8859-9 "\xA4\xA6\xA8\xB4\xB8\xBC\xBD\xBE\xD0\xDD\xDE\xF0\xFD\xFE"))
+  "ISO-8859-15 exchangeable coding systems and inconvertible characters.")
+
+(defvar mm-iso-8859-x-to-15-table
+  (and (fboundp 'coding-system-p)
+       (mm-coding-system-p 'iso-8859-15)
+       (mapcar
+       (lambda (cs)
+         (if (mm-coding-system-p (car cs))
+             (let ((c (string-to-char
+                       (decode-coding-string "\341" (car cs)))))
+               (cons (char-charset c)
+                     (cons
+                      (- (string-to-char
+                          (decode-coding-string "\341" 'iso-8859-15)) c)
+                      (string-to-list (decode-coding-string (car (cdr cs))
+                                                            (car cs))))))
+           '(gnus-charset 0)))
+       mm-iso-8859-15-compatible))
+  "A table of the difference character between ISO-8859-X and ISO-8859-15.")
+
 (defcustom mm-coding-system-priorities
   (if (boundp 'current-language-environment)
       (let ((lang (symbol-value 'current-language-environment)))
@@ -829,6 +859,27 @@ This affects whether coding conversion should be attempted generally."
          default-enable-multibyte-characters
        t)))
 
+(defun mm-iso-8859-x-to-15-region (&optional b e)
+  (if (fboundp 'char-charset)
+      (let (charset item c inconvertible)
+       (save-restriction
+         (if e (narrow-to-region b e))
+         (goto-char (point-min))
+         (skip-chars-forward "\0-\177")
+         (while (not (eobp))
+           (cond
+            ((not (setq item (assq (char-charset (setq c (char-after)))
+                                   mm-iso-8859-x-to-15-table)))
+             (forward-char))
+            ((memq c (cdr (cdr item)))
+             (setq inconvertible t)
+             (forward-char))
+            (t
+             (insert-before-markers (prog1 (+ c (car (cdr item)))
+                                      (delete-char 1)))))
+           (skip-chars-forward "\0-\177")))
+       (not inconvertible))))
+
 (defun mm-sort-coding-systems-predicate (a b)
   (let ((priorities
         (mapcar (lambda (cs)
@@ -976,6 +1027,26 @@ charset, and a longer list means no appropriate charset."
               (mapcar 'mm-mime-charset
                       (delq 'ascii
                             (mm-find-charset-region b e))))))
+    (if (and (> (length charsets) 1)
+            (memq 'iso-8859-15 charsets)
+            (memq 'iso-8859-15 hack-charsets)
+            (save-excursion (mm-iso-8859-x-to-15-region b e)))
+       (dolist (x mm-iso-8859-15-compatible)
+         (setq charsets (delq (car x) charsets))))
+    (if (and (memq 'iso-2022-jp-2 charsets)
+            (memq 'iso-2022-jp-2 hack-charsets))
+       (setq charsets (delq 'iso-2022-jp charsets)))
+    ;; Attempt to reduce the number of charsets if utf-8 is available.
+    (if (and (featurep 'xemacs)
+            (> (length charsets) 1)
+            (mm-coding-system-p 'utf-8))
+       (let ((mm-coding-system-priorities
+              (cons 'utf-8 mm-coding-system-priorities)))
+         (setq charsets
+               (mm-delete-duplicates
+                (mapcar 'mm-mime-charset
+                        (delq 'ascii
+                              (mm-find-charset-region b e)))))))
     charsets))
 
 (defmacro mm-with-unibyte-buffer (&rest forms)

diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el
index c335e985d0e135852617dcc5b3a60ccdc8475c2b..2b5987e5e6eef77b92c2a8c77fffd329c819fb2f 100644 (file)
--- a/lisp/gnus/mml.el
+++ b/lisp/gnus/mml.el
@@ -284,7 +284,8 @@ part.  This is for the internal use, you should never modify the value.")
                         (list
                          (intern (downcase (cdr (assq 'charset tag))))))
                        (t
-                        (mm-find-mime-charset-region point (point)))))
+                        (mm-find-mime-charset-region point (point)
+                                                     mm-hack-charsets))))
        (when (and (not raw) (memq nil charsets))
          (if (or (memq 'unknown-encoding mml-confirmation-set)
                  (message-options-get 'unknown-encoding)