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