;;; anthy.scm: Anthy for uim.
;;; charset: EUC-JP
;;;
;;; 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.
;;;;

(require "japanese.scm")
(require "generic-key.scm")
;;
(define anthy-init-lib-ok? #f)
;; configs
(define anthy-use-candidate-window? #t)
(define anthy-candidate-op-count 1)
(define anthy-nr-candidate-max 10)
(define anthy-show-segment-separator? #f)
(define anthy-segment-separator "|")

;; key defs
(define-key anthy-on-key? '("<Control>j" "<Control>J" generic-on-key?))
(define-key anthy-latin-key? '("l" generic-on-key?))
(define-key anthy-wide-latin-key? "L")
(define-key anthy-hankaku-kana-key? '("<Control>q" "<Control>Q"))
(define-key anthy-kana-toggle-key? "q")
(define-key anthy-commit-key? 'generic-commit-key?)
(define-key anthy-commit-as-opposite-kana-key? "Q")
(define-key anthy-commit-as-katakana-key? "F7")
(define-key anthy-commit-as-hankana-key? "F8")
(define-key anthy-commit-as-wide-latin-key? "") ; "F9"
(define-key anthy-commit-as-latin-key? "") ; "F10"
(define-key anthy-begin-conv-key? 'generic-begin-conv-key?)
(define-key anthy-extend-segment-key? '("<Control>o" "<Control>O" "<Shift>right"))
(define-key anthy-shrink-segment-key? '("<Control>i" "<Control>I" "<Shift>left"))
(define-key anthy-next-candidate-key? 'generic-next-candidate-key?)
(define-key anthy-prev-candidate-key? 'generic-prev-candidate-key?)
(define-key anthy-next-page-key? 'generic-next-page-key?)
(define-key anthy-prev-page-key? 'generic-prev-page-key?)
(define-key anthy-cancel-key? 'generic-cancel-key?)
(define-key anthy-backspace-key? 'generic-backspace-key?)
(define-key anthy-delete-key? 'generic-delete-key?)
(define-key anthy-kill-key? 'generic-kill-key?)
(define-key anthy-kill-backward-key? 'generic-kill-backward-key?)
(define-key anthy-go-left-key? 'generic-go-left-key?)
(define-key anthy-go-right-key? 'generic-go-right-key?)
(define-key anthy-beginning-of-preedit-key? 'generic-beginning-of-preedit-key?)
(define-key anthy-end-of-preedit-key? 'generic-end-of-preedit-key?)
(define-key anthy-next-segment-key? 'generic-go-right-key?)
(define-key anthy-prev-segment-key? 'generic-go-left-key?)

;; access
(define anthy-context-on
  (lambda (ac)
    (car (nthcdr 0 ac))))

(define anthy-context-set-on!
  (lambda (ac s)
    (set-car! (nthcdr 0 ac) s)))

(define anthy-context-state
  (lambda (ac)
    (car (nthcdr 1 ac))))

(define anthy-context-set-state!
 (lambda (ac st)
   (set-car! (nthcdr 1 ac) st)))

(define anthy-context-ac-id
  (lambda (ac)
    (car (nthcdr 2 ac))))

(define anthy-context-set-ac-id!
  (lambda (ac id)
    (set-car! (nthcdr 2 ac) id)))

(define anthy-context-left-string ;;preedit strings in the left of cursor
 (lambda (ac)
   (car (nthcdr 3 ac))))

(define anthy-context-set-left-string!
  (lambda (ac str)
    (set-car! (nthcdr 3 ac) str)))

(define anthy-context-right-string
 (lambda (ac)
   (car (nthcdr 4 ac))))

(define anthy-context-set-right-string!
  (lambda (ac str)
    (set-car! (nthcdr 4 ac) str)))

(define anthy-context-rkc
  (lambda (ac)
    (car (nthcdr 5 ac))))

(define anthy-context-set-rkc!
 (lambda (ac rkc)
   (set-car! (nthcdr 5 ac) rkc)))

(define anthy-context-index-list
  (lambda (ac)
    (car (nthcdr 6 ac))))
  
(define anthy-context-set-index-list!
 (lambda (ac lst)
   (set-car! (nthcdr 6 ac) lst)))

(define anthy-context-cur-seg
  (lambda (ac)
    (car (nthcdr 7 ac))))

(define anthy-context-set-cur-seg!
  (lambda (ac seg)
    (set-car! (nthcdr 7 ac) seg)))

(define anthy-context-candidate-window
  (lambda (ac)
    (car (nthcdr 8 ac))))

(define anthy-context-set-candidate-window!
  (lambda (ac f)
    (set-car! (nthcdr 8 ac) f)))

(define anthy-context-candidate-op-count
  (lambda (ac)
    (car (nthcdr 9 ac))))

(define anthy-context-set-candidate-op-count!
  (lambda (ac c)
    (set-car! (nthcdr 9 ac) c)))

(define anthy-context-wide-latin
  (lambda (ac)
    (car (nthcdr 10 ac))))

(define anthy-context-set-wide-latin!
  (lambda (ac c)
    (set-car! (nthcdr 10 ac) c)))

(define anthy-context-kana-mode
  (lambda (ac)
    (car (nthcdr 11 ac))))

(define anthy-context-set-kana-mode!
  (lambda (ac c)
    (set-car! (nthcdr 11 ac) c)))

(define anthy-context-commit-raw
  (lambda (ac)
    (car (nthcdr 12 ac))))

(define anthy-context-set-commit-raw!
  (lambda (ac c)
    (set-car! (nthcdr 12 ac) c)))

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

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

;; on/off state(compose,input) anthy-context-id string rkc index-list
;; cur-seg candidate-window
(define anthy-context-new
 (lambda ()
   (let ((c '())
	 (rkc (rk-context-new ja-rk-rule #t #f)))
     (set! c (copy-list '(() () () () () () () () () () #f 0 #t #f)))
     (if (symbol-bound? 'anthy-lib-init))
	 (set! anthy-init-lib-ok? (anthy-lib-init))
     (anthy-context-set-ac-id!
      c
      (if anthy-init-lib-ok?
	  (anthy-lib-alloc-context)
	  ()))
     (anthy-context-set-rkc! c rkc)
     (anthy-flush c)
     (anthy-context-set-on! c #f)
     c)))

(define anthy-commit-raw
  (lambda (ac id)
    (im-commit-raw id)
    (anthy-context-set-commit-raw! ac #t)))

(define anthy-context-kana-toggle
  (lambda (ac)
    (let* ((kana (anthy-context-kana-mode ac))
	   (opposite-kana (multi-segment-opposite-kana kana)))
      (anthy-context-set-kana-mode! ac opposite-kana))))

;; TODO: generarize as multi-segment procedure
;; side effect: flushes rkc if convert-pending?
(define anthy-make-whole-string
  (lambda (ac convert-pending-into-kana? kana)
    (let* ((rkc (anthy-context-rkc ac))
	   (pending (rk-pending rkc))
	   (residual-kana (rk-push-key-last! rkc)))
      (string-append
       (multi-segment-make-left-string (anthy-context-left-string ac)
				       kana)
       (if convert-pending-into-kana?
	   (if residual-kana
	       (begin
		 (rk-flush rkc)
		 (multi-segment-make-left-string (list residual-kana)
						 kana))
	       (if using-kana-table?
		   pending
		   ""))
	   pending)
       (multi-segment-make-right-string (anthy-context-right-string ac)
					kana)))))

(define anthy-init-handler
  (lambda (id arg)
    (let ((c (find-context id)))
      (set-context-data! c (anthy-context-new))
      (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 0)
      (anthy-update-prop-list id)
      ())))

(define anthy-release-handler
  (lambda (id)
    (let* ((c (find-context id))
	   (ac (context-data c))
	   (ac-id (anthy-context-ac-id ac)))
      (anthy-lib-free-context ac-id))))

(define anthy-mode-handler
  (lambda (id mode)
    (let* ((c (find-context id))
	   (ac (context-data c)))
      (anthy-flush ac)
      (cond  ; `case' is not supported by uim
       ((= mode anthy-mode-direct)
        (anthy-context-set-on! ac #f)
        (anthy-context-set-wide-latin! ac #f))
       ((= mode anthy-mode-hiragana)
        (anthy-context-set-on! ac #t)
        (anthy-context-set-kana-mode! ac anthy-type-hiragana))
       ((= mode anthy-mode-katakana)
        (anthy-context-set-on! ac #t)
        (anthy-context-set-kana-mode! ac anthy-type-katakana))
       ((= mode anthy-mode-wide-latin)
        (anthy-context-set-on! ac #f)
        (anthy-context-set-wide-latin! ac #t))
       ((= mode anthy-mode-hankana)
        (anthy-context-set-on! ac #t)
        (anthy-context-set-kana-mode! ac anthy-type-hankana)))
      (anthy-update-preedit ac id))
    ()))

(define anthy-flush
  (lambda (ac)
    (rk-flush (anthy-context-rkc ac))
    (anthy-context-set-left-string! ac '())
    (anthy-context-set-right-string! ac '())
    (anthy-context-set-on! ac #t)
    (anthy-context-set-state! ac #f)
    (anthy-context-set-index-list! ac ())
    (anthy-context-set-candidate-window! ac #f)
    (anthy-context-set-candidate-op-count! ac 0)))

(define anthy-begin-input
  (lambda (ac)
    (anthy-context-set-on! ac #t)
    (rk-flush (anthy-context-rkc ac))
    (anthy-context-set-state! ac #f)))

(define anthy-update-preedit
  (lambda (ac id)
    (if (not (anthy-context-commit-raw ac))
	(if (anthy-context-on ac)
	    (if (anthy-context-state ac)
		(anthy-compose-state-preedit ac id)
		(anthy-input-state-preedit ac id))
	    (begin
	      (im-clear-preedit id)
	      (im-update-preedit id)))
	(anthy-context-set-commit-raw! ac #f))))
  
(define anthy-proc-raw-state
  (lambda (c key key-state)
    (let ((id (context-id c))
	  (ac (context-data c)))
      (if (anthy-on-key? key key-state)
	  (begin
	    (anthy-begin-input ac)
	    (anthy-update-mode ac id)
	    (anthy-update-prop-label ac id))
	  (anthy-commit-raw ac id)))))

(define anthy-append-string
  (lambda (ac str)
    (and
     str
     (if (not (string? (car str)))
	 (begin
	   (anthy-append-string ac (car str))
	   (anthy-append-string ac (cdr str))
	   #f)
	 #t)
     (anthy-context-set-left-string!
      ac (cons str (anthy-context-left-string ac))))))

(define anthy-begin-conv
  (lambda (ac)
    (let* ((ac-id (anthy-context-ac-id ac))
	   (rkc (anthy-context-rkc ac))
	   (kana (anthy-context-kana-mode ac)))
      (anthy-lib-set-string
       ac-id
       (anthy-make-whole-string ac #t anthy-type-hiragana))
      (anthy-context-set-index-list!
       ac
       (multi-segment-make-index-list
	(anthy-lib-get-nr-segments ac-id)
	'()))
      (anthy-context-set-state! ac #t)
      (anthy-context-set-cur-seg! ac 0)
      (rk-flush (anthy-context-rkc ac)))))

(define anthy-proc-input-state-no-preedit
  (lambda (ac id key key-state)
    (let ((rkc (anthy-context-rkc ac))
	  (direct (ja-direct (charcode->string key))))
      (cond
       ((anthy-wide-latin-key? key key-state)
	(begin
	  (anthy-flush ac)
	  (anthy-context-set-on! ac #f)
	  (anthy-context-set-wide-latin! ac #t)
	  (anthy-update-mode ac id)
	  (anthy-update-prop-label ac id)))
	  
       ((anthy-latin-key? key key-state)
	   (begin
	     (anthy-flush ac)
	     (anthy-context-set-on! ac #f)
	     (anthy-context-set-wide-latin! ac #f)
	     (anthy-update-mode ac id)
	     (anthy-update-prop-label ac id)))

       ((anthy-backspace-key? key key-state)
	(anthy-commit-raw ac id))

       ((anthy-delete-key? key key-state)
	(anthy-commit-raw ac id))
       
       ((anthy-hankaku-kana-key? key key-state)
	   (begin 
	     (anthy-context-set-kana-mode! ac anthy-type-hankana)
	     (anthy-update-mode ac id)
	     (anthy-update-prop-label ac id)))

       ((anthy-kana-toggle-key? key key-state)
	(begin 
	  (anthy-context-kana-toggle ac)
	  (anthy-update-mode ac id)
	  (anthy-update-prop-label ac id)))

       ;; modifiers (except shift) => ignore
       ((and (modifier-key-mask key-state)
	     (not (shift-key-mask key-state)))
	(anthy-commit-raw ac id))
       
       ;; direct key => commit
       (direct
	(im-commit id direct))

       ((symbol? key)
	(anthy-commit-raw ac id))

       (else
	(let* ((key-str (charcode->string
			 (if using-kana-table?
			     key
			     (to-lower-char key))))
	       (res (rk-push-key! rkc key-str)))
	  (if res
	      (anthy-append-string ac res)
	      (if (not (rk-pending rkc)
		       (anthy-commit-raw ac id))))))))))

(define anthy-has-preedit?
  (lambda (ac)
    (or
     (> (length (anthy-context-left-string ac)) 0)
     (> (length (anthy-context-right-string ac)) 0)
     (> (length (rk-pending (anthy-context-rkc ac))) 0))))

(define anthy-proc-input-state-with-preedit
  (lambda (ac id key key-state)
    (let ((rkc (anthy-context-rkc ac))
	  (kana (anthy-context-kana-mode ac)))
      (cond
       
       ;; begin conversion
       ((and (anthy-begin-conv-key? key key-state)
	     (number? (anthy-context-ac-id ac)))
	(anthy-begin-conv ac))
       
       ;; backspace
       ((anthy-backspace-key? key key-state)
	(if (not (rk-backspace rkc))
	    (if (anthy-context-left-string ac)
		(anthy-context-set-left-string!
		 ac
		 (cdr (anthy-context-left-string ac))))))
       
       ;; delete
       ((anthy-delete-key? key key-state)
	(if (not (rk-delete rkc))
	    (if (anthy-context-right-string ac)
		(anthy-context-set-right-string!
		 ac
		 (cdr (anthy-context-right-string ac))))))

       ;; kill
       ((anthy-kill-key? key key-state)
	(anthy-context-set-right-string! ac ()))
       
       ;; kill-backward
       ((anthy-kill-backward-key? key key-state)
	(begin
	  (rk-flush rkc)
	  (anthy-context-set-left-string! ac ())))

       ;; 現在とは逆のかなモードでかなを確定する
       ((anthy-commit-as-opposite-kana-key? key key-state)
	(begin
	  (im-commit
	   id
	   (anthy-make-whole-string ac #t (multi-segment-opposite-kana kana)))
	  (anthy-flush ac)))

       ;; カタカナモードでかなを確定する
       ((anthy-commit-as-katakana-key? key key-state)
	(begin
	  (im-commit
	   id
	   (anthy-make-whole-string ac #t multi-segment-type-katakana))
	  (anthy-flush ac)))

       ;; 半角カタカナモードでかなを確定する
       ((anthy-commit-as-hankana-key? key key-state)
	(begin
	  (im-commit
	   id
	   (anthy-make-whole-string ac #t multi-segment-type-hankana))
	  (anthy-flush ac)))

       ;; かなを英数字に戻して確定する
       ((anthy-commit-as-latin-key? key key-state)
	(begin
	  (im-commit
	   id
	   "not implemented")
	  (anthy-flush ac)))

       ;; かなを全角英数字に戻して確定する
       ((anthy-commit-as-wide-latin-key? key key-state)
	(begin
	  (im-commit
	   id
	   "ｎｏｔ　ｉｍｐｌｅｍｅｎｔｅｄ")
	  (anthy-flush ac)))

       ;; 現在のかなを確定後、ひらがな/カタカナモードを切り換える
       ((anthy-kana-toggle-key? key key-state)
	(begin
	  (im-commit
	   id
	   (anthy-make-whole-string ac #t kana))
	  (anthy-flush ac)
	  (anthy-context-kana-toggle ac)
	  (anthy-update-mode ac id)
	  (anthy-update-prop-label ac id)))

       ;; cancel
       ((anthy-cancel-key? key key-state)
	(anthy-flush ac))

       ;; commit
       ((anthy-commit-key? key key-state)
	(begin
	  (im-commit
	   id
	   (anthy-make-whole-string ac #t kana))
	  (anthy-flush ac)))

       ;; left
       ((anthy-go-left-key? key key-state)
	(if (anthy-context-left-string ac)
	    (let ((c (car (anthy-context-left-string ac))))
	      (anthy-context-set-left-string!
	       ac (cdr (anthy-context-left-string ac)))
	      (anthy-context-set-right-string! 
	       ac
	       (cons c (anthy-context-right-string ac))))))

       ;; right
       ((anthy-go-right-key? key key-state)
	(if (anthy-context-right-string ac)
	    (let ((c (car (anthy-context-right-string ac))))
	      (anthy-context-set-right-string!
	       ac (cdr (anthy-context-right-string ac)))
	      (anthy-append-string ac c))))

       ;; beginning-of-preedit
       ((anthy-beginning-of-preedit-key? key key-state)
	(if (anthy-context-left-string ac)
	    (begin
	      (anthy-context-set-right-string!
	       ac
	       (append
		(reverse (anthy-context-left-string ac))
		(anthy-context-right-string ac)))
	      (anthy-context-set-left-string! ac ()))))

       ;; end-of-preedit
       ((anthy-end-of-preedit-key? key key-state)
	(if (anthy-context-right-string ac)
	    (begin
	      (anthy-context-set-left-string!
	       ac
	       (append
		(reverse (anthy-context-right-string ac))
		(anthy-context-left-string ac)))
	      (anthy-context-set-right-string! ac ()))))
;		   (rk-flush rkc)))

       ;; modifiers (except shift) => ignore
       ((and (modifier-key-mask key-state)
	     (not (shift-key-mask key-state)))
	(anthy-commit-raw ac id))

       (else	
	(let* ((key-str (charcode->string 
			 (if using-kana-table?
			     key
			     (to-lower-char key))))
	       (pend (rk-pending rkc))
	       (res (rk-push-key! rkc key-str)))
	  (if (and res (not (string=? (car res) "")))
	      (anthy-append-string ac res)
	      (if using-kana-table?
		  (anthy-append-string ac (list pend "" ""))))))))))

(define anthy-proc-input-state
  (lambda (ac id key key-state)
    (if (anthy-has-preedit? ac)
	(anthy-proc-input-state-with-preedit ac id key key-state)
	(anthy-proc-input-state-no-preedit ac id key key-state))))

(define anthy-pushback-preedit-segment-rec
  (lambda (ac id idx nseg)
    (let ((ac-id (anthy-context-ac-id ac)))
      (if (< idx nseg)
	  (begin
	    (if (and
		 anthy-show-segment-separator?
		 (< 0 idx))
		(im-pushback-preedit
		 id
		 (bit-or preedit-separator
			 preedit-underline)
		 anthy-segment-separator))
	    (im-pushback-preedit
	     id
	     (if (= idx (anthy-context-cur-seg ac))
		 (+ preedit-reverse preedit-cursor)
		 preedit-underline)
	     (anthy-lib-get-nth-candidate
	      ac-id idx
	      (nth idx (anthy-context-index-list ac))))
	    (anthy-pushback-preedit-segment-rec ac id (+ idx 1) nseg))))))

(define anthy-compose-state-preedit
  (lambda (ac id)
    (im-clear-preedit id)
    (anthy-pushback-preedit-segment-rec
     ac id
     0 (length (anthy-context-index-list ac)))
    (im-update-preedit id)))

(define anthy-input-state-preedit
  (lambda (ac id)
    (let ((rkc (anthy-context-rkc ac))
	  (kana (anthy-context-kana-mode ac)))
      (im-clear-preedit id)
      (im-pushback-preedit
       id preedit-underline
       (multi-segment-make-left-string (anthy-context-left-string ac) kana))
      (im-pushback-preedit id preedit-underline
                           (rk-pending rkc))
      (if (anthy-has-preedit? ac)
	  (im-pushback-preedit id preedit-cursor ""))
      (im-pushback-preedit
       id preedit-underline
       (multi-segment-make-right-string (anthy-context-right-string ac) kana))
      (im-update-preedit id))))
  
(define anthy-get-commit-string
  (lambda (ac idx nseg)
    (let ((ac-id (anthy-context-ac-id ac)))
      (if (< idx nseg)
	  (string-append
	   (anthy-lib-get-nth-candidate
	    ac-id idx
	    (nth idx (anthy-context-index-list ac)))
	   (anthy-get-commit-string ac (+ idx 1) nseg))
	  ""))))

(define anthy-do-commit
  (lambda (ac id)
    (anthy-reset-candidate-window ac id)
    (im-commit id
	       (anthy-get-commit-string
		ac 0
		(length (anthy-context-index-list ac))))
    (anthy-commit-string
     ac 0
     (length (anthy-context-index-list ac)))
    (anthy-flush ac)))

(define anthy-commit-string
  (lambda (ac idx nseg)
    (let ((ac-id (anthy-context-ac-id ac)))
      (if (< idx nseg)
	  (begin
	    (anthy-lib-commit-segment
	     ac-id idx (nth idx (anthy-context-index-list ac)))
	    (anthy-commit-string ac
				 (+ idx 1) nseg))
	  '()))))

(define anthy-move-segment
  (lambda (ac dir)
    (let ((pos (+ (anthy-context-cur-seg ac) dir))
	  (nseg (length (anthy-context-index-list ac))))
      (if (and
	   (> pos -1)
	   (< pos nseg))
	  (anthy-context-set-cur-seg! ac pos)))))

(define anthy-move-candidate
  (lambda (ac id offset)
    (let* ((seg (anthy-context-cur-seg ac))
	   (n (nth seg (anthy-context-index-list ac)))
	   (ac-id (anthy-context-ac-id ac))
	   (max (anthy-lib-get-nr-candidates ac-id seg)))
      (set! n (+ n offset))
      (if (>= n max)
	  (set! n 0))
      (if (< n 0)
	  (set! n (- max 1)))
      (set-car! (nthcdr seg (anthy-context-index-list ac)) n)
      (anthy-context-set-candidate-op-count!
       ac
       (+ 1 (anthy-context-candidate-op-count ac)))
      (if (and
	   (= (anthy-context-candidate-op-count ac)
	      anthy-candidate-op-count)
	   anthy-use-candidate-window?)
	  (begin
	    (anthy-context-set-candidate-window! ac #t)
	    (im-activate-candidate-selector
	     id
	     max anthy-nr-candidate-max)))
      (if (anthy-context-candidate-window ac)
	  (im-select-candidate id n)))))

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

(define anthy-resize-segment
  (lambda (ac id cnt)
    (let
	((ac-id (anthy-context-ac-id ac)))
      (anthy-reset-candidate-window ac id)
      (anthy-lib-resize-segment
       ac-id (anthy-context-cur-seg ac) cnt)
      (anthy-context-set-index-list!
       ac
       (multi-segment-make-index-list
	(anthy-lib-get-nr-segments ac-id)
	(truncate-list
	 (anthy-context-index-list ac)
	 (anthy-context-cur-seg ac))))
      )))

;; 'compose' means 'converting' here
(define anthy-proc-compose-state
  (lambda (ac id key key-state)
    (cond
     ((anthy-commit-key? key key-state)
      (anthy-do-commit ac id))
     
     ((anthy-extend-segment-key? key key-state)
      (anthy-resize-segment ac id 1))
     
     ((anthy-shrink-segment-key? key key-state)
      (anthy-resize-segment ac id -1))
     
     ((anthy-next-segment-key? key key-state)
      (begin
	(anthy-move-segment ac 1)
	(anthy-reset-candidate-window ac id)))
     
     ((anthy-prev-segment-key? key key-state)
      (begin
	(anthy-move-segment ac -1)
	(anthy-reset-candidate-window ac id)))

     ((anthy-beginning-of-preedit-key? key key-state)
      (begin
	(anthy-context-set-cur-seg! ac 0)
	(anthy-reset-candidate-window ac id)))

     ((anthy-end-of-preedit-key? key key-state)
      (let ((nseg (length (anthy-context-index-list ac))))
	(anthy-context-set-cur-seg! ac (- nseg 1))
	(anthy-reset-candidate-window ac id)))

     ((anthy-backspace-key? key key-state)
      (begin
	(anthy-context-set-state! ac #f)
	(anthy-reset-candidate-window ac id)))

     ((anthy-next-candidate-key? key key-state)
      (anthy-move-candidate ac id 1))

     ((anthy-prev-candidate-key? key key-state)
      (anthy-move-candidate ac id -1))

     ((anthy-cancel-key? key key-state)
      (begin
	(anthy-context-set-state! ac #f)
	(anthy-reset-candidate-window ac id)))

     ((anthy-prev-page-key? key key-state)
	(im-shift-page-candidate id #f))

     ((anthy-next-page-key? key key-state)
	(im-shift-page-candidate id #t))

     ;; don't discard shift-modified keys. Some of them ("?", "~",
     ;; etc) are used to implicit commit. Reported by [Anthy-dev 745]
     ;; -- YamaKen 2004-04-08
     ((and (modifier-key-mask key-state)
	   (not (shift-key-mask key-state)))
      #f)  ;; use #f rather than () to conform to R5RS

     ((symbol? key)
      #f)

     (else
      (begin
	(anthy-do-commit ac id)
	(anthy-proc-input-state ac id key key-state))))))

(define anthy-proc-wide-latin
  (lambda (c key key-state)
    (let* ((char (charcode->string key))
	   (w (or (ja-direct char)
		  (ja-wide char)))
	   (id (context-id c))
	   (ac (context-data c)))
      (cond
       ((anthy-on-key? key key-state)
	(anthy-flush ac)
	(anthy-update-mode ac id)
	(anthy-update-prop-label ac id))
       ((and (modifier-key-mask key-state)
	     (not (shift-key-mask key-state)))
	(anthy-commit-raw ac id))
       (w
	(im-commit id w))
       (else
	(anthy-commit-raw ac id)))
      ())))

(define anthy-press-key-handler
  (lambda (id key key-state)
    (let* ((c (find-context id))
	   (ac (context-data c)))
      (if (control-char? key)
	  (im-commit-raw id)
	  (if (anthy-context-on ac)
	      (if (anthy-context-state ac)
		  (anthy-proc-compose-state ac id key key-state)
		  (anthy-proc-input-state ac id key key-state))
	      (if (anthy-context-wide-latin ac)
		  (anthy-proc-wide-latin c key key-state)
		  (anthy-proc-raw-state c key key-state))))
      ;; preedit
      (anthy-update-preedit ac id))))


(define anthy-release-key-handler
  (lambda (id key key-state)
    (let* ((c (find-context id))
	   (ac (context-data c)))
      (if (or (control-char? key)
	      (and
	       (not (anthy-context-on ac))
	       (not (anthy-context-wide-latin ac))))
	  ;; don't discard key release event for apps
	  (anthy-commit-raw ac id)))))

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

(define anthy-get-candidate-handler
  (lambda (id idx accel-enum-hint)
    (let* ((c (find-context id))
	   (ac (context-data c))
	   (ac-id (anthy-context-ac-id ac))
	   (cand (anthy-lib-get-nth-candidate
		  ac-id (anthy-context-cur-seg ac) idx)))
      (list cand (digit->string (+ idx 1))))))

(define anthy-set-candidate-index-handler
  (lambda (id idx)
    (let* ((c (find-context id))
	   (ac (context-data c))
	   (seg (anthy-context-cur-seg ac))
	   (ac-id (anthy-context-ac-id ac)))
      (set-car! (nthcdr seg (anthy-context-index-list ac)) idx)
;      (anthy-reset-candidate-window ac id)
;      (anthy-move-segment ac 1)
      (anthy-update-preedit ac id))))

(define anthy-prop-handler
  (lambda (id message)
    (let* ((c (find-context id))
	   (ac (context-data c)))
      (anthy-flush ac)
      (anthy-update-preedit ac id)
      (cond
       ((string=? message
		       "prop_anthy_hiragana")
	(begin
	  (anthy-context-set-on! ac #t)
	  (anthy-context-set-kana-mode! ac anthy-type-hiragana)))
       ((string=? message
		       "prop_anthy_katakana")
	(begin
	  (anthy-context-set-on! ac #t)
	  (anthy-context-set-kana-mode! ac anthy-type-katakana)))
       ((string=? message
		       "prop_anthy_hankana")
	(begin
	  (anthy-context-set-on! ac #t)
	  (anthy-context-set-kana-mode! ac anthy-type-hankana)))
       ((string=? message
		       "prop_anthy_direct")
	(begin
	  (anthy-context-set-on! ac #f)
	  (anthy-context-set-wide-latin! ac #f)))
       ((string=? message
		       "prop_anthy_zenkaku")
	(begin
	  (anthy-context-set-on! ac #f)
	  (anthy-context-set-wide-latin! ac #t)))
       ((string=? message
		       "prop_anthy_kana")
	(begin
	  (load-kana-table))))
      (anthy-update-mode ac id)
      (anthy-update-prop-label ac id))))

(define anthy-update-prop-label
  (lambda (ac id)
    (let ((str "")
	  (kana (anthy-context-kana-mode ac)))
      (set! str
	    (if (anthy-context-on ac)
		(cond
		 ((= kana anthy-type-hiragana)
		  "あ\tひらがな\n")
		 ((= kana anthy-type-katakana)
		  "ア\tカタカナ\n")
		  ((= kana anthy-type-hankana)
		   "ｱ\t半角カタカナ\n"))
		(if (anthy-context-wide-latin ac)
		    "ａ\t全角英数\n"
		    "a\t直接入力\n")))
      (set! str (string-append str "Ｒ\t入力モード\n"))
      (im-update-prop-label id str))))

(define anthy-update-mode
  (lambda (ac id)
    (if (anthy-context-on ac)
	(let ((kana (anthy-context-kana-mode ac)))
	  (cond
	   ((= kana anthy-type-hiragana)
	    (im-update-mode id anthy-mode-hiragana))
	   ((= kana anthy-type-katakana)
	    (im-update-mode id anthy-mode-katakana))
	   ((= kana anthy-type-hankana)
	    (im-update-mode id anthy-mode-hankana))))
	(if (anthy-context-wide-latin ac)
	    (im-update-mode id anthy-mode-wide-latin)
	    (im-update-mode id anthy-mode-direct)))
    (anthy-update-prop-label ac id)))

(define anthy-update-prop-list
  (lambda (id) 
    (let* ((c (find-context id))
	   (ac (context-data c))
	   (str "branch\t"))
      (set! str (string-append str
			       (if (anthy-context-on ac)
				   "あ\tひらがな\n"
				   (if (anthy-context-wide-latin ac)
				       "ａ\t全角英数\n"
				       "a\t直接入力\n"))))
      (set! str (string-append
		 str
		 "leaf\tあ\tひらがな\tひらがなです\tprop_anthy_hiragana\n"
		 "leaf\tア\tカタカナ\tカタカナで入力できます\tprop_anthy_katakana\n"
		 "leaf\tｱ\t半角カタカナ\t半角カタカナで入力できます\tprop_anthy_hankana\n"
		 "leaf\tA\t直接入力\tダイレクトです\tprop_anthy_direct\n"
		 "leaf\tａ\t全角英数\t全角英数モード\tprop_anthy_zenkaku\n"
		 "branch\tＲ\t入力方式\n"
		 "leaf\tＲ\tローマ字\tdesc\tprop_anthy_roma\n"
		 "leaf\tか\tかな\tかな入力\tprop_anthy_kana\n"))
      (im-update-prop-list id str)
      )))

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