[uim-commit] r817 - branches/composer/scm
yamaken at freedesktop.org
yamaken at freedesktop.org
Wed Apr 6 02:57:02 PDT 2005
Author: yamaken
Date: 2005-04-06 02:56:59 -0700 (Wed, 06 Apr 2005)
New Revision: 817
Modified:
branches/composer/scm/anthy.scm
branches/composer/scm/evmap.scm
Log:
* This commit replaces composition table based key-release handling
with dedicated key-release dropper to relax strict press-release
sequence. This change allows accepting ((press "a") (press "b")
(release "a") (release "b")) sequence as ("a" "b"). This is required
for ordinary character composition.
Although simple expression such as "a" is interpreted as above, the
strict press/release handling is still available by describing
explicit 'press' or 'release' directive in event expression such as
(press "a").
* scm/evmap.scm
- (event-exp-directive-alist): Add new entry 'drop-release'
- (event-exp-has-explicit-press?): New procedure
- (event-exp-list-expand-macro):
* Disable implicit press-release macro expansion in accordance
with introduction of key-release dropper
* Remove duplicate procedure definition
- (event-exp-seq-parse): Add fast path for single event expression
- (evmap-context-input!): Add drop-release handling
- (record event-dropper): New record
- (event-dropper-add-event!, key-release-event-dropper-drop!): New
procedure
* scm/anthy.scm
- (anthy-context-rec-spec): Add new member 'ev-dropper'
- (anthy-context-new): Add initialization for 'ev-dropper'
- (anthy-input!): Add key-release dropper handlings
Modified: branches/composer/scm/anthy.scm
===================================================================
--- branches/composer/scm/anthy.scm 2005-04-04 01:49:03 UTC (rev 816)
+++ branches/composer/scm/anthy.scm 2005-04-06 09:56:59 UTC (rev 817)
@@ -842,6 +842,7 @@
(list 'ruletree #f) ;; current composition rule
(list 'keytrans-emc #f) ;; evmap-context for key-event translator
(list 'actmap-emc #f) ;; evmap-context for action mapper
+ (list 'ev-dropper #f) ;; key-release-event dropper
(list 'mod-state mod_None) ;; regenerated modifier state
(list 'mod-lock mod_None) ;; modifier lock state
(list 'mod-stick mod_None)))) ;; sticky modifier state
@@ -859,6 +860,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-ev-dropper! ac (event-dropper-new))
(anthy-select-ruletree! ac)
ac)))
@@ -918,39 +920,44 @@
(define anthy-input!
(lambda (ac ev)
- (let* ((actmap-emc (anthy-context-actmap-emc ac))
- (last-emc (evmap-ustr-last-emc (anthy-context-preconv-ustr ac)))
- (operating? (not (evmap-context-initial? actmap-emc)))
- (composing? (and last-emc
- (not (evmap-context-initial? last-emc))
- (not (evmap-context-complete? last-emc))))
- (actmap-input!
- (lambda ()
- (let ((matched? (evmap-context-input! actmap-emc ev)))
- (if (evmap-context-complete? actmap-emc)
+ (or (key-release-event-dropper-drop! (anthy-context-ev-dropper ac) ev #t)
+ (let* ((actmap-emc (anthy-context-actmap-emc ac))
+ (last-emc (evmap-ustr-last-emc (anthy-context-preconv-ustr ac)))
+ (operating? (not (evmap-context-initial? actmap-emc)))
+ (composing? (and last-emc
+ (not (evmap-context-initial? last-emc))
+ (not (evmap-context-complete? last-emc))))
+ (actmap-input!
+ (lambda ()
+ (let ((matched? (evmap-context-input! actmap-emc ev)))
+ (if (evmap-context-complete? actmap-emc)
+ (begin
+ (for-each (lambda (act-id)
+ (anthy-activate-action! ac act-id))
+ (evmap-context-action-seq actmap-emc))
+ (evmap-context-flush! actmap-emc)))
+ matched?))))
+ (if (or (and (or operating?
+ (not composing?))
+ (actmap-input!))
+ (let* ((rejected-ev-list (evmap-context-event-seq actmap-emc))
+ (matched-list (map (lambda (rej-ev)
+ (anthy-preedit-input! ac rej-ev))
+ (append rejected-ev-list
+ (list ev)))))
+ (evmap-context-flush! actmap-emc)
+ (apply proc-or matched-list))
+ (actmap-input!)) ;; to accept "nq" sequence
+ (begin
+ (if (eq? (event-consumed ev)
+ 'drop-release)
+ (event-dropper-add-event! (anthy-context-ev-dropper ac)
+ ev))
+ (if (event-loopback ev)
(begin
- (for-each (lambda (act-id)
- (anthy-activate-action! ac act-id))
- (evmap-context-action-seq actmap-emc))
- (evmap-context-flush! actmap-emc)))
- matched?))))
- (if (or (and (or operating?
- (not composing?))
- (actmap-input!))
- (let* ((rejected-ev-list (evmap-context-event-seq actmap-emc))
- (matched-list (map (lambda (rej-ev)
- (anthy-preedit-input! ac rej-ev))
- (append rejected-ev-list
- (list ev)))))
- (evmap-context-flush! actmap-emc)
- (apply proc-or matched-list))
- (actmap-input!)) ;; to accept "nq" sequence
- (begin
- (if (event-loopback ev)
- (begin
- (event-set-loopback! ev #f)
- (anthy-input! ac ev)))
- (anthy-update-preedit ac))))))
+ (event-set-loopback! ev #f)
+ (anthy-input! ac ev)))
+ (anthy-update-preedit ac)))))))
;; returns matched
(define anthy-preedit-input!
Modified: branches/composer/scm/evmap.scm
===================================================================
--- branches/composer/scm/evmap.scm 2005-04-04 01:49:03 UTC (rev 816)
+++ branches/composer/scm/evmap.scm 2005-04-06 09:56:59 UTC (rev 817)
@@ -95,6 +95,7 @@
(list
(cons 'consume (lambda (ev) (event-set-consumed! ev #t) #t))
(cons 'peek (lambda (ev) (event-set-consumed! ev 'peek) #t))
+ (cons 'drop-release (lambda (ev) (event-set-consumed! ev 'drop-release) #t))
(cons 'loopback (lambda (ev) (event-set-loopback! ev #t) #t))))
(define event-exp-predicate
@@ -249,6 +250,14 @@
(event-exp-has-elem? exp elem))
exp-list)))
+(define event-exp-has-explicit-press?
+ (lambda (exp)
+ (let ((press-pred (event-exp-predicate 'press)))
+ (if (pair? exp)
+ (memq press-pred exp)
+ (eq? press-pred exp)))))
+
+
;; side effect: event-consumed of passed ev is modified when matched
;; and explicit directive 'consume' or 'peek' is specified. The
;; event-consumed field will not be modified if any other elements of
@@ -429,40 +438,15 @@
(define event-exp-list-expand-macro
(lambda (ev-exps parsed)
(if (null? ev-exps)
- (list (reverse parsed))
- (let ((exp (car ev-exps))
- (rest (cdr ev-exps)))
- (cond
- ;; fast path for implicit press-release macro
- ((event-exp-implicit-macro? exp)
- (let ((expanded (car (event-exp-expand-macro-press-release exp))))
- (event-exp-list-expand-macro
- rest
- (append-reverse expanded parsed))))
- ;; ordinary macros
- ((event-exp-formal-macro? exp)
- (let* ((macro-sym (car exp))
- (macro-args (cdr exp))
- (macro (assq-cdr macro-sym event-exp-macro-alist)))
- (append-map (lambda (expanded)
- (event-exp-list-expand-macro
- rest
- (append-reverse expanded parsed)))
- (macro macro-args))))
- ;; AND expression, other simple elements
- (else
- (event-exp-list-expand-macro rest (cons exp parsed))))))))
-
-(define event-exp-list-expand-macro
- (lambda (ev-exps parsed)
- (if (null? ev-exps)
(list (concatenate (reverse parsed)))
(let ((exp (car ev-exps))
(rest (cdr ev-exps)))
(cond
- ;; fast path for implicit press-release macro
+ ;; fast path for implicit macro
((event-exp-implicit-macro? exp)
- (let ((expanded (car (event-exp-expand-macro-press-release 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))))
@@ -486,6 +470,10 @@
event-exp-collector-fold))
(canonicalize (lambda (exp)
(cond
+ ;; fast path for single expression
+ ((or (string? exp)
+ (symbol? exp))
+ exp)
;; fast path for simple press-release elements
((and (pair? exp)
(= (length exp)
@@ -880,6 +868,10 @@
(let* ((peek (eq? (event-consumed ev)
'peek))
(branches (evmap-tree-branches closer-tree))
+ (ev-exp (evmap-tree-event closer-tree))
+ (implicit-press? (and (key-event-press ev)
+ (not (event-exp-has-explicit-press?
+ ev-exp))))
(substituted (evmap-tree-new (if peek
(key-event-new) ;; dummy
ev)
@@ -889,7 +881,15 @@
(ustr-insert-elem! seq substituted)
(evmap-tree-set-action-seq! substituted
(action-exp-seq-extract act-exps emc))
- (event-set-consumed! ev (if peek #f #t))
+ (event-set-consumed! ev (cond
+ (peek
+ #f)
+ (implicit-press?
+ 'drop-release)
+ ((symbol? (event-consumed ev))
+ (event-consumed ev))
+ (else
+ #t)))
closer-tree)))))
;; Current implementation only supports these undo behaviors.
@@ -914,3 +914,34 @@
(else
(ustr-cursor-delete-backside! seq)
(undo seq))))))
+
+;;
+;; event-dropper
+;;
+(define-record 'event-dropper
+ '((ev-set ())))
+
+(define event-dropper-add-event!
+ (lambda (dropper ev)
+ (event-dropper-set-ev-set! dropper
+ (cons ev (event-dropper-ev-set dropper)))))
+
+;; TODO: introduce event expression to generalize matching
+;; returns dropped or not
+(define key-release-event-dropper-drop!
+ (lambda (dropper ev remove-matcher?)
+ (let ((orig (event-dropper-ev-set dropper))
+ (removed (remove (lambda (matcher-ev)
+ (and (not (key-event-press ev))
+ (eq? (key-event-lkey matcher-ev)
+ (key-event-lkey ev))
+ (eq? (key-event-pkey matcher-ev)
+ (key-event-pkey ev))))
+ (event-dropper-ev-set dropper))))
+ (and (not (= (length orig)
+ (length removed)))
+ (begin
+ (event-set-consumed! ev #t)
+ (if remove-matcher?
+ (event-dropper-set-ev-set! dropper removed))
+ #t)))))
More information about the Uim-commit
mailing list