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)