Author: deton.kih
Date: Mon Jan 14 00:04:51 2008
New Revision: 5124
Modified:
trunk/scm/tutcode-custom.scm
trunk/scm/tutcode.scm
Log:
* scm/tutcode-custom.scm
- (custom tutcode-commit-candidate-by-label-key?): New custom variable
* scm/tutcode.scm
- (tutcode-heading-label-char-list): New variable.
- (tutcode-commit-by-label-key, tutcode-heading-label-char?): New function.
- (tutcode-incr-candidate-index, tutcode-decr-candidate-index): Remove.
- (tutcode-change-candidate-index): Change to support next/prev page select.
- (tutcode-proc-state-converting):
Fix to be able to select next/prev page without candidate window.
Add support of commit by label key.
- (tutcode-get-candidate-handler):
Change label to use tutcode-heading-label-char-list.
Modified: trunk/scm/tutcode-custom.scm
==============================================================================
--- trunk/scm/tutcode-custom.scm (original)
+++ trunk/scm/tutcode-custom.scm Mon Jan 14 00:04:51 2008
@@ -90,6 +90,12 @@
(N_ "Use candidate window")
(N_ "long description will be here."))
+(define-custom 'tutcode-commit-candidate-by-label-key? #t
+ '(tutcode candwin)
+ '(boolean)
+ (N_ "Commit candidate by heading label keys")
+ (N_ "long description will be here."))
+
(define-custom 'tutcode-candidate-op-count 5
'(tutcode candwin)
'(integer 0 99)
Modified: trunk/scm/tutcode.scm
==============================================================================
--- trunk/scm/tutcode.scm (original)
+++ trunk/scm/tutcode.scm Mon Jan 14 00:04:51 2008
@@ -116,6 +116,16 @@
;;; 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"
+ "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
;;; ���Ѵ�����ν�����äƤ��뤫�ɤ���
@@ -307,6 +317,30 @@
(tutcode-flush pc)
res))
+;;; ���ꤵ�줿��٥�ʸ����б�����������ꤹ��
+(define (tutcode-commit-by-label-key pc ch)
+ (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 cur-offset))
+ (target-labels (member ch cur-labels))
+ (offset (if target-labels
+ (- (length cur-labels) (length target-labels))
+ (+ (length cur-labels)
+ (- (length tutcode-heading-label-char-list)
+ (length
+ (member ch tutcode-heading-label-char-list))))))
+ (idx (+ cur-offset offset)))
+ (if (and (>= idx 0)
+ (< idx nr))
+ (begin
+ (tutcode-context-set-nth! pc idx)
+ (im-commit pc (tutcode-prepare-commit-string pc))))))
+
;;; ���Ѵ����ɤ�/������Ѵ������(ʸ����ꥹ��head)��ʸ������ɲä��롣
;;; @param pc ����ƥ����ȥꥹ��
;;; @param str �ɲä���ʸ����
@@ -583,27 +617,19 @@
;; ������Ի������Ϥ�ľ�����Ԥ�
)))))))
-;;; ���Ѵ�����������ֹ��1��䤹��
+;;; ��������������
;;; @param pc ����ƥ����ȥꥹ��
-(define (tutcode-incr-candidate-index pc)
- (let ((nth (tutcode-context-nth pc)))
- (if (< (+ nth 1) (tutcode-context-nr-candidates pc))
- (tutcode-context-set-nth! pc (+ nth 1)))))
-
-;;; ���Ѵ�����������ֹ��1���餹��
-;;; @param pc ����ƥ����ȥꥹ��
-(define (tutcode-decr-candidate-index pc)
- (let ((nth (tutcode-context-nth pc)))
- (if (>= (- nth 1) 0)
- (tutcode-context-set-nth! pc (- nth 1)))))
-
-;;; ���Ѵ�����������ֹ��+1��-1���롣
-;;; @param pc ����ƥ����ȥꥹ��
-;;; @param incr #t:+1��, #f:-1��
-(define (tutcode-change-candidate-index pc incr)
- (if incr
- (tutcode-incr-candidate-index pc)
- (tutcode-decr-candidate-index pc))
+;;; @param num ���ߤθ����ֹ椫�鿷�����ֹ�ޤǤΥ��ե��å�
+(define (tutcode-change-candidate-index pc num)
+ (let* ((nr (tutcode-context-nr-candidates pc))
+ (nth (tutcode-context-nth pc))
+ (new-nth (+ nth num)))
+ (cond
+ ((< new-nth 0)
+ (set! new-nth 0))
+ ((>= new-nth nr)
+ (set! new-nth (- nr 1))))
+ (tutcode-context-set-nth! pc new-nth))
(tutcode-check-candidate-window-begin pc)
(if (tutcode-context-candidate-window pc)
(im-select-candidate pc (tutcode-context-nth pc))))
@@ -622,6 +648,11 @@
(tutcode-context-set-state! pc 'tutcode-state-yomi)
(tutcode-context-set-nr-candidates! pc 0))
+;;; ���Ϥ��줿�����������٥�ʸ��ɤ�����Ĵ�٤�
+;;; @param key ���Ϥ��줿����
+(define (tutcode-heading-label-char? key)
+ (member (charcode->string key) tutcode-heading-label-char-list))
+
;;; ���Ѵ��θ��������֤ΤȤ��Υ������Ϥ����롣
;;; @param pc ����ƥ����ȥꥹ��
;;; @param key ���Ϥ��줿����
@@ -629,21 +660,22 @@
(define (tutcode-proc-state-converting pc key key-state)
(cond
((tutcode-next-candidate-key? key key-state)
- (tutcode-change-candidate-index pc #t))
+ (tutcode-change-candidate-index pc 1))
((tutcode-prev-candidate-key? key key-state)
- (tutcode-change-candidate-index pc #f))
+ (tutcode-change-candidate-index pc -1))
((tutcode-cancel-key? key key-state)
(tutcode-back-to-yomi-state pc))
((tutcode-next-page-key? key key-state)
- (if (tutcode-context-candidate-window pc)
- (im-shift-page-candidate pc #t)))
+ (tutcode-change-candidate-index pc tutcode-nr-candidate-max))
((tutcode-prev-page-key? key key-state)
- (if (tutcode-context-candidate-window pc)
- (im-shift-page-candidate pc #f)))
+ (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 pc)))
+ ((and tutcode-commit-candidate-by-label-key?
+ (tutcode-heading-label-char? key))
+ (tutcode-commit-by-label-key pc (charcode->string key)))
(else
(im-commit pc (tutcode-prepare-commit-string pc))
(tutcode-proc-state-on pc key key-state))))
@@ -827,8 +859,9 @@
;;; ���䥦����ɥ�������ʸ����������뤿��˸Ƥִؿ�
(define (tutcode-get-candidate-handler tc idx accel-enum-hint)
- (let ((cand (tutcode-get-nth-candidate tc idx)))
- (list cand (digit->string (+ idx 1)) "")))
+ (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) "")))
;;; ���䥦����ɥ������������Ȥ��˸Ƥִؿ�
(define (tutcode-set-candidate-index-handler tc idx)
