lisp/international/ja-dic-cnv.el

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