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