1 ;;; ids-util.el --- Utilities about ideographic-structure -*- coding: utf-8 -*-
3 ;; Copyright (C) 2001,2002,2003,2004 MORIOKA Tomohiko
5 ;; Author: MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
6 ;; Keywords: ideographic-structure, CHISE, IDS, IDC, UCS, 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.
30 (defun ideographic-structure-convert-to-domain (structure domain)
33 (setq cell (car structure))
36 (cond ((characterp cell)
37 (char-representative-of-domain cell domain))
41 ((setq ret (find-char cell))
42 (char-representative-of-domain cell domain))
43 ((setq ret (assq 'ideographic-structure cell))
44 (put-alist 'ideographic-structure
45 (ideographic-structure-convert-to-domain
50 (setq structure (cdr structure)))
54 (defun ideographic-structure-convert-to-ucs (structure)
55 (let (dest cell ucs ret)
57 (setq cell (car structure))
60 (cond ((characterp cell)
61 (if (or (get-char-attribute cell 'ucs)
64 (or (get-char-attribute cell '=>ucs)
65 (get-char-attribute cell '->ucs)))))
67 (decode-char 'ucs ucs)))
71 ((setq ret (find-char cell))
72 (if (or (get-char-attribute ret 'ucs)
75 (or (get-char-attribute ret '=>ucs)
76 (get-char-attribute ret '->ucs)))))
78 (decode-char 'ucs ucs)))
79 ((setq ret (assq 'ideographic-structure cell))
80 (put-alist 'ideographic-structure
81 (ideographic-structure-convert-to-ucs
86 (setq structure (cdr structure)))
89 (defun char-cns11643-p (char &optional defined-only)
92 (intern (format "=cns11643-%d" n))
96 (defun char-representative-of-cns11643 (char)
97 (if (char-cns11643-p char)
99 (let ((ucs (char-ucs char))
103 (char-variants (decode-char 'ucs ucs))))
105 (setq char (car variants))
106 (not (char-cns11643-p char)))
107 (setq variants (cdr variants))))
110 (defun ideographic-structure-convert-to-cns11643 (structure)
111 (let (dest cell ucs ret)
113 (setq cell (car structure))
116 (cond ((characterp cell)
117 (char-representative-of-cns11643 cell))
119 (symbolp (car cell)))
121 ((setq ret (find-char cell))
122 (char-representative-of-cns11643 ret))
123 ((setq ret (assq 'ideographic-structure cell))
124 (put-alist 'ideographic-structure
125 (ideographic-structure-convert-to-cns11643
130 (setq structure (cdr structure)))
133 (defvar morohashi-char-replace-alist
135 (cons (decode-char 'chinese-big5-cdp #x8B42)
136 (decode-char 'chinese-big5-cdp #x8B42))
137 (cons (decode-char 'chinese-big5-cdp #x8AFC)
138 (decode-char 'chinese-big5-cdp #x8AFC))
139 (cons (decode-char 'ucs #x2EBE)
140 (decode-char 'ucs #x2EBF))
141 (cons (decode-char 'ucs #x4EA0)
142 (decode-char 'chinese-big5-cdp #x8B42))
143 (cons (decode-char 'ucs #x4EBD)
144 (decode-char 'chinese-big5-cdp #x8AFC))
145 (cons (decode-char 'ucs #x517C)
146 (decode-char 'ideograph-gt 01936))
147 (cons ?亼 (decode-char 'chinese-big5-cdp #x8AFC))
148 (cons (decode-char 'chinese-big5-cdp #x8AFC)
149 (decode-char 'chinese-big5-cdp #x8AFC))
150 (cons (decode-char 'chinese-big5-cdp #x8B69)
151 (decode-char 'chinese-big5-cdp #x8A60))
152 (cons (decode-char 'ucs #x4FDE)
153 (decode-char 'ideograph-daikanwa 01437))
154 (cons (decode-char 'ucs #x5151)
155 (decode-char 'ideograph-daikanwa 01356))
156 (cons (decode-char 'ucs #x5154)
157 (decode-char 'ideograph-daikanwa 01368))
158 (cons (decode-char 'ucs #x5179)
159 (decode-char 'ideograph-daikanwa 30911))
160 (cons (decode-char 'ucs #x518D)
161 (decode-char 'ideograph-daikanwa 01524))
162 (cons (decode-char 'ucs #x5193)
163 (decode-char 'ideograph-gt 02025))
164 (cons (decode-char 'ucs #x53CA)
165 (decode-char 'ideograph-daikanwa 03118))
166 (cons (decode-char 'ucs #x544A)
167 (decode-char 'ideograph-daikanwa 03381))
168 (cons (decode-char 'ucs #x5468)
169 (decode-char 'ideograph-daikanwa 03441))
171 (cons (decode-char 'ucs #x5922)
172 (decode-char 'ideograph-daikanwa 05802))
173 (cons (decode-char 'ucs #x5C1A)
174 (decode-char 'ucs #x5C19))
175 (cons (decode-char 'ucs #x5D29)
176 (decode-char 'ideograph-daikanwa 08212))
177 (cons (decode-char 'ucs #x5F66)
178 (decode-char 'ideograph-daikanwa 09980))
179 (cons (decode-char 'ucs #x6247)
180 (decode-char 'ideograph-daikanwa 11743))
181 (cons (decode-char 'ucs #x656C)
182 (decode-char 'ideograph-daikanwa 13303))
183 (cons (decode-char 'ucs #x65E2)
184 (decode-char 'ideograph-daikanwa 13724))
185 (cons (decode-char 'ucs #x6B21)
186 (decode-char 'ideograph-daikanwa 15992))
187 (cons (decode-char 'ucs #x7235)
188 (decode-char 'ideograph-daikanwa 19711))
189 (cons (decode-char 'ucs #x7523)
190 (decode-char 'ideograph-daikanwa 21684))
191 (cons (decode-char 'ucs #x76CA)
192 (decode-char 'ideograph-daikanwa 22972))
193 (cons (decode-char 'ucs #x771F)
194 (decode-char 'ideograph-daikanwa 23235))
195 (cons (decode-char 'ucs #x7FBD)
196 (decode-char 'ideograph-daikanwa 28614))
197 (cons (decode-char 'ucs #x7FC1)
198 (decode-char 'ideograph-daikanwa 28635))
199 (cons (decode-char 'ucs #x2EA4)
200 (decode-char 'ucs #x722B))
201 (cons (decode-char 'ucs #x8005)
202 (decode-char 'ideograph-daikanwa 28853))
203 (cons (decode-char 'ucs #x8096)
204 (decode-char 'ideograph-daikanwa 29263))
205 (cons (decode-char 'ucs #x82E5)
206 (decode-char 'ideograph-daikanwa 30796))
207 (cons (decode-char 'ucs #x82D7)
208 (decode-char 'ideograph-daikanwa 30781))
209 (cons (decode-char 'ucs #x82F1)
210 (decode-char 'ideograph-daikanwa 30808))
211 (cons (decode-char 'ucs #x8336)
212 (decode-char 'ideograph-daikanwa 30915))
213 (cons (decode-char 'ucs #x8449)
214 (decode-char 'ideograph-daikanwa 31387))
215 (cons (decode-char 'ucs #x9023)
216 (decode-char 'ideograph-daikanwa 38902))
217 (cons (decode-char 'ucs #x9053)
218 (decode-char 'ideograph-daikanwa 39010))
219 (cons (decode-char 'ucs #x9054)
220 (decode-char 'ideograph-daikanwa 39011))
221 (cons (decode-char 'ucs #x9063)
222 (decode-char 'ideograph-daikanwa 39052))
223 (cons (decode-char 'ucs #x9752)
224 (decode-char 'ucs #x9751))
225 (cons (decode-char 'ucs #x670B)
226 (decode-char 'ideograph-daikanwa 14340))
227 (cons (decode-char 'ucs #x8981)
228 (decode-char 'ideograph-daikanwa 34768))
229 (cons (decode-char 'ucs #x8AF8)
230 (decode-char 'ideograph-daikanwa 35743))
231 (cons (decode-char 'japanese-jisx0213-2 #x2327)
232 (decode-char 'japanese-jisx0213-2 #x2327))
233 (cons (decode-char 'chinese-big5-cdp #x8BFA)
234 (decode-char 'japanese-jisx0213-2 #x2327))
238 (defun ideographic-structure-convert-to-daikanwa (structure)
239 (let (dest cell morohashi ret ret2 ret3)
241 (setq cell (car structure))
244 (cond ((characterp cell)
246 (assq cell morohashi-char-replace-alist))
248 ((get-char-attribute cell 'ideograph-daikanwa)
252 cell 'morohashi-daikanwa))
253 (cond ((null (cdr (cdr morohashi)))
255 ((= (nth 1 morohashi) 0)
256 (decode-char 'ideograph-daikanwa
259 (setq morohashi (list (car morohashi)
261 (or (map-char-attribute
263 (if (equal morohashi val)
270 (symbolp (car cell)))
272 ((setq ret (find-char cell))
273 (if (or (get-char-attribute ret 'ideograph-daikanwa)
277 ret 'morohashi-daikanwa)))
278 (null (cdr (cdr morohashi))))
280 (if (= (nth 1 morohashi) 0)
281 (decode-char 'ideograph-daikanwa (car morohashi))
283 ((setq ret (assq 'ideographic-structure cell))
285 (ideographic-structure-convert-to-daikanwa
287 (if (setq ret3 (ideographic-structure-find-char ret2))
289 (put-alist 'ideographic-structure
294 (setq structure (cdr structure)))
303 ;;; ids-util.el ends here