1;;; yahoo-jp.scm: yahoo-jp for uim.
2;;;
3;;; Copyright (c) 2008-2013 uim Project https://github.com/uim/uim
4;;;
5;;; All rights reserved.
6;;;
7;;; Redistribution and use in source and binary forms, with or without
8;;; modification, are permitted provided that the following conditions
9;;; are met:
10;;; 1. Redistributions of source code must retain the above copyright
11;;;    notice, this list of conditions and the following disclaimer.
12;;; 2. Redistributions in binary form must reproduce the above copyright
13;;;    notice, this list of conditions and the following disclaimer in the
14;;;    documentation and/or other materials provided with the distribution.
15;;; 3. Neither the name of authors nor the names of its contributors
16;;;    may be used to endorse or promote products derived from this software
17;;;    without specific prior written permission.
18;;;
19;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS'' AND
20;;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
21;;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
22;;; ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE
23;;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
24;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
25;;; OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
26;;; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
27;;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
28;;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
29;;; SUCH DAMAGE.
30;;;;
31
32(require-extension (srfi 1 2 6 23 34 48))
33
34(require "ustr.scm")
35(require "japanese.scm")
36(require "http-client.scm")
37(require "generic-predict.scm")
38(require "util.scm")
39(require-custom "generic-key-custom.scm")
40(require-custom "yahoo-jp-custom.scm")
41(require-custom "yahoo-jp-key-custom.scm")
42
43(require-dynlib "expat")
44
45;;; implementations
46
47;;
48;; canna emulating functions
49;;
50
51(define yahoo-jp-internal-context-rec-spec
52  (append
53   context-rec-spec
54   (list
55    (list 'yomi-seg    '())
56    (list 'candidates  '())
57    (list 'seg-cnts '())
58    (list 'prediction-word '())
59    (list 'prediction-candidates '())
60    (list 'prediction-appendix '())
61    (list 'prediction-nr '()))))
62(define-record 'yahoo-jp-internal-context yahoo-jp-internal-context-rec-spec)
63(define yahoo-jp-internal-context-new-internal yahoo-jp-internal-context-new)
64
65(define (yahoo-jp-conversion str opts)
66  (define (fromconv str)
67    (iconv-convert "UTF-8" "EUC-JP" str))
68  (define (toconv str)
69    (iconv-convert "EUC-JP" "UTF-8" str))
70  (define (make-query appid)
71    (format "~aconversion?appid=~a&sentence=~a~a"
72            yahoo-jp-path
73            appid
74            (http:encode-uri-string (fromconv str))
75            opts))
76  (define (parse str)
77    (let ((parser (xml-parser-create "UTF-8"))
78          (path '())
79          (seg '())
80          (seg-txt "")
81          (candidate '())
82          (cand-queue '()))
83      (define (elem-start name atts)
84        (set! path (append path (list name))))
85      (define (elem-end name)
86        (cond ((equal? '("ResultSet" "Result" "SegmentList" "Segment" "CandidateList")
87                       path)
88               (set! candidate (append candidate (list cand-queue)))
89               (set! cand-queue '()))
90              ((equal? '("ResultSet" "Result" "SegmentList" "Segment")
91                       path)
92               (set! seg (append seg (list seg-txt)))
93               (set! seg-txt "")))
94        (set! path (drop-right path 1)))
95      (define (chardata str)
96        (cond ((equal? '("ResultSet" "Result" "SegmentList" "Segment" "CandidateList" "Candidate")
97                       path)
98               (set! cand-queue (append cand-queue (list (toconv str)))))
99              ((equal? '("ResultSet" "Result" "SegmentList" "Segment" "SegmentText")
100                       path)
101               (set! seg-txt (toconv str)))))
102      (xml-element-handler-set! parser elem-start elem-end)
103      (xml-characterdata-handler-set! parser chardata)
104      (xml-parse parser str 1)
105      (xml-parser-free parser)
106      (cons seg candidate)))
107
108  (let* ((appid (if (string=? yahoo-jp-appid "")
109                    (begin (uim-notify-fatal (N_ "Please regist Api key from <a href='http://developer.yahoo.co.jp/'>developer network</a> and set value on advanced menu."))
110                           #f)
111                    yahoo-jp-appid))
112         (proxy (make-http-proxy-from-custom))
113         (ssl (and yahoo-jp-use-ssl?
114                   (make-http-ssl (SSLv3-client-method) 443)))
115         (ret (and appid
116                   (http:get yahoo-jp-server (make-query appid) 80 proxy ssl))))
117    (if (string? ret)
118        (parse ret)
119        (cons '() (list (list str))))))
120
121(define (yahoo-jp-predict-memoize! yc str cand)
122  (let ((cache (yahoo-jp-context-prediction-cache yc)))
123    (yahoo-jp-context-set-prediction-cache!
124     yc
125     (append (if (<= yahoo-jp-prediction-cache-words
126                     (length cache))
127                 (cdr cache)
128                 cache)
129             (list (cons str cand))))))
130(define (yahoo-jp-predict yc str opts)
131  (let ((ret (assoc str (yahoo-jp-context-prediction-cache yc))))
132    (if ret
133        (cdr ret)
134        (let ((cand (yahoo-jp-predict-from-server str opts)))
135          (if (not (null? (car cand)))
136              (yahoo-jp-predict-memoize! yc str cand))
137          cand))))
138(define (yahoo-jp-predict-from-server str opts)
139  (cadr (yahoo-jp-conversion str (string-append "&mode=predictive" opts))))
140
141(define (yahoo-jp-conversion-make-resize-query yomi-seg)
142  (let ((len (length yomi-seg)))
143    (apply string-append (map (lambda (idx)
144                                (if (= (+ idx 1) len)
145                                    (list-ref yomi-seg idx)
146                                    (string-append (list-ref yomi-seg idx) " ")))
147                              (iota len)))))
148(define (yahoo-jp-conversion-resize yomi-seg)
149  (yahoo-jp-conversion
150   (yahoo-jp-conversion-make-resize-query yomi-seg) ""))
151
152(define (yahoo-jp-lib-init)
153  #t)
154(define (yahoo-jp-lib-alloc-context)
155  (yahoo-jp-internal-context-new-internal))
156(define (yahoo-jp-lib-get-nth-candidate yc seg nth)
157  (let* ((yx-ctx (yahoo-jp-context-yx-ctx yc))
158         (cand (yahoo-jp-internal-context-candidates yx-ctx)))
159    (list-ref (list-ref cand seg) nth)))
160(define (yahoo-jp-lib-release-context yc)
161  #t)
162(define (yahoo-jp-lib-get-unconv-candidate yc seg-idx)
163  (let* ((yx-ctx (yahoo-jp-context-yx-ctx yc))
164         (cand (yahoo-jp-internal-context-candidates yx-ctx)))
165    ;; XXX
166    (car (take-right (list-ref cand seg-idx) 1))))
167(define (yahoo-jp-lib-get-nr-segments yc)
168  (let* ((yx-ctx (yahoo-jp-context-yx-ctx yc))
169         (cand (yahoo-jp-internal-context-candidates yx-ctx)))
170    (length cand)))
171(define (yahoo-jp-lib-get-nr-candidates yc seg)
172  (let* ((yx-ctx (yahoo-jp-context-yx-ctx yc))
173         (cand (yahoo-jp-internal-context-candidates yx-ctx)))
174    (length (list-ref cand seg))))
175(define (yahoo-jp-next-yomi-seg yomi-seg seg cnt)
176  (let* ((kana-str (list-ref yomi-seg seg))
177         (kana-list (reverse (string-to-list kana-str))))
178    (cond ((and (< cnt 0) ;; shrink segment
179                (< 1 (length kana-list)))
180           (let* ((not-edited-head (if (< 0 seg)
181                                       (take yomi-seg seg)
182                                       '()))
183                  (edited-head (list (apply string-append (drop-right kana-list (* -1 cnt)))))
184                  (edited-tail (if (= (+ 1 seg) (length yomi-seg)) ;; end of segments
185                                   (take-right kana-list (* -1 cnt))
186                                   (let* ((next-char (car (take-right kana-list (* -1 cnt))))
187                                          (kana-next-str (list-ref yomi-seg (+ 1 seg))))
188                                     (list (string-append next-char kana-next-str)))))
189                  (not-edited-tail (if (= (+ 1 seg) (length yomi-seg))
190                                       '()
191                                       (drop yomi-seg (+ seg 2)))))
192             (append not-edited-head edited-head edited-tail not-edited-tail)))
193          ((and (< 0 cnt) ;; stretch segment
194                (< (+ seg 1) (length yomi-seg))
195                (< 0 (length (string-to-list (list-ref yomi-seg (+ seg 1))))))
196           (let* ((next-str (list-ref yomi-seg (+ seg 1)))
197                  (next-kana-list (reverse (string-to-list next-str)))
198                  (not-edited-head (if (< 0 seg)
199                                       (take yomi-seg seg)
200                                       '()))
201                  (edited-head (list (apply string-append
202                                            (append kana-list
203                                                    (take next-kana-list cnt)))))
204                  (edited-tail (if (= 1 (length next-kana-list))
205                                   '()
206                                   (list (apply string-append (drop next-kana-list cnt)))))
207                  (not-edited-tail (if (< (length yomi-seg) 2)
208                                       '()
209                                       (drop yomi-seg (+ 2 seg)))))
210             (append not-edited-head edited-head edited-tail not-edited-tail)))
211          (else
212           yomi-seg))))
213(define (yahoo-jp-lib-resize-segment yc seg cnt)
214  (let* ((yx-ctx (yahoo-jp-context-yx-ctx yc))
215         (cand (yahoo-jp-internal-context-candidates yx-ctx))
216         (yomi-seg (yahoo-jp-internal-context-yomi-seg yx-ctx))
217         (next-yomi-seg (yahoo-jp-next-yomi-seg yomi-seg seg cnt))
218         (replace-yomi-seg-and-next-cand (yahoo-jp-conversion-resize next-yomi-seg))
219         (replace-yomi-seg (car replace-yomi-seg-and-next-cand))
220         (next-cand        (cdr replace-yomi-seg-and-next-cand)))
221    (if (and next-cand
222             (not (equal? next-cand cand)))
223        (begin
224          (yahoo-jp-internal-context-set-candidates! yx-ctx next-cand)
225          (yahoo-jp-internal-context-set-yomi-seg! yx-ctx replace-yomi-seg)))
226    #t))
227(define (yahoo-jp-lib-begin-conversion yc str)
228  (let* ((yomi-seg-and-cand (yahoo-jp-conversion str ""))
229         (yomi-seg (car yomi-seg-and-cand))
230         (cand (cdr yomi-seg-and-cand))
231         (yx-ctx (yahoo-jp-context-yx-ctx yc)))
232    (yahoo-jp-internal-context-set-yomi-seg! yx-ctx yomi-seg)
233    (yahoo-jp-internal-context-set-candidates! yx-ctx cand)
234    (length cand)))
235(define (yahoo-jp-lib-commit-segments yc delta)
236  #t)
237(define (yahoo-jp-lib-reset-conversion yc)
238  #f)
239(define (yahoo-jp-lib-set-prediction-src-string yc str)
240  (cond ((eq? yahoo-jp-prediction-type 'www)
241         (let ((yx-ctx (yahoo-jp-context-yx-ctx yc))
242               (cands (yahoo-jp-predict yc str "")))
243           (yahoo-jp-internal-context-set-prediction-candidates! yx-ctx cands)
244           (yahoo-jp-internal-context-set-prediction-nr! yx-ctx (length cands))))
245        ((eq? yahoo-jp-prediction-type 'uim)
246         (let* ((ret (predict-meta-search
247                      (yahoo-jp-context-prediction-ctx yc)
248                      str))
249                (yx-ctx (yahoo-jp-context-yx-ctx yc))
250                (word     (predict-meta-word? ret))
251                (cands    (predict-meta-candidates? ret))
252                (appendix (predict-meta-appendix? ret)))
253           (yahoo-jp-internal-context-set-prediction-word! yx-ctx word)
254           (yahoo-jp-internal-context-set-prediction-candidates! yx-ctx cands)
255           (yahoo-jp-internal-context-set-prediction-appendix! yx-ctx appendix)
256           (yahoo-jp-internal-context-set-prediction-nr! yx-ctx (length cands)))))
257  #f)
258(define (yahoo-jp-lib-get-nr-predictions yc)
259  (let ((yx-ctx (yahoo-jp-context-yx-ctx yc)))
260    (yahoo-jp-internal-context-prediction-nr yx-ctx)))
261(define (yahoo-jp-lib-get-nth-word yc nth)
262  (let* ((yx-ctx (yahoo-jp-context-yx-ctx yc))
263         (word (yahoo-jp-internal-context-prediction-word yx-ctx)))
264    (list-ref word nth)))
265(define (yahoo-jp-lib-get-nth-prediction yc nth)
266  (let* ((yx-ctx (yahoo-jp-context-yx-ctx yc))
267         (cands (yahoo-jp-internal-context-prediction-candidates yx-ctx)))
268    (list-ref cands nth)))
269(define (yahoo-jp-lib-get-nth-appendix yc nth)
270  (let* ((yx-ctx (yahoo-jp-context-yx-ctx yc))
271         (appendix (yahoo-jp-internal-context-prediction-appendix yx-ctx)))
272    (list-ref appendix nth)))
273(define (yahoo-jp-lib-commit-nth-prediction yc nth)
274  (if (eq? yahoo-jp-prediction-type 'uim)
275      (let ((yx-ctx (yahoo-jp-context-yx-ctx yc)))
276        (predict-meta-commit
277         (yahoo-jp-context-prediction-ctx yc)
278         (yahoo-jp-lib-get-nth-word yc nth)
279         (yahoo-jp-lib-get-nth-prediction yc nth)
280         (yahoo-jp-lib-get-nth-appendix yc nth))))
281  #f)
282
283(define yahoo-jp-init-lib-ok? #f)
284
285(define yahoo-jp-type-direct	   ja-type-direct)
286(define yahoo-jp-type-hiragana	   ja-type-hiragana)
287(define yahoo-jp-type-katakana	   ja-type-katakana)
288(define yahoo-jp-type-halfkana	   ja-type-halfkana)
289(define yahoo-jp-type-halfwidth-alnum ja-type-halfwidth-alnum)
290(define yahoo-jp-type-fullwidth-alnum ja-type-fullwidth-alnum)
291
292(define yahoo-jp-input-rule-roma 0)
293(define yahoo-jp-input-rule-kana 1)
294(define yahoo-jp-input-rule-azik 2)
295(define yahoo-jp-input-rule-act 3)
296(define yahoo-jp-input-rule-kzik 4)
297
298(define yahoo-jp-candidate-type-katakana -2)
299(define yahoo-jp-candidate-type-hiragana -3)
300(define yahoo-jp-candidate-type-halfkana -4)
301(define yahoo-jp-candidate-type-halfwidth-alnum -5)
302(define yahoo-jp-candidate-type-fullwidth-alnum -6)
303(define yahoo-jp-candidate-type-upper-halfwidth-alnum -7)
304(define yahoo-jp-candidate-type-upper-fullwidth-alnum -8)
305
306
307;; I don't think the key needs to be customizable.
308(define-key yahoo-jp-space-key? '(" "))
309
310(define yahoo-jp-prepare-input-rule-activation
311  (lambda (yc)
312    (cond
313     ((yahoo-jp-context-state yc)
314      (yahoo-jp-do-commit yc))
315     ((yahoo-jp-context-transposing yc)
316      (im-commit yc (yahoo-jp-transposing-text yc)))
317     ((and
318       (yahoo-jp-context-on yc)
319       (yahoo-jp-has-preedit? yc))
320      (im-commit
321       yc (yahoo-jp-make-whole-string yc #t (yahoo-jp-context-kana-mode yc)))))
322    (yahoo-jp-flush yc)
323    (yahoo-jp-update-preedit yc)))
324
325(define yahoo-jp-prepare-input-mode-activation
326  (lambda (yc new-mode)
327    (let ((old-kana (yahoo-jp-context-kana-mode yc)))
328      (cond
329       ((yahoo-jp-context-state yc)
330	(yahoo-jp-do-commit yc))
331       ((yahoo-jp-context-transposing yc)
332	(im-commit yc (yahoo-jp-transposing-text yc))
333	(yahoo-jp-flush yc))
334       ((and
335	 (yahoo-jp-context-on yc)
336	 (yahoo-jp-has-preedit? yc)
337	 (not (= old-kana new-mode)))
338	(im-commit
339	 yc (yahoo-jp-make-whole-string yc #t (yahoo-jp-context-kana-mode yc)))
340	(yahoo-jp-flush yc)))
341      (yahoo-jp-update-preedit yc))))
342
343(register-action 'action_yahoo-jp_hiragana
344		 (lambda (yc) ;; indication handler
345		   '(ja_hiragana
346		     "��"
347		     "�Ҥ餬��"
348		     "�Ҥ餬�����ϥ⡼��"))
349
350		 (lambda (yc) ;; activity predicate
351		   (and (yahoo-jp-context-on yc)
352		        (not (yahoo-jp-context-alnum yc))
353			(= (yahoo-jp-context-kana-mode yc)
354			   yahoo-jp-type-hiragana)))
355
356		 (lambda (yc) ;; action handler
357		   (yahoo-jp-prepare-input-mode-activation yc yahoo-jp-type-hiragana)
358		   (yahoo-jp-context-set-on! yc #t)
359		   (yahoo-jp-context-set-alnum! yc #f)
360		   (yahoo-jp-context-change-kana-mode! yc yahoo-jp-type-hiragana)))
361
362(register-action 'action_yahoo-jp_katakana
363		 (lambda (yc)
364		   '(ja_katakana
365		     "��"
366		     "��������"
367		     "�����������ϥ⡼��"))
368		 (lambda (yc)
369		   (and (yahoo-jp-context-on yc)
370		        (not (yahoo-jp-context-alnum yc))
371			(= (yahoo-jp-context-kana-mode yc)
372			   yahoo-jp-type-katakana)))
373		 (lambda (yc)
374		   (yahoo-jp-prepare-input-mode-activation yc yahoo-jp-type-katakana)
375		   (yahoo-jp-context-set-on! yc #t)
376		   (yahoo-jp-context-set-alnum! yc #f)
377		   (yahoo-jp-context-change-kana-mode! yc yahoo-jp-type-katakana)))
378
379(register-action 'action_yahoo-jp_halfkana
380		 (lambda (yc)
381		   '(ja_halfkana
382		     "��"
383		     "Ⱦ�ѥ�������"
384		     "Ⱦ�ѥ����������ϥ⡼��"))
385		 (lambda (yc)
386		   (and (yahoo-jp-context-on yc)
387			(not (yahoo-jp-context-alnum yc))
388			(= (yahoo-jp-context-kana-mode yc) yahoo-jp-type-halfkana)))
389		 (lambda (yc)
390		   (yahoo-jp-prepare-input-mode-activation yc yahoo-jp-type-halfkana)
391		   (yahoo-jp-context-set-on! yc #t)
392		   (yahoo-jp-context-set-alnum! yc #f)
393		   (yahoo-jp-context-change-kana-mode! yc yahoo-jp-type-halfkana)))
394
395(register-action 'action_yahoo-jp_halfwidth_alnum
396		 (lambda (yc) ;; indication handler
397		   '(ja_halfwidth_alnum
398		     "a"
399		     "Ⱦ�ѱѿ�"
400		     "Ⱦ�ѱѿ����ϥ⡼��"))
401		 (lambda (yc) ;; activity predicate
402		   (and (yahoo-jp-context-on yc)
403			(yahoo-jp-context-alnum yc)
404			(= (yahoo-jp-context-alnum-type yc)
405			   yahoo-jp-type-halfwidth-alnum)))
406		 (lambda (yc) ;; action handler
407		   (yahoo-jp-prepare-input-mode-activation
408		    yc (yahoo-jp-context-kana-mode yc))
409		   (yahoo-jp-context-set-on! yc #t)
410		   (yahoo-jp-context-set-alnum! yc #t)
411		   (yahoo-jp-context-set-alnum-type!
412		    yc yahoo-jp-type-halfwidth-alnum)))
413
414(register-action 'action_yahoo-jp_direct
415		 (lambda (yc)
416		   '(ja_direct
417		     "-"
418		     "ľ������"
419		     "ľ��(̵�Ѵ�)���ϥ⡼��"))
420		 (lambda (yc)
421		   (not (yahoo-jp-context-on yc)))
422		 (lambda (yc)
423		   (yahoo-jp-prepare-input-mode-activation yc yahoo-jp-type-direct)
424		   (yahoo-jp-context-set-on! yc #f)))
425
426(register-action 'action_yahoo-jp_fullwidth_alnum
427		 (lambda (yc)
428		   '(ja_fullwidth_alnum
429		     "��"
430		     "���ѱѿ�"
431		     "���ѱѿ����ϥ⡼��"))
432		 (lambda (yc)
433		   (and (yahoo-jp-context-on yc)
434			(yahoo-jp-context-alnum yc)
435			(= (yahoo-jp-context-alnum-type yc)
436			   yahoo-jp-type-fullwidth-alnum)))
437		 (lambda (yc)
438		   (yahoo-jp-prepare-input-mode-activation
439		    yc (yahoo-jp-context-kana-mode yc))
440		   (yahoo-jp-context-set-on! yc #t)
441		   (yahoo-jp-context-set-alnum! yc #t)
442		   (yahoo-jp-context-set-alnum-type!
443		    yc yahoo-jp-type-fullwidth-alnum)))
444
445(register-action 'action_yahoo-jp_roma
446		 (lambda (yc)
447		   '(ja_romaji
448		     "��"
449		     "���޻�"
450		     "���޻����ϥ⡼��"))
451		 (lambda (yc)
452		   (= (yahoo-jp-context-input-rule yc)
453		      yahoo-jp-input-rule-roma))
454		 (lambda (yc)
455		   (yahoo-jp-prepare-input-rule-activation yc)
456		   (rk-context-set-rule! (yahoo-jp-context-rkc yc)
457					 ja-rk-rule)
458		   (yahoo-jp-context-set-input-rule! yc yahoo-jp-input-rule-roma)))
459
460(register-action 'action_yahoo-jp_kana
461		 (lambda (yc)
462		   '(ja_kana
463		     "��"
464		     "����"
465		     "�������ϥ⡼��"))
466		 (lambda (yc)
467		   (= (yahoo-jp-context-input-rule yc)
468		      yahoo-jp-input-rule-kana))
469		 (lambda (yc)
470		   (yahoo-jp-prepare-input-rule-activation yc)
471                   (require "japanese-kana.scm")
472		   (yahoo-jp-context-set-input-rule! yc yahoo-jp-input-rule-kana)
473                   (yahoo-jp-context-change-kana-mode!
474                     yc (yahoo-jp-context-kana-mode yc))
475		   (yahoo-jp-context-set-alnum! yc #f)))
476
477(register-action 'action_yahoo-jp_azik
478		 (lambda (yc)
479		   '(ja_azik
480		     "��"
481		     "AZIK"
482		     "AZIK��ĥ���޻����ϥ⡼��"))
483		 (lambda (yc)
484		   (= (yahoo-jp-context-input-rule yc)
485		      yahoo-jp-input-rule-azik))
486		 (lambda (yc)
487		   (yahoo-jp-prepare-input-rule-activation yc)
488                   (require "japanese-azik.scm")
489		   (rk-context-set-rule! (yahoo-jp-context-rkc yc)
490					 ja-azik-rule)
491		   (yahoo-jp-context-set-input-rule! yc yahoo-jp-input-rule-azik)))
492
493(register-action 'action_yahoo-jp_kzik
494		 (lambda (yc)
495		   '(ja_kzik
496		     "��"
497		     "KZIK"
498		     "KZIK��ĥ���޻����ϥ⡼��"))
499		 (lambda (yc)
500		   (= (yahoo-jp-context-input-rule yc)
501		      yahoo-jp-input-rule-kzik))
502		 (lambda (yc)
503		   (yahoo-jp-prepare-input-rule-activation yc)
504                   (require "japanese-kzik.scm")
505		   (rk-context-set-rule! (yahoo-jp-context-rkc yc)
506					 ja-kzik-rule)
507		   (yahoo-jp-context-set-input-rule! yc yahoo-jp-input-rule-kzik)))
508
509(register-action 'action_yahoo-jp_act
510		 (lambda (yc)
511		   '(ja_act
512		     "��"
513		     "ACT"
514		     "ACT��ĥ���޻����ϥ⡼��"))
515		 (lambda (yc)
516		   (= (yahoo-jp-context-input-rule yc)
517		      yahoo-jp-input-rule-act))
518		 (lambda (yc)
519		   (yahoo-jp-prepare-input-rule-activation yc)
520                   (require "japanese-act.scm")
521		   (rk-context-set-rule! (yahoo-jp-context-rkc yc)
522					 ja-act-rule)
523		   (yahoo-jp-context-set-input-rule! yc yahoo-jp-input-rule-act)))
524
525;; Update widget definitions based on action configurations. The
526;; procedure is needed for on-the-fly reconfiguration involving the
527;; custom API
528(define yahoo-jp-configure-widgets
529  (lambda ()
530    (register-widget 'widget_yahoo-jp_input_mode
531		     (activity-indicator-new yahoo-jp-input-mode-actions)
532		     (actions-new yahoo-jp-input-mode-actions))
533
534    (register-widget 'widget_yahoo-jp_kana_input_method
535		     (activity-indicator-new yahoo-jp-kana-input-method-actions)
536		     (actions-new yahoo-jp-kana-input-method-actions))
537    (context-list-replace-widgets! 'yahoo-jp yahoo-jp-widgets)))
538
539(define yahoo-jp-context-rec-spec
540  (append
541   context-rec-spec
542   (list
543    (list 'on                 #f)
544    (list 'state              #f)
545    (list 'transposing        #f)
546    (list 'transposing-type    0)
547    (list 'predicting         #f)
548    (list 'yx-ctx             ()) ;; yahoo-jp-internal-context
549    (list 'preconv-ustr	      #f) ;; preedit strings
550    (list 'rkc                ())
551    (list 'segments	      #f) ;; ustr of candidate indices
552    (list 'candidate-window   #f)
553    (list 'candidate-op-count 0)
554    (list 'prediction-ctx     '())
555    (list 'prediction-window  #f)
556    (list 'prediction-index   #f)
557    (list 'prediction-cache   '())
558    (list 'kana-mode          yahoo-jp-type-hiragana)
559    (list 'alnum	      #f)
560    (list 'alnum-type	      yahoo-jp-type-halfwidth-alnum)
561    (list 'commit-raw         #t)
562    (list 'input-rule         yahoo-jp-input-rule-roma)
563    (list 'raw-ustr	      #f))))
564(define-record 'yahoo-jp-context yahoo-jp-context-rec-spec)
565(define yahoo-jp-context-new-internal yahoo-jp-context-new)
566
567(define (yahoo-jp-context-new id im)
568  (let ((yc (yahoo-jp-context-new-internal id im))
569	(rkc (rk-context-new ja-rk-rule #t #f)))
570;    (yahoo-jp-context-set-yx-ctx! yc (if yahoo-jp-init-lib-ok?
571;				      (yahoo-jp-lib-alloc-context) ()))
572    (yahoo-jp-context-set-yx-ctx! yc (yahoo-jp-lib-alloc-context))
573    (yahoo-jp-context-set-widgets! yc yahoo-jp-widgets)
574    (yahoo-jp-context-set-rkc! yc rkc)
575    (yahoo-jp-context-set-preconv-ustr! yc (ustr-new '()))
576    (yahoo-jp-context-set-raw-ustr! yc (ustr-new '()))
577    (yahoo-jp-context-set-segments! yc (ustr-new '()))
578    (if (and yahoo-jp-use-prediction?
579             (eq? yahoo-jp-prediction-type 'uim))
580        (begin
581          (yahoo-jp-context-set-prediction-ctx! yc (predict-make-meta-search))
582          (predict-meta-open (yahoo-jp-context-prediction-ctx yc) "yahoo-jp")
583          (predict-meta-set-external-charset! (yahoo-jp-context-prediction-ctx yc) "EUC-JP")))
584    yc))
585
586(define (yahoo-jp-commit-raw yc)
587  (im-commit-raw yc)
588  (yahoo-jp-context-set-commit-raw! yc #t))
589
590(define (yahoo-jp-context-kana-toggle yc)
591  (let* ((kana (yahoo-jp-context-kana-mode yc))
592	 (opposite-kana (ja-opposite-kana kana)))
593    (yahoo-jp-context-change-kana-mode! yc opposite-kana)))
594
595(define yahoo-jp-context-alkana-toggle
596  (lambda (yc)
597    (let ((alnum-state (yahoo-jp-context-alnum yc)))
598      (yahoo-jp-context-set-alnum! yc (not alnum-state)))))
599
600(define yahoo-jp-context-change-kana-mode!
601  (lambda (yc kana-mode)
602    (if (= (yahoo-jp-context-input-rule yc)
603           yahoo-jp-input-rule-kana)
604        (rk-context-set-rule!
605	 (yahoo-jp-context-rkc yc)
606	 (cond
607	  ((= kana-mode yahoo-jp-type-hiragana) ja-kana-hiragana-rule)
608	  ((= kana-mode yahoo-jp-type-katakana) ja-kana-katakana-rule)
609	  ((= kana-mode yahoo-jp-type-halfkana) ja-kana-halfkana-rule))))
610    (yahoo-jp-context-set-kana-mode! yc kana-mode)))
611
612(define yahoo-jp-make-whole-string
613  (lambda (yc convert-pending-into-kana? kana)
614    (let* ((rkc (yahoo-jp-context-rkc yc))
615           (pending (rk-pending rkc))
616           (residual-kana (rk-peek-terminal-match rkc))
617           (rule (yahoo-jp-context-input-rule yc))
618           (preconv-str (yahoo-jp-context-preconv-ustr yc))
619           (extract-kana
620            (if (= rule yahoo-jp-input-rule-kana)
621                (lambda (entry) (car entry))
622                (lambda (entry) (list-ref entry kana)))))
623
624      (if (= rule yahoo-jp-input-rule-kana)
625	  (ja-make-kana-str
626	   (ja-make-kana-str-list
627	    (string-to-list
628	     (string-append
629	      (string-append-map-ustr-former extract-kana preconv-str)
630	      (if convert-pending-into-kana?
631		  (if residual-kana
632                    (if (list? (car residual-kana))
633                      (string-append-map extract-kana residual-kana)
634		      (extract-kana residual-kana))
635                    pending)
636		  pending)
637              (string-append-map-ustr-latter extract-kana preconv-str))))
638	   kana)
639          (string-append
640	   (string-append-map-ustr-former extract-kana preconv-str)
641           (if convert-pending-into-kana?
642               (if residual-kana
643                 (if (list? (car residual-kana))
644                   (string-append-map extract-kana residual-kana)
645                   (extract-kana residual-kana))
646                 "")
647               pending)
648           (string-append-map-ustr-latter extract-kana preconv-str))))))
649
650(define yahoo-jp-make-raw-string
651  (lambda (raw-str-list wide? upper?)
652    (if (not (null? raw-str-list))
653	(if wide?
654	    (string-append
655	     (ja-string-list-to-wide-alphabet
656	      (if upper?
657		  (map charcode->string
658		       (map ichar-upcase
659			    (map string->charcode
660				 (string-to-list (car raw-str-list)))))
661		  (string-to-list (car raw-str-list))))
662	     (yahoo-jp-make-raw-string (cdr raw-str-list) wide? upper?))
663	    (string-append
664	     (if upper?
665		 (string-list-concat
666		  (map charcode->string
667		       (map ichar-upcase
668			    (map string->charcode
669				 (string-to-list (car raw-str-list))))))
670		 (car raw-str-list))
671	     (yahoo-jp-make-raw-string (cdr raw-str-list) wide? upper?)))
672	"")))
673
674(define yahoo-jp-make-whole-raw-string
675  (lambda (yc wide? upper?)
676    (yahoo-jp-make-raw-string (yahoo-jp-get-raw-str-seq yc) wide? upper?)))
677
678(define (yahoo-jp-init-handler id im arg)
679  (if (not yahoo-jp-init-lib-ok?)
680      (begin
681	(yahoo-jp-lib-init)
682	(set! yahoo-jp-init-lib-ok? #t)))
683  (yahoo-jp-context-new id im))
684
685(define (yahoo-jp-release-handler yc)
686  (if yc
687      (yahoo-jp-lib-release-context yc)))
688
689(define (yahoo-jp-flush yc)
690  (rk-flush (yahoo-jp-context-rkc yc))
691  (ustr-clear! (yahoo-jp-context-preconv-ustr yc))
692  (ustr-clear! (yahoo-jp-context-raw-ustr yc))
693  (ustr-clear! (yahoo-jp-context-segments yc))
694  (yahoo-jp-context-set-transposing! yc #f)
695  (yahoo-jp-context-set-state! yc #f)
696  (if (or
697       (yahoo-jp-context-candidate-window yc)
698       (yahoo-jp-context-prediction-window yc))
699      (im-deactivate-candidate-selector yc))
700  (yahoo-jp-context-set-candidate-window! yc #f)
701  (yahoo-jp-context-set-prediction-window! yc #f)
702  (yahoo-jp-context-set-candidate-op-count! yc 0))
703
704(define (yahoo-jp-begin-input yc key key-state)
705  (if (cond
706       ((yahoo-jp-on-key? key key-state)
707	#t)
708       ((and
709	 yahoo-jp-use-mode-transition-keys-in-off-mode?
710	 (cond
711	  ((yahoo-jp-hiragana-key? key key-state)
712	   (yahoo-jp-context-set-kana-mode! yc yahoo-jp-type-hiragana)
713	   (yahoo-jp-context-set-alnum! yc #f)
714	   #t)
715	  ((yahoo-jp-katakana-key? key key-state)
716	   (yahoo-jp-context-set-kana-mode! yc yahoo-jp-type-katakana)
717	   (yahoo-jp-context-set-alnum! yc #f)
718	   #t)
719	  ((yahoo-jp-halfkana-key? key key-state)
720	   (yahoo-jp-context-set-kana-mode! yc yahoo-jp-type-halfkana)
721	   (yahoo-jp-context-set-alnum! yc #f)
722	   #t)
723	  ((yahoo-jp-halfwidth-alnum-key? key key-state)
724	   (yahoo-jp-context-set-alnum-type! yc yahoo-jp-type-halfwidth-alnum)
725	   (yahoo-jp-context-set-alnum! yc #t)
726	   #t)
727	  ((yahoo-jp-halfwidth-alnum-key? key key-state)
728	   (yahoo-jp-context-set-alnum-type! yc yahoo-jp-type-fullwidth-alnum)
729	   (yahoo-jp-context-set-alnum! yc #t)
730	   #t)
731	  ((yahoo-jp-kana-toggle-key? key key-state)
732	   (yahoo-jp-context-kana-toggle yc)
733	   (yahoo-jp-context-set-alnum! yc #f)
734	   #t)
735	  ((yahoo-jp-alkana-toggle-key? key key-state)
736	   (yahoo-jp-context-alkana-toggle yc)
737	   #t)
738	  (else
739	   #f))))
740       (else
741	#f))
742      (begin
743	(yahoo-jp-context-set-on! yc #t)
744	(rk-flush (yahoo-jp-context-rkc yc))
745	(yahoo-jp-context-set-state! yc #f)
746	#t)
747      #f))
748
749(define (yahoo-jp-update-preedit yc)
750  (if (not (yahoo-jp-context-commit-raw yc))
751      (let ((segments (if (yahoo-jp-context-on yc)
752			  (if (yahoo-jp-context-transposing yc)
753			      (yahoo-jp-context-transposing-state-preedit yc)
754			      (if (yahoo-jp-context-state yc)
755				  (yahoo-jp-compose-state-preedit yc)
756                                  (if (yahoo-jp-context-predicting yc)
757                                      (yahoo-jp-predicting-state-preedit yc)
758                                      (yahoo-jp-input-state-preedit yc))))
759			  ())))
760	(context-update-preedit yc segments))
761      (yahoo-jp-context-set-commit-raw! yc #f)))
762
763(define (yahoo-jp-begin-conv yc)
764  (let ((yx-ctx (yahoo-jp-context-yx-ctx yc))
765	(preconv-str (yahoo-jp-make-whole-string yc #t yahoo-jp-type-hiragana)))
766    (if (and yx-ctx
767             (> (string-length preconv-str) 0))
768	(let ((num (yahoo-jp-lib-begin-conversion yc preconv-str)))
769	  (if num
770	      (begin
771		(ustr-set-latter-seq!
772		 (yahoo-jp-context-segments yc)
773		 (make-list num 0))
774		(yahoo-jp-context-set-state! yc #t)
775		;; Don't perform rk-flush here. The rkc must be restored when
776		;; yahoo-jp-cancel-conv invoked -- YamaKen 2004-10-25
777		))))))
778
779(define yahoo-jp-cancel-conv
780  (lambda (yc)
781    (yahoo-jp-reset-candidate-window yc)
782    (yahoo-jp-context-set-state! yc #f)
783    (ustr-clear! (yahoo-jp-context-segments yc))
784    (yahoo-jp-lib-reset-conversion yc)))
785
786(define (yahoo-jp-proc-input-state-no-preedit yc key key-state)
787  (let
788      ((rkc (yahoo-jp-context-rkc yc))
789       (direct (ja-direct (charcode->string key)))
790       (rule (yahoo-jp-context-input-rule yc)))
791    (cond
792     ((and yahoo-jp-use-with-vi?
793           (yahoo-jp-vi-escape-key? key key-state))
794      (yahoo-jp-flush yc)
795      (yahoo-jp-context-set-on! yc #f)
796      (yahoo-jp-commit-raw yc))
797
798     ((yahoo-jp-off-key? key key-state)
799      (yahoo-jp-flush yc)
800      (yahoo-jp-context-set-on! yc #f))
801
802     ((yahoo-jp-backspace-key? key key-state)
803      (yahoo-jp-commit-raw yc))
804
805     ((yahoo-jp-delete-key? key key-state)
806      (yahoo-jp-commit-raw yc))
807
808     ((and
809       (yahoo-jp-hiragana-key? key key-state)
810       (not
811        (and
812	 (= (yahoo-jp-context-kana-mode yc) yahoo-jp-type-hiragana)
813	 (not (yahoo-jp-context-alnum yc)))))
814      (yahoo-jp-context-change-kana-mode! yc yahoo-jp-type-hiragana)
815      (yahoo-jp-context-set-alnum! yc #f))
816
817     ((and
818       (yahoo-jp-katakana-key? key key-state)
819       (not
820        (and
821	 (= (yahoo-jp-context-kana-mode yc) yahoo-jp-type-katakana)
822	 (not (yahoo-jp-context-alnum yc)))))
823      (yahoo-jp-context-change-kana-mode! yc yahoo-jp-type-katakana)
824      (yahoo-jp-context-set-alnum! yc #f))
825
826     ((and
827       (yahoo-jp-halfkana-key? key key-state)
828       (not
829        (and
830	 (= (yahoo-jp-context-kana-mode yc) yahoo-jp-type-halfkana)
831	 (not (yahoo-jp-context-alnum yc)))))
832      (yahoo-jp-context-change-kana-mode! yc yahoo-jp-type-halfkana)
833      (yahoo-jp-context-set-alnum! yc #f))
834
835     ((and
836       (yahoo-jp-halfwidth-alnum-key? key key-state)
837       (not
838        (and
839	 (= (yahoo-jp-context-alnum-type yc) yahoo-jp-type-halfwidth-alnum)
840	 (yahoo-jp-context-alnum yc))))
841      (yahoo-jp-context-set-alnum-type! yc yahoo-jp-type-halfwidth-alnum)
842      (yahoo-jp-context-set-alnum! yc #t))
843
844     ((and
845       (yahoo-jp-fullwidth-alnum-key? key key-state)
846       (not
847        (and
848	 (= (yahoo-jp-context-alnum-type yc) yahoo-jp-type-fullwidth-alnum)
849	 (yahoo-jp-context-alnum yc))))
850      (yahoo-jp-context-set-alnum-type! yc yahoo-jp-type-fullwidth-alnum)
851      (yahoo-jp-context-set-alnum! yc #t))
852
853     ((and
854       (not (yahoo-jp-context-alnum yc))
855       (yahoo-jp-kana-toggle-key? key key-state))
856      (yahoo-jp-context-kana-toggle yc))
857
858     ((yahoo-jp-alkana-toggle-key? key key-state)
859      (yahoo-jp-context-alkana-toggle yc))
860
861     ;; modifiers (except shift) => ignore
862     ((and (modifier-key-mask key-state)
863	   (not (shift-key-mask key-state)))
864      (yahoo-jp-commit-raw yc))
865
866     ;; direct key => commit
867     (direct
868      (im-commit yc direct))
869
870     ;; space key
871     ((yahoo-jp-space-key? key key-state)
872      (if (yahoo-jp-context-alnum yc)
873	  (im-commit yc (list-ref
874			 ja-alnum-space
875			 (- (yahoo-jp-context-alnum-type yc)
876			    yahoo-jp-type-halfwidth-alnum)))
877	  (im-commit yc (list-ref ja-space (yahoo-jp-context-kana-mode yc)))))
878
879     ((symbol? key)
880      (yahoo-jp-commit-raw yc))
881
882     (else
883      (if (yahoo-jp-context-alnum yc)
884          (let ((key-str (charcode->string key)))
885	    (ustr-insert-elem! (yahoo-jp-context-preconv-ustr yc)
886			       (if (= (yahoo-jp-context-alnum-type yc)
887				      yahoo-jp-type-halfwidth-alnum)
888			       (list key-str key-str key-str)
889			       (list (ja-wide key-str) (ja-wide key-str)
890				     (ja-wide key-str))))
891	    (ustr-insert-elem! (yahoo-jp-context-raw-ustr yc) key-str))
892	  (let* ((key-str (charcode->string
893		           (if (= rule yahoo-jp-input-rule-kana)
894			       key
895			       (ichar-downcase key))))
896	         (res (rk-push-key! rkc key-str)))
897	    (if res
898	        (begin
899                  (if (list? (car res))
900                    (ustr-insert-seq! (yahoo-jp-context-preconv-ustr yc) res)
901                    (ustr-insert-elem! (yahoo-jp-context-preconv-ustr yc) res))
902	          (ustr-insert-elem! (yahoo-jp-context-raw-ustr yc) key-str))
903	        (if (null? (rk-context-seq rkc))
904		    (yahoo-jp-commit-raw yc)))))))))
905
906(define (yahoo-jp-has-preedit? yc)
907  (or (not (ustr-empty? (yahoo-jp-context-preconv-ustr yc)))
908      (> (string-length (rk-pending (yahoo-jp-context-rkc yc))) 0)))
909
910(define yahoo-jp-rotate-transposing-alnum-type
911  (lambda (cur-type state)
912    (cond
913     ((and
914       (= cur-type yahoo-jp-type-halfwidth-alnum)
915       (= state yahoo-jp-type-halfwidth-alnum))
916      yahoo-jp-candidate-type-upper-halfwidth-alnum)
917     ((and
918       (= cur-type yahoo-jp-type-fullwidth-alnum)
919       (= state yahoo-jp-type-fullwidth-alnum))
920      yahoo-jp-candidate-type-upper-fullwidth-alnum)
921     (else
922      state))))
923
924(define yahoo-jp-proc-transposing-state
925  (lambda (yc key key-state)
926    (let ((rotate-list '())
927	  (state #f))
928      (if (yahoo-jp-transpose-as-fullwidth-alnum-key? key key-state)
929	  (set! rotate-list (cons yahoo-jp-type-fullwidth-alnum rotate-list)))
930      (if (yahoo-jp-transpose-as-halfwidth-alnum-key? key key-state)
931	  (set! rotate-list (cons yahoo-jp-type-halfwidth-alnum rotate-list)))
932      (if (yahoo-jp-transpose-as-halfkana-key? key key-state)
933	  (set! rotate-list (cons yahoo-jp-type-halfkana rotate-list)))
934      (if (yahoo-jp-transpose-as-katakana-key? key key-state)
935	  (set! rotate-list (cons yahoo-jp-type-katakana rotate-list)))
936      (if (yahoo-jp-transpose-as-hiragana-key? key key-state)
937	  (set! rotate-list (cons yahoo-jp-type-hiragana rotate-list)))
938
939      (if (yahoo-jp-context-transposing yc)
940	  (let ((lst (member (yahoo-jp-context-transposing-type yc) rotate-list)))
941	    (if (and lst
942	    	     (not (null? (cdr lst))))
943		(set! state (car (cdr lst)))
944		(if (not (null? rotate-list))
945		    (set! state (yahoo-jp-rotate-transposing-alnum-type
946				 (yahoo-jp-context-transposing-type yc)
947				 (car rotate-list))))))
948	  (begin
949	    (yahoo-jp-context-set-transposing! yc #t)
950	    (set! state (car rotate-list))))
951
952      (cond
953       ((and state
954	     (or
955	      (= state yahoo-jp-type-hiragana)
956	      (= state yahoo-jp-type-katakana)
957	      (= state yahoo-jp-type-halfkana)))
958	(yahoo-jp-context-set-transposing-type! yc state))
959       ((and state
960	     (or
961	      (= state yahoo-jp-type-halfwidth-alnum)
962	      (= state yahoo-jp-candidate-type-upper-halfwidth-alnum)
963	      (= state yahoo-jp-type-fullwidth-alnum)
964	      (= state yahoo-jp-candidate-type-upper-fullwidth-alnum)))
965	(if (not (= (yahoo-jp-context-input-rule yc) yahoo-jp-input-rule-kana))
966	    (yahoo-jp-context-set-transposing-type! yc state)))
967       (else
968	(and
969	 ; commit
970	 (if (yahoo-jp-commit-key? key key-state)
971	     (begin
972	       (im-commit yc (yahoo-jp-transposing-text yc))
973	       (yahoo-jp-flush yc)
974	       #f)
975	     #t)
976	 ; begin-conv
977	 (if (yahoo-jp-begin-conv-key? key key-state)
978	     (begin
979	       (yahoo-jp-context-set-transposing! yc #f)
980	       (yahoo-jp-begin-conv yc)
981	       #f)
982	     #t)
983	 ; cancel
984	 (if (or
985	      (yahoo-jp-cancel-key? key key-state)
986	      (yahoo-jp-backspace-key? key key-state))
987	     (begin
988	       (yahoo-jp-context-set-transposing! yc #f)
989	       #f)
990	     #t)
991	 ; ignore
992	 (if (or
993	      (yahoo-jp-prev-page-key? key key-state)
994	      (yahoo-jp-next-page-key? key key-state)
995	      (yahoo-jp-extend-segment-key? key key-state)
996	      (yahoo-jp-shrink-segment-key? key key-state)
997	      (yahoo-jp-next-segment-key? key key-state)
998	      (yahoo-jp-beginning-of-preedit-key? key key-state)
999	      (yahoo-jp-end-of-preedit-key? key key-state)
1000	      (yahoo-jp-next-candidate-key? key key-state)
1001	      (yahoo-jp-prev-candidate-key? key key-state)
1002	      (and
1003	       (modifier-key-mask key-state)
1004	       (not (shift-key-mask key-state)))
1005	      (symbol? key))
1006	     #f
1007	     #t)
1008	 ; implicit commit
1009	 (begin
1010	   (im-commit yc (yahoo-jp-transposing-text yc))
1011	   (yahoo-jp-flush yc)
1012	   (yahoo-jp-proc-input-state yc key key-state))))))))
1013
1014(define (yahoo-jp-move-prediction yc offset)
1015  (let* ((nr (yahoo-jp-lib-get-nr-predictions yc))
1016         (idx (yahoo-jp-context-prediction-index yc))
1017         (n (if (not idx)
1018		0
1019		(+ idx offset)))
1020         (compensated-n (cond
1021			 ((>= n nr)
1022			  0)
1023			 ((< n 0)
1024			  (- nr 1))
1025			 (else
1026			  n))))
1027    (im-select-candidate yc compensated-n)
1028    (yahoo-jp-context-set-prediction-index! yc compensated-n)))
1029
1030(define (yahoo-jp-move-prediction-in-page yc numeralc)
1031  (let* ((nr (yahoo-jp-lib-get-nr-predictions yc))
1032	 (p-idx (yahoo-jp-context-prediction-index yc))
1033	 (n (if (not p-idx)
1034		0
1035		p-idx))
1036	 (cur-page (if (= yahoo-jp-nr-candidate-max 0)
1037		       0
1038		       (quotient n yahoo-jp-nr-candidate-max)))
1039	 (pageidx (- (numeric-ichar->integer numeralc) 1))
1040	 (compensated-pageidx (cond
1041			       ((< pageidx 0) ; pressing key_0
1042				(+ pageidx 10))
1043			       (else
1044				pageidx)))
1045	 (idx (+ (* cur-page yahoo-jp-nr-candidate-max) compensated-pageidx))
1046	 (compensated-idx (cond
1047			   ((>= idx nr)
1048			    #f)
1049			   (else
1050			    idx)))
1051	 (selected-pageidx (if (not p-idx)
1052			       #f
1053			       (if (= yahoo-jp-nr-candidate-max 0)
1054				   p-idx
1055				   (remainder p-idx
1056					      yahoo-jp-nr-candidate-max)))))
1057    (if (and
1058	 compensated-idx
1059	 (not (eqv? compensated-pageidx selected-pageidx)))
1060	(begin
1061	  (yahoo-jp-context-set-prediction-index! yc compensated-idx)
1062	  (im-select-candidate yc compensated-idx)
1063	  #t)
1064	#f)))
1065
1066(define (yahoo-jp-prediction-select-non-existing-index? yc numeralc)
1067  (let* ((nr (yahoo-jp-lib-get-nr-predictions yc))
1068	 (p-idx (yahoo-jp-context-prediction-index yc))
1069	 (cur-page (if (= yahoo-jp-nr-candidate-max 0)
1070		       0
1071		       (quotient p-idx yahoo-jp-nr-candidate-max)))
1072	 (pageidx (- (numeric-ichar->integer numeralc) 1))
1073	 (compensated-pageidx (cond
1074			       ((< pageidx 0) ; pressing key_0
1075				(+ pageidx 10))
1076			       (else
1077				pageidx)))
1078	 (idx (+ (* cur-page yahoo-jp-nr-candidate-max) compensated-pageidx)))
1079    (if (>= idx nr)
1080        #t
1081        #f)))
1082
1083(define (yahoo-jp-prediction-keys-handled? yc key key-state)
1084  (cond
1085   ((yahoo-jp-next-prediction-key? key key-state)
1086    (yahoo-jp-move-prediction yc 1)
1087    #t)
1088   ((yahoo-jp-prev-prediction-key? key key-state)
1089    (yahoo-jp-move-prediction yc -1)
1090    #t)
1091   ((and
1092     yahoo-jp-select-prediction-by-numeral-key?
1093     (ichar-numeric? key))
1094    (yahoo-jp-move-prediction-in-page yc key))
1095   ((and
1096     (yahoo-jp-context-prediction-index yc)
1097     (yahoo-jp-prev-page-key? key key-state))
1098    (im-shift-page-candidate yc #f)
1099    #t)
1100   ((and
1101     (yahoo-jp-context-prediction-index yc)
1102     (yahoo-jp-next-page-key? key key-state))
1103    (im-shift-page-candidate yc #t)
1104    #t)
1105   (else
1106    #f)))
1107
1108(define (yahoo-jp-proc-prediction-state yc key key-state)
1109  (cond
1110   ;; prediction index change
1111   ((yahoo-jp-prediction-keys-handled? yc key key-state))
1112
1113   ;; cancel
1114   ((yahoo-jp-cancel-key? key key-state)
1115    (if (yahoo-jp-context-prediction-index yc)
1116	(yahoo-jp-reset-prediction-window yc)
1117	(begin
1118	  (yahoo-jp-reset-prediction-window yc)
1119	  (yahoo-jp-proc-input-state yc key key-state))))
1120
1121   ;; commit
1122   ((and
1123     (yahoo-jp-context-prediction-index yc)
1124     (yahoo-jp-commit-key? key key-state))
1125    (yahoo-jp-do-commit-prediction yc))
1126   (else
1127    (if (and
1128	 yahoo-jp-use-implicit-commit-prediction?
1129	 (yahoo-jp-context-prediction-index yc))
1130	(cond
1131	 ((or
1132	   ;; check keys used in yahoo-jp-proc-input-state-with-preedit
1133	   (yahoo-jp-begin-conv-key? key key-state)
1134	   (yahoo-jp-backspace-key? key key-state)
1135	   (yahoo-jp-delete-key? key key-state)
1136	   (yahoo-jp-kill-key? key key-state)
1137	   (yahoo-jp-kill-backward-key? key key-state)
1138	   (and
1139	    (not (yahoo-jp-context-alnum yc))
1140	    (yahoo-jp-commit-as-opposite-kana-key? key key-state))
1141	   (yahoo-jp-transpose-as-hiragana-key? key key-state)
1142	   (yahoo-jp-transpose-as-katakana-key? key key-state)
1143	   (yahoo-jp-transpose-as-halfkana-key? key key-state)
1144	   (and
1145	    (not (= (yahoo-jp-context-input-rule yc) yahoo-jp-input-rule-kana))
1146	    (or
1147	     (yahoo-jp-transpose-as-halfwidth-alnum-key? key key-state)
1148	     (yahoo-jp-transpose-as-fullwidth-alnum-key? key key-state)))
1149	   (yahoo-jp-hiragana-key? key key-state)
1150	   (yahoo-jp-katakana-key? key key-state)
1151	   (yahoo-jp-halfkana-key? key key-state)
1152	   (yahoo-jp-halfwidth-alnum-key? key key-state)
1153	   (yahoo-jp-fullwidth-alnum-key? key key-state)
1154	   (and
1155	    (not (yahoo-jp-context-alnum yc))
1156	    (yahoo-jp-kana-toggle-key? key key-state))
1157	   (yahoo-jp-alkana-toggle-key? key key-state)
1158	   (yahoo-jp-go-left-key? key key-state)
1159	   (yahoo-jp-go-right-key? key key-state)
1160	   (yahoo-jp-beginning-of-preedit-key? key key-state)
1161	   (yahoo-jp-end-of-preedit-key? key key-state)
1162	   (and
1163	    (modifier-key-mask key-state)
1164	    (not (shift-key-mask key-state))))
1165	  ;; go back to unselected prediction
1166	  (yahoo-jp-reset-prediction-window yc)
1167	  (yahoo-jp-check-prediction yc #f))
1168	 ((and
1169	   (ichar-numeric? key)
1170	   yahoo-jp-select-prediction-by-numeral-key?
1171	   (not (yahoo-jp-prediction-select-non-existing-index? yc key)))
1172	  (yahoo-jp-context-set-predicting! yc #f)
1173	  (yahoo-jp-context-set-prediction-index! yc #f)
1174	  (yahoo-jp-proc-input-state yc key key-state))
1175	 (else
1176	  ;; implicit commit
1177	  (yahoo-jp-do-commit-prediction yc)
1178	  (yahoo-jp-proc-input-state yc key key-state)))
1179	(begin
1180	  (yahoo-jp-context-set-predicting! yc #f)
1181	  (yahoo-jp-context-set-prediction-index! yc #f)
1182	  (if (not yahoo-jp-use-prediction?)
1183	      (yahoo-jp-reset-prediction-window yc))
1184	  (yahoo-jp-proc-input-state yc key key-state))))))
1185
1186(define (yahoo-jp-proc-input-state-with-preedit yc key key-state)
1187  (define (check-auto-conv str)
1188    (and
1189      str
1190      yahoo-jp-auto-start-henkan?
1191      (string-find japanese-auto-start-henkan-keyword-list str)
1192      (begin
1193	(yahoo-jp-reset-prediction-window yc)
1194	(yahoo-jp-begin-conv yc))))
1195  (let ((preconv-str (yahoo-jp-context-preconv-ustr yc))
1196	(raw-str (yahoo-jp-context-raw-ustr yc))
1197	(rkc (yahoo-jp-context-rkc yc))
1198	(rule (yahoo-jp-context-input-rule yc))
1199	(kana (yahoo-jp-context-kana-mode yc)))
1200    (cond
1201     ;; begin conversion
1202     ((yahoo-jp-begin-conv-key? key key-state)
1203      (yahoo-jp-begin-conv yc))
1204
1205     ;; prediction
1206     ((yahoo-jp-next-prediction-key? key key-state)
1207      (yahoo-jp-check-prediction yc #t))
1208
1209     ;; backspace
1210     ((yahoo-jp-backspace-key? key key-state)
1211      (if (not (rk-backspace rkc))
1212	  (begin
1213	    (ustr-cursor-delete-backside! preconv-str)
1214	    (ustr-cursor-delete-backside! raw-str)
1215	    ;; fix to valid roma
1216	    (if (and
1217		 (= (yahoo-jp-context-input-rule yc) yahoo-jp-input-rule-roma)
1218		 (not (null? (ustr-former-seq preconv-str)))
1219		 (not (ichar-printable?
1220		       (string->ichar
1221			(car (last (ustr-former-seq preconv-str)))))))
1222	        (ja-fix-deleted-raw-str-to-valid-roma! raw-str)))))
1223
1224     ;; delete
1225     ((yahoo-jp-delete-key? key key-state)
1226      (if (not (rk-delete rkc))
1227	  (begin
1228	    (ustr-cursor-delete-frontside! preconv-str)
1229	    (ustr-cursor-delete-frontside! raw-str))))
1230
1231       ;; kill
1232     ((yahoo-jp-kill-key? key key-state)
1233      (ustr-clear-latter! preconv-str)
1234      (ustr-clear-latter! raw-str))
1235
1236     ;; kill-backward
1237     ((yahoo-jp-kill-backward-key? key key-state)
1238      (rk-flush rkc)
1239      (ustr-clear-former! preconv-str)
1240      (ustr-clear-former! raw-str))
1241
1242     ;; ���ߤȤϵդΤ��ʥ⡼�ɤǤ��ʤ���ꤹ��
1243     ((and
1244       (not (yahoo-jp-context-alnum yc))
1245       (yahoo-jp-commit-as-opposite-kana-key? key key-state))
1246      (im-commit yc (yahoo-jp-make-whole-string yc #t (ja-opposite-kana kana)))
1247      (yahoo-jp-flush yc))
1248
1249     ;; Transposing���֤ذܹ�
1250     ((or (yahoo-jp-transpose-as-hiragana-key? key key-state)
1251	  (yahoo-jp-transpose-as-katakana-key? key key-state)
1252	  (yahoo-jp-transpose-as-halfkana-key? key key-state)
1253	  (and
1254	   (not (= (yahoo-jp-context-input-rule yc) yahoo-jp-input-rule-kana))
1255	   (or
1256	    (yahoo-jp-transpose-as-halfwidth-alnum-key? key key-state)
1257	    (yahoo-jp-transpose-as-fullwidth-alnum-key? key key-state))))
1258      (yahoo-jp-reset-prediction-window yc)
1259      (yahoo-jp-proc-transposing-state yc key key-state))
1260
1261     ((yahoo-jp-hiragana-key? key key-state)
1262      (if (not (= kana yahoo-jp-type-hiragana))
1263	  (begin
1264	    (im-commit yc (yahoo-jp-make-whole-string yc #t kana))
1265	    (yahoo-jp-flush yc)))
1266      (yahoo-jp-context-set-kana-mode! yc yahoo-jp-type-hiragana)
1267      (yahoo-jp-context-set-alnum! yc #f))
1268
1269     ((yahoo-jp-katakana-key? key key-state)
1270      (if (not (= kana yahoo-jp-type-katakana))
1271	  (begin
1272	    (im-commit yc (yahoo-jp-make-whole-string yc #t kana))
1273	    (yahoo-jp-flush yc)))
1274      (yahoo-jp-context-set-kana-mode! yc yahoo-jp-type-katakana)
1275      (yahoo-jp-context-set-alnum! yc #f))
1276
1277     ((yahoo-jp-halfkana-key? key key-state)
1278      (if (not (= kana yahoo-jp-type-halfkana))
1279	  (begin
1280	    (im-commit yc (yahoo-jp-make-whole-string yc #t kana))
1281	    (yahoo-jp-flush yc)))
1282      (yahoo-jp-context-set-kana-mode! yc yahoo-jp-type-halfkana)
1283      (yahoo-jp-context-set-alnum! yc #f))
1284
1285     ((and
1286       (yahoo-jp-halfwidth-alnum-key? key key-state)
1287       (not
1288        (and
1289	 (= (yahoo-jp-context-alnum-type yc) yahoo-jp-type-halfwidth-alnum)
1290	 (yahoo-jp-context-alnum yc))))
1291      (yahoo-jp-context-set-alnum-type! yc yahoo-jp-type-halfwidth-alnum)
1292      (yahoo-jp-context-set-alnum! yc #t))
1293
1294     ((and
1295       (yahoo-jp-fullwidth-alnum-key? key key-state)
1296       (not
1297        (and
1298	 (= (yahoo-jp-context-alnum-type yc) yahoo-jp-type-fullwidth-alnum)
1299	 (yahoo-jp-context-alnum yc))))
1300      (yahoo-jp-context-set-alnum-type! yc yahoo-jp-type-fullwidth-alnum)
1301      (yahoo-jp-context-set-alnum! yc #t))
1302
1303     ;; Commit current preedit string, then toggle hiragana/katakana mode.
1304     ((and
1305       (not (yahoo-jp-context-alnum yc))
1306       (yahoo-jp-kana-toggle-key? key key-state))
1307      (im-commit yc (yahoo-jp-make-whole-string yc #t kana))
1308      (yahoo-jp-flush yc)
1309      (yahoo-jp-context-kana-toggle yc))
1310
1311     ((yahoo-jp-alkana-toggle-key? key key-state)
1312      (yahoo-jp-context-alkana-toggle yc))
1313
1314     ;; cancel
1315     ((yahoo-jp-cancel-key? key key-state)
1316      (yahoo-jp-flush yc))
1317
1318     ;; commit
1319     ((yahoo-jp-commit-key? key key-state)
1320      (begin
1321	(im-commit
1322	 yc
1323	 (yahoo-jp-make-whole-string yc #t kana))
1324	(yahoo-jp-flush yc)))
1325
1326     ;; left
1327     ((yahoo-jp-go-left-key? key key-state)
1328      (yahoo-jp-context-confirm-kana! yc)
1329      (ustr-cursor-move-backward! preconv-str)
1330      (ustr-cursor-move-backward! raw-str))
1331
1332     ;; right
1333     ((yahoo-jp-go-right-key? key key-state)
1334      (yahoo-jp-context-confirm-kana! yc)
1335      (ustr-cursor-move-forward! preconv-str)
1336      (ustr-cursor-move-forward! raw-str))
1337
1338     ;; beginning-of-preedit
1339     ((yahoo-jp-beginning-of-preedit-key? key key-state)
1340      (yahoo-jp-context-confirm-kana! yc)
1341      (ustr-cursor-move-beginning! preconv-str)
1342      (ustr-cursor-move-beginning! raw-str))
1343
1344     ;; end-of-preedit
1345     ((yahoo-jp-end-of-preedit-key? key key-state)
1346      (yahoo-jp-context-confirm-kana! yc)
1347      (ustr-cursor-move-end! preconv-str)
1348      (ustr-cursor-move-end! raw-str))
1349
1350     ;; modifiers (except shift) => ignore
1351     ((and (modifier-key-mask key-state)
1352	      (not (shift-key-mask key-state)))
1353      #f)
1354
1355     ((symbol? key)
1356      #f)
1357
1358     (else
1359      (if (yahoo-jp-context-alnum yc)
1360          (let ((key-str (charcode->string key))
1361	        (pend (rk-pending rkc))
1362		(residual-kana (rk-peek-terminal-match rkc)))
1363	    (rk-flush rkc) ;; OK to reset rkc here.
1364	    (if residual-kana
1365	        (begin
1366                  (if (list? (car residual-kana))
1367                    (begin
1368                      (ustr-insert-seq! preconv-str residual-kana)
1369                      (ustr-insert-elem! raw-str (reverse
1370                                                   (string-to-list pend))))
1371                    (begin
1372                      (ustr-insert-elem! preconv-str residual-kana)
1373                      (ustr-insert-elem! raw-str pend)))))
1374	    (ustr-insert-elem! preconv-str
1375			       (if (= (yahoo-jp-context-alnum-type yc)
1376				      yahoo-jp-type-halfwidth-alnum)
1377				   (list key-str key-str key-str)
1378				   (list (ja-wide key-str) (ja-wide key-str)
1379					 (ja-wide key-str))))
1380	    (ustr-insert-elem! raw-str key-str)
1381	    (check-auto-conv key-str))
1382	  (let* ((key-str (charcode->string
1383			   (if (= rule yahoo-jp-input-rule-kana)
1384			       key
1385			       (ichar-downcase key))))
1386	         (pend (rk-pending rkc))
1387	         (res (rk-push-key! rkc key-str)))
1388	    (if (and res
1389		     (or (list? (car res))
1390		         (not (string=? (car res) ""))))
1391	        (let ((next-pend (rk-pending rkc)))
1392	          (if (list? (car res))
1393		      (ustr-insert-seq!  preconv-str res)
1394		      (ustr-insert-elem! preconv-str res))
1395	          (if (and next-pend
1396		           (not (string=? next-pend "")))
1397		      (ustr-insert-seq! raw-str
1398                                        (reverse (string-to-list pend)))
1399		      (if (list? (car res))
1400		          (begin
1401                            (if (member pend
1402                                        (map car
1403                                             ja-consonant-syllable-table))
1404                              ;; treat consonant having more than one
1405                              ;; charactear as one raw-str in this case
1406                              (ustr-insert-elem! raw-str pend)
1407                              (ustr-insert-elem! raw-str (reverse
1408                                                           (string-to-list
1409                                                             pend))))
1410                            ;; assume key-str as a vowel
1411			    (ustr-insert-elem! raw-str key-str))
1412		          (ustr-insert-elem!
1413		           raw-str
1414		           (string-append pend key-str))))))
1415	    (check-auto-conv (if res (car res) #f))))))))
1416
1417(define yahoo-jp-context-confirm-kana!
1418  (lambda (yc)
1419    (if (= (yahoo-jp-context-input-rule yc)
1420	   yahoo-jp-input-rule-kana)
1421	(let* ((preconv-str (yahoo-jp-context-preconv-ustr yc))
1422	       (rkc (yahoo-jp-context-rkc yc))
1423	       (residual-kana (rk-peek-terminal-match rkc)))
1424	  (if residual-kana
1425	      (begin
1426                (if (list? (car residual-kana))
1427                  (ustr-insert-seq! preconv-str residual-kana)
1428                  (ustr-insert-elem! preconv-str residual-kana))
1429		(rk-flush rkc)))))))
1430
1431(define (yahoo-jp-reset-prediction-window yc)
1432  (if (yahoo-jp-context-prediction-window yc)
1433      (im-deactivate-candidate-selector yc))
1434  (yahoo-jp-context-set-predicting! yc #f)
1435  (yahoo-jp-context-set-prediction-window! yc #f)
1436  (yahoo-jp-context-set-prediction-index! yc #f))
1437
1438(define (yahoo-jp-check-prediction yc force-check?)
1439  (if (and
1440       (not (yahoo-jp-context-state yc))
1441       (not (yahoo-jp-context-transposing yc))
1442       (not (yahoo-jp-context-predicting yc)))
1443      (let* ((use-pending-rk-for-prediction? #t)
1444             (preconv-str
1445              (yahoo-jp-make-whole-string
1446               yc
1447               (not use-pending-rk-for-prediction?)
1448               (yahoo-jp-context-kana-mode yc)))
1449             (preedit-len (+
1450                           (ustr-length (yahoo-jp-context-preconv-ustr yc))
1451                           (if (not use-pending-rk-for-prediction?)
1452                               0
1453                               (string-length (rk-pending
1454                                               (yahoo-jp-context-rkc
1455                                                yc)))))))
1456        (if (or
1457             (>= preedit-len yahoo-jp-prediction-start-char-count)
1458             force-check?)
1459            (begin
1460              (yahoo-jp-lib-set-prediction-src-string yc preconv-str)
1461              (let ((nr (yahoo-jp-lib-get-nr-predictions yc)))
1462                (if (and
1463                     nr
1464                     (> nr 0))
1465                    (begin
1466                     (im-activate-candidate-selector
1467                      yc nr yahoo-jp-nr-candidate-max)
1468                     (yahoo-jp-context-set-prediction-window! yc #t)
1469                     (yahoo-jp-context-set-predicting! yc #t))
1470                    (yahoo-jp-reset-prediction-window yc))))
1471            (yahoo-jp-reset-prediction-window yc)))))
1472
1473(define (yahoo-jp-proc-input-state yc key key-state)
1474  (if (yahoo-jp-has-preedit? yc)
1475      (yahoo-jp-proc-input-state-with-preedit yc key key-state)
1476      (yahoo-jp-proc-input-state-no-preedit yc key key-state))
1477  (if yahoo-jp-use-prediction?
1478      (yahoo-jp-check-prediction yc #f)))
1479
1480(define yahoo-jp-separator
1481  (lambda (yc)
1482    (let ((attr (bitwise-ior preedit-separator preedit-underline)))
1483      (if yahoo-jp-show-segment-separator?
1484	  (cons attr yahoo-jp-segment-separator)
1485	  #f))))
1486
1487(define yahoo-jp-context-transposing-state-preedit
1488  (lambda (yc)
1489    (let ((transposing-text (yahoo-jp-transposing-text yc)))
1490      (list (cons preedit-reverse transposing-text)
1491	    (cons preedit-cursor "")))))
1492
1493(define yahoo-jp-transposing-text
1494  (lambda (yc)
1495    (let ((transposing-type (yahoo-jp-context-transposing-type yc)))
1496      (cond
1497       ((or
1498	 (= transposing-type yahoo-jp-type-hiragana)
1499	 (= transposing-type yahoo-jp-type-katakana)
1500	 (= transposing-type yahoo-jp-type-halfkana))
1501	(yahoo-jp-make-whole-string yc #t transposing-type))
1502       ((= transposing-type yahoo-jp-type-halfwidth-alnum)
1503	(yahoo-jp-make-whole-raw-string yc #f #f))
1504       ((= transposing-type yahoo-jp-candidate-type-upper-halfwidth-alnum)
1505	(yahoo-jp-make-whole-raw-string yc #f #t))
1506       ((= transposing-type yahoo-jp-type-fullwidth-alnum)
1507	(yahoo-jp-make-whole-raw-string yc #t #f))
1508       ((= transposing-type yahoo-jp-candidate-type-upper-fullwidth-alnum)
1509	(yahoo-jp-make-whole-raw-string yc #t #t))))))
1510
1511(define yahoo-jp-get-raw-str-seq
1512  (lambda (yc)
1513    (let* ((rkc (yahoo-jp-context-rkc yc))
1514	   (pending (rk-pending rkc))
1515	   (residual-kana (rk-peek-terminal-match rkc))
1516	   (raw-str (yahoo-jp-context-raw-ustr yc))
1517	   (right-str (ustr-latter-seq raw-str))
1518	   (left-str (ustr-former-seq raw-str)))
1519     (append left-str
1520	     (if residual-kana
1521               (if (list? (car residual-kana))
1522                 (reverse (string-to-list pending))
1523		 (list pending))
1524               '())
1525	      right-str))))
1526
1527(define yahoo-jp-get-raw-candidate
1528  (lambda (yc seg-idx cand-idx)
1529    (let* ((preconv
1530	    (ja-join-vu (string-to-list
1531			 (yahoo-jp-make-whole-string yc #t yahoo-jp-type-hiragana))))
1532	   (unconv-candidate (yahoo-jp-lib-get-unconv-candidate yc seg-idx))
1533	   (unconv (if unconv-candidate
1534		       (ja-join-vu (string-to-list unconv-candidate))
1535		       '()))
1536	   (raw-str (reverse (yahoo-jp-get-raw-str-seq yc))))
1537      (cond
1538       ((= cand-idx yahoo-jp-candidate-type-hiragana)
1539	(string-list-concat unconv))
1540       ((= cand-idx yahoo-jp-candidate-type-katakana)
1541	(ja-make-kana-str (ja-make-kana-str-list unconv) yahoo-jp-type-katakana))
1542       ((= cand-idx yahoo-jp-candidate-type-halfkana)
1543	(ja-make-kana-str (ja-make-kana-str-list unconv) yahoo-jp-type-halfkana))
1544       (else
1545	(if (not (null? unconv))
1546	    (if (member (car unconv) preconv)
1547		(let ((start (list-seq-contained? preconv unconv))
1548		      (len (length unconv)))
1549		  (if (and
1550                        start
1551                        (= (length raw-str) (length preconv))) ;; sanity check
1552		      (yahoo-jp-make-raw-string
1553		       (reverse (sublist-rel raw-str start len))
1554		       (if (or
1555			    (= cand-idx yahoo-jp-candidate-type-halfwidth-alnum)
1556			    (= cand-idx
1557			       yahoo-jp-candidate-type-upper-halfwidth-alnum))
1558			   #f
1559			   #t)
1560		       (if (or
1561			    (= cand-idx yahoo-jp-candidate-type-halfwidth-alnum)
1562			    (= cand-idx yahoo-jp-candidate-type-fullwidth-alnum))
1563			   #f
1564			   #t))
1565		      "??")) ;; FIXME
1566		"???") ;; FIXME
1567	    "????")))))) ;; shouldn't happen
1568
1569(define (yahoo-jp-predicting-state-preedit yc)
1570  (if (or
1571       (not yahoo-jp-use-implicit-commit-prediction?)
1572       (not (yahoo-jp-context-prediction-index yc)))
1573      (yahoo-jp-input-state-preedit yc)
1574      (let ((cand (yahoo-jp-get-prediction-string yc)))
1575       (list (cons (bitwise-ior preedit-reverse preedit-cursor) cand)))))
1576
1577(define (yahoo-jp-compose-state-preedit yc)
1578  (let* ((segments (yahoo-jp-context-segments yc))
1579	 (cur-seg (ustr-cursor-pos segments))
1580	 (separator (yahoo-jp-separator yc)))
1581    (append-map
1582     (lambda (seg-idx cand-idx)
1583       (let* ((attr (if (= seg-idx cur-seg)
1584			(bitwise-ior preedit-reverse
1585				     preedit-cursor)
1586			preedit-underline))
1587	      (cand (if (> cand-idx yahoo-jp-candidate-type-katakana)
1588			(yahoo-jp-lib-get-nth-candidate yc seg-idx cand-idx)
1589			(yahoo-jp-get-raw-candidate yc seg-idx cand-idx)))
1590	      (seg (list (cons attr cand))))
1591	 (if (and separator
1592		  (< 0 seg-idx))
1593	     (cons separator seg)
1594	     seg)))
1595     (iota (ustr-length segments))
1596     (ustr-whole-seq segments))))
1597
1598(define (yahoo-jp-input-state-preedit yc)
1599  (let* ((preconv-str (yahoo-jp-context-preconv-ustr yc))
1600	 (rkc (yahoo-jp-context-rkc yc))
1601	 (pending (rk-pending rkc))
1602	 (kana (yahoo-jp-context-kana-mode yc))
1603	 (rule (yahoo-jp-context-input-rule yc))
1604	 (extract-kana
1605	  (if (= rule yahoo-jp-input-rule-kana)
1606	      (lambda (entry) (car entry))
1607	      (lambda (entry) (list-ref entry kana)))))
1608    (list
1609     (and (not (ustr-cursor-at-beginning? preconv-str))
1610	  (cons preedit-underline
1611		(string-append-map-ustr-former extract-kana preconv-str)))
1612     (and (> (string-length pending) 0)
1613	  (cons preedit-underline pending))
1614     (and (yahoo-jp-has-preedit? yc)
1615	  (cons preedit-cursor ""))
1616     (and (not (ustr-cursor-at-end? preconv-str))
1617	  (cons preedit-underline
1618		(string-append-map-ustr-latter extract-kana preconv-str))))))
1619
1620(define (yahoo-jp-get-commit-string yc)
1621  (let ((segments (yahoo-jp-context-segments yc)))
1622    (string-append-map (lambda (seg-idx cand-idx)
1623			 (if (> cand-idx yahoo-jp-candidate-type-katakana)
1624			     (yahoo-jp-lib-get-nth-candidate
1625			      yc seg-idx cand-idx)
1626			     (yahoo-jp-get-raw-candidate
1627			      yc seg-idx cand-idx)))
1628		       (iota (ustr-length segments))
1629		       (ustr-whole-seq segments))))
1630
1631(define (yahoo-jp-commit-string yc)
1632    (let ((yx-ctx (yahoo-jp-context-yx-ctx yc))
1633          (segments (yahoo-jp-context-segments yc)))
1634      (if yx-ctx
1635          (begin
1636            (yahoo-jp-lib-commit-segments yc (ustr-whole-seq segments))
1637            (if (every (lambda (x) (<= x yahoo-jp-candidate-type-katakana))
1638                       (ustr-whole-seq segments))
1639                (yahoo-jp-lib-reset-conversion yc))))))
1640
1641(define (yahoo-jp-do-commit yc)
1642    (im-commit yc (yahoo-jp-get-commit-string yc))
1643    (yahoo-jp-commit-string yc)
1644    (yahoo-jp-reset-candidate-window yc)
1645    (yahoo-jp-flush yc))
1646
1647(define (yahoo-jp-get-prediction-string yc)
1648  (yahoo-jp-lib-get-nth-prediction
1649   yc
1650   (yahoo-jp-context-prediction-index yc)))
1651
1652(define (yahoo-jp-learn-prediction-string yc)
1653  (yahoo-jp-lib-commit-nth-prediction
1654   yc
1655   (yahoo-jp-context-prediction-index yc)))
1656
1657(define (yahoo-jp-do-commit-prediction yc)
1658  (im-commit yc (yahoo-jp-get-prediction-string yc))
1659  (yahoo-jp-learn-prediction-string yc)
1660  (yahoo-jp-reset-prediction-window yc)
1661  (yahoo-jp-flush yc))
1662
1663(define yahoo-jp-correct-segment-cursor
1664  (lambda (segments)
1665    (if (ustr-cursor-at-end? segments)
1666	(ustr-cursor-move-backward! segments))))
1667
1668(define (yahoo-jp-move-segment yc dir)
1669  (yahoo-jp-reset-candidate-window yc)
1670  (let ((segments (yahoo-jp-context-segments yc)))
1671    (ustr-cursor-move! segments dir)
1672    (yahoo-jp-correct-segment-cursor segments)))
1673
1674(define (yahoo-jp-resize-segment yc cnt)
1675  (let* ((segments (yahoo-jp-context-segments yc))
1676	 (cur-seg (ustr-cursor-pos segments)))
1677    (yahoo-jp-reset-candidate-window yc)
1678    (yahoo-jp-lib-resize-segment yc cur-seg cnt)
1679    (let* ((resized-nseg (yahoo-jp-lib-get-nr-segments yc))
1680           (latter-nseg (- resized-nseg cur-seg)))
1681      (ustr-set-latter-seq! segments (make-list latter-nseg 0)))))
1682
1683(define (yahoo-jp-move-candidate yc offset)
1684  (let* ((segments (yahoo-jp-context-segments yc))
1685	 (cur-seg (ustr-cursor-pos segments))
1686	 (max (yahoo-jp-lib-get-nr-candidates yc cur-seg))
1687	 (n (if (< (ustr-cursor-frontside segments) 0) ;; segment-transposing
1688		0
1689		(+ (ustr-cursor-frontside segments) offset)))
1690	 (compensated-n (cond
1691			 ((>= n max)
1692			  0)
1693			 ((< n 0)
1694			  (- max 1))
1695			 (else
1696			  n)))
1697	 (new-op-count (+ 1 (yahoo-jp-context-candidate-op-count yc))))
1698    (ustr-cursor-set-frontside! segments compensated-n)
1699    (yahoo-jp-context-set-candidate-op-count! yc new-op-count)
1700    (if (and
1701	 (= (yahoo-jp-context-candidate-op-count yc)
1702	    yahoo-jp-candidate-op-count)
1703	 yahoo-jp-use-candidate-window?)
1704	(begin
1705	  (yahoo-jp-context-set-candidate-window! yc #t)
1706	  (im-activate-candidate-selector yc max yahoo-jp-nr-candidate-max)))
1707    (if (yahoo-jp-context-candidate-window yc)
1708	(im-select-candidate yc compensated-n))))
1709
1710(define yahoo-jp-move-candidate-in-page
1711  (lambda (yc numeralc)
1712    (let* ((segments (yahoo-jp-context-segments yc))
1713	   (cur-seg (ustr-cursor-pos segments))
1714	   (max (yahoo-jp-lib-get-nr-candidates yc cur-seg))
1715	   (n (ustr-cursor-frontside segments))
1716	   (cur-page (if (= yahoo-jp-nr-candidate-max 0)
1717			 0
1718			 (quotient n yahoo-jp-nr-candidate-max)))
1719	   (pageidx (- (numeric-ichar->integer numeralc) 1))
1720	   (compensated-pageidx (cond
1721				 ((< pageidx 0) ; pressing key_0
1722				  (+ pageidx 10))
1723				 (else
1724				  pageidx)))
1725	   (idx (+ (* cur-page yahoo-jp-nr-candidate-max) compensated-pageidx))
1726	   (compensated-idx (cond
1727			     ((>= idx max)
1728			      (- max 1))
1729			     (else
1730			      idx)))
1731	   (new-op-count (+ 1 (yahoo-jp-context-candidate-op-count yc))))
1732      (ustr-cursor-set-frontside! segments compensated-idx)
1733      (yahoo-jp-context-set-candidate-op-count! yc new-op-count)
1734      (im-select-candidate yc compensated-idx))))
1735
1736(define (yahoo-jp-reset-candidate-window yc)
1737  (if (yahoo-jp-context-candidate-window yc)
1738      (begin
1739	(im-deactivate-candidate-selector yc)
1740	(yahoo-jp-context-set-candidate-window! yc #f)))
1741  (yahoo-jp-context-set-candidate-op-count! yc 0))
1742
1743(define yahoo-jp-rotate-segment-transposing-alnum-type
1744  (lambda (idx state)
1745    (cond
1746     ((and
1747       (= idx yahoo-jp-candidate-type-halfwidth-alnum)
1748       (= state yahoo-jp-candidate-type-halfwidth-alnum))
1749      yahoo-jp-candidate-type-upper-halfwidth-alnum)
1750     ((and
1751       (= idx yahoo-jp-candidate-type-fullwidth-alnum)
1752       (= state yahoo-jp-candidate-type-fullwidth-alnum))
1753      yahoo-jp-candidate-type-upper-fullwidth-alnum)
1754     (else
1755      state))))
1756
1757(define yahoo-jp-set-segment-transposing
1758  (lambda (yc key key-state)
1759    (let ((segments (yahoo-jp-context-segments yc)))
1760      (let ((rotate-list '())
1761	    (state #f)
1762	    (idx (ustr-cursor-frontside segments)))
1763	(yahoo-jp-reset-candidate-window yc)
1764	(yahoo-jp-context-set-candidate-op-count! yc 0)
1765
1766	(if (yahoo-jp-transpose-as-fullwidth-alnum-key? key key-state)
1767	    (set! rotate-list (cons yahoo-jp-candidate-type-fullwidth-alnum
1768				    rotate-list)))
1769	(if (yahoo-jp-transpose-as-halfwidth-alnum-key? key key-state)
1770	    (set! rotate-list (cons yahoo-jp-candidate-type-halfwidth-alnum
1771				    rotate-list)))
1772	(if (yahoo-jp-transpose-as-halfkana-key? key key-state)
1773	    (set! rotate-list (cons yahoo-jp-candidate-type-halfkana
1774				    rotate-list)))
1775	(if (yahoo-jp-transpose-as-katakana-key? key key-state)
1776	    (set! rotate-list (cons yahoo-jp-candidate-type-katakana
1777				    rotate-list)))
1778	(if (yahoo-jp-transpose-as-hiragana-key? key key-state)
1779	    (set! rotate-list (cons yahoo-jp-candidate-type-hiragana
1780				    rotate-list)))
1781	(if (or
1782	     (= idx yahoo-jp-candidate-type-hiragana)
1783	     (= idx yahoo-jp-candidate-type-katakana)
1784	     (= idx yahoo-jp-candidate-type-halfkana)
1785	     (= idx yahoo-jp-candidate-type-halfwidth-alnum)
1786	     (= idx yahoo-jp-candidate-type-fullwidth-alnum)
1787	     (= idx yahoo-jp-candidate-type-upper-halfwidth-alnum)
1788	     (= idx yahoo-jp-candidate-type-upper-fullwidth-alnum))
1789	    (let ((lst (member idx rotate-list)))
1790	      (if (and lst
1791		       (not (null? (cdr lst))))
1792		  (set! state (car (cdr lst)))
1793		  (set! state (yahoo-jp-rotate-segment-transposing-alnum-type
1794			       idx (car rotate-list)))))
1795	    (set! state (car rotate-list)))
1796	(ustr-cursor-set-frontside! segments state)))))
1797
1798(define (yahoo-jp-proc-compose-state yc key key-state)
1799  (cond
1800   ((yahoo-jp-prev-page-key? key key-state)
1801    (if (yahoo-jp-context-candidate-window yc)
1802        (im-shift-page-candidate yc #f)))
1803
1804   ((yahoo-jp-next-page-key? key key-state)
1805    (if (yahoo-jp-context-candidate-window yc)
1806        (im-shift-page-candidate yc #t)))
1807
1808   ((yahoo-jp-commit-key? key key-state)
1809    (yahoo-jp-do-commit yc))
1810
1811   ((yahoo-jp-extend-segment-key? key key-state)
1812    (yahoo-jp-resize-segment yc 1))
1813
1814   ((yahoo-jp-shrink-segment-key? key key-state)
1815    (yahoo-jp-resize-segment yc -1))
1816
1817   ((yahoo-jp-next-segment-key? key key-state)
1818    (yahoo-jp-move-segment yc 1))
1819
1820   ((yahoo-jp-prev-segment-key? key key-state)
1821    (yahoo-jp-move-segment yc -1))
1822
1823   ((yahoo-jp-beginning-of-preedit-key? key key-state)
1824    (begin
1825      (ustr-cursor-move-beginning! (yahoo-jp-context-segments yc))
1826      (yahoo-jp-reset-candidate-window yc)))
1827
1828   ((yahoo-jp-end-of-preedit-key? key key-state)
1829    (begin
1830      (ustr-cursor-move-end! (yahoo-jp-context-segments yc))
1831      (yahoo-jp-correct-segment-cursor (yahoo-jp-context-segments yc))
1832      (yahoo-jp-reset-candidate-window yc)))
1833
1834   ((yahoo-jp-backspace-key? key key-state)
1835    (yahoo-jp-cancel-conv yc))
1836
1837   ((yahoo-jp-next-candidate-key? key key-state)
1838    (yahoo-jp-move-candidate yc 1))
1839
1840   ((yahoo-jp-prev-candidate-key? key key-state)
1841    (yahoo-jp-move-candidate yc -1))
1842
1843   ((or (yahoo-jp-transpose-as-hiragana-key? key key-state)
1844        (yahoo-jp-transpose-as-katakana-key? key key-state)
1845        (yahoo-jp-transpose-as-halfkana-key? key key-state)
1846        (and
1847         (not (= (yahoo-jp-context-input-rule yc) yahoo-jp-input-rule-kana))
1848         (or
1849          (yahoo-jp-transpose-as-halfwidth-alnum-key? key key-state)
1850          (yahoo-jp-transpose-as-fullwidth-alnum-key? key key-state))))
1851    (yahoo-jp-set-segment-transposing yc key key-state))
1852
1853   ((yahoo-jp-cancel-key? key key-state)
1854    (yahoo-jp-cancel-conv yc))
1855
1856   ((and yahoo-jp-select-candidate-by-numeral-key?
1857         (ichar-numeric? key)
1858         (yahoo-jp-context-candidate-window yc))
1859    (yahoo-jp-move-candidate-in-page yc key))
1860
1861   ((and (modifier-key-mask key-state)
1862         (not (shift-key-mask key-state)))
1863    #f)
1864
1865   ((symbol? key)
1866    #f)
1867
1868   (else
1869    (begin
1870      (yahoo-jp-do-commit yc)
1871      (yahoo-jp-proc-input-state yc key key-state)))))
1872
1873(define (yahoo-jp-press-key-handler yc key key-state)
1874  (if (ichar-control? key)
1875      (im-commit-raw yc)
1876      (if (yahoo-jp-context-on yc)
1877          (if (yahoo-jp-context-transposing yc)
1878              (yahoo-jp-proc-transposing-state yc key key-state)
1879              (if (yahoo-jp-context-state yc)
1880                  (yahoo-jp-proc-compose-state yc key key-state)
1881                  (if (yahoo-jp-context-predicting yc)
1882                      (yahoo-jp-proc-prediction-state yc key key-state)
1883                      (yahoo-jp-proc-input-state yc key key-state))))
1884	  (yahoo-jp-proc-raw-state yc key key-state)))
1885  (yahoo-jp-update-preedit yc))
1886
1887;;;
1888(define (yahoo-jp-release-key-handler yc key key-state)
1889  (if (or (ichar-control? key)
1890	  (not (yahoo-jp-context-on yc)))
1891      (yahoo-jp-commit-raw yc)))
1892;;;
1893(define (yahoo-jp-reset-handler yc)
1894  (if (yahoo-jp-context-on yc)
1895      (begin
1896	(if (yahoo-jp-context-state yc)
1897            (yahoo-jp-lib-reset-conversion yc))
1898	(yahoo-jp-flush yc))))
1899
1900;;;
1901(define (yahoo-jp-get-candidate-handler yc idx ascel-enum-hint)
1902  (let* ((cur-seg (ustr-cursor-pos (yahoo-jp-context-segments yc)))
1903         (cand (if (yahoo-jp-context-state yc)
1904                   (yahoo-jp-lib-get-nth-candidate yc cur-seg idx)
1905                   (yahoo-jp-lib-get-nth-prediction yc idx))))
1906    (list cand (digit->string (+ idx 1)) "")))
1907
1908(define (yahoo-jp-set-candidate-index-handler yc idx)
1909    (cond
1910     ((yahoo-jp-context-state yc)
1911      (ustr-cursor-set-frontside! (yahoo-jp-context-segments yc) idx)
1912      (yahoo-jp-update-preedit yc))
1913     ((yahoo-jp-context-predicting yc)
1914      (yahoo-jp-context-set-prediction-index! yc idx)
1915      (yahoo-jp-update-preedit yc))))
1916
1917(define (yahoo-jp-proc-raw-state yc key key-state)
1918  (if (not (yahoo-jp-begin-input yc key key-state))
1919      (im-commit-raw yc)))
1920
1921(yahoo-jp-configure-widgets)
1922(register-im
1923 'yahoo-jp
1924 "ja"
1925 "EUC-JP"
1926 yahoo-jp-im-name-label
1927 yahoo-jp-im-short-desc
1928 #f
1929 yahoo-jp-init-handler
1930 yahoo-jp-release-handler
1931 context-mode-handler
1932 yahoo-jp-press-key-handler
1933 yahoo-jp-release-key-handler
1934 yahoo-jp-reset-handler
1935 yahoo-jp-get-candidate-handler
1936 yahoo-jp-set-candidate-index-handler
1937 context-prop-activate-handler
1938 #f
1939 #f
1940 #f
1941 #f
1942 #f
1943 )
1944