← Back to branch summary

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

« back to all changes in this revision

Viewing changes to scm/mana.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/mana.scm
1
1
;;; mana.scm: mana 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
;;;
175
175
                 (if start
176
176
                     (mana-make-raw-string
177
177
                      (reverse (sublist raw-str start (+ start (- len 1))))
178
 
                      (if (= cand-idx mana-candidate-type-halfwidth-alnum)
 
178
                      (if (or
 
179
                           (= cand-idx mana-candidate-type-halfwidth-alnum)
 
180
                           (= cand-idx
 
181
                              mana-candidate-type-upper-halfwidth-alnum))
 
182
                          #f
 
183
                          #t)
 
184
                      (if (or
 
185
                           (= cand-idx mana-candidate-type-halfwidth-alnum)
 
186
                           (= cand-idx mana-candidate-type-fullwidth-alnum))
179
187
                          #f
180
188
                          #t))
181
189
                     "??")) ;; FIXME
274
282
(define mana-candidate-type-halfkana -4)
275
283
(define mana-candidate-type-halfwidth-alnum -5)
276
284
(define mana-candidate-type-fullwidth-alnum -6)
 
285
(define mana-candidate-type-upper-halfwidth-alnum -7)
 
286
(define mana-candidate-type-upper-fullwidth-alnum -8)
277
287
 
278
288
;; I don't think the key needs to be customizable.
279
289
(define-key mana-space-key? '(" "))
607
617
           (string-append-map-ustr-latter extract-kana preconv-str))))))
608
618
 
609
619
(define mana-make-raw-string
610
 
  (lambda (raw-str-list wide?)
 
620
  (lambda (raw-str-list wide? upper?)
611
621
    (if (not (null? raw-str-list))
612
622
        (if wide?
613
623
            (string-append
614
 
              (ja-string-list-to-wide-alphabet (string-to-list (car raw-str-list)))
615
 
              (mana-make-raw-string (cdr raw-str-list) wide?))
 
624
              (ja-string-list-to-wide-alphabet 
 
625
                (if upper?
 
626
                    (map charcode->string
 
627
                         (map char-upcase
 
628
                              (map string->charcode
 
629
                                   (string-to-list (car raw-str-list)))))
 
630
                    (string-to-list (car raw-str-list))))
 
631
              (mana-make-raw-string (cdr raw-str-list) wide? upper?))
616
632
            (string-append
617
 
              (car raw-str-list)
618
 
              (mana-make-raw-string (cdr raw-str-list) wide?)))
 
633
              (if upper?
 
634
                  (string-list-concat
 
635
                   (map charcode->string
 
636
                        (map char-upcase
 
637
                             (map string->charcode
 
638
                                  (string-to-list (car raw-str-list))))))
 
639
                  (car raw-str-list))
 
640
              (mana-make-raw-string (cdr raw-str-list) wide? upper?)))
619
641
        "")))
620
642
 
621
643
(define mana-make-whole-raw-string
622
 
  (lambda (mc wide?)
623
 
    (mana-make-raw-string (mana-get-raw-str-seq mc) wide?)))
 
644
  (lambda (mc wide? upper?)
 
645
    (mana-make-raw-string (mana-get-raw-str-seq mc) wide? upper?)))
624
646
 
625
647
(define mana-init-handler
626
648
  (lambda (id im arg)
864
886
    (or (not (ustr-empty? (mana-context-preconv-ustr mc)))
865
887
        (> (string-length (rk-pending (mana-context-rkc mc))) 0))))
866
888
 
 
889
(define mana-rotate-transposing-alnum-type
 
890
  (lambda (cur-type state)
 
891
    (cond
 
892
     ((and
 
893
       (= cur-type mana-type-halfwidth-alnum)
 
894
       (= state mana-type-halfwidth-alnum))
 
895
      mana-candidate-type-upper-halfwidth-alnum)
 
896
     ((and
 
897
       (= cur-type mana-type-fullwidth-alnum)
 
898
       (= state mana-type-fullwidth-alnum))
 
899
      mana-candidate-type-upper-fullwidth-alnum)
 
900
     (else
 
901
      state))))
 
902
 
867
903
(define mana-proc-transposing-state
868
904
  (lambda (mc key key-state)
869
905
    (let ((rotate-list '())
884
920
            (if (and lst
885
921
                     (not (null? (cdr lst))))
886
922
                (set! state (car (cdr lst)))
887
 
                (set! state (car rotate-list))))
 
923
                (set! state (mana-rotate-transposing-alnum-type
 
924
                             (mana-context-transposing-type mc)
 
925
                             (car rotate-list)))))
888
926
          (begin
889
927
            (mana-context-set-transposing! mc #t)
890
928
            (set! state (car rotate-list))))
891
929
 
892
930
      (cond
893
 
       ((= state mana-type-hiragana)
894
 
        (mana-context-set-transposing-type! mc mana-type-hiragana))
895
 
       ((= state mana-type-katakana)
896
 
        (mana-context-set-transposing-type! mc mana-type-katakana))
897
 
       ((= state mana-type-halfkana)
898
 
        (mana-context-set-transposing-type! mc mana-type-halfkana))
899
 
       ((= state mana-type-halfwidth-alnum)
900
 
        (if (not (= (mana-context-input-rule mc)
901
 
                    mana-input-rule-kana))
902
 
            (mana-context-set-transposing-type! mc mana-type-halfwidth-alnum)))
903
 
       ((= state mana-type-fullwidth-alnum)
904
 
        (if (not (= (mana-context-input-rule mc)
905
 
                    mana-input-rule-kana))
906
 
            (mana-context-set-transposing-type! mc mana-type-fullwidth-alnum)))
 
931
       ((or
 
932
         (= state mana-type-hiragana)
 
933
         (= state mana-type-katakana)
 
934
         (= state mana-type-halfkana))
 
935
        (mana-context-set-transposing-type! mc state))
 
936
       ((or
 
937
         (= state mana-type-halfwidth-alnum)
 
938
         (= state mana-candidate-type-upper-halfwidth-alnum)
 
939
         (= state mana-type-fullwidth-alnum)
 
940
         (= state mana-candidate-type-upper-fullwidth-alnum))
 
941
        (if (not (= (mana-context-input-rule mc)
 
942
                    mana-input-rule-kana))
 
943
            (mana-context-set-transposing-type! mc state)))
907
944
       (else
908
945
        (and
909
946
         ; commit
1217
1254
  (lambda (mc)
1218
1255
    (let* ((transposing-type (mana-context-transposing-type mc)))
1219
1256
      (cond
1220
 
       ((= transposing-type mana-type-hiragana)
1221
 
        (mana-make-whole-string mc #t mana-type-hiragana))
1222
 
       ((= transposing-type mana-type-katakana)
1223
 
        (mana-make-whole-string mc #t mana-type-katakana))
1224
 
       ((= transposing-type mana-type-halfkana)
1225
 
        (mana-make-whole-string mc #t mana-type-halfkana))
 
1257
       ((or
 
1258
         (= transposing-type mana-type-hiragana)
 
1259
         (= transposing-type mana-type-katakana)
 
1260
         (= transposing-type mana-type-halfkana))
 
1261
        (mana-make-whole-string mc #t transposing-type))
1226
1262
       ((= transposing-type mana-type-halfwidth-alnum)
1227
 
        (mana-make-whole-raw-string mc #f))
 
1263
        (mana-make-whole-raw-string mc #f #f))
 
1264
       ((= transposing-type mana-candidate-type-upper-halfwidth-alnum)
 
1265
        (mana-make-whole-raw-string mc #f #t))
1228
1266
       ((= transposing-type mana-type-fullwidth-alnum)
1229
 
        (mana-make-whole-raw-string mc #t))))))
 
1267
        (mana-make-whole-raw-string mc #t #f))
 
1268
       ((= transposing-type mana-candidate-type-upper-fullwidth-alnum)
 
1269
        (mana-make-whole-raw-string mc #t #t))))))
1230
1270
 
1231
1271
(define mana-converting-state-preedit
1232
1272
  (lambda (mc)
1389
1429
          (mana-context-set-candidate-window! mc #f)))
1390
1430
    (mana-context-set-candidate-op-count! mc 0)))
1391
1431
 
 
1432
(define mana-rotate-segment-transposing-alnum-type
 
1433
  (lambda (idx state)
 
1434
    (cond
 
1435
     ((and
 
1436
       (= idx mana-candidate-type-halfwidth-alnum)
 
1437
       (= state mana-candidate-type-halfwidth-alnum))
 
1438
      mana-candidate-type-upper-halfwidth-alnum)
 
1439
     ((and
 
1440
       (= idx mana-candidate-type-fullwidth-alnum)
 
1441
       (= state mana-candidate-type-fullwidth-alnum))
 
1442
      mana-candidate-type-upper-fullwidth-alnum)
 
1443
     (else
 
1444
      state))))
 
1445
 
1392
1446
(define mana-set-segment-transposing
1393
1447
  (lambda (mc key key-state)
1394
1448
    (let ((segments (mana-context-segments mc)))
1418
1472
             (= idx mana-candidate-type-katakana)
1419
1473
             (= idx mana-candidate-type-halfkana)
1420
1474
             (= idx mana-candidate-type-halfwidth-alnum)
1421
 
             (= idx mana-candidate-type-fullwidth-alnum))
 
1475
             (= idx mana-candidate-type-fullwidth-alnum)
 
1476
             (= idx mana-candidate-type-upper-halfwidth-alnum)
 
1477
             (= idx mana-candidate-type-upper-fullwidth-alnum))
1422
1478
            (let ((lst (member idx rotate-list)))
1423
 
              (if (and (not (null? lst))
 
1479
              (if (and lst
1424
1480
                       (not (null? (cdr lst))))
1425
1481
                  (set! state (car (cdr lst)))
1426
 
                  (set! state (car rotate-list))))
 
1482
                  (set! state (mana-rotate-segment-transposing-alnum-type
 
1483
                               idx (car rotate-list)))))
1427
1484
            (set! state (car rotate-list)))
1428
1485
        (ustr-cursor-set-frontside! segments state)))))
1429
1486
 
1567
1624
  mana-get-candidate-handler
1568
1625
  mana-set-candidate-index-handler
1569
1626
  context-prop-activate-handler
 
1627
  #f
 
1628
  #f
 
1629
  #f
 
1630
  #f
 
1631
  #f
1570
1632
  )