;;; ideo-trans.el --- Translation utility for Ideographic Strings
-;; Copyright (C) 2003,2004,2005,2008 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
'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 uchr
(setq chr (decode-char '=ucs@jis ret))
chr))
(t chr)))
- (setq ret (or (char-feature chr '->simplified@JP/Jouyou)
- (char-feature chr '->simplified@JP)
- (char-feature chr '->simplified)))
+ (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))
(mapconcat
(lambda (chr)
(char-to-string
- (cond ((car (char-feature chr '<-simplified))
+ (cond ((car (setq ret (char-feature chr '<-simplified@CN)))
(if (cdr ret)
(funcall selector ret)
(car ret)))
(setq selector
(lambda (chars)
(ideo-trans-select-char chars (format "%c => " chr)))))
- (let (ret)
+ (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 (or (char-feature chr '<-simplified@JP/Jouyou)
- (char-feature chr '<-simplified@JP)
- (char-feature chr '<-simplified)))
+ (cond (ret
(if (cdr ret)
(funcall selector ret)
(car ret)))
(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))
'japanese-traditionalize-string)
;;;###autoload
-(defun japanese-traditionalize-region (start end)
+(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 (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)))
+ (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))
+ (setq rret (funcall selector ret))
(delete-char)
(insert rret))
(delete-char)
(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 (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)))
+ (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