1 ;;; ids-util.el --- Utilities about ideographic-structure -*- coding: utf-8 -*-
3 ;; Copyright (C) 2001,2002 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.
30 (defun ideographic-structure-convert-to-ucs (structure)
31 (let (dest cell ucs ret)
33 (setq cell (car structure))
36 (cond ((characterp cell)
37 (if (or (get-char-attribute cell 'ucs)
40 (or (get-char-attribute cell '=>ucs)
41 (get-char-attribute cell '->ucs)))))
43 (decode-char 'ucs ucs)))
47 ((setq ret (find-char cell))
48 (if (or (get-char-attribute ret 'ucs)
51 (or (get-char-attribute ret '=>ucs)
52 (get-char-attribute ret '->ucs)))))
54 (decode-char 'ucs ucs)))
55 ((setq ret (assq 'ideographic-structure cell))
56 (put-alist 'ideographic-structure
57 (ideographic-structure-convert-to-ucs
62 (setq structure (cdr structure)))
65 (defvar morohashi-char-replace-alist
67 (cons (decode-char 'chinese-big5-cdp #x8B42)
68 (decode-char 'chinese-big5-cdp #x8B42))
69 (cons (decode-char 'chinese-big5-cdp #x8AFC)
70 (decode-char 'chinese-big5-cdp #x8AFC))
71 (cons (decode-char 'ucs #x2EBE)
72 (decode-char 'ucs #x2EBF))
73 (cons (decode-char 'ucs #x4EA0)
74 (decode-char 'chinese-big5-cdp #x8B42))
75 (cons (decode-char 'ucs #x4EBD)
76 (decode-char 'chinese-big5-cdp #x8AFC))
77 (cons (decode-char 'ucs #x517C)
78 (decode-char 'ideograph-gt 01936))
79 (cons ?亼 (decode-char 'chinese-big5-cdp #x8AFC))
80 (cons (decode-char 'chinese-big5-cdp #x8AFC)
81 (decode-char 'chinese-big5-cdp #x8AFC))
82 (cons (decode-char 'chinese-big5-cdp #x8B69)
83 (decode-char 'chinese-big5-cdp #x8A60))
84 (cons (decode-char 'ucs #x4FDE)
85 (decode-char 'ideograph-daikanwa 01437))
86 (cons (decode-char 'ucs #x5151)
87 (decode-char 'ideograph-daikanwa 01356))
88 (cons (decode-char 'ucs #x5154)
89 (decode-char 'ideograph-daikanwa 01368))
90 (cons (decode-char 'ucs #x5179)
91 (decode-char 'ideograph-daikanwa 30911))
92 (cons (decode-char 'ucs #x518D)
93 (decode-char 'ideograph-daikanwa 01524))
94 (cons (decode-char 'ucs #x5193)
95 (decode-char 'ideograph-gt 02025))
96 (cons (decode-char 'ucs #x53CA)
97 (decode-char 'ideograph-daikanwa 03118))
98 (cons (decode-char 'ucs #x544A)
99 (decode-char 'ideograph-daikanwa 03381))
100 (cons (decode-char 'ucs #x5468)
101 (decode-char 'ideograph-daikanwa 03441))
103 (cons (decode-char 'ucs #x5922)
104 (decode-char 'ideograph-daikanwa 05802))
105 (cons (decode-char 'ucs #x5C1A)
106 (decode-char 'ucs #x5C19))
107 (cons (decode-char 'ucs #x5D29)
108 (decode-char 'ideograph-daikanwa 08212))
109 (cons (decode-char 'ucs #x5F66)
110 (decode-char 'ideograph-daikanwa 09980))
111 (cons (decode-char 'ucs #x6247)
112 (decode-char 'ideograph-daikanwa 11743))
113 (cons (decode-char 'ucs #x656C)
114 (decode-char 'ideograph-daikanwa 13303))
115 (cons (decode-char 'ucs #x65E2)
116 (decode-char 'ideograph-daikanwa 13724))
117 (cons (decode-char 'ucs #x6B21)
118 (decode-char 'ideograph-daikanwa 15992))
119 (cons (decode-char 'ucs #x7235)
120 (decode-char 'ideograph-daikanwa 19711))
121 (cons (decode-char 'ucs #x7523)
122 (decode-char 'ideograph-daikanwa 21684))
123 (cons (decode-char 'ucs #x76CA)
124 (decode-char 'ideograph-daikanwa 22972))
125 (cons (decode-char 'ucs #x771F)
126 (decode-char 'ideograph-daikanwa 23235))
127 (cons (decode-char 'ucs #x7FBD)
128 (decode-char 'ideograph-daikanwa 28614))
129 (cons (decode-char 'ucs #x7FC1)
130 (decode-char 'ideograph-daikanwa 28635))
131 (cons (decode-char 'ucs #x2EA4)
132 (decode-char 'ucs #x722B))
133 (cons (decode-char 'ucs #x8005)
134 (decode-char 'ideograph-daikanwa 28853))
135 (cons (decode-char 'ucs #x8096)
136 (decode-char 'ideograph-daikanwa 29263))
137 (cons (decode-char 'ucs #x82E5)
138 (decode-char 'ideograph-daikanwa 30796))
139 (cons (decode-char 'ucs #x82D7)
140 (decode-char 'ideograph-daikanwa 30781))
141 (cons (decode-char 'ucs #x82F1)
142 (decode-char 'ideograph-daikanwa 30808))
143 (cons (decode-char 'ucs #x8336)
144 (decode-char 'ideograph-daikanwa 30915))
145 (cons (decode-char 'ucs #x8449)
146 (decode-char 'ideograph-daikanwa 31387))
147 (cons (decode-char 'ucs #x9023)
148 (decode-char 'ideograph-daikanwa 38902))
149 (cons (decode-char 'ucs #x9053)
150 (decode-char 'ideograph-daikanwa 39010))
151 (cons (decode-char 'ucs #x9054)
152 (decode-char 'ideograph-daikanwa 39011))
153 (cons (decode-char 'ucs #x9063)
154 (decode-char 'ideograph-daikanwa 39052))
155 (cons (decode-char 'ucs #x9752)
156 (decode-char 'ucs #x9751))
157 (cons (decode-char 'ucs #x670B)
158 (decode-char 'ideograph-daikanwa 14340))
159 (cons (decode-char 'ucs #x8981)
160 (decode-char 'ideograph-daikanwa 34768))
161 (cons (decode-char 'ucs #x8AF8)
162 (decode-char 'ideograph-daikanwa 35743))
163 (cons (decode-char 'japanese-jisx0213-2 #x2327)
164 (decode-char 'japanese-jisx0213-2 #x2327))
165 (cons (decode-char 'chinese-big5-cdp #x8BFA)
166 (decode-char 'japanese-jisx0213-2 #x2327))
170 (defun ideographic-structure-convert-to-daikanwa (structure)
171 (let (dest cell morohashi ret ret2 ret3)
173 (setq cell (car structure))
176 (cond ((characterp cell)
178 (assq cell morohashi-char-replace-alist))
180 ((get-char-attribute cell 'ideograph-daikanwa)
184 cell 'morohashi-daikanwa))
185 (cond ((null (cdr (cdr morohashi)))
187 ((= (nth 1 morohashi) 0)
188 (decode-char 'ideograph-daikanwa
191 (setq morohashi (list (car morohashi)
193 (or (map-char-attribute
195 (if (equal morohashi val)
202 (symbolp (car cell)))
204 ((setq ret (find-char cell))
205 (if (or (get-char-attribute ret 'ideograph-daikanwa)
209 ret 'morohashi-daikanwa)))
210 (null (cdr (cdr morohashi))))
212 (if (= (nth 1 morohashi) 0)
213 (decode-char 'ideograph-daikanwa (car morohashi))
215 ((setq ret (assq 'ideographic-structure cell))
217 (ideographic-structure-convert-to-daikanwa
219 (if (setq ret3 (ideographic-structure-find-char ret2))
221 (put-alist 'ideographic-structure
226 (setq structure (cdr structure)))
235 ;;; ids-util.el ends here