38414
|
1 ;;; ja-dic-cnv.el --- convert a Japanese dictionary (SKK-JISYO.L) to Emacs Lisp
|
31164
|
2
|
|
3 ;; Copyright (C) 1995, 2000 Electrotechnical Laboratory, JAPAN.
|
|
4 ;; Licensed to the Free Software Foundation.
|
|
5
|
|
6 ;; Keywords: mule, multilingual, Japanese
|
|
7
|
|
8 ;; This file is part of GNU Emacs.
|
|
9
|
|
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
11 ;; it under the terms of the GNU General Public License as published by
|
|
12 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
13 ;; any later version.
|
|
14
|
|
15 ;; GNU Emacs is distributed in the hope that it will be useful,
|
|
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
18 ;; GNU General Public License for more details.
|
|
19
|
|
20 ;; You should have received a copy of the GNU General Public License
|
|
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
|
|
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
23 ;; Boston, MA 02111-1307, USA.
|
|
24
|
|
25 ;;; Commentary:
|
|
26
|
|
27 ;; SKK is a Japanese input method running on Mule created by Masahiko
|
|
28 ;; Sato <masahiko@sato.riec.tohoku.ac.jp>. Here we provide utilities
|
|
29 ;; to handle a dictionary distributed with SKK so that a different
|
|
30 ;; input method (e.g. quail-japanese) can utilize the dictionary.
|
|
31
|
|
32 ;; The format of SKK dictionary is quite simple. Each line has the
|
|
33 ;; form "KANASTRING /CONV1/CONV2/.../" which means KANASTRING ($B2>L>J8(B
|
|
34 ;; $B;zNs(B) can be converted to one of CONVi. CONVi is a Kanji ($B4A;z(B)
|
|
35 ;; and Kana ($B2>L>(B) mixed string.
|
|
36 ;;
|
|
37 ;; KANASTRING may have a trailing ASCII letter for Okurigana ($BAw$j2>L>(B)
|
|
38 ;; information. For instance, the trailing letter `k' means that one
|
|
39 ;; of the following Okurigana is allowed: $B$+$-$/$1$3(B. So, in that
|
|
40 ;; case, the string "KANASTRING$B$/(B" can be converted to one of "CONV1$B$/(B",
|
|
41 ;; CONV2$B$/(B, ...
|
|
42
|
|
43 ;;; Code:
|
|
44
|
|
45 ;; Name of a file to generate from SKK dictionary.
|
|
46 (defvar ja-dic-filename "ja-dic.el")
|
|
47
|
|
48 ;; To make a generated ja-dic.el smaller.
|
|
49 (make-coding-system
|
|
50 'iso-2022-7bit-short
|
|
51 2 ?J
|
|
52 "Like `iso-2022-7bit' but no ASCII designation before SPC."
|
|
53 '(ascii nil nil nil t t nil t)
|
|
54 '((safe-charsets . t)))
|
|
55
|
|
56 (defun skkdic-convert-okuri-ari (skkbuf buf)
|
|
57 (message "Processing OKURI-ARI entries ...")
|
|
58 (goto-char (point-min))
|
|
59 (save-excursion
|
|
60 (set-buffer buf)
|
|
61 (insert ";; Setting okuri-ari entries.\n"
|
|
62 "(skkdic-set-okuri-ari\n"))
|
|
63 (while (not (eobp))
|
|
64 (let ((from (point))
|
|
65 to)
|
|
66 (end-of-line)
|
|
67 (setq to (point))
|
|
68
|
|
69 (save-excursion
|
|
70 (set-buffer buf)
|
|
71 (insert-buffer-substring skkbuf from to)
|
|
72 (beginning-of-line)
|
|
73 (insert "\"")
|
|
74 (search-forward " ")
|
|
75 (delete-char 1) ; delete the first '/'
|
|
76 (let ((p (point)))
|
|
77 (end-of-line)
|
|
78 (delete-char -1) ; delete the last '/'
|
|
79 (subst-char-in-region p (point) ?/ ? 'noundo))
|
|
80 (insert "\"\n"))
|
|
81
|
|
82 (forward-line 1)))
|
|
83 (save-excursion
|
|
84 (set-buffer buf)
|
|
85 (insert ")\n\n")))
|
|
86
|
|
87 (defconst skkdic-postfix-list '(skkdic-postfix-list))
|
|
88
|
|
89 (defconst skkdic-postfix-data
|
|
90 '(("$B$$$-(B" "$B9T(B")
|
|
91 ("$B$,$+$j(B" "$B78(B")
|
|
92 ("$B$,$/(B" "$B3X(B")
|
|
93 ("$B$,$o(B" "$B@n(B")
|
|
94 ("$B$7$c(B" "$B<R(B")
|
|
95 ("$B$7$e$&(B" "$B=8(B")
|
|
96 ("$B$7$g$&(B" "$B>^(B" "$B>k(B")
|
|
97 ("$B$8$g$&(B" "$B>k(B")
|
|
98 ("$B$;$s(B" "$B@~(B")
|
|
99 ("$B$@$1(B" "$B3Y(B")
|
|
100 ("$B$A$c$/(B" "$BCe(B")
|
|
101 ("$B$F$s(B" "$BE9(B")
|
|
102 ("$B$H$&$2(B" "$BF=(B")
|
|
103 ("$B$I$*$j(B" "$BDL$j(B")
|
|
104 ("$B$d$^(B" "$B;3(B")
|
|
105 ("$B$P$7(B" "$B66(B")
|
|
106 ("$B$O$D(B" "$BH/(B")
|
|
107 ("$B$b$/(B" "$BL\(B")
|
|
108 ("$B$f$-(B" "$B9T(B")))
|
|
109
|
|
110 (defun skkdic-convert-postfix (skkbuf buf)
|
|
111 (message "Processing POSTFIX entries ...")
|
|
112 (goto-char (point-min))
|
|
113 (save-excursion
|
|
114 (set-buffer buf)
|
|
115 (insert ";; Setting postfix entries.\n"
|
|
116 "(skkdic-set-postfix\n"))
|
|
117
|
|
118 ;; Initialize SKKDIC-POSTFIX-LIST by predefined data
|
|
119 ;; SKKDIC-POSTFIX-DATA.
|
|
120 (save-excursion
|
|
121 (set-buffer buf)
|
|
122 (let ((l skkdic-postfix-data)
|
|
123 kana candidates entry)
|
|
124 (while l
|
|
125 (setq kana (car (car l)) candidates (cdr (car l)))
|
|
126 (insert "\"" kana)
|
|
127 (while candidates
|
|
128 (insert " " (car candidates))
|
|
129 (setq entry (lookup-nested-alist (car candidates)
|
|
130 skkdic-postfix-list nil nil t))
|
|
131 (if (consp (car entry))
|
|
132 (setcar entry (cons kana (car entry)))
|
|
133 (set-nested-alist (car candidates) (list kana)
|
|
134 skkdic-postfix-list))
|
|
135 (setq candidates (cdr candidates)))
|
|
136 (insert "\"\n")
|
|
137 (setq l (cdr l)))))
|
|
138
|
|
139 ;; Search postfix entries.
|
|
140 (while (re-search-forward "^[#<>?]\\(\\(\\cH\\|$B!<(B\\)+\\) " nil t)
|
|
141 (let ((kana (match-string 1))
|
|
142 str candidates)
|
|
143 (while (looking-at "/[#0-9 ]*\\([^/\n]*\\)/")
|
|
144 (setq str (match-string 1))
|
|
145 (if (not (member str candidates))
|
|
146 (setq candidates (cons str candidates)))
|
|
147 (goto-char (match-end 1)))
|
|
148 (save-excursion
|
|
149 (set-buffer buf)
|
|
150 (insert "\"" kana)
|
|
151 (while candidates
|
|
152 (insert " " (car candidates))
|
|
153 (let ((entry (lookup-nested-alist (car candidates)
|
|
154 skkdic-postfix-list nil nil t)))
|
|
155 (if (consp (car entry))
|
|
156 (if (not (member kana (car entry)))
|
|
157 (setcar entry (cons kana (car entry))))
|
|
158 (set-nested-alist (car candidates) (list kana)
|
|
159 skkdic-postfix-list)))
|
|
160 (setq candidates (cdr candidates)))
|
|
161 (insert "\"\n"))))
|
|
162 (save-excursion
|
|
163 (set-buffer buf)
|
|
164 (insert ")\n\n")))
|
49598
|
165
|
31164
|
166 (defconst skkdic-prefix-list '(skkdic-prefix-list))
|
|
167
|
|
168 (defun skkdic-convert-prefix (skkbuf buf)
|
|
169 (message "Processing PREFIX entries ...")
|
|
170 (goto-char (point-min))
|
|
171 (save-excursion
|
|
172 (set-buffer buf)
|
|
173 (insert ";; Setting prefix entries.\n"
|
|
174 "(skkdic-set-prefix\n"))
|
|
175 (save-excursion
|
|
176 (while (re-search-forward "^\\(\\(\\cH\\|$B!<(B\\)+\\)[<>?] " nil t)
|
|
177 (let ((kana (match-string 1))
|
|
178 str candidates)
|
|
179 (while (looking-at "/\\([^/\n]+\\)/")
|
|
180 (setq str (match-string 1))
|
|
181 (if (not (member str candidates))
|
|
182 (setq candidates (cons str candidates)))
|
|
183 (goto-char (match-end 1)))
|
|
184 (save-excursion
|
|
185 (set-buffer buf)
|
|
186 (insert "\"" kana)
|
|
187 (while candidates
|
|
188 (insert " " (car candidates))
|
|
189 (set-nested-alist (car candidates) kana skkdic-prefix-list)
|
|
190 (setq candidates (cdr candidates)))
|
|
191 (insert "\"\n")))))
|
|
192 (save-excursion
|
|
193 (set-buffer buf)
|
|
194 (insert ")\n\n")))
|
49598
|
195
|
31164
|
196 ;; FROM and TO point the head and tail of "/J../J../.../".
|
|
197 (defun skkdic-get-candidate-list (from to)
|
|
198 (let (candidates)
|
|
199 (goto-char from)
|
34626
6e98a6e86b7f
(skkdic-get-candidate-list): Fix the regexp to search for candidates.
Kenichi Handa <handa@m17n.org>
diff
changeset
|
200 (while (re-search-forward "/[^/ \n]+" to t)
|
31164
|
201 (setq candidates (cons (buffer-substring (1+ (match-beginning 0))
|
|
202 (match-end 0))
|
|
203 candidates)))
|
|
204 candidates))
|
|
205
|
|
206 ;; Return entry for STR from nested alist ALIST.
|
|
207 (defsubst skkdic-get-entry (str alist)
|
|
208 (car (lookup-nested-alist str alist nil nil t)))
|
|
209
|
|
210
|
|
211 (defconst skkdic-word-list '(skkdic-word-list))
|
|
212
|
|
213 ;; Return t if substring of STR (between FROM and TO) can be broken up
|
|
214 ;; to chunks all of which can be derived from another entry in SKK
|
|
215 ;; dictionary. SKKBUF is the buffer where the original SKK dictionary
|
|
216 ;; is visited, KANA is the current entry for STR. FIRST is t iff this
|
|
217 ;; is called at top level.
|
|
218
|
|
219 (defun skkdic-breakup-string (skkbuf kana str from to &optional first)
|
|
220 (let ((len (- to from)))
|
|
221 (or (and (>= len 2)
|
|
222 (let ((min-idx (+ from 2))
|
|
223 (idx (if first (1- to ) to))
|
|
224 (found nil))
|
|
225 (while (and (not found) (>= idx min-idx))
|
|
226 (let ((kana2-list (skkdic-get-entry
|
|
227 (substring str from idx)
|
|
228 skkdic-word-list)))
|
|
229 (if (or (and (consp kana2-list)
|
|
230 (let ((kana-len (length kana))
|
|
231 kana2)
|
|
232 (catch 'skkdic-tag
|
|
233 (while kana2-list
|
|
234 (setq kana2 (car kana2-list))
|
|
235 (if (string-match kana2 kana)
|
|
236 (throw 'skkdic-tag t))
|
|
237 (setq kana2-list (cdr kana2-list)))))
|
|
238 (or (= idx to)
|
|
239 (skkdic-breakup-string skkbuf kana str
|
|
240 idx to)))
|
|
241 (and (stringp kana2-list)
|
|
242 (string-match kana2-list kana)))
|
|
243 (setq found t)
|
|
244 (setq idx (1- idx)))))
|
|
245 found))
|
|
246 (and first
|
|
247 (> len 2)
|
|
248 (let ((kana2 (skkdic-get-entry
|
|
249 (substring str from (1+ from))
|
|
250 skkdic-prefix-list)))
|
|
251 (and (stringp kana2)
|
|
252 (eq (string-match kana2 kana) 0)))
|
|
253 (skkdic-breakup-string skkbuf kana str (1+ from) to))
|
|
254 (and (not first)
|
|
255 (>= len 1)
|
|
256 (let ((kana2-list (skkdic-get-entry
|
|
257 (substring str from to)
|
|
258 skkdic-postfix-list)))
|
|
259 (and (consp kana2-list)
|
|
260 (let (kana2)
|
|
261 (catch 'skkdic-tag
|
|
262 (while kana2-list
|
|
263 (setq kana2 (car kana2-list))
|
|
264 (if (string= kana2
|
|
265 (substring kana (- (length kana2))))
|
|
266 (throw 'skkdic-tag t))
|
|
267 (setq kana2-list (cdr kana2-list)))))))))))
|
|
268
|
|
269 ;; Return list of candidates which excludes some from CANDIDATES.
|
|
270 ;; Excluded candidates can be derived from another entry.
|
|
271
|
|
272 (defun skkdic-reduced-candidates (skkbuf kana candidates)
|
|
273 (let (elt l)
|
|
274 (while candidates
|
|
275 (setq elt (car candidates))
|
|
276 (if (or (= (length elt) 1)
|
|
277 (and (string-match "^\\cj" elt)
|
|
278 (not (skkdic-breakup-string skkbuf kana elt 0 (length elt)
|
|
279 'first))))
|
|
280 (setq l (cons elt l)))
|
|
281 (setq candidates (cdr candidates)))
|
|
282 (nreverse l)))
|
|
283
|
51055
b3d9bd5b31b8
(skkdic-okuri-nasi-entries, skkdic-okuri-nasi-entries-count):
John Paul Wallington <jpw@pobox.com>
diff
changeset
|
284 (defvar skkdic-okuri-nasi-entries (list nil))
|
b3d9bd5b31b8
(skkdic-okuri-nasi-entries, skkdic-okuri-nasi-entries-count):
John Paul Wallington <jpw@pobox.com>
diff
changeset
|
285 (defvar skkdic-okuri-nasi-entries-count 0)
|
31164
|
286
|
|
287 (defun skkdic-collect-okuri-nasi ()
|
|
288 (message "Collecting OKURI-NASI entries ...")
|
|
289 (save-excursion
|
|
290 (let ((prev-ratio 0)
|
|
291 ratio)
|
|
292 (while (re-search-forward "^\\(\\(\\cH\\|$B!<(B\\)+\\) \\(/\\cj.*\\)/$"
|
|
293 nil t)
|
|
294 (let ((kana (match-string 1))
|
|
295 (candidates (skkdic-get-candidate-list (match-beginning 3)
|
|
296 (match-end 3))))
|
|
297 (setq skkdic-okuri-nasi-entries
|
|
298 (cons (cons kana candidates) skkdic-okuri-nasi-entries)
|
|
299 skkdic-okuri-nasi-entries-count
|
|
300 (1+ skkdic-okuri-nasi-entries-count))
|
|
301 (setq ratio (floor (/ (* (point) 100.0) (point-max))))
|
|
302 (if (/= ratio prev-ratio)
|
|
303 (progn
|
|
304 (message "collected %2d%% %s ..." ratio kana)
|
|
305 (setq prev-ratio ratio)))
|
|
306 (while candidates
|
|
307 (let ((entry (lookup-nested-alist (car candidates)
|
|
308 skkdic-word-list nil nil t)))
|
|
309 (if (consp (car entry))
|
|
310 (setcar entry (cons kana (car entry)))
|
|
311 (set-nested-alist (car candidates) (list kana)
|
|
312 skkdic-word-list)))
|
|
313 (setq candidates (cdr candidates))))))))
|
|
314
|
|
315 (defun skkdic-convert-okuri-nasi (skkbuf buf)
|
|
316 (message "Processing OKURI-NASI entries ...")
|
|
317 (save-excursion
|
|
318 (set-buffer buf)
|
|
319 (insert ";; Setting okuri-nasi entries.\n"
|
|
320 "(skkdic-set-okuri-nasi\n")
|
|
321 (let ((l (nreverse skkdic-okuri-nasi-entries))
|
|
322 (count 0)
|
|
323 (prev-ratio 0)
|
|
324 ratio)
|
|
325 (while l
|
|
326 (let ((kana (car (car l)))
|
|
327 (candidates (cdr (car l))))
|
|
328 (setq ratio (/ (* count 1000) skkdic-okuri-nasi-entries-count)
|
|
329 count (1+ count))
|
|
330 (if (/= prev-ratio (/ ratio 10))
|
|
331 (progn
|
|
332 (message "processed %2d%% %s ..." (/ ratio 10) kana)
|
|
333 (setq prev-ratio (/ ratio 10))))
|
|
334 (if (setq candidates
|
|
335 (skkdic-reduced-candidates skkbuf kana candidates))
|
|
336 (progn
|
|
337 (insert "\"" kana)
|
|
338 (while candidates
|
|
339 (insert " " (car candidates))
|
|
340 (setq candidates (cdr candidates)))
|
|
341 (insert "\"\n"))))
|
|
342 (setq l (cdr l))))
|
|
343 (insert ")\n\n")))
|
|
344
|
|
345 (defun skkdic-convert (filename &optional dirname)
|
|
346 "Generate Emacs lisp file form Japanese dictionary file FILENAME.
|
|
347 The format of the dictionary file should be the same as SKK dictionaries.
|
|
348 Optional argument DIRNAME if specified is the directory name under which
|
|
349 the generated Emacs Lisp is saved.
|
|
350 The name of generated file is specified by the variable `ja-dic-filename'."
|
|
351 (interactive "FSKK dictionary file: ")
|
|
352 (message "Reading file \"%s\" ..." filename)
|
|
353 (let* ((coding-system-for-read 'euc-japan)
|
|
354 (skkbuf(find-file-noselect (expand-file-name filename)))
|
|
355 (buf (get-buffer-create "*skkdic-work*")))
|
|
356 (save-excursion
|
|
357 ;; Setup and generate the header part of working buffer.
|
|
358 (set-buffer buf)
|
|
359 (erase-buffer)
|
|
360 (buffer-disable-undo)
|
46671
|
361 (insert ";;; ja-dic.el --- dictionary for Japanese input method"
|
|
362 " -*-coding: iso-2022-jp;-*-\n"
|
31164
|
363 ";;\tGenerated by the command `skkdic-convert'\n"
|
|
364 ";;\tDate: " (current-time-string) "\n"
|
|
365 ";;\tOriginal SKK dictionary file: "
|
|
366 (file-name-nondirectory filename)
|
|
367 "\n\n"
|
38479
|
368 ";; This file is part of GNU Emacs.\n\n"
|
|
369 ";;; Commentary:\n\n"
|
31164
|
370 ";; Do byte-compile this file again after any modification.\n\n"
|
|
371 ";;; Start of the header of the original SKK dictionary.\n\n")
|
|
372 (set-buffer skkbuf)
|
|
373 (widen)
|
|
374 (goto-char 1)
|
|
375 (let (pos)
|
|
376 (search-forward ";; okuri-ari")
|
|
377 (forward-line 1)
|
|
378 (setq pos (point))
|
|
379 (set-buffer buf)
|
|
380 (insert-buffer-substring skkbuf 1 pos))
|
|
381 (insert "\n"
|
31196
|
382 ";;; Code:\n\n(eval-when-compile (require 'ja-dic-cnv))\n\n")
|
31164
|
383
|
|
384 ;; Generate the body part of working buffer.
|
|
385 (set-buffer skkbuf)
|
|
386 (let ((from (point))
|
|
387 to)
|
|
388 ;; Convert okuri-ari entries.
|
|
389 (search-forward ";; okuri-nasi")
|
|
390 (beginning-of-line)
|
|
391 (setq to (point))
|
|
392 (narrow-to-region from to)
|
|
393 (skkdic-convert-okuri-ari skkbuf buf)
|
|
394 (widen)
|
|
395
|
|
396 ;; Convert okuri-nasi postfix entries.
|
|
397 (goto-char to)
|
|
398 (forward-line 1)
|
|
399 (setq from (point))
|
|
400 (re-search-forward "^\\cH")
|
|
401 (setq to (match-beginning 0))
|
|
402 (narrow-to-region from to)
|
|
403 (skkdic-convert-postfix skkbuf buf)
|
|
404 (widen)
|
|
405
|
|
406 ;; Convert okuri-nasi prefix entries.
|
|
407 (goto-char to)
|
|
408 (skkdic-convert-prefix skkbuf buf)
|
|
409
|
49598
|
410 ;;
|
31164
|
411 (skkdic-collect-okuri-nasi)
|
|
412
|
|
413 ;; Convert okuri-nasi general entries.
|
|
414 (skkdic-convert-okuri-nasi skkbuf buf)
|
|
415
|
|
416 ;; Postfix
|
|
417 (save-excursion
|
|
418 (set-buffer buf)
|
|
419 (goto-char (point-max))
|
38479
|
420 (insert ";;\n(provide 'ja-dic)\n\n;;; ja-dic.el ends here\n")))
|
31164
|
421
|
|
422 ;; Save the working buffer.
|
|
423 (set-buffer buf)
|
|
424 (set-visited-file-name (expand-file-name ja-dic-filename dirname) t)
|
|
425 (set-buffer-file-coding-system 'iso-2022-7bit-short)
|
|
426 (save-buffer 0))
|
|
427 (kill-buffer skkbuf)
|
|
428 (switch-to-buffer buf)))
|
|
429
|
|
430 (defun batch-skkdic-convert ()
|
|
431 "Run `skkdic-convert' on the files remaining on the command line.
|
|
432 Use this from the command line, with `-batch';
|
|
433 it won't work in an interactive Emacs.
|
|
434 For example, invoke:
|
|
435 % emacs -batch -l ja-dic-cnv -f batch-skkdic-convert SKK-JISYO.L
|
|
436 to generate \"ja-dic.el\" from SKK dictionary file \"SKK-JISYO.L\".
|
|
437 To get complete usage, invoke:
|
|
438 % emacs -batch -l ja-dic-cnv -f batch-skkdic-convert -h"
|
|
439 (defvar command-line-args-left) ; Avoid compiler warning.
|
|
440 (if (not noninteractive)
|
|
441 (error "`batch-skkdic-convert' should be used only with -batch"))
|
|
442 (if (string= (car command-line-args-left) "-h")
|
|
443 (progn
|
|
444 (message "To convert SKK-JISYO.L into skkdic.el:")
|
|
445 (message " %% emacs -batch -l ja-dic-cnv -f batch-skkdic-convert SKK-JISYO.L")
|
|
446 (message "To convert SKK-JISYO.L into DIR/ja-dic.el:")
|
|
447 (message " %% emacs -batch -l ja-dic-cnv -f batch-skkdic-convert -dir DIR SKK-JISYO.L"))
|
|
448 (let (targetdir filename)
|
|
449 (if (string= (car command-line-args-left) "-dir")
|
|
450 (progn
|
|
451 (setq command-line-args-left (cdr command-line-args-left))
|
|
452 (setq targetdir (expand-file-name (car command-line-args-left)))
|
|
453 (setq command-line-args-left (cdr command-line-args-left))))
|
|
454 (setq filename (expand-file-name (car command-line-args-left)))
|
|
455 (message "Converting %s to %s ..." filename ja-dic-filename)
|
|
456 (message "It takes around 10 minutes even on Sun SS20.")
|
|
457 (skkdic-convert filename targetdir)
|
|
458 (message "Do byte-compile the created file by:")
|
|
459 (message " %% emacs -batch -f batch-byte-compile %s" ja-dic-filename)
|
|
460 ))
|
|
461 (kill-emacs 0))
|
|
462
|
|
463
|
|
464 ;; The following macros are expanded at byte-compiling time so that
|
|
465 ;; compiled code can be loaded quickly.
|
|
466
|
|
467 (defun skkdic-get-kana-compact-codes (kana)
|
|
468 (let* ((len (length kana))
|
|
469 (vec (make-vector len 0))
|
|
470 (i 0)
|
|
471 ch)
|
|
472 (while (< i len)
|
|
473 (setq ch (aref kana i))
|
|
474 (aset vec i
|
|
475 (if (< ch 128) ; CH is an ASCII letter for OKURIGANA,
|
|
476 (- ch) ; represented by a negative code.
|
|
477 (if (= ch ?$B!<(B) ; `$B!<(B' is represented by 0.
|
|
478 0
|
|
479 (- (nth 2 (split-char ch)) 32))))
|
|
480 (setq i (1+ i)))
|
|
481 vec))
|
|
482
|
|
483 (defun skkdic-extract-conversion-data (entry)
|
|
484 (string-match "^\\cj+[a-z]* " entry)
|
|
485 (let ((kana (substring entry (match-beginning 0) (1- (match-end 0))))
|
|
486 (i (match-end 0))
|
|
487 candidates)
|
|
488 (while (string-match "[^ ]+" entry i)
|
|
489 (setq candidates (cons (match-string 0 entry) candidates))
|
|
490 (setq i (match-end 0)))
|
|
491 (cons (skkdic-get-kana-compact-codes kana) candidates)))
|
|
492
|
|
493 (defmacro skkdic-set-okuri-ari (&rest entries)
|
|
494 `(defconst skkdic-okuri-ari
|
|
495 ',(let ((l entries)
|
|
496 (map '(skkdic-okuri-ari))
|
|
497 entry)
|
|
498 (while l
|
|
499 (setq entry (skkdic-extract-conversion-data (car l)))
|
|
500 (set-nested-alist (car entry) (cdr entry) map)
|
|
501 (setq l (cdr l)))
|
|
502 map)))
|
|
503
|
|
504 (defmacro skkdic-set-postfix (&rest entries)
|
|
505 `(defconst skkdic-postfix
|
|
506 ',(let ((l entries)
|
|
507 (map '(nil))
|
|
508 (longest 1)
|
|
509 len entry)
|
|
510 (while l
|
|
511 (setq entry (skkdic-extract-conversion-data (car l)))
|
|
512 (setq len (length (car entry)))
|
|
513 (if (> len longest)
|
|
514 (setq longest len))
|
|
515 (let ((entry2 (lookup-nested-alist (car entry) map nil nil t)))
|
|
516 (if (consp (car entry2))
|
|
517 (let ((conversions (cdr entry)))
|
|
518 (while conversions
|
|
519 (if (not (member (car conversions) (car entry2)))
|
|
520 (setcar entry2 (cons (car conversions) (car entry2))))
|
|
521 (setq conversions (cdr conversions))))
|
|
522 (set-nested-alist (car entry) (cdr entry) map)))
|
|
523 (setq l (cdr l)))
|
|
524 (setcar map longest)
|
|
525 map)))
|
|
526
|
|
527 (defmacro skkdic-set-prefix (&rest entries)
|
|
528 `(defconst skkdic-prefix
|
|
529 ',(let ((l entries)
|
|
530 (map '(nil))
|
|
531 (longest 1)
|
|
532 len entry)
|
|
533 (while l
|
|
534 (setq entry (skkdic-extract-conversion-data (car l)))
|
|
535 (setq len (length (car entry)))
|
|
536 (if (> len longest)
|
|
537 (setq longest len))
|
|
538 (let ((entry2 (lookup-nested-alist (car entry) map len nil t)))
|
|
539 (if (consp (car entry2))
|
|
540 (let ((conversions (cdr entry)))
|
|
541 (while conversions
|
|
542 (if (not (member (car conversions) (car entry2)))
|
|
543 (setcar entry2 (cons (car conversions) (car entry2))))
|
|
544 (setq conversions (cdr conversions))))
|
|
545 (set-nested-alist (car entry) (cdr entry) map len)))
|
|
546 (setq l (cdr l)))
|
|
547 (setcar map longest)
|
|
548 map)))
|
|
549
|
|
550 (defmacro skkdic-set-okuri-nasi (&rest entries)
|
|
551 `(defconst skkdic-okuri-nasi
|
|
552 ',(let ((l entries)
|
|
553 (map '(skdic-okuri-nasi))
|
|
554 (count 0)
|
|
555 entry)
|
|
556 (while l
|
|
557 (setq count (1+ count))
|
34532
|
558 (if (= (% count 10000) 0)
|
31164
|
559 (message (format "%d entries" count)))
|
|
560 (setq entry (skkdic-extract-conversion-data (car l)))
|
|
561 (set-nested-alist (car entry) (cdr entry) map)
|
|
562 (setq l (cdr l)))
|
|
563 map)))
|
|
564
|
|
565 (provide 'ja-dic-cnv)
|
|
566
|
36681
|
567 ;; Local Variables:
|
|
568 ;; coding: iso-2022-7bit
|
|
569 ;; End:
|
38414
|
570
|
|
571 ;;; ja-dic-cnv.el ends here
|