;; $Id: prime-engine-prime.el,v 1.2 2003/03/25 03:15:49 komatsu Exp $
(defcustom prime-engine-prime-default-use-p nil
  "nil 以外なら組み込んだ時点で prime エンジンを使用する")
(defcustom prime-engine-prime-command "prime"
  "prime のコマンドパス")
(defcustom prime-engine-prime-args-list
  '() "prime に与える引数")
;(defcustom prime-engine-prime-max-cands 100 "prime サーバが返す候補の数.")

(defconst prime-prime-buffer " *prime*")
(defconst prime-prime-process "prime-prime")

(defconst prime-engine-prime
  '((id . "prime")
    (name . "PRIME")
    (comment . "    予測入力システム PRIME")
    (init  . prime-prime-init)
;    (open  . prime-prime-open)
;    (close . prime-prime-close)
;    (exit  . prime-prime-exit)
    (get-cands . prime-prime-get-cands)
    (register-word . prime-prime-register-word)
;    (forget-phrase . prime-prime-delete-phrase)
    (status . prime-prime-status)
    ))

(defvar prime-engine-prime-pattern nil)
(defvar prime-engine-prime-cands nil)
(defvar prime-engine-prime-cands-alist nil)
;(defvar prime-engine-prime-current-num-of-cands 100)

;;;; Mell ------------------------------------------------------------

(defcustom mell-working-buffer-name " *mell-buffer*"
  "Working buffer for mell")
(defvar    mell-working-buffer nil)

(defun mell-string-append-to-file (string filename)
  (save-excursion
    (or (bufferp mell-working-buffer)
	(setq mell-working-buffer
	      (get-buffer-create mell-working-buffer-name)))
    (set-buffer mell-working-buffer)
    (erase-buffer)
    (insert string)
    (append-to-file (point-min) (point-max) (expand-file-name filename))
    ))

;;;; -----------------------------------------------------------------

(defun prime-prime-init (&optional forcep)
  (and (or forcep
	   (not (member (prime-prime-status) '(run error))))
       (or (prime-process-command-start
	    prime-prime-process prime-prime-buffer 
	    prime-engine-prime-command prime-engine-prime-args-list
	    'prime-prime-exit)
	   (prime-process-error prime-prime-process 
				"PRIME の初期化に失敗しました"))
;       (prime-prime-setdict "~/src/hitonami/data/latest.dict")
;       (prime-prime-setdict "/tmp/latest.dict")
       ))

(defun prime-prime-status ()
  (prime-process-status prime-prime-process)
  )

(defun prime-prime-send-command (command &optional function)
  (save-excursion
    (set-buffer prime-prime-buffer)
    (erase-buffer)
    (process-send-string prime-prime-process command)
    (catch 'process-loop
      (while (process-status prime-prime-process)
	(accept-process-output (get-process prime-prime-process) 1 0)
	(and (> (buffer-size) 0)
	     (progn (goto-char (1- (point-max))) (looking-at "^$"))
	     (if function (funcall function) t)
	     (throw 'process-loop nil))
	))
    (buffer-string)
    ))

(defun prime-prime-exit (&optional forcep) ; プロセスから切断 
  (condition-case nil
      (progn
;	(prime-prime-dict-save)
	(and (eq (process-status prime-prime-process) 'run)
	     (process-send-string prime-prime-process "close\n")))
    (error nil)
    ))

;(defun prime-prime-open (&optional forcep)
;  (prime-prime-send-command (format "reset_context\n"))
;  )

;(defun prime-prime-exit (&optional forcep)
;  (condition-case nil
;      (and (eq (process-status prime-prime-process) 'run)
;	   (prime-prime-send-command "close\n"))
;    (error nil)
;    ))

(defun prime-prime-register-word (word pattern &optional context)
  (let* ((word-data
	  (or (assoc word prime-engine-prime-cands-alist)
	      (list word (suikyo-convert-romaji-kana pattern))
	     ))
	 (annotation-alist
	  (prime-prime-parse-annotations (nthcdr 2 word-data)))
	 (key   (or (cdr (assoc "basekey" annotation-alist))
		    (nth 1 word-data)))
	 (value (or (cdr (assoc "base"    annotation-alist))
		    (nth 0 word-data)))
	 (part  (or (cdr (assoc "part"    annotation-alist)) ""))
	 (context (or context ""))
	 (suffix (or (cdr (assoc "conjugation" annotation-alist)) ""))
	 (rest   (or (cdr (assoc "suffix"      annotation-alist)) ""))
	 )
    (prime-prime-send-command
     (format "learn_word\t%s\t%s\t%s\t%s\t%s\t%s\n"
	     key value part context suffix rest))
;	     (nth 1 word-data) (nth 0 word-data) (or context ""))
       ))


(defun prime-prime-parse-annotations (annotation-list)
  (mapcar
   '(lambda (annotaion)
      (let ((pair (split-string annotaion "=")))
	(cons (car pair) (nth 1 pair))))
   annotation-list))

;  (let* ((word-data (prime-pogemo-have-word-p word pattern))
;	 (word (or (cdr (assoc "orig_value" (cdr word-data))) word))
;	 (yomigana  (or (cdr (assoc "orig_key" (cdr word-data)))
;			(cdr (assoc "key" (cdr word-data)))
;			(suikyo-convert-romaji-kana pattern))))
;    (prime-pogemo-send-command
;     (format "learn_word\t%s\t%s\n" yomigana word))
;    (and context
;	 (prime-pogemo-send-command 
;	  (format "learn_phrase\t%s\t%s\t%s\n" yomigana word context)))
;    ))
  
(defun prime-prime-get-cands (pattern &optional context)
  (setq prime-engine-prime-cands-alist
	(prime-prime-lookup pattern context prime-conv-exact-p))
  (setq prime-engine-prime-pattern pattern)
  (setq prime-engine-prime-cands
	(mapcar '(lambda (x) (car x)) prime-engine-prime-cands-alist))
  prime-engine-prime-cands)

;(defun prime-prime-set-max-cands (max-num)
;  (prime-prime-send-command (format "max_candidates\t%d\n" max-num)))

(defun prime-prime-parse-cands (cands-string)
  (mapcar
   '(lambda (str-line)
      (let ((tmp-list (split-string str-line "\t")))
	(cons (nth 1 tmp-list) 
	      (cons (car tmp-list)
		    (nthcdr 2 tmp-list)))
	))
   (cdr (delete "" (split-string cands-string "\n")))
   ))

(defun prime-prime-set-context (context)
  (prime-prime-send-command
   (if context
       (format "set_context\t%s\n" context)
     "reset_context\n"
     )))

(defun prime-prime-lookup (pattern &optional context exactp)
  (if (string= pattern "")
      nil
    (prime-prime-set-context context)
    (prime-prime-parse-cands
     (prime-prime-send-command
      (format (if exactp "lookup_exact\t%s\n" "lookup_hybrid\t%s\n")
	      pattern)))
    ))

(provide 'prime-engine-prime)
;(prime-append-engine 'prime-engine-prime
;		     (not prime-engine-prime-default-use-p))