(chise-turtle-uri-encode-feature-name): Use ":instance" for
[chise/tomoyo-tools.git] / ideo-trans.el
index ec8de15..63755eb 100644 (file)
@@ -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, 2013 MORIOKA Tomohiko
 
 ;; Author: MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
 ;; Keywords: Ideographs, Character Database, Chaon, CHISE
@@ -87,7 +87,7 @@
             string ""))
 
 ;;;###autoload
-(defun ideo-translate-string-into-simplified-chinese (string)
+(defun chinese-simplify-string (string)
   "Simplify Chinese traditional characters in STRING."
   (let (uchr ret)
     (mapconcat
@@ -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
      string "")))
 
 ;;;###autoload
+(define-obsolete-function-alias
+  'ideo-translate-string-into-simplified-chinese
+  'chinese-simplify-string)
+
+;;;###autoload
 (define-obsolete-function-alias 'ideo-trans-simplify-chinese-string
-  'ideo-translate-string-into-simplified-chinese)
+  '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 ideo-translate-string-into-simplified-japanese (string)
+(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 "")))
 
+;;;###autoload
+(define-obsolete-function-alias
+  'ideo-translate-string-into-simplified-japanese
+  'japanese-simplify-string)
+
+
 (defun ideo-trans-select-char (chars &optional prefix)
   (let ((i 0)
        prompt ret)
     (nth (1- ret) chars)))
 
 ;;;###autoload
-(defun ideo-translate-chinese-string-into-traditional (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))
+       (cond ((car (setq ret (char-feature chr '<-simplified@CN)))
               (if (cdr ret)
-                  (ideo-trans-select-char ret (format "%c => " chr))
+                  (funcall selector ret)
                 (car ret)))
              ((progn
                 (setq ret
      string "")))
 
 ;;;###autoload
-(defun ideo-translate-japanese-string-into-traditional (string)
+(define-obsolete-function-alias
+  'ideo-translate-chinese-string-into-traditional
+  'chinese-traditionalize-string)
+
+;;;###autoload
+(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))))
               (if (cdr ret)
-                  (ideo-trans-select-char ret (format "%c => " chr))
+                  (funcall selector ret)
                 (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 "")))
                      
 ;;;###autoload
-(defun ideo-translate-japanese-region-into-traditional (start end)
+(define-obsolete-function-alias
+  'ideo-translate-japanese-string-into-traditional
+  'japanese-traditionalize-string)
+
+;;;###autoload
+(defun japanese-traditionalize-region (start end &optional selector)
+  "Convert Japanese simplified Kanji in the region into traditional characters."
   (interactive "r")
+  (unless selector
+    (setq selector
+         (lambda (chars)
+           (ideo-trans-select-char chars (format "%c => " chr)))))
   (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-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 (funcall selector 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 rest)
+       (while (and (skip-chars-forward "\x00-\xFF")
+                   (not (eobp)))
+         (setq chr (char-after))
+         (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
 
 ;;;###autoload
 (define-obsolete-function-alias
+  'ideo-translate-japanese-region-into-traditional
+  'japanese-traditionalize-region)
+
+;;;###autoload
+(define-obsolete-function-alias
   'ideo-translate-region-into-traditional
-  'ideo-translate-japanese-region-into-traditional)
+  'japanese-traditionalize-region)
 
 
 ;;; @ End.