[uim-commit] r734 - in branches/composer: scm test
yamaken at freedesktop.org
yamaken at freedesktop.org
Mon Feb 28 09:14:24 PST 2005
Author: yamaken
Date: 2005-02-28 09:14:21 -0800 (Mon, 28 Feb 2005)
New Revision: 734
Added:
branches/composer/scm/legacy-api-bridge.scm
branches/composer/test/test-legacy-api-bridge.scm
Modified:
branches/composer/scm/Makefile.am
branches/composer/test/Makefile.am
Log:
* scm/legacy-api-bridge.scm
- New file
- All procedures are validated by test-legacy-api-bridge.scm
- (legacy-modifier->modifier, legacy-key->key-event): New procedure
* scm/Makefile.am
- (SCM_FILES): Add legacy-api-bridge.scm
* test/test-legacy-api-bridge.scm
- New file
- (testcase legacy-api-bridge): New testcase
- (test legacy-modifier->modifier, test legacy-key->key-event): New
test
* test/Makefile.am
- (EXTRA_DIST): Add test-legacy-api-bridge.scm
Modified: branches/composer/scm/Makefile.am
===================================================================
--- branches/composer/scm/Makefile.am 2005-02-28 14:53:56 UTC (rev 733)
+++ branches/composer/scm/Makefile.am 2005-02-28 17:14:21 UTC (rev 734)
@@ -11,6 +11,7 @@
uim-sh.scm custom.scm custom-rt.scm \
manage-modules.scm \
direct.scm \
+ legacy-api-bridge.scm \
ng-japanese.scm ng-japanese-romaji.scm ng-japanese-kana.scm \
japanese-nicola.scm ng-japanese-azik.scm \
rk.scm \
Added: branches/composer/scm/legacy-api-bridge.scm
===================================================================
--- branches/composer/scm/legacy-api-bridge.scm 2005-02-28 14:53:56 UTC (rev 733)
+++ branches/composer/scm/legacy-api-bridge.scm 2005-02-28 17:14:21 UTC (rev 734)
@@ -0,0 +1,258 @@
+;;; legacy-api-bridge.scm: Legacy API bridge
+;;;
+;;; 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")
+(require "key.scm")
+(require "ng-key.scm")
+(require "event.scm")
+(require "evmap.scm")
+
+
+(define legacy-key->lkey-alist
+ '((" " . 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)
+ ("0" . lkey_0)
+ ("1" . lkey_1)
+ ("2" . lkey_2)
+ ("3" . lkey_3)
+ ("4" . lkey_4)
+ ("5" . lkey_5)
+ ("6" . lkey_6)
+ ("7" . lkey_7)
+ ("8" . lkey_8)
+ ("9" . lkey_9)
+ (":" . lkey_colon)
+ (";" . lkey_semicolon)
+ ("<" . lkey_less)
+ ("=" . lkey_equal)
+ (">" . lkey_greater)
+ ("?" . lkey_question)
+ ("@" . lkey_at)
+ ("A" . lkey_A)
+ ("B" . lkey_B)
+ ("C" . lkey_C)
+ ("D" . lkey_D)
+ ("E" . lkey_E)
+ ("F" . lkey_F)
+ ("G" . lkey_G)
+ ("H" . lkey_H)
+ ("I" . lkey_I)
+ ("J" . lkey_J)
+ ("K" . lkey_K)
+ ("L" . lkey_L)
+ ("M" . lkey_M)
+ ("N" . lkey_N)
+ ("O" . lkey_O)
+ ("P" . lkey_P)
+ ("Q" . lkey_Q)
+ ("R" . lkey_R)
+ ("S" . lkey_S)
+ ("T" . lkey_T)
+ ("U" . lkey_U)
+ ("V" . lkey_V)
+ ("W" . lkey_W)
+ ("X" . lkey_X)
+ ("Y" . lkey_Y)
+ ("Z" . lkey_Z)
+ ("[" . lkey_bracketleft)
+ ("\\" . lkey_backslash)
+ ("]" . lkey_bracketright)
+ ("^" . lkey_asciicircum)
+ ("_" . lkey_underscore)
+ ("`" . lkey_grave)
+ ("a" . lkey_a)
+ ("b" . lkey_b)
+ ("c" . lkey_c)
+ ("d" . lkey_d)
+ ("e" . lkey_e)
+ ("f" . lkey_f)
+ ("g" . lkey_g)
+ ("h" . lkey_h)
+ ("i" . lkey_i)
+ ("j" . lkey_j)
+ ("k" . lkey_k)
+ ("l" . lkey_l)
+ ("m" . lkey_m)
+ ("n" . lkey_n)
+ ("o" . lkey_o)
+ ("p" . lkey_p)
+ ("q" . lkey_q)
+ ("r" . lkey_r)
+ ("s" . lkey_s)
+ ("t" . lkey_t)
+ ("u" . lkey_u)
+ ("v" . lkey_v)
+ ("w" . lkey_w)
+ ("x" . lkey_x)
+ ("y" . lkey_y)
+ ("z" . lkey_z)
+ ("{" . lkey_braceleft)
+ ("|" . lkey_bar)
+ ("}" . lkey_braceright)
+ ("~" . lkey_asciitilde)
+ (backspace . lkey_BackSpace)
+ (delete . lkey_Delete)
+ (escape . lkey_Escape)
+ (return . lkey_Return)
+ (tab . lkey_Tab)
+ (left . lkey_Left)
+ (up . lkey_Up)
+ (right . lkey_Right)
+ (down . lkey_Down)
+ (prior . lkey_Page_Up)
+ (next . lkey_Page_Down)
+ (home . lkey_Home)
+ (end . lkey_End)
+ (insert . lkey_Insert)
+ (zenkaku-hankaku . lkey_Zenkaku_Hankaku)
+ (Multi_key . lkey_Multi_key)
+ (Mode_switch . lkey_Mode_switch)
+ (Henkan_Mode . lkey_Henkan)
+ (Muhenkan . lkey_Muhenkan)
+ (F1 . lkey_F1)
+ (F2 . lkey_F2)
+ (F3 . lkey_F3)
+ (F4 . lkey_F4)
+ (F5 . lkey_F5)
+ (F6 . lkey_F6)
+ (F7 . lkey_F7)
+ (F8 . lkey_F8)
+ (F9 . lkey_F9)
+ (F10 . lkey_F10)
+ (F11 . lkey_F11)
+ (F12 . lkey_F12)
+ (F13 . lkey_F13)
+ (F14 . lkey_F14)
+ (F15 . lkey_F15)
+ (F16 . lkey_F16)
+ (F17 . lkey_F17)
+ (F18 . lkey_F18)
+ (F19 . lkey_F19)
+ (F20 . lkey_F20)
+ (F21 . lkey_F21)
+ (F22 . lkey_F22)
+ (F23 . lkey_F23)
+ (F24 . lkey_F24)
+ (F25 . lkey_F25)
+ (F26 . lkey_F26)
+ (F27 . lkey_F27)
+ (F28 . lkey_F28)
+ (F29 . lkey_F29)
+ (F30 . lkey_F30)
+ (F31 . lkey_F31)
+ (F32 . lkey_F32)
+ (F33 . lkey_F33)
+ (F34 . lkey_F34)
+ (F35 . lkey_F35)
+ ;;(Private1 . lkey_Private1)
+ ;;(Private2 . lkey_Private2)
+ ;;(Private3 . lkey_Private3)
+ ;;(Private4 . lkey_Private4)
+ ;;(Private5 . lkey_Private5)
+ ;;(Private6 . lkey_Private6)
+ ;;(Private7 . lkey_Private7)
+ ;;(Private8 . lkey_Private8)
+ ;;(Private9 . lkey_Private9)
+ ;;(Private10 . lkey_Private10)
+ ;;(Private11 . lkey_Private11)
+ ;;(Private12 . lkey_Private12)
+ ;;(Private13 . lkey_Private13)
+ ;;(Private14 . lkey_Private14)
+ ;;(Private15 . lkey_Private15)
+ ;;(Private16 . lkey_Private16)
+ ;;(Private17 . lkey_Private17)
+ ;;(Private18 . lkey_Private18)
+ ;;(Private19 . lkey_Private19)
+ ;;(Private20 . lkey_Private20)
+ ;;(Private21 . lkey_Private21)
+ ;;(Private22 . lkey_Private22)
+ ;;(Private23 . lkey_Private23)
+ ;;(Private24 . lkey_Private24)
+ ;;(Private25 . lkey_Private25)
+ ;;(Private26 . lkey_Private26)
+ ;;(Private27 . lkey_Private27)
+ ;;(Private28 . lkey_Private28)
+ ;;(Private29 . lkey_Private29)
+ ;;(Private30 . lkey_Private30)
+ (Shift_key . lkey_Shift_L)
+ (Alt_key . lkey_Alt_L)
+ (Control_key . lkey_Control_L)
+ (Meta_key . lkey_Meta_L)
+ (Super_key . lkey_Super_L)
+ (Hyper_key . lkey_Hyper_L)))
+
+;;
+;; event interface
+;;
+
+(define legacy-modifier->modifier
+ (lambda (state)
+ (apply bitwise-or
+ (filter integer?
+ (list
+ (and (shift-key-mask state)
+ mod_Shift)
+ (and (control-key-mask state)
+ mod_Control)
+ (and (alt-key-mask state)
+ mod_Alt)
+ (and (meta-key-mask state)
+ mod_Meta)
+ (and (super-key-mask state)
+ mod_Super)
+ (and (hyper-key-mask state)
+ mod_Hyper))))))
+
+(define legacy-key->key-event
+ (lambda (key state press?)
+ (let* ((str (and (char-printable? key)
+ (charcode->string key)))
+ (lkey (safe-cdr (assoc (or str
+ key)
+ legacy-key->lkey-alist)))
+ (pkey (and (symbol-bound? 'lkey-jp106-qwerty->pkey-jp106-alist)
+ (assq-cdr lkey lkey-jp106-qwerty->pkey-jp106-alist)))
+ (modifier (legacy-modifier->modifier state)))
+ (key-event-new str lkey pkey modifier press?))))
Modified: branches/composer/test/Makefile.am
===================================================================
--- branches/composer/test/Makefile.am 2005-02-28 14:53:56 UTC (rev 733)
+++ branches/composer/test/Makefile.am 2005-02-28 17:14:21 UTC (rev 734)
@@ -4,4 +4,5 @@
test-lazy-load.scm test-plugin.scm test-slib.scm \
test-uim-test-utils.scm test-uim-util.scm test-ustr.scm \
test-util.scm \
- test-ng-key.scm test-event.scm test-evmap.scm test-evmap-csv.scm
+ test-ng-key.scm test-event.scm test-evmap.scm test-evmap-csv.scm \
+ test-legacy-api-bridge.scm
Added: branches/composer/test/test-legacy-api-bridge.scm
===================================================================
--- branches/composer/test/test-legacy-api-bridge.scm 2005-02-28 14:53:56 UTC (rev 733)
+++ branches/composer/test/test-legacy-api-bridge.scm 2005-02-28 17:14:21 UTC (rev 734)
@@ -0,0 +1,236 @@
+#!/usr/bin/env gosh
+
+;;; 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 is tested with revision 734 of new repository
+
+(use test.unit)
+
+(require "test/uim-test-utils")
+
+(define-uim-test-case "testcase legacy-api-bridge"
+ (setup
+ (lambda ()
+ (uim '(require "legacy-api-bridge.scm"))))
+
+ ("test legacy-modifier->modifier"
+ ;; no modifier
+ (assert-equal (uim 'mod_None)
+ (uim '(legacy-modifier->modifier 0)))
+ ;; single modifier
+ (assert-equal (uim 'mod_Shift)
+ (uim '(legacy-modifier->modifier
+ (assq-cdr 'Shift_key key-state-alist))))
+ (assert-equal (uim 'mod_Control)
+ (uim '(legacy-modifier->modifier
+ (assq-cdr 'Control_key key-state-alist))))
+ (assert-equal (uim 'mod_Alt)
+ (uim '(legacy-modifier->modifier
+ (assq-cdr 'Alt_key key-state-alist))))
+ (assert-equal (uim 'mod_Meta)
+ (uim '(legacy-modifier->modifier
+ (assq-cdr 'Meta_key key-state-alist))))
+ (assert-equal (uim 'mod_Super)
+ (uim '(legacy-modifier->modifier
+ (assq-cdr 'Super_key key-state-alist))))
+ (assert-equal (uim 'mod_Hyper)
+ (uim '(legacy-modifier->modifier
+ (assq-cdr 'Hyper_key key-state-alist))))
+ ;; duplexed modifier
+ (assert-equal (uim '(bitwise-or mod_Shift mod_Control))
+ (uim '(legacy-modifier->modifier
+ (bitwise-or (assq-cdr 'Shift_key key-state-alist)
+ (assq-cdr 'Control_key key-state-alist)))))
+ (assert-equal (uim '(bitwise-or mod_Shift mod_Control mod_Alt))
+ (uim '(legacy-modifier->modifier
+ (bitwise-or (assq-cdr 'Shift_key key-state-alist)
+ (assq-cdr 'Control_key key-state-alist)
+ (assq-cdr 'Alt_key key-state-alist)))))
+ (assert-equal (uim '(bitwise-or mod_Shift mod_Control mod_Alt
+ mod_Super mod_Hyper))
+ (uim '(legacy-modifier->modifier
+ (bitwise-or (assq-cdr 'Shift_key key-state-alist)
+ (assq-cdr 'Control_key key-state-alist)
+ (assq-cdr 'Alt_key key-state-alist)
+ (assq-cdr 'Super_key key-state-alist)
+ (assq-cdr 'Hyper_key key-state-alist))))))
+
+ ("test legacy-key->key-event"
+ (assert-equal (uim '(list 'key
+ #f
+ #f
+ -1
+ "a"
+ 'lkey_a
+ #f
+ mod_None
+ #t
+ #f))
+ (uim '(legacy-key->key-event (string->char "a") 0 #t)))
+ ;; enable physical-key mapping
+ (uim '(require "physical-key.scm"))
+ (assert-equal (uim '(list 'key
+ #f
+ #f
+ -1
+ "a"
+ 'lkey_a
+ 'pkey_jp106_a
+ mod_None
+ #t
+ #f))
+ (uim '(legacy-key->key-event (string->char "a") 0 #t)))
+ ;; press/release
+ (assert-equal (uim '(list 'key
+ #f
+ #f
+ -1
+ "a"
+ 'lkey_a
+ 'pkey_jp106_a
+ mod_None
+ #f
+ #f))
+ (uim '(legacy-key->key-event (string->char "a") 0 #f)))
+ ;; with single modifier
+ (assert-equal (uim '(list 'key
+ #f
+ #f
+ -1
+ "a"
+ 'lkey_a
+ 'pkey_jp106_a
+ mod_Shift
+ #t
+ #f))
+ (uim '(legacy-key->key-event (string->char "a")
+ (assq-cdr 'Shift_key
+ key-state-alist)
+ #t)))
+ ;; with duplexed modifier
+ (assert-equal (uim '(list 'key
+ #f
+ #f
+ -1
+ "a"
+ 'lkey_a
+ 'pkey_jp106_a
+ (bitwise-or mod_Shift mod_Control)
+ #t
+ #f))
+ (uim '(legacy-key->key-event (string->char "a")
+ (bitwise-or
+ (assq-cdr 'Shift_key
+ key-state-alist)
+ (assq-cdr 'Control_key
+ key-state-alist))
+ #t)))
+ ;; capitalized alphabet
+ (assert-equal (uim '(list 'key
+ #f
+ #f
+ -1
+ "A"
+ 'lkey_A
+ 'pkey_jp106_a
+ mod_None
+ #t
+ #f))
+ (uim '(legacy-key->key-event (string->char "A") 0 #t)))
+ ;; ASCII symbol
+ (assert-equal (uim '(list 'key
+ #f
+ #f
+ -1
+ "("
+ 'lkey_parenleft
+ 'pkey_jp106_8
+ mod_None
+ #t
+ #f))
+ (uim '(legacy-key->key-event (string->char "(") 0 #t)))
+ ;; ASCII space
+ (assert-equal (uim '(list 'key
+ #f
+ #f
+ -1
+ " "
+ 'lkey_space
+ 'pkey_jp106_space
+ mod_None
+ #t
+ #f))
+ (uim '(legacy-key->key-event (string->char " ") 0 #t)))
+ ;; symbolic key
+ (assert-equal (uim '(list 'key
+ #f
+ #f
+ -1
+ #f
+ 'lkey_BackSpace
+ 'pkey_jp106_BackSpace
+ mod_None
+ #t
+ #f))
+ (uim '(legacy-key->key-event 'backspace 0 #t)))
+ ;; invalid key
+ (assert-equal (uim '(list 'key
+ #f
+ #f
+ -1
+ #f
+ #f
+ #f
+ mod_None
+ #t
+ #f))
+ (uim '(legacy-key->key-event 'nonexistent 0 #t)))
+ (assert-equal (uim '(list 'key
+ #f
+ #f
+ -1
+ #f
+ #f
+ #f
+ mod_None
+ #t
+ #f))
+ (uim '(legacy-key->key-event (string->char "\n") 0 #t)))
+ (assert-equal (uim '(list 'key
+ #f
+ #f
+ -1
+ #f
+ #f
+ #f
+ mod_None
+ #t
+ #f))
+ (uim '(legacy-key->key-event (string->char "") 0 #t)))))
Property changes on: branches/composer/test/test-legacy-api-bridge.scm
___________________________________________________________________
Name: svn:executable
+ *
More information about the Uim-commit
mailing list