update.

[elisp/apel.git] / mcs-e20.el

diff --git a/mcs-e20.el b/mcs-e20.el
index a82b367..824582f 100644 (file)
--- a/mcs-e20.el
+++ b/mcs-e20.el
@@ -101,29 +101,56 @@
 ;          chinese-cns11643-7)                         . iso-2022-int-1)
     ))
 
+(defun-maybe coding-system-get (coding-system prop)
+  "Extract a value from CODING-SYSTEM's property list for property PROP."
+  (plist-get (coding-system-plist coding-system) prop)
+  )
 
 (defun coding-system-to-mime-charset (coding-system)
   "Convert CODING-SYSTEM to a MIME-charset.
 Return nil if corresponding MIME-charset is not found."
   (or (car (rassq coding-system mime-charset-coding-system-alist))
-      (coding-system-get coding-system 'mime-charset)))
+      (coding-system-get coding-system 'mime-charset)
+      ))
 
-(defun mime-charset-list ()
+(defun-maybe-cond mime-charset-list ()
   "Return a list of all existing MIME-charset."
-  (let ((dest (mapcar (function car) mime-charset-coding-system-alist))
-       (rest coding-system-list)
-       cs)
-    (while rest
-      (setq cs (car rest))
-      (unless (rassq cs mime-charset-coding-system-alist)
-       (if (setq cs (coding-system-get cs 'mime-charset))
+  ((boundp 'coding-system-list)
+   (let ((dest (mapcar (function car) mime-charset-coding-system-alist))
+        (rest coding-system-list)
+        cs)
+     (while rest
+       (setq cs (car rest))
+       (unless (rassq cs mime-charset-coding-system-alist)
+        (if (setq cs (coding-system-get cs 'mime-charset))
+            (or (rassq cs mime-charset-coding-system-alist)
+                (memq cs dest)  
+                (setq dest (cons cs dest))
+                )))
+       (setq rest (cdr rest)))
+     dest))
+   (t
+    (let ((dest (mapcar (function car) mime-charset-coding-system-alist))
+         (rest (coding-system-list))
+         cs)
+      (while rest
+       (setq cs (car rest))
+       (unless (rassq cs mime-charset-coding-system-alist)
+         (when (setq cs (or (coding-system-get cs 'mime-charset)
+                            (and
+                             (setq cs (aref
+                                       (coding-system-get cs 'coding-spec)
+                                       2))
+                             (string-match "(MIME:[ \t]*\\([^,)]+\\)" cs)
+                             (match-string 1 cs))))
+           (setq cs (intern (downcase cs)))
            (or (rassq cs mime-charset-coding-system-alist)
-               (memq cs dest)  
+               (memq cs dest)
                (setq dest (cons cs dest))
                )))
-      (setq rest (cdr rest)))
-    dest))
-
+       (setq rest (cdr rest)))
+      dest)
+    ))
 
 ;;; @ end
 ;;;