1 ;;; idc-util.el --- Utilities about ideographic-structure property
3 ;; Copyright (C) 2001 MORIOKA Tomohiko
5 ;; Author: MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
6 ;; Keywords: ideographic-structure, UTF-2000, database
8 ;; This file is a part of Tomoyo Utilities.
10 ;; This program is free software; you can redistribute it and/or
11 ;; modify it under the terms of the GNU General Public License as
12 ;; published by the Free Software Foundation; either version 2, or (at
13 ;; your option) any later version.
15 ;; This program is distributed in the hope that it will be useful, but
16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
18 ;; General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with this program; see the file COPYING. If not, write to
22 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
29 (defun ideographic-structure-convert-to-ucs (structure)
30 (let (dest cell ucs ret)
32 (setq cell (car structure))
35 (cond ((characterp cell)
36 (if (or (get-char-attribute cell 'ucs)
39 (or (get-char-attribute cell '=>ucs)
40 (get-char-attribute cell '->ucs)))))
42 (decode-char 'ucs ucs)))
46 ((setq ret (find-char cell))
47 (if (or (get-char-attribute ret 'ucs)
50 (or (get-char-attribute ret '=>ucs)
51 (get-char-attribute ret '->ucs)))))
53 (decode-char 'ucs ucs)))
54 ((setq ret (assq 'ideographic-structure cell))
55 (put-alist 'ideographic-structure
56 (ideographic-structure-convert-to-ucs
61 (setq structure (cdr structure)))
64 (defvar morohashi-char-replace-alist
66 (cons (decode-char 'chinese-big5-cdp #x8B42)
67 (decode-char 'chinese-big5-cdp #x8B42))
68 (cons (decode-char 'chinese-big5-cdp #x8AFC)
69 (decode-char 'chinese-big5-cdp #x8AFC))
70 (cons (decode-char 'ucs #x2EBE)
71 (decode-char 'ucs #x2EBF))
72 (cons (decode-char 'ucs #x5922)
73 (decode-char 'ideograph-daikanwa 05802))
74 (cons (decode-char 'ucs #x656C)
75 (decode-char 'ideograph-daikanwa 13303))
76 (cons (decode-char 'ucs #x8449)
77 (decode-char 'ideograph-daikanwa 31387))
78 (cons (decode-char 'ucs #x2EA4)
79 (decode-char 'ucs #x722B))
80 (cons (decode-char 'ucs #x5151)
81 (decode-char 'ideograph-daikanwa 01356))
82 (cons (decode-char 'ucs #x544A)
83 (decode-char 'ideograph-daikanwa 03381))
84 (cons (decode-char 'ucs #x5F66)
85 (decode-char 'ideograph-daikanwa 09980))
86 (cons (decode-char 'ucs #x8005)
87 (decode-char 'ideograph-daikanwa 28853))
88 (cons (decode-char 'ucs #x82E5)
89 (decode-char 'ideograph-daikanwa 30796))
90 (cons (decode-char 'ucs #x82F1)
91 (decode-char 'ideograph-daikanwa 30808))
92 (cons (decode-char 'ucs #x9063)
93 (decode-char 'ideograph-daikanwa 39052))
94 (cons (decode-char 'ucs #x4EA0)
95 (decode-char 'chinese-big5-cdp #x8B42))
96 (cons (decode-char 'ucs #x5154)
97 (decode-char 'ideograph-daikanwa 01368))
98 (cons (decode-char 'ucs #x53CA)
99 (decode-char 'ideograph-daikanwa 03118))
100 (cons (decode-char 'ucs #x5468)
101 (decode-char 'ideograph-daikanwa 03441))
102 (cons (decode-char 'ucs #x5C1A)
103 (decode-char 'ucs #x5C19))
104 (cons (decode-char 'ucs #x5D29)
105 (decode-char 'ideograph-daikanwa 08212))
106 (cons (decode-char 'ucs #x670B)
107 (decode-char 'ideograph-daikanwa 14340))
108 (cons (decode-char 'ucs #x7FBD)
109 (decode-char 'ideograph-daikanwa 28614))
110 (cons (decode-char 'ucs #x8096)
111 (decode-char 'ideograph-daikanwa 29263))
112 (cons (decode-char 'ucs #x8981)
113 (decode-char 'ideograph-daikanwa 34768))
114 (cons (decode-char 'ucs #x8AF8)
115 (decode-char 'ideograph-daikanwa 35743))
116 (cons (decode-char 'ucs #x9023)
117 (decode-char 'ideograph-daikanwa 38902))
118 (cons (decode-char 'ucs #x9752)
119 (decode-char 'ucs #x9751))
122 (defun ideographic-structure-convert-to-daikanwa (structure)
123 (let (dest cell morohashi ret)
125 (setq cell (car structure))
128 (cond ((characterp cell)
130 (assq cell morohashi-char-replace-alist))
132 ((get-char-attribute cell 'ideograph-daikanwa)
136 cell 'morohashi-daikanwa))
137 (cond ((null (cdr (cdr morohashi)))
139 ((= (nth 1 morohashi) 0)
140 (decode-char 'ideograph-daikanwa
143 (setq morohashi (list (car morohashi)
145 (or (map-char-attribute
147 (if (equal morohashi val)
154 (symbolp (car cell)))
156 ((setq ret (find-char cell))
157 (if (or (get-char-attribute ret 'ideograph-daikanwa)
161 ret 'morohashi-daikanwa)))
162 (null (cdr (cdr morohashi))))
164 (if (= (nth 1 morohashi) 0)
165 (decode-char 'ideograph-daikanwa (car morohashi))
167 ((setq ret (assq 'ideographic-structure cell))
168 (put-alist 'ideographic-structure
169 (ideographic-structure-convert-to-daikanwa
174 (setq structure (cdr structure)))
183 ;;; idc-util.el ends here