;;; egg/sj3.el --- SJ3 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>
;; 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:

(defconst sj3-support-languages '("Japanese"))

(eval-when-compile
  (defmacro SJ3-const (c)
    (cond ((eq c 'FileNotExist) 35)
	  )))

(defconst sj3-conversion-backend
  [ sj3-init

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

    sj3-fini
 ])

(defvar sj3-server-port 3000 "Port number of SJ3 server")
(defvar sj3-stdy-size 0 "STDYSIZE of SJ3 server")
(defvar sj3-hostname "localhost"
  "Hostname of SJ3 server")

(defvar sj3-open-message)

(defun sj3-open (hostname)
  "Establish the connection to SJ3 server.  Return process object."
  (let* ((buf (generate-new-buffer " *SJ3*"))
	 (proc (open-network-stream "SJ3" buf hostname sj3-server-port))
	 result)
    (process-kill-without-query proc)
    (set-process-coding-system proc 'no-conversion 'no-conversion)
    (set-marker-insertion-type (process-mark proc) t)
    (save-excursion
      (set-buffer buf)
      (erase-buffer)
      (buffer-disable-undo)
      (set-buffer-multibyte nil))
    ;; Initialize dictionaries
    (setq sj3-sys-dict-list nil)
    (setq sj3-user-dict-list nil)
    (setq result (sj3rpc-open proc (system-name) (user-login-name)))
    (if (< result 0)
	(let ((msg (sj3rpc-get-error-message (- result))))
	  (delete-process proc)
	  (kill-buffer buf)
	  (error "Can't open SJ3 session (%s): %s" hostname msg)))
    (setq result (sj3rpc-get-stdy-size proc))
    (if (< result 0)
	(let ((msg (sj3rpc-get-error-message (- result))))
	  (delete-process proc)
	  (kill-buffer buf)
	  (error "Can't get SJ3 STDYSIZE: %s"msg)))
    (setq sj3-stdy-size result)
    proc))

;; (defun sj3-open (hostname-list)
;;   "Establish the connection to SJ3 server.  Return process object."
;;   (let* ((buf (generate-new-buffer " *SJ3*"))
;; 	 (msg-form "SJ3: connecting to sj3serv at %s...")
;; 	 hostname proc result msg)
;;     (save-excursion
;;       (set-buffer buf)
;;       (erase-buffer)
;;       (buffer-disable-undo)
;;       (setq enable-multibyte-characters 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 hostname)
;;       (sit-for 0)
;;       (condition-case result
;; 	  (setq proc (open-network-stream "SJ3" buf hostname sj3-server-port))
;; 	(error nil))
;;       (if proc
;; 	  (progn
;; 	    (process-kill-without-query proc)
;; 	    (set-process-coding-system proc 'no-conversion 'no-conversion)
;; 	    (set-marker-insertion-type (process-mark proc) t)
;; 	    ;; Initialize dictionaries
;; 	    (setq sj3-sys-dict-list nil)
;; 	    (setq sj3-user-dict-list nil)
;; 	    (setq result (sj3rpc-open proc (system-name) (user-login-name)))
;; 	    (if (< result 0)
;; 		(progn
;; 		  (delete-process proc)
;; 		  (setq proc nil
;; 			msg (format "Can't open SJ3 session (%s): %s"
;; 				    hostname msg)))
;; 	      (setq result (sj3rpc-get-stdy-size proc))
;; 	      (if (< result 0)
;; 		  (progn
;; 		    (delete-process proc)
;; 		    (setq proc nil
;; 			  msg (format "Can't get SJ3 STDYSIZE: %s"
;; 				      (sj3rpc-get-error-message (- result)))))
;; 		(setq sj3-stdy-size result))))))
;;     (if proc
;; 	(progn
;; 	  (setq sj3-open-message (format (concat msg-form "done") hostname))
;; 	  proc)
;;       (kill-buffer buf)
;;       (error "%s" (or msg "no sj3serv available")))))

;; <env> ::= [ <proc> <dictionary-list> ]
(defvar sj3-environment nil
  "Environment for SJ3 kana-kanji conversion")

(defsubst sj3env-get-proc (env)
  (aref env 0))
(defsubst sj3env-get-dictionary-list (env)
  (aref env 1))

;; <bunsetsu> ::=
;;  [ <env> <source> <converted> <rest>
;;    <stdy> <zenkouho> <zenkouho-pos> <kugiri-changed> ]
(defsubst sj3-make-bunsetsu (env source converted rest stdy)
  (vector env source converted rest stdy nil nil nil))

(defsubst sj3bunsetsu-get-env (b)
  (aref b 0))
(defsubst sj3bunsetsu-get-source (b)
  (aref b 1))
(defsubst sj3bunsetsu-get-converted (b)
  (aref b 2))
(defsubst sj3bunsetsu-get-rest (b)
  (aref b 3))
(defsubst sj3bunsetsu-get-stdy (b)
  (aref b 4))
(defsubst sj3bunsetsu-get-zenkouho (b)
  (aref b 5))
(defsubst sj3bunsetsu-set-zenkouho (b z)
  (aset b 5 z))
(defsubst sj3bunsetsu-get-zenkouho-pos (b)
  (aref b 6))
(defsubst sj3bunsetsu-set-zenkouho-pos (b p)
  (aset b 6 p))
(defsubst sj3bunsetsu-get-kugiri-changed (b)
  (aref b 7))
(defsubst sj3bunsetsu-set-kugiri-changed (b s)
  (aset b 7 s))

(defun sj3-get-bunsetsu-source (b)
  (sj3bunsetsu-get-source b))
(defun sj3-get-bunsetsu-converted (b)
  (concat (sj3bunsetsu-get-converted b)
	  (sj3bunsetsu-get-rest b)))
(defun sj3-get-bunsetsu-stdy (b)
  (sj3bunsetsu-get-stdy b))

(defvar sj3-dictionary-specification
  '(("study.dat")
    ["sj3main.dic" ""]
    [("private.dic") ""])
  "Dictionary specification of SJ3.")

(defvar sj3-usr-dic-dir (concat "user/" (user-login-name))
  "*Directory of user dictionary for SJ3.")

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

(defun sj3-get-environment ()
  "Return the backend of SJ3 environment."
  (if sj3-environment
      sj3-environment
    (let* ((proc (sj3-open sj3-hostname))
	   (freq-info-name (sj3-filename (car sj3-dictionary-specification)))
	   (l (cdr sj3-dictionary-specification))
	   dict-list)
      (sj3-open-freq-info proc freq-info-name)
      (while l
	(let ((dic (car l))
	      dic-id)
	  (setq dic-id
		(sj3-open-dictionary proc (sj3-filename (aref dic 0))
				     (aref dic 1)))
	  (if (< dic-id 0)
	      (error "Dame2")		; XXX
	    (setq dict-list (cons dic-id dict-list)
		  l (cdr l)))))
      (setq sj3-environment (vector proc dict-list)))))

(defun sj3-open-freq-info (proc name)
  (let ((trying t)
	ret)
    (while trying
      (setq ret (sj3rpc-open-stdy proc name))
      (if (= ret 0)
	  (setq trying nil)
	(message "学習ファイル(%s)がありません" name)
	(if (/= ret (SJ3-const FileNotExist))
	    (error "Fatal1")		; XXX
	  (if (and (y-or-n-p
		    (format "学習ファイル(%s)がありません。作りますか? "
			    name))
		   (sj3rpc-make-directory proc
					  (file-name-directory name))
		   ;; ignore error
		   (= (sj3rpc-make-stdy proc name) 0))
	      (message "学習ファイル(%s)を作りました" name)
	    (error "Fatal2")))))))	; XXX

(defun sj3-open-dictionary (proc name passwd)
  (let ((trying t)
	ret)
    (while trying
      (setq ret (sj3rpc-open-dictionary proc name passwd))
      (if (>= ret 0)
	  (setq trying nil)
	(message "辞書ファイル(%s)がありません" name)
	(setq ret (- ret))		; Get error code.
	(if (/= ret (SJ3-const FileNotExist))
	    (error "Fatal3 %d" ret)		; XXX
	  (if (and (y-or-n-p
		    (format "辞書ファイル(%s)がありません。作りますか? "
			    name))
		   (= (sj3rpc-make-dictionary proc name) 0))
	      (message "辞書ファイル(%s)を作りました" name)
	    (error "Fatal4")))))	; XXX
    ret))

(defun sj3-init ()
  )

(defun sj3-start-conversion (yomi &optional lang)
  "Convert YOMI string to kanji, and enter conversion mode.
Return the list of bunsetsu."
  (let ((env (sj3-get-environment)))
    (sj3rpc-begin env yomi)))

(defun sj3-end-conversion (bunsetsu-list abort)
  (if abort
      ()
    (let ((env (sj3bunsetsu-get-env (car bunsetsu-list)))
	  (l bunsetsu-list)
	  bunsetsu stdy kugiri-changed)
      (while l
	(setq bunsetsu (car l))
	(setq l (cdr l))
	(setq stdy (sj3bunsetsu-get-stdy bunsetsu))
	(if stdy
	    (sj3rpc-bunsetsu-stdy env stdy))
	(if (setq kugiri-changed (sj3bunsetsu-get-kugiri-changed bunsetsu))
	    (let ((yomi1 (sj3bunsetsu-get-source bunsetsu))
		  (yomi2 (sj3bunsetsu-get-source (car l))))
	      (if (/= kugiri-changed (length yomi1))
		  (sj3rpc-kugiri-stdy env yomi1 yomi2
				      (sj3bunsetsu-get-stdy (car l))))))))))

(defun sj3-list-candidates (bunsetsu prev-bunsetsu)
  (let* ((env (sj3bunsetsu-get-env bunsetsu))
	 (yomi (sj3bunsetsu-get-source bunsetsu))
	 (z (sj3rpc-get-bunsetsu-candidates env yomi)))
    (sj3bunsetsu-set-zenkouho bunsetsu z)
    (sj3bunsetsu-set-zenkouho-pos bunsetsu 0)
    0))

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

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

(defun sj3-get-current-candidate-number (bunsetsu)
  (sj3bunsetsu-get-zenkouho-pos bunsetsu))

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

(defun sj3-change-bunsetsu-length (b0 b1 b2 len)
  (let ((yomi (concat
	       (sj3bunsetsu-get-source b1)
	       (if b2 (sj3bunsetsu-get-source b2))))
	(env (sj3bunsetsu-get-env b1))
	yomi1 yomi2
	bunsetsu1 bunsetsu2)
    (setq yomi1 (substring yomi 0 len)
	  yomi2 (substring yomi len))
    (setq bunsetsu1
	  (sj3rpc-tanbunsetsu-conversion env yomi1))
    ;; Only set once (memory original length of the bunsetsu).
    (sj3bunsetsu-set-kugiri-changed bunsetsu1
				    (or (sj3bunsetsu-get-kugiri-changed b1)
					(length (sj3bunsetsu-get-source b1))))
    (if (< 0 (length yomi2))
	(setq bunsetsu2 (sj3rpc-tanbunsetsu-conversion env yomi2))
      (setq bunsetsu2 nil))
    (if bunsetsu2
	(list bunsetsu1 bunsetsu2)
      (list bunsetsu1))))

(defun sj3-fini (lang)
  (let ((proc (sj3env-get-proc sj3-environment))
	(dict-list (sj3env-get-dictionary-list sj3-environment))
	dict)
    (while dict-list
      (setq dict (car dict-list))
      (setq dict-list (cdr dict-list))
      (sj3rpc-close-dictionary proc dict)) ; XXX: check error
    (sj3rpc-close-stdy proc)
    (sj3rpc-close proc))
  (setq sj3-environment nil))

;;; setup

(require 'egg)
(load "egg/sj3rpc")

;;;###autoload
(defun egg-activate-sj3 (&rest arg)
  "Activate SJ3 backend of Tamagotchy."
  (egg-set-support-languages sj3-support-languages)
  (egg-set-conversion-backend sj3-conversion-backend 
			      sj3-support-languages)
  (apply 'egg-mode arg))

;;; egg/sj3.el ends here.