;;; ideo-trans.el --- Translation utility for Ideographic Strings
-;; Copyright (C) 2003,2004,2005,2008 MORIOKA Tomohiko
+;; Copyright (C) 2003,2004,2005,2008,2012 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))
(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)))
(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
(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