Synch to No Gnus 200409220305.

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

diff --git a/lisp/mm-util.el b/lisp/mm-util.el
index cbaff05..50f0bca 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.
-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)
-       (coding-system-p cs)
+       (when (coding-system-p cs)
+         cs)
       ;; 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
   `(
@@ -160,6 +163,10 @@ In XEmacs, also return non-nil if CS is a coding system object."
               (mm-coding-system-p 'cp1250))
          '((windows-1250 . cp1250)))
     ;; A Microsoft misunderstanding.
+    ,@(if (and (not (mm-coding-system-p 'unicode))
+              (mm-coding-system-p 'utf-16-le))
+         '((unicode . utf-16-le)))
+    ;; A Microsoft misunderstanding.
     ,@(unless (mm-coding-system-p 'ks_c_5601-1987)
        (if (mm-coding-system-p 'cp949)
            '((ks_c_5601-1987 . cp949))
@@ -229,6 +236,7 @@ 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)
+    (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
@@ -261,24 +269,47 @@ In XEmacs, also return non-nil if CS is a coding system object."
                       (coding-system-get 'mule-utf-8 'safe-charsets)))))
   "Alist of MIME-charset/MULE-charsets.")
 
-;; Correct by construction, but should be unnecessary:
-;; XEmacs hates it.
-(when (and (not (featurep 'xemacs))
-          (fboundp 'coding-system-list)
-          (fboundp 'sort-coding-systems))
-  (setq mm-mime-mule-charset-alist
-       (apply
-        'nconc
-        (mapcar
-         (lambda (cs)
-           (when (and (or (coding-system-get cs :mime-charset) ; Emacs 22
-                          (coding-system-get cs 'mime-charset))
-                      (not (eq t (coding-system-get cs 'safe-charsets))))
-             (list (cons (or (coding-system-get cs :mime-charset)
-                             (coding-system-get cs 'mime-charset))
-                         (delq 'ascii
-                               (coding-system-get cs 'safe-charsets))))))
-         (sort-coding-systems (coding-system-list 'base-only))))))
+(defun mm-enrich-utf-8-by-mule-ucs ()
+  "Make the `utf-8' MIME charset usable by the Mule-UCS package.
+This function will run when the `un-define' module is loaded under
+XEmacs, and fill the `utf-8' entry in `mm-mime-mule-charset-alist'
+with Mule charsets.  It is completely useless for Emacs."
+  (unless (cdr (delete '(mm-enrich-utf-8-by-mule-ucs)
+                      (assoc "un-define" after-load-alist)))
+    (setq after-load-alist
+         (delete '("un-define") after-load-alist)))
+  (when (boundp 'unicode-basic-translation-charset-order-list)
+    (condition-case nil
+       (let ((val (delq
+                   'ascii
+                   (copy-sequence
+                    (symbol-value
+                     'unicode-basic-translation-charset-order-list))))
+             (elem (assq 'utf-8 mm-mime-mule-charset-alist)))
+         (if elem
+             (setcdr elem val)
+           (setq mm-mime-mule-charset-alist
+                 (nconc mm-mime-mule-charset-alist
+                        (list (cons 'utf-8 val))))))
+      (error))))
+
+;; Correct by construction, but should be unnecessary for Emacs:
+(if (featurep 'xemacs)
+    (eval-after-load "un-define" '(mm-enrich-utf-8-by-mule-ucs))
+  (when (and (fboundp 'coding-system-list)
+            (fboundp 'sort-coding-systems))
+    (let ((css (sort-coding-systems (coding-system-list 'base-only)))
+         cs mime mule alist)
+      (while css
+       (setq cs (pop css)
+             mime (or (coding-system-get cs :mime-charset) ; Emacs 22
+                      (coding-system-get cs 'mime-charset)))
+       (when (and mime
+                  (not (eq t (setq mule
+                                   (coding-system-get cs 'safe-charsets))))
+                  (not (assq mime alist)))
+         (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.
@@ -322,6 +353,7 @@ More than one suitable coding system may be found for some text.
 By default, the coding system with the highest priority is used
 to encode outgoing messages (see `sort-coding-systems').  If this
 variable is set, it overrides the default priority."
+  :version "21.2"
   :type '(repeat (symbol :tag "Coding system"))
   :group 'mime)
 
@@ -544,11 +576,11 @@ This affects whether coding conversion should be attempted generally."
   (let ((priorities
         (mapcar (lambda (cs)
                   ;; Note: invalid entries are dropped silently
-                  (and (mm-coding-system-p cs)
+                  (and (setq cs (mm-coding-system-p cs))
                        (coding-system-base cs)))
                 mm-coding-system-priorities)))
-    (and (mm-coding-system-p a)
-        (if (mm-coding-system-p b)
+    (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))))