← Back to branch summary

~ubuntu-branches/ubuntu/trusty/uim/trusty

« back to all changes in this revision

Viewing changes to scm/baidu-olime-jp.scm

  • Committer: Package Import Robot
  • Author(s): HIGUCHI Daisuke (VDR dai), HIGUCHI Daisuke (VDR dai)
  • Date: 2012-05-17 20:12:04 UTC
  • mfrom: (1.1.14) (15.2.4 experimental) (15.1.15 sid)
  • Revision ID: package-import@ubuntu.com-20120517201204-7h5fwh5cvh79gjof
Tags: 1:1.8.0-2
[ HIGUCHI Daisuke (VDR dai) ]
upload to unstable.

Show diffs side-by-side

added added

removed removed

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