update.

[chise/tomoyo-tools.git] / ideo-trans.el

diff --git a/ideo-trans.el b/ideo-trans.el
index 3edfdec..e4f8998 100644 (file)
--- a/ideo-trans.el
+++ b/ideo-trans.el
@@ -1,6 +1,6 @@
 ;;; ideo-trans.el --- Translation utility for Ideographic Strings
 
-;; Copyright (C) 2003,2004 MORIOKA Tomohiko
+;; Copyright (C) 2003,2004,2005,2008,2012 MORIOKA Tomohiko
 
 ;; Author: MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
 ;; Keywords: Ideographs, Character Database, Chaon, CHISE
@@ -97,8 +97,8 @@
                    (setq chr (decode-char '=ucs@gb ret)))
                   ((setq ret (char-ucs chr))
                    (setq chr (decode-char '=ucs@gb ret))
-                   (if (setq ret (get-char-attribute chr '=>ucs*))
-                       (decode-char '=ucs@gb ret)
+                   (if (setq ret (char-feature chr '=>ucs*))
+                       (setq chr (decode-char '=ucs@gb ret))
                      chr))
                   (t chr)))
        (char-to-string
@@ -117,20 +117,68 @@
   'chinese-simplify-string)
 
 ;;;###autoload
+(defvar japanese-simplified-relation-features
+  '(->simplified@JP/Jouyou
+    ->simplified@jp-jouyou
+    ;; ->simplified@JP/extra
+    ;; ->simplified@JP/extra/design
+    ;; ->simplified@JP/jis
+    ;; ->simplified@JP/jis/2004
+    ;; ->simplified@JP/jis/1978
+    ;; ->simplified@JP/misc
+    ;; ->simplified@JP
+    ;; ->simplified@jp
+    ;; ->jp-simplified
+    ;; ->simplified
+    ;; ->simplified@JP/old
+    ;; ->simplified@JP/buddhism
+    )
+  "List of relation features to map traditional Kanji to simplified Kanji used in Japanese.")
+
+;;;###autoload
+(defvar japanese-traditional-relation-features
+  '(<-simplified@JP/Jouyou
+    <-simplified@jp-jouyou
+    <-simplified@JP/extra
+    <-simplified@JP/extra/design
+    <-simplified@JP/jis
+    <-simplified@JP/jis/2004
+    <-simplified@JP/jis/1978
+    <-simplified@JP/misc
+    <-simplified@JP
+    <-simplified@jp
+    <-jp-simplified
+    <-simplified
+    ;; <-simplified@JP/old
+    ;; <-simplified@JP/buddhism
+    )
+  "List of relation features to map simplified Kanji to traditional Kanji used in Japanese.")
+
+;;;###autoload
 (defun japanese-simplify-string (string)
   "Simplify traditional Kanji characters in STRING."
-  (let (ret)
+  (let (ret rest)
     (mapconcat
      (lambda (chr)
-       (setq ret (or (char-feature chr '->simplified@JP/Jouyou)
-                    (char-feature chr '->simplified@JP)
-                    (char-feature chr '->simplified)))
+       (setq uchr
+            (cond ((setq ret (char-feature chr '=>ucs@jis))
+                   (setq chr (decode-char '=ucs@jis ret)))
+                  ((setq ret (char-ucs chr))
+                   (setq chr (decode-char '=ucs@jis ret))
+                   (if (setq ret (char-feature chr '=>ucs*))
+                       (setq chr (decode-char '=ucs@jis ret))
+                     chr))
+                  (t chr)))
+       (setq rest japanese-simplified-relation-features)
+       (while (and rest
+                  (null (setq ret (char-feature chr (car rest)))))
+        (setq rest (cdr rest)))
        (char-to-string
        (cond ((car ret))
              ((setq ret (char-feature chr '=>ucs@jis))
               (decode-char '=ucs@jis ret))
              ((setq ret (char-ucs chr))
-              (decode-char '=ucs@jp ret))
+              (decode-char '=ucs@JP ret))
              (t chr))))
      string "")))
 
@@ -157,15 +205,19 @@
     (nth (1- ret) chars)))
 
 ;;;###autoload
-(defun chinese-traditionalize-string (string)
+(defun chinese-traditionalize-string (string &optional selector)
   "Convert simplified Chinese characters in STRING to traditional characters."
+  (unless selector
+    (setq selector
+         (lambda (chars)
+           (ideo-trans-select-char chars (format "%c => " chr)))))
   (let (ret)
     (mapconcat
      (lambda (chr)
        (char-to-string
        (cond ((car (char-feature chr '<-simplified))
               (if (cdr ret)
-                  (ideo-trans-select-char ret (format "%c => " chr))
+                  (funcall selector ret)
                 (car ret)))
              ((progn
                 (setq ret
@@ -186,22 +238,30 @@
   'chinese-traditionalize-string)
 
 ;;;###autoload
-(defun japanese-traditionalize-string (string)
+(defun japanese-traditionalize-string (string &optional selector)
   "Convert simplified Kanji in STRING into traditional characters."
-  (let (ret)
+  (unless selector
+    (setq selector
+         (lambda (chars)
+           (ideo-trans-select-char chars (format "%c => " chr)))))
+  (let (ret rest)
     (mapconcat
      (lambda (chr)
+       (setq rest japanese-traditional-relation-features)
+       (while (and rest
+                  (null (setq ret (char-feature chr (car rest)))))
+        (setq rest (cdr rest)))
        (char-to-string
-       (cond ((setq ret (char-feature chr '<-simplified))
+       (cond (ret
               (if (cdr ret)
-                  (ideo-trans-select-char ret (format "%c => " chr))
+                  (funcall selector ret)
                 (car ret)))
              ((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))
+                             (decode-char '=ucs@JP ret))
                             (t chr)))
                 (setq ret (or (char-feature ret '<-simplified@JP/Jouyou)
                               (char-feature ret '<-simplified@JP))))
@@ -211,7 +271,7 @@
              ((setq ret (char-feature chr '=>ucs@jis))
               (decode-char '=ucs@jis ret))
              ((setq ret (char-ucs chr))
-              (decode-char '=ucs@jp ret))
+              (decode-char '=ucs@JP ret))
              (t chr))))
      string "")))
                      
@@ -222,21 +282,48 @@
 
 ;;;###autoload
 (defun japanese-traditionalize-region (start end)
+  "Convert Japanese simplified Kanji in the region into traditional characters."
+  (interactive "r")
+  (save-excursion
+    (save-restriction
+      (narrow-to-region start end)
+      (goto-char start)
+      (let (chr ret rret rest)
+       (while (and (skip-chars-forward "\x00-\xFF")
+                   (not (eobp)))
+         (setq chr (char-after))
+         (setq rest japanese-traditional-relation-features)
+         (while (and rest
+                     (null (setq ret (char-feature chr (car rest)))))
+           (setq rest (cdr rest)))
+         (if ret
+             (progn
+               (if (cdr ret)
+                   (progn
+                     (setq rret (ideo-trans-select-char ret))
+                     (delete-char)
+                     (insert rret))
+                 (delete-char)
+                 (insert (car ret))))
+           (or (eobp)
+               (forward-char))))))))
+
+;;;###autoload
+(defun japanese-simplify-region (start end)
   (interactive "r")
   (save-excursion
     (save-restriction
       (narrow-to-region start end)
       (goto-char start)
-      (let (chr ret rret)
+      (let (chr ret rret rest)
        (while (and (skip-chars-forward "\x00-\xFF")
                    (not (eobp)))
          (setq chr (char-after))
-         (if (setq ret (or (get-char-attribute chr '<-simplified@JP/Jouyou)
-                           (get-char-attribute chr '<-simplified@jp-jouyou)
-                           (get-char-attribute chr '<-simplified@JP)
-                           (get-char-attribute chr '<-simplified@jp)
-                           (get-char-attribute chr '<-jp-simplified)
-                           (get-char-attribute chr '<-simplified)))
+         (setq rest japanese-simplified-relation-features)
+         (while (and rest
+                     (null (setq ret (char-feature chr (car rest)))))
+           (setq rest (cdr rest)))
+         (if ret
              (progn
                (if (cdr ret)
                    (progn