;;; ja-dic-cnv.el --- convert a Japanese dictionary (SKK-JISYO.L) to Emacs Lisp
+;; Copyright (C) 2001-2016 Free Software Foundation, Inc.
+
;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008, 2009
+;; 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H14PRO021
-;; Keywords: mule, multilingual, Japanese
+;; Keywords: i18n, mule, multilingual, Japanese
;; This file is part of GNU Emacs.
;; 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)
+ (with-current-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)
+ (if (/= (following-char) ?>)
+ (let ((from (point))
+ (to (line-end-position)))
+ (with-current-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))
+ (with-current-buffer buf
(insert ")\n\n")))
(defconst skkdic-postfix-list '(skkdic-postfix-list))
(defun skkdic-convert-postfix (skkbuf buf)
(message "Processing POSTFIX entries ...")
(goto-char (point-min))
- (save-excursion
- (set-buffer buf)
+ (with-current-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)
+ (with-current-buffer buf
(let ((l skkdic-postfix-data)
kana candidates entry)
(while l
(if (not (member str candidates))
(setq candidates (cons str candidates)))
(goto-char (match-end 1)))
- (save-excursion
- (set-buffer buf)
+ (with-current-buffer buf
(insert "\"" kana)
(while candidates
(insert " " (car candidates))
skkdic-postfix-list)))
(setq candidates (cdr candidates)))
(insert "\"\n"))))
- (save-excursion
- (set-buffer buf)
+ (with-current-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)
+ (with-current-buffer buf
(insert ";; Setting prefix entries.\n"
"(skkdic-set-prefix\n"))
(save-excursion
(if (not (member str candidates))
(setq candidates (cons str candidates)))
(goto-char (match-end 1)))
- (save-excursion
- (set-buffer buf)
+ (with-current-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)
+ (with-current-buffer buf
(insert ")\n\n")))
;; FROM and TO point the head and tail of "/J../J../.../".
(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)
+ (setq ratio (floor (* (point) 100.0) (point-max)))
+ (if (/= (/ prev-ratio 10) (/ ratio 10))
(progn
- (message "collected %2d%% %s ..." ratio kana)
+ (message "collected %2d%% ..." ratio)
(setq prev-ratio ratio)))
(while candidates
(let ((entry (lookup-nested-alist (car candidates)
(defun skkdic-convert-okuri-nasi (skkbuf buf)
(message "Processing OKURI-NASI entries ...")
- (save-excursion
- (set-buffer buf)
+ (with-current-buffer buf
(insert ";; Setting okuri-nasi entries.\n"
"(skkdic-set-okuri-nasi\n")
(let ((l (nreverse skkdic-okuri-nasi-entries))
(while l
(let ((kana (car (car l)))
(candidates (cdr (car l))))
- (setq ratio (/ (* count 1000) skkdic-okuri-nasi-entries-count)
+ (setq ratio (floor (* count 100.0) skkdic-okuri-nasi-entries-count)
count (1+ count))
- (if (/= prev-ratio (/ ratio 10))
+ (if (/= (/ prev-ratio 10) (/ ratio 10))
(progn
- (message "processed %2d%% %s ..." (/ ratio 10) kana)
- (setq prev-ratio (/ ratio 10))))
+ (message "processed %2d%% ..." ratio)
+ (setq prev-ratio ratio)))
(if (setq candidates
(skkdic-reduced-candidates skkbuf kana candidates))
(progn
(interactive "FSKK dictionary file: ")
(message "Reading file \"%s\" ..." filename)
(let* ((coding-system-for-read 'euc-japan)
- (skkbuf(find-file-noselect (expand-file-name filename)))
+ (skkbuf (get-buffer-create " *skkdic-unannotated*"))
(buf (get-buffer-create "*skkdic-work*")))
- (save-excursion
- ;; Setup and generate the header part of working buffer.
- (set-buffer buf)
+ ;; Set skkbuf to an unannotated copy of the dictionary.
+ (with-current-buffer skkbuf
+ (insert-file-contents (expand-file-name filename))
+ (re-search-forward "^[^;]")
+ (while (re-search-forward ";[^\n/]*/" nil t)
+ (replace-match "/")))
+ ;; Setup and generate the header part of working buffer.
+ (with-current-buffer buf
(erase-buffer)
(buffer-disable-undo)
- (insert ";;; ja-dic.el --- dictionary for Japanese input method"
- " -*-coding: iso-2022-jp; byte-compile-disable-print-circle:t; -*-\n"
+ (insert ";;; ja-dic.el --- dictionary for Japanese input method\n"
";;\tGenerated by the command `skkdic-convert'\n"
- ";;\tDate: " (current-time-string) "\n"
";;\tOriginal SKK dictionary file: "
(file-relative-name (expand-file-name filename) dirname)
"\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")
(skkdic-convert-okuri-nasi skkbuf buf)
;; Postfix
- (save-excursion
- (set-buffer buf)
+ (with-current-buffer buf
(goto-char (point-max))
- (insert ";;\n(provide 'ja-dic)\n\n;;; ja-dic.el ends here\n")))
+ (insert ";;\n(provide 'ja-dic)\n\n"
+ ";; Local Variables:\n"
+ ";; version-control: never\n"
+ ";; no-update-autoloads: t\n"
+ ";; coding: utf-8\n"
+ ";; End:\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)
+ (set-buffer-file-coding-system 'utf-8)
(save-buffer 0))
(kill-buffer skkbuf)
(switch-to-buffer buf)))
(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)
- ))
+ (skkdic-convert filename targetdir)))
(kill-emacs 0))
;; coding: iso-2022-7bit
;; End:
-;; arch-tag: dec06fb0-8118-45b1-80d7-dc360b6fd3b2
;;; ja-dic-cnv.el ends here