Synch to No Gnus 200406290509.

[elisp/gnus.git-] / lisp / mm-util.el

diff --git a/lisp/mm-util.el b/lisp/mm-util.el
index 6bcc05f..7913ac1 100644 (file)
--- a/lisp/mm-util.el
+++ b/lisp/mm-util.el
@@ -128,13 +128,16 @@
 
 (defun mm-coding-system-p (cs)
   "Return non-nil if CS is a symbol naming a coding system.
 
 (defun mm-coding-system-p (cs)
   "Return non-nil if CS is a symbol naming a coding system.

-In XEmacs, also return non-nil if CS is a coding system object."
+In XEmacs, also return non-nil if CS is a coding system object.
+If CS is available, return CS itself in Emacs, and return a coding
+system object in XEmacs."

   (if (fboundp 'find-coding-system)
       (find-coding-system cs)
     (if (fboundp 'coding-system-p)
   (if (fboundp 'find-coding-system)
       (find-coding-system cs)
     (if (fboundp 'coding-system-p)

-       (coding-system-p cs)
+       (when (coding-system-p cs)
+         cs)

       ;; Is this branch ever actually useful?
       ;; Is this branch ever actually useful?

-      (memq cs (mm-get-coding-system-list)))))
+      (car (memq cs (mm-get-coding-system-list))))))

 
 (defvar mm-charset-synonym-alist
   `(
 
 (defvar mm-charset-synonym-alist
   `(

@@ -229,12 +232,12 @@ In XEmacs, also return non-nil if CS is a coding system object."
     (big5 chinese-big5-1 chinese-big5-2)
     (tibetan tibetan)
     (thai-tis620 thai-tis620)
     (big5 chinese-big5-1 chinese-big5-2)
     (tibetan tibetan)
     (thai-tis620 thai-tis620)

+    (windows-1251 cyrillic-iso8859-5)

     (iso-2022-7bit ethiopic arabic-1-column arabic-2-column)
     (iso-2022-jp-2 latin-iso8859-1 greek-iso8859-7
                   latin-jisx0201 japanese-jisx0208-1978
                   chinese-gb2312 japanese-jisx0208
     (iso-2022-7bit ethiopic arabic-1-column arabic-2-column)
     (iso-2022-jp-2 latin-iso8859-1 greek-iso8859-7
                   latin-jisx0201 japanese-jisx0208-1978
                   chinese-gb2312 japanese-jisx0208

-                  korean-ksc5601 japanese-jisx0212
-                  katakana-jisx0201)
+                  korean-ksc5601 japanese-jisx0212)

     (iso-2022-int-1 latin-iso8859-1 greek-iso8859-7
                    latin-jisx0201 japanese-jisx0208-1978
                    chinese-gb2312 japanese-jisx0208
     (iso-2022-int-1 latin-iso8859-1 greek-iso8859-7
                    latin-jisx0201 japanese-jisx0208-1978
                    chinese-gb2312 japanese-jisx0208

@@ -249,6 +252,9 @@ In XEmacs, also return non-nil if CS is a coding system object."
                    chinese-cns11643-3 chinese-cns11643-4
                    chinese-cns11643-5 chinese-cns11643-6
                    chinese-cns11643-7)
                    chinese-cns11643-3 chinese-cns11643-4
                    chinese-cns11643-5 chinese-cns11643-6
                    chinese-cns11643-7)

+    (iso-2022-jp-3 latin-jisx0201 japanese-jisx0208-1978 japanese-jisx0208
+                  japanese-jisx0213-1 japanese-jisx0213-2)
+    (shift_jis latin-jisx0201 katakana-jisx0201 japanese-jisx0208)

     ,(if (or (not (fboundp 'charsetp)) ;; non-Mule case
             (charsetp 'unicode-a)
             (not (mm-coding-system-p 'mule-utf-8)))
     ,(if (or (not (fboundp 'charsetp)) ;; non-Mule case
             (charsetp 'unicode-a)
             (not (mm-coding-system-p 'mule-utf-8)))

@@ -312,9 +318,8 @@ Valid elements include:
   (if (boundp 'current-language-environment)
       (let ((lang (symbol-value 'current-language-environment)))
        (cond ((string= lang "Japanese")
   (if (boundp 'current-language-environment)
       (let ((lang (symbol-value 'current-language-environment)))
        (cond ((string= lang "Japanese")

-              ;; Japanese users may prefer iso-2022-jp to shift-jis.
-              '(iso-2022-jp iso-2022-jp-2 japanese-shift-jis
-                            iso-latin-1 utf-8)))))
+              ;; Japanese users may prefer iso-2022-jp to shift_jis.
+              '(iso-2022-jp iso-2022-jp-2 shift_jis iso-8859-1 utf-8)))))

   "Preferred coding systems for encoding outgoing messages.
 
 More than one suitable coding system may be found for some text.
   "Preferred coding systems for encoding outgoing messages.
 
 More than one suitable coding system may be found for some text.

@@ -340,16 +345,20 @@ mail with multiple parts is preferred to sending a Unicode one.")
   "Return the MIME charset corresponding to the given Mule CHARSET."
   (if (and (fboundp 'find-coding-systems-for-charsets)
           (fboundp 'sort-coding-systems))
   "Return the MIME charset corresponding to the given Mule CHARSET."
   (if (and (fboundp 'find-coding-systems-for-charsets)
           (fboundp 'sort-coding-systems))

-      (let (mime)
-       (dolist (cs (sort-coding-systems
-                    (copy-sequence
-                     (find-coding-systems-for-charsets (list charset)))))
-         (unless mime
-           (when cs
-             (setq mime (or (coding-system-get cs :mime-charset)
-                            (coding-system-get cs 'mime-charset))))))
+      (let ((css (sort (sort-coding-systems
+                       (find-coding-systems-for-charsets (list charset)))
+                      'mm-sort-coding-systems-predicate))
+           cs mime)
+       (while (and (not mime)
+                   css)
+         (when (setq cs (pop css))
+           (setq mime (or (coding-system-get cs :mime-charset)
+                          (coding-system-get cs 'mime-charset)))))

        mime)
        mime)

-    (let ((alist mm-mime-mule-charset-alist)
+    (let ((alist (mapcar (lambda (cs)
+                          (assq cs mm-mime-mule-charset-alist))
+                        (sort (mapcar 'car mm-mime-mule-charset-alist)
+                              'mm-sort-coding-systems-predicate)))

          out)
       (while alist
        (when (memq charset (cdar alist))
          out)
       (while alist
        (when (memq charset (cdar alist))

@@ -539,11 +548,14 @@ This affects whether coding conversion should be attempted generally."
   (let ((priorities
         (mapcar (lambda (cs)
                   ;; Note: invalid entries are dropped silently
   (let ((priorities
         (mapcar (lambda (cs)
                   ;; Note: invalid entries are dropped silently

-                  (and (coding-system-p cs)
+                  (and (setq cs (mm-coding-system-p cs))

                        (coding-system-base cs)))
                 mm-coding-system-priorities)))
                        (coding-system-base cs)))
                 mm-coding-system-priorities)))

-    (> (length (memq a priorities))
-       (length (memq b priorities)))))
+    (and (setq a (mm-coding-system-p a))
+        (if (setq b (mm-coding-system-p b))
+            (> (length (memq (coding-system-base a) priorities))
+               (length (memq (coding-system-base b) priorities)))
+          t))))

 
 (defun mm-find-mime-charset-region (b e &optional hack-charsets)
   "Return the MIME charsets needed to encode the region between B and E.
 
 (defun mm-find-mime-charset-region (b e &optional hack-charsets)
   "Return the MIME charsets needed to encode the region between B and E.