Fix:
[chise/ids.git] / install-ids.el
1 ;;; install-ids.el --- installer of IDS files.
2
3 ;;; Code:
4
5 (setq load-ids-simplify nil)
6
7 (defun install-ids-read-file (file simplify soft)
8   (princ "Loading ")
9   (princ file)
10   (princ "...")
11   (ids-read-file file simplify soft)
12   (princ "done.\n"))
13
14
15 ;; (mount-char-attribute-table 'ideographic-products)
16 ;; (map-char-attribute
17 ;;  (lambda (c v)
18 ;;    (remove-char-attribute c 'ideographic-products)
19 ;;    nil)
20 ;;  'ideographic-products)
21
22
23 (install-ids-read-file "IDS-JIS-X0208-1990.txt" load-ids-simplify t)
24
25 (install-ids-read-file "IDS-UCS-Basic.txt" load-ids-simplify t)
26
27 (install-ids-read-file "IDS-UCS-Ext-A.txt" load-ids-simplify t)
28
29 (let ((i 1))
30   (while (<= i 6)
31     (install-ids-read-file (format "IDS-UCS-Ext-B-%d.txt" i)
32                            load-ids-simplify t)
33     (setq i (1+ i))))
34
35 (install-ids-read-file "IDS-UCS-Ext-C.txt" load-ids-simplify t)
36
37 (install-ids-read-file "IDS-UCS-Ext-D.txt" load-ids-simplify t)
38
39 (install-ids-read-file "IDS-UCS-Ext-E.txt" load-ids-simplify t)
40
41 (install-ids-read-file "IDS-UCS-Ext-F.txt" load-ids-simplify t)
42
43 (install-ids-read-file "IDS-UCS-Ext-G.txt" load-ids-simplify t)
44
45 (install-ids-read-file "IDS-UCS-Compat.txt" load-ids-simplify t)
46
47 (install-ids-read-file "IDS-UCS-Compat-Supplement.txt" load-ids-simplify t)
48
49 (let ((i 1))
50   (while (<= i 3)
51     (install-ids-read-file (format "IDS-CNS-%d.txt" i)
52                            load-ids-simplify t)
53     (setq i (1+ i))))
54
55 (let ((i 1))
56   (while (<= i 12)
57     (install-ids-read-file (format "IDS-Daikanwa-%02d.txt" i)
58                            load-ids-simplify t)
59     (setq i (1+ i))))
60
61 (install-ids-read-file "IDS-Daikanwa-dx.txt" load-ids-simplify t)
62
63 (install-ids-read-file "IDS-Daikanwa-ho.txt" load-ids-simplify t)
64
65 (install-ids-read-file "IDS-CBETA.txt" load-ids-simplify t)
66
67 (install-ids-read-file "IDS-CDP.txt" load-ids-simplify t)
68 ;; (let ((i 1))
69 ;;   (while (<= i 12)
70 ;;     (install-ids-read-file (format "IDS-HZK%02d.txt" i)
71 ;;                            load-ids-simplify t)
72 ;;     (setq i (1+ i))))
73
74 (install-ids-read-file "IDS-SW-JIGUGE.txt" load-ids-simplify t)
75
76 (princ "Generating apparent-structure...")
77 (let* ((terminal-coding-system 'utf-8-mcs-er)
78        (feature-dir
79         (expand-file-name
80          "feature"
81          (expand-file-name
82           "character" chise-system-db-directory)))
83        (p-file
84         (expand-file-name "ideographic-products" feature-dir))
85        old-p-file
86        a-str ret)
87   (when (file-exists-p p-file)
88     (setq old-p-file (make-temp-name p-file))
89     (rename-file p-file old-p-file))
90   (ids-update-index 'in-memory)
91
92   (map-char-attribute
93    (lambda (c v)
94      (unless (equal (setq ret (ideographic-structure-compact v)) v)
95        (princ (format "Compact %04X (%c) : %s -> %s\n"
96                       (char-int c)
97                       c
98                       (ideographic-structure-to-ids v)
99                       (ideographic-structure-to-ids ret)))
100        (put-char-attribute c 'ideographic-structure ret)
101        (setq v ret))
102      (unless (setq a-str (get-char-attribute c 'ideographic-structure@apparent))
103        (when (setq a-str (functional-ideographic-structure-to-apparent-structure v))
104          (put-char-attribute c 'ideographic-structure@apparent
105                              (ideographic-structure-compact a-str))))
106      nil)
107    'ideographic-structure)
108
109   (map-char-attribute
110    (lambda (c v)
111      (unless (equal (setq ret (ideographic-structure-compact v)) v)
112        (princ (format "Compact %04X (%c) : [apparent] %s -> %s\n"
113                       (char-int c)
114                       c
115                       (ideographic-structure-to-ids v)
116                       (ideographic-structure-to-ids ret)))
117        (put-char-attribute c 'ideographic-structure@apparent ret)
118        (setq v ret))
119      nil)
120    'ideographic-structure@apparent)
121
122   (map-char-attribute
123    (lambda (c v)
124      (unless (equal (setq ret (ideographic-structure-compact v)) v)
125        (princ (format "Compact %04X (%c) : [apparent/leftmost] %s -> %s\n"
126                       (char-int c)
127                       c
128                       (ideographic-structure-to-ids v)
129                       (ideographic-structure-to-ids ret)))
130        (put-char-attribute c 'ideographic-structure@apparent/leftmost ret)
131        (setq v ret))
132      nil)
133    'ideographic-structure@apparent/leftmost)
134
135   (map-char-attribute
136    (lambda (c v)
137      (unless (equal (setq ret (ideographic-structure-compact v)) v)
138        (princ (format "Compact %04X (%c) : %s -> %s\n"
139                       (char-int c)
140                       c
141                       (ideographic-structure-to-ids v)
142                       (ideographic-structure-to-ids ret)))
143        (put-char-attribute c 'ideographic-structure ret)
144        (setq v ret))
145      nil)
146    'ideographic-structure)
147   (map-char-attribute
148    (lambda (c v)
149      (unless (equal (setq ret (ideographic-structure-compact v)) v)
150        (princ (format "Compact %04X (%c) : [apparent] %s -> %s\n"
151                       (char-int c)
152                       c
153                       (ideographic-structure-to-ids v)
154                       (ideographic-structure-to-ids ret)))
155        (put-char-attribute c 'ideographic-structure@apparent ret)
156        (setq v ret))
157      nil)
158    'ideographic-structure@apparent)
159   (map-char-attribute
160    (lambda (c v)
161      (unless (equal (setq ret (ideographic-structure-compact v)) v)
162        (princ (format "Compact %04X (%c) : [apparent/leftmost] %s -> %s\n"
163                       (char-int c)
164                       c
165                       (ideographic-structure-to-ids v)
166                       (ideographic-structure-to-ids ret)))
167        (put-char-attribute c 'ideographic-structure@apparent/leftmost ret)
168        (setq v ret))
169      nil)
170    'ideographic-structure@apparent/leftmost)
171   (princ "done.\n")
172
173   (princ "Updating char-feature `ideographic-structure'...")
174   (save-char-attribute-table 'ideographic-structure)
175   (save-char-attribute-table 'ideographic-structure@apparent)
176   (princ "done.\n")
177
178   (princ "Updating char-feature `ideographic-products'...")
179   (ids-update-index)
180   (when old-p-file
181     (delete-file old-p-file)))
182 (princ "done.\n")
183
184 ;;; install-ids.el ends hear