Author: deton.kih
Date: Sun Sep 14 22:09:41 2008
New Revision: 5569

Added:
   trunk/scm/tutcode-kigoudic.scm
Modified:
   trunk/scm/Makefile.am
   trunk/scm/tutcode-key-custom.scm
   trunk/scm/tutcode.scm

Log:
* This commit add kigou(symbol) input mode for tutcode

* scm/tutcode-key-custom.scm
  - (tutcode-kigou-toggle-key): New custom key definition

* scm/tutcode-kigoudic.scm
  - New file

* scm/tutcode.scm
  - (tutcode-input-mode-actions): Add action_tutcode_kigou
  - (tutcode-heading-label-char-list-for-kigou-mode): New variable
  - (action_tutcode_hiragana, action_tutcode_katakana):
    Change to support kigou mode
  - (action_tutcode_kigou): New action
  - (tutcode-get-nth-candidate-for-kigou-mode,
     tutcode-get-current-candidate-for-kigou-mode,
     tutcode-prepare-commit-string-for-kigou-mode,
     tutcode-commit-by-label-key-for-kigou-mode, tutcode-begin-kigou-mode,
     tutcode-proc-state-kigou, tutcode-heading-label-char-for-kigou-mode?):
    New function
  - (tutcode-update-preedit): Add update for kigou mode
  - (tutcode-proc-state-on): Add check of tutcode-kigou-toggle-key?
  - (tutcode-state-has-preedit?): Add tutcode-state-kigou
  - (tutcode-key-press-handler, tutcode-get-candidate-handler):
    Follow the addition of kigou mode

* scm/Makefile.am
  - (SCM_FILES): Add tutcode-kigoudic.scm


Modified: trunk/scm/Makefile.am
==============================================================================
--- trunk/scm/Makefile.am       (original)
+++ trunk/scm/Makefile.am       Sun Sep 14 22:09:41 2008
@@ -26,8 +26,8 @@
  skk.scm skk-editor.scm skk-custom.scm skk-key-custom.scm skk-dialog.scm \
  mana.scm mana-custom.scm mana-key-custom.scm \
  tcode.scm trycode.scm \
- tutcode.scm tutcode-key-custom.scm \
- tutcode-custom.scm tutcode-bushudic.scm tutcode-rule.scm \
+ tutcode.scm tutcode-custom.scm tutcode-key-custom.scm \
+ tutcode-bushudic.scm tutcode-rule.scm tutcode-kigoudic.scm \
  hangul.scm hangul2.scm hangul3.scm romaja.scm \
  byeoru.scm byeoru-dic.scm byeoru-symbols.scm \
  byeoru-custom.scm byeoru-key-custom.scm \

Modified: trunk/scm/tutcode-key-custom.scm
==============================================================================
--- trunk/scm/tutcode-key-custom.scm    (original)
+++ trunk/scm/tutcode-key-custom.scm    Sun Sep 14 22:09:41 2008
@@ -59,6 +59,12 @@
               (N_ "[TUT-Code] toggle hiragana/katakana mode")
               (N_ "long description will be here"))

+(define-custom 'tutcode-kigou-toggle-key '("<IgnoreShift><Control>_")
+               '(tutcode-keys1 mode-transition)
+               '(key)
+               (N_ "[TUT-Code] toggle kigou mode")
+               (N_ "long description will be here"))
+
 (define-custom 'tutcode-mazegaki-start-sequence "alj"
                '(tutcode-keys1 mode-transition)
               '(string ".*")

Added: trunk/scm/tutcode-kigoudic.scm
==============================================================================
--- (empty file)
+++ trunk/scm/tutcode-kigoudic.scm      Sun Sep 14 22:09:41 2008
@@ -0,0 +1,568 @@
+;;;
+;;; Copyright (c) 2008 uim Project http://code.google.com/p/uim/
+;;;
+;;; All rights reserved.
+;;;
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+;;; 1. Redistributions of source code must retain the above copyright
+;;;    notice, this list of conditions and the following disclaimer.
+;;; 2. Redistributions in binary form must reproduce the above copyright
+;;;    notice, this list of conditions and the following disclaimer in the
+;;;    documentation and/or other materials provided with the distribution.
+;;; 3. Neither the name of authors nor the names of its contributors
+;;; may be used to endorse or promote products derived from this software
+;;;    without specific prior written permission.
+;;;
+;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS'' AND
+;;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+;;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +;;; ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE +;;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+;;; OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+;;; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +;;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+;;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+;;; SUCH DAMAGE.
+;;;;
+
+;;; TUT-Code�ε������ϥ⡼���Ѥε���ɽ��
+;;; (��ѱѿ�⡼�ɤȤ��ƻȤ��ˤϡ�
+;;;  tutcode-heading-label-char-list-for-kigou-mode�ȹ�碌��ɬ�פ���)
+; ��������Ƹ��䥦����ɥ��ǰ������٤�褦�ˤ���������
+; ����(6355ʸ��)�������ȡ����䥦����ɥ�ɽ�����Ϥ˿����Ԥ������
+; (���䥦����ɥ�ɽ�����ϻ��������������뤿��)�Τ�̵��
+(define tutcode-kigoudic
+  '(
+    ;("����" "���Υơ������")
+    ;���Υơ������ϸ���̤���Ѥ�����Խ����λ��ͤˤ�ʤ�Τǰ�����Ϳ
+    ("��" "��ѥ��ڡ���") ;�������ϥ⡼����ܻ���preeditɽ���ǰ��´��ʤ��褦��
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��" "�ޥ��ʥ�")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+
+    ("��")
+    ("��" "����֥������")
+    ("��" "������")
+    ("��")
+    ("��")
+    ("��")
+    ("��" "�����󥰥������")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��" "����")
+    ("��" "�����󥰥������")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��" "�����")
+    ("��" "�����")
+    ("��")
+    ("��" "�������饤��")
+
+    ("��" "����")
+    ("��" "����")
+    ("��" "����")
+    ("��" "����")
+    ("��" "Ⱦ����")
+    ("��" "��������ƥ���")
+    ("��" "�������󥰥顼��")
+    ("��" "����饦��")
+    ("��" "�����С��饤��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��" "�����")
+    ("��" "������")
+    ("��" "����")
+    ("��" "�ϥ��ե�")
+    ("��")
+    ("��")
+    ("��")
+    ("��" "����֥������")
+    ("��" "����֥������") ;��Ф��������֥��������Ф����Ϥ��䤹���褦��
+    ("��")
+    ("��")
+    ("��" "�Ϥỳ���")
+    ("��" "����껳���")
+    ("��" "�Ϥ���Ż����")
+    ("��" "�����������")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��" "�軻����")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��" "��")
+    ("��" "ʬ")
+    ("��" "��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��" "�ݰ�")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��" "���˾�����")
+    ("��" "�����礭��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��" "���㡼��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��" "�礭�ʴ�")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��" "��������")
+    ("��" "��������")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+    ("��")
+))

Modified: trunk/scm/tutcode.scm
==============================================================================
--- trunk/scm/tutcode.scm       (original)
+++ trunk/scm/tutcode.scm       Sun Sep 14 22:09:41 2008
@@ -85,6 +85,7 @@
 ;;;  * �򤼽��Ѵ��Ǥ�SKK����μ����Ȥ��Τǡ�
 ;;;    skk.scm�Τ��ʴ���Ѵ������ɬ�פ���ʬ������ߡ�
 ;;;  * ������Ѵ���ǽ���ɲá�
+;;;  * �������ϥ⡼�ɤ��ɲá�

 (require "generic.scm")
 (require-custom "tutcode-custom.scm")
@@ -95,6 +96,7 @@
 (and-let* ((lib-path (find-module-lib-path uim-plugin-lib-load-path "skk"))
           (proc-ptrs (%%dynlib-bind lib-path))))
 (require "tutcode-bushudic.scm") ;������Ѵ�����
+(require "tutcode-kigoudic.scm") ;�������ϥ⡼���Ѥε���ɽ

 ;;; user configs

@@ -110,7 +112,8 @@
 (define tutcode-input-mode-actions
   '(action_tutcode_direct
     action_tutcode_hiragana
-    action_tutcode_katakana))
+    action_tutcode_katakana
+    action_tutcode_kigou))

 ;;; ���Ѥ��륳����ɽ��
 ;;; tutcode-context-new����(tutcode-custom-load-rule!)������
@@ -121,7 +124,7 @@
 ;;; tutcode-context-new����ȿ�Ǥ��롣
 (define tutcode-rule-userconfig ())

-;;; ��������ѥ�٥�ʸ��Υꥹ��
+;;; �򤼽��Ѵ����θ�������ѥ�٥�ʸ��Υꥹ��
 (define tutcode-heading-label-char-list
   '("1" "2" "3" "4" "5" "6" "7" "8" "9" "0"
     "a" "b" "c" "d" "e" "f" "g" "h" "i" "j"
@@ -131,6 +134,21 @@
     "K" "L" "M" "N" "O" "P" "Q" "R" "S" "T"
     "U" "V" "W" "X" "Y" "Z"))

+;;; �������ϥ⡼�ɻ��θ�������ѥ�٥�ʸ��Υꥹ��
+;;; (��ѱѿ�⡼�ɤȤ��ƻȤ��ˤϡ�tutcode-kigoudic�ȹ�碌��ɬ�פ���)
+(define tutcode-heading-label-char-list-for-kigou-mode
+  '(" "
+    "1" "2" "3" "4" "5" "6" "7" "8" "9" "0"
+    "a" "b" "c" "d" "e" "f" "g" "h" "i" "j"
+    "k" "l" "m" "n" "o" "p" "q" "r" "s" "t"
+    "u" "v" "w" "x" "y" "z"
+    "-" "^" "\\" "@" "[" ";" ":" "]" "," "." "/"
+    "!" "\"" "#" "$" "%" "&" "'" "(" ")"
+    "A" "B" "C" "D" "E" "F" "G" "H" "I" "J"
+    "K" "L" "M" "N" "O" "P" "Q" "R" "S" "T"
+    "U" "V" "W" "X" "Y" "Z"
+    "=" "~" "|" "`" "{" "+" "*" "}" "<" ">" "?" "_"))
+
 ;;; implementations

 ;;; �򤼽��Ѵ�����ν�����äƤ��뤫�ɤ���
@@ -163,12 +181,20 @@
                     "�Ҥ餬�ʥ⡼��"))
                 (lambda (tc)
                   (and (tutcode-context-on? tc)
+                        (not (eq? (tutcode-context-state tc)
+                                  'tutcode-state-kigou))
                        (not (tutcode-context-katakana-mode? tc))))
                 (lambda (tc)
                   (tutcode-prepare-activation tc)
-                   (if (not (tutcode-context-on? tc)) ; �Ѵ�����֤��ѹ����ʤ�
-                     (tutcode-context-set-state! tc 'tutcode-state-on))
-                  (tutcode-context-set-katakana-mode! tc #f)))
+                   (if
+                     (or
+                       (not (tutcode-context-on? tc)) ; �Ѵ�����֤��ѹ����ʤ�
+ (eq? (tutcode-context-state tc) 'tutcode-state-kigou))
+                     (begin
+                       (tutcode-reset-candidate-window tc)
+                       (tutcode-context-set-state! tc 'tutcode-state-on)))
+                   (tutcode-context-set-katakana-mode! tc #f)
+                   (tutcode-update-preedit tc)))

 (register-action 'action_tutcode_katakana
                 (lambda (tc)
@@ -178,12 +204,36 @@
                     "�������ʥ⡼��"))
                 (lambda (tc)
                   (and (tutcode-context-on? tc)
+                        (not (eq? (tutcode-context-state tc)
+                                  'tutcode-state-kigou))
                        (tutcode-context-katakana-mode? tc)))
                 (lambda (tc)
                   (tutcode-prepare-activation tc)
-                   (if (not (tutcode-context-on? tc)) ; �Ѵ�����֤��ѹ����ʤ�
-                     (tutcode-context-set-state! tc 'tutcode-state-on))
-                  (tutcode-context-set-katakana-mode! tc #t)))
+                   (if
+                     (or
+                       (not (tutcode-context-on? tc)) ; �Ѵ�����֤��ѹ����ʤ�
+ (eq? (tutcode-context-state tc) 'tutcode-state-kigou))
+                     (begin
+                       (tutcode-reset-candidate-window tc)
+                       (tutcode-context-set-state! tc 'tutcode-state-on)))
+                   (tutcode-context-set-katakana-mode! tc #t)
+                   (tutcode-update-preedit tc)))
+
+(register-action 'action_tutcode_kigou
+                 (lambda (tc)
+                   '(ja_fullwidth_alnum
+                     "��"
+                     "��������"
+                     "�������ϥ⡼��"))
+                 (lambda (tc)
+                   (eq? (tutcode-context-state tc) 'tutcode-state-kigou))
+                 (lambda (tc)
+                   (tutcode-prepare-activation tc)
+                   (if
+ (not (eq? (tutcode-context-state tc) 'tutcode-state-kigou))
+                     (tutcode-flush tc))
+                   (tutcode-begin-kigou-mode tc)
+                   (tutcode-update-preedit tc)))

 ;; Update widget definitions based on action configurations. The
 ;; procedure is needed for on-the-fly reconfiguration involving the
@@ -204,6 +254,7 @@
      ;;; 'tutcode-state-yomi �򤼽��Ѵ����ɤ�������
      ;;; 'tutcode-state-converting �򤼽��Ѵ��θ��������
      ;;; 'tutcode-state-bushu ������ϡ��Ѵ���
+     ;;; 'tutcode-state-kigou �������ϥ⡼��
      (state 'tutcode-state-off)
      ;;; �������ʥ⡼�ɤ��ɤ���
      ;;; #t: �������ʥ⡼�ɡ�#f: �Ҥ餬�ʥ⡼�ɡ�
@@ -306,11 +357,20 @@
                 n (tutcode-make-string head) "" "" #f)))
     cand))

+;;; �������ϥ⡼�ɻ���n���ܤθ�����֤���
+;;; @param n �оݤθ����ֹ�
+(define (tutcode-get-nth-candidate-for-kigou-mode pc n)
+ (car (nth n tutcode-kigoudic)))
+
 ;;; �򤼽��Ѵ���θ��������θ�����֤���
 ;;; @param pc ����ƥ����ȥꥹ��
 (define (tutcode-get-current-candidate pc)
   (tutcode-get-nth-candidate pc (tutcode-context-nth pc)))

+;;; �������ϥ⡼�ɻ��θ��������θ�����֤���
+(define (tutcode-get-current-candidate-for-kigou-mode pc)
+  (tutcode-get-nth-candidate-for-kigou-mode pc (tutcode-context-nth pc)))
+
 ;;; �򤼽��Ѵ��dz��ꤷ��ʸ������֤���
 ;;; @param pc ����ƥ����ȥꥹ��
 (define (tutcode-prepare-commit-string pc)
@@ -329,14 +389,24 @@
     (tutcode-flush pc)
     res))

-;;; ���ꤵ�줿��٥�ʸ����б�����������ꤹ��
+;;; �������ϥ⡼�ɻ��˳��ꤷ��ʸ������֤���
+(define (tutcode-prepare-commit-string-for-kigou-mode pc)
+  (tutcode-get-current-candidate-for-kigou-mode pc))
+
+;;; �򤼽��Ѵ��θ��������ˡ����ꤵ�줿��٥�ʸ����б�����������ꤹ��
 (define (tutcode-commit-by-label-key pc ch)
+  ;; ���߸��䥦����ɥ���ɽ������Ƥ��ʤ���٥�ʸ������Ϥ�����硢
+  ;; ���߰ʹߤθ�����ˤ��������ϥ�٥�ʸ����б�����������ꤹ�롣
+  ;; (�ؽ���ǽ�򥪥դˤ��Ƹ�����¤ӽ�����ˤ��ƻ��Ѥ�����ˡ�
+  ;; next-page-key�򲡤����򸺤餷��
+  ;; �ʤ�٤����ʤ���������Ū�θ������٤�褦�ˤ��뤿��)
   (let* ((nr (tutcode-context-nr-candidates pc))
          (nth (tutcode-context-nth pc))
          (cur-page (cond
                      ((= tutcode-nr-candidate-max 0) 0)
                      (else
                        (quotient nth tutcode-nr-candidate-max))))
+         ;; ���߸��䥦����ɥ���ɽ����θ���ꥹ�Ȥ���Ƭ�θ����ֹ�
          (cur-offset (* cur-page tutcode-nr-candidate-max))
          (cur-labels (list-tail
                        tutcode-heading-label-char-list
@@ -356,6 +426,31 @@
         (tutcode-context-set-nth! pc idx)
         (im-commit pc (tutcode-prepare-commit-string pc))))))

+;;; �������ϥ⡼�ɻ��ˡ����ꤵ�줿��٥�ʸ����б�����������ꤹ��
+(define (tutcode-commit-by-label-key-for-kigou-mode pc ch)
+  ;; �򤼽��Ѵ����Ȱۤʤꡢ���ߤ����θ������ꤹ���礢��
+  ;; (��ѱѿ����ϥ⡼�ɤȤ��ƻȤ���褦�ˤ��뤿��)��
+  ;; (�������ϥ⡼�ɻ��ϡ����ٳ��ꤷ�������Ϣ³�������ϤǤ���褦�ˡ�
+  ;; ������ľ��θ������򤷤Ƥ��뤬��
+  ;; ���ΤȤ��򤼽��Ѵ�����Ʊ�ͤθ�������Ԥ��ȡ�
+  ;; ��٥�ʸ��ꥹ�Ȥ�2���ܤ��б�����������ꤷ�Ƥ��ޤ���礬����
+  ;; (��:th���Ǥä���硢��ѱѿ����ϤȤ��Ƥϣ��ˤʤä��ߤ���������ˤʤ�)
+  ;; ���ᡢ�򤼽��Ѵ��Ȥϰۤʤ�����������Ԥ�)
+  (let* ((nr (tutcode-context-nr-candidates pc))
+         (nth (tutcode-context-nth pc))
+         (labellen (length tutcode-heading-label-char-list-for-kigou-mode))
+         (cur-base (quotient nth labellen))
+         (offset
+           (- labellen
+              (length
+ (member ch tutcode-heading-label-char-list-for-kigou-mode))))
+         (idx (+ (* cur-base labellen) offset)))
+    (if (and (>= idx 0)
+             (< idx nr))
+      (begin
+        (tutcode-context-set-nth! pc idx)
+ (im-commit pc (tutcode-prepare-commit-string-for-kigou-mode pc))))))
+
 ;;; �򤼽��Ѵ����ɤ�/������Ѵ������(ʸ����ꥹ��head)��ʸ������ɲä��롣
 ;;; @param pc ����ƥ����ȥꥹ��
 ;;; @param str �ɲä���ʸ����
@@ -386,6 +481,16 @@
       ;(tutcode-flush pc) ; ����̵����flush��������Ϥ���ʸ���󤬾ä��Ƥ��ä���
       )))

+;;; �������ϥ⡼�ɤ򳫻Ϥ��롣
+;;; @param pc ����ƥ����ȥꥹ��
+(define (tutcode-begin-kigou-mode pc)
+  (tutcode-context-set-nth! pc 0)
+  (tutcode-context-set-nr-candidates! pc (length tutcode-kigoudic))
+  (tutcode-context-set-state! pc 'tutcode-state-kigou)
+  (tutcode-check-candidate-window-begin pc)
+  (if (tutcode-context-candidate-window pc)
+    (im-select-candidate pc 0)))
+
 ;;; ���䥦����ɥ���ɽ���򳫻Ϥ���
 (define (tutcode-check-candidate-window-begin pc)
   (if (and (not (tutcode-context-candidate-window pc))
@@ -417,7 +522,11 @@
       ((tutcode-state-bushu)
         (let ((h (tutcode-make-string (tutcode-context-head pc))))
           (if (string? h)
-            (im-pushback-preedit pc preedit-none h)))))
+            (im-pushback-preedit pc preedit-none h))))
+      ((tutcode-state-kigou)
+        ;; ���䥦����ɥ���ɽ�����Ǥ�������Ǥ���褦��preeditɽ��
+        (im-pushback-preedit pc preedit-reverse
+          (tutcode-get-current-candidate-for-kigou-mode pc))))
     (im-pushback-preedit pc preedit-cursor "")
     (im-update-preedit pc)))

@@ -437,6 +546,9 @@
       ((tutcode-off-key? key key-state)
        (rk-flush rkc)
        (tutcode-context-set-state! pc 'tutcode-state-off))
+      ((tutcode-kigou-toggle-key? key key-state)
+       (rk-flush rkc)
+       (tutcode-begin-kigou-mode pc))
       ((tutcode-kana-toggle-key? key key-state)
        (rk-flush rkc)
        (tutcode-context-kana-toggle pc))
@@ -480,6 +592,57 @@
    (tutcode-context-set-state! pc 'tutcode-state-on)
    (im-commit-raw pc)))

+;;; �������ϥ⡼�ɻ��Υ������Ϥ����롣
+;;; @param pc ����ƥ����ȥꥹ��
+;;; @param key ���Ϥ��줿����
+;;; @param key-state ����ȥ��륭����ξ���
+(define (tutcode-proc-state-kigou pc key key-state)
+  (cond
+    ((and
+      (tutcode-vi-escape-key? key key-state)
+      tutcode-use-with-vi?)
+     (tutcode-reset-candidate-window pc)
+     (tutcode-context-set-state! pc 'tutcode-state-off)
+     (im-commit-raw pc)) ; ESC�����򥢥ץ�ˤ��Ϥ�
+    ((tutcode-off-key? key key-state)
+     (tutcode-reset-candidate-window pc)
+     (tutcode-context-set-state! pc 'tutcode-state-off))
+    ((tutcode-kigou-toggle-key? key key-state)
+     (tutcode-reset-candidate-window pc)
+     (tutcode-context-set-state! pc 'tutcode-state-on))
+    ;; ���ڡ�����������ѥ��ڡ������ϲ�ǽ�Ȥ��뤿�ᡢ
+    ;; next-candidate-key?�Υ���å�������heading-label-char?�����å�
+    ((and tutcode-commit-candidate-by-label-key?
+          (not (and (modifier-key-mask key-state)
+                    (not (shift-key-mask key-state))))
+          (tutcode-heading-label-char-for-kigou-mode? key))
+ (tutcode-commit-by-label-key-for-kigou-mode pc (charcode->string key))
+      (if (tutcode-context-candidate-window pc)
+        (im-select-candidate pc (tutcode-context-nth pc))))
+    ((tutcode-next-candidate-key? key key-state)
+      (tutcode-change-candidate-index pc 1))
+    ((tutcode-prev-candidate-key? key key-state)
+      (tutcode-change-candidate-index pc -1))
+    ((tutcode-cancel-key? key key-state)
+      (tutcode-reset-candidate-window pc)
+      (tutcode-begin-kigou-mode pc))
+    ((tutcode-next-page-key? key key-state)
+      (tutcode-change-candidate-index pc tutcode-nr-candidate-max))
+    ((tutcode-prev-page-key? key key-state)
+      (tutcode-change-candidate-index pc (- tutcode-nr-candidate-max)))
+    ((or
+      (tutcode-commit-key? key key-state)
+      (tutcode-return-key? key key-state))
+      (im-commit pc (tutcode-prepare-commit-string-for-kigou-mode pc)))
+    ((or
+      (symbol? key)
+      (and
+        (modifier-key-mask key-state)
+        (not (shift-key-mask key-state))))
+      (im-commit-raw pc))
+    (else
+      (im-commit-raw pc))))
+
 ;;; �򤼽��Ѵ����ɤ����Ͼ��֤ΤȤ��Υ������Ϥ����롣
 ;;; @param pc ����ƥ����ȥꥹ��
 ;;; @param key ���Ϥ��줿����
@@ -668,6 +831,11 @@
 (define (tutcode-heading-label-char? key)
   (member (charcode->string key) tutcode-heading-label-char-list))

+;;; ���Ϥ��줿�������������ϥ⡼�ɻ��θ����٥�ʸ��ɤ�����Ĵ�٤�
+;;; @param key ���Ϥ��줿����
+(define (tutcode-heading-label-char-for-kigou-mode? key)
+ (member (charcode->string key) tutcode-heading-label-char-list-for-kigou-mode))
+
 ;;; �򤼽��Ѵ��θ��������֤ΤȤ��Υ������Ϥ����롣
 ;;; @param pc ����ƥ����ȥꥹ��
 ;;; @param key ���Ϥ��줿����
@@ -815,7 +983,8 @@
 ;;; @param pc ����ƥ����ȥꥹ��
 (define (tutcode-state-has-preedit? pc)
   (memq (tutcode-context-state pc)
-    '(tutcode-state-yomi tutcode-state-bushu tutcode-state-converting)))
+    '(tutcode-state-yomi tutcode-state-bushu tutcode-state-converting
+                         tutcode-state-kigou)))

 ;;; �����������줿�Ȥ��ν���ο���ʬ����Ԥ���
 ;;; @param pc ����ƥ����ȥꥹ��
@@ -831,6 +1000,9 @@
            (if (tutcode-state-has-preedit? pc)
              ;; �򤼽��Ѵ���������Ѵ����ϡ����䢥��ɽ������
              (tutcode-update-preedit pc)))
+          ((tutcode-state-kigou)
+           (tutcode-proc-state-kigou pc key key-state)
+           (tutcode-update-preedit pc))
           ((tutcode-state-yomi)
            (tutcode-proc-state-yomi pc key key-state)
            (tutcode-update-preedit pc))
@@ -874,9 +1046,19 @@

 ;;; ���䥦����ɥ�������ʸ����������뤿��˸Ƥִؿ�
 (define (tutcode-get-candidate-handler tc idx accel-enum-hint)
-  (let ((cand (tutcode-get-nth-candidate tc idx))
-        (n (remainder idx (length tutcode-heading-label-char-list))))
-    (list cand (nth n tutcode-heading-label-char-list) "")))
+  (cond
+    ((eq? (tutcode-context-state tc) 'tutcode-state-kigou)
+      (let* ((cand (tutcode-get-nth-candidate-for-kigou-mode tc idx))
+             (n (remainder
+ idx (length tutcode-heading-label-char-list-for-kigou-mode))) + (label (nth n tutcode-heading-label-char-list-for-kigou-mode)))
+        ;; XXX:annotationɽ���ϸ���̵����Ƥ���Τǡ����""���֤��Ƥ���
+        (list cand label "")))
+    (else
+      (let* ((cand (tutcode-get-nth-candidate tc idx))
+             (n (remainder idx (length tutcode-heading-label-char-list)))
+             (label (nth n tutcode-heading-label-char-list)))
+        (list cand label "")))))

 ;;; ���䥦����ɥ����������򤷤��Ȥ��˸Ƥִؿ�
 (define (tutcode-set-candidate-index-handler tc idx)

Reply via email to