(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 (file)
--- 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