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

(require 'cl)

(set-language-environment "Japanese")
(require 'japan-util)

(defvar TEMP_ZIPCODE nil)
(defvar TEMP_OFFICE nil)

(defvar KEN_ALL nil)
(defvar JIGYOSYO nil)

(let ((vars '(TEMP_ZIPCODE TEMP_OFFICE KEN_ALL JIGYOSYO))
      (args (nthcdr 4 command-line-args-left)))
  (when args
    (while (not (stringp (car args)))
      (setq args (cdr args)))
    (while vars
      (set (car vars) (car args))
      (setq args (cdr args))
      (setq vars (cdr vars)))))

;(save-excursion
;  (set-buffer (get-buffer-create " *arere*"))
;  (insert (format "%s %s %s %s %s" TEMP_ZIPCODE TEMP_OFFICE KEN_ALL JIGYOSYO
;		  command-line-args-left))
;  (write-region (point-min) (point-max) "00arere"))

;; $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 (expand-file-name KEN_ALL))
    ;;
    (goto-char (point-min))
    ;;
    (while (not (looking-at "^[0-9]"))
      (forward-line))
    ;;
    (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)
		  (expand-file-name TEMP_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= "$B0J2<$K7G:\$,$J$$>l9g(B"
			 addr3)
		(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))
	      (if (string-match "$BCO3d(B$" fromstr)
		  (setq pt2 (match-beginning 0)))
	      (setq from (string-to-int (substring fromstr
						   pt1
						   pt2)))
	      ;;
	      (if (string-match "[0-9]" tostr)
		  (setq pt1 (match-beginning 0)))
	      (if (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
	    (if (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))
      (mapc #'(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)))
      (mapc #'(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 (expand-file-name JIGYOSYO))
    ;;
    (goto-char (point-min))
    ;;
    (while (not (looking-at "^[0-9]"))
      (forward-line))
    ;;
    (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)
		  (expand-file-name TEMP_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 *"))
    ;;
    (dolist (dic dics)
      (erase-buffer)
      (insert-file-contents dic)
      (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)))))
    ;;
    (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: skk-jisyo-edit; 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.7 2001/09/23 11:16:06 czkmt Exp $
;; Keywords: japanese
;; Last Modified: $Date: 2001/09/23 11:16:06 $
;;
;; 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: skk-jisyo-edit; 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.7 2001/09/23 11:16:06 czkmt Exp $
;; Keywords: japanese
;; Last Modified: $Date: 2001/09/23 11:16:06 $
;;
;; 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
