← Back to branch summary

~ubuntu-branches/ubuntu/maverick/uim/maverick

« back to all changes in this revision

Viewing changes to scm/canna.scm

  • Committer: Bazaar Package Importer
  • Author(s): Masahito Omote
  • Date: 2008-06-25 19:56:33 UTC
  • mfrom: (3.1.18 intrepid)
  • Revision ID: james.westby@ubuntu.com-20080625195633-8jljph4rfq00l8o7
Tags: 1:1.5.1-2
http://bugs.debian.org/482659
http://bugs.debian.org/483078
* uim-tcode: provide tutcode-custom.scm, tutcode-bushudic.scm
  and tutcode-rule.scm (Closes: #482659)
* Fix FTBFS: segv during compile (Closes: #483078).
  I personally think this bug is not specific for uim but is a optimization
  problem on gcc-4.3.1. (https://bugs.freedesktop.org/show_bug.cgi?id=16477)

Show diffs side-by-side

added added

removed removed

Lines of Context:
scm/canna.scm
1
1
;;; canna.scm: Canna for uim.
2
2
;;;
3
 
;;; Copyright (c) 2003-2006 uim Project http://uim.freedesktop.org/
 
3
;;; Copyright (c) 2003-2008 uim Project http://code.google.com/p/uim/
4
4
;;;
5
5
;;; All rights reserved.
6
6
;;;
58
58
(define canna-candidate-type-halfkana -4)
59
59
(define canna-candidate-type-halfwidth-alnum -5)
60
60
(define canna-candidate-type-fullwidth-alnum -6)
 
61
(define canna-candidate-type-upper-halfwidth-alnum -7)
 
62
(define canna-candidate-type-upper-fullwidth-alnum -8)
61
63
 
62
64
;; I don't think the key needs to be customizable.
63
65
(define-key canna-space-key? '(" "))
262
264
   context-rec-spec
263
265
   (list
264
266
    (list 'on                 #f)
265
 
    (list 'state              ())
 
267
    (list 'state              #f)
266
268
    (list 'transposing        #f)
267
269
    (list 'transposing-type    0)
268
270
    (list 'cc-id              ()) ;; canna-context-id
269
271
    (list 'preconv-ustr       #f) ;; preedit strings
270
272
    (list 'rkc                ())
271
273
    (list 'segments           #f) ;; ustr of candidate indices
272
 
    (list 'candidate-window   ())
273
 
    (list 'candidate-op-count ())
 
274
    (list 'candidate-window   #f)
 
275
    (list 'candidate-op-count 0)
274
276
    (list 'kana-mode          canna-type-hiragana)
275
277
    (list 'alnum              #f)
276
278
    (list 'alnum-type         canna-type-halfwidth-alnum)
288
290
    (canna-context-set-cc-id! cc (canna-lib-alloc-context))
289
291
    (canna-context-set-widgets! cc canna-widgets)
290
292
    (canna-context-set-rkc! cc rkc)
291
 
    (canna-context-set-preconv-ustr! cc (ustr-new))
292
 
    (canna-context-set-raw-ustr! cc (ustr-new))
293
 
    (canna-context-set-segments! cc (ustr-new))
 
293
    (canna-context-set-preconv-ustr! cc (ustr-new '()))
 
294
    (canna-context-set-raw-ustr! cc (ustr-new '()))
 
295
    (canna-context-set-segments! cc (ustr-new '()))
294
296
    (if using-kana-table?
295
297
        (canna-context-set-input-rule! cc canna-input-rule-kana)
296
298
        (canna-context-set-input-rule! cc canna-input-rule-roma))
357
359
           (string-append-map-ustr-latter extract-kana preconv-str))))))
358
360
 
359
361
(define canna-make-raw-string
360
 
  (lambda (raw-str-list wide?)
 
362
  (lambda (raw-str-list wide? upper?)
361
363
    (if (not (null? raw-str-list))
362
364
        (if wide?
363
365
            (string-append
364
366
             (ja-string-list-to-wide-alphabet
365
 
              (string-to-list (car raw-str-list)))
366
 
             (canna-make-raw-string (cdr raw-str-list) wide?))
 
367
              (if upper?
 
368
                  (map charcode->string
 
369
                       (map ichar-upcase
 
370
                            (map string->charcode
 
371
                                 (string-to-list (car raw-str-list)))))
 
372
                  (string-to-list (car raw-str-list))))
 
373
             (canna-make-raw-string (cdr raw-str-list) wide? upper?))
367
374
            (string-append
368
 
             (car raw-str-list)
369
 
             (canna-make-raw-string (cdr raw-str-list) wide?)))
 
375
             (if upper?
 
376
                 (string-list-concat
 
377
                  (map charcode->string
 
378
                       (map ichar-upcase
 
379
                            (map string->charcode
 
380
                                 (string-to-list (car raw-str-list))))))
 
381
                 (car raw-str-list))
 
382
             (canna-make-raw-string (cdr raw-str-list) wide? upper?)))
370
383
        "")))
371
384
 
372
385
(define canna-make-whole-raw-string
373
 
  (lambda (cc wide?)
374
 
    (canna-make-raw-string (canna-get-raw-str-seq cc) wide?)))
 
386
  (lambda (cc wide? upper?)
 
387
    (canna-make-raw-string (canna-get-raw-str-seq cc) wide? upper?)))
375
388
 
376
389
(define (canna-init-handler id im arg)
377
390
  (if (not canna-init-lib-ok?)
382
395
 
383
396
(define (canna-release-handler cc)
384
397
  (let ((cc-id (canna-context-cc-id cc)))
385
 
    (if (number? cc-id)
 
398
    (if cc-id
386
399
        (canna-lib-release-context cc-id))))
387
400
 
388
401
(define (canna-flush cc)
457
470
(define (canna-begin-conv cc)
458
471
  (let ((cc-id (canna-context-cc-id cc))
459
472
        (preconv-str (canna-make-whole-string cc #t canna-type-hiragana)))
460
 
    (if (and (number? cc-id)
 
473
    (if (and cc-id
461
474
             (> (string-length preconv-str) 0))
462
475
        (let ((num (canna-lib-begin-conversion cc-id preconv-str)))
463
476
          (if num
587
600
          (let* ((key-str (charcode->string
588
601
                           (if (= rule canna-input-rule-kana)
589
602
                               key
590
 
                               (to-lower-char key))))
 
603
                               (ichar-downcase key))))
591
604
                 (res (rk-push-key! rkc key-str)))
592
605
            (if res
593
606
                (begin
600
613
  (or (not (ustr-empty? (canna-context-preconv-ustr cc)))
601
614
      (> (string-length (rk-pending (canna-context-rkc cc))) 0)))
602
615
 
 
616
(define canna-rotate-transposing-alnum-type
 
617
  (lambda (cur-type state)
 
618
    (cond
 
619
     ((and
 
620
       (= cur-type canna-type-halfwidth-alnum)
 
621
       (= state canna-type-halfwidth-alnum))
 
622
      canna-candidate-type-upper-halfwidth-alnum)
 
623
     ((and
 
624
       (= cur-type canna-type-fullwidth-alnum)
 
625
       (= state canna-type-fullwidth-alnum))
 
626
      canna-candidate-type-upper-fullwidth-alnum)
 
627
     (else
 
628
      state))))
 
629
 
603
630
(define canna-proc-transposing-state
604
631
  (lambda (cc key key-state)
605
632
    (let ((rotate-list '())
620
647
            (if (and lst
621
648
                     (not (null? (cdr lst))))
622
649
                (set! state (car (cdr lst)))
623
 
                (set! state (car rotate-list))))
 
650
                (if (not (null? rotate-list))
 
651
                    (set! state (canna-rotate-transposing-alnum-type
 
652
                                 (canna-context-transposing-type cc)
 
653
                                 (car rotate-list))))))
624
654
          (begin
625
655
            (canna-context-set-transposing! cc #t)
626
656
            (set! state (car rotate-list))))
627
657
 
628
658
      (cond
629
 
       ((= state canna-type-hiragana)
630
 
        (canna-context-set-transposing-type! cc canna-type-hiragana))
631
 
       ((= state canna-type-katakana)
632
 
        (canna-context-set-transposing-type! cc canna-type-katakana))
633
 
       ((= state canna-type-halfkana)
634
 
        (canna-context-set-transposing-type! cc canna-type-halfkana))
635
 
       ((= state canna-type-halfwidth-alnum)
636
 
        (if (not (= (canna-context-input-rule cc) canna-input-rule-kana))
637
 
            (canna-context-set-transposing-type!
638
 
             cc canna-type-halfwidth-alnum)))
639
 
       ((= state canna-type-fullwidth-alnum)
640
 
        (if (not (= (canna-context-input-rule cc) canna-input-rule-kana))
641
 
            (canna-context-set-transposing-type!
642
 
             cc canna-type-fullwidth-alnum)))
 
659
       ((and state
 
660
             (or
 
661
              (= state canna-type-hiragana)
 
662
              (= state canna-type-katakana)
 
663
              (= state canna-type-halfkana)))
 
664
        (canna-context-set-transposing-type! cc state))
 
665
       ((and state
 
666
             (or
 
667
              (= state canna-type-halfwidth-alnum)
 
668
              (= state canna-candidate-type-upper-halfwidth-alnum)
 
669
              (= state canna-type-fullwidth-alnum)
 
670
              (= state canna-candidate-type-upper-fullwidth-alnum)))
 
671
        (if (not (= (canna-context-input-rule cc) canna-input-rule-kana))
 
672
            (canna-context-set-transposing-type! cc state)))
643
673
       (else
644
674
        (and
645
675
         ; commit
708
738
            (if (and
709
739
                 (= (canna-context-input-rule cc) canna-input-rule-roma)
710
740
                 (not (null? (ustr-former-seq preconv-str)))
711
 
                 (not (char-printable?
712
 
                       (string->char
 
741
                 (not (ichar-printable?
 
742
                       (string->ichar
713
743
                        (car (last (ustr-former-seq preconv-str)))))))
714
744
                (ja-fix-deleted-raw-str-to-valid-roma! raw-str)))))
715
745
 
849
879
     (else
850
880
      ;; handle "n1" sequence as "��1"
851
881
      (if (and (not (canna-context-alnum cc))
852
 
               (not (alphabet-char? key))
 
882
               (not (ichar-alphabetic? key))
853
883
               (not (string-find
854
884
                     (rk-expect rkc)
855
885
                     (charcode->string
856
886
                      (if (= rule canna-input-rule-kana)
857
887
                          key
858
 
                          (to-lower-char key))))))
 
888
                          (ichar-downcase key))))))
859
889
          (let ((pend (rk-pending rkc))
860
890
                (residual-kana (rk-push-key-last! rkc)))
861
891
            (if residual-kana
882
912
          (let* ((key-str (charcode->string
883
913
                           (if (= rule canna-input-rule-kana)
884
914
                               key
885
 
                               (to-lower-char key))))
 
915
                               (ichar-downcase key))))
886
916
                 (pend (rk-pending rkc))
887
917
                 (res (rk-push-key! rkc key-str)))
888
918
            (if (and res
922
952
 
923
953
(define canna-separator
924
954
  (lambda (cc)
925
 
    (let ((attr (bit-or preedit-separator preedit-underline)))
 
955
    (let ((attr (bitwise-ior preedit-separator preedit-underline)))
926
956
      (if canna-show-segment-separator?
927
957
          (cons attr canna-segment-separator)
928
958
          #f))))
937
967
  (lambda (cc)
938
968
    (let ((transposing-type (canna-context-transposing-type cc)))
939
969
      (cond
940
 
       ((= transposing-type canna-type-hiragana)
941
 
        (canna-make-whole-string cc #t canna-type-hiragana))
942
 
       ((= transposing-type canna-type-katakana)
943
 
        (canna-make-whole-string cc #t canna-type-katakana))
944
 
       ((= transposing-type canna-type-halfkana)
945
 
        (canna-make-whole-string cc #t canna-type-halfkana))
 
970
       ((or
 
971
         (= transposing-type canna-type-hiragana)
 
972
         (= transposing-type canna-type-katakana)
 
973
         (= transposing-type canna-type-halfkana))
 
974
        (canna-make-whole-string cc #t transposing-type))
946
975
       ((= transposing-type canna-type-halfwidth-alnum)
947
 
        (canna-make-whole-raw-string cc #f))
 
976
        (canna-make-whole-raw-string cc #f #f))
 
977
       ((= transposing-type canna-candidate-type-upper-halfwidth-alnum)
 
978
        (canna-make-whole-raw-string cc #f #t))
948
979
       ((= transposing-type canna-type-fullwidth-alnum)
949
 
        (canna-make-whole-raw-string cc #t))))))
 
980
        (canna-make-whole-raw-string cc #t #f))
 
981
       ((= transposing-type canna-candidate-type-upper-fullwidth-alnum)
 
982
        (canna-make-whole-raw-string cc #t #t))))))
950
983
 
951
984
(define canna-get-raw-str-seq
952
985
  (lambda (cc)
957
990
           (right-str (ustr-latter-seq raw-str))
958
991
           (left-str (ustr-former-seq raw-str)))
959
992
     (append left-str
960
 
             (if (not (null? residual-kana))
961
 
                 (list pending))
 
993
             (if residual-kana
 
994
                 (list pending)
 
995
                 '())
962
996
              right-str))))
963
997
 
964
998
(define canna-get-raw-candidate
985
1019
                      (len (length unconv)))
986
1020
                  (if start
987
1021
                      (canna-make-raw-string
988
 
                       (reverse (sublist raw-str start (+ start (- len 1))))
989
 
                       (if (= cand-idx canna-candidate-type-halfwidth-alnum)
 
1022
                       (reverse (sublist-rel raw-str start len))
 
1023
                       (if (or
 
1024
                            (= cand-idx canna-candidate-type-halfwidth-alnum)
 
1025
                            (= cand-idx
 
1026
                               canna-candidate-type-upper-halfwidth-alnum))
 
1027
                           #f
 
1028
                           #t)
 
1029
                       (if (or
 
1030
                            (= cand-idx canna-candidate-type-halfwidth-alnum)
 
1031
                            (= cand-idx canna-candidate-type-fullwidth-alnum))
990
1032
                           #f
991
1033
                           #t))
992
1034
                      "??")) ;; FIXME
1001
1043
    (append-map
1002
1044
     (lambda (seg-idx cand-idx)
1003
1045
       (let* ((attr (if (= seg-idx cur-seg)
1004
 
                        (bit-or preedit-reverse
1005
 
                                preedit-cursor)
 
1046
                        (bitwise-ior preedit-reverse
 
1047
                                     preedit-cursor)
1006
1048
                        preedit-underline))
1007
1049
              (cand (if (> cand-idx canna-candidate-type-katakana)
1008
1050
                        (canna-lib-get-nth-candidate cc-id seg-idx cand-idx)
1052
1094
(define (canna-commit-string cc)
1053
1095
  (let ((cc-id (canna-context-cc-id cc))
1054
1096
        (segments (canna-context-segments cc)))
1055
 
    (for-each (lambda (seg-idx cand-idx)
1056
 
                (if (> cand-idx canna-candidate-type-katakana)
1057
 
                    (canna-lib-commit-segment cc-id seg-idx cand-idx)))
1058
 
              (iota (ustr-length segments))
1059
 
              (ustr-whole-seq segments))
1060
 
    (if (every (lambda (x) (<= x canna-candidate-type-katakana))
1061
 
               (ustr-whole-seq segments))
1062
 
        (canna-lib-reset-conversion cc-id))))
 
1097
    (if cc-id
 
1098
        (begin
 
1099
          (for-each (lambda (seg-idx cand-idx)
 
1100
                      (if (> cand-idx canna-candidate-type-katakana)
 
1101
                          (canna-lib-commit-segment cc-id seg-idx cand-idx)))
 
1102
                    (iota (ustr-length segments))
 
1103
                    (ustr-whole-seq segments))
 
1104
          (if (every (lambda (x) (<= x canna-candidate-type-katakana))
 
1105
                     (ustr-whole-seq segments))
 
1106
              (canna-lib-reset-conversion cc-id))))))
1063
1107
 
1064
1108
(define (canna-do-commit cc)
1065
1109
    (im-commit cc (canna-get-commit-string cc))
1126
1170
           (cur-page (if (= canna-nr-candidate-max 0)
1127
1171
                         0
1128
1172
                         (quotient n canna-nr-candidate-max)))
1129
 
           (pageidx (- (numeral-char->number numeralc) 1))
 
1173
           (pageidx (- (numeric-ichar->integer numeralc) 1))
1130
1174
           (compensated-pageidx (cond
1131
1175
                                 ((< pageidx 0) ; pressing key_0
1132
1176
                                  (+ pageidx 10))
1150
1194
        (canna-context-set-candidate-window! cc #f)))
1151
1195
  (canna-context-set-candidate-op-count! cc 0))
1152
1196
 
 
1197
(define canna-rotate-segment-transposing-alnum-type
 
1198
  (lambda (idx state)
 
1199
    (cond
 
1200
     ((and
 
1201
       (= idx canna-candidate-type-halfwidth-alnum)
 
1202
       (= state canna-candidate-type-halfwidth-alnum))
 
1203
      canna-candidate-type-upper-halfwidth-alnum)
 
1204
     ((and
 
1205
       (= idx canna-candidate-type-fullwidth-alnum)
 
1206
       (= state canna-candidate-type-fullwidth-alnum))
 
1207
      canna-candidate-type-upper-fullwidth-alnum)
 
1208
     (else
 
1209
      state))))
 
1210
 
1153
1211
(define canna-set-segment-transposing
1154
1212
  (lambda (cc key key-state)
1155
1213
    (let ((segments (canna-context-segments cc)))
1179
1237
             (= idx canna-candidate-type-katakana)
1180
1238
             (= idx canna-candidate-type-halfkana)
1181
1239
             (= idx canna-candidate-type-halfwidth-alnum)
1182
 
             (= idx canna-candidate-type-fullwidth-alnum))
 
1240
             (= idx canna-candidate-type-fullwidth-alnum)
 
1241
             (= idx canna-candidate-type-upper-halfwidth-alnum)
 
1242
             (= idx canna-candidate-type-upper-fullwidth-alnum))
1183
1243
            (let ((lst (member idx rotate-list)))
1184
 
              (if (and (not (null? lst))
 
1244
              (if (and lst
1185
1245
                       (not (null? (cdr lst))))
1186
1246
                  (set! state (car (cdr lst)))
1187
 
                  (set! state (car rotate-list))))
 
1247
                  (set! state (canna-rotate-segment-transposing-alnum-type
 
1248
                               idx (car rotate-list)))))
1188
1249
            (set! state (car rotate-list)))
1189
1250
        (ustr-cursor-set-frontside! segments state)))))
1190
1251
 
1248
1309
      (canna-cancel-conv cc))
1249
1310
 
1250
1311
     ((and canna-select-candidate-by-numeral-key?
1251
 
           (numeral-char? key)
 
1312
           (ichar-numeric? key)
1252
1313
           (canna-context-candidate-window cc))
1253
1314
      (canna-move-candidate-in-page cc key))
1254
1315
 
1265
1326
        (canna-proc-input-state cc key key-state))))))
1266
1327
 
1267
1328
(define (canna-press-key-handler cc key key-state)
1268
 
  (if (control-char? key)
 
1329
  (if (ichar-control? key)
1269
1330
      (im-commit-raw cc)
1270
1331
      (if (canna-context-on cc)
1271
1332
          (if (canna-context-transposing cc)
1278
1339
 
1279
1340
;;;
1280
1341
(define (canna-release-key-handler cc key key-state)
1281
 
  (if (or (control-char? key)
 
1342
  (if (or (ichar-control? key)
1282
1343
          (not (canna-context-on cc)))
1283
1344
      (canna-commit-raw cc)))
1284
1345
;;;
1322
1383
 canna-reset-handler
1323
1384
 canna-get-candidate-handler
1324
1385
 canna-set-candidate-index-handler
1325
 
 context-prop-activate-handler)
 
1386
 context-prop-activate-handler
 
1387
 #f
 
1388
 #f
 
1389
 #f
 
1390
 #f
 
1391
 #f
 
1392
 )