X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=ideo-trans.el;h=3385583e9a76678cb3b955e0feacc31de211fc1c;hb=c7f71e96c4140023f63a1cc40120f6f3d38502c3;hp=d0b84d0617b14fdbbff5e2b0bebbc5115c73b762;hpb=4e001be6fdf3c0735edf808a4e87d93d44aa36a3;p=chise%2Ftomoyo-tools.git

diff --git a/ideo-trans.el b/ideo-trans.el
index d0b84d0..3385583 100644
--- 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 MORIOKA Tomohiko
 
 ;; Author: MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
 ;; Keywords: Ideographs, Character Database, Chaon, CHISE
@@ -51,9 +51,10 @@
 ;;;###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))
+  (let (ret)
+    (if (setq ret (char-ucs char))
+	(decode-char '=ucs ret)
+      char)))
 
 ;;;###autoload
 (defun char-representative-of-domain (char domain)
@@ -86,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
@@ -107,13 +108,18 @@
      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
-(defun ideo-translate-string-into-simplified-japanese (string)
+(defun japanese-simplify-string (string)
   "Simplify traditional Kanji characters in STRING."
-  (let (uchr ret)
+  (let (ret)
     (mapconcat
      (lambda (chr)
        (setq ret (or (char-feature chr '->simplified@JP/Jouyou)
@@ -129,23 +135,38 @@
      string "")))
 
 ;;;###autoload
-(defun ideo-translate-string-into-traditional (string)
-  "Convert simplified Kanji in STRING into traditional characters."
-  (let (uchr ret)
+(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)
+    (setq prompt
+	  (concat
+	   prefix
+	   (mapconcat (lambda (cell)
+			(setq i (1+ i))
+			(format "%d. %c" i cell))
+		      chars " ")
+	   " : "))
+    (while (and (setq ret (string-to-int (read-string prompt)))
+		(not (and (< 0 ret)
+			  (<=  ret (length chars))))))
+    (nth (1- ret) chars)))
+
+;;;###autoload
+(defun chinese-traditionalize-string (string)
+  "Convert simplified Chinese characters in STRING to traditional characters."
+  (let (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))
+	(cond ((car (char-feature chr '<-simplified))
+	       (if (cdr ret)
+		   (ideo-trans-select-char ret (format "%c => " chr))
+		 (car ret)))
 	      ((progn
 		 (setq ret
 		       (cond ((setq ret (char-feature chr '=>ucs@gb))
@@ -156,53 +177,117 @@
 		 (if (setq ret (encode-char ret 'chinese-gb2312))
 		     (setq ret (decode-char 'chinese-gb12345 ret))))
 	       ret)
+	      (t chr))))
+     string "")))
+
+;;;###autoload
+(define-obsolete-function-alias
+  'ideo-translate-chinese-string-into-traditional
+  'chinese-traditionalize-string)
+
+;;;###autoload
+(defun japanese-traditionalize-string (string)
+  "Convert simplified Kanji in STRING into traditional characters."
+  (let (ret)
+    (mapconcat
+     (lambda (chr)
+       (char-to-string
+	(cond ((setq ret (or (char-feature ret '<-simplified@JP/Jouyou)
+			     (char-feature ret '<-simplified@JP)
+			     (char-feature chr '<-simplified)))
+	       (if (cdr ret)
+		   (ideo-trans-select-char ret (format "%c => " chr))
+		 (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))
+			     (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))
+		 (car 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
+(define-obsolete-function-alias
+  'ideo-translate-japanese-string-into-traditional
+  'japanese-traditionalize-string)
+
+;;;###autoload
+(defun japanese-traditionalize-region (start end)
+  (interactive "r")
+  (save-excursion
+    (save-restriction
+      (narrow-to-region start end)
+      (goto-char start)
+      (let (chr ret rret)
+	(while (and (skip-chars-forward "\x00-\xFF")
+		    (not (eobp)))
+	  (setq chr (char-after))
+	  (if (setq ret (or (char-feature chr '<-simplified@JP/Jouyou)
+			    (char-feature chr '<-simplified@jp-jouyou)
+			    (char-feature chr '<-simplified@JP)
+			    (char-feature chr '<-simplified@jp)
+			    (char-feature chr '<-jp-simplified)
+			    (char-feature chr '<-simplified)))
+	      (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 ideo-translate-region-into-traditional (start end)
+(defun japanese-simplify-region (start end)
   (interactive "r")
   (save-excursion
     (save-restriction
       (narrow-to-region start end)
       (goto-char start)
-      (let (chr ret rret i prompt)
+      (let (chr ret rret)
 	(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)))
+	  (if (setq ret (or (char-feature chr '->simplified@JP/Jouyou)
+			    (char-feature chr '->simplified@jp-jouyou)
+			    (char-feature chr '->simplified@JP)
+			    (char-feature chr '->simplified@jp)
+			    (char-feature chr '->jp-simplified)
+			    (char-feature chr '->simplified)))
 	      (progn
 		(if (cdr ret)
 		    (progn
-		      (setq i 0)
-		      (setq prompt
-			    (concat
-			     (mapconcat (lambda (cell)
-					  (setq i (1+ i))
-					  (format "%d. %c" i cell))
-					ret " ")
-			     " : "))
-		      (while (and (setq rret
-					(string-to-int
-					 (read-string prompt)))
-				  (not (and (< 0 rret)
-					    (<=  rret (length ret))))))
+		      (setq rret (ideo-trans-select-char ret))
 		      (delete-char)
-		      (insert (nth (1- rret) ret)))
+		      (insert rret))
 		  (delete-char)
 		  (insert (car ret))))
 	    (or (eobp)
 		(forward-char))))))))
 
+;;;###autoload
+(define-obsolete-function-alias
+  'ideo-translate-japanese-region-into-traditional
+  'japanese-traditionalize-region)
+
+;;;###autoload
+(define-obsolete-function-alias
+  'ideo-translate-region-into-traditional
+  'japanese-traditionalize-region)
+
 
 ;;; @ End.
 ;;;