[uim-commit] r706 - branches/composer/scm
yamaken at freedesktop.org
yamaken at freedesktop.org
Wed Feb 23 16:46:49 PST 2005
Author: yamaken
Date: 2005-02-23 16:46:46 -0800 (Wed, 23 Feb 2005)
New Revision: 706
Added:
branches/composer/scm/event.scm
branches/composer/scm/evmap.scm
branches/composer/scm/ng-key.scm
branches/composer/scm/physical-key.scm
Modified:
branches/composer/scm/Makefile.am
Log:
* This commit introduces new generic component named evmap for
ease developing input methods.
The evmap is designed to be used as table-based character
composition, key binding, key substitution, action binding and so
on. See header comments of these files for further information.
Don't blame me about efficiency or resource consumption of current
implementation. This is only a prototype. Interfaces, data formats
and behaviors will be changed without notice until next next stable
release (0.6).
* scm/ng-key.scm
- New file
- (valid-modifiers, mod_None, mod_Shift_L, mod_Shift_R, mod_Shift,
mod_Control_L, mod_Control_R, mod_Control, mod_Alt_L, mod_Alt_R,
mod_Alt, mod_Meta_L, mod_Meta_R, mod_Meta, mod_Super_L,
mod_Super_R, mod_Super, mod_Hyper_L, mod_Hyper_R, mod_Hyper,
mod_Caps_Lock, mod_ignore_Shift, mod_ignore_Control,
mod_ignore_Alt, mod_ignore_Meta, mod_ignore_Super,
mod_ignore_Hyper, modifier-shift-mask, modifier-control-mask,
modifier-alt-mask, modifier-meta-mask, modifier-super-mask,
modifier-hyper-mask, valid-logical-keys, valid-physical-keys): New
variable
- (modifier-symbol?, modifier-has?, modifier-aggregate,
modifier-match?, logical-key?, physical-key?): New procedure
* scm/physical-key.scm
- New file
- (lkey-qwerty->pkey-qwerty-alist,
lkey-extended-qwerty->pkey-qwerty-alist,
lkey-dvorak->pkey-qwerty-alist,
lkey-jp106-qwerty->pkey-jp106-alist): New variable
* scm/event.scm
- New file
- (record utext, record event, record timer-event, record
reset-event, record action-event, record commit-event, record
insert-event, record key-event): New record
- (valid-event-types, event-rec-spec): New variable
- (key-event-new-internal, key-event-new, key-release-event-new,
key-event-char, key-event-extract-press-str,
key-event-char-upcase!, key-event-char-downcase!,
key-event-covers?): New procedure
* scm/evmap.scm
- New file
- (record event-exp-collector, record evmap-rule, record evmap-tree,
record evmap-context): New record
- (event-exp-predicate-alist, event-exp-directive-alist
event-exp-macro-alist, action-exp-preprocess-directive-alist,
action-exp-postprocess-directive-alist): New variable
- (event-exp-predicate, event-exp-collector-new-internal,
event-exp-collector-new, event-exp-collector-find-predicate,
event-exp-collector-add-modifier!,
event-exp-collector-add-predicate!,
event-exp-collector-normalize-predicates!,
event-exp-collector-exp, event-exp-collector-fold-elem,
event-exp-collector-fold-internal, event-exp-collector-fold,
event-exp-add-elem, event-exp-list-add-elem, event-exp-has-elem?,
event-exp-list-has-elem?, event-exp-match?,
event-exp-implicit-macro?, event-exp-macro?,
event-exp-expand-macro-press-release, event-exp-expand-macro-set,
event-exp-expand-macro-ordered-chord,
event-exp-expand-macro-chord, event-exp-list-expand-macro,
event-exp-seq-parse, list-copy!,
action-exp-directive-positional-var, action-exp-directive,
action-exp-collector-new, action-exp-collector-fold,
action-exp-seq-parse, action-exp-seq-extract, evmap-tree-leaf?,
evmap-tree-node?, evmap-tree-find-branches,
evmap-tree-insert-node!, evmap-tree-insert-rule!,
evmap-parse-ruleset, rk-rule->evmap-ruleset, ustr-end-elem,
evmap-context-new-internal, evmap-context-new,
evmap-context-flush!, evmap-context-current-tree,
evmap-context-complete?, evmap-context-partial?,
evmap-context-event-seq, evmap-context-event-seq-string,
evmap-context-composed-string, evmap-context-preedit-string,
evmap-context-positional-var, evmap-context-input!,
evmap-context-undo!): New procedure
- (combinational-shift-ruleset, sticky-shift-ruleset,
shift-lock-ruleset): New variable
* scm/Makefile.am
- (SCM_FILES): ng-key.scm physical-key.scm event.scm evmap.scm
Modified: branches/composer/scm/Makefile.am
===================================================================
--- branches/composer/scm/Makefile.am 2005-02-24 00:08:32 UTC (rev 705)
+++ branches/composer/scm/Makefile.am 2005-02-24 00:46:46 UTC (rev 706)
@@ -7,6 +7,7 @@
SCM_FILES = plugin.scm im.scm im-custom.scm lazy-load.scm init.scm \
default.scm \
util.scm key.scm ustr.scm action.scm load-action.scm i18n.scm \
+ ng-key.scm physical-key.scm event.scm evmap.scm \
uim-sh.scm custom.scm custom-rt.scm \
manage-modules.scm \
direct.scm \
Added: branches/composer/scm/event.scm
===================================================================
--- branches/composer/scm/event.scm 2005-02-24 00:08:32 UTC (rev 705)
+++ branches/composer/scm/event.scm 2005-02-24 00:46:46 UTC (rev 706)
@@ -0,0 +1,173 @@
+;;; event.scm: Event definitions
+;;;
+;;; Copyright (c) 2004-2005 uim Project http://uim.freedesktop.org/
+;;;
+;;; 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 REGENTS 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 REGENTS 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.
+;;;;
+
+;; These events will cooperate with the composer framework which will
+;; be appeared as composer.scm to enable flexible input method
+;; component organization such as nested composer (input method) based
+;; on loose relationships. -- YamaKen 2005-02-18
+
+(require "util.scm")
+(require "ng-key.scm")
+
+
+;;
+;; utext
+;;
+
+;; The name 'utext' is inspired by Mtext of the m17n library
+(define-record 'utext
+ '((str "")
+ (language "")
+ (encoding "")
+ (props ()))) ;; arbitrary properties alist
+
+;; TODO:
+;; - character encoding conversion
+;; - encoding-aware string split
+;; - encoding name canonicalization
+;; - comparison
+
+;;
+;; event definitions
+;;
+
+(define valid-event-types
+ '(timer
+ reset
+ action
+ commit
+ insert
+ key))
+
+(define event-rec-spec
+ '((type unknown)
+ (consumed #f)
+ (loopback #f) ;; instructs re-injection into local composer
+ (timestamp -1))) ;; placeholder
+(define-record 'event event-rec-spec)
+
+(define-record 'timer-event
+ event-rec-spec)
+
+(define-record 'reset-event
+ event-rec-spec)
+
+(define-record 'action-event
+ (append
+ event-rec-spec
+ '((name #f)))) ;; 'action_input_mode_direct
+
+;; TODO: define req/ack events for action and chooser (candidate
+;; selector) to export their items
+
+(define-record 'commit-event
+ (append
+ event-rec-spec
+ '((utexts ())
+ (clear-preedit #t))))
+
+;; insert a text into preedit
+(define-record 'insert-event
+ (append
+ event-rec-spec
+ '((utext #f))))
+
+;; #f means "don't care" for lkey, pkey, str, press and autorepeat
+;; when comparing with other key-event. But modifiers require exact
+;; match.
+(define-record 'key-event
+ (append
+ event-rec-spec
+ (list
+ ;;(list text #f) ;; replace raw string with utext in future
+ (list 'str #f) ;; precomposed string
+ (list 'lkey #f) ;; logical keysym
+ (list 'pkey #f) ;; physical keysym
+ (list 'modifier mod_None) ;; set of modifiers
+ (list 'press #t) ;; indicates press/release
+ (list 'autorepeat #f)))) ;; whether generated by autorepeat or not
+(define key-event-new-internal key-event-new)
+
+(define key-event-new
+ (lambda args
+ (apply key-event-new-internal
+ (append '(key #f #f -1) args))))
+
+(define key-release-event-new
+ (lambda args
+ (let ((ev (apply key-event-new args)))
+ (key-event-set-press! ev #f)
+ ev)))
+
+;; TODO: make encoding sensitive
+(define key-event-char
+ (compose string->char key-event-str))
+
+(define key-event-extract-press-str
+ (lambda (ev)
+ (and (key-event-press ev)
+ (key-event-str ev))))
+
+(define key-event-char-upcase!
+ (lambda (ev)
+ (let ((str ((compose charcode->string
+ char-upcase
+ key-event-char)
+ ev)))
+ (key-event-set-str! ev str))))
+
+(define key-event-char-downcase!
+ (lambda (ev)
+ (let ((str ((compose charcode->string
+ char-downcase
+ key-event-char)
+ ev)))
+ (key-event-set-str! ev str))))
+
+;; TODO: write test
+(define key-event-covers?
+ (lambda (self other)
+ (and (every (lambda (getter)
+ (let ((self-val (getter self))
+ (other-val (getter other)))
+ (and self-val ;; #f means "don't care"
+ (equal? self-val other-val))))
+ (list key-event-lkey
+ key-event-pkey
+ key-event-str))
+ (modifier-match? (key-event-modifier self)
+ (key-event-modifier other))
+ ;; exact matches
+ (every (lambda (getter)
+ (equal? (getter self)
+ (getter other)))
+ (list key-event-press
+ key-event-autorepeat)))))
Added: branches/composer/scm/evmap.scm
===================================================================
--- branches/composer/scm/evmap.scm 2005-02-24 00:08:32 UTC (rev 705)
+++ branches/composer/scm/evmap.scm 2005-02-24 00:46:46 UTC (rev 706)
@@ -0,0 +1,836 @@
+;;; evmap.scm: Multipurpose event mapper
+;;;
+;;; Copyright (c) 2004-2005 uim Project http://uim.freedesktop.org/
+;;;
+;;; 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 REGENTS 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 REGENTS 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.
+;;;;
+
+;; The evmap is designed to be used as table-based character composition, key
+;; binding, key substitution, action binding and so on.
+;;
+;; Current implementation is using dumb expanded tree of event sequences as
+;; internal representaion. In different to ordinary finite state machine (or
+;; automaton), cyclic state transitions are intentionally limited in evmap to
+;; achieve:
+;;
+;; - merging multiple state machines into single one
+;; - represent mapping rules as simple table definition for user convenience
+;;
+;; Former issue means merging event sequences such as ("k" "a") and ("k" "k"
+;; "o") into single tree ("k" ("a" ("k" "o"))). This tree representation
+;; requirement will be withdrawn if sophisticated state machine compiler is
+;; introduced. But I recommend that using the m17n library to create such
+;; cyclic state machine based input method since the library has
+;; well-experienced facility for such input methods.
+;;
+;; From the viewpoint of character composition feature, the evmap itself only
+;; provides simple table-based character composition roughly as same layer as
+;; traditional rk.scm although it can handle more complex composition rules
+;; than rk. More complex features such as word or phrase-level editing will be
+;; implemented in higher layer using the composer framework in cooperation
+;; with evmap's own composer interface evmap-composer.scm.
+;;
+;; Don't blame me about efficiency or resource consumption of current
+;; implementation. This is only a prototype. Interfaces, data formats and
+;; behaviors will be changed without notice until next stable release.
+;; -- YamaKen 2005-02-18
+
+(require "util.scm")
+(require "ustr.scm")
+(require "event.scm")
+(require "ng-key.scm")
+
+
+;;
+;; event expression
+;;
+
+(define event-exp-predicate-alist
+ (list
+ (cons 'press key-event-press)
+ (cons 'release (compose not key-event-press))
+ (cons 'autorepeat key-event-autorepeat)
+ (cons 'nonrepeat (compose not key-event-autorepeat))
+ (cons 'char-printable (compose char-printable? key-event-char))
+ (cons 'char-graphic (compose char-graphic? key-event-char))
+ (cons 'char-control (compose char-control? key-event-char))
+ (cons 'char-numeric (compose char-numeric? key-event-char))
+ (cons 'char-alphabetic (compose char-alphabetic? key-event-char))
+ (cons 'char-upper-case (compose char-upper-case? key-event-char))
+ (cons 'char-lower-case (compose char-lower-case? key-event-char))
+ (cons 'char-vowel (compose char-vowel? key-event-char))
+ (cons 'char-nonvowel (compose not char-vowel? key-event-char))
+ (cons 'char-consonant (compose char-consonant? key-event-char))))
+
+(define event-exp-directive-alist
+ (list
+ (cons 'consume (lambda (ev) (event-set-consumed! ev #t) #t))
+ (cons 'peek (lambda (ev) (event-set-consumed! ev 'peek) #t))))
+
+(define event-exp-predicate
+ (lambda (sym)
+ (or (assq-cdr sym event-exp-predicate-alist)
+ (assq-cdr sym event-exp-directive-alist))))
+
+;; #f means "don't care"
+(define-record 'event-exp-collector
+ (list
+ (list 'str #f) ;; precomposed string
+ (list 'lkey #f) ;; logical keysym
+ (list 'pkey #f) ;; physical keysym
+ (list 'modifier mod_None) ;; set of modifiers
+ (list 'predicates ()) ;; ordered list of predicates
+ (list 'pred-alist ())))
+(define event-exp-collector-new-internal event-exp-collector-new)
+
+(define event-exp-collector-new
+ (let ((pred-alist (append event-exp-predicate-alist
+ event-exp-directive-alist)))
+ (lambda args
+ (let ((evc (apply event-exp-collector-new-internal args)))
+ (event-exp-collector-set-pred-alist! evc pred-alist)
+ evc))))
+
+(define event-exp-collector-find-predicate
+ (lambda (evc sym)
+ (assq-cdr sym (event-exp-collector-pred-alist evc))))
+
+(define event-exp-collector-add-modifier!
+ (lambda (evc mod)
+ (let ((modifier (event-exp-collector-modifier evc)))
+ (event-exp-collector-set-modifier! evc (bit-or mod modifier)))))
+
+(define event-exp-collector-add-predicate!
+ (lambda (evc pred)
+ (let ((predicates (event-exp-collector-predicates evc)))
+ (event-exp-collector-set-predicates! evc (cons pred predicates)))))
+
+(define event-exp-collector-normalize-predicates!
+ (lambda (evc)
+ (let* ((pred-alist (event-exp-collector-pred-alist evc))
+ (predicates (event-exp-collector-predicates evc))
+ (normalized (filter-map (lambda (pair)
+ (let ((pred (cdr pair)))
+ (and (memq pred predicates)
+ pred)))
+ pred-alist)))
+ (event-exp-collector-set-predicates! evc normalized))))
+
+;; returns normalized event-exp expression
+(define event-exp-collector-exp
+ (lambda (evc)
+ (event-exp-collector-normalize-predicates! evc)
+ (let* ((modifier (event-exp-collector-modifier evc))
+ (exp-list (filter (lambda (elem)
+ elem)
+ (append
+ (list
+ (event-exp-collector-str evc)
+ (event-exp-collector-lkey evc)
+ (event-exp-collector-pkey evc))
+ (if (not (= modifier 0))
+ (list modifier)
+ ())
+ (event-exp-collector-predicates evc)))))
+ (if (= (length exp-list)
+ 1)
+ (car exp-list)
+ exp-list))))
+
+(define event-exp-collector-fold-elem
+ (lambda (evc exp)
+ (let ((pred-alist (event-exp-collector-pred-alist evc))
+ (evc-error (lambda (msg)
+ (error (string-append "invalid event-exp expression: "
+ msg)))))
+ (cond
+ ((string? exp)
+ (if (event-exp-collector-str evc)
+ (evc-error "duplicated str"))
+ (event-exp-collector-set-str! evc exp))
+ ((symbol? exp)
+ (cond
+ ((modifier-symbol? exp)
+ (event-exp-collector-add-modifier! evc (symbol-value exp)))
+ ((assq exp pred-alist)
+ (let ((match? (assq-cdr exp pred-alist)))
+ (event-exp-collector-add-predicate! evc match?)))
+ ((logical-key? exp)
+ (if (event-exp-collector-lkey evc)
+ (evc-error "duplicated logical key"))
+ (event-exp-collector-set-lkey! evc exp))
+ ((physical-key? exp)
+ (if (event-exp-collector-pkey evc)
+ (evc-error "duplicated physical key"))
+ (event-exp-collector-set-pkey! evc exp))
+ (else
+ (evc-error "unknown symbol"))))
+ ((list? exp)
+ (evc-error "invalid nested list"))
+ (else
+ (evc-error "invalid element")))
+ evc)))
+
+(define event-exp-collector-fold-internal
+ (lambda (exp evc-creator)
+ (let ((evc (evc-creator)))
+ (fold (lambda (exp evc)
+ (event-exp-collector-fold-elem evc exp))
+ evc
+ (if (list? exp)
+ exp
+ (list exp))))))
+
+(define event-exp-collector-fold
+ (lambda (exp)
+ (event-exp-collector-fold-internal exp event-exp-collector-new)))
+
+
+(define event-exp-add-elem
+ (lambda (exp elem)
+ (if (list? exp)
+ (cons elem exp)
+ (list elem exp))))
+
+(define event-exp-list-add-elem
+ (lambda (exp-list elem)
+ (map (lambda (exp)
+ (event-exp-add-elem exp elem))
+ exp-list)))
+
+(define event-exp-has-elem?
+ (lambda (exp elem)
+ (if (list? exp)
+ (member elem exp)
+ (equal? elem exp))))
+
+(define event-exp-list-has-elem?
+ (lambda (exp-list elem)
+ (any (lambda (exp)
+ (event-exp-has-elem? exp elem))
+ exp-list)))
+
+;; 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
+;; the event-exp do not match.
+;;
+;; TODO: distinguish key-event and others
+(define event-exp-match?
+ (lambda (exp ev)
+ (let ((modifier-explicitly-matched? #f))
+ (and (not (null? exp))
+ (every (lambda (elem)
+ (cond
+ ((string? elem)
+ (and (key-event-str ev)
+ (string=? (key-event-str ev)
+ elem)))
+ ;; modifier
+ ((integer? elem)
+ (set! modifier-explicitly-matched? #t)
+ (modifier-match? elem (key-event-modifier ev)))
+ ((symbol? elem)
+ (cond
+ ;; logical key
+ ((eq? (key-event-lkey ev)
+ elem)
+ ;;(logical-key? elem) ;; already validated when parsed
+ #t)
+ ;; physical key
+ ((eq? (key-event-pkey ev)
+ elem)
+ ;;(physical-key? elem) ;; already validated when parsed
+ #t)
+ (else
+ #f)))
+ ((procedure? elem)
+ (elem ev))
+ (else
+ #f)))
+ (if (list? exp)
+ exp
+ (list exp)))
+ (or modifier-explicitly-matched?
+ (= (key-event-modifier ev)
+ 0))))))
+
+;;
+;; event expression macros
+;;
+
+;; macro expansion should be performed on rule rather than
+;; event-exp-seq to allow flexible expressions. -- YamaKen 2005-02-23
+
+;; abbreviation of press-release macro
+(define event-exp-implicit-macro?
+ (lambda (exp)
+ (let ((exp-list (if (list? exp)
+ exp
+ (list exp))))
+ (and (not (memq 'press exp-list))
+ (not (memq 'release exp-list))
+ (not (assq (car exp-list) event-exp-macro-alist))
+ (find (lambda (elem)
+ (or (string? elem)
+ (logical-key? elem)
+ (physical-key? elem)))
+ exp-list)))))
+
+(define event-exp-macro?
+ (lambda (exp)
+ (let ((macro-sym (safe-car exp)))
+ (or (and macro-sym
+ (symbol? macro-sym)
+ (assq-cdr macro-sym event-exp-macro-alist))
+ (event-exp-implicit-macro? exp)))))
+
+;; 'press-release' macro
+;; Collects corresponding release edge of the key. Default behavior.
+(define event-exp-expand-macro-press-release
+ (lambda (exp-list)
+ (list
+ ;; Composed character should be appeared on pressing key
+ ;;(list
+ ;; (event-exp-add-elem exp-list 'press))
+ ;; Composed character must not be disappeared on releasing
+ ;; key. These duplicated action mapping prevents mapping
+ ;; ordinary named action instead of characters. This problem
+ ;; should be resolved by rule-based macro expansion which
+ ;; replacing current event-exp-seq based one.
+ (list
+ (event-exp-add-elem exp-list 'press)
+ (event-exp-add-elem exp-list 'release)))))
+
+;; 'set' macro
+(define event-exp-expand-macro-set
+ (lambda (exp-list)
+ (cond
+ ((null? exp-list)
+ ())
+ ((= (length exp-list)
+ 1)
+ (list exp-list))
+ (else
+ (append-map (lambda (exp)
+ (let* ((others (delete exp exp-list equal?))
+ (expandeds (event-exp-expand-macro-set others)))
+ (map (lambda (expanded)
+ (cons exp expanded))
+ expandeds)))
+ exp-list)))))
+
+;; 'ordered-chord' macro
+;;
+;; Since current implementation produces explosional (length exp-list)!
+;; rules, arguments of ordered-chord keys should be limited to 3, which
+;; produces 6 rules. 4 keys produces 24 rules, and 5 keys produces 120
+;; rules. This rule explosion problem will be resolved by dynamic state
+;; transition and ruleset composer(merger) that aware of the dynamic
+;; transition. -- YamaKen 2005-02-15
+;;
+;; TODO: ensure that exp-list does not contain 'press' and 'release'
+(define event-exp-expand-macro-ordered-chord
+ (lambda (exp-list)
+ (if (or (null? exp-list)
+ (event-exp-list-has-elem? exp-list 'press)
+ (event-exp-list-has-elem? exp-list 'release))
+ ()
+ (let* ((presses (event-exp-list-add-elem exp-list 'press))
+ (releases (event-exp-list-add-elem exp-list 'release))
+ (release-seqs (event-exp-expand-macro-set releases)))
+ (map (lambda (release-seq)
+ (append presses release-seq))
+ release-seqs)))))
+
+;; 'chord' macro
+;;
+;; Since current implementation produces explosional ((length exp-list)! ^ 2)
+;; rules, arguments of chord keys should be limited to 2, which produces 4
+;; rules. 3 keys produces 36 rules, and 4 keys produces 576 rules. This rule
+;; explosion problem will be resolved by dynamic state transition and ruleset
+;; composer(merger) that aware of the dynamic transition.
+;; -- YamaKen 2005-02-15
+;;
+;; TODO: ensure that exp-list does not contain 'press' and 'release'
+(define event-exp-expand-macro-chord
+ (lambda (exp-list)
+ (if (or (null? exp-list)
+ (event-exp-list-has-elem? exp-list 'press)
+ (event-exp-list-has-elem? exp-list 'release))
+ ()
+ (let* ((presses (event-exp-list-add-elem exp-list 'press))
+ (releases (event-exp-list-add-elem exp-list 'release))
+ (release-seqs (event-exp-expand-macro-set releases)))
+ (append-map (lambda (press-seq)
+ (map (lambda (release-seq)
+ (append press-seq release-seq))
+ release-seqs))
+ (event-exp-expand-macro-set presses))))))
+
+;; press-release, set, and ordered-chord are very bad name. should be
+;; replaced with short and meaningful names.
+(define event-exp-macro-alist
+ (list
+ (cons 'press-release event-exp-expand-macro-press-release)
+ (cons 'set event-exp-expand-macro-set)
+ (cons 'ordered-chord event-exp-expand-macro-ordered-chord)
+ (cons 'chord event-exp-expand-macro-chord)
+ ;;(cons 'interval event-exp-expand-macro-interval)
+ ))
+
+;;
+;; event expression sequence
+;;
+
+;; returns list of ev-exps
+(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
+ ;; macro
+ ((event-exp-macro? exp)
+ (let* ((implicit-macro? (event-exp-implicit-macro? exp))
+ (macro-sym (if implicit-macro?
+ 'press-release
+ (car exp)))
+ (macro-args (if implicit-macro?
+ (if (list? exp)
+ exp
+ (list exp))
+ (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))))))))
+
+;; returns list of ev-exps
+(define event-exp-seq-parse
+ (lambda (ev-exp-seq)
+ (let ((expandeds (event-exp-list-expand-macro ev-exp-seq ())))
+ (map (lambda (expanded)
+ (map (compose event-exp-collector-exp
+ event-exp-collector-fold)
+ expanded))
+ expandeds))))
+
+;;
+;; action expressions
+;;
+
+;; - an event is interpreted as implicit commit-event action
+;; - event can be expressed as event-exp
+;; - positional matched event references $1, $2, ... $9 are available
+;; - raw string as action such as "a" represents commit-event
+;; - raw string list as action such as '("a" "b") represents predit-event
+;; - an action-id
+;;
+;; special directives:
+;; - loopback
+;; - return
+;; - char-upcase
+;; - char-downcase
+
+(define list-copy!
+ (lambda (dst src)
+ (if (not (or (null? dst)
+ (null? src)))
+ (begin
+ (set-car! dst (car src))
+ (list-copy! (cdr dst) (cdr src))))))
+
+(define action-exp-directive-positional-var
+ (lambda (pos)
+ (lambda (emc ev)
+ (list-copy! ev (evmap-context-positional-var emc pos))
+ #t)))
+
+;; These directives are processed at first of action extraction
+(define action-exp-preprocess-directive-alist
+ (list
+ ;; Positional variable references
+ (cons '$1 (action-exp-directive-positional-var 1))
+ (cons '$2 (action-exp-directive-positional-var 2))
+ (cons '$3 (action-exp-directive-positional-var 3))
+ (cons '$4 (action-exp-directive-positional-var 4))
+ (cons '$5 (action-exp-directive-positional-var 5))
+ (cons '$6 (action-exp-directive-positional-var 6))
+ (cons '$7 (action-exp-directive-positional-var 7))
+ (cons '$8 (action-exp-directive-positional-var 8))
+ (cons '$9 (action-exp-directive-positional-var 9))))
+
+(define action-exp-postprocess-directive-alist
+ (list
+ (cons 'press (lambda (emc ev) (key-event-set-press! ev #t) #t))
+ (cons 'release (lambda (emc ev) (key-event-set-press! ev #f) #t))
+ (cons 'autorepeat (lambda (emc ev) (key-event-set-autorepeat! ev #t) #t))
+ (cons 'nonrepeat (lambda (emc ev) (key-event-set-autorepeat! ev #t) #t))
+ (cons 'char-upcase (lambda (emc ev) (key-event-char-upcase! ev) #t))
+ (cons 'char-downcase (lambda (emc ev) (key-event-char-downcase! ev) #t))
+
+ (cons 'loopback (lambda (emc ev) (event-set-loopback! ev #t) #t))
+ (cons 'return (lambda (emc ev) #t))))
+
+(define action-exp-directive
+ (lambda (sym)
+ (or (assq-cdr sym action-exp-preprocess-directive-alist)
+ (assq-cdr sym action-exp-postprocess-directive-alist))))
+
+(define action-exp-collector-new
+ (let ((directive-alist (append action-exp-preprocess-directive-alist
+ action-exp-postprocess-directive-alist)))
+ (lambda args
+ (let ((actc (apply event-exp-collector-new args)))
+ (event-exp-collector-set-pred-alist! actc directive-alist)
+ actc))))
+
+(define action-exp-collector-fold
+ (lambda (exp)
+ (event-exp-collector-fold-internal exp action-exp-collector-new)))
+
+(define action-exp-seq-parse
+ (lambda (act-exps)
+ (map (compose event-exp-collector-exp
+ action-exp-collector-fold)
+ act-exps)))
+
+;; presumes normalized
+;; TODO:
+;; - support named action (e.g. action_anthy_hiragana)
+;; - support alternative actions ('alt' macro) to express candidates
+;; - support arbitrary event object construction
+(define action-exp-seq-extract
+ (let* ((member-proc? (lambda (proc alist)
+ (find (lambda (pair)
+ (eq? proc (cdr pair)))
+ alist)))
+ (preproc? (lambda (proc)
+ (member-proc? proc
+ action-exp-preprocess-directive-alist)))
+ (extract-exp
+ (lambda (act-exp emc)
+ (cond
+ ((or (string? act-exp)
+ (symbol? act-exp)
+ (integer? act-exp))
+ act-exp)
+ ((procedure? act-exp)
+ (let ((ev (key-event-new)))
+ (act-exp emc ev)
+ ev))
+ ((pair? act-exp)
+ (let* ((ev (key-event-new))
+ (pre-procs (filter preproc? act-exp))
+ (rest-elems (remove (lambda (elem)
+ (memq elem pre-procs))
+ act-exp)))
+ (for-each (lambda (preproc)
+ (preproc emc ev))
+ pre-procs)
+ (for-each (lambda (elem)
+ (cond
+ ((string? elem)
+ (key-event-set-str! ev elem))
+ ((integer? elem)
+ (key-event-set-modifier! ev elem))
+ ((procedure? elem)
+ (elem emc ev))
+ ((symbol? elem)
+ (cond
+ ((logical-key? elem)
+ (key-event-set-lkey! ev elem))
+ ((physical-key? elem)
+ (key-event-set-pkey! ev elem))
+ (else
+ (error "invalid symbol in action expression"))))
+ (else
+ (error "invalid element in action expression"))))
+ rest-elems)
+ ev))
+ (else
+ (error "invalid element in action expression"))))))
+ (lambda (act-exps emc)
+ (cond
+ ((not act-exps)
+ #f)
+ ((pair? act-exps)
+ (filter-map (lambda (act-exps)
+ (extract-exp act-exps emc))
+ act-exps))
+ (else
+ (extract-exp act-exps emc))))))
+
+;;
+;; evmap-tree
+;;
+
+(define-record 'evmap-rule
+ '((event-seq ())
+ (action-seq ())))
+
+;; internal representation
+(define-record 'evmap-tree
+ '((event #f)
+ (action-seq #f)
+ (branches ()))) ;; list of nodes
+
+(define evmap-tree-leaf?
+ (lambda (tree)
+ (null? (evmap-tree-branches tree))))
+
+(define evmap-tree-node?
+ (lambda (tree)
+ (not (evmap-tree-leaf? tree))))
+
+;; API
+;; returns branches
+(define evmap-tree-find-branches
+ (lambda args
+ (let ((tree (car args))
+ (ev (cadr args))
+ (ev=? (if (null? (cddr args))
+ event-exp-match?
+ (car (cddr args)))))
+ (and (evmap-tree-node? tree)
+ (find-tail (lambda (child)
+ (let ((child-ev (evmap-tree-event child)))
+ (ev=? child-ev ev)))
+ (evmap-tree-branches tree))))))
+
+(define evmap-tree-insert-node!
+ (lambda (tree node)
+ (let ((inserted (cons node (evmap-tree-branches tree))))
+ (evmap-tree-set-branches! tree inserted)
+ node)))
+
+;; presumes normalized
+(define evmap-tree-insert-rule!
+ (lambda (tree ev-exps act-exps)
+ (if (null? ev-exps)
+ (error "invalid null event expression in rule")
+ (let* ((ev-exp (car ev-exps))
+ (rest (cdr ev-exps))
+ (child (or (safe-car (evmap-tree-find-branches tree
+ ev-exp
+ equal?))
+ (evmap-tree-insert-node! tree
+ (evmap-tree-new ev-exp)))))
+ (if (null? rest)
+ (evmap-tree-set-action-seq! child act-exps)
+ (evmap-tree-insert-rule! child rest act-exps))))))
+
+;; API
+;; returns evmap-tree
+(define evmap-parse-ruleset
+ (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))))
+ (for-each (lambda (ev-seq)
+ (evmap-tree-insert-rule! tree ev-seq act-seq))
+ ev-seq-list)))
+ ruleset)
+ tree)))
+
+(define rk-rule->evmap-ruleset
+ (lambda (rk-rule)
+ (map (lambda (pair)
+ (let ((seq (caar pair))
+ (composed (cadr pair)))
+ (print
+ (list seq
+ (if (string? (car composed))
+ composed
+ (apply zip composed))))))
+ rk-rule)
+ #f))
+
+;;
+;; evmap-context
+;;
+
+(define ustr-end-elem
+ (lambda (ustr)
+ (and (not (ustr-empty? ustr))
+ (ustr-nth ustr (- (ustr-length ustr)
+ 1)))))
+
+(define-record 'evmap-context
+ '((root #f)
+ (seq #f))) ;; list of evmap-tree
+(define evmap-context-new-internal evmap-context-new)
+
+(define evmap-context-new
+ (lambda (ruletree)
+ (evmap-context-new-internal ruletree (ustr-new))))
+
+(define evmap-context-flush!
+ (lambda (emc)
+ (ustr-clear! (evmap-context-seq emc))))
+
+(define evmap-context-current-tree
+ (lambda (emc)
+ (let ((seq (evmap-context-seq emc)))
+ (ustr-end-elem seq))))
+
+(define evmap-context-complete?
+ (lambda (emc)
+ (let ((current-tree (evmap-context-current-tree emc)))
+ (and current-tree
+ (evmap-tree-leaf? current-tree)))))
+
+(define evmap-context-partial?
+ (lambda (emc)
+ (let ((current-tree (evmap-context-current-tree emc)))
+ (and current-tree
+ (evmap-tree-node? current-tree)
+ (evmap-tree-action-seq current-tree)))))
+
+;;(define evmap-context-terminate!
+;; (lambda (emc)
+;; (let ((composed-str (evmap-context-composed-string emc)))
+;; (evmap-context-flush! emc)
+;; composed-str)))
+
+;;(define evmap-context-commit!
+;; (lambda (emc)
+;; (let ((commit-str (evmap-context-composed-string emc)))
+;; (ustr-clear-former! (evmap-context-seq emc))
+;; commit-str)))
+
+(define evmap-context-event-seq
+ (lambda (emc)
+ (let ((seq (evmap-context-seq emc)))
+ (map-ustr-whole evmap-tree-event seq))))
+
+;; returns string list
+(define evmap-context-event-seq-string
+ (lambda (emc)
+ (filter-map key-event-extract-press-str
+ (evmap-context-event-seq emc))))
+
+;; returns string list
+;; can be used as rk-peek-terminal-match
+(define evmap-context-composed-string
+ (lambda (emc)
+ (let ((tree (evmap-context-current-tree emc)))
+ (and tree
+ (let* ((act-seq (evmap-tree-action-seq tree))
+ (str-list (if (string? act-seq)
+ (list act-seq)
+ (filter string? act-seq))))
+ (and (not (null? str-list))
+ str-list))))))
+
+(define evmap-context-preedit-string
+ (lambda (emc)
+ (or (evmap-context-composed-string emc)
+ (evmap-context-event-seq-string emc))))
+
+;; pos starts from 1
+(define evmap-context-positional-var
+ (lambda (emc pos)
+ (let* ((seq (evmap-context-seq emc))
+ (tree (ustr-nth seq (- pos 1))))
+ (evmap-tree-event tree))))
+
+;; 'ev' may be consumed
+;; returns closer-tree
+(define evmap-context-input!
+ (lambda (emc ev)
+ (let* ((seq (evmap-context-seq emc))
+ (prev-tree (if (ustr-cursor-at-beginning? seq)
+ (evmap-context-root emc)
+ (ustr-cursor-backside seq)))
+ (closer-tree (safe-car (evmap-tree-find-branches prev-tree ev))))
+ (and closer-tree
+ (let* ((branches (evmap-tree-branches closer-tree))
+ (substituted (evmap-tree-new ev #f branches))
+ (act-exps (evmap-tree-action-seq closer-tree))
+ (peek (eq? (event-consumed ev)
+ 'peek)))
+ (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))
+ closer-tree)))))
+
+;; Current implementation only supports these undo behaviors.
+;;
+;; "ch" -> backspace -> "c"
+;; "¤Á¤ã" -> backspace -> "ch"
+;;
+;; TODO: Support following alternative undo behaviors.
+;;
+;; "¤Á¤ã" -> backspace -> ""
+;; "¤Á¤ã" -> backspace -> "¤Á"
+(define evmap-context-undo!
+ (lambda (emc)
+ (let undo ((seq (evmap-context-seq emc)))
+ (cond
+ ((ustr-cursor-at-beginning? seq)
+ #f)
+ ;; remove until most recent press
+ ((key-event-extract-press-str (car (ustr-cursor-backside seq)))
+ (ustr-cursor-delete-backside! seq)
+ #t)
+ (else
+ (ustr-cursor-delete-backside! seq)
+ (undo seq))))))
+
+;;
+;; fundamental rulesets
+;;
+
+(define combinational-shift-ruleset
+ '((((char-alphabet press) (char-alphabet press))
+ ((($1 char-upcase mod_shift loopback)) (($2 loopback))))))
+
+;; TODO:
+;; - support arbitrary set of modifiers
+;; - support non-alphabet chars
+(define sticky-shift-ruleset
+ '(((lkey_Shift_L char-alphabet) (($3 char-upcase mod_Shift_L loopback)
+ ($4 char-upcase mod_Shift_L loopback)))
+ ((lkey_Shift_R char-alphabet) (($3 char-upcase mod_Shift_R loopback)
+ ($4 char-upcase mod_Shift_R loopback)))))
+
+;; does not work yet
+(define shift-lock-ruleset
+ '(((lkey_Shift_L lkey_Shift_L) (action_toggle_shift_lock))
+ ((lkey_Shift_R lkey_Shift_R) (action_toggle_shift_lock))))
Added: branches/composer/scm/ng-key.scm
===================================================================
--- branches/composer/scm/ng-key.scm 2005-02-24 00:08:32 UTC (rev 705)
+++ branches/composer/scm/ng-key.scm 2005-02-24 00:46:46 UTC (rev 706)
@@ -0,0 +1,387 @@
+;;; ng-key.scm: Key definitions and utilities
+;;;
+;;; Copyright (c) 2005 uim Project http://uim.freedesktop.org/
+;;;
+;;; 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 REGENTS 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 REGENTS 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.
+;;;;
+
+(require "util.scm")
+
+;;
+;; modifiers
+;;
+
+(define valid-modifiers
+ '(mod_None
+
+ mod_Shift
+ mod_Shift_R
+ mod_Shift_L
+ mod_Control
+ mod_Control_R
+ mod_Control_L
+ mod_Alt
+ mod_Alt_R
+ mod_Alt_L
+ mod_Meta
+ mod_Meta_R
+ mod_Meta_L
+ mod_Super
+ mod_Super_R
+ mod_Super_L
+ mod_Hyper
+ mod_Hyper_R
+ mod_Hyper_L
+
+ mod_Caps_Lock
+ ;;mod_Shift_Lock
+ ;;mod_Num_Lock
+
+ ;; pseudo modifiers for meta-event
+ mod_ignore_Shift
+ mod_ignore_Control
+ mod_ignore_Alt
+ mod_ignore_Meta
+ mod_ignore_Super
+ mod_ignore_Hyper))
+
+(define mod_None 0)
+(define mod_Shift_L 1)
+(define mod_Shift_R 2)
+(define mod_Shift 4)
+(define mod_Control_L 8)
+(define mod_Control_R 16)
+(define mod_Control 32)
+(define mod_Alt_L 64)
+(define mod_Alt_R 128)
+(define mod_Alt 256)
+(define mod_Meta_L 512)
+(define mod_Meta_R 1024)
+(define mod_Meta 2048)
+(define mod_Super_L 4096)
+(define mod_Super_R 8192)
+(define mod_Super 16384)
+(define mod_Hyper_L 32768)
+(define mod_Hyper_R 65536)
+(define mod_Hyper 131072)
+(define mod_Caps_Lock 262144)
+;;(define 524288)
+;;(define 1048576)
+;;(define 2097152)
+;;(define 4194304)
+;;(define 8388608)
+;;(define 16777216)
+(define mod_ignore_Shift 33554432)
+(define mod_ignore_Control 67108864)
+(define mod_ignore_Alt 134217728)
+(define mod_ignore_Meta 268435456)
+(define mod_ignore_Super 536870912)
+(define mod_ignore_Hyper 1073741824)
+
+(define modifier-shift-mask
+ (bitwise-or mod_Shift_L mod_Shift_R mod_Shift))
+(define modifier-control-mask
+ (bitwise-or mod_Control_L mod_Control_R mod_Control))
+(define modifier-alt-mask
+ (bitwise-or mod_Alt_L mod_Alt_R mod_Alt))
+(define modifier-meta-mask
+ (bitwise-or mod_Meta_L mod_Meta_R mod_Meta))
+(define modifier-super-mask
+ (bitwise-or mod_Super_L mod_Super_R mod_Super))
+(define modifier-hyper-mask
+ (bitwise-or mod_Hyper_L mod_Hyper_R mod_Hyper))
+
+
+;; API
+(define modifier-symbol?
+ (lambda (sym)
+ (and (symbol? sym)
+ (memq sym valid-modifiers))))
+
+;; API
+(define modifier-has?
+ (lambda (self other)
+ (= (bitwise-and self other)
+ other)))
+
+(define modifier-aggregate
+ (lambda (self flags)
+ (let ((aggregate-mod-group (lambda (self flags mod mod-ignore mod-mask)
+ (let ((self-mods (bitwise-and self mod-mask)))
+ (if (modifier-has? flags mod-ignore)
+ mod-ignore
+ (if (and (modifier-has? flags mod)
+ (not (= self-mods 0)))
+ mod
+ self-mods))))))
+ (bitwise-or (aggregate-mod-group self flags mod_Shift mod_ignore_Shift
+ modifier-shift-mask)
+ (aggregate-mod-group self flags mod_Control mod_ignore_Control
+ modifier-control-mask)
+ (aggregate-mod-group self flags mod_Alt mod_ignore_Alt
+ modifier-alt-mask)
+ (aggregate-mod-group self flags mod_Meta mod_ignore_Meta
+ modifier-meta-mask)
+ (aggregate-mod-group self flags mod_Super mod_ignore_Super
+ modifier-super-mask)
+ (aggregate-mod-group self flags mod_Hyper mod_ignore_Hyper
+ modifier-hyper-mask)
+ (bitwise-and self mod_Caps_Lock)))))
+
+;; API
+(define modifier-match?
+ (lambda (self other)
+ (let* ((aggregated-self (modifier-aggregate self self))
+ (aggregated-other (modifier-aggregate other aggregated-self)))
+ (= aggregated-self
+ aggregated-other))))
+
+;;
+;; logical keys
+;;
+
+(define valid-logical-keys
+ '(lkey_VoidSymbol
+
+ lkey_BackSpace
+ lkey_Tab
+ lkey_Return
+ lkey_Escape
+ lkey_Delete
+ lkey_Home
+ lkey_Left
+ lkey_Up
+ lkey_Right
+ lkey_Down
+ lkey_Page_Up
+ lkey_Page_Down
+ lkey_End
+ lkey_Insert
+
+ lkey_Shift_L
+ lkey_Shift_R
+ lkey_Control_L
+ lkey_Control_R
+ lkey_Caps_Lock
+ lkey_Meta_L
+ lkey_Meta_R
+ lkey_Alt_L
+ lkey_Alt_R
+ lkey_Super_L
+ lkey_Super_R
+ lkey_Hyper_L
+ lkey_Hyper_R
+
+ lkey_Multi_key ;; Multi-key character compose
+ lkey_Mode_switch ;; Character set switch
+
+ ;; Japanese keyboard support
+ lkey_Kanji ;; Kanji, Kanji convert
+ lkey_Muhenkan ;; Cancel Conversion
+ lkey_Henkan ;; Henkan_Mode
+ lkey_Hiragana_Katakana ;; Hiragana/Katakana toggle
+ lkey_Zenkaku_Hankaku ;; Zenkaku/Hankaku toggle
+
+ ;; NICOLA keys
+ lkey_Thumb_Shift_L
+ lkey_Thumb_Shift_R
+
+ lkey_F1
+ lkey_F2
+ lkey_F3
+ lkey_F4
+ lkey_F5
+ lkey_F6
+ lkey_F7
+ lkey_F8
+ lkey_F9
+ lkey_F10
+ lkey_F11
+ lkey_F12
+ lkey_F13
+ lkey_F14
+ lkey_F15
+ lkey_F16
+ lkey_F17
+ lkey_F18
+ lkey_F19
+ lkey_F20
+ lkey_F21
+ lkey_F22
+ lkey_F23
+ lkey_F24
+ lkey_F25
+ lkey_F26
+ lkey_F27
+ lkey_F28
+ lkey_F29
+ lkey_F30
+ lkey_F31
+ lkey_F32
+ lkey_F33
+ lkey_F34
+ lkey_F35
+
+ ;; ASCII keys
+ lkey_space
+ lkey_exclam
+ lkey_quotedbl
+ lkey_numbersign
+ lkey_dollar
+ lkey_percent
+ lkey_ampersand
+ lkey_apostrophe
+ lkey_parenleft
+ lkey_parenright
+ lkey_asterisk
+ lkey_plus
+ lkey_comma
+ lkey_minus
+ lkey_period
+ lkey_slash
+ lkey_0
+ lkey_1
+ lkey_2
+ lkey_3
+ lkey_4
+ lkey_5
+ lkey_6
+ lkey_7
+ lkey_8
+ lkey_9
+ lkey_colon
+ lkey_semicolon
+ lkey_less
+ lkey_equal
+ lkey_greater
+ lkey_question
+ lkey_at
+ lkey_A
+ lkey_B
+ lkey_C
+ lkey_D
+ lkey_E
+ lkey_F
+ lkey_G
+ lkey_H
+ lkey_I
+ lkey_J
+ lkey_K
+ lkey_L
+ lkey_M
+ lkey_N
+ lkey_O
+ lkey_P
+ lkey_Q
+ lkey_R
+ lkey_S
+ lkey_T
+ lkey_U
+ lkey_V
+ lkey_W
+ lkey_X
+ lkey_Y
+ lkey_Z
+ lkey_bracketleft
+ lkey_backslash
+ lkey_bracketright
+ lkey_asciicircum
+ lkey_underscore
+ lkey_grave
+ lkey_a
+ lkey_b
+ lkey_c
+ lkey_d
+ lkey_e
+ lkey_f
+ lkey_g
+ lkey_h
+ lkey_i
+ lkey_j
+ lkey_k
+ lkey_l
+ lkey_m
+ lkey_n
+ lkey_o
+ lkey_p
+ lkey_q
+ lkey_r
+ lkey_s
+ lkey_t
+ lkey_u
+ lkey_v
+ lkey_w
+ lkey_x
+ lkey_y
+ lkey_z
+ lkey_braceleft
+ lkey_bar
+ lkey_braceright
+ lkey_asciitilde
+
+ ;; extended keys
+ lkey_yen
+
+ ;; dead keys
+ lkey_dead_grave
+ lkey_dead_acute
+ lkey_dead_circumflex
+ lkey_dead_tilde
+ lkey_dead_macron
+ lkey_dead_breve
+ lkey_dead_abovedot
+ lkey_dead_diaeresis
+ lkey_dead_abovering
+ lkey_dead_doubleacute
+ lkey_dead_caron
+ lkey_dead_cedilla
+ lkey_dead_ogonek
+ lkey_dead_iota
+ lkey_dead_voiced_sound
+ lkey_dead_semivoiced_sound
+ lkey_dead_belowdot
+ lkey_dead_hook
+ lkey_dead_horn))
+
+;; API
+(define logical-key?
+ (lambda (key)
+ (and (symbol? key)
+ (memq key valid-logical-keys))))
+
+;;
+;; physical key
+;;
+
+;; added on demand
+(define valid-physical-keys '(pkey_VoidSymbol))
+
+;; API
+(define physical-key?
+ (lambda (key)
+ (and (symbol? key)
+ (memq key valid-physical-keys))))
Added: branches/composer/scm/physical-key.scm
===================================================================
--- branches/composer/scm/physical-key.scm 2005-02-24 00:08:32 UTC (rev 705)
+++ branches/composer/scm/physical-key.scm 2005-02-24 00:46:46 UTC (rev 706)
@@ -0,0 +1,552 @@
+;;; physical-key.scm: Physical key definitions and utilities
+;;;
+;;; Copyright (c) 2005 uim Project http://uim.freedesktop.org/
+;;;
+;;; 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 REGENTS 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 REGENTS 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.
+;;;;
+
+;; This file defines physical keyboard information such as
+;; logical-physical key mappings. Future version of uim may contain
+;; more information about keyboards such as dimensions and visual
+;; attributes to provide visual input guidance, keymap editor, and so
+;; on. -- YamaKen 2005-02-12
+
+(require "util.scm")
+(require "ng-key.scm")
+
+(define lkey-qwerty->pkey-qwerty-alist
+ '(
+ (lkey_BackSpace . pkey_qwerty_BackSpace)
+ (lkey_Tab . pkey_qwerty_Tab)
+ (lkey_Return . pkey_qwerty_Return)
+ (lkey_Escape . pkey_qwerty_Escape)
+ (lkey_Delete . pkey_qwerty_Delete)
+ (lkey_Home . pkey_qwerty_Home)
+ (lkey_Left . pkey_qwerty_Left)
+ (lkey_Up . pkey_qwerty_Up)
+ (lkey_Right . pkey_qwerty_Right)
+ (lkey_Down . pkey_qwerty_Down)
+ (lkey_Page_Up . pkey_qwerty_Page_Up)
+ (lkey_Page_Down . pkey_qwerty_Page_Down)
+ (lkey_End . pkey_qwerty_End)
+ (lkey_Insert . pkey_qwerty_Insert)
+
+ (lkey_Shift_L . pkey_qwerty_Shift_L)
+ (lkey_Shift_R . pkey_qwerty_Shift_R)
+ (lkey_Control_L . pkey_qwerty_Control_L)
+ (lkey_Control_R . pkey_qwerty_Control_R)
+ (lkey_Caps_Lock . pkey_qwerty_Caps_Lock)
+ ;;(lkey_Meta_L . pkey_qwerty_Meta_L)
+ ;;(lkey_Meta_R . pkey_qwerty_Meta_R)
+ (lkey_Alt_L . pkey_qwerty_Alt_L)
+ (lkey_Alt_R . pkey_qwerty_Alt_R)
+ ;;(lkey_Super_L . pkey_qwerty_Super_L)
+ ;;(lkey_Super_R . pkey_qwerty_Super_R)
+ ;;(lkey_Hyper_L . pkey_qwerty_Hyper_L)
+ ;;(lkey_Hyper_R . pkey_qwerty_Hyper_R)
+
+ (lkey_F1 . pkey_qwerty_F1)
+ (lkey_F2 . pkey_qwerty_F2)
+ (lkey_F3 . pkey_qwerty_F3)
+ (lkey_F4 . pkey_qwerty_F4)
+ (lkey_F5 . pkey_qwerty_F5)
+ (lkey_F6 . pkey_qwerty_F6)
+ (lkey_F7 . pkey_qwerty_F7)
+ (lkey_F8 . pkey_qwerty_F8)
+ (lkey_F9 . pkey_qwerty_F9)
+ (lkey_F10 . pkey_qwerty_F10)
+ (lkey_F11 . pkey_qwerty_F11)
+ (lkey_F12 . pkey_qwerty_F12)
+ (lkey_F13 . pkey_qwerty_F13)
+ (lkey_F14 . pkey_qwerty_F14)
+ (lkey_F15 . pkey_qwerty_F15)
+ (lkey_F16 . pkey_qwerty_F16)
+ (lkey_F17 . pkey_qwerty_F17)
+ (lkey_F18 . pkey_qwerty_F18)
+ (lkey_F19 . pkey_qwerty_F19)
+ (lkey_F20 . pkey_qwerty_F20)
+ (lkey_F21 . pkey_qwerty_F21)
+ (lkey_F22 . pkey_qwerty_F22)
+ (lkey_F23 . pkey_qwerty_F23)
+ (lkey_F24 . pkey_qwerty_F24)
+ (lkey_F25 . pkey_qwerty_F25)
+ (lkey_F26 . pkey_qwerty_F26)
+ (lkey_F27 . pkey_qwerty_F27)
+ (lkey_F28 . pkey_qwerty_F28)
+ (lkey_F29 . pkey_qwerty_F29)
+ (lkey_F30 . pkey_qwerty_F30)
+ (lkey_F31 . pkey_qwerty_F31)
+ (lkey_F32 . pkey_qwerty_F32)
+ (lkey_F33 . pkey_qwerty_F33)
+ (lkey_F34 . pkey_qwerty_F34)
+ (lkey_F35 . pkey_qwerty_F35)
+
+ ;; ASCII keys
+ (lkey_space . pkey_qwerty_space)
+ (lkey_exclam . pkey_qwerty_1)
+ (lkey_quotedbl . pkey_qwerty_apostrophe)
+ (lkey_numbersign . pkey_qwerty_3)
+ (lkey_dollar . pkey_qwerty_4)
+ (lkey_percent . pkey_qwerty_5)
+ (lkey_ampersand . pkey_qwerty_7)
+ (lkey_apostrophe . pkey_qwerty_apostrophe)
+ (lkey_parenleft . pkey_qwerty_9)
+ (lkey_parenright . pkey_qwerty_0)
+ (lkey_asterisk . pkey_qwerty_8)
+ (lkey_plus . pkey_qwerty_equal)
+ (lkey_comma . pkey_qwerty_comma)
+ (lkey_minus . pkey_qwerty_minus)
+ (lkey_period . pkey_qwerty_period)
+ (lkey_slash . pkey_qwerty_slash)
+ (lkey_0 . pkey_qwerty_0)
+ (lkey_1 . pkey_qwerty_1)
+ (lkey_2 . pkey_qwerty_2)
+ (lkey_3 . pkey_qwerty_3)
+ (lkey_4 . pkey_qwerty_4)
+ (lkey_5 . pkey_qwerty_5)
+ (lkey_6 . pkey_qwerty_6)
+ (lkey_7 . pkey_qwerty_7)
+ (lkey_8 . pkey_qwerty_8)
+ (lkey_9 . pkey_qwerty_9)
+ (lkey_colon . pkey_qwerty_semicolon)
+ (lkey_semicolon . pkey_qwerty_semicolon)
+ (lkey_less . pkey_qwerty_comma)
+ (lkey_equal . pkey_qwerty_equal)
+ (lkey_greater . pkey_qwerty_period)
+ (lkey_question . pkey_qwerty_slash)
+ (lkey_at . pkey_qwerty_2)
+ (lkey_A . pkey_qwerty_a)
+ (lkey_B . pkey_qwerty_b)
+ (lkey_C . pkey_qwerty_c)
+ (lkey_D . pkey_qwerty_d)
+ (lkey_E . pkey_qwerty_e)
+ (lkey_F . pkey_qwerty_f)
+ (lkey_G . pkey_qwerty_g)
+ (lkey_H . pkey_qwerty_h)
+ (lkey_I . pkey_qwerty_i)
+ (lkey_J . pkey_qwerty_j)
+ (lkey_K . pkey_qwerty_k)
+ (lkey_L . pkey_qwerty_l)
+ (lkey_M . pkey_qwerty_m)
+ (lkey_N . pkey_qwerty_n)
+ (lkey_O . pkey_qwerty_o)
+ (lkey_P . pkey_qwerty_p)
+ (lkey_Q . pkey_qwerty_q)
+ (lkey_R . pkey_qwerty_r)
+ (lkey_S . pkey_qwerty_s)
+ (lkey_T . pkey_qwerty_t)
+ (lkey_U . pkey_qwerty_u)
+ (lkey_V . pkey_qwerty_v)
+ (lkey_W . pkey_qwerty_w)
+ (lkey_X . pkey_qwerty_x)
+ (lkey_Y . pkey_qwerty_y)
+ (lkey_Z . pkey_qwerty_z)
+ (lkey_bracketleft . pkey_qwerty_bracketleft)
+ (lkey_backslash . pkey_qwerty_backslash)
+ (lkey_bracketright . pkey_qwerty_bracketright)
+ (lkey_asciicircum . pkey_qwerty_6)
+ (lkey_underscore . pkey_qwerty_minus)
+ (lkey_grave . pkey_qwerty_grave)
+ (lkey_a . pkey_qwerty_a)
+ (lkey_b . pkey_qwerty_b)
+ (lkey_c . pkey_qwerty_c)
+ (lkey_d . pkey_qwerty_d)
+ (lkey_e . pkey_qwerty_e)
+ (lkey_f . pkey_qwerty_f)
+ (lkey_g . pkey_qwerty_g)
+ (lkey_h . pkey_qwerty_h)
+ (lkey_i . pkey_qwerty_i)
+ (lkey_j . pkey_qwerty_j)
+ (lkey_k . pkey_qwerty_k)
+ (lkey_l . pkey_qwerty_l)
+ (lkey_m . pkey_qwerty_m)
+ (lkey_n . pkey_qwerty_n)
+ (lkey_o . pkey_qwerty_o)
+ (lkey_p . pkey_qwerty_p)
+ (lkey_q . pkey_qwerty_q)
+ (lkey_r . pkey_qwerty_r)
+ (lkey_s . pkey_qwerty_s)
+ (lkey_t . pkey_qwerty_t)
+ (lkey_u . pkey_qwerty_u)
+ (lkey_v . pkey_qwerty_v)
+ (lkey_w . pkey_qwerty_w)
+ (lkey_x . pkey_qwerty_x)
+ (lkey_y . pkey_qwerty_y)
+ (lkey_z . pkey_qwerty_z)
+ (lkey_braceleft . pkey_qwerty_bracketleft)
+ (lkey_bar . pkey_qwerty_backslash)
+ (lkey_braceright . pkey_qwerty_bracketright)
+ (lkey_asciitilde . pkey_qwerty_grave)
+ ))
+
+(define lkey-extended-qwerty->pkey-qwerty-alist
+ (append
+ lkey-qwerty->pkey-qwerty-alist
+ '(
+ (lkey_Multi_key . pkey_qwerty_Multi_key) ;; Multi-key character compose
+ (lkey_Mode_switch . pkey_qwerty_Mode_switch) ;; Character set switch
+
+ ;; dead keys: QWERTY keyboard does not have these keys
+ ;;(lkey_dead_grave . pkey_qwerty_grave)
+ ;;(lkey_dead_acute . pkey_qwerty_acute)
+ ;;(lkey_dead_circumflex . pkey_qwerty_circumflex)
+ ;;(lkey_dead_tilde . pkey_qwerty_tilde)
+ ;;(lkey_dead_macron . pkey_qwerty_macron)
+ ;;(lkey_dead_breve . pkey_qwerty_breve)
+ ;;(lkey_dead_abovedot . pkey_qwerty_abovedot)
+ ;;(lkey_dead_diaeresis . pkey_qwerty_diaeresis)
+ ;;(lkey_dead_abovering . pkey_qwerty_abovering)
+ ;;(lkey_dead_doubleacute . pkey_qwerty_doubleacute)
+ ;;(lkey_dead_caron . pkey_qwerty_caron)
+ ;;(lkey_dead_cedilla . pkey_qwerty_cedilla)
+ ;;(lkey_dead_ogonek . pkey_qwerty_ogonek)
+ ;;(lkey_dead_iota . pkey_qwerty_iota)
+ ;;(lkey_dead_voiced_sound . pkey_qwerty_voiced_sound)
+ ;;(lkey_dead_semivoiced_sound . pkey_qwerty_semivoiced_sound)
+ ;;(lkey_dead_belowdot . pkey_qwerty_belowdot)
+ ;;(lkey_dead_hook . pkey_qwerty_hook)
+ ;;(lkey_dead_horn . pkey_qwerty_horn)
+ )))
+
+(define lkey-dvorak->pkey-qwerty-alist
+ (append
+ '(
+ ;; ASCII keys
+ ;(lkey_space . pkey_qwerty_space)
+ ;(lkey_exclam . pkey_qwerty_1)
+ (lkey_quotedbl . pkey_qwerty_q)
+ ;(lkey_numbersign . pkey_qwerty_3)
+ ;(lkey_dollar . pkey_qwerty_4)
+ ;(lkey_percent . pkey_qwerty_5)
+ ;(lkey_ampersand . pkey_qwerty_7)
+ (lkey_apostrophe . pkey_qwerty_q)
+ ;(lkey_parenleft . pkey_qwerty_9)
+ ;(lkey_parenright . pkey_qwerty_0)
+ ;(lkey_asterisk . pkey_qwerty_8)
+ (lkey_plus . pkey_qwerty_bracketright)
+ (lkey_comma . pkey_qwerty_w)
+ (lkey_minus . pkey_qwerty_apostrophe)
+ (lkey_period . pkey_qwerty_e)
+ (lkey_slash . pkey_qwerty_bracketleft)
+ ;(lkey_0 . pkey_qwerty_0)
+ ;(lkey_1 . pkey_qwerty_1)
+ ;(lkey_2 . pkey_qwerty_2)
+ ;(lkey_3 . pkey_qwerty_3)
+ ;(lkey_4 . pkey_qwerty_4)
+ ;(lkey_5 . pkey_qwerty_5)
+ ;(lkey_6 . pkey_qwerty_6)
+ ;(lkey_7 . pkey_qwerty_7)
+ ;(lkey_8 . pkey_qwerty_8)
+ ;(lkey_9 . pkey_qwerty_9)
+ (lkey_colon . pkey_qwerty_z)
+ (lkey_semicolon . pkey_qwerty_z)
+ (lkey_less . pkey_qwerty_w)
+ (lkey_equal . pkey_qwerty_bracketright)
+ (lkey_greater . pkey_qwerty_e)
+ (lkey_question . pkey_qwerty_bracketleft)
+ ;(lkey_at . pkey_qwerty_2)
+ (lkey_A . pkey_qwerty_a)
+ (lkey_B . pkey_qwerty_n)
+ (lkey_C . pkey_qwerty_i)
+ (lkey_D . pkey_qwerty_h)
+ (lkey_E . pkey_qwerty_d)
+ (lkey_F . pkey_qwerty_y)
+ (lkey_G . pkey_qwerty_u)
+ (lkey_H . pkey_qwerty_j)
+ (lkey_I . pkey_qwerty_g)
+ (lkey_J . pkey_qwerty_c)
+ (lkey_K . pkey_qwerty_v)
+ (lkey_L . pkey_qwerty_p)
+ (lkey_M . pkey_qwerty_m)
+ (lkey_N . pkey_qwerty_l)
+ (lkey_O . pkey_qwerty_s)
+ (lkey_P . pkey_qwerty_r)
+ (lkey_Q . pkey_qwerty_x)
+ (lkey_R . pkey_qwerty_o)
+ (lkey_S . pkey_qwerty_semicolon)
+ (lkey_T . pkey_qwerty_k)
+ (lkey_U . pkey_qwerty_f)
+ (lkey_V . pkey_qwerty_period)
+ (lkey_W . pkey_qwerty_comma)
+ (lkey_X . pkey_qwerty_b)
+ (lkey_Y . pkey_qwerty_t)
+ (lkey_Z . pkey_qwerty_slash)
+ (lkey_bracketleft . pkey_qwerty_minus)
+ ;;(lkey_backslash . pkey_qwerty_backslash)
+ (lkey_bracketright . pkey_qwerty_equal)
+ ;;(lkey_asciicircum . pkey_qwerty_6)
+ (lkey_underscore . pkey_qwerty_apostrophe)
+ ;;(lkey_grave . pkey_qwerty_grave)
+ (lkey_a . pkey_qwerty_a)
+ (lkey_b . pkey_qwerty_n)
+ (lkey_c . pkey_qwerty_i)
+ (lkey_d . pkey_qwerty_h)
+ (lkey_e . pkey_qwerty_d)
+ (lkey_f . pkey_qwerty_y)
+ (lkey_g . pkey_qwerty_u)
+ (lkey_h . pkey_qwerty_j)
+ (lkey_i . pkey_qwerty_g)
+ (lkey_j . pkey_qwerty_c)
+ (lkey_k . pkey_qwerty_v)
+ (lkey_l . pkey_qwerty_p)
+ (lkey_m . pkey_qwerty_m)
+ (lkey_n . pkey_qwerty_l)
+ (lkey_o . pkey_qwerty_s)
+ (lkey_p . pkey_qwerty_r)
+ (lkey_q . pkey_qwerty_x)
+ (lkey_r . pkey_qwerty_o)
+ (lkey_s . pkey_qwerty_semicolon)
+ (lkey_t . pkey_qwerty_k)
+ (lkey_u . pkey_qwerty_f)
+ (lkey_v . pkey_qwerty_period)
+ (lkey_w . pkey_qwerty_comma)
+ (lkey_x . pkey_qwerty_b)
+ (lkey_y . pkey_qwerty_t)
+ (lkey_z . pkey_qwerty_slash)
+ (lkey_braceleft . pkey_qwerty_minus)
+ ;;(lkey_bar . pkey_qwerty_backslash)
+ (lkey_braceright . pkey_qwerty_equal)
+ ;;(lkey_asciitilde . pkey_qwerty_grave)
+ )
+ lkey-qwerty->pkey-qwerty-alist
+ ))
+
+;; TODO: make pkey_jp106_a macheable with pkey_qwerty_a
+(define lkey-jp106-qwerty->pkey-jp106-alist
+ '(
+ (lkey_BackSpace . pkey_jp106_BackSpace)
+ (lkey_Tab . pkey_jp106_Tab)
+ (lkey_Return . pkey_jp106_Return)
+ (lkey_Escape . pkey_jp106_Escape)
+ (lkey_Delete . pkey_jp106_Delete)
+ (lkey_Home . pkey_jp106_Home)
+ (lkey_Left . pkey_jp106_Left)
+ (lkey_Up . pkey_jp106_Up)
+ (lkey_Right . pkey_jp106_Right)
+ (lkey_Down . pkey_jp106_Down)
+ (lkey_Page_Up . pkey_jp106_Page_Up)
+ (lkey_Page_Down . pkey_jp106_Page_Down)
+ (lkey_End . pkey_jp106_End)
+ (lkey_Insert . pkey_jp106_Insert)
+
+ (lkey_Shift_L . pkey_jp106_Shift_L)
+ (lkey_Shift_R . pkey_jp106_Shift_R)
+ (lkey_Control_L . pkey_jp106_Control_L)
+ (lkey_Control_R . pkey_jp106_Control_R)
+ (lkey_Caps_Lock . pkey_jp106_Caps_Lock)
+ ;;(lkey_Meta_L . pkey_jp106_Meta_L)
+ ;;(lkey_Meta_R . pkey_jp106_Meta_R)
+ (lkey_Alt_L . pkey_jp106_Alt_L)
+ (lkey_Alt_R . pkey_jp106_Alt_R)
+ ;;(lkey_Super_L . pkey_jp106_Super_L)
+ ;;(lkey_Super_R . pkey_jp106_Super_R)
+ ;;(lkey_Hyper_L . pkey_jp106_Hyper_L)
+ ;;(lkey_Hyper_R . pkey_jp106_Hyper_R)
+
+ ;;(lkey_Multi_key . pkey_jp106_Multi_key)
+ ;;(lkey_Mode_switch . pkey_jp106_Mode_switch)
+
+ ;; Japanese keyboard support
+ (lkey_Kanji . pkey_jp106_Zenkaku_Hankaku)
+ (lkey_Muhenkan . pkey_jp106_Muhenkan)
+ (lkey_Henkan . pkey_jp106_Henkan)
+ (lkey_Hiragana_Katakana . pkey_jp106_Hiragana_Katakana)
+ (lkey_Zenkaku_Hankaku . pkey_jp106_Zenkaku_Hankaku)
+
+ (lkey_F1 . pkey_jp106_F1)
+ (lkey_F2 . pkey_jp106_F2)
+ (lkey_F3 . pkey_jp106_F3)
+ (lkey_F4 . pkey_jp106_F4)
+ (lkey_F5 . pkey_jp106_F5)
+ (lkey_F6 . pkey_jp106_F6)
+ (lkey_F7 . pkey_jp106_F7)
+ (lkey_F8 . pkey_jp106_F8)
+ (lkey_F9 . pkey_jp106_F9)
+ (lkey_F10 . pkey_jp106_F10)
+ (lkey_F11 . pkey_jp106_F11)
+ (lkey_F12 . pkey_jp106_F12)
+ (lkey_F13 . pkey_jp106_F13)
+ (lkey_F14 . pkey_jp106_F14)
+ (lkey_F15 . pkey_jp106_F15)
+ (lkey_F16 . pkey_jp106_F16)
+ (lkey_F17 . pkey_jp106_F17)
+ (lkey_F18 . pkey_jp106_F18)
+ (lkey_F19 . pkey_jp106_F19)
+ (lkey_F20 . pkey_jp106_F20)
+ (lkey_F21 . pkey_jp106_F21)
+ (lkey_F22 . pkey_jp106_F22)
+ (lkey_F23 . pkey_jp106_F23)
+ (lkey_F24 . pkey_jp106_F24)
+ (lkey_F25 . pkey_jp106_F25)
+ (lkey_F26 . pkey_jp106_F26)
+ (lkey_F27 . pkey_jp106_F27)
+ (lkey_F28 . pkey_jp106_F28)
+ (lkey_F29 . pkey_jp106_F29)
+ (lkey_F30 . pkey_jp106_F30)
+ (lkey_F31 . pkey_jp106_F31)
+ (lkey_F32 . pkey_jp106_F32)
+ (lkey_F33 . pkey_jp106_F33)
+ (lkey_F34 . pkey_jp106_F34)
+ (lkey_F35 . pkey_jp106_F35)
+
+ ;; ASCII keys
+ (lkey_space . pkey_jp106_space)
+ (lkey_exclam . pkey_jp106_1)
+ (lkey_quotedbl . pkey_jp106_2)
+ (lkey_numbersign . pkey_jp106_3)
+ (lkey_dollar . pkey_jp106_4)
+ (lkey_percent . pkey_jp106_5)
+ (lkey_ampersand . pkey_jp106_6)
+ (lkey_apostrophe . pkey_jp106_7)
+ (lkey_parenleft . pkey_jp106_8)
+ (lkey_parenright . pkey_jp106_9)
+ (lkey_asterisk . pkey_jp106_colon)
+ (lkey_plus . pkey_jp106_semicolon)
+ (lkey_comma . pkey_jp106_comma)
+ (lkey_minus . pkey_jp106_minus)
+ (lkey_period . pkey_jp106_period)
+ (lkey_slash . pkey_jp106_slash)
+ (lkey_0 . pkey_jp106_0)
+ (lkey_1 . pkey_jp106_1)
+ (lkey_2 . pkey_jp106_2)
+ (lkey_3 . pkey_jp106_3)
+ (lkey_4 . pkey_jp106_4)
+ (lkey_5 . pkey_jp106_5)
+ (lkey_6 . pkey_jp106_6)
+ (lkey_7 . pkey_jp106_7)
+ (lkey_8 . pkey_jp106_8)
+ (lkey_9 . pkey_jp106_9)
+ (lkey_colon . pkey_jp106_colon)
+ (lkey_semicolon . pkey_jp106_semicolon)
+ (lkey_less . pkey_jp106_comma)
+ (lkey_equal . pkey_jp106_minus)
+ (lkey_greater . pkey_jp106_period)
+ (lkey_question . pkey_jp106_slash)
+ (lkey_at . pkey_jp106_at)
+ (lkey_A . pkey_jp106_a)
+ (lkey_B . pkey_jp106_b)
+ (lkey_C . pkey_jp106_c)
+ (lkey_D . pkey_jp106_d)
+ (lkey_E . pkey_jp106_e)
+ (lkey_F . pkey_jp106_f)
+ (lkey_G . pkey_jp106_g)
+ (lkey_H . pkey_jp106_h)
+ (lkey_I . pkey_jp106_i)
+ (lkey_J . pkey_jp106_j)
+ (lkey_K . pkey_jp106_k)
+ (lkey_L . pkey_jp106_l)
+ (lkey_M . pkey_jp106_m)
+ (lkey_N . pkey_jp106_n)
+ (lkey_O . pkey_jp106_o)
+ (lkey_P . pkey_jp106_p)
+ (lkey_Q . pkey_jp106_q)
+ (lkey_R . pkey_jp106_r)
+ (lkey_S . pkey_jp106_s)
+ (lkey_T . pkey_jp106_t)
+ (lkey_U . pkey_jp106_u)
+ (lkey_V . pkey_jp106_v)
+ (lkey_W . pkey_jp106_w)
+ (lkey_X . pkey_jp106_x)
+ (lkey_Y . pkey_jp106_y)
+ (lkey_Z . pkey_jp106_z)
+ (lkey_bracketleft . pkey_jp106_bracketleft)
+ (lkey_backslash . pkey_jp106_yen) ;; be careful
+ ;;(lkey_backslash . pkey_jp106_backslash) ;; be careful
+ (lkey_bracketright . pkey_jp106_bracketright)
+ (lkey_asciicircum . pkey_jp106_asciicircum)
+ (lkey_underscore . pkey_jp106_backslash) ;; be careful
+ (lkey_grave . pkey_jp106_at)
+ (lkey_a . pkey_jp106_a)
+ (lkey_b . pkey_jp106_b)
+ (lkey_c . pkey_jp106_c)
+ (lkey_d . pkey_jp106_d)
+ (lkey_e . pkey_jp106_e)
+ (lkey_f . pkey_jp106_f)
+ (lkey_g . pkey_jp106_g)
+ (lkey_h . pkey_jp106_h)
+ (lkey_i . pkey_jp106_i)
+ (lkey_j . pkey_jp106_j)
+ (lkey_k . pkey_jp106_k)
+ (lkey_l . pkey_jp106_l)
+ (lkey_m . pkey_jp106_m)
+ (lkey_n . pkey_jp106_n)
+ (lkey_o . pkey_jp106_o)
+ (lkey_p . pkey_jp106_p)
+ (lkey_q . pkey_jp106_q)
+ (lkey_r . pkey_jp106_r)
+ (lkey_s . pkey_jp106_s)
+ (lkey_t . pkey_jp106_t)
+ (lkey_u . pkey_jp106_u)
+ (lkey_v . pkey_jp106_v)
+ (lkey_w . pkey_jp106_w)
+ (lkey_x . pkey_jp106_x)
+ (lkey_y . pkey_jp106_y)
+ (lkey_z . pkey_jp106_z)
+ (lkey_braceleft . pkey_jp106_bracketleft)
+ (lkey_bar . pkey_jp106_yen) ;; be careful
+ ;;(lkey_bar . pkey_jp106_backslash) ;; be careful
+ (lkey_braceright . pkey_jp106_bracketright)
+ (lkey_asciitilde . pkey_jp106_asciicircum)
+
+ ;; extended keys
+ (lkey_yen . pkey_jp106_yen) ;; be careful
+ ;;(lkey_backslash . pkey_jp106_yen) ;; be careful
+
+ ;; dead keys: JP106 keyboard does not have these keys
+ ;;(lkey_dead_grave . pkey_jp106_grave)
+ ;;(lkey_dead_acute . pkey_jp106_acute)
+ ;;(lkey_dead_circumflex . pkey_jp106_circumflex)
+ ;;(lkey_dead_tilde . pkey_jp106_tilde)
+ ;;(lkey_dead_macron . pkey_jp106_macron)
+ ;;(lkey_dead_breve . pkey_jp106_breve)
+ ;;(lkey_dead_abovedot . pkey_jp106_abovedot)
+ ;;(lkey_dead_diaeresis . pkey_jp106_diaeresis)
+ ;;(lkey_dead_abovering . pkey_jp106_abovering)
+ ;;(lkey_dead_doubleacute . pkey_jp106_doubleacute)
+ ;;(lkey_dead_caron . pkey_jp106_caron)
+ ;;(lkey_dead_cedilla . pkey_jp106_cedilla)
+ ;;(lkey_dead_ogonek . pkey_jp106_ogonek)
+ ;;(lkey_dead_iota . pkey_jp106_iota)
+ ;;(lkey_dead_voiced_sound . pkey_jp106_voiced_sound)
+ ;;(lkey_dead_semivoiced_sound . pkey_jp106_semivoiced_sound)
+ ;;(lkey_dead_belowdot . pkey_jp106_belowdot)
+ ;;(lkey_dead_hook . pkey_jp106_hook)
+ ;;(lkey_dead_horn . pkey_jp106_horn)
+ ))
+
+
+;; register physical key symbols to valid-physical-keys
+(for-each (lambda (alist)
+ (for-each (lambda (entry)
+ (let ((pkey (cdr entry)))
+ (or (memq pkey valid-physical-keys)
+ (set! valid-physical-keys
+ (cons pkey valid-physical-keys)))))
+ alist))
+ (list lkey-qwerty->pkey-qwerty-alist
+ lkey-extended-qwerty->pkey-qwerty-alist
+ lkey-jp106-qwerty->pkey-jp106-alist))
More information about the Uim-commit
mailing list