← Back to branch summary

~ubuntu-branches/ubuntu/hardy/uim/hardy

« back to all changes in this revision

Viewing changes to scm/anthy.scm

  • Committer: Bazaar Package Importer
  • Author(s): Masahito Omote
  • Date: 2007-04-21 03:46:09 UTC
  • mfrom: (1.1.6 upstream)
  • Revision ID: james.westby@ubuntu.com-20070421034609-gpcurkutp8vaysqj
Tags: 1:1.4.1-3
* Switch to dh_gtkmodules for the gtk 2.10 transition (Closes:
  #419318)
  - debian/control: Add ${misc:Depends} and remove libgtk2.0-bin on
    uim-gtk2.0.
  - debian/uim-gtk2.0.post{inst,rm}: Removed.

Show diffs side-by-side

added added

removed removed

Lines of Context:
scm/anthy.scm
1
1
;;; anthy.scm: Anthy for uim.
2
2
;;; charset: EUC-JP
3
3
;;;
4
 
;;; Copyright (c) 2003-2006 uim Project http://uim.freedesktop.org/
 
4
;;; Copyright (c) 2003-2007 uim Project http://uim.freedesktop.org/
5
5
;;;
6
6
;;; All rights reserved.
7
7
;;;
45
45
(define anthy-lib-initialized? #f)
46
46
(define anthy-version #f)
47
47
 
48
 
(define anthy-type-direct         -1)
49
 
(define anthy-type-hiragana        0)
50
 
(define anthy-type-katakana        1)
51
 
(define anthy-type-halfkana        2)
52
 
(define anthy-type-halfwidth-alnum 3)
53
 
(define anthy-type-fullwidth-alnum 4)
 
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
54
 
55
55
(define anthy-input-rule-roma 0)
56
56
(define anthy-input-rule-kana 1)
59
59
(define anthy-candidate-type-katakana -2)
60
60
(define anthy-candidate-type-hiragana -3)
61
61
(define anthy-candidate-type-halfkana -4)
62
 
(define anthy-candidate-type-halfwidth-alnum -5) ; not defined in Anthy
63
 
(define anthy-candidate-type-fullwidth-alnum -6) ; not defined in Anthy
 
62
;; below are not defined in Anthy
 
63
(define anthy-candidate-type-halfwidth-alnum -5)
 
64
(define anthy-candidate-type-fullwidth-alnum -6)
 
65
(define anthy-candidate-type-upper-halfwidth-alnum -7)
 
66
(define anthy-candidate-type-upper-fullwidth-alnum -8)
64
67
 
65
68
;; I don't think the key needs to be customizable.
66
69
(define-key anthy-space-key? '(" "))
226
229
                   (anthy-prepare-input-rule-activation ac)
227
230
                   (rk-context-set-rule! (anthy-context-rkc ac)
228
231
                                         ja-rk-rule)
 
232
                   (japanese-roma-set-yen-representation)
229
233
                   (anthy-context-set-input-rule! ac anthy-input-rule-roma)))
230
234
 
231
235
(register-action 'action_anthy_kana
244
248
                   (anthy-context-set-input-rule! ac anthy-input-rule-kana)
245
249
                   (anthy-context-change-kana-mode! ac (anthy-context-kana-mode ac))
246
250
                   (anthy-context-set-alnum! ac #f)
 
251
                   (japanese-roma-set-yen-representation)
247
252
                   ;;(define-key anthy-kana-toggle-key? "")
248
253
                   ;;(define-key anthy-on-key? generic-on-key?)
249
254
                   ;;(define-key anthy-fullwidth-alnum-key? "")
264
269
                   (anthy-prepare-input-rule-activation ac)
265
270
                   (rk-context-set-rule! (anthy-context-rkc ac)
266
271
                                         ja-azik-rule)
 
272
                   (japanese-roma-set-yen-representation)
267
273
                   (anthy-context-set-input-rule! ac anthy-input-rule-azik)))
268
274
 
269
275
;; Update widget definitions based on action configurations. The
397
403
           (string-append-map-ustr-latter extract-kana preconv-str))))))
398
404
 
399
405
(define anthy-make-raw-string
400
 
  (lambda (raw-str-list wide?)
 
406
  (lambda (raw-str-list wide? upper?)
401
407
    (if (not (null? raw-str-list))
402
408
        (if wide?
403
409
            (string-append
404
410
             (ja-string-list-to-wide-alphabet
405
 
              (string-to-list (car raw-str-list)))
406
 
             (anthy-make-raw-string (cdr raw-str-list) wide?))
 
411
              (if upper?
 
412
                  (map
 
413
                   (lambda (x)
 
414
                     (if (char-alphabetic? (string->charcode x))
 
415
                         (charcode->string (char-upcase (string->charcode x)))
 
416
                         x))
 
417
                   (string-to-list (car raw-str-list)))
 
418
                  (string-to-list (car raw-str-list))))
 
419
             (anthy-make-raw-string (cdr raw-str-list) wide? upper?))
407
420
            (string-append
408
 
             (car raw-str-list)
409
 
             (anthy-make-raw-string (cdr raw-str-list) wide?)))
 
421
             (if upper?
 
422
                 (string-list-concat
 
423
                  (map
 
424
                   (lambda (x)
 
425
                     (if (char-alphabetic? (string->charcode x))
 
426
                         (charcode->string (char-upcase (string->charcode x)))
 
427
                         x))
 
428
                   (string-to-list (car raw-str-list))))
 
429
                 (car raw-str-list))
 
430
             (anthy-make-raw-string (cdr raw-str-list) wide? upper?)))
410
431
        "")))
411
432
 
412
433
(define anthy-make-whole-raw-string
413
 
  (lambda (ac wide?)
414
 
    (anthy-make-raw-string (anthy-get-raw-str-seq ac) wide?)))
 
434
  (lambda (ac wide? upper?)
 
435
    (anthy-make-raw-string (anthy-get-raw-str-seq ac) wide? upper?)))
415
436
 
416
437
(define anthy-init-handler
417
438
  (lambda (id im arg)
530
551
    (anthy-context-set-converting! ac #f)
531
552
    (ustr-clear! (anthy-context-segments ac))))
532
553
 
 
554
(define kana-keys?
 
555
  (lambda (key)
 
556
    (if (not (symbol? key))
 
557
        #f
 
558
        (cond
 
559
         ((eq? 'kana-lock key)
 
560
          #f)
 
561
         ((eq? 'kana-shift key)
 
562
          #f)
 
563
         (else
 
564
           (let ((name (symbol->string key)))
 
565
             (if (> (string-length name) 5)
 
566
                 (let ((keysym-head
 
567
                        (string-list-concat
 
568
                       (list-head (reverse (string-to-list name)) 5))))
 
569
                   (if (string=? keysym-head "-anak") ;; reverse
 
570
                       #t
 
571
                       #f))
 
572
                 #f)))))))
 
573
 
 
574
(define anthy-non-composing-symbol?
 
575
  (lambda (ac key)
 
576
    (if (and
 
577
         (symbol? key)
 
578
         (not (kana-keys? key))
 
579
         (not (eq? key 'yen)))
 
580
        #t
 
581
        #f)))
 
582
 
533
583
(define anthy-proc-input-state-no-preedit
534
584
  (lambda (ac key key-state)
535
585
    (let ((rkc (anthy-context-rkc ac))
623
673
                              anthy-type-halfwidth-alnum)))
624
674
            (im-commit ac (list-ref ja-space (anthy-context-kana-mode ac)))))
625
675
 
626
 
       ((symbol? key)
 
676
       ((anthy-non-composing-symbol? ac key)
627
677
        (anthy-commit-raw ac))
628
678
 
629
679
       (else
630
680
        (if (anthy-context-alnum ac)
631
 
            (let ((key-str (charcode->string key)))
 
681
            (let ((key-str (if (symbol? key)
 
682
                               (if (symbol-bound? key)
 
683
                                   (symbol-value key)
 
684
                                   "?") ;; shouldn't happen
 
685
                               (charcode->string key))))
632
686
              (ustr-insert-elem! (anthy-context-preconv-ustr ac)
633
687
                                 (if (= (anthy-context-alnum-type ac)
634
 
                                        anthy-type-halfwidth-alnum)
 
688
                                        anthy-type-halfwidth-alnum)
635
689
                                     (list key-str key-str key-str)
636
690
                                     (list (ja-wide key-str) (ja-wide key-str)
637
 
                                           (ja-wide key-str))))
 
691
                                           (ja-wide key-str))))
638
692
              (ustr-insert-elem! (anthy-context-raw-ustr ac) key-str))
639
 
            (let* ((key-str (charcode->string
640
 
                             (if (= rule anthy-input-rule-kana)
641
 
                                 key
642
 
                                 (to-lower-char key))))
 
693
            (let* ((key-str (if (= rule anthy-input-rule-kana)
 
694
                                (if (symbol? key)
 
695
                                    (symbol->string key)
 
696
                                    (charcode->string key))
 
697
                                (if (symbol? key)
 
698
                                    (symbol->string key)
 
699
                                    (charcode->string (to-lower-char key)))))
643
700
                   (res (rk-push-key! rkc key-str)))
644
701
              (if res
645
702
                  (begin
646
703
                    (ustr-insert-elem! (anthy-context-preconv-ustr ac) res)
647
 
                    (ustr-insert-elem! (anthy-context-raw-ustr ac) key-str))
 
704
                    (ustr-insert-elem! (anthy-context-raw-ustr ac)
 
705
                                       (if (and (intern-key-symbol key-str)
 
706
                                                (symbol-bound?
 
707
                                                 (string->symbol key-str)))
 
708
                                           (symbol-value
 
709
                                            (string->symbol key-str))
 
710
                                           key-str)))
648
711
                  (if (null? (rk-context-seq rkc))
649
712
                      (anthy-commit-raw ac))))))))))
650
713
 
653
716
    (or (not (ustr-empty? (anthy-context-preconv-ustr ac)))
654
717
        (> (string-length (rk-pending (anthy-context-rkc ac))) 0))))
655
718
 
 
719
(define anthy-rotate-transposing-alnum-type
 
720
  (lambda (cur-type state)
 
721
    (cond
 
722
     ((and
 
723
       (= cur-type anthy-type-halfwidth-alnum)
 
724
       (= state anthy-type-halfwidth-alnum))
 
725
      anthy-candidate-type-upper-halfwidth-alnum)
 
726
     ((and
 
727
       (= cur-type anthy-type-fullwidth-alnum)
 
728
       (= state anthy-type-fullwidth-alnum))
 
729
      anthy-candidate-type-upper-fullwidth-alnum)
 
730
     (else
 
731
      state))))
 
732
 
656
733
(define anthy-proc-transposing-state
657
734
  (lambda (ac key key-state)
658
735
    (let ((rotate-list '())
673
750
            (if (and lst
674
751
                     (not (null? (cdr lst))))
675
752
                (set! state (car (cdr lst)))
676
 
                (set! state (car rotate-list))))
 
753
                (set! state (anthy-rotate-transposing-alnum-type
 
754
                             (anthy-context-transposing-type ac)
 
755
                             (car rotate-list)))))
677
756
          (begin
678
757
            (anthy-context-set-transposing! ac #t)
679
758
            (set! state (car rotate-list))))
680
759
 
681
760
      (cond
682
 
       ((= state anthy-type-hiragana)
683
 
        (anthy-context-set-transposing-type! ac anthy-type-hiragana))
684
 
       ((= state anthy-type-katakana)
685
 
        (anthy-context-set-transposing-type! ac anthy-type-katakana))
686
 
       ((= state anthy-type-halfkana)
687
 
        (anthy-context-set-transposing-type! ac anthy-type-halfkana))
688
 
       ((= state anthy-type-halfwidth-alnum)
689
 
        (if (not (= (anthy-context-input-rule ac)
690
 
                    anthy-input-rule-kana))
691
 
            (anthy-context-set-transposing-type!
692
 
             ac anthy-type-halfwidth-alnum)))
693
 
       ((= state anthy-type-fullwidth-alnum)
694
 
        (if (not (= (anthy-context-input-rule ac)
695
 
                    anthy-input-rule-kana))
696
 
            (anthy-context-set-transposing-type!
697
 
             ac anthy-type-fullwidth-alnum)))
 
761
       ((or
 
762
         (= state anthy-type-hiragana)
 
763
         (= state anthy-type-katakana)
 
764
         (= state anthy-type-halfkana))
 
765
        (anthy-context-set-transposing-type! ac state))
 
766
       ((or
 
767
         (= state anthy-type-halfwidth-alnum)
 
768
         (= state anthy-candidate-type-upper-halfwidth-alnum)
 
769
         (= state anthy-type-fullwidth-alnum)
 
770
         (= state anthy-candidate-type-upper-fullwidth-alnum))
 
771
        (if (not (= (anthy-context-input-rule ac) anthy-input-rule-kana))
 
772
            (anthy-context-set-transposing-type! ac state)))
698
773
       (else
699
774
        (and
700
775
         ; commit
733
808
              (anthy-prev-candidate-key? key key-state)
734
809
              (and (modifier-key-mask key-state)
735
810
                   (not (shift-key-mask key-state)))
736
 
              (symbol? key))
 
811
              (anthy-non-composing-symbol? ac key))
737
812
             #f
738
813
             #t)
739
814
         ; implicit commit
1096
1171
             (not (shift-key-mask key-state)))
1097
1172
        #f)
1098
1173
 
1099
 
       ((symbol? key)
1100
 
        #f)
 
1174
       ((anthy-non-composing-symbol? ac key)
 
1175
        #f)
1101
1176
 
1102
1177
       (else    
1103
1178
        ;; handle "n1" sequence as "��1"
1105
1180
                 (not (alphabet-char? key))
1106
1181
                 (not (string-find
1107
1182
                       (rk-expect rkc)
1108
 
                       (charcode->string
1109
 
                        (if (= rule anthy-input-rule-kana)
1110
 
                            key
1111
 
                            (to-lower-char key))))))
 
1183
                       (if (= rule anthy-input-rule-kana)
 
1184
                           (if (symbol? key)
 
1185
                               (symbol->string key)
 
1186
                               (charcode->string key))
 
1187
                           (if (symbol? key)
 
1188
                               (symbol->string key)
 
1189
                               (charcode->string (to-lower-char key)))))))
1112
1190
            (let ((pend (rk-pending rkc))
1113
1191
                  (residual-kana (rk-push-key-last! rkc)))
1114
1192
              (if residual-kana
1117
1195
                    (ustr-insert-elem! raw-str pend)))))
1118
1196
 
1119
1197
        (if (anthy-context-alnum ac)
1120
 
            (let ((key-str (charcode->string key))
 
1198
            (let ((key-str (if (symbol? key)
 
1199
                               (if (symbol-bound? key)
 
1200
                                   (symbol-value key)
 
1201
                                   "?") ;; shouldn't happen
 
1202
                               (charcode->string key)))
1121
1203
                  (pend (rk-pending rkc))
1122
1204
                  (residual-kana (rk-peek-terminal-match rkc)))
1123
1205
              (rk-flush rkc) ;; OK to reset rkc here.
1132
1214
                                     (list (ja-wide key-str) (ja-wide key-str)
1133
1215
                                           (ja-wide key-str))))
1134
1216
              (ustr-insert-elem! raw-str key-str))
1135
 
            (let* ((key-str (charcode->string 
1136
 
                             (if (= rule anthy-input-rule-kana)
1137
 
                                 key
1138
 
                                 (to-lower-char key))))
 
1217
            (let* ((key-str (if (= rule anthy-input-rule-kana)
 
1218
                                (if (symbol? key)
 
1219
                                    (symbol->string key)
 
1220
                                    (charcode->string key))
 
1221
                                (if (symbol? key)
 
1222
                                    (symbol->string key)
 
1223
                                    (charcode->string (to-lower-char key)))))
1139
1224
                   (pend (rk-pending rkc))
1140
1225
                   (res (rk-push-key! rkc key-str)))
1141
1226
              (if (and res
1151
1236
                        (if (list? (car res))
1152
1237
                            (begin
1153
1238
                              (ustr-insert-elem! raw-str pend)
1154
 
                              (ustr-insert-elem! raw-str key-str))
 
1239
                              (ustr-insert-elem!
 
1240
                               raw-str (if (and (intern-key-symbol key-str)
 
1241
                                                (symbol-bound?
 
1242
                                                 (string->symbol key-str)))
 
1243
                                           (symbol-value
 
1244
                                            (string->symbol key-str))
 
1245
                                           key-str)))
1155
1246
                            (ustr-insert-elem!
1156
1247
                             raw-str
1157
 
                             (string-append pend key-str)))))))))))))
 
1248
                             (string-append
 
1249
                              pend
 
1250
                              (if (and
 
1251
                                   (intern-key-symbol key-str)
 
1252
                                   (symbol-bound? (string->symbol key-str)))
 
1253
                                  (symbol-value (string->symbol key-str))
 
1254
                                  key-str))))))))))))))
1158
1255
 
1159
1256
(define anthy-context-confirm-kana!
1160
1257
  (lambda (ac)
1227
1324
  (lambda (ac)
1228
1325
    (let* ((transposing-type (anthy-context-transposing-type ac)))
1229
1326
      (cond
1230
 
       ((= transposing-type anthy-type-hiragana)
1231
 
        (anthy-make-whole-string ac #t anthy-type-hiragana))
1232
 
 
1233
 
       ((= transposing-type anthy-type-katakana)
1234
 
        (anthy-make-whole-string ac #t anthy-type-katakana))
1235
 
 
1236
 
       ((= transposing-type anthy-type-halfkana)
1237
 
        (anthy-make-whole-string ac #t anthy-type-halfkana))
1238
 
 
 
1327
       ((or
 
1328
         (= transposing-type anthy-type-hiragana)
 
1329
         (= transposing-type anthy-type-katakana)
 
1330
         (= transposing-type anthy-type-halfkana))
 
1331
        (anthy-make-whole-string ac #t transposing-type))
1239
1332
       ((= transposing-type anthy-type-halfwidth-alnum)
1240
 
        (anthy-make-whole-raw-string ac #f))
1241
 
 
 
1333
        (anthy-make-whole-raw-string ac #f #f))
 
1334
       ((= transposing-type anthy-candidate-type-upper-halfwidth-alnum)
 
1335
        (anthy-make-whole-raw-string ac #f #t))
1242
1336
       ((= transposing-type anthy-type-fullwidth-alnum)
1243
 
        (anthy-make-whole-raw-string ac #t))
1244
 
       ))))
 
1337
        (anthy-make-whole-raw-string ac #t #f))
 
1338
       ((= transposing-type anthy-candidate-type-upper-fullwidth-alnum)
 
1339
        (anthy-make-whole-raw-string ac #t #t))))))
1245
1340
 
1246
1341
(define anthy-get-raw-str-seq
1247
1342
  (lambda (ac)
1273
1368
                (if start
1274
1369
                    (anthy-make-raw-string
1275
1370
                     (reverse (sublist raw-str start (+ start (- len 1))))
1276
 
                     (if (= cand-idx anthy-candidate-type-halfwidth-alnum)
 
1371
                     (if (or
 
1372
                          (= cand-idx anthy-candidate-type-halfwidth-alnum)
 
1373
                          (= cand-idx
 
1374
                             anthy-candidate-type-upper-halfwidth-alnum))
 
1375
                         #f
 
1376
                         #t)
 
1377
                     (if (or
 
1378
                          (= cand-idx anthy-candidate-type-halfwidth-alnum)
 
1379
                          (= cand-idx anthy-candidate-type-fullwidth-alnum))
1277
1380
                         #f
1278
1381
                         #t))
1279
1382
                    "??")) ;; FIXME
1473
1576
          (anthy-context-set-candidate-window! ac #f)))
1474
1577
    (anthy-context-set-candidate-op-count! ac 0)))
1475
1578
 
 
1579
(define anthy-rotate-segment-transposing-alnum-type
 
1580
  (lambda (idx state)
 
1581
    (cond
 
1582
     ((and
 
1583
       (= idx anthy-candidate-type-halfwidth-alnum)
 
1584
       (= state anthy-candidate-type-halfwidth-alnum))
 
1585
      anthy-candidate-type-upper-halfwidth-alnum)
 
1586
     ((and
 
1587
       (= idx anthy-candidate-type-fullwidth-alnum)
 
1588
       (= state anthy-candidate-type-fullwidth-alnum))
 
1589
      anthy-candidate-type-upper-fullwidth-alnum)
 
1590
     (else
 
1591
      state))))
 
1592
 
1476
1593
(define anthy-set-segment-transposing
1477
1594
  (lambda (ac key key-state)
1478
1595
    (let ((segments (anthy-context-segments ac)))
1506
1623
                 (= idx anthy-candidate-type-katakana)
1507
1624
                 (= idx anthy-candidate-type-halfkana)
1508
1625
                 (= idx anthy-candidate-type-halfwidth-alnum)
1509
 
                 (= idx anthy-candidate-type-fullwidth-alnum))
 
1626
                 (= idx anthy-candidate-type-fullwidth-alnum)
 
1627
                 (= idx anthy-candidate-type-upper-halfwidth-alnum)
 
1628
                 (= idx anthy-candidate-type-upper-fullwidth-alnum))
1510
1629
                (let ((lst (member idx rotate-list)))
1511
 
                  (if (and (not (null? lst))
 
1630
                  (if (and lst
1512
1631
                           (not (null? (cdr lst))))
1513
1632
                      (set! state (car (cdr lst)))
1514
 
                      (set! state (car rotate-list))))
 
1633
                      (set! state (anthy-rotate-segment-transposing-alnum-type
 
1634
                                   idx (car rotate-list)))))
1515
1635
                (set! state (car rotate-list)))
1516
1636
             (ustr-cursor-set-frontside! segments state))
1517
1637
          ;; below anthy-7802
1591
1711
           (not (shift-key-mask key-state)))
1592
1712
      #f)  ;; use #f rather than () to conform to R5RS
1593
1713
 
1594
 
     ((symbol? key)
 
1714
     ((anthy-non-composing-symbol? ac key)
1595
1715
      #f)
1596
1716
 
1597
1717
     (else
1668
1788
 anthy-get-candidate-handler
1669
1789
 anthy-set-candidate-index-handler
1670
1790
 context-prop-activate-handler
 
1791
 #f
 
1792
 #f
 
1793
 #f
 
1794
 #f
 
1795
 #f
1671
1796
)