;;; 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
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
(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.