;; -*- mode: emacs-lisp -*-
;; ZIPCODE-MK -- $BM9JXHV9f<-=q:n@.MQ%W%m%0%i%`(B

(set-language-environment "Japanese")
(require 'japan-util)
;(set-default-coding-systems 'euc-jp)

;; $B0lHLM9JXHV9fMQ(B
(defun mkdic-zipcode ()
  (let (*addr3* *addr4* *stat*)
    (set-buffer (get-buffer-create " *dic *"))
    (erase-buffer)
    
    (set-buffer (get-buffer-create " *csv *"))
    (erase-buffer)

    (insert-file-contents "ken_all.csv")

    (goto-char (point-min))
    (mkdic-get-line)
    (while (eq (forward-line) 0)
      (mkdic-get-line))
    
    (set-buffer " *dic *")
    (set-buffer-file-coding-system 'euc-jp-unix)
    (set-buffer-modified-p t)
    (goto-char (point-min))
    (insert ";; okuri-ari entries.
;; okuri-nasi entries.
")
    (write-region (point-min) (point-max) ".zipcode" nil nil nil)))

(defun mkdic-get-line ()
  (let ((i 0)
	zip addr1 addr2 addr3 stat)
    (while (< i 9)
      (cond ((= i 2)
	     (forward-char 1)
	     (setq zip (buffer-substring (point) (+ 7 (point)))))
	    ((= i 6)
	     (forward-char 1)
	     (setq addr1 (buffer-substring (point) (1- (search-forward "\"")))))
	    ((= i 7)
	     (forward-char 1)
	     (setq addr2 (buffer-substring (point) (1- (search-forward "\"")))))
	    ((= i 8)
	     (forward-char 1)
	     (setq addr3 (buffer-substring (point) (1- (search-forward "\""))))
	     ;;
	     (if (or (string= addr3 "$B0J2<$K7G:\$,$J$$>l9g(B")
		     (string-match ".*$B0l1_(B$" addr3)
		     (string-match ".*$B$N<!$KHVCO$,$/$k>l9g(B$" addr3)
		     (string-match "^[$B#0(B-$B#9(B].*[$B#0(B-$B#9(B]$" addr3))
		 (setq addr3 ""))
	     ;;
	     (when (string-match "$B!J(B" addr3)
	       (let ((start (match-beginning 0)))
		 (cond ((string-match "$B3,(B" addr3 start)
			(setq addr3
			      (concat (substring addr3 0 start)
				      (substring addr3 (1+ start) (match-end 0)))))
		       ;;
		       ((and (string= addr1 "$B5~ETI\(B") (string-match "^$B5~ET;T(B" addr2))
			(setq *addr4* (substring addr3 0 start))
			(setq *addr3* (substring addr3 start))
			(if (string-match "$B!K(B$" *addr3*)
			    (progn
			      (setq addr3 (mkdic-process-kyoto *addr3* *addr4*))
			      (setq *stat* nil)
			      (setq *addr4* nil))
			  (setq addr3 nil)
			  (setq *stat* t)))
		       ;;
		       ((and (string-match "$B!K(B" addr3)
			     (not
			      (string-match
			       "$BCO3d(B\\|$B$r=|$/(B\\|$B$r4^$`(B\\|$BA40h(B\\|[$B%"(B-$B%s(B]$B!"(B[$B%"(B-$B%s(B]"
			       addr3)))
			(setq *addr4* (substring addr3 0 start))
			(setq *addr3* (substring addr3 start))
			(when (string= *addr4* "$B9C!"25(B")
			  (setq *addr4* ""))
			(if (and (string-match ".+$B!K(B$" *addr3*)
				 (not (string-match "$B!V(B\\|$B!W(B\\|$B!A(B\\|[$B#0(B-$B#9(B]" *addr3*)))
			    (progn
			      (setq addr3 (mkdic-process-kakkonai *addr3* *addr4*))
			      (setq *stat* nil)
			      (setq *addr4* nil))
			  (setq *addr4* nil)
			  (setq *addr3* nil)
			  (setq addr3 (substring addr3 0 start))
			  (setq *stat* t)))
		       ;;
		       (t
			(setq addr3 (substring addr3 0 start))
			(setq *addr3* nil)
			(setq *stat* t)))))
	     ;;
	     (when (and addr3 (string-match ".*$BCO3d(B$" addr3))
	       (cond ((string-match "$B!"(B" addr3)
		      (let ((start (match-beginning 0)))
			(setq addr3
			      (concat (substring addr3 0 start)
				      "/" addr1 addr2 (substring addr3 (1+ start))))))
		     ((string-match "$B!A(B" addr3)
		      (let ((point (match-beginning 0))
			    fromstr tostr from to chimei str pt1 pt2)
			(setq fromstr (japanese-hankaku (substring addr3 0 point)))
			(setq tostr (japanese-hankaku (substring addr3 (1+ point))))
			(setq chimei (substring fromstr 0 (string-match "[0-9]" fromstr)))
			(setq pt1 (match-beginning 0))
			(and (string-match "$BCO3d(B$" fromstr)
			     (setq pt2 (match-beginning 0)))
			(setq from (string-to-int (substring fromstr pt1 pt2)))
			;;
			(and (string-match "[0-9]" tostr)
			     (setq pt1 (match-beginning 0)))
			(and (string-match "$BCO3d(B$" tostr)
			     (setq pt2 (match-beginning 0)))
			(setq to (string-to-int (substring tostr pt1 pt2)))
			;;
			(let ((i from))
			  (while (<= i to)
			    (cond ((= i from)
				   (setq addr3
					 (concat chimei
						 (japanese-zenkaku (format "%d" i)) "$BCO3d(B")))
				  (t
				   (setq addr3
					 (concat addr3 "/" addr1 addr2 chimei
						 (japanese-zenkaku (format "%d" i)) "$BCO3d(B"))))
			    (setq i (1+ i))))))))
	     ;;
	     (when (and addr3 (string-match "$B!K(B$" addr3))
	       (cond ((and *addr4* *addr3*)
		      (setq *addr3* (concat *addr3* addr3))
		      (setq addr3 (mkdic-process-kyoto *addr3* *addr4*))
		      (setq *stat* nil)
		      (setq *addr4* nil)
		      )
		     (t
		      (and *addr3* (setq addr3 *addr3*)
			   (setq *stat* nil)))))
	     ;;
	     (cond ((and *stat* *addr4* *addr3* addr3)
		    (setq *addr3* (concat *addr3* addr3))
		    (setq addr3 nil))
		   (addr3	     
		    (if (string-match "$B!"(B" addr3)
			(if *stat*
			    (and *addr3* (setq addr3 *addr3*))
			  (setq addr3 ""))))
		   (t nil)))
	    (t nil))
      ;;
      (let ((search (search-forward "," nil t)))
	(if search
	    (setq i (1+ i))
	  (setq i 9))))
    ;;
    (if (and *stat* addr3)
	(setq *addr3* addr3)
      (if *addr4*
	  nil
	(setq *addr3* nil)))
    ;;
    (save-excursion
      (set-buffer " *dic *")
      (when (and zip addr1 addr2 addr3)
	(insert zip)
	(insert " /")
	(insert addr1)
	(insert addr2)
	(insert addr3)
	(insert "/\n")))))

(defun mkdic-process-kyoto (nantaras cho)
  (let (addr)
    (cond ((string-match "\\($B!A(B\\|$B!JCzL\!K(B\\|$B$=$NB>(B\\|$BHVCO!K(B$\\)" nantaras)
	   (setq nantaras nil))
	  ((string-match "$B!J(B[$B#0(B-$B#9(B]$BCzL\!K(B" nantaras)
	   (setq cho (concat cho (substring nantaras 1 (1- (length nantaras)))))
	   (setq nantaras nil))
	  (t
	   (setq nantaras (split-string (substring nantaras 1 (1- (length nantaras))) "$B!"(B"))))
    (cond ((not nantaras)
	   (setq addr cho))
	  (t
	   (setq addr (concat (car nantaras) cho))
	   (mapcar #'(lambda (nantara)
		       (setq addr (concat addr "/" addr1 addr2 nantara cho)))
		   (cdr nantaras))
	   addr))))

(defun mkdic-process-kakkonai (detail cho)
  (let (addr)
    (cond ((string-match "\\($B!A(B\\|$B!JCzL\!K(B\\|$BHVCO!K(B$\\)" detail)
	   (setq detail nil))
	  ((string-match "$B!J(B[$B#0(B-$B#9(B]$BCzL\!K(B" detail)
	   (setq cho (concat cho (substring detail 1 (1- (length detail)))))
	   (setq detail nil))
	  (t
	   (setq detail (split-string (substring detail 1 (1- (length detail))) "$B!"(B"))))
    (cond ((not detail)
	   (setq addr cho))
	  (t
	   (unless (or (member "" detail)
		       (memq nil detail))
	     (setq detail (cons "" detail)))
	   (setq addr (concat cho (car detail)))
	   (mapcar #'(lambda (nantara)
		       (unless (string-match "$B$=$NB>(B" nantara)
			 (setq addr (concat addr "/" addr1 addr2 cho nantara))))
		     (cdr detail))
	   addr))))

;; $B;v6H=jMQ(B
(defun mkdic-office ()
  (let (*addr3* *addr4* *stat*)
    (set-buffer (get-buffer-create " *dic *"))
    (erase-buffer)
    
    (set-buffer (get-buffer-create " *csv *"))
    (erase-buffer)
    
    (insert-file-contents "jigyosyo.csv")
    
    (goto-char (point-min))
    (mkdic-office-get-line)
    (while (eq (forward-line) 0)
      (mkdic-office-get-line))
    
    (set-buffer " *dic *")
    (set-buffer-file-coding-system 'euc-jp-unix)
    (set-buffer-modified-p t)
    (goto-char (point-min))
    
    (when (re-search-forward "^91086\"," nil t)
      (replace-match "9108630"))

    (goto-char (point-min))
    (insert ";; okuri-ari entries.
;; okuri-nasi entries.
")
    (write-region (point-min) (point-max) ".office" nil nil nil)))

(defun mkdic-office-get-line ()
  (let ((i 0)
	zip name addr1 addr2 addr3 addr4)
    (while (< i 9)
      (cond ((= i 7)
	     (forward-char 1)
	     (setq zip (buffer-substring (point) (+ 7 (point)))))
	    ((= i 2)
	     (forward-char 1)
	     (setq name (buffer-substring (point) (1- (search-forward "\"")))))
	    ((= i 3)
	     (forward-char 1)
	     (setq addr1 (buffer-substring (point) (1- (search-forward "\"")))))
	    ((= i 4)
	     (forward-char 1)
	     (setq addr2 (buffer-substring (point) (1- (search-forward "\"")))))
	    ((= i 5)
	     (forward-char 1)
	     (setq addr3 (buffer-substring (point) (1- (search-forward "\"")))))
	    ((= i 6)
	     (forward-char 1)
	     (setq addr4 (buffer-substring (point) (1- (search-forward "\""))))))
      ;;
      (let ((search (search-forward "," nil t)))
	(if search
	    (setq i (1+ i))
	  (setq i 9))))
    ;;
    (save-excursion
      (set-buffer " *dic *")
      (when (and zip name addr1 addr2 addr3 addr4)
	(insert zip)
	(insert " /")
	(insert name)
	(insert " @ ")
	(insert addr1)
	(insert addr2)
	(insert addr3)
	(insert addr4)
	(insert "/\n")))))

(defun mkdic-words ()
  (let ((dics '("SKK-JISYO.office.zipcode" "SKK-JISYO.zipcode")) str)
    (set-buffer (get-buffer-create " *words *"))
    (erase-buffer)
  
    (set-buffer (get-buffer-create " *dic *"))

    (while dics
      (erase-buffer)
      (insert-file-contents (car dics))
      (goto-char (point-min))
      (while (re-search-forward "^[0-9][0-9][0-9][0-9][0-9][0-9][0-9] " nil t)
	(setq str (buffer-substring (match-beginning 0) (1- (match-end 0))))
	(save-excursion
	  (set-buffer (get-buffer " *words *"))
	  (goto-char (point-max))
	  (insert (format "%s\n" str))))
      (setq dics (cdr dics)))

    (set-buffer (get-buffer " *words *"))
    (sort-lines nil (point-min) (point-max))
    (write-region (point-min) (point-max) "words.zipcode" nil nil nil)))

;;

(defun mkdic-zipcode-header ()
  (with-temp-buffer
    (insert "\
;; -*- mode: fundamental; coding: euc-jp -*-
;; 7-digit ZIP code dictionary for SKK system
;;
;; Copyright (C) 2000 Tetsuo Tsukamoto <czkmt@remus.dti.ne.jp>
;;
;; Maintainer: SKK Development Team <skk@ring.gr.jp>
;; Version: $Id: ZIPCODE-MK,v 1.4 2000/11/20 21:50:31 czkmt Exp $
;; Keywords: japanese
;; Last Modified: $Date: 2000/11/20 21:50:31 $
;;
;; This dictionary  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  versions 2,  or  (at your option)  any  later
;; version.
;;
;; This dictionary  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
;; SKK,  see the file COPYING.  If not,  write  to the Free Software Foundation
;; Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
;;
")
    (write-region (point-min) (point-max) "SKK-JISYO.zipcode")))

(defun mkdic-office-header ()
  (with-temp-buffer
    (insert "\
;; -*- mode: fundamental; coding: euc-jp -*-
;; 7-digit ZIP code (offices) dictionary for SKK system
;;
;; Copyright (C) 2000 Tetsuo Tsukamoto <czkmt@remus.dti.ne.jp>
;;
;; Maintainer: SKK Development Team <skk@ring.gr.jp>
;; Version: $Id: ZIPCODE-MK,v 1.4 2000/11/20 21:50:31 czkmt Exp $
;; Keywords: japanese
;; Last Modified: $Date: 2000/11/20 21:50:31 $
;;
;; This dictionary  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  versions 2,  or  (at your option)  any  later
;; version.
;;
;; This dictionary  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
;; SKK,  see the file COPYING.  If not,  write  to the Free Software Foundation
;; Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
;;
")
    (write-region (point-min) (point-max) "SKK-JISYO.office.zipcode")))

;; ZIPCODE-MK ends here
