← Back to branch summary

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

« back to all changes in this revision

Viewing changes to scm/tutcode.scm

  • Committer: Bazaar Package Importer
  • Author(s): Masahito Omote
  • Date: 2009-03-01 12:57:00 UTC
  • mfrom: (1.1.10 upstream)
  • Revision ID: james.westby@ubuntu.com-20090301125700-0ykjdq0zgj55e3n3
Tags: 1:1.5.5-1
New upstream release and final upload by current maintainter.

Show diffs side-by-side

added added

removed removed

Lines of Context:
scm/tutcode.scm
1
1
;;;
2
 
;;; Copyright (c) 2003-2008 uim Project http://code.google.com/p/uim/
 
2
;;; Copyright (c) 2003-2009 uim Project http://code.google.com/p/uim/
3
3
;;;
4
4
;;; All rights reserved.
5
5
;;;
85
85
;;;  * �򤼽��Ѵ��Ǥ�SKK�����μ����Ȥ��Τǡ�
86
86
;;;    skk.scm�Τ��ʴ����Ѵ���������ɬ�פ���ʬ������ߡ�
87
87
;;;  * ��������Ѵ���ǽ���ɲá�
 
88
;;;  * �������ϥ⡼�ɤ��ɲá�
88
89
 
89
90
(require "generic.scm")
90
91
(require-custom "tutcode-custom.scm")
92
93
(require-custom "tutcode-key-custom.scm")
93
94
(load-plugin "skk") ;SKK�����θ򤼽񤭼���θ����Τ��ᡢlibuim-skk.so�������
94
95
(require "tutcode-bushudic.scm") ;��������Ѵ�����
 
96
(require "tutcode-kigoudic.scm") ;�������ϥ⡼���Ѥε���ɽ
95
97
 
96
98
;;; user configs
97
99
 
107
109
(define tutcode-input-mode-actions
108
110
  '(action_tutcode_direct
109
111
    action_tutcode_hiragana
110
 
    action_tutcode_katakana))
 
112
    action_tutcode_katakana
 
113
    action_tutcode_kigou))
111
114
 
112
115
;;; ���Ѥ��륳����ɽ��
113
116
;;; tutcode-context-new����(tutcode-custom-load-rule!)������
118
121
;;; tutcode-context-new����ȿ�Ǥ��롣
119
122
(define tutcode-rule-userconfig ())
120
123
 
121
 
;;; ���������ѥ�٥�ʸ���Υꥹ��
 
124
;;; �򤼽��Ѵ����θ��������ѥ�٥�ʸ���Υꥹ��
122
125
(define tutcode-heading-label-char-list
123
126
  '("1" "2" "3" "4" "5" "6" "7" "8" "9" "0"
124
127
    "a" "b" "c" "d" "e" "f" "g" "h" "i" "j"
128
131
    "K" "L" "M" "N" "O" "P" "Q" "R" "S" "T"
129
132
    "U" "V" "W" "X" "Y" "Z"))
130
133
 
 
134
;;; �������ϥ⡼�ɻ��θ��������ѥ�٥�ʸ���Υꥹ��
 
135
;;; (���ѱѿ��⡼�ɤȤ��ƻȤ��ˤϡ�tutcode-kigoudic�ȹ�碌��ɬ�פ���)
 
136
(define tutcode-heading-label-char-list-for-kigou-mode
 
137
  '(" "
 
138
    "1" "2" "3" "4" "5" "6" "7" "8" "9" "0"
 
139
    "a" "b" "c" "d" "e" "f" "g" "h" "i" "j"
 
140
    "k" "l" "m" "n" "o" "p" "q" "r" "s" "t"
 
141
    "u" "v" "w" "x" "y" "z"
 
142
    "-" "^" "\\" "@" "[" ";" ":" "]" "," "." "/"
 
143
    "!" "\"" "#" "$" "%" "&" "'" "(" ")"
 
144
    "A" "B" "C" "D" "E" "F" "G" "H" "I" "J"
 
145
    "K" "L" "M" "N" "O" "P" "Q" "R" "S" "T"
 
146
    "U" "V" "W" "X" "Y" "Z"
 
147
    "=" "~" "|" "`" "{" "+" "*" "}" "<" ">" "?" "_"))
 
148
 
131
149
;;; implementations
132
150
 
133
151
;;; �򤼽��Ѵ�����ν����������äƤ��뤫�ɤ���
160
178
                     "�Ҥ餬�ʥ⡼��"))
161
179
                 (lambda (tc)
162
180
                   (and (tutcode-context-on? tc)
 
181
                        (not (eq? (tutcode-context-state tc)
 
182
                                  'tutcode-state-kigou))
163
183
                        (not (tutcode-context-katakana-mode? tc))))
164
184
                 (lambda (tc)
165
185
                   (tutcode-prepare-activation tc)
166
 
                   (if (not (tutcode-context-on? tc)) ; �Ѵ�����֤��ѹ����ʤ�
167
 
                     (tutcode-context-set-state! tc 'tutcode-state-on))
168
 
                   (tutcode-context-set-katakana-mode! tc #f)))
 
186
                   (if
 
187
                     (or
 
188
                       (not (tutcode-context-on? tc)) ; �Ѵ�����֤��ѹ����ʤ�
 
189
                       (eq? (tutcode-context-state tc) 'tutcode-state-kigou))
 
190
                     (begin
 
191
                       (tutcode-reset-candidate-window tc)
 
192
                       (tutcode-context-set-state! tc 'tutcode-state-on)))
 
193
                   (tutcode-context-set-katakana-mode! tc #f)
 
194
                   (tutcode-update-preedit tc)))
169
195
 
170
196
(register-action 'action_tutcode_katakana
171
197
                 (lambda (tc)
175
201
                     "�������ʥ⡼��"))
176
202
                 (lambda (tc)
177
203
                   (and (tutcode-context-on? tc)
 
204
                        (not (eq? (tutcode-context-state tc)
 
205
                                  'tutcode-state-kigou))
178
206
                        (tutcode-context-katakana-mode? tc)))
179
207
                 (lambda (tc)
180
208
                   (tutcode-prepare-activation tc)
181
 
                   (if (not (tutcode-context-on? tc)) ; �Ѵ�����֤��ѹ����ʤ�
182
 
                     (tutcode-context-set-state! tc 'tutcode-state-on))
183
 
                   (tutcode-context-set-katakana-mode! tc #t)))
 
209
                   (if
 
210
                     (or
 
211
                       (not (tutcode-context-on? tc)) ; �Ѵ�����֤��ѹ����ʤ�
 
212
                       (eq? (tutcode-context-state tc) 'tutcode-state-kigou))
 
213
                     (begin
 
214
                       (tutcode-reset-candidate-window tc)
 
215
                       (tutcode-context-set-state! tc 'tutcode-state-on)))
 
216
                   (tutcode-context-set-katakana-mode! tc #t)
 
217
                   (tutcode-update-preedit tc)))
 
218
 
 
219
(register-action 'action_tutcode_kigou
 
220
                 (lambda (tc)
 
221
                   '(ja_fullwidth_alnum
 
222
                     "��"
 
223
                     "��������"
 
224
                     "�������ϥ⡼��"))
 
225
                 (lambda (tc)
 
226
                   (eq? (tutcode-context-state tc) 'tutcode-state-kigou))
 
227
                 (lambda (tc)
 
228
                   (tutcode-prepare-activation tc)
 
229
                   (if
 
230
                     (not (eq? (tutcode-context-state tc) 'tutcode-state-kigou))
 
231
                     (tutcode-flush tc))
 
232
                   (tutcode-begin-kigou-mode tc)
 
233
                   (tutcode-update-preedit tc)))
184
234
 
185
235
;; Update widget definitions based on action configurations. The
186
236
;; procedure is needed for on-the-fly reconfiguration involving the
201
251
     ;;; 'tutcode-state-yomi �򤼽��Ѵ����ɤ�������
202
252
     ;;; 'tutcode-state-converting �򤼽��Ѵ��θ���������
203
253
     ;;; 'tutcode-state-bushu �������ϡ��Ѵ���
 
254
     ;;; 'tutcode-state-kigou �������ϥ⡼��
204
255
     (state 'tutcode-state-off)
205
256
     ;;; �������ʥ⡼�ɤ��ɤ���
206
257
     ;;; #t: �������ʥ⡼�ɡ�#f: �Ҥ餬�ʥ⡼�ɡ�
303
354
                n (tutcode-make-string head) "" "" #f)))
304
355
    cand))
305
356
 
 
357
;;; �������ϥ⡼�ɻ���n���ܤθ�����֤���
 
358
;;; @param n �оݤθ����ֹ�
 
359
(define (tutcode-get-nth-candidate-for-kigou-mode pc n)
 
360
 (car (nth n tutcode-kigoudic)))
 
361
 
306
362
;;; �򤼽��Ѵ���θ���������θ�����֤���
307
363
;;; @param pc ����ƥ����ȥꥹ��
308
364
(define (tutcode-get-current-candidate pc)
309
365
  (tutcode-get-nth-candidate pc (tutcode-context-nth pc)))
310
366
 
 
367
;;; �������ϥ⡼�ɻ��θ���������θ�����֤���
 
368
(define (tutcode-get-current-candidate-for-kigou-mode pc)
 
369
  (tutcode-get-nth-candidate-for-kigou-mode pc (tutcode-context-nth pc)))
 
370
 
311
371
;;; �򤼽��Ѵ��dz��ꤷ��ʸ������֤���
312
372
;;; @param pc ����ƥ����ȥꥹ��
313
373
(define (tutcode-prepare-commit-string pc)
326
386
    (tutcode-flush pc)
327
387
    res))
328
388
 
329
 
;;; ���ꤵ�줿��٥�ʸ�����б�����������ꤹ��
 
389
;;; �������ϥ⡼�ɻ��˳��ꤷ��ʸ������֤���
 
390
(define (tutcode-prepare-commit-string-for-kigou-mode pc)
 
391
  (tutcode-get-current-candidate-for-kigou-mode pc))
 
392
 
 
393
;;; �򤼽��Ѵ��θ���������ˡ����ꤵ�줿��٥�ʸ�����б�����������ꤹ��
330
394
(define (tutcode-commit-by-label-key pc ch)
 
395
  ;; ���߸��䥦����ɥ���ɽ������Ƥ��ʤ���٥�ʸ�������Ϥ�����硢
 
396
  ;; ���߰ʹߤθ�����ˤ��������ϥ�٥�ʸ�����б�����������ꤹ�롣
 
397
  ;; (�ؽ���ǽ�򥪥դˤ��Ƹ�����¤ӽ�����ˤ��ƻ��Ѥ�����ˡ�
 
398
  ;; next-page-key�򲡤�����򸺤餷��
 
399
  ;; �ʤ�٤����ʤ���������Ū�θ�������٤�褦�ˤ��뤿��)
331
400
  (let* ((nr (tutcode-context-nr-candidates pc))
332
401
         (nth (tutcode-context-nth pc))
333
402
         (cur-page (cond
334
403
                     ((= tutcode-nr-candidate-max 0) 0)
335
404
                     (else
336
405
                       (quotient nth tutcode-nr-candidate-max))))
 
406
         ;; ���߸��䥦����ɥ���ɽ����θ���ꥹ�Ȥ���Ƭ�θ����ֹ�
337
407
         (cur-offset (* cur-page tutcode-nr-candidate-max))
338
408
         (cur-labels (list-tail
339
409
                       tutcode-heading-label-char-list
353
423
        (tutcode-context-set-nth! pc idx)
354
424
        (im-commit pc (tutcode-prepare-commit-string pc))))))
355
425
 
 
426
;;; �������ϥ⡼�ɻ��ˡ����ꤵ�줿��٥�ʸ�����б�����������ꤹ��
 
427
(define (tutcode-commit-by-label-key-for-kigou-mode pc ch)
 
428
  ;; �򤼽��Ѵ����Ȱۤʤꡢ���ߤ�����θ������ꤹ���礢��
 
429
  ;; (���ѱѿ����ϥ⡼�ɤȤ��ƻȤ���褦�ˤ��뤿��)��
 
430
  ;; (�������ϥ⡼�ɻ��ϡ����ٳ��ꤷ�������Ϣ³�������ϤǤ���褦�ˡ�
 
431
  ;; ������ľ���θ�������򤷤Ƥ��뤬��
 
432
  ;; ���ΤȤ��򤼽��Ѵ�����Ʊ�ͤθ��������Ԥ��ȡ�
 
433
  ;; ��٥�ʸ���ꥹ�Ȥ�2���ܤ��б�����������ꤷ�Ƥ��ޤ���礬����
 
434
  ;; (��:th���Ǥä���硢���ѱѿ����ϤȤ��Ƥϣ���ˤʤä��ߤ������������ˤʤ�)
 
435
  ;; ���ᡢ�򤼽��Ѵ��Ȥϰۤʤ������������Ԥ�)
 
436
  (let* ((nr (tutcode-context-nr-candidates pc))
 
437
         (nth (tutcode-context-nth pc))
 
438
         (labellen (length tutcode-heading-label-char-list-for-kigou-mode))
 
439
         (cur-base (quotient nth labellen))
 
440
         (offset
 
441
           (- labellen
 
442
              (length
 
443
                (member ch tutcode-heading-label-char-list-for-kigou-mode))))
 
444
         (idx (+ (* cur-base labellen) offset)))
 
445
    (if (and (>= idx 0)
 
446
             (< idx nr))
 
447
      (begin
 
448
        (tutcode-context-set-nth! pc idx)
 
449
        (im-commit pc (tutcode-prepare-commit-string-for-kigou-mode pc))))))
 
450
 
356
451
;;; �򤼽��Ѵ����ɤ�/��������Ѵ�������(ʸ����ꥹ��head)��ʸ������ɲä��롣
357
452
;;; @param pc ����ƥ����ȥꥹ��
358
453
;;; @param str �ɲä���ʸ����
383
478
      ;(tutcode-flush pc) ; ����̵����flush��������Ϥ���ʸ���󤬾ä��Ƥ��ä���
384
479
      )))
385
480
 
 
481
;;; �������ϥ⡼�ɤ򳫻Ϥ��롣
 
482
;;; @param pc ����ƥ����ȥꥹ��
 
483
(define (tutcode-begin-kigou-mode pc)
 
484
  (tutcode-context-set-nth! pc 0)
 
485
  (tutcode-context-set-nr-candidates! pc (length tutcode-kigoudic))
 
486
  (tutcode-context-set-state! pc 'tutcode-state-kigou)
 
487
  (tutcode-check-candidate-window-begin pc)
 
488
  (if (tutcode-context-candidate-window pc)
 
489
    (im-select-candidate pc 0)))
 
490
 
386
491
;;; ���䥦����ɥ���ɽ���򳫻Ϥ���
387
492
(define (tutcode-check-candidate-window-begin pc)
388
493
  (if (and (not (tutcode-context-candidate-window pc))
414
519
      ((tutcode-state-bushu)
415
520
        (let ((h (tutcode-make-string (tutcode-context-head pc))))
416
521
          (if (string? h)
417
 
            (im-pushback-preedit pc preedit-none h)))))
 
522
            (im-pushback-preedit pc preedit-none h))))
 
523
      ((tutcode-state-kigou)
 
524
        ;; ���䥦����ɥ���ɽ�����Ǥ��������Ǥ���褦��preeditɽ��
 
525
        (im-pushback-preedit pc preedit-reverse
 
526
          (tutcode-get-current-candidate-for-kigou-mode pc))))
418
527
    (im-pushback-preedit pc preedit-cursor "")
419
528
    (im-update-preedit pc)))
420
529
 
434
543
      ((tutcode-off-key? key key-state)
435
544
       (rk-flush rkc)
436
545
       (tutcode-context-set-state! pc 'tutcode-state-off))
 
546
      ((tutcode-kigou-toggle-key? key key-state)
 
547
       (rk-flush rkc)
 
548
       (tutcode-begin-kigou-mode pc))
437
549
      ((tutcode-kana-toggle-key? key key-state)
438
550
       (rk-flush rkc)
439
551
       (tutcode-context-kana-toggle pc))
477
589
   (tutcode-context-set-state! pc 'tutcode-state-on)
478
590
   (im-commit-raw pc)))
479
591
 
 
592
;;; �������ϥ⡼�ɻ��Υ������Ϥ�������롣
 
593
;;; @param pc ����ƥ����ȥꥹ��
 
594
;;; @param key ���Ϥ��줿����
 
595
;;; @param key-state ����ȥ����륭�����ξ���
 
596
(define (tutcode-proc-state-kigou pc key key-state)
 
597
  (cond
 
598
    ((and
 
599
      (tutcode-vi-escape-key? key key-state)
 
600
      tutcode-use-with-vi?)
 
601
     (tutcode-reset-candidate-window pc)
 
602
     (tutcode-context-set-state! pc 'tutcode-state-off)
 
603
     (im-commit-raw pc)) ; ESC�����򥢥ץ�ˤ��Ϥ�
 
604
    ((tutcode-off-key? key key-state)
 
605
     (tutcode-reset-candidate-window pc)
 
606
     (tutcode-context-set-state! pc 'tutcode-state-off))
 
607
    ((tutcode-kigou-toggle-key? key key-state)
 
608
     (tutcode-reset-candidate-window pc)
 
609
     (tutcode-context-set-state! pc 'tutcode-state-on))
 
610
    ;; ���ڡ������������ѥ��ڡ������ϲ�ǽ�Ȥ��뤿�ᡢ
 
611
    ;; next-candidate-key?�Υ����å��������heading-label-char?������å�
 
612
    ((and tutcode-commit-candidate-by-label-key?
 
613
          (not (and (modifier-key-mask key-state)
 
614
                    (not (shift-key-mask key-state))))
 
615
          (tutcode-heading-label-char-for-kigou-mode? key))
 
616
      (tutcode-commit-by-label-key-for-kigou-mode pc (charcode->string key))
 
617
      (if (tutcode-context-candidate-window pc)
 
618
        (im-select-candidate pc (tutcode-context-nth pc))))
 
619
    ((tutcode-next-candidate-key? key key-state)
 
620
      (tutcode-change-candidate-index pc 1))
 
621
    ((tutcode-prev-candidate-key? key key-state)
 
622
      (tutcode-change-candidate-index pc -1))
 
623
    ((tutcode-cancel-key? key key-state)
 
624
      (tutcode-reset-candidate-window pc)
 
625
      (tutcode-begin-kigou-mode pc))
 
626
    ((tutcode-next-page-key? key key-state)
 
627
      (tutcode-change-candidate-index pc tutcode-nr-candidate-max))
 
628
    ((tutcode-prev-page-key? key key-state)
 
629
      (tutcode-change-candidate-index pc (- tutcode-nr-candidate-max)))
 
630
    ((or
 
631
      (tutcode-commit-key? key key-state)
 
632
      (tutcode-return-key? key key-state))
 
633
      (im-commit pc (tutcode-prepare-commit-string-for-kigou-mode pc)))
 
634
    ((or
 
635
      (symbol? key)
 
636
      (and
 
637
        (modifier-key-mask key-state)
 
638
        (not (shift-key-mask key-state))))
 
639
      (im-commit-raw pc))
 
640
    (else
 
641
      (im-commit-raw pc))))
 
642
 
480
643
;;; �򤼽��Ѵ����ɤ����Ͼ��֤ΤȤ��Υ������Ϥ�������롣
481
644
;;; @param pc ����ƥ����ȥꥹ��
482
645
;;; @param key ���Ϥ��줿����
665
828
(define (tutcode-heading-label-char? key)
666
829
  (member (charcode->string key) tutcode-heading-label-char-list))
667
830
 
 
831
;;; ���Ϥ��줿�������������ϥ⡼�ɻ��θ����٥�ʸ�����ɤ�����Ĵ�٤�
 
832
;;; @param key ���Ϥ��줿����
 
833
(define (tutcode-heading-label-char-for-kigou-mode? key)
 
834
  (member (charcode->string key) tutcode-heading-label-char-list-for-kigou-mode))
 
835
 
668
836
;;; �򤼽��Ѵ��θ���������֤ΤȤ��Υ������Ϥ�������롣
669
837
;;; @param pc ����ƥ����ȥꥹ��
670
838
;;; @param key ���Ϥ��줿����
812
980
;;; @param pc ����ƥ����ȥꥹ��
813
981
(define (tutcode-state-has-preedit? pc)
814
982
  (memq (tutcode-context-state pc)
815
 
    '(tutcode-state-yomi tutcode-state-bushu tutcode-state-converting)))
 
983
    '(tutcode-state-yomi tutcode-state-bushu tutcode-state-converting
 
984
                         tutcode-state-kigou)))
816
985
 
817
986
;;; �����������줿�Ȥ��ν����ο���ʬ����Ԥ���
818
987
;;; @param pc ����ƥ����ȥꥹ��
828
997
           (if (tutcode-state-has-preedit? pc)
829
998
             ;; �򤼽��Ѵ�����������Ѵ����ϡ����䢥��ɽ������
830
999
             (tutcode-update-preedit pc)))
 
1000
          ((tutcode-state-kigou)
 
1001
           (tutcode-proc-state-kigou pc key key-state)
 
1002
           (tutcode-update-preedit pc))
831
1003
          ((tutcode-state-yomi)
832
1004
           (tutcode-proc-state-yomi pc key key-state)
833
1005
           (tutcode-update-preedit pc))
871
1043
 
872
1044
;;; ���䥦����ɥ�������ʸ�����������뤿��˸Ƥִؿ�
873
1045
(define (tutcode-get-candidate-handler tc idx accel-enum-hint)
874
 
  (let ((cand (tutcode-get-nth-candidate tc idx))
875
 
        (n (remainder idx (length tutcode-heading-label-char-list))))
876
 
    (list cand (nth n tutcode-heading-label-char-list) "")))
 
1046
  (cond
 
1047
    ((eq? (tutcode-context-state tc) 'tutcode-state-kigou)
 
1048
      (let* ((cand (tutcode-get-nth-candidate-for-kigou-mode tc idx))
 
1049
             (n (remainder
 
1050
                  idx (length tutcode-heading-label-char-list-for-kigou-mode)))
 
1051
             (label (nth n tutcode-heading-label-char-list-for-kigou-mode)))
 
1052
        ;; XXX:annotationɽ���ϸ���̵��������Ƥ���Τǡ����""���֤��Ƥ���
 
1053
        (list cand label "")))
 
1054
    (else
 
1055
      (let* ((cand (tutcode-get-nth-candidate tc idx))
 
1056
             (n (remainder idx (length tutcode-heading-label-char-list)))
 
1057
             (label (nth n tutcode-heading-label-char-list)))
 
1058
        (list cand label "")))))
877
1059
 
878
1060
;;; ���䥦����ɥ�����������򤷤��Ȥ��˸Ƥִؿ�
879
1061
(define (tutcode-set-candidate-index-handler tc idx)