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

;; SKK is a Japanese input method
;;
;; EUC-JP
;;
;; SKKの入力は下記の状態で構成される
;; Following is list of SKK input state
;;  直接入力 direct
;;  漢字入力 kanji
;;  変換中 converting
;;  送りがな okuri
;;  英数 latin
;;  全角英数 wide-latin
;;
;; parent/child context is not used now
;;
(require "japanese.scm")
(require "generic-key.scm")

(define skk-dic-file-name "/usr/share/skk/SKK-JISYO.L")
(define skk-personal-dic-filename
  (string-append (getenv "HOME") "/.skk-jisyo"))
(define skk-uim-personal-dic-filename
  (string-append (getenv "HOME") "/.skk-uim-jisyo"))
(define skk-dic-init #f)
;; configs
(define skk-use-candidate-window? #t)
(define skk-candidate-op-count 0)
(define skk-nr-candidate-max 10)
(define skk-use-recursive-learning? #t)
(define skk-egg-like-newline? #f)
(define skk-commit-newline-explicitly? #f)  ;; turn into #t provided safe behavior
(define skk-style 'skk-style-ddskk-like)

;; key defs
(define-key skk-latin-key? '("l" generic-off-key?))
(define-key skk-wide-latin-key? "L")
(define-key skk-begin-conv-key? 'generic-begin-conv-key?)
(define-key skk-on-key? '("<Control>j" "<Control>J" generic-on-key?))
(define-key skk-hankaku-kana-key? '("<Control>q" "<Control>Q"))
(define-key skk-return-key? 'generic-return-key?)
(define-key skk-commit-key? '("<Control>j" "<Control>J"))
(define-key skk-next-candidate-key? 'generic-next-candidate-key?)
(define-key skk-prev-candidate-key? '("x" generic-prev-candidate-key?))
(define-key skk-kana-toggle-key? "q")
(define-key skk-cancel-key? 'generic-cancel-key?)
(define-key skk-backspace-key? 'generic-backspace-key?)
(define-key skk-latin-conv-key? "/")
(define-key skk-kanji-mode-key? "Q")
(define-key skk-plain-space-key? " ")  ;; should not be changed

;; style elements
(define skk-preedit-attr-mode-mark #f)
(define skk-preedit-attr-head #f)
(define skk-preedit-attr-okuri #f)
(define skk-preedit-attr-pending-rk #f)
(define skk-preedit-attr-conv-body #f)
(define skk-preedit-attr-conv-okuri #f)
(define skk-preedit-attr-direct-pending-rk #f)
(define skk-preedit-attr-child-beginning-mark #f)
(define skk-preedit-attr-child-end-mark #f)
(define skk-preedit-attr-child-committed #f)
(define skk-child-context-beginning-mark #f)
(define skk-child-context-end-mark #f)
(define skk-show-cursor-on-preedit? #f)
(define skk-show-candidates-with-okuri? #f)
;; style specification
(define skk-style-spec
  '(;; (style-element-name . validator)
    (skk-preedit-attr-mode-mark            . preedit-attr?)
    (skk-preedit-attr-head                 . preedit-attr?)
    (skk-preedit-attr-okuri                . preedit-attr?)
    (skk-preedit-attr-pending-rk           . preedit-attr?)
    (skk-preedit-attr-conv-body            . preedit-attr?)
    (skk-preedit-attr-conv-okuri           . preedit-attr?)
    (skk-preedit-attr-direct-pending-rk    . preedit-attr?)
    (skk-preedit-attr-child-beginning-mark . preedit-attr?)
    (skk-preedit-attr-child-end-mark       . preedit-attr?)
    (skk-preedit-attr-child-committed      . preedit-attr?)
    (skk-child-context-beginning-mark      . string?)
    (skk-child-context-end-mark            . string?)
    (skk-show-cursor-on-preedit?           . boolean?)
    (skk-show-candidates-with-okuri?       . boolean?)))
;; predefined styles
(define skk-style-uim
  '((skk-preedit-attr-mode-mark            . preedit-reverse)
    (skk-preedit-attr-head                 . preedit-reverse)
    (skk-preedit-attr-okuri                . preedit-reverse)
    (skk-preedit-attr-pending-rk           . preedit-reverse)
    (skk-preedit-attr-conv-body            . preedit-reverse)
    (skk-preedit-attr-conv-okuri           . preedit-reverse)
    (skk-preedit-attr-direct-pending-rk    . preedit-underline)
    (skk-preedit-attr-child-beginning-mark . preedit-reverse)
    (skk-preedit-attr-child-end-mark       . preedit-reverse)
    (skk-preedit-attr-child-committed      . preedit-reverse)
    (skk-child-context-beginning-mark      . "[")
    (skk-child-context-end-mark            . "]")
    (skk-show-cursor-on-preedit?           . #f)
    (skk-show-candidates-with-okuri?       . #t)))
(define skk-style-ddskk-like
  '((skk-preedit-attr-mode-mark            . preedit-underline)
    (skk-preedit-attr-head                 . preedit-underline)
    (skk-preedit-attr-okuri                . preedit-underline)
    (skk-preedit-attr-pending-rk           . preedit-underline)
    (skk-preedit-attr-conv-body            . preedit-reverse)
    (skk-preedit-attr-conv-okuri           . preedit-underline)
    (skk-preedit-attr-direct-pending-rk    . preedit-underline)
    (skk-preedit-attr-child-beginning-mark . preedit-underline)
    (skk-preedit-attr-child-end-mark       . preedit-underline)
    (skk-preedit-attr-child-committed      . preedit-underline)
    (skk-child-context-beginning-mark      . "【")
    (skk-child-context-end-mark            . "】")
    (skk-show-cursor-on-preedit?           . #t)
    (skk-show-candidates-with-okuri?       . #f)))

;; access

(define skk-context-commit-raw
  (lambda (c)
    (car (nthcdr 14 c))))
(define skk-context-set-commit-raw!
  (lambda (c raw)
    (set-car! (nthcdr 14 c) raw)))
(define skk-context-latin-conv
  (lambda (c)
    (car (nthcdr 13 c))))
(define skk-context-set-latin-conv!
  (lambda (c lc)
    (set-car! (nthcdr 13 c) lc)))
(define skk-context-editor
  (lambda (c)
    (car (nthcdr 12 c))))
(define skk-context-set-editor!
  (lambda (c cnt)
    (set-car! (nthcdr 12 c) cnt)))
(define skk-context-parent-context
  (lambda (c)
    (car (nthcdr 11 c))))
(define skk-context-set-parent-context!
  (lambda (c cnt)
    (set-car! (nthcdr 11 c) cnt)))
(define skk-context-child-context
  (lambda (c)
    (car (nthcdr 10 c))))
(define skk-context-set-child-context!
  (lambda (c cnt)
    (set-car! (nthcdr 10 c) cnt)))
(define skk-context-candidate-window
  (lambda (c)
    (car (nthcdr 9 c))))
(define skk-context-set-candidate-window!
  (lambda (c cnt)
    (set-car! (nthcdr 9 c) cnt)))
(define skk-context-candidate-op-count
  (lambda (c)
    (car (nthcdr 8 c))))
(define skk-context-set-candidate-op-count!
  (lambda (c cnt)
    (set-car! (nthcdr 8 c) cnt)))
(define skk-context-rk-context
  (lambda (c)
    (car (nthcdr 7 c))))
(define skk-context-set-rk-context!
  (lambda (c rkc)
    (set-car! (nthcdr 7 c) rkc)))
(define skk-context-nth
  (lambda (c)
    (car (nthcdr 6 c))))
(define skk-context-set-nth!
  (lambda (c nth)
    (set-car! (nthcdr 6 c) nth)))
(define skk-context-okuri
  (lambda (c)
    (car (nthcdr 4 c))))
(define skk-context-set-okuri!
  (lambda (c tail)
    (set-car! (nthcdr 4 c) tail)))
(define skk-context-okuri-head
  (lambda (c)
    (car (nthcdr 3 c))))
(define skk-context-set-okuri-head!
  (lambda (c okuri-head)
    (set-car! (nthcdr 3 c) okuri-head)))
(define skk-context-set-head!
  (lambda (c head)
    (set-car! (nthcdr 2 c) head)))
(define skk-context-head
  (lambda (c)
    (car (nthcdr 2 c))))
(define skk-context-kana-mode
  (lambda (sc)
    (car (nthcdr 1 sc))))
(define skk-context-set-kana-mode!
  (lambda (sc mode)
    (set-car! (nthcdr 1 sc) mode)))
(define skk-context-state
  (lambda (c)
    (car (nthcdr 0 c))))
(define skk-context-set-state!
  (lambda (c s)
    (set-car! (nthcdr 0 c) s)))
;; state kana head okuri tail candidates nth rk

(define skk-type-hiragana 0)
(define skk-type-katakana 1)
(define skk-type-hankana 2)

(define skk-mode-latin 0)
(define skk-mode-hiragana 1)
(define skk-mode-katakana 2)
(define skk-mode-wide-latin 3)
(define skk-mode-hankana 4)

(define skk-find-root-context
  (lambda (sc)
    (let ((pc (skk-context-parent-context sc)))
      (if pc
	  (skk-find-root-context pc)
	  sc))))

(define skk-find-descendant-context
  (lambda (sc)
    (let ((csc (skk-context-child-context sc)))
      (if csc
	  (skk-find-descendant-context csc)
	  sc))))

(define skk-read-personal-dictionary
  (lambda ()
    (or (skk-lib-read-personal-dictionary skk-uim-personal-dic-filename)
	(skk-lib-read-personal-dictionary skk-personal-dic-filename))))

(define skk-save-personal-dictionary
  (lambda ()
    (skk-lib-save-personal-dictionary skk-uim-personal-dic-filename)))

(define skk-current-context
  (lambda (c)
    (skk-find-descendant-context (context-data c))))

(define skk-flush
  (lambda (sc)
    (rk-flush (skk-context-rk-context sc))
    (if skk-use-recursive-learning?
	(skk-editor-flush (skk-context-editor sc)))
    (skk-context-set-state! sc 'skk-state-direct)
    (skk-context-set-head! sc '())
    (skk-context-set-okuri-head! sc "")
    (skk-context-set-okuri! sc '())
    (skk-context-set-candidate-op-count! sc 0)
    (skk-context-set-candidate-window! sc #f)
    (skk-context-set-latin-conv! sc #f)))

(define skk-context-new
  (lambda (id)
    (if (null? skk-dic-init)
	(begin
	  (set! skk-dic-init #t)
	  (if skk-use-recursive-learning?
	   (require "skk-editor.scm"))
	  (skk-lib-dic-open skk-dic-file-name)
	  (skk-read-personal-dictionary)))
    (let ((sc 
	   (copy-list 
	    '(skk-state-latin 0 "" "" "" () () () () () () () () () #f))))
      (skk-context-set-head! sc ())
      (skk-context-set-rk-context! sc
				   (rk-context-new ja-rk-rule #t #f))
      (skk-context-set-child-context! sc ())
      (skk-context-set-parent-context! sc ())
      (if skk-use-recursive-learning?
	  (skk-context-set-editor! sc
				   (skk-editor-new sc id)))
      (skk-flush sc)
      (skk-context-set-state! sc 'skk-state-latin)
      sc)))

(define skk-make-string
  (lambda (sl kana)
    (let ((get-str-by-type 
	   (lambda (l)
	     (cond
	      ((= kana skk-type-hiragana)
	       (caar l))
	      ((= kana skk-type-katakana)
	       (car (cdar l)))
	      ((= kana skk-type-hankana)
	       (cadr (cdar l)))))))
    (if sl
	(string-append (skk-make-string (cdr sl) kana)
		       (get-str-by-type sl))
	""))))

(define skk-opposite-kana
  (lambda (kana)
    (cond
     ((= kana skk-type-hiragana)
      skk-type-katakana)
     ((= kana skk-type-katakana)
      skk-type-hiragana)
     ((= kana skk-type-hankana)
      skk-type-hiragana))))  ; different to ddskk's behavior

(define skk-context-kana-toggle
  (lambda (sc)
    (let* ((kana (skk-context-kana-mode sc))
	   (opposite-kana (skk-opposite-kana kana)))
      (skk-context-set-kana-mode! sc opposite-kana))))

(define skk-get-string-mode-part
  (lambda (sc res type)
    (let ((get-str-by-type 
	   (lambda (l)
	     (cond
	      ((= type skk-type-hiragana)
	       (car l))
	      ((= type skk-type-katakana)
	       (car (cdr l)))
	      ((= type skk-type-hankana)
	       (cadr (cdr l)))))))
      (get-str-by-type res))))

(define skk-do-get-string
  (lambda (sc str kana)
    (if str
	(if (string? (car str))
	    (skk-get-string-mode-part sc str kana)
	    (string-append
	     (skk-do-get-string-by-mode sc (car str) kana)
	     (skk-do-get-string-by-mode sc (cdr str) kana)))
	"")))

(define skk-get-string
  (lambda (sc str kana)
    (let ((res (skk-do-get-string sc str kana)))
      (if (and res (> (length res) 0))
	  res
	  #f))))

(define skk-get-string-by-mode
  (lambda (sc str)
    (let ((kana (skk-context-kana-mode sc)))
      (skk-get-string sc str kana))))

(define skk-get-nth-candidate
  (lambda (sc n)
    (skk-lib-get-nth-candidate
     n
     (skk-make-string (skk-context-head sc) skk-type-hiragana)
     (skk-context-okuri-head sc)
     (skk-make-string (skk-context-okuri sc) skk-type-hiragana))))

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

(define skk-commit-raw
  (lambda (sc id key key-state)
    (let ((psc (skk-context-parent-context sc)))
      (if psc
	  (skk-editor-commit-raw
	   (skk-context-editor psc)
	   key key-state)
	  (begin
	    (skk-context-set-commit-raw! sc #f)
	    (im-commit-raw id))))))

;; commit string
(define skk-commit
  (lambda (sc id str)
    (let ((psc (skk-context-parent-context sc)))
      (if psc
	  (skk-editor-commit
	   (skk-context-editor psc) (skk-lib-remove-annotation str))
	  (im-commit id (skk-lib-remove-annotation str))))))

(define skk-prepare-commit-string
  (lambda (sc id)
    (let* ((cand (skk-get-current-candidate sc))
	   (okuri (skk-make-string (skk-context-okuri sc)
				   (skk-context-kana-mode sc)))
	   (res (string-append cand okuri)))
      (skk-lib-commit-candidate
       (skk-make-string (skk-context-head sc) skk-type-hiragana)
       (skk-context-okuri-head sc)
       (skk-make-string (skk-context-okuri sc) skk-type-hiragana)
       (skk-context-nth sc))
      (if (> (skk-context-nth sc) 0)
	  (skk-save-personal-dictionary))
      (skk-reset-candidate-window sc id)
      (skk-flush sc)
      (skk-context-set-state! sc 'skk-state-direct)
      (skk-update-mode id sc)
      res)))


(define skk-append-string
  (lambda (sc str)
    (and
     str
     (if (not (string? (car str)))
	 (begin
	   (skk-append-string sc (car str))
	   (skk-append-string sc (cdr str))
	   )
	 #t)
     (skk-context-set-head!
      sc
      (cons str (skk-context-head sc))))))

(define skk-append-residual-kana
  (lambda (sc)
    (let* ((rkc (skk-context-rk-context sc))
	   (residual-kana (rk-push-key-last! rkc)))
      (if residual-kana
	  (skk-append-string sc residual-kana)))))

(define skk-begin-conversion
  (lambda (sc id)
    (let ((res))
      ;; get residual 'n'
      (if (= (skk-context-state sc) 'skk-state-kanji)
	  (skk-append-residual-kana sc))
      ;;
      (set! res
	    (skk-lib-get-entry
	     (skk-make-string (skk-context-head sc) skk-type-hiragana)
	     (skk-context-okuri-head sc)
	     (skk-make-string (skk-context-okuri sc) skk-type-hiragana)))
      (if res
	  (begin
	    (skk-context-set-nth! sc 0)
	    (skk-context-set-state!
	     sc 'skk-state-converting))
	  (if skk-use-recursive-learning?
	      (skk-setup-child-context sc id)
	      (skk-flush sc)))
      ())))

(define skk-do-update-preedit
  (lambda (id sc)
    (let ((rkc (skk-context-rk-context sc))
	  (stat (skk-context-state sc))
	  (csc (skk-context-child-context sc)))
      (if (and
	   (not csc)
	   (or
	    (= stat 'skk-state-kanji)
	    (= stat 'skk-state-okuri)))
	  (im-pushback-preedit id skk-preedit-attr-mode-mark "▽"))
      (if (or
	   csc
	   (= stat 'skk-state-converting))
	  (im-pushback-preedit id skk-preedit-attr-mode-mark "▼"))
      (if (or
	   (= stat 'skk-state-kanji)
	   (= stat 'skk-state-okuri)
	   (and
	    csc
	    (= stat 'skk-state-converting)))
	  (let ((h (skk-make-string 
		    (skk-context-head sc)
		    (skk-context-kana-mode sc))))
	    (if (string? h)
		(im-pushback-preedit
		 id skk-preedit-attr-head
		 h))))
      (if (and
	   (= stat 'skk-state-converting)
	   (not csc))
	  (begin
	    (im-pushback-preedit
	     id
	     (bit-or skk-preedit-attr-conv-body
		     preedit-cursor)
	     (skk-get-current-candidate sc))
	    (im-pushback-preedit
	     id skk-preedit-attr-conv-okuri
	     (skk-make-string (skk-context-okuri sc)
			      (skk-context-kana-mode sc)))))

      (if (or
	   (= stat 'skk-state-okuri)
	   (and
	    csc
	    (= stat 'skk-state-converting)
	    (skk-context-okuri sc)))
	  (begin
	    (im-pushback-preedit 
	     id skk-preedit-attr-okuri
	     (string-append
	      "*" (skk-make-string (skk-context-okuri sc)
				   (skk-context-kana-mode sc))))))

      (if (or
	   (= stat 'skk-state-direct)
	   (= stat 'skk-state-latin)
	   (= stat 'skk-state-wide-latin))
	  (begin
	    (im-pushback-preedit id skk-preedit-attr-direct-pending-rk
				 (rk-pending rkc))
	    (im-pushback-preedit id preedit-cursor ""))
	  (begin
	    (im-pushback-preedit id skk-preedit-attr-pending-rk
				 (rk-pending rkc))
	    (if (and
		 (or
		  (= stat 'skk-state-kanji)
		  (= stat 'skk-state-okuri))
		 skk-show-cursor-on-preedit?)
		(im-pushback-preedit id preedit-cursor ""))))

      ;; child context's preedit
      (if csc
	  (let ((editor (skk-context-editor sc)))
	    (im-pushback-preedit id skk-preedit-attr-child-beginning-mark
				 skk-child-context-beginning-mark)
	    (im-pushback-preedit id skk-preedit-attr-child-committed
				 (skk-editor-get-left-string editor))
	    (skk-do-update-preedit id csc)
	    (im-pushback-preedit id skk-preedit-attr-child-committed
				 (skk-editor-get-right-string editor))
	    (im-pushback-preedit id skk-preedit-attr-child-end-mark
				 skk-child-context-end-mark)
	    )))))

(define skk-update-mode
  (lambda (id sc)
    (let ((stat (skk-context-state sc))
	  (mode)
	  (kana (skk-context-kana-mode sc)))
      (set! mode
	    (cond
	     ((= kana skk-type-hiragana)
	      skk-mode-hiragana)
	     ((= kana skk-type-katakana)
	      skk-mode-katakana)
	     ((= kana skk-type-hankana)
	      skk-mode-hankana)))
      (if (= stat 'skk-state-latin)
	  (set! mode skk-mode-latin))
      (if (= stat 'skk-state-wide-latin)
	  (set! mode skk-mode-wide-latin))
      (im-update-mode id mode))))

(define skk-update-preedit
  (lambda (id sc)
    (if (not (skk-context-commit-raw sc))
	(begin
	  (im-clear-preedit id)
	  (skk-do-update-preedit id (skk-find-root-context sc))
	  (im-update-preedit id))
	(skk-context-set-commit-raw! sc #f))))


;; called from skk-editor
(define skk-commit-editor-context
  (lambda (sc id str)
    (let* ((psc (skk-context-parent-context sc))
	   (okuri (skk-make-string (skk-context-okuri sc)
				   (skk-context-kana-mode sc)))
	   (str (if psc
		    str
		    (string-append str okuri))))
      (skk-flush sc)
      (skk-context-set-child-context! sc #f)
      (skk-commit sc id str))))

;; experimental coding style. discussions are welcome -- YamaKen
(define skk-proc-state-direct-no-preedit
  (lambda (key key-state id sc rkc)
    (cond
     ((skk-cancel-key? key key-state)
      (skk-commit-raw sc id key key-state)
      #f)
     ((skk-wide-latin-key? key key-state)
      (skk-context-set-state! sc 'skk-state-wide-latin)
      (rk-flush rkc)
      (skk-update-mode id sc)
      (skk-update-prop-label sc id)
      #f)
     ((skk-latin-key? key key-state)
      (skk-context-set-state! sc 'skk-state-latin)
      (rk-flush rkc)
      (skk-update-mode id sc)
      (skk-update-prop-label sc id)
      #f)
     ((skk-latin-conv-key? key key-state)
      (skk-context-set-state! sc 'skk-state-kanji)
      (skk-update-mode id sc)
      (skk-context-set-latin-conv! sc #t)
      #f)
     ((skk-kanji-mode-key? key key-state)
      (skk-context-set-state! sc 'skk-state-kanji)
      (skk-update-mode id sc)
      (skk-context-set-latin-conv! sc #f)
      #f)
     ((skk-hankaku-kana-key? key key-state)
      (let* ((kana (skk-context-kana-mode sc))
	     (new-kana (if (= kana skk-type-hankana)
			   skk-type-hiragana
			   skk-type-hankana)))
	(skk-context-set-kana-mode! sc new-kana)
	(skk-update-mode id sc)
	(skk-update-prop-label sc id))
      #f)
     ((skk-kana-toggle-key? key key-state)
      (skk-context-kana-toggle sc)
      (skk-update-mode id sc)
      (skk-update-prop-label sc id)
      #f)
     (else
      #t))))

(define skk-proc-state-direct
  (lambda (c key key-state)
    (let* ((sc (skk-current-context c))
	   (id (context-id c))
	   (key-str (charcode->string (to-lower-char key)))
	   (rkc (skk-context-rk-context sc))
	   (res #f)
	   (kana (skk-context-kana-mode sc)))
      (and
       ;; at first, no preedit mode
       (if (string=? (rk-pending rkc) "")
	   (skk-proc-state-direct-no-preedit key key-state id sc rkc)
	   #t)
       (if (skk-cancel-key? key key-state)
	   (begin
	     (skk-flush sc)
	     #f)
	   #t)
       (if (skk-backspace-key? key key-state)
	   (if (not (rk-backspace rkc))
	       (begin
		 (skk-commit-raw sc id key key-state)
		 #f)
	       #f)
	   #t)
       ;; commits "n" as kana according to kana-mode. This is
       ;; ddskk-compatible behavior.
       (if (skk-commit-key? key key-state)
	   (begin
	     (set! res (rk-push-key-last! rkc))
	     #f)
	   #t)
       ;; Handles "nq" key sequence as below. This is ddskk-compatible
       ;; behavior.
       ;; 1. commits "n" as kana according to kana-mode
       ;; 2. switch kana-mode by "q" (hiragana to katakana, or reversely)
       ;;
       ;; skk-kana-toggle-key? have to be here for now because it will
       ;; not work with non-standard key-binding such as "<Control>Q"
       ;; if processed later. This is a problem caused by improper
       ;; strategy "explicit rejection according to the kind of
       ;; key". See bug #528.
       (if (skk-kana-toggle-key? key key-state)
	   (begin
	     (set! res (rk-push-key-last! rkc))
	     (skk-context-kana-toggle sc)
	     (skk-update-mode id sc)
	     (skk-update-prop-label sc id)
	     #f)
	   #t)
       ;; Handles "n " key sequence as below. This is ddskk-compatible
       ;; behavior.
       ;; 1. commits "n" as kana according to kana-mode
       ;; 2. commits " " as native space (such as Qt::Key_Space)
       (if (skk-plain-space-key? key key-state)
	   (begin
	     (set! res (rk-push-key-last! rkc))
	     (skk-commit-raw sc id key key-state)
	     #f)
	   #t)
       ;; bad strategy. see bug #528
       (if (or
	    (control-key-mask key-state)
	    (alt-key-mask key-state)
	    (= key 32))  ;; "<Control> ", "<Alt> ", and so on
	   (begin
	     (skk-commit-raw sc id key key-state)
	     #f)
	   #t)
       ;; Should be fixed to look lower or upper rather than looking
       ;; shift-key-mask
       (if (and
	    (shift-key-mask key-state)
	    (alphabet-char? key))
	   (begin
	     (skk-context-set-state! sc 'skk-state-kanji)
	     (skk-update-mode id sc)
	     (set! key (to-lower-char key))
	     (set! key-str (charcode->string key))
	     #t)
	   #t)
       (if (and
	    (not (skk-context-head sc))
	    (not (string-find (rk-expect rkc) key-str))
	    (not (rk-pending rkc)))
	   (begin
	     (skk-commit-raw sc id key key-state)
	     (skk-flush sc)
	     (skk-update-preedit id sc)
	     #f)
	   #t)
       ;; bad strategy. see bug #528
       (if (symbol? key)
	   (begin
	     (skk-flush sc)
	     (skk-commit-raw sc id key key-state)
	     #f)
	   #t)
       (begin
	 (set! res
	       (rk-push-key!
		rkc
		key-str))
	 #t));;and
      ;; update state
      (if (= (skk-context-state sc) 'skk-state-kanji)
	  (if res
	      (skk-append-string sc res)))
      (if (= (skk-context-state sc) 'skk-state-direct)
	  (skk-get-string sc res kana)
	  #f))))

(define skk-proc-state-kanji
  (lambda (c key key-state)
    (let* ((sc (skk-current-context c))
	   (id (context-id c))
	   (rkc (skk-context-rk-context sc))
	   (stat (skk-context-state sc))
	   (res #f))
      (and
       (if (skk-begin-conv-key? key key-state)
	   (begin
	     (skk-begin-conversion sc id)
	     #f)
	   #t)
       (if (skk-cancel-key? key key-state)
	   (begin
	     (skk-flush sc)
	     #f)
	   #t)
       (if (skk-backspace-key? key key-state)
	   (begin
	     (if (not (rk-backspace rkc))
		 (if (> (length (skk-context-head sc)) 0)
		     (skk-context-set-head!
		      sc (cdr (skk-context-head sc)))
		     (begin
		       (skk-context-set-state! sc 'skk-state-direct)
		       (skk-flush sc))))
	     #f)
	   #t)
       (if (or
	    (skk-commit-key? key key-state)
	    (skk-return-key? key key-state))
	   (begin
	     (skk-append-residual-kana sc)
	     (skk-commit sc id (skk-make-string
				(skk-context-head sc)
				(skk-context-kana-mode sc)))
	     (skk-flush sc)
	     (skk-context-set-state! sc 'skk-state-direct)
	     (skk-update-mode id sc)
	     (if (not skk-egg-like-newline?)
		 (if (skk-return-key? key key-state)
		     (if skk-commit-newline-explicitly?
			 (skk-commit sc id "\n")
			 (skk-proc-state-direct c key key-state))))
 	     #f)
	   #t)
       (if (skk-context-latin-conv sc)
          (begin
            (if (usual-char? key)
                (let* ((s (charcode->string key))
                       (p (cons s s)))
                  (skk-append-string sc p)))
            #f)
          #t)
       (if (and (shift-key-mask key-state)
		(skk-context-head sc))
	   (begin
	     (skk-context-set-state! sc 'skk-state-okuri)
	     (skk-update-mode id sc)
	     (set! key (to-lower-char key))
	     (skk-context-set-okuri-head! sc
					  (charcode->string key))
	     (skk-append-residual-kana sc)
	     #t)
	   #t)
       (if (skk-kana-toggle-key? key key-state)
	   (begin
	     (skk-append-residual-kana sc)
	     (if (skk-context-head sc)
		 (skk-commit sc id (skk-make-string
				    (skk-context-head sc)
				    (skk-opposite-kana
				     (skk-context-kana-mode sc)))))
            (skk-flush sc)
            (skk-context-set-state! sc 'skk-state-direct)
            (skk-update-mode id sc)
            #f)
          #t)
       (begin
	 (set! key (to-lower-char key))  
	 (set! stat (skk-context-state sc))
	 (set! res
	       (rk-push-key!
		rkc
		(charcode->string key)))
	 (if (and res (= stat 'skk-state-kanji))
	     (begin
	       (skk-context-set-head! sc
				      (cons
				       res
				       (skk-context-head sc)))))
	 (if (and res (= stat 'skk-state-okuri))
	     (begin
	       (skk-context-set-okuri! sc
				       (cons res ()))
	       (skk-begin-conversion sc id)))))
      #f)))

(define skk-setup-child-context
  (lambda (sc id)
    (let ((csc (skk-context-new id)))
      (skk-context-set-child-context! sc csc)
      (skk-context-set-parent-context! csc sc)
      (skk-context-set-state! csc 'skk-state-direct))))

(define skk-check-candidate-window-begin
  (lambda (sc id)
    (if
     (and
      (not
       (skk-context-candidate-window sc))
      skk-use-candidate-window?
      (> (skk-context-candidate-op-count sc)
	 skk-candidate-op-count))
     (begin
       (skk-context-set-candidate-window! sc #t)
       (im-activate-candidate-selector
	id
	(skk-lib-get-nr-candidates
	 (skk-make-string (skk-context-head sc) skk-type-hiragana)
	 (skk-context-okuri-head sc)
	 (skk-make-string (skk-context-okuri sc) skk-type-hiragana))
	skk-nr-candidate-max)))))

(define skk-change-candidate-index
  (lambda (sc id incr)
    (if incr
	(begin
	  (skk-context-set-nth! sc
				(+ 1 (skk-context-nth sc)))
	  (skk-context-set-candidate-op-count!
	   sc
	   (+ 1 (skk-context-candidate-op-count sc))))
	(begin
	  (if (> (skk-context-nth sc) 0)
	      (skk-context-set-nth! sc (- (skk-context-nth sc) 1))
	      (skk-context-set-nth! sc (- (skk-lib-get-nr-candidates
					   (skk-make-string
					    (skk-context-head sc)
					    skk-type-hiragana)
					   (skk-context-okuri-head sc)
					   (skk-make-string
					    (skk-context-okuri sc)
					    skk-type-hiragana))
					  1)))))
    (if (not (skk-get-current-candidate sc))
	(begin
	  (skk-context-set-nth! sc 0)
	  (if skk-use-recursive-learning?
	      (begin
		(skk-reset-candidate-window sc id)
		(skk-setup-child-context sc id)))))
    (if (not (skk-context-child-context sc))
	(begin
	  ;; 候補Windowの表示を開始するか
	  (skk-check-candidate-window-begin sc id)
	  ;;
	  (if (skk-context-candidate-window sc)
	      (im-select-candidate id (skk-context-nth sc)))))
    #f))

(define skk-reset-candidate-window
  (lambda (sc id)
    (if (skk-context-candidate-window sc)
	(begin
	  (im-deactivate-candidate-selector id sc)
	  (skk-context-set-candidate-window! sc #f)))
    (skk-context-set-candidate-op-count! sc 0)))

(define skk-back-to-kanji-state
  (lambda (sc id)
    (skk-reset-candidate-window sc id)
    (skk-context-set-state! sc 'skk-state-kanji)
    (skk-context-set-okuri-head! sc "")
    (if (not (null? (skk-context-okuri sc)))
	(skk-context-set-head! sc
			       (append (skk-context-okuri sc)
				       (skk-context-head sc))))
    (skk-context-set-okuri! sc ())))

(define skk-proc-state-converting
  (lambda (c key key-state)
    (let ((sc (skk-current-context c))
	  (id (context-id c))
	  (res ()))
      (and
       (if (skk-next-candidate-key? key key-state)
	   (skk-change-candidate-index sc id #t)
	   #t)
       (if (skk-prev-candidate-key? key key-state)
	   (skk-change-candidate-index sc id #f)
	   #t)
       (if (skk-cancel-key? key key-state)
	   (begin
	     ;; back to kanji state
	     (skk-back-to-kanji-state sc id)
	     #f)
	   #t)
       (if (or
	    (skk-commit-key? key key-state)
	    (skk-return-key? key key-state))
	   (begin
	     (set! res (skk-prepare-commit-string sc id))
	     (if (skk-return-key? key key-state)
		 (begin
		   (skk-commit sc id res)
		   (set! res ())
		   (if (not skk-egg-like-newline?)
		       (if skk-commit-newline-explicitly?
			   (skk-commit sc id "\n")
			   (skk-proc-state-direct c key key-state)))))
	     #f)
	   #t)
       (begin
	 (skk-context-set-state! sc 'skk-state-direct)
	 (skk-update-mode id sc)
	 (set! res (skk-get-current-candidate sc))
	 (skk-reset-candidate-window sc id)
	 (set!
	  res
	  (string-append res 
			 (skk-make-string
			  (skk-context-okuri sc)
			  (skk-context-kana-mode sc))))
	 (skk-prepare-commit-string sc id)
	 (skk-commit sc id res)
	 (skk-flush sc)
	 (set! res (skk-proc-state-direct c key key-state))))
      res)))

(define skk-proc-state-okuri
  (lambda (c key key-state)
    (let* ((sc (skk-current-context c))
	   (rkc (skk-context-rk-context sc))
	   (id (context-id c))	   
	   (res))
      (and
       (if (skk-cancel-key? key key-state)
	   (begin
	     (rk-flush rkc)
	     (skk-context-set-state! sc 'skk-state-kanji)
	     #f)
	   #t)
       (if (skk-backspace-key? key key-state)
	   (begin
	     (if (not (rk-backspace rkc))
		 (begin
		   (if (cdr (skk-context-okuri sc))
		       (skk-context-set-okuri! sc
			(cdr (skk-context-okuri sc)))
		       (skk-back-to-kanji-state sc id))))
	     #f)
	   #t)
       ;; committing incomplete head: conformed the behavior to ddskk
       (if (or
	    (skk-commit-key? key key-state)
	    (skk-return-key? key key-state))
	   (begin
	     (skk-commit sc id (skk-make-string
				(skk-context-head sc)
				(skk-context-kana-mode sc)))
	     (skk-flush sc)
	     (skk-context-set-state! sc 'skk-state-direct)
	     (skk-update-mode id sc)
	     (if (skk-return-key? key key-state)
		 (skk-proc-state-direct c key key-state))
	     #f)
	   #t)
       (begin
	 (set! res
	       (rk-push-key!
		rkc
		(charcode->string (to-lower-char key))))
	 (if res
	     (begin
	       (skk-context-set-okuri!
		sc
		(cons res (skk-context-okuri sc)))
	       (if (string=? (rk-pending rkc) "")
		   (skk-begin-conversion sc id))))))
      ())))

(define skk-proc-state-latin
  (lambda (c key key-state)
    (let ((sc (skk-current-context c))
	  (id (context-id c)))
      (if
       (skk-on-key? key key-state)
       (begin
	 (skk-context-set-state! sc 'skk-state-direct)
	 (skk-context-set-kana-mode! sc skk-type-hiragana)
	 (skk-update-mode (context-id c) sc)
	 (skk-update-prop-label sc id))
       (skk-commit-raw sc (context-id c) key key-state))
      ())))

(define skk-proc-state-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 (skk-current-context c)))
      (cond
       ((skk-on-key? key key-state)
	(skk-flush sc)  ; implicitly reset to 'skk-state-direct
	(skk-context-set-kana-mode! sc skk-type-hiragana)
	(skk-update-mode id sc)
	(skk-update-prop-label sc id))
       ((and (modifier-key-mask key-state)
	     (not (shift-key-mask key-state)))
	(skk-commit-raw sc id key key-state))
       (w
	(skk-commit sc id w))
       (else
	(skk-commit-raw sc id key key-state)))
      ())))

(define skk-push-key
  (lambda (c id key key-state)
    (let* ((sc (skk-current-context c))
	   (state (skk-context-state sc))
	   (fun (cond
		 ((= state 'skk-state-direct)
		  skk-proc-state-direct)
		 ((= state 'skk-state-kanji)
		  skk-proc-state-kanji)
		 ((= state 'skk-state-converting)
		  skk-proc-state-converting)
		 ((= state 'skk-state-okuri)
		  skk-proc-state-okuri)
		 ((= state 'skk-state-latin)
		  skk-proc-state-latin)
		 ((= state 'skk-state-wide-latin)
		  skk-proc-state-wide-latin)))
	   (res (fun c key key-state)))
      (if res
	  (skk-commit sc id res))
      (skk-update-preedit id sc))))

(define skk-init-handler
  (lambda (id arg)
    (let* ((c (find-context id)))
      (set-context-data! c
			 (skk-context-new id))
      (im-clear-mode-list id)
      (im-pushback-mode-list id "直接入力")
      (im-pushback-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 skk-mode-latin)
      (skk-update-prop-list id)
      (update-style skk-style-spec (symbol-value skk-style)))))

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

(define skk-release-key-handler
  (lambda (id key state)
    (let* ((c (find-context id))
	   (sc (skk-current-context c))
	   (state (skk-context-state sc)))
      (if (= state 'skk-state-latin)
	  ;; don't discard key release event for apps
	  (begin
	    (skk-context-set-commit-raw! sc #f)
	    (im-commit-raw id))))))

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

(define skk-mode-handler
  (lambda (id mode)
    (let* ((c (find-context id))
	   (sc (context-data c)))
      (skk-flush sc)
      (if (= mode skk-mode-latin)
	  (skk-context-set-state! sc 'skk-state-latin))
      (if (= mode skk-mode-hiragana)
	  (begin
	    (skk-context-set-state! sc 'skk-state-direct)
	    (skk-context-set-kana-mode! sc skk-type-hiragana)))
      (if (= mode skk-mode-katakana)
	  (begin
	    (skk-context-set-state! sc 'skk-state-direct)
	    (skk-context-set-kana-mode! sc skk-type-katakana)))
      (if (= mode skk-mode-wide-latin)
	  (skk-context-set-state! sc 'skk-state-wide-latin))
      (if (= mode skk-mode-hankana)
	  (begin
	    (skk-context-set-state! sc 'skk-state-direct)
	    (skk-context-set-kana-mode! sc skk-type-hankana)))
      (skk-update-preedit id sc)
      ())))

(define skk-get-candidate-handler
  (lambda (id idx)
    (let* ((c (find-context id))
	   (sc (context-data c))
	   (dcsc (skk-find-descendant-context sc))
	   (cand (skk-get-nth-candidate dcsc idx))
	   (okuri (skk-context-okuri dcsc)))
      (list
       (if (and
	    okuri
	    skk-show-candidates-with-okuri?)
	   (string-append cand
			  (skk-make-string okuri skk-type-hiragana))
	   cand)
       (digit->string (+ idx 1))))))

(define skk-set-candidate-index-handler
  (lambda (id idx)
    (let* ((c (find-context id))
	   (sc (skk-current-context c)))
      (skk-context-set-nth! sc idx)
      (skk-commit sc id (skk-prepare-commit-string sc id))
      (skk-update-preedit id sc))))

(define skk-prop-handler
  (lambda (id message)
    (let* ((c (find-context id))
	   (sc (context-data c)))
      (skk-flush sc)
      (skk-update-preedit id sc)
      (cond
       ((string=? message
		  "prop_skk_hiragana")
	(begin
	  (skk-context-set-state! sc 'skk-state-direct)
	  (skk-context-set-kana-mode! sc skk-type-hiragana)))
       ((string=? message
		  "prop_skk_katakana")
	(begin
	  (skk-context-set-state! sc 'skk-state-direct)
	  (skk-context-set-kana-mode! sc skk-type-katakana)))
       ((string=? message
		  "prop_skk_hankana")
	(begin
	  (skk-context-set-state! sc 'skk-state-direct)
	  (skk-context-set-kana-mode! sc skk-type-hankana)))
       ((string=? message
		  "prop_skk_latin")
	(skk-context-set-state! sc 'skk-state-latin))
       ((string=? message
		  "prop_skk_wide_latin")
	(skk-context-set-state! sc 'skk-state-wide-latin)))
      (skk-update-mode id sc)
      (skk-update-prop-label sc id))))


(define skk-update-prop-label
  (lambda (sc id)
    (let* ((state (skk-context-state sc))
	   (kana (skk-context-kana-mode sc))
	   (str ""))
      (cond
       ((= state 'skk-state-latin)
	(set! str "S\t直接入力\n"))
       ((= state 'skk-state-wide-latin)
	(set! str "Ｓ\t全角英数\n"))
       ((= kana skk-type-hiragana)
	(set! str "え\tひらがな\n"))
       ((= kana skk-type-katakana)
	(set! str "エ\tカタカナ\n"))
       ((= kana skk-type-hankana)
	(set! str "ｴ\t半角カタカナ\n")))
      (im-update-prop-label id str))))

(define skk-update-prop-list
  (lambda (id) 
    (let* ((c (find-context id))
	   (sc (context-data c))
	   (state (skk-context-state sc))
	   (kana? (skk-context-kana-mode sc))
	   (str ""))
      (cond
       ((= state 'skk-state-latin)
	(set! str "S\t直接入力\n"))
       ((= state 'skk-state-wide-latin)
	(set! str "Ｓ\t全角英数\n"))
       ((= kana skk-type-hiragana)
	(set! str "え\tひらがな\n"))
       ((= kana skk-type-katakana)
	(set! str "エ\tカタカナ\n"))
       ((= kana skk-type-hankana)
	(set! str "ｴ\t半角カタカナ\n")))
      (set! str (string-append "branch\t" str
			       "leaf\tえ\tひらがな\tひらがなモード\tprop_skk_hiragana\n"
			       "leaf\tエ\tカタカナ\tカタカナモード\tprop_skk_katakana\n"
			       "leaf\tｴ\t半角カタカナ\t半角カタカナモード\tprop_skk_hankana\n"
			       "leaf\tS\t直接入力\t直接入力モード\tprop_skk_latin\n"
			       "leaf\tＳ\t全角英数\t全角英数モード\tprop_skk_wide_latin\n"))
      (im-update-prop-list id str)
      )))

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