From: tomo <tomo>
Date: Tue, 24 Aug 2004 12:58:47 +0000 (+0000)
Subject: (char-cns11643-p): New function [copied from ids/ids-util.el].
X-Git-Tag: chise-base-0_23~31
X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=4e001be6fdf3c0735edf808a4e87d93d44aa36a3;p=chise%2Ftomoyo-tools.git

(char-cns11643-p): New function [copied from ids/ids-util.el].
(char-ks-x1001-p): New function.
(find-char-variant): New function.
(char-representative-of-ucs): New function.
(char-representative-of-domain): New function.
(ideo-translate-string-into-ucs): New function.
(ideo-translate-string-into-traditional): New function.
---

diff --git a/ideo-trans.el b/ideo-trans.el
index df05dae..d0b84d0 100644
--- a/ideo-trans.el
+++ b/ideo-trans.el
@@ -24,6 +24,67 @@
 
 ;;; Code:
 
+(defun char-cns11643-p (char &optional defined-only)
+  (some (lambda (n)
+	  (encode-char char
+		       (intern (format "=cns11643-%d" n))
+		       defined-only))
+	'(1 2 3 4 5 6 7)))
+
+(defun char-ks-x1001-p (char &optional defined-only)
+  (encode-char char 'korean-ksc5601 defined-only))
+
+(defun find-char-variant (char predicate)
+  (if (funcall predicate char)
+      char
+    (let ((ucs (char-ucs char))
+	  variants)
+      (if (and ucs
+	       (setq variants
+		     (char-variants (decode-char 'ucs ucs))))
+	  (while (and variants
+		      (setq char (car variants))
+		      (not (funcall predicate char)))
+	    (setq variants (cdr variants))))
+      char)))
+
+;;;###autoload
+(defun char-representative-of-ucs (char)
+  "Convert CHAR into representative character of UCS."
+  (if (setq ret (char-ucs char))
+      (decode-char '=ucs ret)
+    char))
+
+;;;###autoload
+(defun char-representative-of-domain (char domain)
+  "Convert CHAR into representative character of DOMAIN."
+  (let (ret)
+    (cond ((eq domain 'daikanwa)
+	   (char-representative-of-daikanwa char))
+	  ((eq domain 'ucs)
+	   (char-representative-of-ucs char))
+	  ((eq domain 'cns)
+	   (if (setq ret (char-feature char '=>ucs@cns))
+	       (decode-char '=ucs@cns ret)
+	     (find-char-variant char 'char-cns11643-p)))
+	  ((eq domain 'ks)
+	   (if (setq ret (char-feature char '=>ucs@ks))
+	       (decode-char '=ucs@ks ret)
+	     (find-char-variant char 'char-ks-x1001-p)))
+	  ((setq ret
+		 (or (char-feature char
+				   (intern (format "=>ucs@%s" domain)))
+		     (char-ucs char)))
+	   (decode-char (intern (format "=ucs@%s" domain)) ret))
+	  (t char))))
+
+;;;###autoload
+(defun ideo-translate-string-into-ucs (string)
+  "Convert characters in STRING into UCS-representative characters."
+  (mapconcat (lambda (char)
+	       (char-to-string (char-representative-of-ucs char)))
+	     string ""))
+
 ;;;###autoload
 (defun ideo-translate-string-into-simplified-chinese (string)
   "Simplify Chinese traditional characters in STRING."
@@ -68,6 +129,41 @@
      string "")))
 
 ;;;###autoload
+(defun ideo-translate-string-into-traditional (string)
+  "Convert simplified Kanji in STRING into traditional characters."
+  (let (uchr ret)
+    (mapconcat
+     (lambda (chr)
+       (char-to-string
+	(cond ((car (char-feature chr '<-simplified)))
+	      ((progn
+		 (setq ret
+		       (cond ((setq ret (char-feature chr '=>ucs@jis))
+			      (decode-char '=ucs@jis ret))
+			     ((setq ret (char-ucs chr))
+			      (decode-char '=ucs@jp ret))
+			     (t chr)))
+		 (setq ret (or (char-feature ret '<-simplified@JP/Jouyou)
+			       (char-feature ret '<-simplified@JP))))
+	       (car ret))
+	      ((progn
+		 (setq ret
+		       (cond ((setq ret (char-feature chr '=>ucs@gb))
+			      (decode-char '=ucs@gb ret))
+			     ((setq ret (char-ucs chr))
+			      (decode-char '=ucs@gb ret))
+			     (t chr)))
+		 (if (setq ret (encode-char ret 'chinese-gb2312))
+		     (setq ret (decode-char 'chinese-gb12345 ret))))
+	       ret)
+	      ((setq ret (char-feature chr '=>ucs@jis))
+	       (decode-char '=ucs@jis ret))
+	      ((setq ret (char-ucs chr))
+	       (decode-char '=ucs@jp ret))
+	      (t chr))))
+     string "")))
+
+;;;###autoload
 (defun ideo-translate-region-into-traditional (start end)
   (interactive "r")
   (save-excursion