(mcs-region-repertoire-p): New function for UTF-2000 implementations.

(mcs-string-repertoire-p): Likewise.
(detect-mime-charset-region): New implementation for UTF-2000
implementations.
(detect-mime-charset-string): New function for UTF-2000
implementations.

diff --git a/mcs-20.el b/mcs-20.el
index ca9f394..7b78585 100644 (file)
--- a/mcs-20.el
+++ b/mcs-20.el
@@ -144,10 +144,78 @@ It must be symbol."
   :group 'i18n
   :type 'mime-charset)
 
+(cond ((featurep 'utf-2000)
+;; for CHISE Architecture
+(defun mcs-region-repertoire-p (start end charsets &optional buffer)
+  (save-excursion
+    (if buffer
+       (set-buffer buffer))
+    (save-restriction
+      (narrow-to-region start end)
+      (goto-char (point-min))
+      (catch 'tag
+       (let (ch)
+         (while (not (eobp))
+           (setq ch (char-after (point)))
+           (unless (some (lambda (ccs)
+                           (encode-char ch ccs))
+                         charsets)
+             (throw 'tag nil))
+           (forward-char)))
+       t))))
+
+(defun mcs-string-repertoire-p (string charsets &optional start end)
+  (let ((i (if start
+              (if (< start 0)
+                  (error 'args-out-of-range string start end)
+                start)
+            0))
+       ch)
+    (if end
+       (if (> end (length string))
+           (error 'args-out-of-range string start end))
+      (setq end (length string)))
+    (catch 'tag
+      (while (< i end)
+       (setq ch (aref string i))
+       (unless (some (lambda (ccs)
+                       (encode-char ch ccs))
+                     charsets)
+         (throw 'tag nil))
+       (setq i (1+ i)))
+      t)))
+
+(defun detect-mime-charset-region (start end)
+  "Return MIME charset for region between START and END."
+  (let ((rest charsets-mime-charset-alist)
+       cell)
+    (catch 'tag
+      (while rest
+       (setq cell (car rest))
+       (if (mcs-region-repertoire-p start end (car cell))
+           (throw 'tag (cdr cell)))
+       (setq rest (cdr rest)))
+      default-mime-charset-for-write)))
+
+(defun detect-mime-charset-string (string)
+  "Return MIME charset for STRING."
+  (let ((rest charsets-mime-charset-alist)
+       cell)
+    (catch 'tag
+      (while rest
+       (setq cell (car rest))
+       (if (mcs-string-repertoire-p string (car cell))
+           (throw 'tag (cdr cell)))
+       (setq rest (cdr rest)))
+      default-mime-charset-for-write)))
+)
+(t
+;; for legacy Mule
 (defun detect-mime-charset-region (start end)
   "Return MIME charset for region between START and 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)