← Back to branch summary

~ubuntu-branches/ubuntu/precise/uim/precise

« back to all changes in this revision

Viewing changes to test/test-key.scm

  • Committer: Package Import Robot
  • Author(s): Ilya Barygin
  • Date: 2011-12-18 16:35:38 UTC
  • mfrom: (1.1.13) (15.1.7 sid)
  • Revision ID: package-import@ubuntu.com-20111218163538-8ktir39z2mjpii8z
Tags: 1:1.7.1-3ubuntu1
https://launchpad.net/bugs/818199
* Merge from Debian testing (LP: #818199).
* Remaining changes:
  - debian/uim-qt.install: Fix plugin path for multiarch location.
* Dropped changes:
  - uim-applet-gnome removal (GNOME 3 applet is available)
  - 19_as-needed_compile_fix.dpatch (accepted into Debian package)
* translations.patch: add several files to POTFILE.in to prevent
  intltool-update failure.

Show diffs side-by-side

added added

removed removed

Lines of Context:
test/test-key.scm
1
 
#!/usr/bin/env gosh
2
 
 
3
 
;;; Copyright (c) 2003-2009 uim Project http://code.google.com/p/uim/
4
 
;;;
5
 
;;; All rights reserved.
6
 
;;;
7
 
;;; Redistribution and use in source and binary forms, with or without
8
 
;;; modification, are permitted provided that the following conditions
9
 
;;; are met:
10
 
;;; 1. Redistributions of source code must retain the above copyright
11
 
;;;    notice, this list of conditions and the following disclaimer.
12
 
;;; 2. Redistributions in binary form must reproduce the above copyright
13
 
;;;    notice, this list of conditions and the following disclaimer in the
14
 
;;;    documentation and/or other materials provided with the distribution.
15
 
;;; 3. Neither the name of authors nor the names of its contributors
16
 
;;;    may be used to endorse or promote products derived from this software
17
 
;;;    without specific prior written permission.
18
 
;;;
19
 
;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS'' AND
20
 
;;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
21
 
;;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
22
 
;;; ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE
23
 
;;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
24
 
;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
25
 
;;; OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
26
 
;;; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
27
 
;;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
28
 
;;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
29
 
;;; SUCH DAMAGE.
30
 
;;;;
31
 
 
32
 
;; These tests are passed at revision 5329 (new repository)
33
 
 
34
 
(use test.unit)
35
 
 
36
 
(require "test/uim-test-utils")
37
 
 
38
 
(define-uim-test-case "test key"
39
 
  (setup
40
 
   (lambda ()
41
 
     (uim '(define test-shift-state (cdr (assq 'Shift_key key-state-alist))))
42
 
     (uim '(define test-control-state (cdr (assq 'Control_key key-state-alist))))
43
 
     (uim '(define test-alt-state (cdr (assq 'Alt_key key-state-alist))))
44
 
     (uim '(define test-meta-state (cdr (assq 'Meta_key key-state-alist))))
45
 
     (uim '(define test-super-state (cdr (assq 'Super_key key-state-alist))))
46
 
     (uim '(define test-hyper-state (cdr (assq 'Hyper_key key-state-alist))))))
47
 
 
48
 
  ("test intern-key-symbol"
49
 
   (assert-equal 'backspace
50
 
                 (uim '(intern-key-symbol "backspace")))
51
 
   (assert-equal 'delete
52
 
                 (uim '(intern-key-symbol "delete")))
53
 
   (assert-equal 'zenkaku-hankaku
54
 
                 (uim '(intern-key-symbol "zenkaku-hankaku")))
55
 
   (assert-equal 'F10
56
 
                 (uim '(intern-key-symbol "F10")))
57
 
   (assert-equal 'Private9
58
 
                 (uim '(intern-key-symbol "Private9")))
59
 
   (assert-equal 'Hyper_key
60
 
                 (uim '(intern-key-symbol "Hyper_key")))
61
 
   (assert-false (uim-bool '(intern-key-symbol "nonexistent"))))
62
 
 
63
 
  ("test modifier key mask predicates"
64
 
   (assert-true  (uim-bool '(shift-key-mask test-shift-state)))
65
 
   (assert-false (uim-bool '(shift-key-mask test-control-state)))
66
 
   (assert-false (uim-bool '(shift-key-mask test-alt-state)))
67
 
   (assert-false (uim-bool '(shift-key-mask test-meta-state)))
68
 
   (assert-false (uim-bool '(shift-key-mask test-super-state)))
69
 
   (assert-false (uim-bool '(shift-key-mask test-hyper-state)))
70
 
   (assert-false (uim-bool '(shift-key-mask 0)))
71
 
 
72
 
   (assert-false (uim-bool '(control-key-mask test-shift-state)))
73
 
   (assert-true  (uim-bool '(control-key-mask test-control-state)))
74
 
   (assert-false (uim-bool '(control-key-mask test-alt-state)))
75
 
   (assert-false (uim-bool '(control-key-mask test-meta-state)))
76
 
   (assert-false (uim-bool '(control-key-mask test-super-state)))
77
 
   (assert-false (uim-bool '(control-key-mask test-hyper-state)))
78
 
   (assert-false (uim-bool '(control-key-mask 0)))
79
 
 
80
 
   (assert-false (uim-bool '(alt-key-mask test-shift-state)))
81
 
   (assert-false (uim-bool '(alt-key-mask test-control-state)))
82
 
   (assert-true  (uim-bool '(alt-key-mask test-alt-state)))
83
 
   (assert-false (uim-bool '(alt-key-mask test-meta-state)))
84
 
   (assert-false (uim-bool '(alt-key-mask test-super-state)))
85
 
   (assert-false (uim-bool '(alt-key-mask test-hyper-state)))
86
 
   (assert-false (uim-bool '(alt-key-mask 0)))
87
 
 
88
 
   (assert-false (uim-bool '(meta-key-mask test-shift-state)))
89
 
   (assert-false (uim-bool '(meta-key-mask test-control-state)))
90
 
   (assert-false (uim-bool '(meta-key-mask test-alt-state)))
91
 
   (assert-true  (uim-bool '(meta-key-mask test-meta-state)))
92
 
   (assert-false (uim-bool '(meta-key-mask test-super-state)))
93
 
   (assert-false (uim-bool '(meta-key-mask test-hyper-state)))
94
 
   (assert-false (uim-bool '(meta-key-mask 0)))
95
 
 
96
 
   (assert-false (uim-bool '(super-key-mask test-shift-state)))
97
 
   (assert-false (uim-bool '(super-key-mask test-control-state)))
98
 
   (assert-false (uim-bool '(super-key-mask test-alt-state)))
99
 
   (assert-false (uim-bool '(super-key-mask test-meta-state)))
100
 
   (assert-true  (uim-bool '(super-key-mask test-super-state)))
101
 
   (assert-false (uim-bool '(super-key-mask test-hyper-state)))
102
 
   (assert-false (uim-bool '(super-key-mask 0)))
103
 
 
104
 
   (assert-false (uim-bool '(hyper-key-mask test-shift-state)))
105
 
   (assert-false (uim-bool '(hyper-key-mask test-control-state)))
106
 
   (assert-false (uim-bool '(hyper-key-mask test-alt-state)))
107
 
   (assert-false (uim-bool '(hyper-key-mask test-meta-state)))
108
 
   (assert-false (uim-bool '(hyper-key-mask test-super-state)))
109
 
   (assert-true  (uim-bool '(hyper-key-mask test-hyper-state)))
110
 
   (assert-false (uim-bool '(hyper-key-mask 0)))
111
 
 
112
 
   (assert-true  (uim-bool '(modifier-key-mask test-shift-state)))
113
 
   (assert-true  (uim-bool '(modifier-key-mask test-control-state)))
114
 
   (assert-true  (uim-bool '(modifier-key-mask test-alt-state)))
115
 
   (assert-true  (uim-bool '(modifier-key-mask test-meta-state)))
116
 
   (assert-true  (uim-bool '(modifier-key-mask test-super-state)))
117
 
   (assert-true  (uim-bool '(modifier-key-mask test-hyper-state)))
118
 
   (assert-false (uim-bool '(modifier-key-mask 0))))
119
 
 
120
 
  ("test modifier-key?"
121
 
   (assert-true  (uim-bool '(modifier-key? 'Shift_key 0)))
122
 
   (assert-true  (uim-bool '(modifier-key? 'Control_key 0)))
123
 
   (assert-true  (uim-bool '(modifier-key? 'Alt_key 0)))
124
 
   (assert-true  (uim-bool '(modifier-key? 'Meta_key 0)))
125
 
   (assert-true  (uim-bool '(modifier-key? 'Super_key 0)))
126
 
   (assert-true  (uim-bool '(modifier-key? 'Hyper_key 0)))
127
 
   (assert-false (uim-bool '(modifier-key? 'return 0)))
128
 
   (assert-false (uim-bool '(modifier-key? 'escape 0)))
129
 
   (assert-false (uim-bool '(modifier-key? 0 0))) ;; NUL
130
 
   (assert-false (uim-bool '(modifier-key? 97 0))) ;; a
131
 
 
132
 
   (assert-true  (uim-bool '(modifier-key? 'Shift_key test-shift-state)))
133
 
   (assert-true  (uim-bool '(modifier-key? 'Control_key test-shift-state)))
134
 
   (assert-true  (uim-bool '(modifier-key? 'Alt_key test-shift-state)))
135
 
   (assert-true  (uim-bool '(modifier-key? 'Meta_key test-shift-state)))
136
 
   (assert-true  (uim-bool '(modifier-key? 'Super_key test-shift-state)))
137
 
   (assert-true  (uim-bool '(modifier-key? 'Hyper_key test-shift-state)))
138
 
   (assert-false (uim-bool '(modifier-key? 'return test-shift-state)))
139
 
   (assert-false (uim-bool '(modifier-key? 'escape test-shift-state)))
140
 
   (assert-false (uim-bool '(modifier-key? 0 test-shift-state))) ;; NUL
141
 
   (assert-false (uim-bool '(modifier-key? 97 test-shift-state)))       ;; a
142
 
 
143
 
   (assert-true  (uim-bool '(modifier-key? 'Shift_key test-control-state)))
144
 
   (assert-true  (uim-bool '(modifier-key? 'Control_key test-control-state)))
145
 
   (assert-true  (uim-bool '(modifier-key? 'Alt_key test-control-state)))
146
 
   (assert-true  (uim-bool '(modifier-key? 'Meta_key test-control-state)))
147
 
   (assert-true  (uim-bool '(modifier-key? 'Super_key test-control-state)))
148
 
   (assert-true  (uim-bool '(modifier-key? 'Hyper_key test-control-state)))
149
 
   (assert-false (uim-bool '(modifier-key? 'return test-control-state)))
150
 
   (assert-false (uim-bool '(modifier-key? 'escape test-control-state)))
151
 
   (assert-false (uim-bool '(modifier-key? 0 test-control-state))) ;; NUL
152
 
   (assert-false (uim-bool '(modifier-key? 97 test-control-state))) ;; a
153
 
 
154
 
   (assert-true  (uim-bool '(modifier-key? 'Shift_key test-alt-state)))
155
 
   (assert-true  (uim-bool '(modifier-key? 'Control_key test-alt-state)))
156
 
   (assert-true  (uim-bool '(modifier-key? 'Alt_key test-alt-state)))
157
 
   (assert-true  (uim-bool '(modifier-key? 'Meta_key test-alt-state)))
158
 
   (assert-true  (uim-bool '(modifier-key? 'Super_key test-alt-state)))
159
 
   (assert-true  (uim-bool '(modifier-key? 'Hyper_key test-alt-state)))
160
 
   (assert-false (uim-bool '(modifier-key? 'return test-alt-state)))
161
 
   (assert-false (uim-bool '(modifier-key? 'escape test-alt-state)))
162
 
   (assert-false (uim-bool '(modifier-key? 0 test-alt-state))) ;; NUL
163
 
   (assert-false (uim-bool '(modifier-key? 97 test-alt-state))) ;; a
164
 
 
165
 
   (assert-true  (uim-bool '(modifier-key? 'Shift_key test-meta-state)))
166
 
   (assert-true  (uim-bool '(modifier-key? 'Control_key test-meta-state)))
167
 
   (assert-true  (uim-bool '(modifier-key? 'Alt_key test-meta-state)))
168
 
   (assert-true  (uim-bool '(modifier-key? 'Meta_key test-meta-state)))
169
 
   (assert-true  (uim-bool '(modifier-key? 'Super_key test-meta-state)))
170
 
   (assert-true  (uim-bool '(modifier-key? 'Hyper_key test-meta-state)))
171
 
   (assert-false (uim-bool '(modifier-key? 'return test-meta-state)))
172
 
   (assert-false (uim-bool '(modifier-key? 'escape test-meta-state)))
173
 
   (assert-false (uim-bool '(modifier-key? 0 test-meta-state))) ;; NUL
174
 
   (assert-false (uim-bool '(modifier-key? 97 test-meta-state))) ;; a
175
 
 
176
 
   (assert-true  (uim-bool '(modifier-key? 'Shift_key test-super-state)))
177
 
   (assert-true  (uim-bool '(modifier-key? 'Control_key test-super-state)))
178
 
   (assert-true  (uim-bool '(modifier-key? 'Alt_key test-super-state)))
179
 
   (assert-true  (uim-bool '(modifier-key? 'Meta_key test-super-state)))
180
 
   (assert-true  (uim-bool '(modifier-key? 'Super_key test-super-state)))
181
 
   (assert-true  (uim-bool '(modifier-key? 'Hyper_key test-super-state)))
182
 
   (assert-false (uim-bool '(modifier-key? 'return test-super-state)))
183
 
   (assert-false (uim-bool '(modifier-key? 'escape test-super-state)))
184
 
   (assert-false (uim-bool '(modifier-key? 0 test-super-state))) ;; NUL
185
 
   (assert-false (uim-bool '(modifier-key? 97 test-super-state)))       ;; a
186
 
 
187
 
   (assert-true  (uim-bool '(modifier-key? 'Shift_key test-hyper-state)))
188
 
   (assert-true  (uim-bool '(modifier-key? 'Control_key test-hyper-state)))
189
 
   (assert-true  (uim-bool '(modifier-key? 'Alt_key test-hyper-state)))
190
 
   (assert-true  (uim-bool '(modifier-key? 'Meta_key test-hyper-state)))
191
 
   (assert-true  (uim-bool '(modifier-key? 'Super_key test-hyper-state)))
192
 
   (assert-true  (uim-bool '(modifier-key? 'Hyper_key test-hyper-state)))
193
 
   (assert-false (uim-bool '(modifier-key? 'return test-hyper-state)))
194
 
   (assert-false (uim-bool '(modifier-key? 'escape test-hyper-state)))
195
 
   (assert-false (uim-bool '(modifier-key? 0 test-hyper-state)))   ;; NUL
196
 
   (assert-false (uim-bool '(modifier-key? 97 test-hyper-state)))) ;; a
197
 
 
198
 
  ("test translator-prefix?"
199
 
   (assert-true  (uim-bool '(translator-prefix? 'IgnoreCase)))
200
 
   (assert-true  (uim-bool '(translator-prefix? 'IgnoreShift)))
201
 
   (assert-true  (uim-bool '(translator-prefix? 'IgnoreRegularShift)))
202
 
   (assert-false (uim-bool '(translator-prefix? 'NonExistent))))
203
 
 
204
 
  ("test intern-key-prefix"
205
 
   (assert-equal 'Shift_key
206
 
                 (uim '(intern-key-prefix "Shift" tag-prefix-alist)))
207
 
   (assert-equal 'Control_key
208
 
                 (uim '(intern-key-prefix "Control" tag-prefix-alist)))
209
 
   (assert-equal 'Alt_key
210
 
                 (uim '(intern-key-prefix "Alt" tag-prefix-alist)))
211
 
   (assert-equal 'Meta_key
212
 
                 (uim '(intern-key-prefix "Meta" tag-prefix-alist)))
213
 
   (assert-equal 'Super_key
214
 
                 (uim '(intern-key-prefix "Super" tag-prefix-alist)))
215
 
   (assert-equal 'Hyper_key
216
 
                 (uim '(intern-key-prefix "Hyper" tag-prefix-alist)))
217
 
   (assert-equal 'IgnoreCase
218
 
                 (uim '(intern-key-prefix "IgnoreCase" tag-prefix-alist)))
219
 
   (assert-equal 'IgnoreShift
220
 
                 (uim '(intern-key-prefix "IgnoreShift" tag-prefix-alist)))
221
 
   (assert-equal 'IgnoreRegularShift
222
 
                 (uim '(intern-key-prefix "IgnoreRegularShift" tag-prefix-alist)))
223
 
   (assert-false (uim-bool '(intern-key-prefix "NonExistent" tag-prefix-alist)))
224
 
 
225
 
   (assert-equal 'Shift_key
226
 
                 (uim '(intern-key-prefix "S" emacs-like-prefix-alist)))
227
 
   (assert-equal 'Control_key
228
 
                 (uim '(intern-key-prefix "C" emacs-like-prefix-alist)))
229
 
   (assert-equal 'Alt_key
230
 
                 (uim '(intern-key-prefix "A" emacs-like-prefix-alist)))
231
 
   (assert-equal 'Meta_key
232
 
                 (uim '(intern-key-prefix "M" emacs-like-prefix-alist)))
233
 
   (assert-equal 'Super_key
234
 
                 (uim '(intern-key-prefix "Z" emacs-like-prefix-alist)))
235
 
   (assert-equal 'Hyper_key
236
 
                 (uim '(intern-key-prefix "H" emacs-like-prefix-alist)))
237
 
   (assert-equal 'IgnoreCase
238
 
                 (uim '(intern-key-prefix "I" emacs-like-prefix-alist)))
239
 
   (assert-equal 'IgnoreShift
240
 
                 (uim '(intern-key-prefix "J" emacs-like-prefix-alist)))
241
 
   (assert-equal 'IgnoreRegularShift
242
 
                 (uim '(intern-key-prefix "K" emacs-like-prefix-alist)))
243
 
   (assert-false (uim-bool '(intern-key-prefix "N" emacs-like-prefix-alist))))
244
 
 
245
 
  ("test parse-tag-prefix-symbol"
246
 
   (assert-equal '(Shift_key)
247
 
                 (uim '(parse-tag-prefix-symbol "" '("S" "h" "i" "f" "t"))))
248
 
   (assert-equal '(Control_key)
249
 
                 (uim '(parse-tag-prefix-symbol "" '("C" "o" "n" "t" "r" "o" "l"))))
250
 
   (assert-equal '(Alt_key)
251
 
                 (uim '(parse-tag-prefix-symbol "" '("A" "l" "t"))))
252
 
   (assert-equal '(Meta_key)
253
 
                 (uim '(parse-tag-prefix-symbol "" '("M" "e" "t" "a"))))
254
 
   (assert-equal '(Super_key)
255
 
                 (uim '(parse-tag-prefix-symbol "" '("S" "u" "p" "e" "r"))))
256
 
   (assert-equal '(Hyper_key)
257
 
                 (uim '(parse-tag-prefix-symbol "" '("H" "y" "p" "e" "r"))))
258
 
   (assert-equal (list (uim #f))
259
 
                 (uim '(parse-tag-prefix-symbol "" '("N" "o" "n" "E" "x" "i" "s" "t" "e" "n" "t"))))
260
 
   (assert-equal (list (uim #f))
261
 
                 (uim '(parse-tag-prefix-symbol "" '("S" "H" "I" "F" "T"))))
262
 
   (assert-equal (list (uim #f))
263
 
                 (uim '(parse-tag-prefix-symbol "" '("S" "h" "i" "f" "t" "t"))))
264
 
 
265
 
   ;; parsing is terminated at boundary char
266
 
   (assert-equal '(Shift_key ">")
267
 
                 (uim '(parse-tag-prefix-symbol "" '("S" "h" "i" "f" "t" ">"))))
268
 
   (assert-equal '(Control_key ">")
269
 
                 (uim '(parse-tag-prefix-symbol "" '("C" "o" "n" "t" "r" "o" "l" ">"))))
270
 
   (assert-equal '(Alt_key ">")
271
 
                 (uim '(parse-tag-prefix-symbol "" '("A" "l" "t" ">"))))
272
 
   (assert-equal '(Meta_key ">")
273
 
                 (uim '(parse-tag-prefix-symbol "" '("M" "e" "t" "a" ">"))))
274
 
   (assert-equal '(Super_key ">")
275
 
                 (uim '(parse-tag-prefix-symbol "" '("S" "u" "p" "e" "r" ">"))))
276
 
   (assert-equal '(Hyper_key ">")
277
 
                 (uim '(parse-tag-prefix-symbol "" '("H" "y" "p" "e" "r" ">"))))
278
 
   (assert-equal (list (uim #f) ">")
279
 
                 (uim '(parse-tag-prefix-symbol "" '("N" "o" "n" "E" "x" "i" "s" "t" "e" "n" "t" ">"))))
280
 
   (assert-equal (list (uim #f) ">")
281
 
                 (uim '(parse-tag-prefix-symbol "" '("S" "H" "I" "F" "T" ">"))))
282
 
   (assert-equal (list (uim #f) ">")
283
 
                 (uim '(parse-tag-prefix-symbol "" '("S" "h" "i" "f" "t" "t" ">"))))
284
 
 
285
 
   ;; all chars that following boundary char remains
286
 
   (assert-equal '(Shift_key ">" "<" "A" "l" "t" ">")
287
 
                 (uim '(parse-tag-prefix-symbol "" '("S" "h" "i" "f" "t" ">" "<" "A" "l" "t" ">"))))
288
 
   (assert-equal '(Control_key ">" "<" "A" "l" "t" ">")
289
 
                 (uim '(parse-tag-prefix-symbol "" '("C" "o" "n" "t" "r" "o" "l" ">" "<" "A" "l" "t" ">"))))
290
 
   (assert-equal '(Alt_key ">" "<" "A" "l" "t" ">")
291
 
                 (uim '(parse-tag-prefix-symbol "" '("A" "l" "t" ">" "<" "A" "l" "t" ">"))))
292
 
   (assert-equal '(Meta_key ">" "<" "A" "l" "t" ">")
293
 
                 (uim '(parse-tag-prefix-symbol "" '("M" "e" "t" "a" ">" "<" "A" "l" "t" ">"))))
294
 
   (assert-equal '(Super_key ">" "<" "A" "l" "t" ">")
295
 
                 (uim '(parse-tag-prefix-symbol "" '("S" "u" "p" "e" "r" ">" "<" "A" "l" "t" ">"))))
296
 
   (assert-equal '(Hyper_key ">" "<" "A" "l" "t" ">")
297
 
                 (uim '(parse-tag-prefix-symbol "" '("H" "y" "p" "e" "r" ">" "<" "A" "l" "t" ">"))))
298
 
   (assert-equal (list (uim #f) ">" "<" "A" "l" "t" ">")
299
 
                 (uim '(parse-tag-prefix-symbol "" '("N" "o" "n" "E" "x" "i" "s" "t" "e" "n" "t" ">" "<" "A" "l" "t" ">"))))
300
 
   (assert-equal (list (uim #f) ">" "<" "A" "l" "t" ">")
301
 
                 (uim '(parse-tag-prefix-symbol "" '("S" "H" "I" "F" "T" ">" "<" "A" "l" "t" ">"))))
302
 
   (assert-equal (list (uim #f) ">" "<" "A" "l" "t" ">")
303
 
                 (uim '(parse-tag-prefix-symbol "" '("S" "h" "i" "f" "t" "t" ">" "<" "A" "l" "t" ">"))))
304
 
 
305
 
   ;; nonexistent symbol is parsed as #f
306
 
   (assert-equal (list (uim #f))
307
 
                 (uim '(parse-tag-prefix-symbol "" '("_" "F" "o" "o" "1"))))
308
 
   ;; tag-prefix symbol must be consist of alphanumeric or "_"
309
 
   (assert-equal (list (uim #f) "-" "F" "o" "o" "1")
310
 
                 (uim '(parse-tag-prefix-symbol "" '("-" "F" "o" "o" "1")))))
311
 
 
312
 
  ("test parse-tag-prefix"
313
 
   (assert-equal '(Shift_key . "")
314
 
                 (uim '(parse-tag-prefix "<Shift>")))
315
 
   (assert-equal '(Control_key . "")
316
 
                 (uim '(parse-tag-prefix "<Control>")))
317
 
   (assert-equal '(Alt_key . "")
318
 
                 (uim '(parse-tag-prefix "<Alt>")))
319
 
   (assert-equal '(Meta_key . "")
320
 
                 (uim '(parse-tag-prefix "<Meta>")))
321
 
   (assert-equal '(Super_key . "")
322
 
                 (uim '(parse-tag-prefix "<Super>")))
323
 
   (assert-equal '(Hyper_key . "")
324
 
                 (uim '(parse-tag-prefix "<Hyper>")))
325
 
   (assert-equal (cons (uim #f) "")
326
 
                 (uim '(parse-tag-prefix "<NonExistent>")))
327
 
   (assert-equal (cons (uim #f) "")
328
 
                 (uim '(parse-tag-prefix "<SHIFT>")))
329
 
   (assert-equal (cons (uim #f) "")
330
 
                 (uim '(parse-tag-prefix "<Shiftt>")))
331
 
 
332
 
   (assert-equal '(Shift_key . "<Alt>")
333
 
                 (uim '(parse-tag-prefix "<Shift><Alt>")))
334
 
   (assert-equal '(Control_key . "<Alt>")
335
 
                 (uim '(parse-tag-prefix "<Control><Alt>")))
336
 
   (assert-equal '(Alt_key . "<Alt>")
337
 
                 (uim '(parse-tag-prefix "<Alt><Alt>")))
338
 
   (assert-equal '(Meta_key . "<Alt>")
339
 
                 (uim '(parse-tag-prefix "<Meta><Alt>")))
340
 
   (assert-equal '(Super_key . "<Alt>")
341
 
                 (uim '(parse-tag-prefix "<Super><Alt>")))
342
 
   (assert-equal '(Hyper_key . "<Alt>")
343
 
                 (uim '(parse-tag-prefix "<Hyper><Alt>")))
344
 
   (assert-equal (cons (uim #f) "<Alt>")
345
 
                 (uim '(parse-tag-prefix "<NonExistent><Alt>")))
346
 
   (assert-equal (cons (uim #f) "<Alt>")
347
 
                 (uim '(parse-tag-prefix "<SHIFT><Alt>")))
348
 
   (assert-equal (cons (uim #f) "<Alt>")
349
 
                 (uim '(parse-tag-prefix "<Shiftt><Alt>")))
350
 
 
351
 
   (assert-equal '(Shift_key . "a")
352
 
                 (uim '(parse-tag-prefix "<Shift>a")))
353
 
   (assert-equal '(Control_key . "a")
354
 
                 (uim '(parse-tag-prefix "<Control>a")))
355
 
   (assert-equal '(Alt_key . "a")
356
 
                 (uim '(parse-tag-prefix "<Alt>a")))
357
 
   (assert-equal '(Meta_key . "a")
358
 
                 (uim '(parse-tag-prefix "<Meta>a")))
359
 
   (assert-equal '(Super_key . "a")
360
 
                 (uim '(parse-tag-prefix "<Super>a")))
361
 
   (assert-equal '(Hyper_key . "a")
362
 
                 (uim '(parse-tag-prefix "<Hyper>a")))
363
 
   (assert-equal (cons (uim #f) "a")
364
 
                 (uim '(parse-tag-prefix "<NonExistent>a")))
365
 
   (assert-equal (cons (uim #f) "a")
366
 
                 (uim '(parse-tag-prefix "<SHIFT>a")))
367
 
   (assert-equal (cons (uim #f) "a")
368
 
                 (uim '(parse-tag-prefix "<Shiftt>a"))))
369
 
 
370
 
  ("test parse-emacs-like-prefix"
371
 
   (assert-equal '(Shift_key . "")
372
 
                 (uim '(parse-emacs-like-prefix "S-")))
373
 
   (assert-equal '(Control_key . "")
374
 
                 (uim '(parse-emacs-like-prefix "C-")))
375
 
   (assert-equal '(Alt_key . "")
376
 
                 (uim '(parse-emacs-like-prefix "A-")))
377
 
   (assert-equal '(Meta_key . "")
378
 
                 (uim '(parse-emacs-like-prefix "M-")))
379
 
   (assert-equal '(Super_key . "")
380
 
                 (uim '(parse-emacs-like-prefix "Z-")))
381
 
   (assert-equal '(Hyper_key . "")
382
 
                 (uim '(parse-emacs-like-prefix "H-")))
383
 
   (assert-equal (cons (uim #f) "N-")
384
 
                 (uim '(parse-emacs-like-prefix "N-")))
385
 
   (assert-equal (cons (uim #f) "s-")
386
 
                 (uim '(parse-emacs-like-prefix "s-")))
387
 
   (assert-equal (cons (uim #f) "SS-")
388
 
                 (uim '(parse-emacs-like-prefix "SS-")))
389
 
 
390
 
   (assert-equal '(Shift_key . "A-")
391
 
                 (uim '(parse-emacs-like-prefix "S-A-")))
392
 
   (assert-equal '(Control_key . "A-")
393
 
                 (uim '(parse-emacs-like-prefix "C-A-")))
394
 
   (assert-equal '(Alt_key . "A-")
395
 
                 (uim '(parse-emacs-like-prefix "A-A-")))
396
 
   (assert-equal '(Meta_key . "A-")
397
 
                 (uim '(parse-emacs-like-prefix "M-A-")))
398
 
   (assert-equal '(Super_key . "A-")
399
 
                 (uim '(parse-emacs-like-prefix "Z-A-")))
400
 
   (assert-equal '(Hyper_key . "A-")
401
 
                 (uim '(parse-emacs-like-prefix "H-A-")))
402
 
   (assert-equal (cons (uim #f) "N-A-")
403
 
                 (uim '(parse-emacs-like-prefix "N-A-")))
404
 
   (assert-equal (cons (uim #f) "s-A-")
405
 
                 (uim '(parse-emacs-like-prefix "s-A-")))
406
 
   (assert-equal (cons (uim #f) "SS-A-")
407
 
                 (uim '(parse-emacs-like-prefix "SS-A-")))
408
 
 
409
 
   (assert-equal '(Shift_key . "a")
410
 
                 (uim '(parse-emacs-like-prefix "S-a")))
411
 
   (assert-equal '(Control_key . "a")
412
 
                 (uim '(parse-emacs-like-prefix "C-a")))
413
 
   (assert-equal '(Alt_key . "a")
414
 
                 (uim '(parse-emacs-like-prefix "A-a")))
415
 
   (assert-equal '(Meta_key . "a")
416
 
                 (uim '(parse-emacs-like-prefix "M-a")))
417
 
   (assert-equal '(Super_key . "a")
418
 
                 (uim '(parse-emacs-like-prefix "Z-a")))
419
 
   (assert-equal '(Hyper_key . "a")
420
 
                 (uim '(parse-emacs-like-prefix "H-a")))
421
 
   (assert-equal (cons (uim #f) "N-a")
422
 
                 (uim '(parse-emacs-like-prefix "N-a")))
423
 
   (assert-equal (cons (uim #f) "s-a")
424
 
                 (uim '(parse-emacs-like-prefix "s-a")))
425
 
   (assert-equal (cons (uim #f) "SS-a")
426
 
                 (uim '(parse-emacs-like-prefix "SS-a"))))
427
 
 
428
 
  ("test parse-key-prefix"
429
 
   (assert-equal '(Shift_key . "")
430
 
                 (uim '(parse-key-prefix "<Shift>")))
431
 
   (assert-equal '(Control_key . "")
432
 
                 (uim '(parse-key-prefix "<Control>")))
433
 
   (assert-equal '(Alt_key . "")
434
 
                 (uim '(parse-key-prefix "<Alt>")))
435
 
   (assert-equal '(Meta_key . "")
436
 
                 (uim '(parse-key-prefix "<Meta>")))
437
 
   (assert-equal '(Super_key . "")
438
 
                 (uim '(parse-key-prefix "<Super>")))
439
 
   (assert-equal '(Hyper_key . "")
440
 
                 (uim '(parse-key-prefix "<Hyper>")))
441
 
   (assert-equal (cons (uim #f) "")
442
 
                 (uim '(parse-key-prefix "<NonExistent>")))
443
 
   (assert-equal (cons (uim #f) "")
444
 
                 (uim '(parse-key-prefix "<SHIFT>")))
445
 
   (assert-equal (cons (uim #f) "")
446
 
                 (uim '(parse-key-prefix "<Shiftt>")))
447
 
 
448
 
   (assert-equal '(Shift_key . "<Alt>")
449
 
                 (uim '(parse-key-prefix "<Shift><Alt>")))
450
 
   (assert-equal '(Control_key . "<Alt>")
451
 
                 (uim '(parse-key-prefix "<Control><Alt>")))
452
 
   (assert-equal '(Alt_key . "<Alt>")
453
 
                 (uim '(parse-key-prefix "<Alt><Alt>")))
454
 
   (assert-equal '(Meta_key . "<Alt>")
455
 
                 (uim '(parse-key-prefix "<Meta><Alt>")))
456
 
   (assert-equal '(Super_key . "<Alt>")
457
 
                 (uim '(parse-key-prefix "<Super><Alt>")))
458
 
   (assert-equal '(Hyper_key . "<Alt>")
459
 
                 (uim '(parse-key-prefix "<Hyper><Alt>")))
460
 
   (assert-equal (cons (uim #f) "<Alt>")
461
 
                 (uim '(parse-key-prefix "<NonExistent><Alt>")))
462
 
   (assert-equal (cons (uim #f) "<Alt>")
463
 
                 (uim '(parse-key-prefix "<SHIFT><Alt>")))
464
 
   (assert-equal (cons (uim #f) "<Alt>")
465
 
                 (uim '(parse-key-prefix "<Shiftt><Alt>")))
466
 
 
467
 
   (assert-equal '(Shift_key . "a")
468
 
                 (uim '(parse-key-prefix "<Shift>a")))
469
 
   (assert-equal '(Control_key . "a")
470
 
                 (uim '(parse-key-prefix "<Control>a")))
471
 
   (assert-equal '(Alt_key . "a")
472
 
                 (uim '(parse-key-prefix "<Alt>a")))
473
 
   (assert-equal '(Meta_key . "a")
474
 
                 (uim '(parse-key-prefix "<Meta>a")))
475
 
   (assert-equal '(Super_key . "a")
476
 
                 (uim '(parse-key-prefix "<Super>a")))
477
 
   (assert-equal '(Hyper_key . "a")
478
 
                 (uim '(parse-key-prefix "<Hyper>a")))
479
 
   (assert-equal (cons (uim #f) "a")
480
 
                 (uim '(parse-key-prefix "<NonExistent>a")))
481
 
   (assert-equal (cons (uim #f) "a")
482
 
                 (uim '(parse-key-prefix "<SHIFT>a")))
483
 
   (assert-equal (cons (uim #f) "a")
484
 
                 (uim '(parse-key-prefix "<Shiftt>a")))
485
 
 
486
 
   (assert-equal '(Shift_key . "")
487
 
                 (uim '(parse-key-prefix "S-")))
488
 
   (assert-equal '(Control_key . "")
489
 
                 (uim '(parse-key-prefix "C-")))
490
 
   (assert-equal '(Alt_key . "")
491
 
                 (uim '(parse-key-prefix "A-")))
492
 
   (assert-equal '(Meta_key . "")
493
 
                 (uim '(parse-key-prefix "M-")))
494
 
   (assert-equal '(Super_key . "")
495
 
                 (uim '(parse-key-prefix "Z-")))
496
 
   (assert-equal '(Hyper_key . "")
497
 
                 (uim '(parse-key-prefix "H-")))
498
 
   (assert-equal (cons (uim #f) "N-")
499
 
                 (uim '(parse-key-prefix "N-")))
500
 
   (assert-equal (cons (uim #f) "s-")
501
 
                 (uim '(parse-key-prefix "s-")))
502
 
   (assert-equal (cons (uim #f) "SS-")
503
 
                 (uim '(parse-key-prefix "SS-")))
504
 
 
505
 
   (assert-equal '(Shift_key . "A-")
506
 
                 (uim '(parse-key-prefix "S-A-")))
507
 
   (assert-equal '(Control_key . "A-")
508
 
                 (uim '(parse-key-prefix "C-A-")))
509
 
   (assert-equal '(Alt_key . "A-")
510
 
                 (uim '(parse-key-prefix "A-A-")))
511
 
   (assert-equal '(Meta_key . "A-")
512
 
                 (uim '(parse-key-prefix "M-A-")))
513
 
   (assert-equal '(Super_key . "A-")
514
 
                 (uim '(parse-key-prefix "Z-A-")))
515
 
   (assert-equal '(Hyper_key . "A-")
516
 
                 (uim '(parse-key-prefix "H-A-")))
517
 
   (assert-equal (cons (uim #f) "N-A-")
518
 
                 (uim '(parse-key-prefix "N-A-")))
519
 
   (assert-equal (cons (uim #f) "s-A-")
520
 
                 (uim '(parse-key-prefix "s-A-")))
521
 
   (assert-equal (cons (uim #f) "SS-A-")
522
 
                 (uim '(parse-key-prefix "SS-A-")))
523
 
 
524
 
   (assert-equal '(Shift_key . "a")
525
 
                 (uim '(parse-key-prefix "S-a")))
526
 
   (assert-equal '(Control_key . "a")
527
 
                 (uim '(parse-key-prefix "C-a")))
528
 
   (assert-equal '(Alt_key . "a")
529
 
                 (uim '(parse-key-prefix "A-a")))
530
 
   (assert-equal '(Meta_key . "a")
531
 
                 (uim '(parse-key-prefix "M-a")))
532
 
   (assert-equal '(Super_key . "a")
533
 
                 (uim '(parse-key-prefix "Z-a")))
534
 
   (assert-equal '(Hyper_key . "a")
535
 
                 (uim '(parse-key-prefix "H-a")))
536
 
   (assert-equal (cons (uim #f) "N-a")
537
 
                 (uim '(parse-key-prefix "N-a")))
538
 
   (assert-equal (cons (uim #f) "s-a")
539
 
                 (uim '(parse-key-prefix "s-a")))
540
 
   (assert-equal (cons (uim #f) "SS-a")
541
 
                 (uim '(parse-key-prefix "SS-a"))))
542
 
 
543
 
  ("test parse-key-str"
544
 
   ;; single key
545
 
   (assert-equal (list "" () 32 0)
546
 
                 (uim '(parse-key-str " " () 0 0)))
547
 
   (assert-equal (list "" () 33 0)
548
 
                 (uim '(parse-key-str "!" () 0 0)))
549
 
   (assert-equal (list "" () 48 0)
550
 
                 (uim '(parse-key-str "0" () 0 0)))
551
 
   (assert-equal (list "" () 65 0)
552
 
                 (uim '(parse-key-str "A" () 0 0)))
553
 
   (assert-equal (list "" () 97 0)
554
 
                 (uim '(parse-key-str "a" () 0 0)))
555
 
   (assert-equal (list "" () 'return 0)
556
 
                 (uim '(parse-key-str "return" () 0 0)))
557
 
 
558
 
   ;; single key with single modifier
559
 
   (assert-equal (uim '(list "" () 32 test-shift-state))
560
 
                 (uim '(parse-key-str "<Shift> " () 0 0)))
561
 
   (assert-equal (uim '(list "" () 33 test-shift-state))
562
 
                 (uim '(parse-key-str "<Shift>!" () 0 0)))
563
 
   (assert-equal (uim '(list "" () 48 test-shift-state))
564
 
                 (uim '(parse-key-str "<Shift>0" () 0 0)))
565
 
   (assert-equal (uim '(list "" () 65 test-shift-state))
566
 
                 (uim '(parse-key-str "<Shift>A" () 0 0)))
567
 
   (assert-equal (uim '(list "" () 97 test-shift-state))
568
 
                 (uim '(parse-key-str "<Shift>a" () 0 0)))
569
 
   (assert-equal (uim '(list "" () 'return test-shift-state))
570
 
                 (uim '(parse-key-str "<Shift>return" () 0 0)))
571
 
 
572
 
   ;; single key with multiple modifiers
573
 
   (assert-equal (uim '(list "" () 32 (+ test-shift-state
574
 
                                         test-control-state
575
 
                                         test-meta-state)))
576
 
                 (uim '(parse-key-str "<Shift><Control><Meta> " () 0 0)))
577
 
   (assert-equal (uim '(list "" () 33 (+ test-shift-state
578
 
                                         test-control-state
579
 
                                         test-meta-state)))
580
 
                 (uim '(parse-key-str "<Shift><Control><Meta>!" () 0 0)))
581
 
   (assert-equal (uim '(list "" () 48 (+ test-shift-state
582
 
                                         test-control-state
583
 
                                         test-meta-state)))
584
 
                 (uim '(parse-key-str "<Shift><Control><Meta>0" () 0 0)))
585
 
   (assert-equal (uim '(list "" () 65 (+ test-shift-state
586
 
                                         test-control-state
587
 
                                         test-meta-state)))
588
 
                 (uim '(parse-key-str "<Shift><Control><Meta>A" () 0 0)))
589
 
   (assert-equal (uim '(list "" () 97 (+ test-shift-state
590
 
                                         test-control-state
591
 
                                         test-meta-state)))
592
 
                 (uim '(parse-key-str "<Shift><Control><Meta>a" () 0 0)))
593
 
   (assert-equal (uim '(list "" () 'return (+ test-shift-state
594
 
                                              test-control-state
595
 
                                              test-meta-state)))
596
 
                 (uim '(parse-key-str "<Shift><Control><Meta>return" () 0 0)))
597
 
 
598
 
   ;; single key with single translator
599
 
   (assert-equal 1
600
 
                 (uim '(length (cadr (parse-key-str "<IgnoreShift> " () 0 0)))))
601
 
   (assert-equal 1
602
 
                 (uim '(length (cadr (parse-key-str "<IgnoreShift>!" () 0 0)))))
603
 
   (assert-equal 1
604
 
                 (uim '(length (cadr (parse-key-str "<IgnoreShift>0" () 0 0)))))
605
 
   (assert-equal 1
606
 
                 (uim '(length (cadr (parse-key-str "<IgnoreShift>A" () 0 0)))))
607
 
   (assert-equal 1
608
 
                 (uim '(length (cadr (parse-key-str "<IgnoreShift>a" () 0 0)))))
609
 
   (assert-equal 1
610
 
                 (uim '(length (cadr (parse-key-str "<IgnoreShift>return" () 0 0)))))
611
 
 
612
 
   ;; single key with multiple translators
613
 
   (assert-equal 2
614
 
                 (uim '(length (cadr (parse-key-str "<IgnoreShift><IgnoreCase> " () 0 0)))))
615
 
   (assert-equal 2
616
 
                 (uim '(length (cadr (parse-key-str "<IgnoreShift><IgnoreCase>!" () 0 0)))))
617
 
   (assert-equal 2
618
 
                 (uim '(length (cadr (parse-key-str "<IgnoreShift><IgnoreCase>0" () 0 0)))))
619
 
   (assert-equal 2
620
 
                 (uim '(length (cadr (parse-key-str "<IgnoreShift><IgnoreCase>A" () 0 0)))))
621
 
   (assert-equal 2
622
 
                 (uim '(length (cadr (parse-key-str "<IgnoreShift><IgnoreCase>a" () 0 0)))))
623
 
   (assert-equal 2
624
 
                 (uim '(length (cadr (parse-key-str "<IgnoreShift><IgnoreCase>return" () 0 0)))))
625
 
 
626
 
   ;; single key with multiple translators (2)
627
 
   (assert-equal 3
628
 
                 (uim '(length (cadr (parse-key-str "<IgnoreShift><IgnoreCase> " (list (lambda () #t)) 0 0)))))
629
 
   (assert-equal 3
630
 
                 (uim '(length (cadr (parse-key-str "<IgnoreShift><IgnoreCase>!" (list (lambda () #t)) 0 0)))))
631
 
   (assert-equal 3
632
 
                 (uim '(length (cadr (parse-key-str "<IgnoreShift><IgnoreCase>0" (list (lambda () #t)) 0 0)))))
633
 
   (assert-equal 3
634
 
                 (uim '(length (cadr (parse-key-str "<IgnoreShift><IgnoreCase>A" (list (lambda () #t)) 0 0)))))
635
 
   (assert-equal 3
636
 
                 (uim '(length (cadr (parse-key-str "<IgnoreShift><IgnoreCase>a" (list (lambda () #t)) 0 0)))))
637
 
   (assert-equal 3
638
 
                 (uim '(length (cadr (parse-key-str "<IgnoreShift><IgnoreCase>return" (list (lambda () #t)) 0 0)))))))
639
 
 
640
 
(define-uim-test-case "test key translators"
641
 
  (setup
642
 
   (lambda ()
643
 
     (uim '(define test-shift-state (cdr (assq 'Shift_key key-state-alist))))
644
 
     (uim '(define test-ignore-case #f))
645
 
     (uim '(define test-ignore-shift #f))
646
 
     (uim '(define test-ignore-regular-shift #f))
647
 
     (uim '(begin
648
 
             (set! test-ignore-case (car (cadr (parse-key-str "<IgnoreCase>" () 0 0))))
649
 
             (set! test-ignore-shift (car (cadr (parse-key-str "<IgnoreShift>" () 0 0))))
650
 
             (set! test-ignore-regular-shift (car (cadr (parse-key-str "<IgnoreRegularShift>" () 0 0))))
651
 
             #t))))
652
 
 
653
 
  ("test IgnoreCase translator"
654
 
   (assert-equal '(0   0) (uim '(test-ignore-case 0 0)))     ; NUL
655
 
   (assert-equal '(1   0) (uim '(test-ignore-case 1 0)))     ; SOH
656
 
   (assert-equal '(31  0) (uim '(test-ignore-case 31 0)))    ; US
657
 
   (assert-equal '(32  0) (uim '(test-ignore-case 32 0)))    ; SPACE
658
 
   (assert-equal '(33  0) (uim '(test-ignore-case 33 0)))    ; !
659
 
   (assert-equal '(47  0) (uim '(test-ignore-case 47 0)))    ; /
660
 
   (assert-equal '(48  0) (uim '(test-ignore-case 48 0)))    ; 0
661
 
   (assert-equal '(57  0) (uim '(test-ignore-case 57 0)))    ; 9
662
 
   (assert-equal '(58  0) (uim '(test-ignore-case 58 0)))    ; :
663
 
   (assert-equal '(64  0) (uim '(test-ignore-case 64 0)))    ; @
664
 
   (assert-equal '(97  0) (uim '(test-ignore-case 65 0)))    ; A
665
 
   (assert-equal '(122 0) (uim '(test-ignore-case 90 0)))    ; Z
666
 
   (assert-equal '(91  0) (uim '(test-ignore-case 91 0)))    ; [
667
 
   (assert-equal '(96  0) (uim '(test-ignore-case 96 0)))    ; `
668
 
   (assert-equal '(97  0) (uim '(test-ignore-case 97 0)))    ; a
669
 
   (assert-equal '(122 0) (uim '(test-ignore-case 122 0)))   ; z
670
 
   (assert-equal '(123 0) (uim '(test-ignore-case 123 0)))   ; {
671
 
   (assert-equal '(126 0) (uim '(test-ignore-case 126 0)))   ; ~
672
 
   (assert-equal '(127 0) (uim '(test-ignore-case 127 0))))  ; DEL
673
 
 
674
 
  ("test IgnoreShift translator"
675
 
   (assert-equal '(0 0) (uim '(test-ignore-shift 0 test-shift-state)))    ; NUL
676
 
   (assert-equal '(1 0) (uim '(test-ignore-shift 1 test-shift-state)))    ; SOH
677
 
   (assert-equal '(31 0) (uim '(test-ignore-shift 31 test-shift-state)))  ; US
678
 
   (assert-equal '(32 0) (uim '(test-ignore-shift 32 test-shift-state)))  ; SPACE
679
 
   (assert-equal '(33 0) (uim '(test-ignore-shift 33 test-shift-state)))  ; !
680
 
   (assert-equal '(47 0) (uim '(test-ignore-shift 47 test-shift-state)))  ; /
681
 
   (assert-equal '(48 0) (uim '(test-ignore-shift 48 test-shift-state)))  ; 0
682
 
   (assert-equal '(57 0) (uim '(test-ignore-shift 57 test-shift-state)))  ; 9
683
 
   (assert-equal '(58 0) (uim '(test-ignore-shift 58 test-shift-state)))  ; :
684
 
   (assert-equal '(64 0) (uim '(test-ignore-shift 64 test-shift-state)))  ; @
685
 
   (assert-equal '(65 0) (uim '(test-ignore-shift 65 test-shift-state)))  ; A
686
 
   (assert-equal '(90 0) (uim '(test-ignore-shift 90 test-shift-state)))  ; Z
687
 
   (assert-equal '(91 0) (uim '(test-ignore-shift 91 test-shift-state)))  ; [
688
 
   (assert-equal '(96 0) (uim '(test-ignore-shift 96 test-shift-state)))  ; `
689
 
   (assert-equal '(97 0) (uim '(test-ignore-shift 97 test-shift-state)))  ; a
690
 
   (assert-equal '(122 0) (uim '(test-ignore-shift 122 test-shift-state))); z
691
 
   (assert-equal '(123 0) (uim '(test-ignore-shift 123 test-shift-state))); {
692
 
   (assert-equal '(126 0) (uim '(test-ignore-shift 126 test-shift-state))); ~
693
 
   (assert-equal '(127 0) (uim '(test-ignore-shift 127 test-shift-state))) ; DEL
694
 
 
695
 
   (assert-equal '(0   0) (uim '(test-ignore-shift 0 0)))     ; NUL
696
 
   (assert-equal '(1   0) (uim '(test-ignore-shift 1 0)))     ; SOH
697
 
   (assert-equal '(31  0) (uim '(test-ignore-shift 31 0)))    ; US
698
 
   (assert-equal '(32  0) (uim '(test-ignore-shift 32 0)))    ; SPACE
699
 
   (assert-equal '(33  0) (uim '(test-ignore-shift 33 0)))    ; !
700
 
   (assert-equal '(47  0) (uim '(test-ignore-shift 47 0)))    ; /
701
 
   (assert-equal '(48  0) (uim '(test-ignore-shift 48 0)))    ; 0
702
 
   (assert-equal '(57  0) (uim '(test-ignore-shift 57 0)))    ; 9
703
 
   (assert-equal '(58  0) (uim '(test-ignore-shift 58 0)))    ; :
704
 
   (assert-equal '(64  0) (uim '(test-ignore-shift 64 0)))    ; @
705
 
   (assert-equal '(65  0) (uim '(test-ignore-shift 65 0)))    ; A
706
 
   (assert-equal '(90  0) (uim '(test-ignore-shift 90 0)))    ; Z
707
 
   (assert-equal '(91  0) (uim '(test-ignore-shift 91 0)))    ; [
708
 
   (assert-equal '(96  0) (uim '(test-ignore-shift 96 0)))    ; `
709
 
   (assert-equal '(97  0) (uim '(test-ignore-shift 97 0)))    ; a
710
 
   (assert-equal '(122 0) (uim '(test-ignore-shift 122 0)))   ; z
711
 
   (assert-equal '(123 0) (uim '(test-ignore-shift 123 0)))   ; {
712
 
   (assert-equal '(126 0) (uim '(test-ignore-shift 126 0)))   ; ~
713
 
   (assert-equal '(127 0) (uim '(test-ignore-shift 127 0))))  ; DEL
714
 
 
715
 
  ("test IgnoreRegularShift translator"
716
 
   (assert-equal (uim '(list 0 test-shift-state))
717
 
                 (uim '(test-ignore-regular-shift 0 test-shift-state)))   ; NUL
718
 
   (assert-equal (uim '(list 1 test-shift-state))
719
 
                 (uim '(test-ignore-regular-shift 1 test-shift-state)))   ; SOH
720
 
   (assert-equal (uim '(list 31 test-shift-state))
721
 
                 (uim '(test-ignore-regular-shift 31 test-shift-state)))  ; US
722
 
   (assert-equal (uim '(list 32 test-shift-state))
723
 
                 (uim '(test-ignore-regular-shift 32 test-shift-state)))  ; SPACE
724
 
   (assert-equal '(33 0)
725
 
                 (uim '(test-ignore-regular-shift 33 test-shift-state)))  ; !
726
 
   (assert-equal '(47 0)
727
 
                 (uim '(test-ignore-regular-shift 47 test-shift-state)))  ; /
728
 
   (assert-equal '(48 0)
729
 
                 (uim '(test-ignore-regular-shift 48 test-shift-state)))  ; 0
730
 
   (assert-equal '(57 0)
731
 
                 (uim '(test-ignore-regular-shift 57 test-shift-state)))  ; 9
732
 
   (assert-equal '(58 0)
733
 
                 (uim '(test-ignore-regular-shift 58 test-shift-state)))  ; :
734
 
   (assert-equal '(64 0)
735
 
                 (uim '(test-ignore-regular-shift 64 test-shift-state)))  ; @
736
 
   (assert-equal '(65 0)
737
 
                 (uim '(test-ignore-regular-shift 65 test-shift-state)))  ; A
738
 
   (assert-equal '(90 0)
739
 
                 (uim '(test-ignore-regular-shift 90 test-shift-state)))  ; Z
740
 
   (assert-equal '(91 0)
741
 
                 (uim '(test-ignore-regular-shift 91 test-shift-state)))  ; [
742
 
   (assert-equal '(96 0)
743
 
                 (uim '(test-ignore-regular-shift 96 test-shift-state)))  ; `
744
 
   (assert-equal '(97 0)
745
 
                 (uim '(test-ignore-regular-shift 97 test-shift-state)))  ; a
746
 
   (assert-equal '(122 0)
747
 
                 (uim '(test-ignore-regular-shift 122 test-shift-state))) ; z
748
 
   (assert-equal '(123 0)
749
 
                 (uim '(test-ignore-regular-shift 123 test-shift-state))) ; {
750
 
   (assert-equal '(126 0)
751
 
                 (uim '(test-ignore-regular-shift 126 test-shift-state))) ; ~
752
 
   (assert-equal (uim '(list 127 test-shift-state))
753
 
                 (uim '(test-ignore-regular-shift 127 test-shift-state))) ; DEL
754
 
 
755
 
   (assert-equal '(0   0) (uim '(test-ignore-regular-shift 0 0)))     ; NUL
756
 
   (assert-equal '(1   0) (uim '(test-ignore-regular-shift 1 0)))     ; SOH
757
 
   (assert-equal '(31  0) (uim '(test-ignore-regular-shift 31 0)))    ; US
758
 
   (assert-equal '(32  0) (uim '(test-ignore-regular-shift 32 0)))    ; SPACE
759
 
   (assert-equal '(33  0) (uim '(test-ignore-regular-shift 33 0)))    ; !
760
 
   (assert-equal '(47  0) (uim '(test-ignore-regular-shift 47 0)))    ; /
761
 
   (assert-equal '(48  0) (uim '(test-ignore-regular-shift 48 0)))    ; 0
762
 
   (assert-equal '(57  0) (uim '(test-ignore-regular-shift 57 0)))    ; 9
763
 
   (assert-equal '(58  0) (uim '(test-ignore-regular-shift 58 0)))    ; :
764
 
   (assert-equal '(64  0) (uim '(test-ignore-regular-shift 64 0)))    ; @
765
 
   (assert-equal '(65  0) (uim '(test-ignore-regular-shift 65 0)))    ; A
766
 
   (assert-equal '(90  0) (uim '(test-ignore-regular-shift 90 0)))    ; Z
767
 
   (assert-equal '(91  0) (uim '(test-ignore-regular-shift 91 0)))    ; [
768
 
   (assert-equal '(96  0) (uim '(test-ignore-regular-shift 96 0)))    ; `
769
 
   (assert-equal '(97  0) (uim '(test-ignore-regular-shift 97 0)))    ; a
770
 
   (assert-equal '(122 0) (uim '(test-ignore-regular-shift 122 0)))   ; z
771
 
   (assert-equal '(123 0) (uim '(test-ignore-regular-shift 123 0)))   ; {
772
 
   (assert-equal '(126 0) (uim '(test-ignore-regular-shift 126 0)))   ; ~
773
 
   (assert-equal '(127 0) (uim '(test-ignore-regular-shift 127 0))))  ; DEL
774
 
 
775
 
  ("test apply-translators"
776
 
   ;; apply single translator
777
 
   (assert-equal (uim '(list () 0 test-shift-state))
778
 
                 (uim '(apply-translators (list test-ignore-regular-shift)
779
 
                                          0 test-shift-state)))   ; NUL
780
 
   (assert-equal (uim '(list () 1 test-shift-state))
781
 
                 (uim '(apply-translators (list test-ignore-regular-shift)
782
 
                                          1 test-shift-state)))   ; SOH
783
 
   (assert-equal (uim '(list () 31 test-shift-state))
784
 
                 (uim '(apply-translators (list test-ignore-regular-shift)
785
 
                                          31 test-shift-state)))  ; US
786
 
   (assert-equal (uim '(list () 32 test-shift-state))
787
 
                 (uim '(apply-translators (list test-ignore-regular-shift)
788
 
                                          32 test-shift-state)))  ; SPACE
789
 
   (assert-equal '(() 33 0)
790
 
                 (uim '(apply-translators (list test-ignore-regular-shift)
791
 
                                          33 test-shift-state)))  ; !
792
 
   (assert-equal '(() 47 0)
793
 
                 (uim '(apply-translators (list test-ignore-regular-shift)
794
 
                                          47 test-shift-state)))  ; /
795
 
   (assert-equal '(() 48 0)
796
 
                 (uim '(apply-translators (list test-ignore-regular-shift)
797
 
                                          48 test-shift-state)))  ; 0
798
 
   (assert-equal '(() 57 0)
799
 
                 (uim '(apply-translators (list test-ignore-regular-shift)
800
 
                                          57 test-shift-state)))  ; 9
801
 
   (assert-equal '(() 58 0)
802
 
                 (uim '(apply-translators (list test-ignore-regular-shift)
803
 
                                          58 test-shift-state)))  ; :
804
 
   (assert-equal '(() 64 0)
805
 
                 (uim '(apply-translators (list test-ignore-regular-shift)
806
 
                                          64 test-shift-state)))  ; @
807
 
   (assert-equal '(() 65 0)
808
 
                 (uim '(apply-translators (list test-ignore-regular-shift)
809
 
                                          65 test-shift-state)))  ; A
810
 
   (assert-equal '(() 90 0)
811
 
                 (uim '(apply-translators (list test-ignore-regular-shift)
812
 
                                          90 test-shift-state)))  ; Z
813
 
   (assert-equal '(() 91 0)
814
 
                 (uim '(apply-translators (list test-ignore-regular-shift)
815
 
                                          91 test-shift-state)))  ; [
816
 
   (assert-equal '(() 96 0)
817
 
                 (uim '(apply-translators (list test-ignore-regular-shift)
818
 
                                          96 test-shift-state)))  ; `
819
 
   (assert-equal '(() 97 0)
820
 
                 (uim '(apply-translators (list test-ignore-regular-shift)
821
 
                                          97 test-shift-state)))  ; a
822
 
   (assert-equal '(() 122 0)
823
 
                 (uim '(apply-translators (list test-ignore-regular-shift)
824
 
                                          122 test-shift-state))) ; z
825
 
   (assert-equal '(() 123 0)
826
 
                 (uim '(apply-translators (list test-ignore-regular-shift)
827
 
                                          123 test-shift-state))) ; {
828
 
   (assert-equal '(() 126 0)
829
 
                 (uim '(apply-translators (list test-ignore-regular-shift)
830
 
                                          126 test-shift-state))) ; ~
831
 
   (assert-equal (uim '(list () 127 test-shift-state))
832
 
                 (uim '(apply-translators (list test-ignore-regular-shift)
833
 
                                          127 test-shift-state))) ; DEL
834
 
 
835
 
   ;; apply multiple translator
836
 
   (assert-equal (uim '(list () 0 test-shift-state))
837
 
                 (uim '(apply-translators (list test-ignore-regular-shift
838
 
                                                test-ignore-case)
839
 
                                          0 test-shift-state)))   ; NUL
840
 
   (assert-equal (uim '(list () 1 test-shift-state))
841
 
                 (uim '(apply-translators (list test-ignore-regular-shift
842
 
                                                test-ignore-case)
843
 
                                          1 test-shift-state)))   ; SOH
844
 
   (assert-equal (uim '(list () 31 test-shift-state))
845
 
                 (uim '(apply-translators (list test-ignore-regular-shift
846
 
                                                test-ignore-case)
847
 
                                          31 test-shift-state)))  ; US
848
 
   (assert-equal (uim '(list () 32 test-shift-state))
849
 
                 (uim '(apply-translators (list test-ignore-regular-shift
850
 
                                                test-ignore-case)
851
 
                                          32 test-shift-state)))  ; SPACE
852
 
   (assert-equal '(() 33 0)
853
 
                 (uim '(apply-translators (list test-ignore-regular-shift
854
 
                                                test-ignore-case)
855
 
                                          33 test-shift-state)))  ; !
856
 
   (assert-equal '(() 47 0)
857
 
                 (uim '(apply-translators (list test-ignore-regular-shift
858
 
                                                test-ignore-case)
859
 
                                          47 test-shift-state)))  ; /
860
 
   (assert-equal '(() 48 0)
861
 
                 (uim '(apply-translators (list test-ignore-regular-shift
862
 
                                                test-ignore-case)
863
 
                                          48 test-shift-state)))  ; 0
864
 
   (assert-equal '(() 57 0)
865
 
                 (uim '(apply-translators (list test-ignore-regular-shift
866
 
                                                test-ignore-case)
867
 
                                          57 test-shift-state)))  ; 9
868
 
   (assert-equal '(() 58 0)
869
 
                 (uim '(apply-translators (list test-ignore-regular-shift
870
 
                                                test-ignore-case)
871
 
                                          58 test-shift-state)))  ; :
872
 
   (assert-equal '(() 64 0)
873
 
                 (uim '(apply-translators (list test-ignore-regular-shift
874
 
                                                test-ignore-case)
875
 
                                          64 test-shift-state)))  ; @
876
 
   (assert-equal '(() 97 0)
877
 
                 (uim '(apply-translators (list test-ignore-regular-shift
878
 
                                                test-ignore-case)
879
 
                                          65 test-shift-state)))  ; A
880
 
   (assert-equal '(() 122 0)
881
 
                 (uim '(apply-translators (list test-ignore-regular-shift
882
 
                                                test-ignore-case)
883
 
                                          90 test-shift-state)))  ; Z
884
 
   (assert-equal '(() 91 0)
885
 
                 (uim '(apply-translators (list test-ignore-regular-shift
886
 
                                                test-ignore-case)
887
 
                                          91 test-shift-state)))  ; [
888
 
   (assert-equal '(() 96 0)
889
 
                 (uim '(apply-translators (list test-ignore-regular-shift
890
 
                                                test-ignore-case)
891
 
                                          96 test-shift-state)))  ; `
892
 
   (assert-equal '(() 97 0)
893
 
                 (uim '(apply-translators (list test-ignore-regular-shift
894
 
                                                test-ignore-case)
895
 
                                          97 test-shift-state)))  ; a
896
 
   (assert-equal '(() 122 0)
897
 
                 (uim '(apply-translators (list test-ignore-regular-shift
898
 
                                                test-ignore-case)
899
 
                                          122 test-shift-state))) ; z
900
 
   (assert-equal '(() 123 0)
901
 
                 (uim '(apply-translators (list test-ignore-regular-shift
902
 
                                                test-ignore-case)
903
 
                                          123 test-shift-state))) ; {
904
 
   (assert-equal '(() 126 0)
905
 
                 (uim '(apply-translators (list test-ignore-regular-shift
906
 
                                                test-ignore-case)
907
 
                                          126 test-shift-state))) ; ~
908
 
   (assert-equal (uim '(list () 127 test-shift-state))
909
 
                 (uim '(apply-translators (list test-ignore-regular-shift
910
 
                                                test-ignore-case)
911
 
                                          127 test-shift-state))))) ; DEL
912
 
 
913
 
(define-uim-test-case "test key key-predicates"
914
 
  (setup
915
 
   (lambda ()
916
 
     (uim '(define test-shift-state (cdr (assq 'Shift_key key-state-alist))))
917
 
     (uim '(define test-control-state (cdr (assq 'Control_key key-state-alist))))
918
 
     (uim '(define test-alt-state (cdr (assq 'Alt_key key-state-alist))))
919
 
     (uim '(define test-meta-state (cdr (assq 'Meta_key key-state-alist))))
920
 
     (uim '(define test-super-state (cdr (assq 'Super_key key-state-alist))))
921
 
     (uim '(define test-hyper-state (cdr (assq 'Hyper_key key-state-alist))))))
922
 
 
923
 
  ("test make-single-key-predicate"
924
 
   ;; null key-str matches with nothing
925
 
   (assert-false (uim-bool '((make-single-key-predicate "")
926
 
                             0 0)))    ; NUL
927
 
   (assert-false (uim-bool '((make-single-key-predicate "")
928
 
                             1 0)))    ; SOH
929
 
   (assert-false (uim-bool '((make-single-key-predicate "")
930
 
                             31 0)))   ; US
931
 
   (assert-false (uim-bool '((make-single-key-predicate "")
932
 
                             32 0)))   ; SPACE
933
 
   (assert-false (uim-bool '((make-single-key-predicate "")
934
 
                             33 0)))   ; !
935
 
   (assert-false (uim-bool '((make-single-key-predicate "")
936
 
                             48 0)))   ; 0
937
 
   (assert-false (uim-bool '((make-single-key-predicate "")
938
 
                             65 0)))   ; A
939
 
   (assert-false (uim-bool '((make-single-key-predicate "")
940
 
                             97 0)))   ; a
941
 
   (assert-false (uim-bool '((make-single-key-predicate "")
942
 
                             127 0)))  ; DEL
943
 
   (assert-false (uim-bool '((make-single-key-predicate "")
944
 
                             'return 0)))  ; return
945
 
   ;; space
946
 
   (assert-true  (uim-bool '((make-single-key-predicate " ")
947
 
                             32 0)))   ; SPACE
948
 
   (assert-false (uim-bool '((make-single-key-predicate " ")
949
 
                             33 0)))   ; !
950
 
   (assert-false (uim-bool '((make-single-key-predicate " ")
951
 
                             48 0)))   ; 0
952
 
   (assert-false (uim-bool '((make-single-key-predicate " ")
953
 
                             65 0)))   ; A
954
 
   (assert-false (uim-bool '((make-single-key-predicate " ")
955
 
                             97 0)))   ; a
956
 
   (assert-false (uim-bool '((make-single-key-predicate " ")
957
 
                             'return 0)))  ; return
958
 
   ;; !
959
 
   (assert-false (uim-bool '((make-single-key-predicate "!")
960
 
                             32 0)))   ; SPACE
961
 
   (assert-true  (uim-bool '((make-single-key-predicate "!")
962
 
                             33 0)))   ; !
963
 
   (assert-false (uim-bool '((make-single-key-predicate "!")
964
 
                             48 0)))   ; 0
965
 
   (assert-false (uim-bool '((make-single-key-predicate "!")
966
 
                             65 0)))   ; A
967
 
   (assert-false (uim-bool '((make-single-key-predicate "!")
968
 
                             97 0)))   ; a
969
 
   (assert-false (uim-bool '((make-single-key-predicate "!")
970
 
                             'return 0)))  ; return
971
 
   ;; 0
972
 
   (assert-false (uim-bool '((make-single-key-predicate "0")
973
 
                             32 0)))   ; SPACE
974
 
   (assert-false (uim-bool '((make-single-key-predicate "0")
975
 
                             33 0)))   ; !
976
 
   (assert-true  (uim-bool '((make-single-key-predicate "0")
977
 
                             48 0)))   ; 0
978
 
   (assert-false (uim-bool '((make-single-key-predicate "0")
979
 
                             65 0)))   ; A
980
 
   (assert-false (uim-bool '((make-single-key-predicate "0")
981
 
                             97 0)))   ; a
982
 
   (assert-false (uim-bool '((make-single-key-predicate "0")
983
 
                             'return 0)))  ; return
984
 
   ;; A
985
 
   (assert-false (uim-bool '((make-single-key-predicate "A")
986
 
                             32 0)))   ; SPACE
987
 
   (assert-false (uim-bool '((make-single-key-predicate "A")
988
 
                             33 0)))   ; !
989
 
   (assert-false (uim-bool '((make-single-key-predicate "A")
990
 
                             48 0)))   ; 0
991
 
   (assert-true  (uim-bool '((make-single-key-predicate "A")
992
 
                             65 0)))   ; A
993
 
   (assert-false (uim-bool '((make-single-key-predicate "A")
994
 
                             97 0)))   ; a
995
 
   (assert-false (uim-bool '((make-single-key-predicate "A")
996
 
                             'return 0)))  ; return
997
 
   ;; a
998
 
   (assert-false (uim-bool '((make-single-key-predicate "a")
999
 
                             32 0)))   ; SPACE
1000
 
   (assert-false (uim-bool '((make-single-key-predicate "a")
1001
 
                             33 0)))   ; !
1002
 
   (assert-false (uim-bool '((make-single-key-predicate "a")
1003
 
                             48 0)))   ; 0
1004
 
   (assert-false (uim-bool '((make-single-key-predicate "a")
1005
 
                             65 0)))   ; A
1006
 
   (assert-true  (uim-bool '((make-single-key-predicate "a")
1007
 
                             97 0)))   ; a
1008
 
   (assert-false (uim-bool '((make-single-key-predicate "a")
1009
 
                             'return 0)))  ; return
1010
 
   ;; return
1011
 
   (assert-false (uim-bool '((make-single-key-predicate "return")
1012
 
                             32 0)))   ; SPACE
1013
 
   (assert-false (uim-bool '((make-single-key-predicate "return")
1014
 
                             33 0)))   ; !
1015
 
   (assert-false (uim-bool '((make-single-key-predicate "return")
1016
 
                             48 0)))   ; 0
1017
 
   (assert-false (uim-bool '((make-single-key-predicate "return")
1018
 
                             65 0)))   ; A
1019
 
   (assert-false (uim-bool '((make-single-key-predicate "return")
1020
 
                             97 0)))   ; a
1021
 
   (assert-true  (uim-bool '((make-single-key-predicate "return")
1022
 
                             'return 0)))  ; return
1023
 
 
1024
 
   ;; single key with single modifier (success)
1025
 
   (assert-true  (uim-bool '((make-single-key-predicate "<Shift> ")
1026
 
                             32 test-shift-state)))   ; SPACE
1027
 
   (assert-true  (uim-bool '((make-single-key-predicate "<Shift>!")
1028
 
                             33 test-shift-state)))   ; !
1029
 
   (assert-true  (uim-bool '((make-single-key-predicate "<Shift>0")
1030
 
                             48 test-shift-state)))   ; 0
1031
 
   (assert-true  (uim-bool '((make-single-key-predicate "<Shift>A")
1032
 
                             65 test-shift-state)))   ; A
1033
 
   (assert-true  (uim-bool '((make-single-key-predicate "<Shift>a")
1034
 
                             97 test-shift-state)))   ; a
1035
 
   (assert-true  (uim-bool '((make-single-key-predicate "<Shift>return")
1036
 
                             'return test-shift-state)))  ; return
1037
 
   ;; single key with single modifier (fail)
1038
 
   (assert-false (uim-bool '((make-single-key-predicate "<Shift> ")
1039
 
                             32 0)))   ; SPACE
1040
 
   (assert-false (uim-bool '((make-single-key-predicate "<Shift>!")
1041
 
                             33 0)))   ; !
1042
 
   (assert-false (uim-bool '((make-single-key-predicate "<Shift>0")
1043
 
                             48 0)))   ; 0
1044
 
   (assert-false (uim-bool '((make-single-key-predicate "<Shift>A")
1045
 
                             65 0)))   ; A
1046
 
   (assert-false (uim-bool '((make-single-key-predicate "<Shift>a")
1047
 
                             97 0)))   ; a
1048
 
   (assert-false (uim-bool '((make-single-key-predicate "<Shift>return")
1049
 
                             'return 0)))  ; return
1050
 
   (assert-false (uim-bool '((make-single-key-predicate "<Shift> ")
1051
 
                             32 test-control-state)))   ; SPACE
1052
 
   (assert-false (uim-bool '((make-single-key-predicate "<Shift>!")
1053
 
                             33 test-control-state)))   ; !
1054
 
   (assert-false (uim-bool '((make-single-key-predicate "<Shift>0")
1055
 
                             48 test-control-state)))   ; 0
1056
 
   (assert-false (uim-bool '((make-single-key-predicate "<Shift>A")
1057
 
                             65 test-control-state)))   ; A
1058
 
   (assert-false (uim-bool '((make-single-key-predicate "<Shift>a")
1059
 
                             97 test-control-state)))   ; a
1060
 
   (assert-false (uim-bool '((make-single-key-predicate "<Shift>return")
1061
 
                             'return test-control-state)))  ; return
1062
 
 
1063
 
   ;; single key with multiple modifier (success)
1064
 
   (assert-true  (uim-bool '((make-single-key-predicate "<Shift><Control> ")
1065
 
                             32 (+ test-shift-state   ; SPACE
1066
 
                                   test-control-state))))
1067
 
   (assert-true  (uim-bool '((make-single-key-predicate "<Shift><Control>!")
1068
 
                             33 (+ test-shift-state   ; !
1069
 
                                   test-control-state))))
1070
 
   (assert-true  (uim-bool '((make-single-key-predicate "<Shift><Control>0")
1071
 
                             48 (+ test-shift-state   ; 0
1072
 
                                   test-control-state))))
1073
 
   (assert-true  (uim-bool '((make-single-key-predicate "<Shift><Control>A")
1074
 
                             65 (+ test-shift-state   ; A
1075
 
                                   test-control-state))))
1076
 
   (assert-true  (uim-bool '((make-single-key-predicate "<Shift><Control>a")
1077
 
                             97 (+ test-shift-state   ; a
1078
 
                                   test-control-state))))
1079
 
   (assert-true  (uim-bool '((make-single-key-predicate "<Shift><Control>return")
1080
 
                             'return (+ test-shift-state  ; return
1081
 
                                        test-control-state))))
1082
 
   ;; single key with multiple modifier (fail)
1083
 
   (assert-false (uim-bool '((make-single-key-predicate "<Shift><Control> ")
1084
 
                             32 0)))   ; SPACE
1085
 
   (assert-false (uim-bool '((make-single-key-predicate "<Shift><Control>!")
1086
 
                             33 0)))   ; !
1087
 
   (assert-false (uim-bool '((make-single-key-predicate "<Shift><Control>0")
1088
 
                             48 0)))   ; 0
1089
 
   (assert-false (uim-bool '((make-single-key-predicate "<Shift><Control>A")
1090
 
                             65 0)))   ; A
1091
 
   (assert-false (uim-bool '((make-single-key-predicate "<Shift><Control>a")
1092
 
                             97 0)))   ; a
1093
 
   (assert-false (uim-bool '((make-single-key-predicate "<Shift><Control>return")
1094
 
                             'return 0)))  ; return
1095
 
   (assert-false (uim-bool '((make-single-key-predicate "<Shift><Control> ")
1096
 
                             32 test-control-state)))   ; SPACE
1097
 
   (assert-false (uim-bool '((make-single-key-predicate "<Shift><Control>!")
1098
 
                             33 test-control-state)))   ; !
1099
 
   (assert-false (uim-bool '((make-single-key-predicate "<Shift><Control>0")
1100
 
                             48 test-control-state)))   ; 0
1101
 
   (assert-false (uim-bool '((make-single-key-predicate "<Shift><Control>A")
1102
 
                             65 test-control-state)))   ; A
1103
 
   (assert-false (uim-bool '((make-single-key-predicate "<Shift><Control>a")
1104
 
                             97 test-control-state)))   ; a
1105
 
   (assert-false (uim-bool '((make-single-key-predicate "<Shift><Control>return")
1106
 
                             'return test-control-state)))  ; return
1107
 
 
1108
 
   ;; single key with single translator
1109
 
   (assert-false (uim-bool '((make-single-key-predicate "<IgnoreRegularShift> ")
1110
 
                             32 test-shift-state)))   ; SPACE
1111
 
   (assert-true  (uim-bool '((make-single-key-predicate "<IgnoreRegularShift>!")
1112
 
                             33 test-shift-state)))   ; !
1113
 
   (assert-true  (uim-bool '((make-single-key-predicate "<IgnoreRegularShift>0")
1114
 
                             48 test-shift-state)))   ; 0
1115
 
   (assert-true  (uim-bool '((make-single-key-predicate "<IgnoreRegularShift>A")
1116
 
                             65 test-shift-state)))   ; A
1117
 
   (assert-true  (uim-bool '((make-single-key-predicate "<IgnoreRegularShift>a")
1118
 
                             97 test-shift-state)))   ; a
1119
 
   (assert-false (uim-bool '((make-single-key-predicate "<IgnoreRegularShift>return")
1120
 
                             'return test-shift-state)))  ; return
1121
 
   (assert-true  (uim-bool '((make-single-key-predicate "<IgnoreRegularShift> ")
1122
 
                             32 0)))   ; SPACE
1123
 
   (assert-true  (uim-bool '((make-single-key-predicate "<IgnoreRegularShift>!")
1124
 
                             33 0)))   ; !
1125
 
   (assert-true  (uim-bool '((make-single-key-predicate "<IgnoreRegularShift>0")
1126
 
                             48 0)))   ; 0
1127
 
   (assert-true  (uim-bool '((make-single-key-predicate "<IgnoreRegularShift>A")
1128
 
                             65 0)))   ; A
1129
 
   (assert-true  (uim-bool '((make-single-key-predicate "<IgnoreRegularShift>a")
1130
 
                             97 0)))   ; a
1131
 
   (assert-true  (uim-bool '((make-single-key-predicate "<IgnoreRegularShift>return")
1132
 
                             'return 0)))  ; return
1133
 
   (assert-false (uim-bool '((make-single-key-predicate "<IgnoreRegularShift> ")
1134
 
                             32 test-control-state)))   ; SPACE
1135
 
   (assert-false (uim-bool '((make-single-key-predicate "<IgnoreRegularShift>!")
1136
 
                             33 test-control-state)))   ; !
1137
 
   (assert-false (uim-bool '((make-single-key-predicate "<IgnoreRegularShift>0")
1138
 
                             48 test-control-state)))   ; 0
1139
 
   (assert-false (uim-bool '((make-single-key-predicate "<IgnoreRegularShift>A")
1140
 
                             65 test-control-state)))   ; A
1141
 
   (assert-false (uim-bool '((make-single-key-predicate "<IgnoreRegularShift>a")
1142
 
                             97 test-control-state)))   ; a
1143
 
   (assert-false (uim-bool '((make-single-key-predicate "<IgnoreRegularShift>return")
1144
 
                             'return test-control-state)))  ; return
1145
 
 
1146
 
   ;; single key with single translator and single modifier
1147
 
   (assert-true  (uim-bool '((make-single-key-predicate "<IgnoreRegularShift><Shift> ")
1148
 
                             32 test-shift-state)))   ; SPACE
1149
 
   (assert-true  (uim-bool '((make-single-key-predicate "<IgnoreRegularShift><Shift>!")
1150
 
                             33 test-shift-state)))   ; !
1151
 
   (assert-true  (uim-bool '((make-single-key-predicate "<IgnoreRegularShift><Shift>0")
1152
 
                             48 test-shift-state)))   ; 0
1153
 
   (assert-true  (uim-bool '((make-single-key-predicate "<IgnoreRegularShift><Shift>A")
1154
 
                             65 test-shift-state)))   ; A
1155
 
   (assert-true  (uim-bool '((make-single-key-predicate "<IgnoreRegularShift><Shift>a")
1156
 
                             97 test-shift-state)))   ; a
1157
 
   (assert-true  (uim-bool '((make-single-key-predicate "<IgnoreRegularShift><Shift>return")
1158
 
                             'return test-shift-state)))  ; return
1159
 
   (assert-false (uim-bool '((make-single-key-predicate "<IgnoreRegularShift><Shift> ")
1160
 
                             32 0)))   ; SPACE
1161
 
   (assert-true  (uim-bool '((make-single-key-predicate "<IgnoreRegularShift><Shift>!")
1162
 
                             33 0)))   ; !
1163
 
   (assert-true  (uim-bool '((make-single-key-predicate "<IgnoreRegularShift><Shift>0")
1164
 
                             48 0)))   ; 0
1165
 
   (assert-true  (uim-bool '((make-single-key-predicate "<IgnoreRegularShift><Shift>A")
1166
 
                             65 0)))   ; A
1167
 
   (assert-true  (uim-bool '((make-single-key-predicate "<IgnoreRegularShift><Shift>a")
1168
 
                             97 0)))   ; a
1169
 
   (assert-false (uim-bool '((make-single-key-predicate "<IgnoreRegularShift><Shift>return")
1170
 
                             'return 0)))  ; return
1171
 
   (assert-false (uim-bool '((make-single-key-predicate "<IgnoreRegularShift><Shift> ")
1172
 
                             32 test-control-state)))   ; SPACE
1173
 
   (assert-false (uim-bool '((make-single-key-predicate "<IgnoreRegularShift><Shift>!")
1174
 
                             33 test-control-state)))   ; !
1175
 
   (assert-false (uim-bool '((make-single-key-predicate "<IgnoreRegularShift><Shift>0")
1176
 
                             48 test-control-state)))   ; 0
1177
 
   (assert-false (uim-bool '((make-single-key-predicate "<IgnoreRegularShift><Shift>A")
1178
 
                             65 test-control-state)))   ; A
1179
 
   (assert-false (uim-bool '((make-single-key-predicate "<IgnoreRegularShift><Shift>a")
1180
 
                             97 test-control-state)))   ; a
1181
 
   (assert-false (uim-bool '((make-single-key-predicate "<IgnoreRegularShift><Shift>return")
1182
 
                             'return test-control-state)))  ; return
1183
 
 
1184
 
   (uim '(define test-return-key? #f))
1185
 
   (uim '(begin (set! test-return-key? (make-single-key-predicate
1186
 
                                        "<IgnoreRegularShift><Shift>return"))
1187
 
                #t)) ;; supress closure result
1188
 
 
1189
 
   ;; make up from preexisting predicate
1190
 
   (assert-true  (uim-bool '((make-single-key-predicate test-return-key?)
1191
 
                             'return test-shift-state)))  ; return
1192
 
   (assert-false (uim-bool '((make-single-key-predicate test-return-key?)
1193
 
                             'return 0)))  ; return
1194
 
 
1195
 
   ;; make up from preexisting predicate symbol
1196
 
   (assert-true  (uim-bool '((make-single-key-predicate 'test-return-key?)
1197
 
                             'return test-shift-state)))  ; return
1198
 
   (assert-false (uim-bool '((make-single-key-predicate 'test-return-key?)
1199
 
                             'return 0))))  ; return
1200
 
 
1201
 
  ("test make-key-predicate"
1202
 
   (uim '(define test-return-key? #f))
1203
 
   (uim '(begin (set! test-return-key? (make-single-key-predicate
1204
 
                                        "<IgnoreRegularShift><Shift>return"))
1205
 
                #t)) ;; supress closure result
1206
 
 
1207
 
   (uim '(define test-a-key? #f))
1208
 
   (uim '(begin (set! test-a-key? (make-single-key-predicate "a"))
1209
 
                #t)) ;; supress closure result
1210
 
 
1211
 
   ;; make up from key-str
1212
 
   (assert-true  (uim-bool '((make-key-predicate
1213
 
                              "<IgnoreRegularShift><Shift>return")
1214
 
                             'return test-shift-state)))  ; return
1215
 
   (assert-false (uim-bool '((make-key-predicate
1216
 
                              "<IgnoreRegularShift><Shift>return")
1217
 
                             'return 0)))  ; return
1218
 
 
1219
 
   ;; make up from preexisting predicate
1220
 
   (assert-true  (uim-bool '((make-key-predicate test-return-key?)
1221
 
                             'return test-shift-state)))  ; return
1222
 
   (assert-false (uim-bool '((make-key-predicate test-return-key?)
1223
 
                             'return 0)))  ; return
1224
 
 
1225
 
   ;; make up from preexisting predicate symbol
1226
 
   (assert-true  (uim-bool '((make-key-predicate 'test-return-key?)
1227
 
                             'return test-shift-state)))  ; return
1228
 
   (assert-false (uim-bool '((make-key-predicate 'test-return-key?)
1229
 
                             'return 0)))  ; return
1230
 
 
1231
 
   ;; make up from key-str in a list
1232
 
   (assert-true  (uim-bool '((make-key-predicate
1233
 
                              '("<IgnoreRegularShift><Shift>return"))
1234
 
                             'return test-shift-state)))  ; return
1235
 
   (assert-false (uim-bool '((make-key-predicate
1236
 
                              '("<IgnoreRegularShift><Shift>return"))
1237
 
                             'return 0)))  ; return
1238
 
 
1239
 
   ;; make up from preexisting predicate in a list
1240
 
   (assert-true  (uim-bool '((make-key-predicate (list test-return-key?))
1241
 
                             'return test-shift-state)))  ; return
1242
 
   (assert-false (uim-bool '((make-key-predicate (list test-return-key?))
1243
 
                             'return 0)))  ; return
1244
 
 
1245
 
   ;; make up from preexisting predicate symbol in a list
1246
 
   (assert-true  (uim-bool '((make-key-predicate '(test-return-key?))
1247
 
                             'return test-shift-state)))  ; return
1248
 
   (assert-false (uim-bool '((make-key-predicate '(test-return-key?))
1249
 
                             'return 0)))  ; return
1250
 
 
1251
 
   ;; make up from or'ed predicates (success)
1252
 
   (assert-true  (uim-bool '((make-key-predicate (list
1253
 
                                                  test-a-key?
1254
 
                                                  'test-return-key?
1255
 
                                                  "<Control>b"))
1256
 
                             'return test-shift-state)))  ; return
1257
 
   (assert-true  (uim-bool '((make-key-predicate (list
1258
 
                                                  test-a-key?
1259
 
                                                  'test-return-key?
1260
 
                                                  "<Control>b"))
1261
 
                             97 0)))  ; a
1262
 
   (assert-true  (uim-bool '((make-key-predicate (list
1263
 
                                                  test-a-key?
1264
 
                                                  'test-return-key?
1265
 
                                                  "<Control>b"))
1266
 
                             98 test-control-state)))  ; b
1267
 
   ;; make up from or'ed predicates (fail)
1268
 
   (assert-false (uim-bool '((make-key-predicate (list
1269
 
                                                  test-a-key?
1270
 
                                                  'test-return-key?
1271
 
                                                  "<Control>b"))
1272
 
                             'return 0)))  ; return
1273
 
   (assert-false (uim-bool '((make-key-predicate (list
1274
 
                                                  test-a-key?
1275
 
                                                  'test-return-key?
1276
 
                                                  "<Control>b"))
1277
 
                             97 test-shift-state)))  ; a
1278
 
   (assert-false (uim-bool '((make-key-predicate (list
1279
 
                                                  test-a-key?
1280
 
                                                  'test-return-key?
1281
 
                                                  "<Control>b"))
1282
 
                             98 0))))  ; b
1283
 
 
1284
 
  ("test modify-key-strs-implicitly"
1285
 
   (assert-equal "<IgnoreRegularShift>return"
1286
 
                 (uim '(modify-key-strs-implicitly "return")))
1287
 
   (assert-equal '("<IgnoreRegularShift>return")
1288
 
                 (uim '(modify-key-strs-implicitly '("return"))))
1289
 
   (assert-equal '("<IgnoreRegularShift>return"
1290
 
                   "<IgnoreRegularShift>a"
1291
 
                   "<IgnoreRegularShift><Shift>b")
1292
 
                 (uim '(modify-key-strs-implicitly '("return" "a" "<Shift>b"))))
1293
 
   (assert-equal '("<IgnoreRegularShift>return"
1294
 
                   "<IgnoreRegularShift>a"
1295
 
                   foo
1296
 
                   "<IgnoreRegularShift><Shift>b")
1297
 
                 (uim '(modify-key-strs-implicitly '("return"
1298
 
                                                     "a"
1299
 
                                                     foo
1300
 
                                                     "<Shift>b")))))
1301
 
 
1302
 
  ("test define-key-internal"
1303
 
   (assert-false (uim-bool '(symbol-bound? 'test-foo-key?)))
1304
 
   (uim '(begin
1305
 
           (define-key-internal 'test-foo-key? "<Shift>return")
1306
 
           (define-key-internal 'test-bar-key? "<Shift>a")
1307
 
           (define-key-internal 'test-baz-key? "b")
1308
 
           (define test-explicit-bar-key? (make-key-predicate "<Shift>a"))
1309
 
           (define-key-internal 'test-quux-key? (list
1310
 
                                                 test-foo-key?
1311
 
                                                 'test-explicit-bar-key?
1312
 
                                                 "b"))
1313
 
           #t))
1314
 
   (assert-true  (uim-bool '(symbol-bound? 'test-foo-key?)))
1315
 
   ;; implicit <IgnoreRegularShift> not affects to 'return
1316
 
   (assert-true  (uim-bool '(test-foo-key? 'return test-shift-state)))
1317
 
   (assert-false (uim-bool '(test-foo-key? 'return 0)))
1318
 
   (assert-false (uim-bool '(test-foo-key? 'return test-control-state)))
1319
 
   ;; always matches by implicit <IgnoreRegularShift>
1320
 
   (assert-true  (uim-bool '(test-bar-key? 97 test-shift-state)))
1321
 
   (assert-true  (uim-bool '(test-bar-key? 97 0)))
1322
 
   (assert-false (uim-bool '(test-bar-key? 97 test-control-state)))
1323
 
   ;; always matches by implicit <IgnoreRegularShift>
1324
 
   (assert-true  (uim-bool '(test-baz-key? 98 test-shift-state)))
1325
 
   (assert-true  (uim-bool '(test-baz-key? 98 0)))
1326
 
   (assert-false (uim-bool '(test-baz-key? 98 test-control-state)))
1327
 
 
1328
 
   ;; implicit <IgnoreRegularShift> not affects to test-foo-key?
1329
 
   (assert-true  (uim-bool '(test-quux-key? 'return test-shift-state)))
1330
 
   (assert-false (uim-bool '(test-quux-key? 'return 0)))
1331
 
   (assert-false (uim-bool '(test-quux-key? 'return test-control-state)))
1332
 
   ;;  implicit <IgnoreRegularShift> not affects to 'test-explicit-bar-key?
1333
 
   (assert-true  (uim-bool '(test-quux-key? 97 test-shift-state)))
1334
 
   (assert-false (uim-bool '(test-quux-key? 97 0)))
1335
 
   (assert-false (uim-bool '(test-quux-key? 97 test-control-state)))
1336
 
   ;; always matches by implicit <IgnoreRegularShift>
1337
 
   (assert-true  (uim-bool '(test-quux-key? 98 test-shift-state)))
1338
 
   (assert-true  (uim-bool '(test-quux-key? 98 0)))
1339
 
   (assert-false (uim-bool '(test-quux-key? 98 test-control-state))))
1340
 
 
1341
 
  ("test valid-key-str?"
1342
 
   ;; null key fails
1343
 
   (assert-false (uim-bool '(valid-key-str? "")))
1344
 
 
1345
 
   ;; invalid key definitions
1346
 
   (assert-false  (uim-bool '(valid-key-str? "nonexistent")))
1347
 
   (assert-false  (uim-bool '(valid-key-str? "<Shift>nonexistent")))
1348
 
   (assert-false  (uim-bool '(valid-key-str? "<Nonexistent>a")))
1349
 
   (assert-false  (uim-bool '(valid-key-str? "<Nonexistent>nonexistent")))
1350
 
   (assert-false  (uim-bool '(valid-key-str? "<Nonexistent><Shift>a")))
1351
 
   (assert-false  (uim-bool '(valid-key-str? "<Nonexistent><Shift>nonexistent")))
1352
 
 
1353
 
   (assert-false  (uim-bool '(valid-key-str? "nonexistent")))
1354
 
   (assert-false  (uim-bool '(valid-key-str? "S-nonexistent")))
1355
 
   (assert-false  (uim-bool '(valid-key-str? "N-a")))
1356
 
   (assert-false  (uim-bool '(valid-key-str? "N-nonexistent")))
1357
 
   (assert-false  (uim-bool '(valid-key-str? "N-S-a")))
1358
 
   (assert-false  (uim-bool '(valid-key-str? "N-S-nonexistent")))
1359
 
 
1360
 
   ;; single key
1361
 
   (assert-true  (uim-bool '(valid-key-str? " ")))
1362
 
   (assert-true  (uim-bool '(valid-key-str? "!")))
1363
 
   (assert-true  (uim-bool '(valid-key-str? "0")))
1364
 
   (assert-true  (uim-bool '(valid-key-str? "A")))
1365
 
   (assert-true  (uim-bool '(valid-key-str? "a")))
1366
 
   (assert-true  (uim-bool '(valid-key-str? "return")))
1367
 
 
1368
 
   ;; single key with single modifier
1369
 
   (assert-true  (uim-bool '(valid-key-str? "<Shift> ")))
1370
 
   (assert-true  (uim-bool '(valid-key-str? "<Shift>!")))
1371
 
   (assert-true  (uim-bool '(valid-key-str? "<Shift>0")))
1372
 
   (assert-true  (uim-bool '(valid-key-str? "<Shift>A")))
1373
 
   (assert-true  (uim-bool '(valid-key-str? "<Shift>a")))
1374
 
   (assert-true  (uim-bool '(valid-key-str? "<Shift>return")))
1375
 
   (assert-true  (uim-bool '(valid-key-str? "<Control>return")))
1376
 
   (assert-true  (uim-bool '(valid-key-str? "<Alt>return")))
1377
 
   (assert-true  (uim-bool '(valid-key-str? "<Meta>return")))
1378
 
   (assert-true  (uim-bool '(valid-key-str? "<Super>return")))
1379
 
   (assert-true  (uim-bool '(valid-key-str? "<Hyper>return")))
1380
 
 
1381
 
   (assert-true  (uim-bool '(valid-key-str? "S- ")))
1382
 
   (assert-true  (uim-bool '(valid-key-str? "S-!")))
1383
 
   (assert-true  (uim-bool '(valid-key-str? "S-0")))
1384
 
   (assert-true  (uim-bool '(valid-key-str? "S-A")))
1385
 
   (assert-true  (uim-bool '(valid-key-str? "S-a")))
1386
 
   (assert-true  (uim-bool '(valid-key-str? "S-return")))
1387
 
   (assert-true  (uim-bool '(valid-key-str? "C-return")))
1388
 
   (assert-true  (uim-bool '(valid-key-str? "A-return")))
1389
 
   (assert-true  (uim-bool '(valid-key-str? "M-return")))
1390
 
   (assert-true  (uim-bool '(valid-key-str? "S-return")))
1391
 
   (assert-true  (uim-bool '(valid-key-str? "H-return")))
1392
 
 
1393
 
   ;; single key with multiple modifiers
1394
 
   (assert-true  (uim-bool '(valid-key-str? "<Shift><Control><Meta> ")))
1395
 
   (assert-true  (uim-bool '(valid-key-str? "<Shift><Control><Meta>!")))
1396
 
   (assert-true  (uim-bool '(valid-key-str? "<Shift><Control><Meta>0")))
1397
 
   (assert-true  (uim-bool '(valid-key-str? "<Shift><Control><Meta>A")))
1398
 
   (assert-true  (uim-bool '(valid-key-str? "<Shift><Control><Meta>a")))
1399
 
   (assert-true  (uim-bool '(valid-key-str? "<Shift><Control><Meta>return")))
1400
 
 
1401
 
   (assert-true  (uim-bool '(valid-key-str? "S-C-M- ")))
1402
 
   (assert-true  (uim-bool '(valid-key-str? "S-C-M-!")))
1403
 
   (assert-true  (uim-bool '(valid-key-str? "S-C-M-0")))
1404
 
   (assert-true  (uim-bool '(valid-key-str? "S-C-M-A")))
1405
 
   (assert-true  (uim-bool '(valid-key-str? "S-C-M-a")))
1406
 
   (assert-true  (uim-bool '(valid-key-str? "S-C-M-return")))
1407
 
 
1408
 
   ;; single key with single translator
1409
 
   (assert-true  (uim-bool '(valid-key-str? "<IgnoreShift> ")))
1410
 
   (assert-true  (uim-bool '(valid-key-str? "<IgnoreShift>!")))
1411
 
   (assert-true  (uim-bool '(valid-key-str? "<IgnoreShift>0")))
1412
 
   (assert-true  (uim-bool '(valid-key-str? "<IgnoreShift>A")))
1413
 
   (assert-true  (uim-bool '(valid-key-str? "<IgnoreShift>a")))
1414
 
   (assert-true  (uim-bool '(valid-key-str? "<IgnoreShift>return")))
1415
 
   (assert-true  (uim-bool '(valid-key-str? "<IgnoreRegularShift>return")))
1416
 
   (assert-true  (uim-bool '(valid-key-str? "<IgnoreCase>return")))
1417
 
 
1418
 
   (assert-true  (uim-bool '(valid-key-str? "J- ")))
1419
 
   (assert-true  (uim-bool '(valid-key-str? "J-!")))
1420
 
   (assert-true  (uim-bool '(valid-key-str? "J-0")))
1421
 
   (assert-true  (uim-bool '(valid-key-str? "J-A")))
1422
 
   (assert-true  (uim-bool '(valid-key-str? "J-a")))
1423
 
   (assert-true  (uim-bool '(valid-key-str? "J-return")))
1424
 
   (assert-true  (uim-bool '(valid-key-str? "K-return")))
1425
 
   (assert-true  (uim-bool '(valid-key-str? "I-return")))
1426
 
 
1427
 
   ;; single key with multiple translators
1428
 
   (assert-true  (uim-bool '(valid-key-str? "<IgnoreShift><IgnoreCase> ")))
1429
 
   (assert-true  (uim-bool '(valid-key-str? "<IgnoreShift><IgnoreCase>!")))
1430
 
   (assert-true  (uim-bool '(valid-key-str? "<IgnoreShift><IgnoreCase>0")))
1431
 
   (assert-true  (uim-bool '(valid-key-str? "<IgnoreShift><IgnoreCase>A")))
1432
 
   (assert-true  (uim-bool '(valid-key-str? "<IgnoreShift><IgnoreCase>a")))
1433
 
   (assert-true  (uim-bool '(valid-key-str? "<IgnoreShift><IgnoreCase>return")))
1434
 
 
1435
 
   (assert-true  (uim-bool '(valid-key-str? "J-I- ")))
1436
 
   (assert-true  (uim-bool '(valid-key-str? "J-I-!")))
1437
 
   (assert-true  (uim-bool '(valid-key-str? "J-I-0")))
1438
 
   (assert-true  (uim-bool '(valid-key-str? "J-I-A")))
1439
 
   (assert-true  (uim-bool '(valid-key-str? "J-I-a")))
1440
 
   (assert-true  (uim-bool '(valid-key-str? "J-I-return"))))
1441
 
 
1442
 
  ("test valid-strict-key-str?"
1443
 
   ;; null key fails
1444
 
   (assert-false (uim-bool '(valid-strict-key-str? "")))
1445
 
 
1446
 
   ;; invalid key definitions
1447
 
   (assert-false  (uim-bool '(valid-strict-key-str? "nonexistent")))
1448
 
   (assert-false  (uim-bool '(valid-strict-key-str? "<Shift>nonexistent")))
1449
 
   (assert-false  (uim-bool '(valid-strict-key-str? "<Nonexistent>a")))
1450
 
   (assert-false  (uim-bool '(valid-strict-key-str? "<Nonexistent>nonexistent")))
1451
 
   (assert-false  (uim-bool '(valid-strict-key-str? "<Nonexistent><Shift>a")))
1452
 
   (assert-false  (uim-bool '(valid-strict-key-str? "<Nonexistent><Shift>nonexistent")))
1453
 
 
1454
 
   (assert-false  (uim-bool '(valid-strict-key-str? "nonexistent")))
1455
 
   (assert-false  (uim-bool '(valid-strict-key-str? "S-nonexistent")))
1456
 
   (assert-false  (uim-bool '(valid-strict-key-str? "N-a")))
1457
 
   (assert-false  (uim-bool '(valid-strict-key-str? "N-nonexistent")))
1458
 
   (assert-false  (uim-bool '(valid-strict-key-str? "N-S-a")))
1459
 
   (assert-false  (uim-bool '(valid-strict-key-str? "N-S-nonexistent")))
1460
 
 
1461
 
   ;; single key
1462
 
   (assert-true  (uim-bool '(valid-strict-key-str? " ")))
1463
 
   (assert-true  (uim-bool '(valid-strict-key-str? "!")))
1464
 
   (assert-true  (uim-bool '(valid-strict-key-str? "0")))
1465
 
   (assert-true  (uim-bool '(valid-strict-key-str? "A")))
1466
 
   (assert-true  (uim-bool '(valid-strict-key-str? "a")))
1467
 
   (assert-true  (uim-bool '(valid-strict-key-str? "return")))
1468
 
 
1469
 
   ;; single key with single modifier
1470
 
   (assert-true  (uim-bool '(valid-strict-key-str? "<Shift> ")))
1471
 
   (assert-true  (uim-bool '(valid-strict-key-str? "<Shift>!")))
1472
 
   (assert-true  (uim-bool '(valid-strict-key-str? "<Shift>0")))
1473
 
   (assert-true  (uim-bool '(valid-strict-key-str? "<Shift>A")))
1474
 
   (assert-true  (uim-bool '(valid-strict-key-str? "<Shift>a")))
1475
 
   (assert-true  (uim-bool '(valid-strict-key-str? "<Shift>return")))
1476
 
   (assert-true  (uim-bool '(valid-strict-key-str? "<Control>return")))
1477
 
   (assert-true  (uim-bool '(valid-strict-key-str? "<Alt>return")))
1478
 
   (assert-true  (uim-bool '(valid-strict-key-str? "<Meta>return")))
1479
 
   (assert-true  (uim-bool '(valid-strict-key-str? "<Super>return")))
1480
 
   (assert-true  (uim-bool '(valid-strict-key-str? "<Hyper>return")))
1481
 
 
1482
 
   (assert-false (uim-bool '(valid-strict-key-str? "S- ")))
1483
 
   (assert-false (uim-bool '(valid-strict-key-str? "S-!")))
1484
 
   (assert-false (uim-bool '(valid-strict-key-str? "S-0")))
1485
 
   (assert-false (uim-bool '(valid-strict-key-str? "S-A")))
1486
 
   (assert-false (uim-bool '(valid-strict-key-str? "S-a")))
1487
 
   (assert-false (uim-bool '(valid-strict-key-str? "S-return")))
1488
 
   (assert-false (uim-bool '(valid-strict-key-str? "C-return")))
1489
 
   (assert-false (uim-bool '(valid-strict-key-str? "A-return")))
1490
 
   (assert-false (uim-bool '(valid-strict-key-str? "M-return")))
1491
 
   (assert-false (uim-bool '(valid-strict-key-str? "S-return")))
1492
 
   (assert-false (uim-bool '(valid-strict-key-str? "H-return")))
1493
 
 
1494
 
   ;; single key with multiple modifiers
1495
 
   (assert-true  (uim-bool '(valid-strict-key-str? "<Shift><Control><Meta> ")))
1496
 
   (assert-true  (uim-bool '(valid-strict-key-str? "<Shift><Control><Meta>!")))
1497
 
   (assert-true  (uim-bool '(valid-strict-key-str? "<Shift><Control><Meta>0")))
1498
 
   (assert-true  (uim-bool '(valid-strict-key-str? "<Shift><Control><Meta>A")))
1499
 
   (assert-true  (uim-bool '(valid-strict-key-str? "<Shift><Control><Meta>a")))
1500
 
   (assert-true  (uim-bool '(valid-strict-key-str? "<Shift><Control><Meta>return")))
1501
 
 
1502
 
   (assert-false (uim-bool '(valid-strict-key-str? "S-C-M- ")))
1503
 
   (assert-false (uim-bool '(valid-strict-key-str? "S-C-M-!")))
1504
 
   (assert-false (uim-bool '(valid-strict-key-str? "S-C-M-0")))
1505
 
   (assert-false (uim-bool '(valid-strict-key-str? "S-C-M-A")))
1506
 
   (assert-false (uim-bool '(valid-strict-key-str? "S-C-M-a")))
1507
 
   (assert-false (uim-bool '(valid-strict-key-str? "S-C-M-return")))
1508
 
 
1509
 
   ;; single key with single translator
1510
 
   (assert-false (uim-bool '(valid-strict-key-str? "<IgnoreShift> ")))
1511
 
   (assert-false (uim-bool '(valid-strict-key-str? "<IgnoreShift>!")))
1512
 
   (assert-false (uim-bool '(valid-strict-key-str? "<IgnoreShift>0")))
1513
 
   (assert-false (uim-bool '(valid-strict-key-str? "<IgnoreShift>A")))
1514
 
   (assert-false (uim-bool '(valid-strict-key-str? "<IgnoreShift>a")))
1515
 
   (assert-false (uim-bool '(valid-strict-key-str? "<IgnoreShift>return")))
1516
 
   (assert-false (uim-bool '(valid-strict-key-str? "<IgnoreRegularShift>return")))
1517
 
   (assert-false (uim-bool '(valid-strict-key-str? "<IgnoreCase>return")))
1518
 
 
1519
 
   (assert-false (uim-bool '(valid-strict-key-str? "J- ")))
1520
 
   (assert-false (uim-bool '(valid-strict-key-str? "J-!")))
1521
 
   (assert-false (uim-bool '(valid-strict-key-str? "J-0")))
1522
 
   (assert-false (uim-bool '(valid-strict-key-str? "J-A")))
1523
 
   (assert-false (uim-bool '(valid-strict-key-str? "J-a")))
1524
 
   (assert-false (uim-bool '(valid-strict-key-str? "J-return")))
1525
 
   (assert-false (uim-bool '(valid-strict-key-str? "K-return")))
1526
 
   (assert-false (uim-bool '(valid-strict-key-str? "I-return")))
1527
 
 
1528
 
   ;; single key with multiple translators
1529
 
   (assert-false (uim-bool '(valid-strict-key-str? "<IgnoreShift><IgnoreCase> ")))
1530
 
   (assert-false (uim-bool '(valid-strict-key-str? "<IgnoreShift><IgnoreCase>!")))
1531
 
   (assert-false (uim-bool '(valid-strict-key-str? "<IgnoreShift><IgnoreCase>0")))
1532
 
   (assert-false (uim-bool '(valid-strict-key-str? "<IgnoreShift><IgnoreCase>A")))
1533
 
   (assert-false (uim-bool '(valid-strict-key-str? "<IgnoreShift><IgnoreCase>a")))
1534
 
   (assert-false (uim-bool '(valid-strict-key-str? "<IgnoreShift><IgnoreCase>return")))
1535
 
 
1536
 
   (assert-false (uim-bool '(valid-strict-key-str? "J-I- ")))
1537
 
   (assert-false (uim-bool '(valid-strict-key-str? "J-I-!")))
1538
 
   (assert-false (uim-bool '(valid-strict-key-str? "J-I-0")))
1539
 
   (assert-false (uim-bool '(valid-strict-key-str? "J-I-A")))
1540
 
   (assert-false (uim-bool '(valid-strict-key-str? "J-I-a")))
1541
 
   (assert-false (uim-bool '(valid-strict-key-str? "J-I-return")))))