update.

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

diff --git a/mcs-20.el b/mcs-20.el
index b98a1ef..77911a4 100644 (file)
--- a/mcs-20.el
+++ b/mcs-20.el
@@ -1,6 +1,6 @@
 ;;; mcs-20.el --- MIME charset implementation for Emacs 20 and XEmacs/mule
 
-;; Copyright (C) 1997,1998 Free Software Foundation, Inc.
+;; Copyright (C) 1997,1998,1999 Free Software Foundation, Inc.
 
 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
 ;; Keywords: emulation, compatibility, Mule
@@ -30,7 +30,7 @@
 ;;; Code:
 
 (require 'poem)
-(require 'custom)
+(require 'pcustom)
 (eval-when-compile (require 'wid-edit))
 
 
@@ -38,30 +38,41 @@
 ;;;
 
 (defcustom mime-charset-coding-system-alist
-  `,(let ((rest
-          '((us-ascii      . raw-text)
-            (gb2312        . cn-gb-2312)
-            (cn-gb         . cn-gb-2312)
-            (iso-2022-jp-2 . iso-2022-7bit-ss2)
-            (x-ctext       . ctext)
-            (unknown       . undecided)
-            (x-unknown     . undecided)
-            ))
-         dest)
-      (while rest
-       (let ((pair (car rest)))
-         (or (find-coding-system (car pair))
-             (setq dest (cons pair dest))
-             ))
-       (setq rest (cdr rest))
-       )
-      dest)
+  (let ((rest
+        '((us-ascii      . raw-text)
+          (gb2312        . cn-gb-2312)
+          (cn-gb         . cn-gb-2312)
+          (iso-2022-jp-2 . iso-2022-7bit-ss2)
+          (tis-620       . tis620)
+          (windows-874   . tis-620)
+          (cp874         . tis-620)
+          (x-ctext       . ctext)
+          (unknown       . undecided)
+          (x-unknown     . undecided)
+          ))
+       dest)
+    (while rest
+      (let ((pair (car rest)))
+       (or (find-coding-system (car pair))
+           (setq dest (cons pair dest))
+           ))
+      (setq rest (cdr rest))
+      )
+    dest)
   "Alist MIME CHARSET vs CODING-SYSTEM.
 MIME CHARSET and CODING-SYSTEM must be symbol."
   :group 'i18n
   :type '(repeat (cons symbol coding-system)))
 
-(defsubst mime-charset-to-coding-system (charset &optional lbt)
+(defcustom mime-charset-to-coding-system-default-method
+  nil
+  "Function called when suitable coding-system is not found from MIME-charset.
+It must be nil or function.
+If it is a function, interface must be (CHARSET LBT CODING-SYSTEM)."
+  :group 'i18n
+  :type '(choice function (const nil)))
+
+(defun mime-charset-to-coding-system (charset &optional lbt)
   "Return coding-system corresponding with CHARSET.
 CHARSET is a symbol whose name is MIME charset.
 If optional argument LBT (`CRLF', `LF', `CR', `unix', `dos' or `mac')
@@ -69,26 +80,24 @@ is specified, it is used as line break code type of coding-system."
   (if (stringp charset)
       (setq charset (intern (downcase charset)))
     )
-  (let ((ret (assq charset mime-charset-coding-system-alist)))
-    (if ret
-       (setq charset (cdr ret))
-      ))
-  (if lbt
-      (setq charset (intern (format "%s-%s" charset
-                                   (cond ((eq lbt 'CRLF) 'dos)
-                                         ((eq lbt 'LF) 'unix)
-                                         ((eq lbt 'CR) 'mac)
-                                         (t lbt)))))
-    )
-  (if (find-coding-system charset)
-      charset
-    ))
-
-(defsubst mime-charset-list ()
-  "Return a list of all existing MIME-charset."
-  (nconc (mapcar (function car) mime-charset-coding-system-alist)
-        (coding-system-list)))
-
+  (let ((cs (assq charset mime-charset-coding-system-alist)))
+    (setq cs
+         (if cs
+             (cdr cs)
+           charset))
+    (if lbt
+       (setq cs (intern (format "%s-%s" cs
+                                (cond ((eq lbt 'CRLF) 'dos)
+                                      ((eq lbt 'LF) 'unix)
+                                      ((eq lbt 'CR) 'mac)
+                                      (t lbt)))))
+      )
+    (if (find-coding-system cs)
+       cs
+      (if mime-charset-to-coding-system-default-method
+         (funcall mime-charset-to-coding-system-default-method
+                  charset lbt cs)
+       ))))
 
 (defvar widget-mime-charset-prompt-value-history nil
   "History of input to `widget-mime-charset-prompt-value'.")
@@ -129,9 +138,10 @@ It must be symbol."
   :group 'i18n
   :type 'mime-charset)
 
-(defsubst detect-mime-charset-region (start end)
+(defun detect-mime-charset-region (start end)
   "Return MIME charset for region between START and END."
-  (charsets-to-mime-charset (find-charset-region start end)))
+  (find-mime-charset-by-charsets (find-charset-region start end)
+                                'region start end))
 
 (defun write-region-as-mime-charset (charset start end filename
                                             &optional append visit lockname)
@@ -145,6 +155,7 @@ It must be symbol."
 ;;; @ end
 ;;;
 
-(provide 'mcs-20)
+(require 'product)
+(product-provide (provide 'mcs-20) (require 'apel-ver))
 
 ;;; mcs-20.el ends here