X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=mcs-20.el;h=7b785855e08dbea7e8c5180aab5eab02c761a76a;hb=329b62714dec924ad4ea1e664f4b0e90391bc513;hp=49bc116ecc20b5e524675bfc191ff8abc276fb79;hpb=ac8e0c04154839e03d6f36f4eb7052940742d5d9;p=elisp%2Fapel.git

diff --git a/mcs-20.el b/mcs-20.el
index 49bc116..7b78585 100644
--- a/mcs-20.el
+++ b/mcs-20.el
@@ -1,8 +1,8 @@
 ;;; mcs-20.el --- MIME charset implementation for Emacs 20 and XEmacs/mule
 
-;; Copyright (C) 1997,1998,1999 Free Software Foundation, Inc.
+;; Copyright (C) 1997,1998,1999,2000 Free Software Foundation, Inc.
 
-;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Author: MORIOKA Tomohiko <tomo@m17n.org>
 ;; Keywords: emulation, compatibility, Mule
 
 ;; This file is part of APEL (A Portable Emacs Library).
@@ -29,10 +29,13 @@
 
 ;;; Code:
 
-(require 'poem)
 (require 'custom)
 (eval-when-compile (require 'wid-edit))
 
+(if (featurep 'xemacs)
+    (require 'mcs-xm)
+  (require 'mcs-e20))
+
 
 ;;; @ MIME charset
 ;;;
@@ -43,8 +46,10 @@
 	   (gb2312	  . cn-gb-2312)
 	   (cn-gb	  . cn-gb-2312)
 	   (iso-2022-jp-2 . iso-2022-7bit-ss2)
+	   (iso-2022-jp-3 . iso-2022-7bit-ss2)
 	   (tis-620	  . tis620)
-	   (windows-874	  . tis620)
+	   (windows-874	  . tis-620)
+	   (cp874	  . tis-620)
 	   (x-ctext       . ctext)
 	   (unknown       . undecided)
 	   (x-unknown     . undecided)
@@ -71,7 +76,7 @@ If it is a function, interface must be (CHARSET LBT CODING-SYSTEM)."
   :group 'i18n
   :type '(choice function (const nil)))
 
-(defsubst mime-charset-to-coding-system (charset &optional lbt)
+(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')
@@ -98,6 +103,8 @@ is specified, it is used as line break code type of coding-system."
 		   charset lbt cs)
 	))))
 
+(defalias 'mime-charset-p 'mime-charset-to-coding-system)
+
 (defvar widget-mime-charset-prompt-value-history nil
   "History of input to `widget-mime-charset-prompt-value'.")
 
@@ -130,43 +137,85 @@ is specified, it is used as line break code type of coding-system."
     (widget-apply widget :notify widget event)
     (widget-setup)))
 
-(defcustom default-mime-charset 'x-ctext
+(defcustom default-mime-charset 'x-unknown
   "Default value of MIME-charset.
 It is used when MIME-charset is not specified.
 It must be symbol."
   :group 'i18n
   :type 'mime-charset)
 
-(defcustom default-mime-charset-for-write
-  (if (find-coding-system 'utf-8)
-      'utf-8
-    default-mime-charset)
-  "Default value of MIME-charset for encoding.
-It may be used when suitable MIME-charset is not found.
-It must be symbol."
-  :group 'i18n
-  :type 'mime-charset)
-
-(defcustom default-mime-charset-detect-method-for-write
-  nil
-  "Function called when suitable MIME-charset is not found to encode.
-It must be nil or function.
-If it is nil, variable `default-mime-charset-for-write' is used.
-If it is a function, interface must be (TYPE CHARSETS &rest ARGS).
-CHARSETS is list of charset.
-If TYPE is 'region, ARGS has START and END."
-  :group 'i18n
-  :type '(choice function (const nil)))
+(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 ((charsets (find-charset-region start end)))
-    (or (charsets-to-mime-charset charsets)
-	(if default-mime-charset-detect-method-for-write
-	    (funcall default-mime-charset-detect-method-for-write
-		     'region charsets start end)
-	  default-mime-charset-for-write)
-	)))
+  (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)
@@ -180,6 +229,7 @@ If TYPE is 'region, ARGS has START and END."
 ;;; @ end
 ;;;
 
-(provide 'mcs-20)
+(require 'product)
+(product-provide (provide 'mcs-20) (require 'apel-ver))
 
 ;;; mcs-20.el ends here