From: keiichi <keiichi>
Date: Thu, 18 Feb 1999 08:18:58 +0000 (+0000)
Subject: (coding-system-get): New function.
X-Git-Tag: apel-mcs-2-9_12_2~15
X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=bd535b14308ab493bfb0deae7b0152b8ed6ab4a9;p=elisp%2Fapel.git

(coding-system-get): New function.
(mime-charset-list): Fix for Emacs 20.2.
---

diff --git a/mcs-e20.el b/mcs-e20.el
index a82b367..824582f 100644
--- 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
 ;;;