[uim-commit] r822 - branches/composer/scm
yamaken at freedesktop.org
yamaken at freedesktop.org
Thu Apr 7 04:18:14 PDT 2005
Author: yamaken
Date: 2005-04-07 04:18:11 -0700 (Thu, 07 Apr 2005)
New Revision: 822
Modified:
branches/composer/scm/action.scm
branches/composer/scm/anthy.scm
branches/composer/scm/event.scm
branches/composer/scm/evmap.scm
Log:
* This commit introduces unified action mapping with implicit guard
predicate extraction from action sequence of evmap-rule, rather than
annoying per-state action map. This enables mapping an input
sequence to different actions per state. Users are not required to
maintain state-sensitivity of input sequence.
* scm/evmap.scm
- (action-symbol?): New procedure generalized from local procedure
of action-exp-seq-parse
- (action-exp-seq-parse): Split off local procedure action-symbol?
as global one
- (event-exp-collector-normalize-predicates!):
* Optimize
* Support custom predicate that did not registered in pred-alist
- (event-exp-collector-fold-elem): Support custom predicate
- (event-exp-expand-macro-ext-true,
event-exp-expand-macro-ext-false,
action-exp-seq-extract-guard-exp): New procedure
- (event-exp-macro-alist): Add new macro 'ext-true' and 'ext-false'
- (event-exp-list-expand-macro):
* Disable implicit macro
* Add nested macro expansion to support ext-true and ext-false in
AND expression
- (event-exp-seq-parse, evmap-tree-insert-rule!): Optimize
- (evmap-parse-ruleset): Add implicit guard predicate extraction
from action sequence
* scm/action.scm
- (action-rec-spec): Add new member 'availability-pred'
- (action-available?): New procedure
- (widget-activate!): Add conditional activation using
action-available?
* scm/event.scm
- (event-rec-spec): Add new member 'ext-state' for external state
accessor
- (event-external-state): New procedure
- (key-event-new): Make portable even if event-rec-spec has been changed
* scm/anthy.scm
- (anthy-input-state-with-preedit?,
anthy-input-state-without-preedit?, anthy-pred-or): New procedure
- (anthy-register-action, anthy-register-std-action,
anthy-register-per-state-action): Follow the change of action
record
- (action action_anthy_off): New action
- (action action_anthy_on, action action_anthy_toggle_kana, action
action_anthy_commit_and_toggle_kana, action
action_anthy_begin_conv, action action_anthy_delete, action
action_anthy_kill, action action_anthy_kill_backward, action
action_anthy_go_left, action action_anthy_go_right, action
action_anthy_transpose_to_opposite_kana, action
action_anthy_transpose_to_hiragana, action
action_anthy_transpose_to_katakana, action
action_anthy_transpose_to_halfkana, action
action_anthy_transpose_to_half_alnum, action
action_anthy_transpose_to_full_alnum, action
action_anthy_prev_page, action action_anthy_next_page, action
action_anthy_commit, action action_anthy_extend_segment, action
action_anthy_shrink_segment, action action_anthy_next_segment,
action action_anthy_prev_segment, action
action_anthy_beginning_of_preedit, action
action_anthy_end_of_preedit, action action_anthy_backspace, action
action_anthy_next_candidate, action action_anthy_prev_candidate,
action action_anthy_cancel_conv, action action_anthy_hiragana,
action action_anthy_katakana, action action_anthy_hankana, action
action_anthy_direct, action action_anthy_zenkaku, action
action_anthy_roma, action action_anthy_kana, action
action_anthy_azik, action action_anthy_nicola): Add availability
predicate
- (anthy-register-candidate-actions,
anthy-register-modifier-action): Add availability predicate
- (anthy-direct-state-action-map-ruleset,
anthy-wide-latin-state-action-map-ruleset,
anthy-input-state-no-preedit-action-map-ruleset,
anthy-input-state-with-preedit-action-map-ruleset,
anthy-converting-state-action-map-ruleset): Removed and unified
into anthy-action-map-ruleset
- (anthy-direct-state-action-map-ruletree,
anthy-wide-latin-state-action-map-ruletree,
anthy-input-state-no-preedit-action-map-ruletree,
anthy-input-state-with-preedit-action-map-ruletree,
anthy-converting-state-action-map-ruletree): Removed and unified
to anthy-action-map-ruletree
- (anthy-action-map-ruleset, anthy-action-map-ruletree): New variable
- (anthy-actmap-ruletree, anthy-select-actmap-ruletree!): Removed
- (anthy-context-new): Add actmap-emc initialization
- (anthy-switch-ruletree!, anthy-preedit-input!, anthy-cancel-conv):
Remove actmap-emc switching
- (anthy-input-state-no-preedit-action): Add action_anthy_off
handling
- (anthy-state-reader): New procedure
- (anthy-key-handler): Add initialization of ext-state of key-event
Modified: branches/composer/scm/action.scm
===================================================================
--- branches/composer/scm/action.scm 2005-04-07 05:59:07 UTC (rev 821)
+++ branches/composer/scm/action.scm 2005-04-07 11:18:11 UTC (rev 822)
@@ -78,7 +78,8 @@
'((id #f)
(indication-handler #f)
(activity-pred #f)
- (handler #f)))
+ (handler #f)
+ (availability-pred #f)))
(define-record 'action action-rec-spec)
;; indicator is restricted version of action
@@ -107,6 +108,13 @@
(and active?
(active? owner)))))
+(define action-available?
+ (lambda (action owner)
+ (let ((available? (action-availability-pred action)))
+ (or (not available?) ;; #f means always available
+ (and (procedure? available?)
+ (available? owner))))))
+
(define action-indicate
(lambda (action owner)
(let ((indicate (and action
@@ -206,6 +214,7 @@
(handler (and action
(action-handler action))))
(and handler
+ (action-available? action (widget-owner widget))
(begin
(handler (widget-owner widget))
#t)))))
Modified: branches/composer/scm/anthy.scm
===================================================================
--- branches/composer/scm/anthy.scm 2005-04-07 05:59:07 UTC (rev 821)
+++ branches/composer/scm/anthy.scm 2005-04-07 11:18:11 UTC (rev 822)
@@ -96,11 +96,28 @@
(and (anthy-context-on ac)
(not (anthy-context-converting ac)))))
+(define anthy-input-state-with-preedit?
+ (lambda (ac)
+ (and (anthy-input-state? ac)
+ (anthy-has-preedit? ac))))
+
+(define anthy-input-state-without-preedit?
+ (lambda (ac)
+ (and (anthy-input-state? ac)
+ (not (anthy-has-preedit? ac)))))
+
(define anthy-converting-state?
(lambda (ac)
(and (anthy-context-on ac)
(anthy-context-converting ac))))
+(define anthy-pred-or
+ (lambda preds
+ (lambda (ac)
+ (any (lambda (pred)
+ (pred ac))
+ preds))))
+
(define anthy-std-indication-handler
(lambda (label short-desc)
(lambda (ac)
@@ -142,136 +159,183 @@
(anthy-converting-state-action ac act-id))))))
(define anthy-register-action
- (lambda (id indication-handler activity-pred handler)
+ (lambda (id indication-handler active? handler available?)
(if (not (memq id anthy-valid-actions))
(set! anthy-valid-actions (cons id anthy-valid-actions)))
- (register-action id indication-handler activity-pred handler)))
+ (register-action id indication-handler active? handler available?)))
(define anthy-register-std-action
- (lambda (id label short-desc handler)
+ (lambda (id label short-desc handler available?)
(anthy-register-action id
(anthy-std-indication-handler label short-desc)
#f
- handler)))
+ handler
+ available?)))
(define anthy-register-per-state-action
- (lambda (id label short-desc)
+ (lambda (id label short-desc available?)
(anthy-register-std-action id
label
short-desc
- (anthy-per-state-action-handler id))))
+ (anthy-per-state-action-handler id)
+ available?)))
(anthy-register-per-state-action 'action_anthy_on
"On"
- "On")
+ "On"
+ (anthy-pred-or anthy-direct-mode?
+ anthy-wide-latin-mode?))
+(anthy-register-per-state-action 'action_anthy_off
+ "Off"
+ "Off"
+ anthy-input-state-without-preedit?)
+
(anthy-register-per-state-action 'action_anthy_toggle_kana
"Toggle hiragana/katakana mode"
- "Toggle hiragana/katakana mode")
+ "Toggle hiragana/katakana mode"
+ (anthy-pred-or anthy-input-state?
+ anthy-converting-state?))
(anthy-register-per-state-action 'action_anthy_commit_and_toggle_kana
"Commit and toggle hiragana/katakana mode"
- "Commit current preedit string, then toggle hiragana/katakana mode")
+ "Commit current preedit string, then toggle hiragana/katakana mode"
+ anthy-input-state-with-preedit?)
(anthy-register-per-state-action 'action_anthy_begin_conv
"Begin conversion"
- "Begin conversion")
+ "Begin conversion"
+ anthy-input-state-with-preedit?)
(anthy-register-per-state-action 'action_anthy_delete
"Delete"
- "Delete")
+ "Delete"
+ anthy-input-state-with-preedit?)
(anthy-register-per-state-action 'action_anthy_kill
"Erase after cursor"
- "Erase after cursor")
+ "Erase after cursor"
+ anthy-input-state-with-preedit?)
(anthy-register-per-state-action 'action_anthy_kill_backward
"Erase before cursor"
- "Erase before cursor")
+ "Erase before cursor"
+ anthy-input-state-with-preedit?)
(anthy-register-per-state-action 'action_anthy_go_left
"Go left"
- "Go left")
+ "Go left"
+ anthy-input-state-with-preedit?)
(anthy-register-per-state-action 'action_anthy_go_right
"Go right"
- "Go right")
+ "Go right"
+ anthy-input-state-with-preedit?)
(anthy-register-per-state-action 'action_anthy_transpose_to_opposite_kana
"Transpose to opposite kana"
- "Transpose to opposite kana")
+ "Transpose to opposite kana"
+ (anthy-pred-or anthy-input-state-with-preedit?
+ anthy-converting-state?))
(anthy-register-per-state-action 'action_anthy_transpose_to_hiragana
"Transpose to hiragana"
- "Transpose to hiragana")
+ "Transpose to hiragana"
+ (anthy-pred-or anthy-input-state-with-preedit?
+ anthy-converting-state?))
(anthy-register-per-state-action 'action_anthy_transpose_to_katakana
"Transpose to katakana"
- "Transpose to katakana")
+ "Transpose to katakana"
+ (anthy-pred-or anthy-input-state-with-preedit?
+ anthy-converting-state?))
(anthy-register-per-state-action 'action_anthy_transpose_to_halfkana
"Transpose to halfwidth kana"
- "Transpose to halfwidth katakana")
+ "Transpose to halfwidth katakana"
+ (anthy-pred-or anthy-input-state-with-preedit?
+ anthy-converting-state?))
(anthy-register-per-state-action 'action_anthy_transpose_to_half_alnum
"Transpose to halfwidth alphanumeric"
- "Transpose to halfwidth alphanumeric")
+ "Transpose to halfwidth alphanumeric"
+ (anthy-pred-or anthy-input-state-with-preedit?
+ anthy-converting-state?))
(anthy-register-per-state-action 'action_anthy_transpose_to_full_alnum
"Transpose to fullwidth alphanumeric"
- "Transpose to fullwidth alphanumeric")
+ "Transpose to fullwidth alphanumeric"
+ (anthy-pred-or anthy-input-state-with-preedit?
+ anthy-converting-state?))
(anthy-register-per-state-action 'action_anthy_prev_page
"Previous page"
- "Previous page of candidate window")
+ "Previous page of candidate window"
+ anthy-converting-state?)
(anthy-register-per-state-action 'action_anthy_next_page
"Next page"
- "Next page of candidate window")
+ "Next page of candidate window"
+ anthy-converting-state?)
(anthy-register-per-state-action 'action_anthy_commit
"Commit"
- "Commit")
+ "Commit"
+ (anthy-pred-or anthy-input-state-with-preedit?
+ anthy-converting-state?))
(anthy-register-per-state-action 'action_anthy_extend_segment
"Extend segment"
- "Extend segment")
+ "Extend segment"
+ anthy-converting-state?)
(anthy-register-per-state-action 'action_anthy_shrink_segment
"Shrink segment"
- "Shrink segment")
+ "Shrink segment"
+ anthy-converting-state?)
(anthy-register-per-state-action 'action_anthy_next_segment
"Next segment"
- "Next segment")
+ "Next segment"
+ anthy-converting-state?)
(anthy-register-per-state-action 'action_anthy_prev_segment
"Previous segment"
- "Previous segment")
+ "Previous segment"
+ anthy-converting-state?)
(anthy-register-per-state-action 'action_anthy_beginning_of_preedit
"Beginning of preedit"
- "Beginning of preedit")
+ "Beginning of preedit"
+ (anthy-pred-or anthy-input-state-with-preedit?
+ anthy-converting-state?))
(anthy-register-per-state-action 'action_anthy_end_of_preedit
"End of preedit"
- "End of preedit")
+ "End of preedit"
+ (anthy-pred-or anthy-input-state-with-preedit?
+ anthy-converting-state?))
(anthy-register-per-state-action 'action_anthy_backspace
"Backspace"
- "Backspace")
+ "Backspace"
+ anthy-input-state-with-preedit?)
(anthy-register-per-state-action 'action_anthy_next_candidate
"Next candidate"
- "Next candidate")
+ "Next candidate"
+ anthy-converting-state?)
(anthy-register-per-state-action 'action_anthy_prev_candidate
"Previous candidate"
- "Previous candidate")
+ "Previous candidate"
+ anthy-converting-state?)
(anthy-register-per-state-action 'action_anthy_cancel_conv
"Cancel conversion"
- "Cancel conversion")
+ "Cancel conversion"
+ (anthy-pred-or anthy-input-state-with-preedit?
+ anthy-converting-state?))
;; candidate selections: Don't use lkey_0 because it may reject KP_0
;; (("0") (action_anthy_candidate_0))
@@ -286,12 +350,14 @@
(act-sym (symbolconc 'action_anthy_candidate_ idx-sym))
(label (string-append "Select candidate " idx-str))
(ind-handler (anthy-std-indication-handler label label))
- (act-handler
+ (available?
(lambda (ac)
(and (anthy-converting-state? ac)
- (anthy-context-candidate-window ac)
- (anthy-set-relative-candidate idx)))))
- (anthy-register-action act-sym ind-handler #f act-handler)
+ (anthy-context-candidate-window ac))))
+ (act-handler (lambda (ac)
+ (anthy-set-relative-candidate idx))))
+ (anthy-register-action act-sym ind-handler #f act-handler
+ available?)
(set! anthy-candidate-action-map-ruleset
(cons (list (list idx-str) ;; event-seq
(list act-sym)) ;; action-seq
@@ -325,11 +391,13 @@
(anthy-register-std-action set-act-sym
set-label
set-label
- (anthy-set-mod-state-handler mod-var))
+ (anthy-set-mod-state-handler mod-var)
+ #f)
(anthy-register-std-action reset-act-sym
reset-label
reset-label
- (anthy-reset-mod-state-handler mod-var)))))
+ (anthy-reset-mod-state-handler mod-var)
+ #f))))
(anthy-register-modifier-action 'mod_Shift_L 'shift_l)
(anthy-register-modifier-action 'mod_Shift_R 'shift_r)
@@ -361,7 +429,8 @@
anthy-hiragana-mode?
(lambda (ac)
(anthy-context-set-on! ac #t)
- (anthy-switch-kana-mode! ac anthy-type-hiragana)))
+ (anthy-switch-kana-mode! ac anthy-type-hiragana))
+ #f)
(anthy-register-action 'action_anthy_katakana
(lambda (ac)
@@ -372,7 +441,8 @@
anthy-katakana-mode?
(lambda (ac)
(anthy-context-set-on! ac #t)
- (anthy-switch-kana-mode! ac anthy-type-katakana)))
+ (anthy-switch-kana-mode! ac anthy-type-katakana))
+ #f)
(anthy-register-action 'action_anthy_hankana
(lambda (ac)
@@ -383,7 +453,8 @@
anthy-hankana-mode?
(lambda (ac)
(anthy-context-set-on! ac #t)
- (anthy-switch-kana-mode! ac anthy-type-hankana)))
+ (anthy-switch-kana-mode! ac anthy-type-hankana))
+ #f)
(anthy-register-action 'action_anthy_direct
(lambda (ac)
@@ -396,7 +467,8 @@
(anthy-prepare-activation ac)
(anthy-context-set-on! ac #f)
(anthy-context-set-wide-latin! ac #f)
- (anthy-select-ruletree! ac)))
+ (anthy-select-ruletree! ac))
+ #f)
(anthy-register-action 'action_anthy_zenkaku
(lambda (ac)
@@ -409,7 +481,8 @@
(anthy-prepare-activation ac)
(anthy-context-set-on! ac #f)
(anthy-context-set-wide-latin! ac #t)
- (anthy-select-ruletree! ac)))
+ (anthy-select-ruletree! ac))
+ #f)
(anthy-register-action 'action_anthy_roma
(lambda (ac)
@@ -424,7 +497,8 @@
(anthy-prepare-activation ac)
(anthy-switch-ruletree! ac
anthy-input-rule-roma
- (anthy-context-kana-mode ac))))
+ (anthy-context-kana-mode ac)))
+ #f)
(anthy-register-action 'action_anthy_kana
(lambda (ac)
@@ -439,7 +513,8 @@
(anthy-prepare-activation ac)
(anthy-switch-ruletree! ac
anthy-input-rule-kana
- (anthy-context-kana-mode ac))))
+ (anthy-context-kana-mode ac)))
+ #f)
(anthy-register-action 'action_anthy_azik
(lambda (ac)
@@ -454,7 +529,8 @@
(anthy-prepare-activation ac)
(anthy-switch-ruletree! ac
anthy-input-rule-azik
- (anthy-context-kana-mode ac))))
+ (anthy-context-kana-mode ac)))
+ #f)
(anthy-register-action 'action_anthy_nicola
(lambda (ac)
@@ -469,7 +545,8 @@
(anthy-prepare-activation ac)
(anthy-switch-ruletree! ac
anthy-input-rule-nicola
- (anthy-context-kana-mode ac))))
+ (anthy-context-kana-mode ac)))
+ #f)
;; Update widget definitions based on action configurations. The
;; procedure is needed for on-the-fly reconfiguration involving the
@@ -485,44 +562,45 @@
(actions-new anthy-kana-input-method-actions))
(context-list-replace-widgets! 'anthy anthy-widgets)))
-(define anthy-direct-state-action-map-ruleset
- '((((mod_Control lkey_j)) (action_anthy_on))
+(define anthy-action-map-ruleset
+ '(
+ ;; direct
+ (((mod_Control lkey_j)) (action_anthy_on))
(((mod_Control lkey_J)) (action_anthy_on))
- (((mod_Shift lkey_space)) (action_anthy_on)) ;; generic
- ((lkey_Zenkaku_Hankaku) (action_anthy_on)) ;; generic
- ))
+ (((mod_Shift lkey_space)) (action_anthy_on)) ;; generic
+ ((lkey_Zenkaku_Hankaku) (action_anthy_on)) ;; generic
+ ;;(((mod_Control lkey_l (ext-true action_anthy_on))) (action_anthy_on))
+ ;;(((mod_Control lkey_l (ext-true action_anthy_prev_page))) (action_anthy_on))
-(define anthy-wide-latin-state-action-map-ruleset
- '((((mod_Control lkey_j)) (action_anthy_on))
+ ;; wide-latin
+ (((mod_Control lkey_j)) (action_anthy_on))
(((mod_Control lkey_J)) (action_anthy_on))
- (((mod_Shift lkey_space)) (action_anthy_on)) ;; generic
- ((lkey_Zenkaku_Hankaku) (action_anthy_on)) ;; generic
- ))
+ (((mod_Shift lkey_space)) (action_anthy_on)) ;; generic
+ ((lkey_Zenkaku_Hankaku) (action_anthy_on)) ;; generic
-(define anthy-input-state-no-preedit-action-map-ruleset
- '(
+ ;; input-state-no-preedit
((lkey_q) (action_anthy_toggle_kana))
((lkey_Q) (action_anthy_toggle_kana))
;;(((mod_Control lkey_j)) (action_anthy_hiragana))
;;(((mod_Control lkey_J)) (action_anthy_hiragana))
;;(() (action_anthy_katakana))
- (((mod_Control lkey_q)) (action_anthy_hankana))
- (((mod_Control lkey_Q)) (action_anthy_hankana))
- (((mod_Shift lkey_space)) (action_anthy_direct))
- (((mod_Control lkey_j)) (action_anthy_direct))
- (((mod_Control lkey_J)) (action_anthy_direct))
- ((lkey_l) (action_anthy_direct))
- ((lkey_L) (action_anthy_direct))
+ (((mod_Control lkey_q (ext-true anthy-input-state?))) (action_anthy_hankana))
+ (((mod_Control lkey_Q (ext-true anthy-input-state?))) (action_anthy_hankana))
+ (((mod_Shift lkey_space)) (action_anthy_off))
+ (((mod_Control lkey_j)) (action_anthy_off))
+ (((mod_Control lkey_J)) (action_anthy_off))
+ ;;(((lkey_l (ext-true anthy-input-state-without-preedit?)))
+ ;;(action_anthy_direct))
+ ((lkey_l) (action_anthy_off))
+ ((lkey_L) (action_anthy_off))
(((mod_Shift lkey_l)) (action_anthy_zenkaku))
(((mod_Shift lkey_L)) (action_anthy_zenkaku))
;;(() (action_anthy_roma))
;;(() (action_anthy_kana))
;;(() (action_anthy_azik))
;;(() (action_anthy_nicola))
- ))
-(define anthy-input-state-with-preedit-action-map-ruleset
- '(
+ ;; input-state-with-preedit
((lkey_q) (action_anthy_toggle_kana))
((lkey_Q) (action_anthy_toggle_kana))
(((mod_Control lkey_q)) (action_anthy_commit_and_toggle_kana))
@@ -565,74 +643,59 @@
((lkey_Escape) (action_anthy_cancel_conv)) ;; generic
(((mod_Control lkey_g)) (action_anthy_cancel_conv)) ;; generic
(((mod_Control lkey_G)) (action_anthy_cancel_conv)) ;; generic
+
+ ;; converting-state-action-map-ruleset
+ ((lkey_q) (action_anthy_toggle_kana))
+ ((lkey_Q) (action_anthy_toggle_kana))
+ ((lkey_Page_Up) (action_anthy_prev_page)) ;; generic
+ ((lkey_Page_Down) (action_anthy_next_page)) ;; generic
+ (((mod_Control lkey_o)) (action_anthy_extend_segment))
+ (((mod_Control lkey_O)) (action_anthy_extend_segment))
+ ((mod_Shift lkey_Right) (action_anthy_extend_segment))
+ (((mod_Control lkey_i)) (action_anthy_shrink_segment))
+ (((mod_Control lkey_I)) (action_anthy_shrink_segment))
+ ((mod_Shift lkey_Left) (action_anthy_shrink_segment))
+ (((mod_Control lkey_f)) (action_anthy_next_segment))
+ (((mod_Control lkey_F)) (action_anthy_next_segment))
+ ((lkey_Right) (action_anthy_next_segment))
+ (((mod_Control lkey_b)) (action_anthy_prev_segment))
+ (((mod_Control lkey_B)) (action_anthy_prev_segment))
+ ((lkey_Left) (action_anthy_prev_segment))
+ ((lkey_space) (action_anthy_next_candidate)) ;; generic
+ ((lkey_Down) (action_anthy_next_candidate)) ;; generic
+ (((mod_Control lkey_n)) (action_anthy_next_candidate)) ;; generic
+ (((mod_Control lkey_N)) (action_anthy_next_candidate)) ;; generic
+ ((lkey_Up) (action_anthy_prev_candidate)) ;; generic
+ (((mod_Control lkey_p)) (action_anthy_prev_candidate)) ;; generic
+ (((mod_Control lkey_P)) (action_anthy_prev_candidate)) ;; generic
+ (((mod_Shift lkey_q)) (action_anthy_transpose_to_opposite_kana))
+ (((mod_Shift lkey_Q)) (action_anthy_transpose_to_opposite_kana))
+ ((lkey_F6) (action_anthy_transpose_to_hiragana))
+ ((lkey_F7) (action_anthy_transpose_to_katakana))
+ ((lkey_F8) (action_anthy_transpose_to_halfkana))
+ ((lkey_F9) (action_anthy_transpose_to_half_alnum))
+ ((lkey_F10) (action_anthy_transpose_to_full_alnum))
+ (((mod_Control lkey_j)) (action_anthy_commit)) ;; generic
+ (((mod_Control lkey_J)) (action_anthy_commit)) ;; generic
+ (((mod_Control lkey_m)) (action_anthy_commit)) ;; generic-return
+ (((mod_Control lkey_M)) (action_anthy_commit)) ;; generic-return
+ ((lkey_Return) (action_anthy_commit)) ;; generic-return
+ (((mod_Control lkey_a)) (action_anthy_beginning_of_preedit)) ;; generic
+ (((mod_Control lkey_A)) (action_anthy_beginning_of_preedit)) ;; generic
+ ((lkey_Home) (action_anthy_beginning_of_preedit)) ;; generic
+ (((mod_Control lkey_e)) (action_anthy_end_of_preedit)) ;; generic
+ (((mod_Control lkey_E)) (action_anthy_end_of_preedit)) ;; generic
+ ((lkey_End) (action_anthy_end_of_preedit)) ;; generic
+ ((lkey_Escape) (action_anthy_cancel_conv)) ;; generic
+ (((mod_Control lkey_g)) (action_anthy_cancel_conv)) ;; generic
+ (((mod_Control lkey_G)) (action_anthy_cancel_conv)) ;; generic
))
-(define anthy-converting-state-action-map-ruleset
- (append
- '(
- ((lkey_q) (action_anthy_toggle_kana))
- ((lkey_Q) (action_anthy_toggle_kana))
- ((lkey_Page_Up) (action_anthy_prev_page)) ;; generic
- ((lkey_Page_Down) (action_anthy_next_page)) ;; generic
- (((mod_Control lkey_o)) (action_anthy_extend_segment))
- (((mod_Control lkey_O)) (action_anthy_extend_segment))
- ((mod_Shift lkey_Right) (action_anthy_extend_segment))
- (((mod_Control lkey_i)) (action_anthy_shrink_segment))
- (((mod_Control lkey_I)) (action_anthy_shrink_segment))
- ((mod_Shift lkey_Left) (action_anthy_shrink_segment))
- (((mod_Control lkey_f)) (action_anthy_next_segment))
- (((mod_Control lkey_F)) (action_anthy_next_segment))
- ((lkey_Right) (action_anthy_next_segment))
- (((mod_Control lkey_b)) (action_anthy_prev_segment))
- (((mod_Control lkey_B)) (action_anthy_prev_segment))
- ((lkey_Left) (action_anthy_prev_segment))
- ((lkey_space) (action_anthy_next_candidate)) ;; generic
- ((lkey_Down) (action_anthy_next_candidate)) ;; generic
- (((mod_Control lkey_n)) (action_anthy_next_candidate)) ;; generic
- (((mod_Control lkey_N)) (action_anthy_next_candidate)) ;; generic
- ((lkey_Up) (action_anthy_prev_candidate)) ;; generic
- (((mod_Control lkey_p)) (action_anthy_prev_candidate)) ;; generic
- (((mod_Control lkey_P)) (action_anthy_prev_candidate)) ;; generic
- (((mod_Shift lkey_q)) (action_anthy_transpose_to_opposite_kana))
- (((mod_Shift lkey_Q)) (action_anthy_transpose_to_opposite_kana))
- ((lkey_F6) (action_anthy_transpose_to_hiragana))
- ((lkey_F7) (action_anthy_transpose_to_katakana))
- ((lkey_F8) (action_anthy_transpose_to_halfkana))
- ((lkey_F9) (action_anthy_transpose_to_half_alnum))
- ((lkey_F10) (action_anthy_transpose_to_full_alnum))
- (((mod_Control lkey_j)) (action_anthy_commit)) ;; generic
- (((mod_Control lkey_J)) (action_anthy_commit)) ;; generic
- (((mod_Control lkey_m)) (action_anthy_commit)) ;; generic-return
- (((mod_Control lkey_M)) (action_anthy_commit)) ;; generic-return
- ((lkey_Return) (action_anthy_commit)) ;; generic-return
- (((mod_Control lkey_a)) (action_anthy_beginning_of_preedit)) ;; generic
- (((mod_Control lkey_A)) (action_anthy_beginning_of_preedit)) ;; generic
- ((lkey_Home) (action_anthy_beginning_of_preedit)) ;; generic
- (((mod_Control lkey_e)) (action_anthy_end_of_preedit)) ;; generic
- (((mod_Control lkey_E)) (action_anthy_end_of_preedit)) ;; generic
- ((lkey_End) (action_anthy_end_of_preedit)) ;; generic
- ((lkey_Escape) (action_anthy_cancel_conv)) ;; generic
- (((mod_Control lkey_g)) (action_anthy_cancel_conv)) ;; generic
- (((mod_Control lkey_G)) (action_anthy_cancel_conv)) ;; generic
- )
- anthy-candidate-action-map-ruleset
- ))
+(define anthy-action-map-ruletree
+ (evmap-parse-ruleset (append anthy-action-map-ruleset
+ anthy-candidate-action-map-ruleset)))
-(define anthy-direct-state-action-map-ruletree
- (evmap-parse-ruleset anthy-direct-state-action-map-ruleset))
-(define anthy-wide-latin-state-action-map-ruletree
- (evmap-parse-ruleset anthy-wide-latin-state-action-map-ruleset))
-
-(define anthy-input-state-no-preedit-action-map-ruletree
- (evmap-parse-ruleset anthy-input-state-no-preedit-action-map-ruleset))
-
-(define anthy-input-state-with-preedit-action-map-ruletree
- (evmap-parse-ruleset anthy-input-state-with-preedit-action-map-ruleset))
-
-(define anthy-converting-state-action-map-ruletree
- (evmap-parse-ruleset anthy-converting-state-action-map-ruleset))
-
(define evmap-context-list-preedit-string
(lambda (emc-list)
(apply string-append
@@ -808,23 +871,6 @@
(else
ja-direct-ruletree)))))
-(define anthy-actmap-ruletree
- (lambda (ac)
- (cond
- ((anthy-direct-mode? ac)
- anthy-direct-state-action-map-ruletree)
-
- ((anthy-wide-latin-mode? ac)
- anthy-wide-latin-state-action-map-ruletree)
-
- ((anthy-input-state? ac)
- (if (anthy-has-preedit? ac)
- anthy-input-state-with-preedit-action-map-ruletree
- anthy-input-state-no-preedit-action-map-ruletree))
-
- ((anthy-converting-state? ac)
- anthy-converting-state-action-map-ruletree))))
-
(define anthy-context-rec-spec
(append
context-rec-spec
@@ -851,7 +897,8 @@
(define anthy-context-new
(lambda (id im)
- (let ((ac (anthy-context-new-internal id im)))
+ (let ((ac (anthy-context-new-internal id im))
+ (actmap-emc (evmap-context-new anthy-action-map-ruletree)))
(if (symbol-bound? 'anthy-lib-init)
(set! anthy-lib-initialized? (anthy-lib-init)))
(if anthy-lib-initialized?
@@ -860,6 +907,7 @@
(anthy-context-set-preconv-ustr! ac (ustr-new))
(anthy-context-set-segments! ac (ustr-new))
(anthy-context-set-keytrans-emc! ac (key-event-translator-new))
+ (anthy-context-set-actmap-emc! ac actmap-emc)
(anthy-context-set-ev-dropper! ac (event-dropper-new))
(anthy-select-ruletree! ac)
ac)))
@@ -873,8 +921,7 @@
(anthy-has-preedit? ac))))
(anthy-context-set-input-rule! ac input-rule)
(anthy-context-set-kana-mode! ac kana-mode)
- (anthy-context-set-ruletree! ac ruletree)
- (anthy-select-actmap-ruletree! ac))))
+ (anthy-context-set-ruletree! ac ruletree))))
(define anthy-select-ruletree!
(lambda (ac)
@@ -882,11 +929,6 @@
(anthy-context-input-rule ac)
(anthy-context-kana-mode ac))))
-(define anthy-select-actmap-ruletree!
- (lambda (ac)
- (let ((actmap-emc (evmap-context-new (anthy-actmap-ruletree ac))))
- (anthy-context-set-actmap-emc! ac actmap-emc))))
-
(define anthy-switch-kana-mode!
(lambda (ac kana-mode)
(let ((rule (anthy-context-input-rule ac)))
@@ -993,8 +1035,6 @@
(transit? (not (= preedit? post-preedit?))))
;; main ruletree must not be changed here to preserve
;; transposed one
- (if transit?
- (anthy-select-actmap-ruletree! ac))
matched?))))))
(define anthy-init-handler
@@ -1050,8 +1090,7 @@
(let ((nr-segments (anthy-lib-get-nr-segments ac-id)))
(ustr-set-latter-seq! (anthy-context-segments ac)
(make-list nr-segments 0))
- (anthy-context-set-converting! ac #t)
- (anthy-select-actmap-ruletree! ac)))))))
+ (anthy-context-set-converting! ac #t)))))))
(define anthy-cancel-conv
(lambda (ac)
@@ -1063,7 +1102,6 @@
(anthy-context-set-converting! ac #f)
(anthy-context-set-preconv-ustr! ac preconv-ustr)
(ustr-clear! segments)
- (anthy-select-actmap-ruletree! ac)
(anthy-update-preedit ac) ;; TODO: remove this
)))
@@ -1081,6 +1119,10 @@
action_anthy_nicola)
(anthy-activate-action! ac act-id))
+ ((action_anthy_off)
+ (anthy-context-set-on! ac #f)
+ (anthy-select-ruletree! ac))
+
((action_anthy_toggle_kana)
(anthy-toggle-kana-mode! ac)))))
@@ -1480,11 +1522,40 @@
(anthy-context-set-on! ac #t)
(anthy-select-ruletree! ac)))))
+;; exports internal state to other IM components via event-external-state
+(define anthy-state-reader
+ (lambda (ac)
+ (lambda (state-id)
+ (cond
+ ((string-prefix? "action_"
+ (symbol->string state-id))
+ (let ((act (and (memq state-id anthy-valid-actions)
+ (fetch-action state-id))))
+ (and act
+ (action-available? act ac))))
+ ((memq state-id '(anthy-hiragana-mode?
+ anthy-katakana-mode?
+ anthy-hankana-mode?
+ anthy-direct-mode?
+ anthy-wide-latin-mode?
+ anthy-input-state?
+ anthy-input-state-with-preedit?
+ anthy-input-state-without-preedit?
+ anthy-converting-state?))
+ ((symbol-value state-id) ac))
+ ((eq? state-id 'true)
+ #t)
+ ((eq? state-id 'false)
+ #f)
+ (else
+ #f)))))
+
(define anthy-key-handler
(lambda (ac key key-state press?)
(let* ((ev (legacy-key->key-event key key-state press?))
(keytrans-emc (anthy-context-keytrans-emc ac))
(act-seq (begin
+ (event-set-ext-state! ev (anthy-state-reader ac))
(key-event-print-inspected "key-event: " ev)
(key-event-translator-translate! keytrans-emc ev))))
(if act-seq
Modified: branches/composer/scm/event.scm
===================================================================
--- branches/composer/scm/event.scm 2005-04-07 05:59:07 UTC (rev 821)
+++ branches/composer/scm/event.scm 2005-04-07 11:18:11 UTC (rev 822)
@@ -71,9 +71,16 @@
'((type unknown)
(consumed #f)
(loopback #f) ;; instructs re-injection into local composer
- (timestamp -1))) ;; placeholder
+ (timestamp -1) ;; placeholder
+ (ext-state #f)))
(define-record 'event event-rec-spec)
+(define event-external-state
+ (lambda (ev state-id)
+ (let ((state-reader (event-ext-state ev)))
+ (and (procedure? state-reader)
+ (state-reader state-id)))))
+
(define-record 'timer-event
event-rec-spec)
@@ -119,7 +126,7 @@
(define key-event-new
(lambda args
(apply key-event-new-internal
- (append '(key #f #f -1) args))))
+ (append (event-new 'key) args))))
(define key-release-event-new
(lambda args
Modified: branches/composer/scm/evmap.scm
===================================================================
--- branches/composer/scm/evmap.scm 2005-04-07 05:59:07 UTC (rev 821)
+++ branches/composer/scm/evmap.scm 2005-04-07 11:18:11 UTC (rev 822)
@@ -65,6 +65,13 @@
(require "ng-key.scm")
+(define action-symbol?
+ (lambda (sym)
+ (and (symbol? sym)
+ (string-prefix? "action_"
+ (symbol->string sym))
+ sym)))
+
(define event-exp-list?
(lambda (x)
(or (pair? x)
@@ -145,17 +152,19 @@
(normalized (or ;; fast path
(and (= (length predicates)
1)
- (find-tail (lambda (pair)
- (eq? (car predicates)
- (cdr pair)))
- pred-alist)
predicates)
;; ordinary path
- (filter-map (lambda (pair)
- (let ((pred (cdr pair)))
- (and (memq pred predicates)
- pred)))
- pred-alist))))
+ (let* ((std-preds
+ (filter-map (lambda (pair)
+ (let ((pred (cdr pair)))
+ (and (memq pred predicates)
+ pred)))
+ pred-alist))
+ (custom-preds
+ (remove (lambda (pred)
+ (memq pred std-preds))
+ predicates)))
+ (append! std-preds custom-preds)))))
(event-exp-collector-set-predicates! evc normalized))))
;; returns normalized event-exp expression
@@ -205,6 +214,8 @@
(event-exp-collector-set-pkey! evc exp))
(else
(evc-error (string-append "unknown symbol '" exp))))))
+ ((procedure? exp)
+ (event-exp-collector-add-predicate! evc exp))
((pair? exp)
(evc-error "invalid nested list"))
(else
@@ -419,6 +430,28 @@
release-seqs))
(event-exp-expand-macro-set presses))))))
+;; 'ext-true' macro
+;; Tests if specified external states are true
+(define event-exp-expand-macro-ext-true
+ (lambda (exp-list)
+ (list
+ (list
+ (lambda (ev)
+ (every (lambda (state-id)
+ (event-external-state ev state-id))
+ exp-list))))))
+
+;; 'ext-false' macro
+;; Tests if specified external states are false
+(define event-exp-expand-macro-ext-false
+ (lambda (exp-list)
+ (list
+ (list
+ (lambda (ev)
+ (every (lambda (state-id)
+ (not (event-external-state ev state-id)))
+ exp-list))))))
+
;; press-release, set, and ordered-chord are very bad name. should be
;; replaced with short and meaningful names.
(define event-exp-macro-alist
@@ -428,7 +461,8 @@
(cons 'ordered-chord event-exp-expand-macro-ordered-chord)
(cons 'chord event-exp-expand-macro-chord)
;;(cons 'interval event-exp-expand-macro-interval)
- ))
+ (cons 'ext-true event-exp-expand-macro-ext-true)
+ (cons 'ext-false event-exp-expand-macro-ext-false)))
;;
;; event expression sequence
@@ -443,13 +477,11 @@
(rest (cdr ev-exps)))
(cond
;; fast path for implicit macro
- ((event-exp-implicit-macro? exp)
- (let ((expanded (list exp) ;; for key-release dropper
- ;;(car (event-exp-expand-macro-press-release exp))
- ))
- (event-exp-list-expand-macro
- rest
- (cons expanded parsed))))
+;; ((event-exp-implicit-macro? exp)
+;; (let ((expanded (list exp) ;; for key-release dropper
+;; ;;(car (event-exp-expand-macro-press-release exp))
+;; ))
+;; (event-exp-list-expand-macro rest (cons expanded parsed))))
;; ordinary macros
((event-exp-formal-macro? exp)
(let* ((macro-sym (car exp))
@@ -462,7 +494,14 @@
(macro macro-args))))
;; AND expression, other simple elements
(else
- (event-exp-list-expand-macro rest (cons (list exp) parsed))))))))
+ (if (pair? exp)
+ (append-map (lambda (expanded)
+ (event-exp-list-expand-macro
+ rest
+ (cons (list expanded) parsed)))
+ (event-exp-list-expand-macro exp ()))
+ (begin
+ (event-exp-list-expand-macro rest (cons (list exp) parsed))))))))))
;; returns list of ev-exps
(define event-exp-seq-parse
@@ -487,10 +526,12 @@
(else
(list-canonicalize exp))))))
(lambda (ev-exp-seq)
- (let ((expandeds (event-exp-list-expand-macro ev-exp-seq ())))
- (map (lambda (expanded)
- (map canonicalize expanded))
- expandeds)))))
+ (if (find-tail pair? ev-exp-seq)
+ (let ((expandeds (event-exp-list-expand-macro ev-exp-seq ())))
+ (map (lambda (expanded)
+ (map canonicalize expanded))
+ expandeds))
+ (list ev-exp-seq))))) ;; fast path
;;
;; action expressions
@@ -571,12 +612,7 @@
(event-exp-collector-fold-internal exp action-exp-collector-new)))
(define action-exp-seq-parse
- (let ((action-symbol? (lambda (sym)
- (and (symbol? sym)
- (string-prefix? "action_"
- (symbol->string sym))
- sym)))
- (canonicalize (compose event-exp-collector-exp
+ (let ((canonicalize (compose event-exp-collector-exp
action-exp-collector-fold)))
(lambda (act-exps)
(map (lambda (exp)
@@ -586,6 +622,12 @@
(canonicalize exp)))
act-exps))))
+(define action-exp-seq-extract-guard-exp
+ (lambda (act-exps)
+ (let ((act-id (find action-symbol? act-exps)))
+ (and act-id
+ (list 'ext-true act-id)))))
+
;; presumes normalized
;; TODO:
;; - support named action (e.g. action_anthy_hiragana)
@@ -704,7 +746,9 @@
ev-exp
equal?))
(evmap-tree-insert-node! tree
- (evmap-tree-new ev-exp)))))
+ (evmap-tree-new ev-exp
+ #f
+ ())))))
(if (null? rest)
(evmap-tree-set-action-seq! child act-exps)
(evmap-tree-insert-rule! child rest act-exps))))))
@@ -729,13 +773,18 @@
(lambda (ruleset)
(let ((tree (evmap-tree-new)))
(for-each (lambda (rule)
- (let ((ev-seq-list (event-exp-seq-parse
- (evmap-rule-event-seq rule)))
- (act-seq (action-exp-seq-parse
- (evmap-rule-action-seq rule))))
+ (let* ((raw-act-seq (evmap-rule-action-seq rule))
+ (raw-ev-seq (evmap-rule-event-seq rule))
+ (guard (action-exp-seq-extract-guard-exp raw-act-seq))
+ (guarded-ev-seq (if guard
+ (event-exp-list-add-elem
+ raw-ev-seq guard)
+ raw-ev-seq))
+ (ev-seq-set (event-exp-seq-parse guarded-ev-seq))
+ (act-seq (action-exp-seq-parse raw-act-seq)))
(for-each (lambda (ev-seq)
(evmap-tree-insert-rule! tree ev-seq act-seq))
- ev-seq-list)))
+ ev-seq-set)))
ruleset)
tree)))
More information about the Uim-commit
mailing list