[bpt/emacs.git] / lisp / international / ja-dic-cnv.el

;;; ja-dic-cnv.el --- convert a Japanese dictionary (SKK-JISYO.L) to Emacs Lisp

;; Copyright (C) 1995, 2000
;;   National Institute of Advanced Industrial Science and Technology (AIST)
;;   Registration Number H14PRO021

;; Keywords: mule, multilingual, Japanese

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;;; Commentary:

;; SKK is a Japanese input method running on Mule created by Masahiko
;; Sato <masahiko@sato.riec.tohoku.ac.jp>.  Here we provide utilities
;; to handle a dictionary distributed with SKK so that a different
;; input method (e.g. quail-japanese) can utilize the dictionary.

;; The format of SKK dictionary is quite simple.  Each line has the
;; form "KANASTRING /CONV1/CONV2/.../" which means KANASTRING (\e$B2>L>J8\e(B
;; \e$B;zNs\e(B) can be converted to one of CONVi.  CONVi is a Kanji (\e$B4A;z\e(B)
;; and Kana (\e$B2>L>\e(B) mixed string.
;;
;; KANASTRING may have a trailing ASCII letter for Okurigana (\e$BAw$j2>L>\e(B)
;; information.  For instance, the trailing letter `k' means that one
;; of the following Okurigana is allowed: \e$B$+$-$/$1$3\e(B.  So, in that
;; case, the string "KANASTRING\e$B$/\e(B" can be converted to one of "CONV1\e$B$/\e(B",
;; CONV2\e$B$/\e(B, ...

;;; Code:

;; Name of a file to generate from SKK dictionary.
(defvar ja-dic-filename "ja-dic.el")

;; To make a generated ja-dic.el smaller.
(define-coding-system 'iso-2022-7bit-short
 "Like `iso-2022-7bit' but no ASCII designation before SPC."
  :coding-type 'iso-2022
  :mnemonic ?J
  :charset-list 'iso-2022
  :designation [(ascii t) nil nil nil]
  :flags '(short 7-bit designation))

(defun skkdic-convert-okuri-ari (skkbuf buf)
  (message "Processing OKURI-ARI entries ...")
  (goto-char (point-min))
  (save-excursion
    (set-buffer buf)
    (insert ";; Setting okuri-ari entries.\n"
	    "(skkdic-set-okuri-ari\n"))
  (while (not (eobp))
    (let ((from (point))
	  to)
      (end-of-line)
      (setq to (point))

      (save-excursion
	(set-buffer buf)
	(insert-buffer-substring skkbuf from to)
	(beginning-of-line)
	(insert "\"")
	(search-forward " ")
	(delete-char 1)			; delete the first '/'
	(let ((p (point)))
	  (end-of-line)
	  (delete-char -1)		; delete the last '/'
	  (subst-char-in-region p (point) ?/ ? 'noundo))
	(insert "\"\n"))

      (forward-line 1)))
  (save-excursion
    (set-buffer buf)
    (insert ")\n\n")))

(defconst skkdic-postfix-list '(skkdic-postfix-list))

(defconst skkdic-postfix-data
  '(("\e$B$$$-\e(B" "\e$B9T\e(B")
    ("\e$B$,$+$j\e(B" "\e$B78\e(B")
    ("\e$B$,$/\e(B" "\e$B3X\e(B")
    ("\e$B$,$o\e(B" "\e$B@n\e(B")
    ("\e$B$7$c\e(B" "\e$B<R\e(B")
    ("\e$B$7$e$&\e(B" "\e$B=8\e(B")
    ("\e$B$7$g$&\e(B" "\e$B>^\e(B" "\e$B>k\e(B")
    ("\e$B$8$g$&\e(B" "\e$B>k\e(B")
    ("\e$B$;$s\e(B" "\e$B@~\e(B")
    ("\e$B$@$1\e(B" "\e$B3Y\e(B")
    ("\e$B$A$c$/\e(B" "\e$BCe\e(B")
    ("\e$B$F$s\e(B" "\e$BE9\e(B")
    ("\e$B$H$&$2\e(B" "\e$BF=\e(B")
    ("\e$B$I$*$j\e(B" "\e$BDL$j\e(B")
    ("\e$B$d$^\e(B" "\e$B;3\e(B")
    ("\e$B$P$7\e(B" "\e$B66\e(B")
    ("\e$B$O$D\e(B" "\e$BH/\e(B")
    ("\e$B$b$/\e(B" "\e$BL\\e(B")
    ("\e$B$f$-\e(B" "\e$B9T\e(B")))

(defun skkdic-convert-postfix (skkbuf buf)
  (message "Processing POSTFIX entries ...")
  (goto-char (point-min))
  (save-excursion
    (set-buffer buf)
    (insert ";; Setting postfix entries.\n"
	    "(skkdic-set-postfix\n"))

  ;; Initialize SKKDIC-POSTFIX-LIST by predefined data
  ;; SKKDIC-POSTFIX-DATA.
  (save-excursion
    (set-buffer buf)
    (let ((l skkdic-postfix-data)
	  kana candidates entry)
      (while l
	(setq kana (car (car l)) candidates (cdr (car l)))
	(insert "\"" kana)
	(while candidates
	  (insert " " (car candidates))
	  (setq entry (lookup-nested-alist (car candidates)
					   skkdic-postfix-list nil nil t))
	  (if (consp (car entry))
	      (setcar entry (cons kana (car entry)))
	    (set-nested-alist (car candidates) (list kana)
			      skkdic-postfix-list))
	  (setq candidates (cdr candidates)))
	(insert "\"\n")
	(setq l (cdr l)))))

  ;; Search postfix entries.
  (while (re-search-forward "^[#<>?]\\(\\(\\cH\\|\e$B!<\e(B\\)+\\) " nil t)
    (let ((kana (match-string 1))
	  str candidates)
      (while (looking-at "/[#0-9 ]*\\([^/\n]*\\)/")
	(setq str (match-string 1))
	(if (not (member str candidates))
	    (setq candidates (cons str candidates)))
	(goto-char (match-end 1)))
      (save-excursion
	(set-buffer buf)
	(insert "\"" kana)
	(while candidates
	  (insert " " (car candidates))
	  (let ((entry (lookup-nested-alist (car candidates)
					    skkdic-postfix-list nil nil t)))
	    (if (consp (car entry))
		(if (not (member kana (car entry)))
		    (setcar entry (cons kana (car entry))))
	      (set-nested-alist (car candidates) (list kana)
				skkdic-postfix-list)))
	  (setq candidates (cdr candidates)))
	(insert "\"\n"))))
  (save-excursion
    (set-buffer buf)
    (insert ")\n\n")))

(defconst skkdic-prefix-list '(skkdic-prefix-list))

(defun skkdic-convert-prefix (skkbuf buf)
  (message "Processing PREFIX entries ...")
  (goto-char (point-min))
  (save-excursion
    (set-buffer buf)
    (insert ";; Setting prefix entries.\n"
	    "(skkdic-set-prefix\n"))
  (save-excursion
    (while (re-search-forward "^\\(\\(\\cH\\|\e$B!<\e(B\\)+\\)[<>?] " nil t)
      (let ((kana (match-string 1))
	    str candidates)
	(while (looking-at "/\\([^/\n]+\\)/")
	  (setq str (match-string 1))
	  (if (not (member str candidates))
	      (setq candidates (cons str candidates)))
	  (goto-char (match-end 1)))
	(save-excursion
	  (set-buffer buf)
	  (insert "\"" kana)
	  (while candidates
	    (insert " " (car candidates))
	    (set-nested-alist (car candidates) kana skkdic-prefix-list)
	    (setq candidates (cdr candidates)))
	  (insert "\"\n")))))
  (save-excursion
    (set-buffer buf)
    (insert ")\n\n")))

;; FROM and TO point the head and tail of "/J../J../.../".
(defun skkdic-get-candidate-list (from to)
  (let (candidates)
    (goto-char from)
    (while (re-search-forward "/[^/ \n]+" to t)
      (setq candidates (cons (buffer-substring (1+ (match-beginning 0))
					       (match-end 0))
			     candidates)))
    candidates))

;; Return entry for STR from nested alist ALIST.
(defsubst skkdic-get-entry (str alist)
  (car (lookup-nested-alist str alist nil nil t)))


(defconst skkdic-word-list '(skkdic-word-list))

;; Return t if substring of STR (between FROM and TO) can be broken up
;; to chunks all of which can be derived from another entry in SKK
;; dictionary.  SKKBUF is the buffer where the original SKK dictionary
;; is visited, KANA is the current entry for STR.  FIRST is t iff this
;; is called at top level.

(defun skkdic-breakup-string (skkbuf kana str from to &optional first)
  (let ((len (- to from)))
    (or (and (>= len 2)
	     (let ((min-idx (+ from 2))
		   (idx (if first (1- to ) to))
		   (found nil))
	       (while (and (not found) (>= idx min-idx))
		 (let ((kana2-list (skkdic-get-entry
				    (substring str from idx)
				    skkdic-word-list)))
		   (if (or (and (consp kana2-list)
				(let ((kana-len (length kana))
				      kana2)
				  (catch 'skkdic-tag
				    (while kana2-list
				      (setq kana2 (car kana2-list))
				      (if (string-match kana2 kana)
					  (throw 'skkdic-tag t))
				      (setq kana2-list (cdr kana2-list)))))
				(or (= idx to)
				    (skkdic-breakup-string skkbuf kana str
							   idx to)))
			   (and (stringp kana2-list)
				(string-match kana2-list kana)))
		       (setq found t)
		     (setq idx (1- idx)))))
	       found))
	(and first
	     (> len 2)
	     (let ((kana2 (skkdic-get-entry
			   (substring str from (1+ from))
			   skkdic-prefix-list)))
	       (and (stringp kana2)
		    (eq (string-match kana2 kana) 0)))
	     (skkdic-breakup-string skkbuf kana str (1+ from) to))
	(and (not first)
	     (>= len 1)
	     (let ((kana2-list (skkdic-get-entry
				(substring str from to)
				skkdic-postfix-list)))
	       (and (consp kana2-list)
		    (let (kana2)
		      (catch 'skkdic-tag
			(while kana2-list
			  (setq kana2 (car kana2-list))
			  (if (string= kana2
				       (substring kana (- (length kana2))))
			      (throw 'skkdic-tag t))
			  (setq kana2-list (cdr kana2-list)))))))))))

;; Return list of candidates which excludes some from CANDIDATES.
;; Excluded candidates can be derived from another entry.

(defun skkdic-reduced-candidates (skkbuf kana candidates)
  (let (elt l)
    (while candidates
      (setq elt (car candidates))
      (if (or (= (length elt) 1)
	      (and (string-match "^\\cj" elt)
		   (not (skkdic-breakup-string skkbuf kana elt 0 (length elt)
					       'first))))
	  (setq l (cons elt l)))
      (setq candidates (cdr candidates)))
    (nreverse l)))

(defvar skkdic-okuri-nasi-entries (list nil))
(defvar skkdic-okuri-nasi-entries-count 0)

(defun skkdic-collect-okuri-nasi ()
  (message "Collecting OKURI-NASI entries ...")
  (save-excursion
    (let ((prev-ratio 0)
	  ratio)
      (while (re-search-forward "^\\(\\(\\cH\\|\e$B!<\e(B\\)+\\) \\(/\\cj.*\\)/$"
				nil t)
	(let ((kana (match-string 1))
	      (candidates (skkdic-get-candidate-list (match-beginning 3)
						     (match-end 3))))
	  (setq skkdic-okuri-nasi-entries
		(cons (cons kana candidates) skkdic-okuri-nasi-entries)
		skkdic-okuri-nasi-entries-count
		(1+ skkdic-okuri-nasi-entries-count))
	  (setq ratio (floor (/ (* (point) 100.0) (point-max))))
	  (if (/= ratio prev-ratio)
	      (progn
		(message "collected %2d%% %s ..." ratio kana)
		(setq prev-ratio ratio)))
	  (while candidates
	    (let ((entry (lookup-nested-alist (car candidates)
					      skkdic-word-list nil nil t)))
	      (if (consp (car entry))
		  (setcar entry (cons kana (car entry)))
		(set-nested-alist (car candidates) (list kana)
				  skkdic-word-list)))
	    (setq candidates (cdr candidates))))))))

(defun skkdic-convert-okuri-nasi (skkbuf buf)
  (message "Processing OKURI-NASI entries ...")
  (save-excursion
    (set-buffer buf)
    (insert ";; Setting okuri-nasi entries.\n"
	    "(skkdic-set-okuri-nasi\n")
    (let ((l (nreverse skkdic-okuri-nasi-entries))
	  (count 0)
	  (prev-ratio 0)
	  ratio)
      (while l
	(let ((kana (car (car l)))
	      (candidates (cdr (car l))))
	  (setq ratio (/ (* count 1000) skkdic-okuri-nasi-entries-count)
		count (1+ count))
	  (if (/= prev-ratio (/ ratio 10))
	      (progn
		(message "processed %2d%% %s ..." (/ ratio 10) kana)
		(setq prev-ratio (/ ratio 10))))
	  (if (setq candidates
		    (skkdic-reduced-candidates skkbuf kana candidates))
	      (progn
		(insert "\"" kana)
		(while candidates
		  (insert " " (car candidates))
		  (setq candidates (cdr candidates)))
		(insert "\"\n"))))
	(setq l (cdr l))))
    (insert ")\n\n")))

(defun skkdic-convert (filename &optional dirname)
  "Generate Emacs lisp file form Japanese dictionary file FILENAME.
The format of the dictionary file should be the same as SKK dictionaries.
Optional argument DIRNAME if specified is the directory name under which
the generated Emacs Lisp is saved.
The name of generated file is specified by the variable `ja-dic-filename'."
  (interactive "FSKK dictionary file: ")
  (message "Reading file \"%s\" ..." filename)
  (let* ((coding-system-for-read 'euc-japan)
	 (skkbuf(find-file-noselect (expand-file-name filename)))
	 (buf (get-buffer-create "*skkdic-work*")))
    (save-excursion
      ;; Setup and generate the header part of working buffer.
      (set-buffer buf)
      (erase-buffer)
      (buffer-disable-undo)
      (insert ";;; ja-dic.el --- dictionary for Japanese input method"
	      " -*-coding: iso-2022-jp;-*-\n"
	      ";;\tGenerated by the command `skkdic-convert'\n"
	      ";;\tDate: " (current-time-string) "\n"
	      ";;\tOriginal SKK dictionary file: "
	      (file-name-nondirectory filename)
	      "\n\n"
	      ";; This file is part of GNU Emacs.\n\n"
	      ";;; Commentary:\n\n"
	      ";; Do byte-compile this file again after any modification.\n\n"
	      ";;; Start of the header of the original SKK dictionary.\n\n")
      (set-buffer skkbuf)
      (widen)
      (goto-char 1)
      (let (pos)
	(search-forward ";; okuri-ari")
	(forward-line 1)
	(setq pos (point))
	(set-buffer buf)
	(insert-buffer-substring skkbuf 1 pos))
      (insert "\n"
	      ";;; Code:\n\n(eval-when-compile (require 'ja-dic-cnv))\n\n")

      ;; Generate the body part of working buffer.
      (set-buffer skkbuf)
      (let ((from (point))
	    to)
	;; Convert okuri-ari entries.
	(search-forward ";; okuri-nasi")
	(beginning-of-line)
	(setq to (point))
	(narrow-to-region from to)
	(skkdic-convert-okuri-ari skkbuf buf)
	(widen)

	;; Convert okuri-nasi postfix entries.
	(goto-char to)
	(forward-line 1)
	(setq from (point))
	(re-search-forward "^\\cH")
	(setq to (match-beginning 0))
	(narrow-to-region from to)
	(skkdic-convert-postfix skkbuf buf)
	(widen)

	;; Convert okuri-nasi prefix entries.
	(goto-char to)
	(skkdic-convert-prefix skkbuf buf)

	;;
	(skkdic-collect-okuri-nasi)

	;; Convert okuri-nasi general entries.
	(skkdic-convert-okuri-nasi skkbuf buf)

	;; Postfix
	(save-excursion
	  (set-buffer buf)
	  (goto-char (point-max))
	  (insert ";;\n(provide 'ja-dic)\n\n;;; ja-dic.el ends here\n")))

      ;; Save the working buffer.
      (set-buffer buf)
      (set-visited-file-name (expand-file-name ja-dic-filename dirname) t)
      (set-buffer-file-coding-system 'iso-2022-7bit-short)
      (save-buffer 0))
    (kill-buffer skkbuf)
    (switch-to-buffer buf)))

(defun batch-skkdic-convert ()
  "Run `skkdic-convert' on the files remaining on the command line.
Use this from the command line, with `-batch';
it won't work in an interactive Emacs.
For example, invoke:
  % emacs -batch -l ja-dic-cnv -f batch-skkdic-convert SKK-JISYO.L
to generate  \"ja-dic.el\" from SKK dictionary file \"SKK-JISYO.L\".
To get complete usage, invoke:
 % emacs -batch -l ja-dic-cnv -f batch-skkdic-convert -h"
  (defvar command-line-args-left)	; Avoid compiler warning.
  (if (not noninteractive)
      (error "`batch-skkdic-convert' should be used only with -batch"))
  (if (string= (car command-line-args-left) "-h")
      (progn
	(message "To convert SKK-JISYO.L into skkdic.el:")
	(message "  %% emacs -batch -l ja-dic-cnv -f batch-skkdic-convert SKK-JISYO.L")
	(message "To convert SKK-JISYO.L into DIR/ja-dic.el:")
	(message "  %% emacs -batch -l ja-dic-cnv -f batch-skkdic-convert -dir DIR SKK-JISYO.L"))
    (let (targetdir filename)
      (if (string= (car command-line-args-left) "-dir")
	  (progn
	    (setq command-line-args-left (cdr command-line-args-left))
	    (setq targetdir (expand-file-name (car command-line-args-left)))
	    (setq command-line-args-left (cdr command-line-args-left))))
      (setq filename (expand-file-name (car command-line-args-left)))
      (message "Converting %s to %s ..." filename ja-dic-filename)
      (message "It takes around 10 minutes even on Sun SS20.")
      (skkdic-convert filename targetdir)
      (message "Do byte-compile the created file by:")
      (message "  %% emacs -batch -f batch-byte-compile %s" ja-dic-filename)
      ))
  (kill-emacs 0))


;; The following macros are expanded at byte-compiling time so that
;; compiled code can be loaded quickly.

(defun skkdic-get-kana-compact-codes (kana)
  (let* ((len (length kana))
	 (vec (make-vector len 0))
	 (i 0)
	 ch)
    (while (< i len)
      (setq ch (aref kana i))
      (aset vec i
	    (if (< ch 128)		; CH is an ASCII letter for OKURIGANA,
		(- ch)			;  represented by a negative code.
	      (if (= ch ?\e$B!<\e(B)		; `\e$B!<\e(B' is represented by 0.
		  0
		(- (logand (encode-char ch 'japanese-jisx0208) #xFF) 32))))
      (setq i (1+ i)))
    vec))

(defun skkdic-extract-conversion-data (entry)
  (string-match "^\\cj+[a-z]* " entry)
  (let ((kana (substring entry (match-beginning 0) (1- (match-end 0))))
	(i (match-end 0))
	candidates)
    (while (string-match "[^ ]+" entry i)
      (setq candidates (cons (match-string 0 entry) candidates))
      (setq i (match-end 0)))
    (cons (skkdic-get-kana-compact-codes kana) candidates)))

(defmacro skkdic-set-okuri-ari (&rest entries)
  `(defconst skkdic-okuri-ari
     ',(let ((l entries)
	     (map '(skkdic-okuri-ari))
	     entry)
	 (while l
	   (setq entry (skkdic-extract-conversion-data (car l)))
	   (set-nested-alist (car entry) (cdr entry) map)
	   (setq l (cdr l)))
	 map)))

(defmacro skkdic-set-postfix (&rest entries)
  `(defconst skkdic-postfix
     ',(let ((l entries)
	     (map '(nil))
	     (longest 1)
	     len entry)
	 (while l
	   (setq entry (skkdic-extract-conversion-data (car l)))
	   (setq len (length (car entry)))
	   (if (> len longest)
	       (setq longest len))
	   (let ((entry2 (lookup-nested-alist (car entry) map nil nil t)))
	     (if (consp (car entry2))
		 (let ((conversions (cdr entry)))
		   (while conversions
		     (if (not (member (car conversions) (car entry2)))
			 (setcar entry2 (cons (car conversions) (car entry2))))
		     (setq conversions (cdr conversions))))
	       (set-nested-alist (car entry) (cdr entry) map)))
	   (setq l (cdr l)))
	 (setcar map longest)
	 map)))

(defmacro skkdic-set-prefix (&rest entries)
  `(defconst skkdic-prefix
     ',(let ((l entries)
	     (map '(nil))
	     (longest 1)
	     len entry)
	 (while l
	   (setq entry (skkdic-extract-conversion-data (car l)))
	   (setq len (length (car entry)))
	   (if (> len longest)
	       (setq longest len))
	   (let ((entry2 (lookup-nested-alist (car entry) map len nil t)))
	     (if (consp (car entry2))
		 (let ((conversions (cdr entry)))
		   (while conversions
		     (if (not (member (car conversions) (car entry2)))
			 (setcar entry2 (cons (car conversions) (car entry2))))
		     (setq conversions (cdr conversions))))
	       (set-nested-alist (car entry) (cdr entry) map len)))
	   (setq l (cdr l)))
	 (setcar map longest)
	 map)))

(defmacro skkdic-set-okuri-nasi (&rest entries)
  `(defconst skkdic-okuri-nasi
     ',(let ((l entries)
	     (map '(skdic-okuri-nasi))
	     (count 0)
	     entry)
	 (while l
	   (setq count (1+ count))
	   (if (= (% count 10000) 0)
	       (message (format "%d entries" count)))
	   (setq entry (skkdic-extract-conversion-data (car l)))
	   (set-nested-alist (car entry) (cdr entry) map)
	   (setq l (cdr l)))
	 map)))

(provide 'ja-dic-cnv)

;; Local Variables:
;; coding: iso-2022-7bit
;; End:

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