+ (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)
+ (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 &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 (setq ret (char-feature chr '<-simplified@CN)))
+ (if (cdr ret)
+ (funcall selector ret)
+ (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)
+ (t chr))))
+ string "")))
+
+;;;###autoload
+(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."
+ (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 (ret
+ (if (cdr ret)
+ (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))
+ (t chr)))
+ (setq ret (or (char-feature ret '<-simplified@JP/Jouyou)
+ (char-feature ret '<-simplified@JP))))
+ (if (cdr ret)
+ (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))