;;;
;;; Copyright (c) 2003,2004 uim Project http://uim.freedesktop.org/
;;;
;;; All rights reserved.
;;;
;;; Redistribution and use in source and binary forms, with or without
;;; modification, are permitted provided that the following conditions
;;; are met:
;;; 1. Redistributions of source code must retain the above copyright
;;;    notice, this list of conditions and the following disclaimer.
;;; 2. Redistributions in binary form must reproduce the above copyright
;;;    notice, this list of conditions and the following disclaimer in the
;;;    documentation and/or other materials provided with the distribution.
;;; 3. Neither the name of authors nor the names of its contributors
;;;    may be used to endorse or promote products derived from this software
;;;    without specific prior written permission.
;;;
;;; THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
;;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
;;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
;;; ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
;;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
;;; OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
;;; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
;;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
;;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
;;; SUCH DAMAGE.
;;;;

;;TODO
;;    ::単語登録
;;
;;モード一覧
;;  日本語入力モード(カタカナ日本語入力モードも必要？)
;;  英数モード
;;  全角英数モード
;;  
;;ステート一覧
;;  *日本語入力モード
;;    待機状態,入力状態,変換状態
;;  *単語登録モード
;;    読み入力状態,単語入力状態
;;

(require "japanese.scm")
(require "generic-key.scm")
(require "util.scm")

;; configs
(define prime-nr-candidate-max 10)
(define prime-always-show-window? #t)
(define prime-preedit-immediate-commit? #f)
(define prime-mask-pending-preedit? #f)

;; config function
(define prime-dont-use-numeral-key-to-select-cand
  (lambda ()
    (set! prime-cand-select-key?
	  (lambda (key key-state)
	    (and (numeral-char? key)
		 (control-key-mask key-state))))))

;; key
(define-key prime-latin-key? '("<Control>l" generic-off-key?))
(define-key prime-wide-latin-key?  "<Control>L")
(define-key prime-begin-conv-key? 'generic-begin-conv-key?)
(define-key prime-on-key? '("<Control>j" "<Control>J" generic-on-key?))
(define-key prime-commit-key? 'generic-commit-key?)
(define-key prime-next-candidate-key? 'generic-next-candidate-key?)
(define-key prime-prev-candidate-key? 'generic-prev-candidate-key?)
(define-key prime-next-page-key? 'generic-next-page-key?)
(define-key prime-prev-page-key? 'generic-prev-page-key?)
(define-key prime-cancel-key? 'generic-cancel-key?)
(define-key prime-backspace-key? 'generic-backspace-key?)
(define-key prime-delete-key? 'generic-delete-key?)
(define-key prime-go-left-key? 'generic-go-left-key?)
(define-key prime-go-right-key? 'generic-go-right-key?)
(define prime-cand-select-key?
  (lambda (key key-state)
    (numeral-char? key)))

;; access
(define prime-context-raw-commit
 (lambda (ac)
   (car (nthcdr 15 ac))))
(define prime-context-set-raw-commit!
  (lambda (ac mode)
    (set-car! (nthcdr 15 ac) mode)))
(define prime-context-immediate-commit ;;一時的にprime-preedit-immediate-commit?をオフにするかどうか
 (lambda (ac)
   (car (nthcdr 14 ac))))
(define prime-context-set-immediate-commit!
  (lambda (ac mode)
    (set-car! (nthcdr 14 ac) mode)))
(define prime-context-last-word ;;PRIMEやPOBoxの用語でいうContext
 (lambda (ac)
   (car (nthcdr 13 ac))))
(define prime-context-set-last-word!
  (lambda (ac mode)
    (set-car! (nthcdr 13 ac) mode)))
(define prime-context-mode
 (lambda (ac)
   (car (nthcdr 12 ac))))
(define prime-context-set-mode!
  (lambda (ac mode)
    (set-car! (nthcdr 12 ac) mode)))
(define prime-context-left-string ;;カーソルの左側にあるpreedit文字列のリスト
 (lambda (ac)
   (car (nthcdr 11 ac))))
(define prime-context-set-left-string!
  (lambda (ac str)
    (set-car! (nthcdr 11 ac) str)))
(define prime-context-right-string
 (lambda (ac)
   (car (nthcdr 10 ac))))
(define prime-context-set-right-string!
  (lambda (ac str)
    (set-car! (nthcdr 10 ac) str)))
(define prime-context-candidates
  (lambda (c)
   (car (nthcdr 9 c))))
(define prime-context-set-candidates!
  (lambda (c cnt)
    (set-car! (nthcdr 9 c) cnt)))
(define prime-context-candidate-window
  (lambda (c)
   (car (nthcdr 8 c))))
(define prime-context-set-candidate-window!
  (lambda (c cnt)
    (set-car! (nthcdr 8 c) cnt)))
(define prime-context-rk-context
  (lambda (c)
   (car (nthcdr 7 c))))
(define prime-context-set-rk-context!
  (lambda (c rkc)
    (set-car! (nthcdr 7 c) rkc)))
(define prime-context-nth
  (lambda (c)
    (car (nthcdr 6 c))))
(define prime-context-set-nth!
  (lambda (c nth)
    (set-car! (nthcdr 6 c) nth)))
(define prime-context-right-right-strings
  (lambda (c)
    (car (nthcdr 4 c))))
(define prime-context-set-right-right-strings!
  (lambda (c right-right)
    (set-car! (nthcdr 4 c) right-right)))
(define prime-context-left-left-strings
  (lambda (c)
    (car (nthcdr 3 c))))
(define prime-context-set-left-left-strings!
  (lambda (c left-left)
    (set-car! (nthcdr 3 c) left-left)))
(define prime-context-set-learning-word!
  (lambda (c head)
    (set-car! (nthcdr 2 c) head)))
(define prime-context-learning-word
  (lambda (c)
    (car (nthcdr 2 c))))
(define prime-context-state
  (lambda (c)
    (car (nthcdr 0 c))))
(define prime-context-set-state!
  (lambda (c s)
    (set-car! (nthcdr 0 c) s)))

(define prime-mode-latin 0)
(define prime-mode-wide-latin 1)
(define prime-mode-hiragana 2)

(define prime-send-command
  (lambda (command)
    (let ((result (prime-lib-send-command command)))
      (let loop ((res result))
	(if (string=? res "")
	    (loop (prime-lib-send-command ""))
	    res
	    )))))

(define prime-flush
  (lambda (sc)
    (rk-flush (prime-context-rk-context sc))
    (prime-context-set-state! sc 'prime-state-no-preedit)
    (prime-context-set-immediate-commit! sc #t)
    (prime-context-set-left-string! sc '())
    (prime-context-set-right-string! sc '())
    (prime-context-set-left-left-strings! sc '())
    (prime-context-set-right-right-strings! sc '())
    (prime-context-set-nth! sc 0)
    (prime-context-set-candidate-window! sc #f)))


(define prime-context-new
  (lambda ()
    (let ((c 
	   (copy-list 
	    '(prime-state-no-latin #t () () () () 0 () () () () () 0 "" #t #f))))
      (prime-context-set-rk-context! c
				   (rk-context-new ja-rk-rule #t #f))
      (prime-flush c)
      c)))

(define prime-get-nth-candidate
  (lambda (sc n)
    (if (> n (prime-get-nr-candidates sc))
	#f
	(car (cdr (car (nthcdr n (prime-context-candidates sc))))))))

(define prime-get-nr-candidates
  (lambda (sc)
    (length (prime-context-candidates sc))))

(define prime-get-current-candidate
  (lambda (sc)
    (prime-get-nth-candidate
     sc
     (prime-context-nth sc))))

(define prime-get-candidates! ;;もうちょっと関数名をどうにかしたい
  (lambda (sc preedit context)
    (if (not (string=? context ""))
	(prime-engine-set-context context))
    (prime-context-set-candidates!
     sc
     (prime-parse-cands
      (prime-send-command (string-append "lookup_compact\t" preedit "\n"))))
    ))

(define prime-get-all-candidates! ;;これももうちょっと関数名をどうにかしたい
  (lambda (sc preedit context)
    (if (not (string=? context ""))
	(prime-engine-set-context context))
    (prime-context-set-candidates!
     sc
     (prime-parse-cands
      (prime-send-command
       (string-append "lookup_compact_all\t" preedit "\n"))))
    ))



(define prime-get-label
  (lambda (sc key)
    (string-append
     (string-list-concat (prime-context-left-string sc))
     (charcode->string key))))

;;;; By Hiroyuki Komatsu
(define prime-engine-set-context
  (lambda (string)
    (prime-send-command (string-append "set_context\t" string "\n"))))

;;;; By Hiroyuki Komatsu
(define prime-engine-reset-context
  (lambda ()
    (prime-send-command "reset_context\n")))

;;;; By Hiroyuki Komatsu
(define prime-engine-get-label
  (lambda (string)
    (if (string=? string "")
	""
	(let ((label (prime-send-command (string-append "get_label\t" string "\n"))))
	  (nth 1 (string-split label "\n"))))))

;;;; By Hiroyuki Komatsu
(define prime-engine-learn-word
  (lambda (pron literal pos context suffix rest)
    (prime-send-command
     (string-append "learn_word\t" pron "\t" literal "\t" pos "\t"
		    context "\t" suffix "\t" rest "\n"))))

;;;; By Hiroyuki Komatsu
(define prime-command-preedit-commit
  (lambda (context key key-state)
    (let ((sc (context-data context))
	  (id (context-id   context)))
      (if (prime-context-learning-word sc)
	  (prime-commit-to-left-left sc (append
					 (prime-context-right-string sc)
					 (prime-context-left-string sc)))
	  (let ((word-committed (prime-preedit-get-string-label sc)))
	    (im-commit id word-committed)
	    (prime-learn-word sc (list (list "basekey" word-committed)
				       (list "base"    word-committed)))
	    (prime-flush sc)
	    (prime-update-mode id sc))))))

;;;; By Hiroyuki Komatsu
(define prime-preedit-get-string-label
  (lambda (sc)
    (prime-engine-get-label
     (prime-preedit-get-string-raw sc))))

;;;; By Hiroyuki Komatsu
(define prime-preedit-get-string-raw
  (lambda (sc)
    (string-append (string-list-concat (prime-context-left-string sc))
		   (string-list-concat (prime-context-right-string sc)))))

(define prime-make-assoc-list
  (lambda (lst)
    (mapcar 
     (lambda (str)
       (string-split str "="))
     lst)))

(define prime-commit-raw
  (lambda (sc id)
    (im-commit-raw id)
    (prime-engine-reset-context)
    (prime-context-set-last-word! sc "")
    (prime-context-set-raw-commit! sc #t)))

(define prime-commit-candidate
  (lambda (sc)
    (let* ((nth (prime-context-nth sc))
	   (assoc-list (prime-make-assoc-list 
			(cdr (cdar (nthcdr nth (prime-context-candidates sc)))))))
      (prime-learn-word sc assoc-list))))

(define prime-learn-word
  (lambda (sc assoc-list)
    (let ((key     (or (cadr (assoc "basekey"     assoc-list)) ""))
	  (value   (or (cadr (assoc "base"        assoc-list)) ""))
	  (part    (or (cadr (assoc "part"        assoc-list)) ""))
	  (context (or (prime-context-last-word sc) ""))
	  (suffix  (or (cadr (assoc "conjugation" assoc-list)) ""))
	  (rest    (or (cadr (assoc "suffix"      assoc-list)) "")))
      
      (prime-engine-learn-word key value part context suffix rest)
      (prime-context-set-last-word! sc (string-append value suffix rest)))))
;				    (prime-get-current-candidate sc)))))

(define prime-parse-cands
  (lambda (cands-string)
    (mapcar
     (lambda (str-line)
       (string-split str-line "\t"))
     (cdr (delq "" (string-split cands-string "\n"))))))

(define prime-begin-conversion-internal
  (lambda (sc id init-idx)
    (let ((res)
	  (rkc (prime-context-rk-context sc)))
      (prime-get-all-candidates!
       sc
       (string-append (string-list-concat (prime-context-left-string sc))
		      (string-list-concat (prime-context-right-string sc)))
       (rk-pending rkc))
      (prime-context-last-word sc)
      (set! res
	    (prime-get-nth-candidate sc init-idx))
      (if res
	  (begin
	    (prime-context-set-nth! sc init-idx)
	    (prime-context-set-state!
	     sc 'prime-state-converting))
	  (prime-flush sc))
      )))

(define prime-begin-conversion-reversely
  (lambda (sc id)
    (let ((last-idx (- (prime-get-nr-candidates sc)
		       1)))
      (prime-begin-conversion-internal sc id last-idx))))

(define prime-begin-conversion
  (lambda (sc id)
    (prime-begin-conversion-internal sc id 0)))

(define prime-update-preedit
  (lambda (id sc)
    (if (not (prime-context-raw-commit sc))
	(let ((rkc (prime-context-rk-context sc))
	      (stat (prime-context-state sc))
	      (learning-word (prime-context-learning-word sc))
	      (left (prime-context-left-string sc))
	      (right (prime-context-right-string sc))
	      (left-left (prime-context-left-left-strings sc))
	      (right-right (prime-context-right-right-strings sc)))
	  
	  (if (and
	       prime-mask-pending-preedit?
	       left
	       (usual-char? (string->charcode (car left))))
	      (set! left (append (list "*") (cdr left))))
	  
	  (im-clear-preedit id)
	  (if learning-word
	      (begin
		(im-pushback-preedit
		 id preedit-reverse
		 (string-append "[" (string-list-concat learning-word) "|"))))
	  (if left-left
	      (begin
		(im-pushback-preedit
		 id preedit-none
		 (string-list-concat left-left))))
	  (if (= stat 'prime-state-converting)
	      (begin
		(im-pushback-preedit
		 id preedit-reverse
		 (prime-get-current-candidate sc)))
	      (if (prime-has-preedit? sc)
		  (let ((hl (prime-engine-get-label (string-list-concat left)))
			(hr (string-list-concat right)))
		    (if (string? hl)
			(im-pushback-preedit
			 id preedit-underline
			 hl))
		    (im-pushback-preedit id preedit-underline
					 (rk-pending rkc))
		    (im-pushback-preedit id preedit-cursor "")
		    (if (string? hr)
			(im-pushback-preedit
			 id preedit-underline
			 hr)))
		  (im-pushback-preedit id preedit-cursor "")))
	  
	  (if right-right
	      (im-pushback-preedit
	       id preedit-none
	       (string-list-concat right-right)))
	  (if learning-word
	      (im-pushback-preedit
	       id preedit-reverse "]"))
	  (im-update-preedit id))
	(prime-context-set-raw-commit! sc #f))))

(define prime-update-mode
  (lambda (id sc)
    (let ((mode (prime-context-mode sc)))
      (im-update-mode id mode)
      (prime-update-prop-label id sc))))

(define prime-update-candidate-window
  (lambda (sc id)
    (let* ((rkc (prime-context-rk-context sc))
	   (nth (prime-context-nth sc))
	   (preedit (string-append (string-list-concat (prime-context-left-string sc))
				   (string-list-concat (prime-context-right-string sc))))
	   (stat (prime-context-state sc)))
      (cond
       ((> nth 0)
	(im-select-candidate id nth))
       ((and (= nth 0)
	     (= stat 'prime-state-converting))
	(prime-get-all-candidates!
	 sc
	 preedit
	 (prime-context-last-word sc))
	(im-activate-candidate-selector
	 id (prime-get-nr-candidates sc) prime-nr-candidate-max)
	(im-select-candidate id nth))
       ((and
	 (prime-has-preedit? sc)
	 (not (prime-context-candidate-window sc))
	 (or (not (prime-context-immediate-commit sc))
	     (not prime-preedit-immediate-commit?)))
	(begin
	  (prime-get-candidates!
	   sc
	   preedit
	   (prime-context-last-word sc))
	  
	  (if (> (prime-get-nr-candidates sc) 0)
	      (begin
		(im-activate-candidate-selector
		 id (prime-get-nr-candidates sc) prime-nr-candidate-max)
		(prime-context-set-candidate-window! sc #t))
	      (begin
		(prime-context-set-candidate-window! sc #f)
		(im-deactivate-candidate-selector id)))))
       ((not (prime-has-preedit? sc))
	(begin
	  (prime-context-set-candidate-window! sc #f)
	  (im-deactivate-candidate-selector id)))))))

(define prime-has-preedit?
  (lambda (sc)
    (or
     (> (length (prime-context-left-string sc)) 0)
     (> (length (prime-context-right-string sc)) 0)
     (> (length (rk-pending (prime-context-rk-context sc))) 0))))

(define prime-word-learning-start!
  (lambda (sc)
    (prime-context-set-learning-word!
     sc
     (append
     (prime-context-right-string sc)
     (prime-context-left-string sc)))
     (prime-context-set-right-string! sc '())
     (prime-context-set-left-string! sc '())
     (prime-context-set-nth! sc 0)
     (prime-context-set-state! sc 'prime-state-no-preedit)
     ))

(define prime-commit-to-left-left
  (lambda (sc lst)
    (prime-context-set-left-left-strings!
     sc (append lst (prime-context-left-left-strings sc)))
    (prime-context-set-right-string! sc '())
    (prime-context-set-left-string! sc '())
    (prime-context-set-nth! sc 0)
    (prime-context-set-state! sc 'prime-state-no-preedit)
    ))

(define prime-proc-input-no-preedit
  (lambda (c key key-state)
    (let* ((sc (context-data c))
	   (id (context-id c))
	   (key-str (charcode->string (to-lower-char key)))
	   (rkc (prime-context-rk-context sc))
	   (res #f)
	   (direct (ja-direct (charcode->string key)))
	   (learning-word (prime-context-learning-word sc))
	   (registered (string-append (string-list-concat (prime-context-left-left-strings sc))
				(string-list-concat (prime-context-right-right-strings sc)))))
      (cond
       ((prime-wide-latin-key? key key-state)
	(begin
	  (prime-context-set-mode! sc prime-mode-wide-latin)
	  (prime-update-mode id sc)))
       
       ((prime-latin-key? key key-state)
	(begin
	  (prime-context-set-mode! sc prime-mode-latin)
	  (prime-update-mode id sc)))
              
       ((prime-backspace-key? key key-state)
	(if (not (rk-backspace rkc))
	    (if (prime-context-left-left-strings sc)
		(prime-context-set-left-left-strings!
		 sc (cdr (prime-context-left-left-strings sc)))
		(prime-commit-raw sc id))))

       ((prime-delete-key? key key-state)
	(if (not (rk-delete rkc))
	    (if (prime-context-right-right-strings sc)
		(prime-context-set-right-right-strings!
		 sc (cdr (prime-context-right-right-strings sc)))
		(prime-commit-raw sc id))))

       ((prime-cancel-key? key key-state)
	(if learning-word
	    (begin
	      (prime-context-set-left-string!
	       sc (prime-context-learning-word sc))
	      (prime-context-set-learning-word! sc '())
	      (prime-context-set-left-left-strings! sc '())
	      (prime-context-set-right-right-strings! sc '()))))
       
       ((prime-commit-key? key key-state)
	(if (and learning-word
		 (not (string=? registered "")))
	    (begin
	      (prime-send-command
	       (string-append "learn_word\t" (string-list-concat learning-word) "\t" registered "\n"))
	      (im-commit id registered)
	      (prime-flush sc)
	      (prime-context-set-learning-word! sc '()))
	    (prime-commit-raw sc id)))
	
       ((and (shift-key-mask key-state)
	     (alphabet-char? key))
	(begin
	  (prime-context-set-immediate-commit! sc #f)
	  (prime-proc-input-with-preedit c key key-state)))

       ((prime-cand-select-key? key key-state)
	(begin
	  (prime-context-set-immediate-commit! sc #f)
	  (prime-proc-input-with-preedit c key key-state)))

       ((prime-go-left-key? key key-state)
	(begin
	  (if (prime-context-left-left-strings sc)
	      (let ((c (car (prime-context-left-left-strings sc))))
		(prime-context-set-left-left-strings!
		 sc (cdr (prime-context-left-left-strings sc)))
		(prime-context-set-right-right-strings!
		 sc
		 (append (prime-context-right-right-strings sc) (list c))))
	      (prime-commit-raw sc id))))
 
       ;; right
       ((prime-go-right-key? key key-state)
	(begin
	  (if (prime-context-right-right-strings sc)
	      (let ((c (car (reverse (prime-context-right-right-strings sc)))))
		(prime-context-set-right-right-strings!
		 sc (reverse (cdr (reverse (prime-context-right-right-strings sc)))))
		(prime-context-set-left-left-strings!
		 sc
		 (append (list c) (prime-context-left-left-strings sc))))
	      (prime-commit-raw sc id))))

       ((control-key-mask key-state)
	(prime-commit-raw sc id))
       
       ;; direct key => commit
       ((and direct
	     (not learning-word))
	(begin
	  (im-commit id direct)))
       

       ((symbol? key)
	(if learning-word
	    ()
	    (begin
	      (prime-context-set-last-word! sc "")
	      (prime-commit-raw sc id)
	      (prime-flush sc))))

       (else
	(begin
	  (prime-proc-input-with-preedit c key key-state)))))))


(define prime-proc-input-with-preedit
  (lambda (c key key-state)
    (let* ((sc (context-data c))
	   (id (context-id c))
	   (learning-word (prime-context-learning-word sc)))
      (cond
       ((or (prime-next-candidate-key? key key-state)
	    (prime-begin-conv-key? key key-state))
	(prime-begin-conversion sc id))

       ((prime-prev-candidate-key? key key-state)
	(prime-begin-conversion-reversely sc id))

       ((prime-cancel-key? key key-state)
	())
       
       ((prime-backspace-key? key key-state)
	(begin
	  (if (prime-context-left-string sc)
	      (prime-context-set-left-string!
	       sc (cdr (prime-context-left-string sc))))
	  (prime-context-set-candidate-window! sc #f) ;FIXME:very dirty hack
	  ))
       ;; delete
       ((prime-delete-key? key key-state)
	(begin
	  (if (prime-context-right-string sc)
	      (prime-context-set-right-string!
	       sc
	       (reverse
		(cdr (reverse (prime-context-right-string sc))))))
	  (prime-context-set-candidate-window! sc #f) ;FIXME:very dirty hack
	  )) 

       ;; commit
       ((prime-commit-key? key key-state)
	(prime-command-preedit-commit c key key-state))

       ;; left
       ((prime-go-left-key? key key-state)
	(begin
	  (if (prime-context-left-string sc)
	      (let ((c (car (prime-context-left-string sc))))
		(prime-context-set-left-string!
		 sc (cdr (prime-context-left-string sc)))
		(prime-context-set-right-string! 
		 sc
		 (append (prime-context-right-string sc) (list c)))))))
       
       ;; right
       ((prime-go-right-key? key key-state)
	(begin
	  (if (prime-context-right-string sc)
	      (let ((c (car (reverse (prime-context-right-string sc)))))
		(prime-context-set-right-string!
		 sc (reverse (cdr (reverse (prime-context-right-string sc)))))
		(prime-context-set-left-string!
		 sc
		 (append (list c) (prime-context-left-string sc)))))))
		
       ((and (prime-cand-select-key? key key-state)
	     (prime-context-immediate-commit sc))
	(let* ((nth (number->candidate-index (numeral-char->number key)))
	       (cand (prime-get-nth-candidate sc nth)))
	  (if cand
	      (if learning-word
		  (begin
		    (prime-context-set-nth! sc nth)
		    (prime-commit-to-left-left sc (string-to-list cand)))
		  (begin
		    (prime-context-set-nth! sc nth)
		    (im-commit id cand)
		    (prime-commit-candidate sc)
		    (prime-flush sc)
		    (prime-update-mode id sc))))))

       ;; modifiers (excepts shift) => ignore
       ((and
	 (modifier-key-mask key-state)
	 (not (shift-key-mask key-state)))
	(prime-commit-raw sc id))

       (else
	(begin
	  (prime-context-set-left-string!
	   sc
	   (string-to-list
	    (prime-get-label sc key)))
	  (prime-context-set-candidate-window! sc #f) ;FIXME:very dirty hack
	  (if (and
	       prime-preedit-immediate-commit?
	       (prime-context-immediate-commit sc))
	      (begin
		(im-commit id (string-list-concat (prime-context-left-string sc)))
		(prime-flush sc)))))
       ))))

(define prime-proc-state-converting
  (lambda (c key key-state)
    (let* ((sc (context-data c))
	  (id (context-id c))
	  (res ())
	  (learning-word (prime-context-learning-word sc)))
      (cond
       ((prime-next-candidate-key? key key-state)
	(begin
	  (prime-context-set-nth! sc
				  (+ 1 (prime-context-nth sc)))
	  (if (prime-get-current-candidate sc)
	      #f
	      (if learning-word
		  (prime-context-set-nth! sc 0)
		  (prime-word-learning-start! sc)))))

       ((prime-prev-candidate-key? key key-state)
	(begin
	  (if (> (prime-context-nth sc) 0)
	      (prime-context-set-nth! sc (- (prime-context-nth sc) 1))
	      (prime-context-set-nth! sc (- (prime-get-nr-candidates sc) 1)))))

       ((or (prime-cancel-key? key key-state)
	    (prime-backspace-key? key key-state))
	(begin
	  (prime-context-set-state! sc 'prime-state-preedit)
	  (prime-context-set-nth! sc 0)
	  (prime-context-set-candidate-window! sc #f)))
       
       ((prime-commit-key? key key-state)
	(if learning-word
	    (prime-commit-to-left-left sc (string-to-list (prime-get-nth-candidate sc (prime-context-nth sc))))
	    (begin
	      (im-commit id (prime-get-current-candidate sc))
	      (prime-commit-candidate sc)
	      (prime-flush sc)
	      (prime-update-mode id sc))))

       ((prime-cand-select-key? key key-state)
	(let* ((nth (number->candidate-index (numeral-char->number key)))
	       (cand (prime-get-nth-candidate sc nth)))
	  (if cand
	      (if learning-word
		  (begin
		    (prime-context-set-nth! sc nth)
		    (prime-commit-to-left-left sc (string-to-list cand)))
		  (begin
		    (prime-context-set-nth! sc nth)
		    (im-commit id cand)
		    (prime-commit-candidate sc)
		    (prime-flush sc)
		    (prime-update-mode id sc))))))

       ((symbol? key)
	())

       (else
	(begin
	  (if learning-word
	      (begin
		(prime-commit-to-left-left sc (append
					       (prime-context-right-string sc)
					       (prime-context-left-string sc)))
		(prime-proc-input-no-preedit c key key-state))
	      (begin
		(prime-update-mode id sc)
		(im-commit id (prime-get-current-candidate sc))
		(prime-commit-candidate sc)
		(prime-flush sc)
		(prime-proc-input-no-preedit c key key-state)))
      ))))))


(define prime-proc-mode-latin
  (lambda (c key key-state)
    (let ((sc (context-data c))
	  (id (context-id c)))
      (if (prime-on-key? key key-state)
	  (begin
	    (prime-context-set-mode! sc prime-mode-hiragana)
	    (prime-update-mode id sc))
	  (prime-commit-raw sc id)))))

(define prime-proc-mode-wide-latin
  (lambda (c key key-state)
    (let* ((char (charcode->string key))
	   (w (or (ja-direct char)
		  (ja-wide char)))
	   (id (context-id c))
	   (sc (context-data c)))
      (if (prime-on-key? key key-state)
	  (begin
	    (prime-flush sc)
	    (prime-context-set-mode! sc prime-mode-hiragana)
	    (prime-update-mode id sc))
	  (if w
	      (im-commit id w)
	      (prime-commit-raw sc id))))))

(define prime-push-key
  (lambda (c key key-state)
    (let* ((sc (context-data c))
	   (state (prime-context-state sc))
	   (mode (prime-context-mode sc))
	   (fun)
	   (res))
      (cond
       ((= mode prime-mode-latin)
	(set! fun prime-proc-mode-latin))
       ((= mode prime-mode-wide-latin)
	(set! fun prime-proc-mode-wide-latin))
      ;((or (= mode 1) (= mode 2))  ;; what's intented? -- YamaKen
      ((= mode prime-mode-hiragana)
       (begin
	 (if (prime-has-preedit? sc)
	     (set! fun prime-proc-input-with-preedit)
	     (set! fun prime-proc-input-no-preedit))
	 (if (= state 'prime-state-converting)
	     (set! fun prime-proc-state-converting)))))
      (fun c key key-state)
      (prime-update-candidate-window sc (context-id c))
      (prime-update-preedit (context-id c) sc)
      )))

(define prime-init-handler
  (lambda (id arg)
    (let* ((c (find-context id)))
      (set! candidate-window-position "left")
      (set-context-data! c
			 (prime-context-new))
      (im-clear-mode-list id)
      (im-pushback-mode-list id "直接入力")
      (im-pushback-mode-list id "ひらがな")
      (im-pushback-mode-list id "全角英数")
      (im-update-mode-list id)
      (im-update-mode id prime-mode-latin)

      (prime-update-prop-list id))))

(define prime-press-key-handler
  (lambda (id key state)
    (let* ((c (find-context id)))
      (if (control-char? key)
	  (im-commit-raw id)
	  (prime-push-key c key state)))))

(define prime-release-key-handler
  (lambda (id key state)
    (let* ((c (find-context id))
	   (sc (context-data c)))
      (if (or (control-char? key)
	      (= (prime-context-mode sc)
		 prime-mode-latin))
	  (im-commit-raw id)))))

(define prime-reset-handler
  (lambda (id)
    ()))

(define prime-mode-handler
  (lambda (id mode)
    (let* ((c (find-context id))
	   (sc (context-data c)))
      (prime-flush sc)
      (prime-context-set-mode! sc mode)
      (prime-update-preedit id sc)
      ())))

(define prime-get-candidate-handler
  (lambda (id idx accel-enum-hint)
    (let* ((c (find-context id))
	   (sc (context-data c)))
      (list (prime-get-nth-candidate sc idx) (digit->string (+ idx 1))))))

(define prime-set-candidate-index-handler
  (lambda (id idx)
    (let* ((c (find-context id))
	   (sc (context-data c)))
      (prime-context-set-nth! sc idx)
      (prime-update-preedit id sc))))

(define prime-prop-handler
  (lambda (id message)
    (let* ((c (find-context id))
	   (sc (context-data c)))
      (prime-flush sc)
      (prime-update-preedit id sc)
      (cond
       ((string=? message
		  "prop_prime_mode_hiragana")
	(prime-context-set-mode! sc prime-mode-hiragana))
       ((string=? message
		  "prop_prime_mode_latin")
	(prime-context-set-mode! sc prime-mode-latin))
       ((string=? message
		  "prop_prime_mode_wide_latin")
	(prime-context-set-mode! sc prime-mode-wide-latin)))
      (prime-update-mode id sc)
      (prime-update-prop-label id sc))))

(define prime-update-prop-label
  (lambda (id sc)
    (let* ((mode (prime-context-mode sc))
	   (str ""))
      (cond
       ((= mode prime-mode-latin)
	(set! str "P\t直接入力\n"))
       ((= mode prime-mode-wide-latin)
	(set! str "ｐ\t全角英数\n"))
       ((= mode prime-mode-hiragana)
	(set! str "ぷ\tひらがな\n")))
      (im-update-prop-label id str))))

(define prime-update-prop-list
  (lambda (id) 
    (let* ((c (find-context id))
	   (sc (context-data c))
	   (mode (prime-context-mode sc))
	   (str ""))
      (cond
       ((= mode prime-mode-latin)
	(set! str "P\t直接入力\n"))
       ((= mode prime-mode-wide-latin)
	(set! str "ｐ\t全角英数\n"))
       ((= mode prime-mode-hiragana)
	(set! str "ぷ\tひらがな\n")))
      (set! str 
	    (string-append "branch\t" str
			   "leaf\tぷ\tひらがな\tひらがなモード\tprop_prime_mode_hiragana\n"
			   "leaf\tP\t直接入力\t直接入力モード\tprop_prime_mode_latin\n"
			   "leaf\tＰ\t全角英数\t全角英数モード\tprop_prime_mode_wide_latin\n"))
      (im-update-prop-list id str)
      )))

(register-im
 'prime
 "ja"
 "EUC-JP"
 #f
 prime-init-handler
 #f
 prime-mode-handler
 prime-press-key-handler
 prime-release-key-handler
 prime-reset-handler
 prime-get-candidate-handler
 prime-set-candidate-index-handler
 prime-prop-handler)