;;; egg/wnn.el --- WNN Support (high level interface) in Egg
;;;                Input Method Architecture

;; Copyright (C) 1997, 1998 Mule Project, Powered by Electrotechnical
;; Laboratory, JAPAN.
;; Project Leader: Satoru Tomura <tomura@etl.go.jp>

;; Author: NIIBE Yutaka <gniibe@mri.co.jp>
;;         KATAYAMA Yoshio <kate@pfu.co.jp> ; Korean, Chinese support.
;;
;; Maintainer: NIIBE Yutaka <gniibe@mri.co.jp>

;; This file is part of EGG.

;; EGG 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.

;; EGG 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., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;;; Code:

(require 'egg-edep)

(defgroup wnn nil
  "Wnn interface for Tamagotchy"
  :group 'egg)

(defconst wnn-support-languages '(Japanese Chinese-GB Chinese-CNS Korean))

(eval-when-compile
  (defmacro WNN-const (c)
    (cond ((eq c 'BUN_SENTOU) -1)
	  ((eq c 'NO_EXIST)  1)
	  ((eq c 'NO_MATCH) 10)
	  ((eq c 'IMA_OFF)   -4)
	  ((eq c 'IMA_ON)    -3)
	  ((eq c 'HINDO_NOP) -2)
	  ((eq c 'HINDO_INC) -3))))

(defconst wnn-conversion-backend
  [ wnn-init

    wnn-start-conversion
      wnn-get-bunsetsu-converted
      wnn-get-bunsetsu-source
      wnn-list-candidates
          wnn-get-number-of-candidates
          wnn-get-current-candidate-number
          wnn-get-all-candidates
          wnn-decide-candidate
      wnn-change-bunsetsu-length
    wnn-end-conversion
    wnn-start-reverse-conversion

    wnn-fini
 ])

;; <env> ::= [ <proc> <env-id> <server-type> <dic-set> <rev-flag>
;;             <daibunsetsu-info> ]

(defsubst wnnenv-create (proc env-id server-type dic-set rev-flag)
  (vector proc env-id server-type dic-set rev-flag nil))

(defsubst wnnenv-get-proc (env)
  (aref env 0))

(defsubst wnnenv-get-env-id (env)
  (aref env 1))

(defsubst wnnenv-get-server-type (env)
  (aref env 2))

(defsubst wnnenv-get-dictionary-set (env)
  (aref env 3))

(defsubst wnnenv-get-reverse-flag (env)
  (aref env 4))

(defsubst wnnenv-get-daibunsetsu-info (env)
  (aref env 5))
(defsubst wnnenv-set-daibunsetsu-info (env d)
  (aset env 5 d))

;; <bunsetsu> ::= [ <env> <end> <start> <jiritsugo-end> <dic-no>
;;                  <entry> <freq> <right-now> <hinshi> <status>
;;                  <status-backward> <kangovect> <evaluation>
;;
;;                  <converted> <yomi> <fuzokugo>
;;		    <zenkouho> <freq-down>
;;                  <zenkouho-pos> ]
;;
(defsubst wnn-bunsetsu-create (e end start jiritsugo-end dic-no entry freq
			       right-now hinshi status status-backward
			       kangovect evaluation)
  (vector e end start jiritsugo-end dic-no entry freq right-now
	  hinshi status status-backward kangovect evaluation
	  nil nil nil nil nil nil))

(defsubst wnn-bunsetsu-get-env (bunsetsu)
  (aref bunsetsu 0))

(defsubst wnn-bunsetsu-get-converted (bunsetsu)
  (aref bunsetsu 13))
(defsubst wnn-bunsetsu-set-converted (bunsetsu converted)
  (aset bunsetsu 13 converted))

(defsubst wnn-bunsetsu-get-hinshi (bunsetsu)
  (aref bunsetsu 8))

(defsubst wnn-bunsetsu-get-dic-no (bunsetsu)
  (aref bunsetsu 4))

(defsubst wnn-bunsetsu-get-entry (bunsetsu)
  (aref bunsetsu 5))

(defsubst wnn-bunsetsu-get-right-now (bunsetsu)
  (aref bunsetsu 7))

(defsubst wnn-bunsetsu-get-yomi (bunsetsu)
  (aref bunsetsu 14))
(defsubst wnn-bunsetsu-set-yomi (bunsetsu yomi)
  (aset bunsetsu 14 yomi))

(defsubst wnn-bunsetsu-get-fuzokugo (bunsetsu)
  (aref bunsetsu 15))
(defsubst wnn-bunsetsu-set-fuzokugo (bunsetsu fuzokugo)
  (aset bunsetsu 15 fuzokugo))

(defsubst wnn-bunsetsu-get-zenkouho (bunsetsu)
  (aref bunsetsu 16))
(defsubst wnn-bunsetsu-set-zenkouho (bunsetsu z)
  (aset bunsetsu 16 z))

(defsubst wnn-bunsetsu-get-freq-down (bunsetsu)
  (aref bunsetsu 17))
(defsubst wnn-bunsetsu-set-freq-down (bunsetsu d)
  (aset bunsetsu 17 d))

(defsubst wnn-bunsetsu-get-zenkouho-pos (bunsetsu)
  (aref bunsetsu 18))
(defsubst wnn-bunsetsu-set-zenkouho-pos (bunsetsu zp)
  (aset bunsetsu 18 zp))

(defvar wnn-environments nil
  "Environment for WNN kana-kanji conversion")

(defcustom wnn-jserver nil "jserver host list" :group 'wnn :type 'string)
(defcustom wnn-cserver nil "cserver host list" :group 'wnn :type 'string)
(defcustom wnn-tserver nil "tserver host list" :group 'wnn :type 'string)
(defcustom wnn-kserver nil "kserver host list" :group 'wnn :type 'string)

(defcustom wnn-jport 22273 "jserver port number" :group 'wnn :type 'integer)
(defcustom wnn-cport 22289 "cserver port number" :group 'wnn :type 'integer)
(defcustom wnn-tport 22321 "tserver port number" :group 'wnn :type 'integer)
(defcustom wnn-kport 22305 "kserver port number" :group 'wnn :type 'integer)

;; The port number should be initialized from $WNNLIB/serverdefs by wnn-init
(defconst wnn-server-info-list
  ;; language    locale  server  port     stream coding-system hostname
  '((Japanese    "ja_JP" jserver wnn-jport "Wnn"  fixed-euc-jp wnn-jserver)
    (Chinese-GB  "zh_CN" cserver wnn-cport "cWnn" fixed-euc-cn wnn-cserver)
    (Chinese-CNS "zh_TW" tserver wnn-tport "tWnn" fixed-euc-tw wnn-tserver)
    (Korean      "ko_KR" kserver wnn-kport "kWnn" fixed-euc-kr wnn-kserver)))

(defsubst wnn-server-get-info (lang)
  (assq (or lang its-current-language) wnn-server-info-list))

(defsubst wnn-server-language (info)
  (car info))

(defsubst wnn-server-locale (info)
  (nth 1 info))

(defsubst wnn-server-type (info)
  (nth 2 info))

(defsubst wnn-server-port (info)
  (symbol-value (nth 3 info)))

(defsubst wnn-server-stream-name (info)
  (nth 4 info))

(defsubst wnn-server-buffer-name (info)
  (concat " *" (wnn-server-stream-name info) "*"))

(defsubst wnn-server-coding-system (info)
  (nth 5 info))

(defsubst wnn-server-hostname (info)
  (symbol-value (nth 6 info)))

(defun wnn-init ()
  )

(defun wnn-start-conversion (yomi &optional language dic-set reverse)
  "Convert YOMI string to kanji, and enter conversion mode.
Return the list of bunsetsu."
  (let ((server-info (wnn-server-get-info language)))
    (if server-info
	(let* ((env (wnn-get-environment server-info dic-set reverse))
	       (result (wnnrpc-renbunsetsu-conversion env yomi
						      (WNN-const BUN_SENTOU) "")))
	  (wnnenv-set-daibunsetsu-info env (car result))
	  (cdr result))
    (signal 'lang-not-supported))))

(defun wnn-start-reverse-conversion (yomi &optional language dic-set)
  (wnn-start-conversion yomi language dic-set t))

(defun wnn-get-bunsetsu-converted (bunsetsu)
  (concat (wnn-bunsetsu-get-converted bunsetsu)
	  (wnn-bunsetsu-get-fuzokugo  bunsetsu)))

;; WNN-UNIQ-CANDIDATES
;;
;; Here, IMNSHO, WNN is broken.
;; WNN must/should return unique one.  The word is representative
;; among possible words with same string literal.
;;
;; With no bunsetsu information to users, users have to chose
;; the word based on the string literal only.
;; How we could update frequency?
;;
;; We'll modify WNN in future.
;;
;; 
(defun wnn-uniq-candidates (bunsetsu bunsetsu-list)
  (let ((hash-table (make-vector 31 0)) ; XXX why 31?
	(l bunsetsu-list)
	(i 0)
	(n 0) sym0 result p b sym)
    (setq sym0 (intern (wnn-get-bunsetsu-converted bunsetsu) hash-table))
    (while l
      (setq b (car l)
	    l (cdr l)
	    sym (intern (wnn-get-bunsetsu-converted b) hash-table))
      (if (null (boundp sym))		; new one
	  (let ((bl (cons b nil)))
	    (set sym b)
	    (if (eq sym0 sym)
		(wnn-bunsetsu-set-zenkouho-pos bunsetsu (setq n i)))
	    (if p
		(setq p (setcdr p bl))
	      (setq result (setq p bl)))
	    (setq i (1+ i)))))
    (wnn-bunsetsu-set-zenkouho bunsetsu result)
    n))

(defun wnn-list-candidates (bunsetsu prev-bunsetsu)
  (let* ((candidates (wnn-bunsetsu-get-zenkouho bunsetsu))
	 (yomi (concat (wnn-bunsetsu-get-yomi bunsetsu)
		       (wnn-bunsetsu-get-fuzokugo bunsetsu)))
	 (converted (concat (wnn-bunsetsu-get-converted bunsetsu)
			    (wnn-bunsetsu-get-fuzokugo bunsetsu)))
	 (env (wnn-bunsetsu-get-env bunsetsu))
	 prev-hinshi
	 prev-fuzokugo)
    (if candidates
	;; We have the candidates already.  Return the current position.
	(wnn-bunsetsu-get-zenkouho-pos bunsetsu)
      (if (null prev-bunsetsu)
	  (setq prev-hinshi -1
		prev-fuzokugo "")
	(setq prev-hinshi (wnn-bunsetsu-get-hinshi prev-bunsetsu)
	      prev-fuzokugo (wnn-bunsetsu-get-fuzokugo prev-bunsetsu)))
      (setq candidates
	    (wnnrpc-get-bunsetsu-candidates env yomi
					    prev-hinshi prev-fuzokugo))
      (wnn-uniq-candidates bunsetsu candidates))))

(defun wnn-get-number-of-candidates (bunsetsu)
  (let ((l (wnn-bunsetsu-get-zenkouho bunsetsu)))
    (if l
	(length l)
      nil)))

(defun wnn-get-current-candidate-number (bunsetsu)
  (wnn-bunsetsu-get-zenkouho-pos bunsetsu))

(defun wnn-get-all-candidates (bunsetsu)
  (let* ((l (wnn-bunsetsu-get-zenkouho bunsetsu))
	 (result (cons nil nil))
	 (r result))
    (catch 'break
      (while t
	(let ((candidate (car l)))
	  (setcar r (concat (wnn-bunsetsu-get-converted candidate)
			    (wnn-bunsetsu-get-fuzokugo candidate)))
	  (if (null (setq l (cdr l)))
	      (throw 'break nil)
	    (setq r (setcdr r (cons nil nil)))))))
    result))

(defun wnn-decide-candidate (bunsetsu candidate-pos)
  (let* ((candidate-list (wnn-bunsetsu-get-zenkouho bunsetsu))
	 (candidate (nth candidate-pos candidate-list)))
    (wnn-bunsetsu-set-zenkouho candidate candidate-list)
    (wnn-bunsetsu-set-zenkouho-pos candidate candidate-pos)
    candidate))

;;
;;
(defun wnn-change-bunsetsu-length (b0 b1 b2 len)
  (let ((yomi (concat
	       (wnn-get-bunsetsu-source b1)
	       (if b2 (wnn-get-bunsetsu-source b2))))
	(env (wnn-bunsetsu-get-env b1))
	yomi1 yomi2 prev-hinshi prev-fuzokugo
	bunsetsu1 bunsetsu2)
    (if (null b0)
	(setq prev-hinshi -1
	      prev-fuzokugo "")
      (setq prev-hinshi (wnn-bunsetsu-get-hinshi b0)
	    prev-fuzokugo (wnn-bunsetsu-get-fuzokugo b0)))
    (setq yomi1 (substring yomi 0 len)
	  yomi2 (substring yomi len))
    (setq bunsetsu1
	  (car (wnnrpc-tanbunsetsu-conversion env yomi1
					      prev-hinshi prev-fuzokugo)))
    ;; Only set once.
    (wnn-bunsetsu-set-freq-down bunsetsu1
				(or (wnn-bunsetsu-get-freq-down b1)
				    (if b2
					(list b1 b2)
				      (list b1))))
    (if (< 0 (length yomi2))
	(setq bunsetsu2
	      (cdr (wnnrpc-renbunsetsu-conversion
		    env yomi2
		    (wnn-bunsetsu-get-hinshi bunsetsu1)
		    (wnn-bunsetsu-get-fuzokugo bunsetsu1))))
      (setq bunsetsu2 nil))
    (if bunsetsu2
	(append (list bunsetsu1) bunsetsu2)
      (list bunsetsu1))))


(defun wnn-get-bunsetsu-source (bunsetsu)
  (concat (wnn-bunsetsu-get-yomi bunsetsu)
	  (wnn-bunsetsu-get-fuzokugo bunsetsu)))

(defun wnn-end-conversion (bunsetsu-info-list abort)
  (if abort
      ()
    (let ((env (wnn-bunsetsu-get-env (car bunsetsu-info-list))))
      (wnn-update-frequency env bunsetsu-info-list)
      (wnnenv-set-daibunsetsu-info env nil))))

(defvar wnn-sticky-environment-flag nil
  "*Flag which specifies sticky environment.")

(defmacro wnn-for-each-environment (lang env &rest body)
  `(let* ((server-info (wnn-server-get-info ,lang))
	 (server-type (wnn-server-type server-info))
	 (env-list wnn-environments))
    (if server-type
	(while env-list
	  (let ((,env (car env-list)))
	    ,@body)
	  (setq env-list (cdr env-list))))))

(defun wnn-fini ()
  (let ((l wnn-support-languages))
    (while l
      (wnn-fini-lang (car l))
      (setq l (cdr l)))))

(defun wnn-fini-lang (lang &optional save-only)
  (let* ((server-info (wnn-server-get-info lang))
	 (server-type (wnn-server-type server-info))
	 (l wnn-environments)
	 new-env-list del-list env proc)
    (if server-type
	(progn
	  (message "%s の頻度情報・辞書情報を退避しています"
		   (wnn-server-stream-name server-info))
	  (while l
	    (setq env (car l))
	    (if (eq (wnnenv-get-server-type env) server-type)
		(condition-case nil
		    (progn
		      (wnn-save-dictionaries env)
		      (if (null save-only)
			  (progn
			    (setq del-list (nconc del-list (list env)))
			    (if wnn-sticky-environment-flag
				(wnnrpc-make-env-sticky env)
			      (wnnrpc-make-env-unsticky env))
			    (wnnrpc-disconnect env))))
		  (error nil))
	      (setq new-env-list (nconc new-env-list (list env))))
	    (setq l (cdr l)))
	  (message "%s の頻度情報・辞書情報を退避しました"
		   (wnn-server-stream-name server-info))
	  (if (null save-only)
	      (progn
		(setq proc (and del-list (wnnenv-get-proc (car del-list))))
		(if (and proc (eq (process-status proc) 'open))
		    (progn
		      (wnnrpc-close proc)
		      (kill-buffer (process-buffer proc))))
		(setq wnn-environments new-env-list)))))))

(defun wnn-close (lang)
  (interactive (list (wnn-read-active-lang)))
  (or (listp lang)
      (setq lang (list lang)))
  (while lang
    (wnn-fini-lang (car lang))
    (setq lang (cdr lang))))

(defun wnn-dictionary-save (lang)
  (interactive (list (wnn-read-active-lang)))
  (or (listp lang)
      (setq lang (list lang)))
  (while lang
    (wnn-fini-lang (car lang) t)
    (setq lang (cdr lang))))

(defun wnn-read-active-lang ()
  (let ((completion-ignore-case t)
	(env wnn-environments)
	langs server server-list)
    (while env
      (setq server (wnnenv-get-server-type (car env))
	    env (cdr env))
      (if (null (member server server-list))
	  (setq server-list (cons server server-list))))
    (setq langs (delete nil
			(mapcar (lambda (info)
				  (if (memq (wnn-server-type info) server-list)
				      (wnn-server-language info)))
				wnn-server-info-list)))
    (if (<= (length langs) 1)
	langs
      (setq langs (cons (cons "All" langs)
			(mapcar (lambda (lang) (cons (symbol-name lang) lang))
				langs)))
      (cdr (assoc (completing-read "language? " langs nil t) langs)))))

;;
(defun wnn-comm-sentinel (proc reason)	; assume it is close
					; tamago-971009 version
  (let ((l wnn-environments)
	env l1)
    (kill-buffer (process-buffer proc))
    ;; delete env from the list.
    (while l
      (setq env (car l))
      (if (eq proc (wnnenv-get-proc env))
	  (progn
	    (if l1
		(setcdr l1 (cdr l))
	      (setq wnn-environments (cdr l)))
	    (setq l (cdr l)))
	(setq l1 l
	      l (cdr l))))))

;;
(defvar wnn-open-message)

(defun wnn-open (server-info)
  "Establish the connection to WNN server.  Return process object."
  ;; Open the session to WNN server, 
  (let ((buf (generate-new-buffer (wnn-server-buffer-name server-info)))
	(server-type (wnn-server-type server-info))
	(hostname-list (wnn-server-hostname server-info))
	(msg-form "WNN: connecting to %S at %s...")
 	hostname proc result msg)
    (save-excursion
      (set-buffer buf)
      (erase-buffer)
      (buffer-disable-undo)
      (setq egg-fixed-euc (wnn-server-coding-system server-info))
      (set-buffer-multibyte nil))
    (cond
     ((null hostname-list)
      (setq hostname-list '("localhost")))
     ((null (listp hostname-list))
      (setq hostname-list (list hostname-list))))
    (while (and hostname-list (null proc))
      (setq hostname (car hostname-list)
	    hostname-list (cdr hostname-list))
      (message msg-form server-type hostname)
      (condition-case result
	  (setq proc (open-network-stream (wnn-server-stream-name server-info)
					  buf
					  hostname
					  (wnn-server-port server-info)))
	(error nil))
      (if proc
	  (progn
	    (process-kill-without-query proc)
	    (set-process-coding-system proc 'no-conversion 'no-conversion)
	    (set-process-sentinel proc 'wnn-comm-sentinel)
	    (set-marker-insertion-type (process-mark proc) t)
	    (setq result (wnnrpc-open proc
				      (if (equal hostname "localhost")
					  "unix"
					(system-name))
				      (user-login-name)))
	    (if (< result 0)
		(progn
		  (delete-process proc)
		  (setq proc nil
			msg (format "Can't open WNN session (%s %S): %s"
				    hostname
				    (wnn-server-type server-info)
				    msg)))))))
    (if proc
	(progn
	  (setq wnn-open-message (format (concat msg-form "done")
					 server-type
					 hostname))
	  proc)
      (kill-buffer buf)
      (error "%s" (or msg (format "no %S available" server-type))))))

(defvar wnn-dictionary-specification-list
  '((jserver
     (nil nil ""
	  [2 10 2 45 100 200 5 1 40 -100 200 -100 200 80 200 200 200]
	  "pubdic/full.fzk"
	  ["pubdic/kihon.dic"     ("kihon.h")    5 nil t]
	  ["pubdic/setsuji.dic"   ("setsuji.h")  5 nil t]
	  ["pubdic/koyuu.dic"     ("koyuu.h")    1 nil t]
	  ["pubdic/chimei.dic"    ("chimei.h")   1 nil t]
	  ["pubdic/jinmei.dic"    ("jinmei.h")   1 nil t]
	  ["pubdic/special.dic"   ("special.h")  5 nil t]
	  ["pubdic/computer.dic"  ("computer.h") 5 nil t]
	  ["pubdic/symbol.dic"    ("symbol.h")   1 nil t]
	  ["pubdic/tankan.dic"    nil            1 nil nil]
	  ["pubdic/bio.dic"       ("bio.h")      1 nil t]
;	  ["gerodic/g-jinmei.dic" ("g-jinmei.h") 1 nil t]
	  ["wnncons/tankan2.dic"  nil            1 nil nil]
	  ["wnncons/tankan3.dic"  nil            1 nil nil]
	  [("ud")                 nil            5 t   t])
     (nil t "R"
	  [2 10 2 45 1 80 5 1 50 -20 400 -10 100 -100 200 0 200]
	  "pubdic/full.fzk"
	  ["pubdic/kihon.dic"     ("kihon.h")    5 nil t]
	  ["pubdic/setsuji.dic"   ("setsuji.h")  5 nil t]
	  ["pubdic/koyuu.dic"     ("koyuu.h")    1 nil t]
	  ["pubdic/chimei.dic"    ("chimei.h")   1 nil t]
	  ["pubdic/jinmei.dic"    ("jinmei.h")   1 nil t]
	  ["pubdic/special.dic"   ("special.h")  5 nil t]
	  ["pubdic/computer.dic"  ("computer.h") 5 nil t]
	  ["pubdic/symbol.dic"    ("symbol.h")   1 nil t]
	  ["pubdic/tankan.dic"    nil            1 nil nil]
	  ["pubdic/bio.dic"       ("bio.h")      1 nil t]
;	  ["gerodic/g-jinmei.dic" ("g-jinmei.h") 1 nil t]
	  ["wnncons/tankan2.dic"  nil            1 nil nil]
	  ["wnncons/tankan3.dic"  nil            1 nil nil]
	  [("ud")                 nil            5 t   t]))
    (cserver
     (Q   nil "Q"
	  nil
	  "sys/full.con"
	  ["sys/QianMa.dic"       nil            1 nil nil])
     (W   nil "W"
	  nil
	  "sys/full.con"
	  ["sys/WuBi.dic"         nil            1 nil nil])
     (nil nil "PZ"
	  [1 5 2 750 10 80 10 5 1000 50 0 -200 0 0 0 16 0]
	  "sys/full.con"
	  ["sys/level_1.dic"      ("level_1.h")  4 nil t]
	  ["sys/level_2.dic"      ("level_2.h")  1 nil t]
	  ["sys/basic.dic"        ("basic.h")    7 nil t]
	  ["sys/computer.dic"     ("computer.h") 4 nil t]
	  ["sys/cwnn.dic"         ("cwnn.h")     4 nil t]
	  [("ud")                 nil            5 t   t])
     (Q   t "QR"
	  nil
	  "sys/full.conR"
	  ["sys/QianMa.dic"       nil            1 nil nil])
     (W   t "WR"
	  nil
	  "sys/full.conR"
	  ["sys/WuBi.dic"         nil            1 nil nil])
     (nil t "PZR"
	  [1 5 2 750 10 80 10 5 1000 50 0 -200 0 0 0 16 0]
	  "sys/full.conR"
	  ["sys/level_1.dic"      ("level_1.h")  4 nil t]
	  ["sys/level_2.dic"      ("level_2.h")  1 nil t]
	  ["sys/basic.dic"        ("basic.h")    7 nil t]
	  ["sys/computer.dic"     ("computer.h") 4 nil t]
	  ["sys/cwnn.dic"         ("cwnn.h")     4 nil t]
	  [("ud")                 nil            5 t   t]))
    (tserver
     (nil nil ""
	  [1 5 2 750 10 80 10 5 1000 50 0 -200 0 0 0 16 0]
	  "sys/full.con"
	  ["sys/cns_ch.dic"       ("cns_ch.h")   4 nil t]
	  ["sys/cns_wd.dic"       ("cns_wd.h")   1 nil t]
	  [("ud")                 nil            5 t   t])
     (nil t "R"
	  [1 5 2 750 10 80 10 5 1000 50 0 -200 0 0 0 16 0]
	  "sys/full.conR"
	  ["sys/cns_ch.dic"       ("cns_ch.h")   4 nil t]
	  ["sys/cns_wd.dic"       ("cns_wd.h")   1 nil t]
	  [("ud")                 nil            5 t   t]))
    (kserver
     (nil nil ""
	  [2 5 2 45 200 80 5 1 40 0 400 -100 400 80 200 2 200]
	  "sys/full.fzk"
	  ["sys/hword.dic"        ("hword.h")    5 nil t]
	  ["sys/single.dic"       ("single.h")   1 nil t]
	  [("ud")                 nil            2 t   t])
     (nil t "R"
	  [2 10 2 45 1 80 5 1 50 -20 400 -10 100 -100 200 0 200]
	  "sys/full.fzk"
	  ["sys/hword.dic"        ("hword.h")    5 nil t]
	  ["sys/single.dic"       ("single.h")   1 nil t]
	  [("ud")                 nil            2 t   t]))))

(defsubst wnn-get-dic-spec (server)
  (cdr (assoc server wnn-dictionary-specification-list)))

(defsubst wnn-dic-spec-dic-set (spec)
  (nth 0 spec))

(defsubst wnn-dic-spec-reverse (spec)
  (nth 1 spec))

(defsubst wnn-dic-spec-name (spec)
  (nth 2 spec))

(defsubst wnn-dic-spec-param (spec)
  (nth 3 spec))

(defsubst wnn-dic-spec-fuzokugo (spec)
  (nth 4 spec))

(defsubst wnn-dic-spec-dic-list (spec)
  (nthcdr 5 spec))


(defcustom wnn-usr-dic-dir (concat "usr/" (user-login-name))
  "*Directory of user dictionary for Wnn."
  :group 'wnn
  :type 'string)

(defun wnn-filename (p)
  ""
  (cond ((consp p) (concat wnn-usr-dic-dir "/" (car p)))
	(t p)))

(defun wnn-open-file (proc env-id filename)
  "Open the file FILENAME on the environment ENV-ID on server process PROC.
Return file descripter.  NIL means NO-file.
On failure, return negate-encoded error code."
  (if filename
      (wnnrpc-open-file proc env-id filename)
    nil))

(defun wnn-create-directory (proc env-id path)
  "Create directory to the path."
  (let ((dir (directory-file-name path))
	create-list)
    (while (and dir (/= (wnnrpc-access proc env-id 0 dir) 0))
      (setq create-list (cons dir create-list)
	    dir (file-name-directory dir))
      (if dir
	  (setq dir (directory-file-name dir))))
    (if (null create-list)
	t				; Already exist.
      ;; Only query once.
      (if (y-or-n-p (format "ディレクトリ(%s)が有りません。作りますか? " path))
	  (catch 'return
	    (while create-list
	      (let* ((dir (car create-list))
		     (ret (wnnrpc-mkdir proc env-id dir)))
		(if (< ret 0)
		    (progn
		      (message "ディレクトリ(%s)の作成に失敗しました" dir)
		      (throw 'return nil))))
	      (setq create-list (cdr create-list)))
	    ;; Success
	    (message "ディレクトリ(%s)を作りました" path)
	    t)
	;; Failure
	nil))))

(defun wnn-open-dictionary (proc env-id dicname mode)
  (let ((dictionary (wnn-open-file proc env-id dicname)))
    (if (null dictionary)
	(throw 'wnn-set-dictionary-tag nil)
      (while (< dictionary 0)
	(let ((err-code (- dictionary)))
	  (if (or (null mode) (/= err-code (WNN-const NO_EXIST)))
	      (let ((msg (wnnrpc-get-error-message err-code)))
		(message "辞書ファイル(%s)がありません: %s" dicname msg)
		(throw 'wnn-set-dictionary-tag nil)) ; Failure
	    ;; Try to create new one
	    (if (and (y-or-n-p
		      (format "辞書ファイル(%s)がありません。作りますか? "
			      dicname))
		     (wnn-create-directory proc env-id
					   (file-name-directory dicname))
		     (= (wnnrpc-create-dictionary proc env-id dicname) 0))
		(progn
		  (message "辞書ファイル(%s)を作りました" dicname)
		  (setq dictionary
			(wnnrpc-open-file proc env-id dicname)))
	      (throw 'wnn-set-dictionary-tag nil)))))
      dictionary)))

(defun wnn-open-frequency (proc env-id freqname mode dic)
  (let ((frequency (wnn-open-file proc env-id freqname)))
    (if (null frequency)
	(setq frequency -1)
      (while (< frequency 0)
	(let ((err-code (- frequency)))
	  (if (or (null mode) (/= err-code (WNN-const NO_EXIST)))
	      (let ((msg (wnnrpc-get-error-message err-code)))
		(message "頻度ファイル(%s)がありません: %s" freqname msg)
		(throw 'wnn-set-dictionary-tag nil)) ; Failure
	    ;; Try to create new one
	    (if (and (y-or-n-p
		      (format "頻度ファイル(%s)がありません。作りますか? "
			      freqname))
		     (wnn-create-directory proc env-id
					   (file-name-directory freqname))
		     (= (wnnrpc-create-frequency proc env-id freqname dic) 0))
		(progn
		  (message "頻度ファイル(%s)を作りました" freqname)
		  (setq frequency
			(wnnrpc-open-file proc env-id freqname)))
	      (throw 'wnn-set-dictionary-tag nil))))))
      frequency))

;; Using local file (uploading/downloading) is not supported yet.
;; Password is not supported (Password is questionable feature, anyway)
(defun wnn-set-dictionary (proc env-id reverse-flag dic-spec)
  ""
  (catch 'wnn-set-dictionary-tag
    (let ((dicname (wnn-filename (aref dic-spec 0)))
	  (freqname (wnn-filename (aref dic-spec 1)))
	  (priority  (aref dic-spec 2))
	  (dic-mode  (aref dic-spec 3))
	  (freq-mode (aref dic-spec 4))
	  dictionary frequency)
      (setq dictionary (wnn-open-dictionary proc env-id dicname dic-mode))
      (setq frequency
	    (wnn-open-frequency proc env-id freqname freq-mode dictionary))
      (wnn-set-dictionary-sub proc env-id reverse-flag
			      dictionary frequency priority dic-mode
			      freq-mode dicname freqname))))

(defun wnn-set-dictionary-sub (proc env-id reverse-flag
			       dictionary frequency priority dic-mode
			       freq-mode dicname freqname)
  (let ((trying t))
    (while trying
      (let ((ret (wnnrpc-set-dictionary proc env-id reverse-flag
					dictionary frequency
					priority dic-mode freq-mode)))
	(if (< ret 0)
	    (let ((err-code (- ret)))
	      (if (or (null freq-mode) (/= err-code (WNN-const NO_MATCH)))
		  (let ((msg (wnnrpc-get-error-message (- ret))))
		    (message "WNN: Error on setting dictionary (%s, %s): %s"
			     dicname freqname msg)
		    (setq trying nil))	; done
		;; No-match: Create new frequency and try it again
		(wnnrpc-discard-file proc env-id frequency) ; XXX: error?
		(setq frequency
		      (wnn-query-del/create-frequency proc env-id freqname
						      dictionary))))
	  ;; done sucessfully
	  (setq trying nil))))))

(defun wnn-query-del/create-frequency (proc env-id freqname dictionary)
  (if (y-or-n-p
       (format "辞書と頻度(%s)の整合性がありません。作り直しますか? "
	       freqname))
      (progn
	(wnnrpc-remove-file proc freqname) ; XXX: error?
	(wnnrpc-create-frequency proc env-id freqname dictionary) ; XXX: error?
	(message "頻度ファイル(%s)を作りました" freqname)
	(wnnrpc-open-file proc env-id freqname)) ; XXX: error?
    -1))

(defun wnn-get-environment (server-info &optional dic-set reverse)
  "Return WNN Environemt for the conversion server specified
by SERVER-INFO.  If none, create new environment.  Optional
argument DIC-SET specifies dictionary set.  Optional argument
REVERSE specifies reverse conversion, if non nil."
  (let ((server-type (wnn-server-type server-info))
	(env wnn-environments)
	proc spec e s)
    (setq reverse (null (null reverse)))
    (if (catch 'found
	  (while env
	    (setq e (car env))
	    (if (and (eq (wnnenv-get-server-type e) server-type)
		     (eq (wnnenv-get-dictionary-set e) dic-set)
		     (eq (wnnenv-get-reverse-flag e) reverse))
		(throw 'found t))
	    (setq env (cdr env))))
	e
      (setq proc (wnn-open server-info)
	    spec (wnn-get-dic-spec server-type))
      (while spec
	(setq s (car spec)
	      e (wnn-create-environment proc server-type s)
	      wnn-environments (cons e wnn-environments))
	(if (and (eq (wnn-dic-spec-dic-set s) dic-set)
		 (eq (wnn-dic-spec-reverse s) reverse))
	    (setq env e))
	(setq spec (cdr spec)))
      (if (null env)
	  (error "WNN: environment for %S%s (%s) not found"
		 server-type
		 (if dic-set (format "(%S)" dic-set) "")
		 (if reverse 'reverse 'normal)))
      (message "%s" wnn-open-message)
      env)))

(defun wnn-create-environment (proc server-type spec)
  ""
  ;; Create new data structure: something like wnn_buf
  ;; Process, Environment-ID and Daibunsetsu-info.
  (let (env-id parameters filename fuzokugo-fid ret dic-set reverse)
    (setq env-id (wnnrpc-connect proc (wnn-make-env-name spec)))
    (if (< env-id 0)
	(error "Can't connect new WNN environment: %s"
	       (wnnrpc-get-error-message (- env-id))))
    (setq dic-set (wnn-dic-spec-dic-set spec)
	  reverse (wnn-dic-spec-reverse spec)
	  parameters (wnn-dic-spec-param spec)
	  filename (wnn-filename (wnn-dic-spec-fuzokugo spec))
	  fuzokugo-fid (wnn-open-file proc env-id filename))
    (if (null fuzokugo-fid)
	(setq fuzokugo-fid -1)
      (if (< fuzokugo-fid 0)
	  (progn
	    (message "WNN: Can't open fuzokugo file (%s): %s"
		     filename
		     (wnnrpc-get-error-message (- fuzokugo-fid)))
	    (setq fuzokugo-fid -1))))
    (setq ret (wnnrpc-set-fuzokugo-file proc env-id fuzokugo-fid))
    (if (< ret 0)
	(let ((msg (wnnrpc-get-error-message (- ret))))
	  (message "WNN: Error on setting fuzokugo (%s): %s" filename msg)))
    (setq spec (wnn-dic-spec-dic-list spec))
    (while spec
      (wnn-set-dictionary proc env-id reverse (car spec))
      (setq spec (cdr spec)))
    (if parameters
	(wnnrpc-set-conversion-parameters proc env-id parameters))
    (wnnenv-create proc env-id server-type dic-set reverse)))

(defvar wnn-user-name nil)

(defun wnn-make-env-name (spec)
  (or wnn-user-name
      (setq wnn-user-name (getenv "WNNUSER"))
      (setq wnn-user-name (user-login-name)))
  (concat wnn-user-name (wnn-dic-spec-name spec)))

(defun wnn-update-frequency (env bunsetsu-info-list)
  (let ((l bunsetsu-info-list))
    (while l
      (let* ((b (car l))
	     (fd (wnn-bunsetsu-get-freq-down b))
	     (z (wnn-bunsetsu-get-zenkouho b)))
	(while fd
	  (let* ((fdb (car fd))
		 (dic-no (wnn-bunsetsu-get-dic-no fdb))
		 (entry (wnn-bunsetsu-get-entry fdb)))
	    (wnnrpc-set-frequency env dic-no entry
				  (WNN-const IMA_OFF) (WNN-const HINDO_NOP))
	    (setq fd (cdr fd))))
	(while z
	  (let* ((zb (car z))
		 (right-now (wnn-bunsetsu-get-right-now zb))
		 (dic-no (wnn-bunsetsu-get-dic-no zb))
		 (entry (wnn-bunsetsu-get-entry zb)))
	    (if (and (/= right-now 0) (/= dic-no -1))
		(wnnrpc-set-frequency env dic-no entry (WNN-const IMA_OFF)
				      (WNN-const HINDO_NOP)))
	    (setq z (cdr z))))
	(let ((dic-no (wnn-bunsetsu-get-dic-no b))
	      (entry (wnn-bunsetsu-get-entry b)))
	  (if (/= dic-no -1)
	      (wnnrpc-set-frequency env dic-no entry 
				    (WNN-const IMA_ON)
				    (WNN-const HINDO_INC))))
	(setq l (cdr l))))))

;;; XXX Need alternative implementation
;(defun wnn-set-conversion-mode ()
;  (jl-set-environment))

(defsubst wnn-dicinfo-entry (info) (aref info 0))
(defsubst wnn-dicinfo-id (info freq) (aref info (+ 1 freq)))
(defsubst wnn-dicinfo-mode (info freq) (aref info (+ 3 freq)))
(defsubst wnn-dicinfo-enable (info) (aref info 5))
(defsubst wnn-dicinfo-nice (info) (aref info 6))
(defsubst wnn-dicinfo-reverse (info) (aref info 7))
(defsubst wnn-dicinfo-comment (info) (aref info 8))
(defsubst wnn-dicinfo-name (info freq) (aref info (+ 9 freq)))
(defsubst wnn-dicinfo-passwd (info freq) (aref info (+ 11 freq)))
(defsubst wnn-dicinfo-type (info) (aref info 13))
(defsubst wnn-dicinfo-words (info) (aref info 14))
(defsubst wnn-dicinfo-local (info freq) (aref info (+ 15 freq)))

(defun wnn-save-dictionaries (env)
  (let ((dic-list (wnnrpc-get-dictionary-list-with-environment env))
	(result 0) info freq)
    (while (and dic-list
		(>= result 0))
      (setq info (car dic-list)
	    dic-list (cdr dic-list)
	    freq 0)
      (while (<= freq 1)
	(if (and (> (wnn-dicinfo-id info freq) 0)
		 (= (wnn-dicinfo-mode info freq) 0))
	    (if (= (wnn-dicinfo-local info freq) 1)
		(setq result (wnnrpc-write-file env
						(wnn-dicinfo-id info freq)
						(wnn-dicinfo-name info freq)))
	      (message "WNN: remote dictionary (%s) not supported yet"
		       (wnn-dicinfo-name info freq))
	      (ding)
	      (sit-for 1)))
	(if (< result 0)
	    (wnnrpc-disconnect env))
	(setq freq (1+ freq))))))

(defun wnn-version (proc)
  "Return version number string of WNN server."
  (format "%x" (wnnrpc-version proc)))

(defun wnn-dai-bunsetsu-p ()
  (jl-dai-top ))

(defun wnn-next-dai-bunsetsu-pos ()
  XXX)

;;; not implemented yet (NIY)
(defun wnn-delete-dictionary ()
  (dj-delete-dic XXX))

;;; NIY, might never be implemented
(defun wnn-server-inspect ())

;;; NIY
(defun wnn-list-dictionaries ()
  (jl-dic-list))

;;; NIY
(defun wnn-get-conversion-parameters ()
  (js-get-parameters))

;;; Dictionary management (word registration) is not implemented yet.

;; XXX: local file loaded into the server: Not supported yet
;(defun wnn-list-dictionaries (env)
;  (wnnrpc-get-dictionary-list-with-environment env))

(defun wnn-find-dictionary-by-id (id dic-list)
  (catch 'return
    (while dic-list
      (let ((dic (car dic-list)))
	(if (= (wnndic-get-id dic) id)
	    (throw 'return dic)
	  (setq dic-list (cdr dic-list)))))))

(defun wnn-dict-name (dic)
  (let ((name (wnndic-get-comment dic)))
    (if (string= name "")
	(file-name-nondirectory (wnndic-get-dictname dic))
      name)))

(defun wnn-list-writable-dictionaries-byname (env)
  (let ((dic-list (wnnrpc-get-dictionary-list-with-environment env))
	(w-id-list (wnnrpc-get-writable-dictionary-id-list env)))
    (mapcar (function (lambda (id)
			(let ((dic (wnn-find-dictionary-by-id id dic-list)))
			  (cons (wnn-dict-name dic) dic))))
	    w-id-list)))

(defun wnn-hinshi-list (env dic name)
  (let ((dic-number (wnndic-get-id dic)))
    (wnnrpc-get-hinshi-list env dic-number name)))

(defun wnn-hinshi-number (env hinshi-name)
  (wnnrpc-hinshi-number (wnnenv-get-proc env) hinshi-name))

(defun wnn-add-word (env dic yomi kanji comment hinshi-id initial-freq)
  (let ((dic-number (wnndic-get-id dic)))
    (wnnrpc-add-word env dic-number yomi kanji comment
		     hinshi-id initial-freq)))

;;; setup

(require 'egg)

;;;###autoload
(defun egg-activate-wnn (&rest arg)
  "Activate Wnn backend of Tamagotchy."
  (setq egg-conversion-backend wnn-conversion-backend)
  (if (not (fboundp 'wnnrpc-open))
      (load-library "egg/wnnrpc"))
  (apply 'egg-mode arg))

;;; egg/wnn.el ends here.