« back to all changes in this revision
Viewing changes to test/test-action.scm
- browse files at revision 4
- compare with another revision
- download diff
- download tarball
- view history from revision 4
- Committer: Bazaar Package Importer
- Author(s): Masahito Omote
- Date: 2005-12-04 13:10:42 UTC
- mfrom: (1.1.2 upstream)
- Revision ID: james.westby@ubuntu.com-20051204131042-ktzc8b17zi7a3cw8
Tags: 1:0.4.9.1-1
* New upstream release
* libuim0-nox, libuim-nox-dev, and libuim0-dbg-nox is now obsolete.
Because libuim0 does not depends on X11. They now become dummy package,
therefore you can safely remove them.
* Add --enable-debug in configure again.
* debian/patches/08_fix_privilage_escalation_CVE_2005_3149: disabled.
* Fix Error on purge because update-uim-config is not found.
(closes: Bug#339345)
* uim-qt: New package for Qt utilities for uim. qt-immodule does not
contained yet because of Debian's Qt3 does not support immodule and
because uim does not recognize libqt4-dev's headers properly.
* libuim0-nox, libuim-nox-dev, and libuim0-dbg-nox is now obsolete.
Because libuim0 does not depends on X11. They now become dummy package,
therefore you can safely remove them.
* Add --enable-debug in configure again.
* debian/patches/08_fix_privilage_escalation_CVE_2005_3149: disabled.
* Fix Error on purge because update-uim-config is not found.
(closes: Bug#339345)
* uim-qt: New package for Qt utilities for uim. qt-immodule does not
contained yet because of Debian's Qt3 does not support immodule and
because uim does not recognize libqt4-dev's headers properly.
- files added:
- ChangeLog.old
- debian/im-switch
- examples
- examples/uim-custom
- pixmaps
- qt
- files removed:
- data
- data/icons
- sumika
- sumika/common
- sumika/gtk2
- sumika/include
- files modified:
- COPYING
added
removed
test/test-action.scm
1
#!/usr/bin/env gosh
2
3
;;; Copyright (c) 2003-2005 uim Project http://uim.freedesktop.org/
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
;; This file is tested with revision 389 of new repository
33
34
(use test.unit)
35
36
(require "test/uim-test-utils")
37
38
(define-uim-test-case "testcase action"
39
(setup
40
(lambda ()
41
(uim
42
'(begin
43
(require "load-action.scm")
44
(require "rk.scm")
45
(require "japanese.scm")
46
(require-module "anthy")
47
48
(set! widget-proto-list ())
49
(set! action-list ())
50
51
(define test-type-hiragana 0)
52
(define test-type-katakana 1)
53
(define test-type-hankana 2)
54
55
(define test-input-rule-roma 0)
56
(define test-input-rule-kana 1)
57
(define test-input-rule-azik 2)
58
59
(define context-rec-spec
60
'((id #f) ;; must be first member
61
(im #f)
62
(widgets ())))
63
(define-record 'context context-rec-spec)
64
65
(define-record 'test-context
66
(append
67
context-rec-spec
68
(list
69
(list 'on #f)
70
(list 'wide-latin #f)
71
(list 'kana-mode test-type-hiragana)
72
(list 'rkc ())
73
(list 'input-rule test-input-rule-roma))))
74
75
(register-action 'action_test_hiragana
76
(lambda (tc)
77
'(figure_ja_hiragana
78
"あ"
79
"ひらがな"
80
"ひらがな入力モード"))
81
(lambda (tc)
82
(and (test-context-on tc)
83
(= (test-context-kana-mode tc)
84
test-type-hiragana)))
85
(lambda (tc)
86
(test-context-set-on! tc #t)
87
(test-context-set-kana-mode! tc test-type-hiragana)
88
(set! test-activated 'action_test_hiragana)))
89
90
(register-action 'action_test_katakana
91
(lambda (tc)
92
'(figure_ja_katakana
93
"ア"
94
"カタカナ"
95
"カタカナ入力モード"))
96
(lambda (tc)
97
(and (test-context-on tc)
98
(= (test-context-kana-mode tc)
99
test-type-katakana)))
100
(lambda (tc)
101
(test-context-set-on! tc #t)
102
(test-context-set-kana-mode! tc test-type-katakana)
103
(set! test-activated 'action_test_katakana)))
104
105
(register-action 'action_test_hankana
106
(lambda (tc)
107
'(figure_ja_hankana
108
"ｱ"
109
"半角カタカナ"
110
"半角カタカナ入力モード"))
111
(lambda (tc)
112
(and (test-context-on tc)
113
(= (test-context-kana-mode tc)
114
test-type-hankana)))
115
(lambda (tc)
116
(test-context-set-on! tc #t)
117
(test-context-set-kana-mode! tc test-type-hankana)
118
(set! test-activated 'action_test_hankana)))
119
120
(register-action 'action_test_direct
121
(lambda (tc)
122
'(figure_ja_direct
123
"a"
124
"直接入力"
125
"直接(無変換)入力モード"))
126
(lambda (tc)
127
(and (not (test-context-on tc))
128
(not (test-context-wide-latin tc))))
129
(lambda (tc)
130
(test-context-set-on! tc #f)
131
(test-context-set-wide-latin! tc #f)
132
(set! test-activated 'action_test_direct)))
133
134
(register-action 'action_test_zenkaku
135
(lambda (tc)
136
'(figure_ja_zenkaku
137
"Ａ"
138
"全角英数"
139
"全角英数入力モード"))
140
(lambda (tc)
141
(and (not (test-context-on tc))
142
(test-context-wide-latin tc)))
143
(lambda (tc)
144
(test-context-set-on! tc #f)
145
(test-context-set-wide-latin! tc #t)
146
(set! test-activated 'action_test_zenkaku)))
147
148
(register-action 'action_test_alt_direct
149
(lambda (tc)
150
'(figure_ja_direct
151
"aa"
152
"直接入力"
153
"直接(無変換)入力モード"))
154
(lambda (tc)
155
(and (not (test-context-on tc))
156
(not (test-context-wide-latin tc))))
157
(lambda (tc)
158
(test-context-set-on! tc #f)
159
(test-context-set-wide-latin! tc #f)
160
(set! test-activated 'action_test_alt_direct)))
161
162
(register-action 'action_test_roma
163
(lambda (tc)
164
'(figure_ja_roma
165
"Ｒ"
166
"ローマ字"
167
"ローマ字入力モード"))
168
(lambda (tc)
169
(= (test-context-input-rule tc)
170
test-input-rule-roma))
171
(lambda (tc)
172
(rk-context-set-rule! (test-context-rkc tc)
173
ja-rk-rule)
174
(test-context-set-input-rule! tc test-input-rule-roma)
175
(set! test-activated 'action_test_roma)))
176
177
(register-action 'action_test_kana
178
(lambda (tc)
179
'(figure_ja_kana
180
"か"
181
"かな"
182
"かな入力モード"))
183
(lambda (tc)
184
(= (test-context-input-rule tc)
185
test-input-rule-kana))
186
(lambda (tc)
187
(rk-context-set-rule! (test-context-rkc tc)
188
ja-kana-hiragana-rule)
189
(test-context-set-input-rule! tc test-input-rule-kana)
190
(set! test-activated 'action_test_kana)))
191
192
(register-widget
193
'widget_test_input_mode
194
(activity-indicator-new '(action_test_hiragana
195
action_test_katakana
196
action_test_hankana
197
action_test_direct
198
action_test_zenkaku))
199
(actions-new '(action_test_hiragana
200
action_test_katakana
201
action_test_hankana
202
action_test_direct
203
action_test_zenkaku)))
204
205
(register-widget
206
'widget_test_kana_input_method
207
(activity-indicator-new '(action_test_roma
208
action_test_kana))
209
(actions-new '(action_test_roma
210
action_test_kana)))
211
212
(register-widget
213
'widget_test_null
214
#f
215
#f)
216
217
(register-widget
218
'widget_fallback
219
(indicator-new (lambda (owner)
220
fallback-indication))
221
#f) ;; has no actions
222
223
(define tc (test-context-new))
224
(begin (test-context-set-rkc! tc (rk-context-new ja-rk-rule #t #f))
225
#t)
226
227
(define test-prop-label #f)
228
(define im-update-prop-label
229
(lambda (context message)
230
(set! test-prop-label message)))
231
(define test-prop-list #f)
232
(define im-update-prop-list
233
(lambda (context message)
234
(set! test-prop-list message)))
235
236
(define test-mode-list ())
237
(define test-updated-mode-list ())
238
(define im-clear-mode-list
239
(lambda (context)
240
(set! test-mode-list ())))
241
(define im-update-mode-list
242
(lambda (context)
243
(set! test-updated-mode-list test-mode-list)))
244
(define im-pushback-mode-list
245
(lambda (context label)
246
(set! test-mode-list (append test-mode-list
247
(list label)))))
248
(define test-updated-mode #f)
249
(define im-update-mode
250
(lambda (context mode)
251
(set! test-updated-mode mode)))
252
253
(define test-widget-conf #f)
254
(define test-widget-state #f)
255
(define test-activated #f)))))
256
257
("test indicator-new"
258
(uim '(begin
259
(define test-indicator (indicator-new (lambda ()
260
'(figure_unknown
261
"?"
262
"unknown"
263
"Unknown"))))
264
#t))
265
(assert-false (uim-bool '(indicator-id test-indicator)))
266
(assert-false (uim-bool '(indicator-activity-pred test-indicator)))
267
(assert-false (uim-bool '(indicator-handler test-indicator))))
268
269
("test register-action"
270
(uim '(set! action-list ()))
271
(assert-equal 0
272
(uim '(length action-list)))
273
(uim '(register-action 'action_test_hiragana
274
(lambda (tc)
275
'(figure_ja_hiragana
276
"あ"
277
"ひらがな"
278
"ひらがな入力モード"))
279
(lambda (tc)
280
(and (test-context-on tc)
281
(= (test-context-kana-mode tc)
282
test-type-hiragana)))
283
(lambda (tc)
284
(test-context-set-on! tc #t)
285
(test-context-set-kana-mode! tc test-type-hiragana))))
286
(assert-equal 1
287
(uim '(length action-list)))
288
(assert-equal 'action_test_hiragana
289
(uim '(caar action-list)))
290
(uim '(register-action 'action_test_katakana
291
(lambda (tc)
292
'(figure_ja_katakana
293
"ア"
294
"カタカナ"
295
"カタカナ入力モード"))
296
(lambda (tc)
297
(and (test-context-on tc)
298
(= (test-context-kana-mode tc)
299
test-type-katakana)))
300
(lambda (tc)
301
(test-context-set-on! tc #t)
302
(test-context-set-kana-mode! tc test-type-katakana))))
303
(assert-equal 2
304
(uim '(length action-list)))
305
(assert-equal 'action_test_katakana
306
(uim '(caar action-list)))
307
(uim '(register-action 'action_test_hankana
308
(lambda (tc)
309
'(figure_ja_hankana
310
"ｱ"
311
"半角カタカナ"
312
"半角カタカナ入力モード"))
313
(lambda (tc)
314
(and (test-context-on tc)
315
(= (test-context-kana-mode tc)
316
test-type-hankana)))
317
(lambda (tc)
318
(test-context-set-on! tc #t)
319
(test-context-set-kana-mode! tc test-type-hankana))))
320
(assert-equal 3
321
(uim '(length action-list)))
322
(assert-equal 'action_test_hankana
323
(uim '(caar action-list))))
324
325
("test fetch-action"
326
(assert-equal 'action_test_hiragana
327
(uim '(action-id (fetch-action 'action_test_hiragana))))
328
(assert-equal 'action_test_katakana
329
(uim '(action-id (fetch-action 'action_test_katakana))))
330
(assert-equal 'action_test_hankana
331
(uim '(action-id (fetch-action 'action_test_hankana)))))
332
333
("test action-active?"
334
(assert-false (uim-bool '(action-active? (fetch-action 'action_test_hiragana)
335
tc)))
336
(assert-false (uim-bool '(action-active? (fetch-action 'action_test_katakana)
337
tc)))
338
(assert-false (uim-bool '(action-active? (fetch-action 'action_test_hankana)
339
tc)))
340
(assert-true (uim-bool '(action-active? (fetch-action 'action_test_direct)
341
tc)))
342
(assert-false (uim-bool '(action-active? (fetch-action 'action_test_zenkaku)
343
tc)))
344
(uim '(test-context-set-wide-latin! tc #t))
345
(assert-false (uim-bool '(action-active? (fetch-action 'action_test_hiragana)
346
tc)))
347
(assert-false (uim-bool '(action-active? (fetch-action 'action_test_katakana)
348
tc)))
349
(assert-false (uim-bool '(action-active? (fetch-action 'action_test_hankana)
350
tc)))
351
(assert-false (uim-bool '(action-active? (fetch-action 'action_test_direct)
352
tc)))
353
(assert-true (uim-bool '(action-active? (fetch-action 'action_test_zenkaku)
354
tc)))
355
(uim '(test-context-set-on! tc #t))
356
(assert-true (uim-bool '(action-active? (fetch-action 'action_test_hiragana)
357
tc)))
358
(assert-false (uim-bool '(action-active? (fetch-action 'action_test_katakana)
359
tc)))
360
(assert-false (uim-bool '(action-active? (fetch-action 'action_test_hankana)
361
tc)))
362
(assert-false (uim-bool '(action-active? (fetch-action 'action_test_direct)
363
tc)))
364
(assert-false (uim-bool '(action-active? (fetch-action 'action_test_zenkaku)
365
tc)))
366
(uim '(test-context-set-kana-mode! tc test-type-katakana))
367
(assert-false (uim-bool '(action-active? (fetch-action 'action_test_hiragana)
368
tc)))
369
(assert-true (uim-bool '(action-active? (fetch-action 'action_test_katakana)
370
tc)))
371
(assert-false (uim-bool '(action-active? (fetch-action 'action_test_hankana)
372
tc)))
373
(assert-false (uim-bool '(action-active? (fetch-action 'action_test_direct)
374
tc)))
375
(assert-false (uim-bool '(action-active? (fetch-action 'action_test_zenkaku)
376
tc))))
377
378
("test action-indicate"
379
(assert-equal '(figure_ja_hiragana
380
"あ"
381
"ひらがな"
382
"ひらがな入力モード")
383
(uim '(action-indicate (fetch-action 'action_test_hiragana)
384
tc)))
385
(assert-equal '(figure_ja_katakana
386
"ア"
387
"カタカナ"
388
"カタカナ入力モード")
389
(uim '(action-indicate (fetch-action 'action_test_katakana)
390
tc)))
391
(assert-equal '(figure_ja_kana
392
"か"
393
"かな"
394
"かな入力モード")
395
(uim '(action-indicate (fetch-action 'action_test_kana)
396
tc)))
397
;; no action
398
(assert-equal (uim 'fallback-indication)
399
(uim '(action-indicate #f tc)))
400
;; no indication handler
401
(assert-equal (uim 'fallback-indication)
402
(uim '(action-indicate (action-new) tc))))
403
404
("test actions-new"
405
(assert-equal '(action_test_katakana
406
action_test_kana
407
action_test_hiragana)
408
(uim '(map action-id (actions-new '(action_test_katakana
409
action_test_kana
410
action_test_hiragana)))))
411
(assert-equal (uim ''(action_test_katakana
412
action_test_kana
413
action_test_hiragana))
414
(uim '(map action-id (actions-new '(action_test_katakana
415
action_test_kana
416
action_nonexistent
417
action_test_hiragana)))))
418
(assert-equal ()
419
(uim '(map action-id (actions-new ())))))
420
421
("test activity-indicator-new"
422
(uim '(define indicator (activity-indicator-new '(action_test_hiragana
423
action_test_katakana
424
action_test_hankana
425
action_test_direct
426
action_test_zenkaku))))
427
(assert-equal '(figure_ja_direct
428
"a"
429
"直接入力"
430
"直接(無変換)入力モード")
431
(uim '(action-indicate indicator tc)))
432
(uim '(test-context-set-wide-latin! tc #t))
433
(assert-equal '(figure_ja_zenkaku
434
"Ａ"
435
"全角英数"
436
"全角英数入力モード")
437
(uim '(action-indicate indicator tc)))
438
(uim '(test-context-set-on! tc #t))
439
(assert-equal '(figure_ja_hiragana
440
"あ"
441
"ひらがな"
442
"ひらがな入力モード")
443
(uim '(action-indicate indicator tc)))
444
(uim '(test-context-set-kana-mode! tc test-type-katakana))
445
(assert-equal '(figure_ja_katakana
446
"ア"
447
"カタカナ"
448
"カタカナ入力モード")
449
(uim '(action-indicate indicator tc)))
450
;; no activity case
451
(uim '(define test-type-invalid 100))
452
(uim '(test-context-set-kana-mode! tc test-type-invalid))
453
(assert-equal '(figure_unknown
454
"?"
455
"unknown"
456
"unknown")
457
(uim '(action-indicate indicator tc))))
458
459
("test register-widget"
460
(uim '(set! widget-proto-list ()))
461
(assert-equal 0
462
(uim '(length widget-proto-list)))
463
(uim '(begin
464
(register-widget
465
'widget_test_input_mode
466
(indicator-new (lambda (tc)
467
fallback-indication))
468
(actions-new '(action_test_hiragana
469
action_test_katakana
470
action_test_hankana
471
action_test_direct
472
action_test_zenkaku)))
473
#t))
474
(assert-equal 1
475
(uim '(length widget-proto-list)))
476
(assert-equal 'widget_test_input_mode
477
(uim '(caar widget-proto-list)))
478
(uim '(begin
479
(register-widget
480
'widget_test_input_mode
481
(indicator-new (lambda (tc)
482
fallback-indication))
483
(actions-new '(action_test_direct)))
484
#t))
485
(assert-equal 1
486
(uim '(length widget-proto-list)))
487
(assert-equal 'widget_test_input_mode
488
(uim '(caar widget-proto-list)))
489
(uim '(begin
490
(register-widget
491
'widget_test_kana_input_method
492
(indicator-new (lambda (tc)
493
fallback-indication))
494
(actions-new '(action_test_roma
495
action_test_kana)))
496
#t))
497
(assert-equal 2
498
(uim '(length widget-proto-list)))
499
(assert-equal 'widget_test_kana_input_method
500
(uim '(caar widget-proto-list)))
501
(assert-equal 'widget_test_input_mode
502
(uim '(car (cadr widget-proto-list)))))
503
504
("test widget-new"
505
(assert-false (uim-bool '(widget-new 'widget_test_nonexistent tc)))
506
;; widget_test_input_mode
507
(assert-true (uim-bool '(and (define test-input-mode
508
(widget-new 'widget_test_input_mode tc))
509
#t)))
510
(assert-equal 'widget_test_input_mode
511
(uim '(widget-id test-input-mode)))
512
(assert-equal 'action_test_direct
513
(uim '(action-id (widget-activity test-input-mode))))
514
;; widget_test_input_mode with default value
515
(uim '(define default-widget_test_input_mode 'action_test_hiragana))
516
(assert-true (uim-bool '(and (define test-input-mode
517
(widget-new 'widget_test_input_mode tc))
518
#t)))
519
(assert-equal 'action_test_hiragana
520
(uim '(action-id (widget-activity test-input-mode))))
521
;; widget_test_input_mode with default value #2
522
(uim '(define default-widget_test_input_mode 'action_test_katakana))
523
(assert-true (uim-bool '(and (define test-input-mode
524
(widget-new 'widget_test_input_mode tc))
525
#t)))
526
(assert-equal 'action_test_katakana
527
(uim '(action-id (widget-activity test-input-mode))))
528
;; widget_test_input_mode with default value #3
529
(uim '(define default-widget_test_input_mode 'action_test_zenkaku))
530
(assert-true (uim-bool '(and (define test-input-mode
531
(widget-new 'widget_test_input_mode tc))
532
#t)))
533
(assert-equal 'action_test_zenkaku
534
(uim '(action-id (widget-activity test-input-mode))))
535
536
;; widget_test_input_mode with invalid default value
537
(uim '(define default-widget_test_input_mode 'action_nonexistent))
538
(assert-true (uim-bool '(and (define test-input-mode
539
(widget-new 'widget_test_input_mode tc))
540
#t)))
541
(assert-equal 'action_test_zenkaku
542
(uim '(action-id (widget-activity test-input-mode))))
543
544
;; widget_test_kana_input_method
545
(assert-true (uim-bool '(and (define test-kana-input-method
546
(widget-new 'widget_test_kana_input_method tc))
547
#t)))
548
(assert-equal 'action_test_roma
549
(uim '(action-id (widget-activity test-kana-input-method))))
550
;; widget_test_kana_input_method with default value
551
(uim '(define default-widget_test_kana_input_method 'action_test_kana))
552
(assert-true (uim-bool '(and (define test-kana-input-method
553
(widget-new 'widget_test_kana_input_method tc))
554
#t)))
555
(assert-equal 'action_test_kana
556
(uim '(action-id (widget-activity test-kana-input-method))))
557
;; widget_test_kana_input_method with invalid default value
558
(uim '(define default-widget_test_kana_input_method 'action_nonexistent))
559
(assert-true (uim-bool '(and (define test-kana-input-method
560
(widget-new 'widget_test_kana_input_method tc))
561
#t)))
562
(assert-equal 'action_test_kana
563
(uim '(action-id (widget-activity test-kana-input-method)))))
564
565
566
("test widget-activity"
567
;;; widget_test_input_mode
568
(assert-true (uim-bool '(and (define test-input-mode
569
(widget-new 'widget_test_input_mode tc))
570
#t)))
571
;; action_test_direct (initial activity)
572
(assert-false (uim-bool '(test-context-on tc)))
573
(assert-false (uim-bool '(test-context-wide-latin tc)))
574
(assert-equal (uim 'test-type-hiragana)
575
(uim '(test-context-kana-mode tc)))
576
(assert-equal 'action_test_direct
577
(uim '(action-id (widget-activity test-input-mode))))
578
;; action_test_direct -> action_test_hiragana
579
(uim '(test-context-set-wide-latin! tc #t))
580
(uim '(test-context-set-on! tc #t))
581
(assert-equal (uim 'test-type-hiragana)
582
(uim '(test-context-kana-mode tc)))
583
(assert-equal 'action_test_hiragana
584
(uim '(action-id (widget-activity test-input-mode))))
585
;; action_test_hiragana -> action_test_katakana
586
(uim '(test-context-set-wide-latin! tc #f))
587
(uim '(test-context-set-kana-mode! tc test-type-katakana))
588
(assert-true (uim-bool '(test-context-on tc)))
589
(assert-false (uim-bool '(test-context-wide-latin tc)))
590
(assert-equal (uim 'test-type-katakana)
591
(uim '(test-context-kana-mode tc)))
592
(assert-equal 'action_test_katakana
593
(uim '(action-id (widget-activity test-input-mode))))
594
;; action_test_katakana -> action_test_hankana
595
(uim '(test-context-set-kana-mode! tc test-type-hankana))
596
(assert-true (uim-bool '(test-context-on tc)))
597
(assert-false (uim-bool '(test-context-wide-latin tc)))
598
(assert-equal (uim 'test-type-hankana)
599
(uim '(test-context-kana-mode tc)))
600
(assert-equal 'action_test_hankana
601
(uim '(action-id (widget-activity test-input-mode))))
602
;; action_test_hankana -> action_test_direct
603
(uim '(test-context-set-on! tc #f))
604
(assert-false (uim-bool '(test-context-on tc)))
605
(assert-false (uim-bool '(test-context-wide-latin tc)))
606
(assert-equal (uim 'test-type-hankana)
607
(uim '(test-context-kana-mode tc)))
608
(assert-equal 'action_test_direct
609
(uim '(action-id (widget-activity test-input-mode))))
610
;; action_test_direct -> invalid
611
(uim '(define test-type-invalid 100))
612
(uim '(test-context-set-on! tc #t))
613
(uim '(test-context-set-kana-mode! tc test-type-invalid))
614
(assert-true (uim-bool '(test-context-on tc)))
615
(assert-false (uim-bool '(test-context-wide-latin tc)))
616
(assert-equal (uim 'test-type-invalid)
617
(uim '(test-context-kana-mode tc)))
618
(assert-false (uim-bool '(widget-activity test-input-mode)))
619
620
;;; duplicate activity
621
(uim '(begin
622
(register-widget
623
'widget_test_invalid_input_mode
624
(indicator-new (lambda (owner)
625
fallback-indication))
626
(actions-new '(action_test_hiragana
627
action_test_katakana
628
action_test_hankana
629
action_test_direct
630
action_test_alt_direct
631
action_test_zenkaku)))
632
(context-init-widgets! tc '(widget_test_invalid_input_mode
633
widget_test_kana_input_method))
634
(define test-invalid-input-mode
635
(widget-new 'widget_test_invalid_input_mode tc))
636
#t))
637
;; action_test_direct and action_test_alt_direct are conflicted
638
(assert-false (uim-bool '(widget-activity test-invalid-input-mode)))
639
;; conflicted -> action_test_hiragana
640
(assert-true (uim-bool '(widget-activate! test-invalid-input-mode
641
'action_test_hiragana)))
642
(assert-equal 'action_test_hiragana
643
(uim '(action-id (widget-activity test-invalid-input-mode))))
644
;; action_test_hiragana -> action_test_katakana
645
(assert-true (uim-bool '(widget-activate! test-invalid-input-mode
646
'action_test_katakana)))
647
(assert-equal 'action_test_katakana
648
(uim '(action-id (widget-activity test-invalid-input-mode))))
649
)
650
651
("test widget-activate!"
652
;;; widget_test_input_mode
653
(assert-true (uim-bool '(and (define test-input-mode
654
(widget-new 'widget_test_input_mode tc))
655
#t)))
656
;; action_test_direct (initial activity)
657
(assert-false (uim-bool '(test-context-on tc)))
658
(assert-false (uim-bool '(test-context-wide-latin tc)))
659
(assert-equal (uim 'test-type-hiragana)
660
(uim '(test-context-kana-mode tc)))
661
(assert-equal 'action_test_direct
662
(uim '(action-id (widget-activity test-input-mode))))
663
;; action_test_direct -> action_test_hiragana
664
(assert-true (uim-bool '(widget-activate! test-input-mode
665
'action_test_hiragana)))
666
(assert-true (uim-bool '(test-context-on tc)))
667
(assert-false (uim-bool '(test-context-wide-latin tc)))
668
(assert-equal (uim 'test-type-hiragana)
669
(uim '(test-context-kana-mode tc)))
670
(assert-equal 'action_test_hiragana
671
(uim '(action-id (widget-activity test-input-mode))))
672
;; action_test_hiragana -> action_test_katakana
673
(assert-true (uim-bool '(widget-activate! test-input-mode
674
'action_test_katakana)))
675
(assert-true (uim-bool '(test-context-on tc)))
676
(assert-false (uim-bool '(test-context-wide-latin tc)))
677
(assert-equal (uim 'test-type-katakana)
678
(uim '(test-context-kana-mode tc)))
679
(assert-equal 'action_test_katakana
680
(uim '(action-id (widget-activity test-input-mode))))
681
;; action_test_katakana -> action_test_hankana
682
(assert-true (uim-bool '(widget-activate! test-input-mode
683
'action_test_hankana)))
684
(assert-true (uim-bool '(test-context-on tc)))
685
(assert-false (uim-bool '(test-context-wide-latin tc)))
686
(assert-equal (uim 'test-type-hankana)
687
(uim '(test-context-kana-mode tc)))
688
(assert-equal 'action_test_hankana
689
(uim '(action-id (widget-activity test-input-mode))))
690
;; action_test_hankana -> action_test_zenkaku
691
(assert-true (uim-bool '(widget-activate! test-input-mode
692
'action_test_zenkaku)))
693
(assert-false (uim-bool '(test-context-on tc)))
694
(assert-true (uim-bool '(test-context-wide-latin tc)))
695
(assert-equal (uim 'test-type-hankana)
696
(uim '(test-context-kana-mode tc)))
697
(assert-equal 'action_test_zenkaku
698
(uim '(action-id (widget-activity test-input-mode))))
699
;; action_test_zenkaku -> action_test_direct
700
(assert-true (uim-bool '(widget-activate! test-input-mode
701
'action_test_direct)))
702
(assert-false (uim-bool '(test-context-on tc)))
703
(assert-false (uim-bool '(test-context-wide-latin tc)))
704
(assert-equal (uim 'test-type-hankana)
705
(uim '(test-context-kana-mode tc)))
706
(assert-equal 'action_test_direct
707
(uim '(action-id (widget-activity test-input-mode))))
708
;; action_test_direct -> invalid
709
(assert-false (uim-bool '(widget-activate! test-input-mode
710
'action_nonexistent)))
711
(assert-false (uim-bool '(test-context-on tc)))
712
(assert-false (uim-bool '(test-context-wide-latin tc)))
713
(assert-equal (uim 'test-type-hankana)
714
(uim '(test-context-kana-mode tc)))
715
(assert-equal 'action_test_direct
716
(uim '(action-id (widget-activity test-input-mode)))))
717
718
("test widget-configuration"
719
;;; widget_test_input_mode
720
(assert-true (uim-bool '(and (define test-input-mode
721
(widget-new 'widget_test_input_mode tc))
722
#t)))
723
(assert-equal '(action_unknown
724
(figure_ja_hiragana
725
"あ"
726
"ひらがな"
727
"ひらがな入力モード")
728
(figure_ja_katakana
729
"ア"
730
"カタカナ"
731
"カタカナ入力モード")
732
(figure_ja_hankana
733
"ｱ"
734
"半角カタカナ"
735
"半角カタカナ入力モード")
736
(figure_ja_direct
737
"a"
738
"直接入力"
739
"直接(無変換)入力モード")
740
(figure_ja_zenkaku
741
"Ａ"
742
"全角英数"
743
"全角英数入力モード"))
744
(uim '(widget-configuration test-input-mode)))
745
;;; widget_test_kana_input_method
746
(assert-true (uim-bool '(and (define test-kana-input-method
747
(widget-new 'widget_test_kana_input_method tc))
748
#t)))
749
(assert-equal '(action_unknown
750
(figure_ja_roma
751
"Ｒ"
752
"ローマ字"
753
"ローマ字入力モード")
754
(figure_ja_kana
755
"か"
756
"かな"
757
"かな入力モード"))
758
(uim '(widget-configuration test-kana-input-method)))
759
;;; widget_test_null
760
(assert-true (uim-bool '(and (define test-null
761
(widget-new 'widget_test_null tc))
762
#t)))
763
(assert-equal '(action_unknown)
764
(uim '(widget-configuration test-null))))
765
766
("test widget-state"
767
;;; widget_test_input_mode
768
(assert-true (uim-bool '(and (define test-input-mode
769
(widget-new 'widget_test_input_mode tc))
770
#t)))
771
(assert-true (uim-bool '(equal? (list (fetch-action 'action_test_direct)
772
'(figure_ja_direct
773
"a"
774
"直接入力"
775
"直接(無変換)入力モード"))
776
(widget-state test-input-mode))))
777
(assert-true (uim-bool '(widget-activate! test-input-mode
778
'action_test_katakana)))
779
(assert-true (uim-bool '(equal? (list (fetch-action 'action_test_katakana)
780
'(figure_ja_katakana
781
"ア"
782
"カタカナ"
783
"カタカナ入力モード"))
784
(widget-state test-input-mode))))
785
(assert-false (uim-bool '(widget-activate! test-input-mode
786
'action_nonexistent)))
787
(assert-true (uim-bool '(equal? (list (fetch-action 'action_test_katakana)
788
'(figure_ja_katakana
789
"ア"
790
"カタカナ"
791
"カタカナ入力モード"))
792
(widget-state test-input-mode))))
793
;;; widget_test_kana_input_method
794
(assert-true (uim-bool '(and (define test-kana-input-method
795
(widget-new 'widget_test_kana_input_method tc))
796
#t)))
797
(assert-true (uim-bool '(equal? (list (fetch-action 'action_test_roma)
798
'(figure_ja_roma
799
"Ｒ"
800
"ローマ字"
801
"ローマ字入力モード"))
802
(widget-state test-kana-input-method))))
803
;;; widget_test_null
804
(assert-true (uim-bool '(and (define test-null
805
(widget-new 'widget_test_null tc))
806
#t)))
807
(assert-true (uim-bool '(equal? (list #f
808
'(figure_unknown
809
"?"
810
"unknown"
811
"unknown"))
812
(widget-state test-null)))))
813
814
("test widget-update-configuration!"
815
;;; widget_test_input_mode
816
(assert-true (uim-bool '(and (define test-input-mode
817
(widget-new 'widget_test_input_mode tc))
818
#t)))
819
(assert-equal '(action_unknown
820
(figure_ja_hiragana
821
"あ"
822
"ひらがな"
823
"ひらがな入力モード")
824
(figure_ja_katakana
825
"ア"
826
"カタカナ"
827
"カタカナ入力モード")
828
(figure_ja_hankana
829
"ｱ"
830
"半角カタカナ"
831
"半角カタカナ入力モード")
832
(figure_ja_direct
833
"a"
834
"直接入力"
835
"直接(無変換)入力モード")
836
(figure_ja_zenkaku
837
"Ａ"
838
"全角英数"
839
"全角英数入力モード"))
840
(uim '(widget-configuration test-input-mode)))
841
(assert-false (uim-bool '(widget-prev-config test-input-mode)))
842
(assert-true (uim-bool '(widget-update-configuration! test-input-mode)))
843
(assert-equal '(action_unknown
844
(figure_ja_hiragana
845
"あ"
846
"ひらがな"
847
"ひらがな入力モード")
848
(figure_ja_katakana
849
"ア"
850
"カタカナ"
851
"カタカナ入力モード")
852
(figure_ja_hankana
853
"ｱ"
854
"半角カタカナ"
855
"半角カタカナ入力モード")
856
(figure_ja_direct
857
"a"
858
"直接入力"
859
"直接(無変換)入力モード")
860
(figure_ja_zenkaku
861
"Ａ"
862
"全角英数"
863
"全角英数入力モード"))
864
(uim '(widget-configuration test-input-mode)))
865
(assert-equal '(action_unknown
866
(figure_ja_hiragana
867
"あ"
868
"ひらがな"
869
"ひらがな入力モード")
870
(figure_ja_katakana
871
"ア"
872
"カタカナ"
873
"カタカナ入力モード")
874
(figure_ja_hankana
875
"ｱ"
876
"半角カタカナ"
877
"半角カタカナ入力モード")
878
(figure_ja_direct
879
"a"
880
"直接入力"
881
"直接(無変換)入力モード")
882
(figure_ja_zenkaku
883
"Ａ"
884
"全角英数"
885
"全角英数入力モード"))
886
(uim '(widget-prev-config test-input-mode)))
887
(assert-false (uim-bool '(widget-update-configuration! test-input-mode)))
888
(assert-equal '(action_unknown
889
(figure_ja_hiragana
890
"あ"
891
"ひらがな"
892
"ひらがな入力モード")
893
(figure_ja_katakana
894
"ア"
895
"カタカナ"
896
"カタカナ入力モード")
897
(figure_ja_hankana
898
"ｱ"
899
"半角カタカナ"
900
"半角カタカナ入力モード")
901
(figure_ja_direct
902
"a"
903
"直接入力"
904
"直接(無変換)入力モード")
905
(figure_ja_zenkaku
906
"Ａ"
907
"全角英数"
908
"全角英数入力モード"))
909
(uim '(widget-prev-config test-input-mode)))
910
;;; widget_test_null
911
(assert-true (uim-bool '(and (define test-null
912
(widget-new 'widget_test_null tc))
913
#t)))
914
(assert-equal '(action_unknown)
915
(uim '(widget-configuration test-null)))
916
(assert-false (uim-bool '(widget-prev-config test-null)))
917
;; initial update (widget_test_null with fallback-indication)
918
(assert-true (uim-bool '(widget-update-configuration! test-null)))
919
;; subsequent update
920
(assert-false (uim-bool '(widget-update-configuration! test-null))))
921
922
("test widget-update-state!"
923
;;; widget_test_input_mode
924
(assert-true (uim-bool '(and (define test-input-mode
925
(widget-new 'widget_test_input_mode tc))
926
#t)))
927
;; initial state
928
(assert-true (uim-bool '(equal? (list (fetch-action 'action_test_direct)
929
'(figure_ja_direct
930
"a"
931
"直接入力"
932
"直接(無変換)入力モード"))
933
(widget-state test-input-mode))))
934
(assert-false (uim-bool '(widget-prev-state test-input-mode)))
935
;; initial update
936
(assert-true (uim-bool '(widget-update-state! test-input-mode)))
937
(assert-true (uim-bool '(equal? (list (fetch-action 'action_test_direct)
938
'(figure_ja_direct
939
"a"
940
"直接入力"
941
"直接(無変換)入力モード"))
942
(widget-state test-input-mode))))
943
(assert-true (uim-bool '(equal? (list (fetch-action 'action_test_direct)
944
'(figure_ja_direct
945
"a"
946
"直接入力"
947
"直接(無変換)入力モード"))
948
(widget-prev-state test-input-mode))))
949
;; action_test_direct -> action_test_katakana
950
(assert-true (uim-bool '(widget-activate! test-input-mode
951
'action_test_katakana)))
952
(assert-true (uim-bool '(equal? (list (fetch-action 'action_test_katakana)
953
'(figure_ja_katakana
954
"ア"
955
"カタカナ"
956
"カタカナ入力モード"))
957
(widget-state test-input-mode))))
958
(assert-true (uim-bool '(equal? (list (fetch-action 'action_test_direct)
959
'(figure_ja_direct
960
"a"
961
"直接入力"
962
"直接(無変換)入力モード"))
963
(widget-prev-state test-input-mode))))
964
(assert-true (uim-bool '(widget-update-state! test-input-mode)))
965
(assert-true (uim-bool '(equal? (list (fetch-action 'action_test_katakana)
966
'(figure_ja_katakana
967
"ア"
968
"カタカナ"
969
"カタカナ入力モード"))
970
(widget-state test-input-mode))))
971
(assert-true (uim-bool '(equal? (list (fetch-action 'action_test_katakana)
972
'(figure_ja_katakana
973
"ア"
974
"カタカナ"
975
"カタカナ入力モード"))
976
(widget-prev-state test-input-mode))))
977
;; action_test_katakana -> action_test_katakana
978
(assert-false (uim-bool '(widget-update-state! test-input-mode)))
979
(assert-true (uim-bool '(equal? (list (fetch-action 'action_test_katakana)
980
'(figure_ja_katakana
981
"ア"
982
"カタカナ"
983
"カタカナ入力モード"))
984
(widget-state test-input-mode))))
985
(assert-true (uim-bool '(equal? (list (fetch-action 'action_test_katakana)
986
'(figure_ja_katakana
987
"ア"
988
"カタカナ"
989
"カタカナ入力モード"))
990
(widget-prev-state test-input-mode))))
991
;; invalid activation
992
(assert-false (uim-bool '(widget-activate! test-input-mode
993
'action_nonexistent)))
994
(assert-false (uim-bool '(widget-update-state! test-input-mode)))
995
(assert-true (uim-bool '(equal? (list (fetch-action 'action_test_katakana)
996
'(figure_ja_katakana
997
"ア"
998
"カタカナ"
999
"カタカナ入力モード"))
1000
(widget-state test-input-mode))))
1001
(assert-true (uim-bool '(equal? (list (fetch-action 'action_test_katakana)
1002
'(figure_ja_katakana
1003
"ア"
1004
"カタカナ"
1005
"カタカナ入力モード"))
1006
(widget-prev-state test-input-mode))))
1007
;;; widget_test_null
1008
(assert-true (uim-bool '(and (define test-null
1009
(widget-new 'widget_test_null tc))
1010
#t)))
1011
1012
;; initial state
1013
(assert-true (uim-bool '(equal? (list #f
1014
'(figure_unknown
1015
"?"
1016
"unknown"
1017
"unknown"))
1018
(widget-state test-null))))
1019
(assert-false (uim-bool '(widget-prev-state test-null)))
1020
;; initial update
1021
(assert-true (uim-bool '(widget-update-state! test-null)))
1022
(assert-true (uim-bool '(equal? (list #f
1023
'(figure_unknown
1024
"?"
1025
"unknown"
1026
"unknown"))
1027
(widget-state test-null))))
1028
(assert-true (uim-bool '(equal? (list #f
1029
'(figure_unknown
1030
"?"
1031
"unknown"
1032
"unknown"))
1033
(widget-prev-state test-null))))
1034
;; subsequent update
1035
(assert-false (uim-bool '(widget-update-state! test-null)))
1036
(assert-true (uim-bool '(equal? (list #f
1037
'(figure_unknown
1038
"?"
1039
"unknown"
1040
"unknown"))
1041
(widget-state test-null))))
1042
(assert-true (uim-bool '(equal? (list #f
1043
'(figure_unknown
1044
"?"
1045
"unknown"
1046
"unknown"))
1047
(widget-prev-state test-null)))))
1048
1049
("test widget-debug-message"
1050
(assert-true (uim-bool '(and (define test-input-mode
1051
(widget-new 'widget_test_input_mode tc))
1052
#t)))
1053
(assert-equal "something in somewhere. debug widget_test_input_mode."
1054
(uim '(widget-debug-message test-input-mode
1055
"somewhere"
1056
"something"))))
1057
1058
("test indication-compose-label"
1059
(assert-equal "あ\tひらがな\n"
1060
(uim '(indication-compose-label
1061
(action-indicate (fetch-action 'action_test_hiragana)
1062
tc))))
1063
(assert-equal "ア\tカタカナ\n"
1064
(uim '(indication-compose-label
1065
(action-indicate (fetch-action 'action_test_katakana)
1066
tc))))
1067
(assert-equal "ｱ\t半角カタカナ\n"
1068
(uim '(indication-compose-label
1069
(action-indicate (fetch-action 'action_test_hankana)
1070
tc))))
1071
(assert-equal "a\t直接入力\n"
1072
(uim '(indication-compose-label
1073
(action-indicate (fetch-action 'action_test_direct)
1074
tc))))
1075
(assert-equal "Ａ\t全角英数\n"
1076
(uim '(indication-compose-label
1077
(action-indicate (fetch-action 'action_test_zenkaku)
1078
tc))))
1079
(assert-equal "Ｒ\tローマ字\n"
1080
(uim '(indication-compose-label
1081
(action-indicate (fetch-action 'action_test_roma)
1082
tc))))
1083
(assert-equal "か\tかな\n"
1084
(uim '(indication-compose-label
1085
(action-indicate (fetch-action 'action_test_kana)
1086
tc)))))
1087
1088
("test indication-compose-branch"
1089
(assert-equal "branch\tあ\tひらがな\n"
1090
(uim '(indication-compose-branch
1091
(action-indicate (fetch-action 'action_test_hiragana)
1092
tc))))
1093
(assert-equal "branch\tア\tカタカナ\n"
1094
(uim '(indication-compose-branch
1095
(action-indicate (fetch-action 'action_test_katakana)
1096
tc))))
1097
(assert-equal "branch\tｱ\t半角カタカナ\n"
1098
(uim '(indication-compose-branch
1099
(action-indicate (fetch-action 'action_test_hankana)
1100
tc))))
1101
(assert-equal "branch\ta\t直接入力\n"
1102
(uim '(indication-compose-branch
1103
(action-indicate (fetch-action 'action_test_direct)
1104
tc))))
1105
(assert-equal "branch\tＡ\t全角英数\n"
1106
(uim '(indication-compose-branch
1107
(action-indicate (fetch-action 'action_test_zenkaku)
1108
tc))))
1109
(assert-equal "branch\tＲ\tローマ字\n"
1110
(uim '(indication-compose-branch
1111
(action-indicate (fetch-action 'action_test_roma)
1112
tc))))
1113
(assert-equal "branch\tか\tかな\n"
1114
(uim '(indication-compose-branch
1115
(action-indicate (fetch-action 'action_test_kana)
1116
tc)))))
1117
1118
("test indication-compose-leaf"
1119
;; inactive leaves
1120
(assert-equal "leaf\tあ\tひらがな\tひらがな入力モード\taction_test_hiragana\t\n"
1121
(uim '(indication-compose-leaf
1122
(action-indicate (fetch-action 'action_test_hiragana)
1123
tc)
1124
'action_test_hiragana
1125
#f)))
1126
(assert-equal "leaf\tア\tカタカナ\tカタカナ入力モード\taction_test_katakana\t\n"
1127
(uim '(indication-compose-leaf
1128
(action-indicate (fetch-action 'action_test_katakana)
1129
tc)
1130
'action_test_katakana
1131
#f)))
1132
(assert-equal "leaf\tｱ\t半角カタカナ\t半角カタカナ入力モード\taction_test_hankana\t\n"
1133
(uim '(indication-compose-leaf
1134
(action-indicate (fetch-action 'action_test_hankana)
1135
tc)
1136
'action_test_hankana
1137
#f)))
1138
(assert-equal "leaf\ta\t直接入力\t直接(無変換)入力モード\taction_test_direct\t\n"
1139
(uim '(indication-compose-leaf
1140
(action-indicate (fetch-action 'action_test_direct)
1141
tc)
1142
'action_test_direct
1143
#f)))
1144
(assert-equal "leaf\tＡ\t全角英数\t全角英数入力モード\taction_test_zenkaku\t\n"
1145
(uim '(indication-compose-leaf
1146
(action-indicate (fetch-action 'action_test_zenkaku)
1147
tc)
1148
'action_test_zenkaku
1149
#f)))
1150
(assert-equal "leaf\tＲ\tローマ字\tローマ字入力モード\taction_test_roma\t\n"
1151
(uim '(indication-compose-leaf
1152
(action-indicate (fetch-action 'action_test_roma)
1153
tc)
1154
'action_test_roma
1155
#f)))
1156
(assert-equal "leaf\tか\tかな\tかな入力モード\taction_test_kana\t\n"
1157
(uim '(indication-compose-leaf
1158
(action-indicate (fetch-action 'action_test_kana)
1159
tc)
1160
'action_test_kana
1161
#f)))
1162
;; active leaves
1163
(assert-equal "leaf\tあ\tひらがな\tひらがな入力モード\taction_test_hiragana\t*\n"
1164
(uim '(indication-compose-leaf
1165
(action-indicate (fetch-action 'action_test_hiragana)
1166
tc)
1167
'action_test_hiragana
1168
#t)))
1169
(assert-equal "leaf\tア\tカタカナ\tカタカナ入力モード\taction_test_katakana\t*\n"
1170
(uim '(indication-compose-leaf
1171
(action-indicate (fetch-action 'action_test_katakana)
1172
tc)
1173
'action_test_katakana
1174
#t)))
1175
(assert-equal "leaf\tｱ\t半角カタカナ\t半角カタカナ入力モード\taction_test_hankana\t*\n"
1176
(uim '(indication-compose-leaf
1177
(action-indicate (fetch-action 'action_test_hankana)
1178
tc)
1179
'action_test_hankana
1180
#t)))
1181
(assert-equal "leaf\ta\t直接入力\t直接(無変換)入力モード\taction_test_direct\t*\n"
1182
(uim '(indication-compose-leaf
1183
(action-indicate (fetch-action 'action_test_direct)
1184
tc)
1185
'action_test_direct
1186
#t)))
1187
(assert-equal "leaf\tＡ\t全角英数\t全角英数入力モード\taction_test_zenkaku\t*\n"
1188
(uim '(indication-compose-leaf
1189
(action-indicate (fetch-action 'action_test_zenkaku)
1190
tc)
1191
'action_test_zenkaku
1192
#t)))
1193
(assert-equal "leaf\tＲ\tローマ字\tローマ字入力モード\taction_test_roma\t*\n"
1194
(uim '(indication-compose-leaf
1195
(action-indicate (fetch-action 'action_test_roma)
1196
tc)
1197
'action_test_roma
1198
#t)))
1199
(assert-equal "leaf\tか\tかな\tかな入力モード\taction_test_kana\t*\n"
1200
(uim '(indication-compose-leaf
1201
(action-indicate (fetch-action 'action_test_kana)
1202
tc)
1203
'action_test_kana
1204
#t))))
1205
1206
("test widget-compose-live-branch"
1207
;; widget_test_input_mode
1208
(assert-true (uim-bool '(and (define test-input-mode
1209
(widget-new 'widget_test_input_mode tc))
1210
#t)))
1211
(assert-equal (string-append
1212
"branch\ta\t直接入力\n"
1213
"leaf\tあ\tひらがな\tひらがな入力モード\taction_test_hiragana\t\n"
1214
"leaf\tア\tカタカナ\tカタカナ入力モード\taction_test_katakana\t\n"
1215
"leaf\tｱ\t半角カタカナ\t半角カタカナ入力モード\taction_test_hankana\t\n"
1216
"leaf\ta\t直接入力\t直接(無変換)入力モード\taction_test_direct\t*\n"
1217
"leaf\tＡ\t全角英数\t全角英数入力モード\taction_test_zenkaku\t\n")
1218
(uim '(widget-compose-live-branch test-input-mode)))
1219
(assert-true (uim-bool '(widget-activate! test-input-mode
1220
'action_test_zenkaku)))
1221
(assert-equal (string-append
1222
"branch\tＡ\t全角英数\n"
1223
"leaf\tあ\tひらがな\tひらがな入力モード\taction_test_hiragana\t\n"
1224
"leaf\tア\tカタカナ\tカタカナ入力モード\taction_test_katakana\t\n"
1225
"leaf\tｱ\t半角カタカナ\t半角カタカナ入力モード\taction_test_hankana\t\n"
1226
"leaf\ta\t直接入力\t直接(無変換)入力モード\taction_test_direct\t\n"
1227
"leaf\tＡ\t全角英数\t全角英数入力モード\taction_test_zenkaku\t*\n")
1228
(uim '(widget-compose-live-branch test-input-mode)))
1229
;;; prop_test_kana_input_method
1230
(assert-true (uim-bool '(and (define test-kana-input-method
1231
(widget-new 'widget_test_kana_input_method tc))
1232
#t)))
1233
(assert-equal (string-append
1234
"branch\tＲ\tローマ字\n"
1235
"leaf\tＲ\tローマ字\tローマ字入力モード\taction_test_roma\t*\n"
1236
"leaf\tか\tかな\tかな入力モード\taction_test_kana\t\n")
1237
(uim '(widget-compose-live-branch test-kana-input-method)))
1238
(assert-true (uim-bool '(widget-activate! test-kana-input-method
1239
'action_test_kana)))
1240
(assert-equal (string-append
1241
"branch\tか\tかな\n"
1242
"leaf\tＲ\tローマ字\tローマ字入力モード\taction_test_roma\t\n"
1243
"leaf\tか\tかな\tかな入力モード\taction_test_kana\t*\n")
1244
(uim '(widget-compose-live-branch test-kana-input-method))))
1245
1246
("test context-init-widgets!"
1247
(uim '(begin
1248
(define context-propagate-widget-configuration
1249
(lambda (context)
1250
(set! test-widget-conf (context-widgets context))))
1251
#t))
1252
;; 2 widgets
1253
(uim '(begin
1254
(context-init-widgets! tc '(widget_test_input_mode
1255
widget_test_kana_input_method))
1256
#t))
1257
(assert-equal '(widget_test_input_mode
1258
widget_test_kana_input_method)
1259
(uim '(map widget-id test-widget-conf)))
1260
;; contains a non-existent widget
1261
(uim '(begin
1262
(context-init-widgets! tc '(widget_test_input_mode
1263
widget_test_nonexistent
1264
widget_test_kana_input_method))
1265
#t))
1266
(assert-equal '(widget_test_input_mode
1267
widget_test_kana_input_method)
1268
(uim '(map widget-id test-widget-conf)))
1269
;; no widgets
1270
(uim '(begin
1271
(context-init-widgets! tc ())
1272
#t))
1273
(assert-equal '(widget_fallback)
1274
(uim '(map widget-id test-widget-conf)))
1275
;; null widget
1276
(uim '(begin
1277
(context-init-widgets! tc '(widget_test_null))
1278
#t))
1279
(assert-equal '(widget_test_null)
1280
(uim '(map widget-id test-widget-conf))))
1281
1282
("test context-update-widgets"
1283
(uim '(begin
1284
(define context-propagate-widget-configuration
1285
(lambda (context)
1286
(set! test-widget-conf (context-widgets context))))
1287
(define context-propagate-widget-states
1288
(lambda (context)
1289
(set! test-widget-state (context-widgets context))))
1290
#t))
1291
;;; 2 widgets + non-existent widget
1292
(uim '(begin
1293
(context-init-widgets! tc '(widget_test_input_mode
1294
widget_test_nonexistent
1295
widget_test_kana_input_method))
1296
#t))
1297
;; initial update
1298
(uim '(begin
1299
(define test-widget-conf #f)
1300
(define test-widget-state #f)))
1301
(uim '(begin
1302
(context-update-widgets tc)
1303
#t))
1304
(assert-equal '(widget_test_input_mode
1305
widget_test_kana_input_method)
1306
(uim '(map widget-id test-widget-conf)))
1307
(assert-equal '(widget_test_input_mode
1308
widget_test_kana_input_method)
1309
(uim '(map widget-id test-widget-state)))
1310
;; duplicate update
1311
(uim '(begin
1312
(define test-widget-conf #f)
1313
(define test-widget-state #f)))
1314
(uim '(begin
1315
(context-update-widgets tc)
1316
#t))
1317
(assert-false (uim-bool '(map widget-id test-widget-conf)))
1318
(assert-false (uim-bool '(map widget-id test-widget-state)))
1319
;; duplicate update #2
1320
(uim '(begin
1321
(define test-widget-conf #f)
1322
(define test-widget-state #f)))
1323
(uim '(begin
1324
(context-update-widgets tc)
1325
#t))
1326
(assert-false (uim-bool '(map widget-id test-widget-conf)))
1327
(assert-false (uim-bool '(map widget-id test-widget-state)))
1328
;; state update
1329
(uim '(begin
1330
(define test-widget-conf #f)
1331
(define test-widget-state #f)))
1332
(assert-true (uim-bool '(widget-activate! (assq 'widget_test_input_mode
1333
(context-widgets tc))
1334
'action_test_katakana)))
1335
(uim '(begin
1336
(context-update-widgets tc)
1337
#t))
1338
(assert-false (uim-bool '(map widget-id test-widget-conf)))
1339
(assert-equal '(widget_test_input_mode
1340
widget_test_kana_input_method)
1341
(uim '(map widget-id test-widget-state)))
1342
;; duplicate state update
1343
(uim '(begin
1344
(define test-widget-conf #f)
1345
(define test-widget-state #f)))
1346
(uim '(begin
1347
(context-update-widgets tc)
1348
#t))
1349
(assert-false (uim-bool '(map widget-id test-widget-conf)))
1350
(assert-false (uim-bool '(map widget-id test-widget-state)))
1351
;; configuration update
1352
(uim '(begin
1353
(define test-widget-conf #f)
1354
(define test-widget-state #f)))
1355
(uim '(begin
1356
(register-action 'action_test_alt_hiragana
1357
(lambda (tc)
1358
'(figure_ja_hiragana
1359
"ひ" ;; differs from action_test_hiragana
1360
"ひらがな"
1361
"ひらがな入力モード"))
1362
(lambda (tc)
1363
(and (test-context-on tc)
1364
(= (test-context-kana-mode tc)
1365
test-type-hiragana)))
1366
(lambda (tc)
1367
(test-context-set-on! tc #t)
1368
(test-context-set-kana-mode! tc test-type-hiragana)))
1369
#t))
1370
(uim '(begin
1371
(for-each (lambda (widget)
1372
(if (eq? (widget-id widget)
1373
'widget_test_input_mode)
1374
(widget-set-actions!
1375
widget
1376
(actions-new '(action_test_alt_hiragana
1377
action_test_katakana
1378
action_test_hankana
1379
action_test_direct
1380
action_test_zenkaku)))))
1381
(context-widgets tc))
1382
#t))
1383
(uim '(begin
1384
(context-update-widgets tc)
1385
#t))
1386
(assert-equal '(widget_test_input_mode
1387
widget_test_kana_input_method)
1388
(uim '(map widget-id test-widget-conf)))
1389
(assert-false (uim-bool '(map widget-id test-widget-state)))
1390
;; duplicate configuration update
1391
(uim '(begin
1392
(define test-widget-conf #f)
1393
(define test-widget-state #f)))
1394
(uim '(begin
1395
(context-update-widgets tc)
1396
#t))
1397
(assert-false (uim-bool '(map widget-id test-widget-conf)))
1398
(assert-false (uim-bool '(map widget-id test-widget-state)))
1399
;; configuration & state update
1400
(uim '(begin
1401
(define test-widget-conf #f)
1402
(define test-widget-state #f)))
1403
(uim '(begin
1404
(context-init-widgets! tc '(widget_test_input_mode))
1405
#t))
1406
(uim '(begin
1407
(context-update-widgets tc)
1408
#t))
1409
(assert-equal '(widget_test_input_mode)
1410
(uim '(map widget-id test-widget-conf)))
1411
(assert-equal '(widget_test_input_mode)
1412
(uim '(map widget-id test-widget-state)))
1413
;; duplicate configuration & state update
1414
(uim '(begin
1415
(define test-widget-conf #f)
1416
(define test-widget-state #f)))
1417
(uim '(begin
1418
(context-update-widgets tc)
1419
#t))
1420
(assert-false (uim-bool '(map widget-id test-widget-conf)))
1421
(assert-false (uim-bool '(map widget-id test-widget-state)))
1422
;; The framework can't detect the configuration information
1423
;; invalidation when violently reconfigured by
1424
;; context-set-widgets!.
1425
(uim '(begin
1426
(define test-widget-conf #f)
1427
(define test-widget-state #f)))
1428
(uim '(begin
1429
(context-set-widgets!
1430
tc
1431
(filter (lambda (widget)
1432
(not (eq? (widget-id widget)
1433
'widget_test_kana_input_method)))
1434
(context-widgets tc)))
1435
#t))
1436
(uim '(begin
1437
(context-update-widgets tc)
1438
#t))
1439
(assert-false (uim-bool '(map widget-id test-widget-conf)))
1440
(assert-false (uim-bool '(map widget-id test-widget-state)))
1441
1442
;;; no widgets
1443
(uim '(begin
1444
(context-init-widgets! tc ())
1445
#t))
1446
;; initial update (widget_fallback)
1447
(uim '(begin
1448
(define test-widget-conf #f)
1449
(define test-widget-state #f)))
1450
(uim '(begin
1451
(context-update-widgets tc)
1452
#t))
1453
(assert-equal '(widget_fallback)
1454
(uim '(map widget-id test-widget-conf)))
1455
(assert-equal '(widget_fallback)
1456
(uim '(map widget-id test-widget-state)))
1457
;; subsequent update
1458
(uim '(begin
1459
(define test-widget-conf #f)
1460
(define test-widget-state #f)))
1461
(uim '(begin
1462
(context-update-widgets tc)
1463
#t))
1464
(assert-false (uim-bool '(map widget-id test-widget-conf)))
1465
(assert-false (uim-bool '(map widget-id test-widget-state)))
1466
1467
;;; null widget
1468
(uim '(begin
1469
(context-init-widgets! tc '(widget_test_null))
1470
#t))
1471
;; initial update (widget_test_null with fallback-indication)
1472
(uim '(begin
1473
(define test-widget-conf #f)
1474
(define test-widget-state #f)))
1475
(uim '(begin
1476
(context-update-widgets tc)
1477
#t))
1478
(assert-equal '(widget_test_null)
1479
(uim '(map widget-id test-widget-conf)))
1480
(assert-equal '(widget_test_null)
1481
(uim '(map widget-id test-widget-state)))
1482
;; subsequent update
1483
(uim '(begin
1484
(define test-widget-conf #f)
1485
(define test-widget-state #f)))
1486
(uim '(begin
1487
(context-update-widgets tc)
1488
#t))
1489
(assert-false (uim-bool '(map widget-id test-widget-conf)))
1490
(assert-false (uim-bool '(map widget-id test-widget-state))))
1491
1492
("test context-propagate-prop-label-update"
1493
;; 2 widgets
1494
(uim '(begin
1495
(context-init-widgets! tc '(widget_test_input_mode
1496
widget_test_kana_input_method))
1497
#t))
1498
(uim '(context-propagate-prop-label-update tc))
1499
(assert-equal (string-append "a\t直接入力\n"
1500
"Ｒ\tローマ字\n")
1501
(uim 'test-prop-label))
1502
;; 2 widgets (updated state)
1503
(assert-true (uim-bool '(widget-activate! (assq 'widget_test_input_mode
1504
(context-widgets tc))
1505
'action_test_katakana)))
1506
(uim '(context-propagate-prop-label-update tc))
1507
(assert-equal (string-append "ア\tカタカナ\n"
1508
"Ｒ\tローマ字\n")
1509
(uim 'test-prop-label))
1510
;; 2 widgets with non-existent
1511
(uim '(begin
1512
(context-init-widgets! tc '(widget_test_kana_input_method
1513
widget_test_nonexistent
1514
widget_test_input_mode))
1515
#t))
1516
(uim '(context-propagate-prop-label-update tc))
1517
(assert-equal (string-append "Ｒ\tローマ字\n"
1518
"ア\tカタカナ\n")
1519
(uim 'test-prop-label))
1520
;; no widgets
1521
(uim '(begin
1522
(context-init-widgets! tc ())
1523
#t))
1524
(uim '(context-propagate-prop-label-update tc))
1525
(assert-equal "?\tunknown\n"
1526
(uim 'test-prop-label))
1527
;; widget_test_null
1528
(uim '(begin
1529
(context-init-widgets! tc '(widget_test_null))
1530
#t))
1531
(uim '(context-propagate-prop-label-update tc))
1532
(assert-equal "?\tunknown\n"
1533
(uim 'test-prop-label)))
1534
1535
("test context-propagate-prop-list-update"
1536
(uim '(begin
1537
(define test-prop-list #f)
1538
(define im-update-prop-list
1539
(lambda (context message)
1540
(set! test-prop-list message)))))
1541
;; 2 widgets
1542
(uim '(begin
1543
(context-init-widgets! tc '(widget_test_input_mode
1544
widget_test_kana_input_method))
1545
#t))
1546
(uim '(context-propagate-prop-list-update tc))
1547
(assert-equal (string-append
1548
"branch\ta\t直接入力\n"
1549
"leaf\tあ\tひらがな\tひらがな入力モード\taction_test_hiragana\t\n"
1550
"leaf\tア\tカタカナ\tカタカナ入力モード\taction_test_katakana\t\n"
1551
"leaf\tｱ\t半角カタカナ\t半角カタカナ入力モード\taction_test_hankana\t\n"
1552
"leaf\ta\t直接入力\t直接(無変換)入力モード\taction_test_direct\t*\n"
1553
"leaf\tＡ\t全角英数\t全角英数入力モード\taction_test_zenkaku\t\n"
1554
"branch\tＲ\tローマ字\n"
1555
"leaf\tＲ\tローマ字\tローマ字入力モード\taction_test_roma\t*\n"
1556
"leaf\tか\tかな\tかな入力モード\taction_test_kana\t\n")
1557
(uim 'test-prop-list))
1558
;; 2 widgets (updated state)
1559
(assert-true (uim-bool '(widget-activate! (assq 'widget_test_input_mode
1560
(context-widgets tc))
1561
'action_test_katakana)))
1562
(uim '(context-propagate-prop-list-update tc))
1563
(assert-equal (string-append
1564
"branch\tア\tカタカナ\n"
1565
"leaf\tあ\tひらがな\tひらがな入力モード\taction_test_hiragana\t\n"
1566
"leaf\tア\tカタカナ\tカタカナ入力モード\taction_test_katakana\t*\n"
1567
"leaf\tｱ\t半角カタカナ\t半角カタカナ入力モード\taction_test_hankana\t\n"
1568
"leaf\ta\t直接入力\t直接(無変換)入力モード\taction_test_direct\t\n"
1569
"leaf\tＡ\t全角英数\t全角英数入力モード\taction_test_zenkaku\t\n"
1570
"branch\tＲ\tローマ字\n"
1571
"leaf\tＲ\tローマ字\tローマ字入力モード\taction_test_roma\t*\n"
1572
"leaf\tか\tかな\tかな入力モード\taction_test_kana\t\n")
1573
(uim 'test-prop-list))
1574
;; 2 widgets with non-existent
1575
(uim '(begin
1576
(context-init-widgets! tc '(widget_test_kana_input_method
1577
widget_test_nonexistent
1578
widget_test_input_mode))
1579
#t))
1580
(uim '(context-propagate-prop-list-update tc))
1581
(assert-equal (string-append
1582
"branch\tＲ\tローマ字\n"
1583
"leaf\tＲ\tローマ字\tローマ字入力モード\taction_test_roma\t*\n"
1584
"leaf\tか\tかな\tかな入力モード\taction_test_kana\t\n"
1585
"branch\tア\tカタカナ\n"
1586
"leaf\tあ\tひらがな\tひらがな入力モード\taction_test_hiragana\t\n"
1587
"leaf\tア\tカタカナ\tカタカナ入力モード\taction_test_katakana\t*\n"
1588
"leaf\tｱ\t半角カタカナ\t半角カタカナ入力モード\taction_test_hankana\t\n"
1589
"leaf\ta\t直接入力\t直接(無変換)入力モード\taction_test_direct\t\n"
1590
"leaf\tＡ\t全角英数\t全角英数入力モード\taction_test_zenkaku\t\n")
1591
(uim 'test-prop-list))
1592
;; no widgets
1593
(uim '(begin
1594
(context-init-widgets! tc ())
1595
#t))
1596
(uim '(context-propagate-prop-list-update tc))
1597
(assert-equal "branch\t?\tunknown\n"
1598
(uim 'test-prop-list))
1599
;; widget_test_null
1600
(uim '(begin
1601
(context-init-widgets! tc '(widget_test_null))
1602
#t))
1603
(uim '(context-propagate-prop-list-update tc))
1604
(assert-equal "branch\t?\tunknown\n"
1605
(uim 'test-prop-list)))
1606
1607
;; TODO: context-update-mode
1608
("test context-propagate-widget-states"
1609
;;; 2 widgets
1610
(uim '(begin
1611
(context-init-widgets! tc '(widget_test_input_mode
1612
widget_test_kana_input_method))
1613
#t))
1614
;; initial state
1615
(uim '(begin
1616
(context-propagate-widget-states tc)
1617
#t))
1618
(assert-equal (string-append
1619
"branch\ta\t直接入力\n"
1620
"leaf\tあ\tひらがな\tひらがな入力モード\taction_test_hiragana\t\n"
1621
"leaf\tア\tカタカナ\tカタカナ入力モード\taction_test_katakana\t\n"
1622
"leaf\tｱ\t半角カタカナ\t半角カタカナ入力モード\taction_test_hankana\t\n"
1623
"leaf\ta\t直接入力\t直接(無変換)入力モード\taction_test_direct\t*\n"
1624
"leaf\tＡ\t全角英数\t全角英数入力モード\taction_test_zenkaku\t\n"
1625
"branch\tＲ\tローマ字\n"
1626
"leaf\tＲ\tローマ字\tローマ字入力モード\taction_test_roma\t*\n"
1627
"leaf\tか\tかな\tかな入力モード\taction_test_kana\t\n")
1628
(uim 'test-prop-list))
1629
(assert-equal (string-append "a\t直接入力\n"
1630
"Ｒ\tローマ字\n")
1631
(uim 'test-prop-label))
1632
(assert-equal 3
1633
(uim 'test-updated-mode))
1634
;; 2 widgets (updated state)
1635
(assert-true (uim-bool '(widget-activate! (assq 'widget_test_input_mode
1636
(context-widgets tc))
1637
'action_test_katakana)))
1638
(uim '(begin
1639
(context-propagate-widget-states tc)
1640
#t))
1641
(assert-equal (string-append
1642
"branch\tア\tカタカナ\n"
1643
"leaf\tあ\tひらがな\tひらがな入力モード\taction_test_hiragana\t\n"
1644
"leaf\tア\tカタカナ\tカタカナ入力モード\taction_test_katakana\t*\n"
1645
"leaf\tｱ\t半角カタカナ\t半角カタカナ入力モード\taction_test_hankana\t\n"
1646
"leaf\ta\t直接入力\t直接(無変換)入力モード\taction_test_direct\t\n"
1647
"leaf\tＡ\t全角英数\t全角英数入力モード\taction_test_zenkaku\t\n"
1648
"branch\tＲ\tローマ字\n"
1649
"leaf\tＲ\tローマ字\tローマ字入力モード\taction_test_roma\t*\n"
1650
"leaf\tか\tかな\tかな入力モード\taction_test_kana\t\n")
1651
(uim 'test-prop-list))
1652
(assert-equal (string-append "ア\tカタカナ\n"
1653
"Ｒ\tローマ字\n")
1654
(uim 'test-prop-label))
1655
(assert-equal 1
1656
(uim 'test-updated-mode))
1657
;; 2 widgets with non-existent
1658
(uim '(begin
1659
(context-init-widgets! tc '(widget_test_kana_input_method
1660
widget_test_nonexistent
1661
widget_test_input_mode))
1662
#t))
1663
(uim '(begin
1664
(context-propagate-widget-states tc)
1665
#t))
1666
(assert-equal (string-append
1667
"branch\tＲ\tローマ字\n"
1668
"leaf\tＲ\tローマ字\tローマ字入力モード\taction_test_roma\t*\n"
1669
"leaf\tか\tかな\tかな入力モード\taction_test_kana\t\n"
1670
"branch\tア\tカタカナ\n"
1671
"leaf\tあ\tひらがな\tひらがな入力モード\taction_test_hiragana\t\n"
1672
"leaf\tア\tカタカナ\tカタカナ入力モード\taction_test_katakana\t*\n"
1673
"leaf\tｱ\t半角カタカナ\t半角カタカナ入力モード\taction_test_hankana\t\n"
1674
"leaf\ta\t直接入力\t直接(無変換)入力モード\taction_test_direct\t\n"
1675
"leaf\tＡ\t全角英数\t全角英数入力モード\taction_test_zenkaku\t\n")
1676
(uim 'test-prop-list))
1677
(assert-equal (string-append "Ｒ\tローマ字\n"
1678
"ア\tカタカナ\n")
1679
(uim 'test-prop-label))
1680
(assert-equal 1
1681
(uim 'test-updated-mode))
1682
;; no widgets
1683
(uim '(begin
1684
(context-init-widgets! tc ())
1685
#t))
1686
(uim '(begin
1687
(context-propagate-widget-states tc)
1688
#t))
1689
(assert-equal "branch\t?\tunknown\n"
1690
(uim 'test-prop-list))
1691
(assert-equal "?\tunknown\n"
1692
(uim 'test-prop-label))
1693
(assert-equal 0
1694
(uim 'test-updated-mode))
1695
;; widget_test_null
1696
(uim '(begin
1697
(context-init-widgets! tc '(widget_test_null))
1698
#t))
1699
(uim '(begin
1700
(context-propagate-widget-states tc)
1701
#t))
1702
(assert-equal "branch\t?\tunknown\n"
1703
(uim 'test-prop-list))
1704
(assert-equal "?\tunknown\n"
1705
(uim 'test-prop-label))
1706
(assert-equal 0
1707
(uim 'test-updated-mode)))
1708
1709
("test context-propagate-widget-configuration"
1710
;;; 2 widgets
1711
(uim '(begin
1712
(context-init-widgets! tc '(widget_test_input_mode
1713
widget_test_kana_input_method))
1714
#t))
1715
;; initial state
1716
(uim '(begin
1717
(context-propagate-widget-configuration tc)
1718
#t))
1719
(assert-equal (string-append
1720
"branch\ta\t直接入力\n"
1721
"leaf\tあ\tひらがな\tひらがな入力モード\taction_test_hiragana\t\n"
1722
"leaf\tア\tカタカナ\tカタカナ入力モード\taction_test_katakana\t\n"
1723
"leaf\tｱ\t半角カタカナ\t半角カタカナ入力モード\taction_test_hankana\t\n"
1724
"leaf\ta\t直接入力\t直接(無変換)入力モード\taction_test_direct\t*\n"
1725
"leaf\tＡ\t全角英数\t全角英数入力モード\taction_test_zenkaku\t\n"
1726
"branch\tＲ\tローマ字\n"
1727
"leaf\tＲ\tローマ字\tローマ字入力モード\taction_test_roma\t*\n"
1728
"leaf\tか\tかな\tかな入力モード\taction_test_kana\t\n")
1729
(uim 'test-prop-list))
1730
(assert-equal '("ひらがな"
1731
"カタカナ"
1732
"半角カタカナ"
1733
"直接入力"
1734
"全角英数")
1735
(uim 'test-mode-list))
1736
(assert-equal '("ひらがな"
1737
"カタカナ"
1738
"半角カタカナ"
1739
"直接入力"
1740
"全角英数")
1741
(uim 'test-updated-mode-list))
1742
(assert-equal 3
1743
(uim 'test-updated-mode))
1744
;; 2 widgets (updated state)
1745
(assert-true (uim-bool '(widget-activate! (assq 'widget_test_input_mode
1746
(context-widgets tc))
1747
'action_test_katakana)))
1748
(uim '(begin
1749
(context-propagate-widget-configuration tc)
1750
#t))
1751
(assert-equal (string-append
1752
"branch\tア\tカタカナ\n"
1753
"leaf\tあ\tひらがな\tひらがな入力モード\taction_test_hiragana\t\n"
1754
"leaf\tア\tカタカナ\tカタカナ入力モード\taction_test_katakana\t*\n"
1755
"leaf\tｱ\t半角カタカナ\t半角カタカナ入力モード\taction_test_hankana\t\n"
1756
"leaf\ta\t直接入力\t直接(無変換)入力モード\taction_test_direct\t\n"
1757
"leaf\tＡ\t全角英数\t全角英数入力モード\taction_test_zenkaku\t\n"
1758
"branch\tＲ\tローマ字\n"
1759
"leaf\tＲ\tローマ字\tローマ字入力モード\taction_test_roma\t*\n"
1760
"leaf\tか\tかな\tかな入力モード\taction_test_kana\t\n")
1761
(uim 'test-prop-list))
1762
(assert-equal '("ひらがな"
1763
"カタカナ"
1764
"半角カタカナ"
1765
"直接入力"
1766
"全角英数")
1767
(uim 'test-mode-list))
1768
(assert-equal '("ひらがな"
1769
"カタカナ"
1770
"半角カタカナ"
1771
"直接入力"
1772
"全角英数")
1773
(uim 'test-updated-mode-list))
1774
(assert-equal 1
1775
(uim 'test-updated-mode))
1776
;; 2 widgets with non-existent
1777
(uim '(begin
1778
(context-init-widgets! tc '(widget_test_kana_input_method
1779
widget_test_nonexistent
1780
widget_test_input_mode))
1781
#t))
1782
(uim '(begin
1783
(context-propagate-widget-configuration tc)
1784
#t))
1785
(assert-equal (string-append
1786
"branch\tＲ\tローマ字\n"
1787
"leaf\tＲ\tローマ字\tローマ字入力モード\taction_test_roma\t*\n"
1788
"leaf\tか\tかな\tかな入力モード\taction_test_kana\t\n"
1789
"branch\tア\tカタカナ\n"
1790
"leaf\tあ\tひらがな\tひらがな入力モード\taction_test_hiragana\t\n"
1791
"leaf\tア\tカタカナ\tカタカナ入力モード\taction_test_katakana\t*\n"
1792
"leaf\tｱ\t半角カタカナ\t半角カタカナ入力モード\taction_test_hankana\t\n"
1793
"leaf\ta\t直接入力\t直接(無変換)入力モード\taction_test_direct\t\n"
1794
"leaf\tＡ\t全角英数\t全角英数入力モード\taction_test_zenkaku\t\n")
1795
(uim 'test-prop-list))
1796
(assert-equal '("ひらがな"
1797
"カタカナ"
1798
"半角カタカナ"
1799
"直接入力"
1800
"全角英数")
1801
(uim 'test-mode-list))
1802
(assert-equal '("ひらがな"
1803
"カタカナ"
1804
"半角カタカナ"
1805
"直接入力"
1806
"全角英数")
1807
(uim 'test-updated-mode-list))
1808
(assert-equal 1
1809
(uim 'test-updated-mode))
1810
;; no widgets
1811
(uim '(begin
1812
(context-init-widgets! tc ())
1813
#t))
1814
(uim '(begin
1815
(context-propagate-widget-configuration tc)
1816
#t))
1817
(assert-equal "branch\t?\tunknown\n"
1818
(uim 'test-prop-list))
1819
(assert-equal '("unknown")
1820
(uim 'test-mode-list))
1821
(assert-equal '("unknown")
1822
(uim 'test-updated-mode-list))
1823
(assert-equal 0
1824
(uim 'test-updated-mode))
1825
;; widget_test_null
1826
(uim '(begin
1827
(context-init-widgets! tc '(widget_test_null))
1828
#t))
1829
(uim '(begin
1830
(context-propagate-widget-configuration tc)
1831
#t))
1832
(assert-equal "branch\t?\tunknown\n"
1833
(uim 'test-prop-list))
1834
(assert-equal '("unknown")
1835
(uim 'test-mode-list))
1836
(assert-equal '("unknown")
1837
(uim 'test-updated-mode-list))
1838
(assert-equal 0
1839
(uim 'test-updated-mode)))
1840
1841
("test context-prop-activate-handler"
1842
;; 2 widgets
1843
(uim '(begin
1844
(context-init-widgets! tc '(widget_test_input_mode
1845
widget_test_kana_input_method))
1846
#t))
1847
(uim '(set! test-activated #f))
1848
(assert-true (uim-bool '(and (context-prop-activate-handler
1849
tc
1850
"action_test_hiragana")
1851
#t)))
1852
(assert-equal 'action_test_hiragana
1853
(uim 'test-activated))
1854
(uim '(set! test-activated #f))
1855
(assert-true (uim-bool '(and (context-prop-activate-handler
1856
tc
1857
"action_test_zenkaku")
1858
#t)))
1859
(assert-equal 'action_test_zenkaku
1860
(uim 'test-activated))
1861
(uim '(set! test-activated #f))
1862
(assert-true (uim-bool '(and (context-prop-activate-handler
1863
tc
1864
"action_test_kana")
1865
#t)))
1866
(assert-equal 'action_test_kana
1867
(uim 'test-activated))
1868
(uim '(set! test-activated #f))
1869
(assert-true (uim-bool '(and (context-prop-activate-handler
1870
tc
1871
"action_test_direct")
1872
#t)))
1873
(assert-equal 'action_test_direct
1874
(uim 'test-activated))
1875
(uim '(set! test-activated #f))
1876
(assert-true (uim-bool '(and (context-prop-activate-handler
1877
tc
1878
"action_test_direct")
1879
#t)))
1880
(assert-equal 'action_test_direct
1881
(uim 'test-activated))
1882
(uim '(set! test-activated #f))
1883
(assert-false (uim-bool '(and (context-prop-activate-handler
1884
tc
1885
"action_test_nonexistent")
1886
#t)))
1887
(assert-false (uim-bool 'test-activated))
1888
;; 1 widget
1889
(uim '(begin
1890
(context-init-widgets! tc '(widget_test_kana_input_method))
1891
#t))
1892
(uim '(set! test-activated #f))
1893
(assert-false (uim-bool '(and (context-prop-activate-handler
1894
tc
1895
"action_test_hiragana")
1896
#t)))
1897
(assert-false (uim-bool 'test-activated))
1898
(uim '(set! test-activated #f))
1899
(assert-false (uim-bool '(and (context-prop-activate-handler
1900
tc
1901
"action_test_zenkaku")
1902
#t)))
1903
(assert-false (uim-bool 'test-activated))
1904
(uim '(set! test-activated #f))
1905
(assert-true (uim-bool '(and (context-prop-activate-handler
1906
tc
1907
"action_test_kana")
1908
#t)))
1909
(assert-equal 'action_test_kana
1910
(uim 'test-activated))
1911
(uim '(set! test-activated #f))
1912
(assert-false (uim-bool '(and (context-prop-activate-handler
1913
tc
1914
"action_test_direct")
1915
#t)))
1916
(assert-false (uim-bool 'test-activated))
1917
(uim '(set! test-activated #f))
1918
(assert-false (uim-bool '(and (context-prop-activate-handler
1919
tc
1920
"action_test_direct")
1921
#t)))
1922
(assert-false (uim-bool 'test-activated))
1923
(uim '(set! test-activated #f))
1924
(assert-false (uim-bool '(and (context-prop-activate-handler
1925
tc
1926
"action_test_nonexistent")
1927
#t)))
1928
(assert-false (uim-bool 'test-activated))
1929
;; no widgets
1930
(uim '(begin
1931
(context-init-widgets! tc ())
1932
#t))
1933
(uim '(set! test-activated #f))
1934
(assert-false (uim-bool '(and (context-prop-activate-handler
1935
tc
1936
"action_test_hiragana")
1937
#t)))
1938
(assert-false (uim-bool 'test-activated))
1939
(uim '(set! test-activated #f))
1940
(assert-false (uim-bool '(and (context-prop-activate-handler
1941
tc
1942
"action_test_kana")
1943
#t)))
1944
(assert-false (uim-bool 'test-activated))
1945
(uim '(set! test-activated #f))
1946
(assert-false (uim-bool '(and (context-prop-activate-handler
1947
tc
1948
"action_test_direct")
1949
#t)))
1950
(assert-false (uim-bool 'test-activated))
1951
(uim '(set! test-activated #f))
1952
(assert-false (uim-bool '(and (context-prop-activate-handler
1953
tc
1954
"action_test_nonexistent")
1955
#t)))
1956
(assert-false (uim-bool 'test-activated))
1957
;; widget_test_null (no action handlers)
1958
(uim '(begin
1959
(context-init-widgets! tc '(widget_test_null))
1960
#t))
1961
(uim '(set! test-activated #f))
1962
(assert-false (uim-bool '(and (context-prop-activate-handler
1963
tc
1964
"action_test_hiragana")
1965
#t)))
1966
(assert-false (uim-bool 'test-activated))
1967
(uim '(set! test-activated #f))
1968
(assert-false (uim-bool '(and (context-prop-activate-handler
1969
tc
1970
"action_test_kana")
1971
#t)))
1972
(assert-false (uim-bool 'test-activated))
1973
(uim '(set! test-activated #f))
1974
(assert-false (uim-bool '(and (context-prop-activate-handler
1975
tc
1976
"action_test_direct")
1977
#t)))
1978
(assert-false (uim-bool 'test-activated))
1979
(uim '(set! test-activated #f))
1980
(assert-false (uim-bool '(and (context-prop-activate-handler
1981
tc
1982
"action_test_nonexistent")
1983
#t)))
1984
(assert-false (uim-bool 'test-activated)))
1985
1986
("test context-find-mode-widget"
1987
(uim '(begin
1988
(context-init-widgets! tc '(widget_test_input_mode
1989
widget_test_kana_input_method))
1990
#t))
1991
(assert-equal 'widget_test_input_mode
1992
(uim '(widget-id (context-find-mode-widget tc))))
1993
(uim '(begin
1994
(context-init-widgets! tc '(widget_test_kana_input_method
1995
widget_test_input_mode))
1996
#t))
1997
(assert-equal 'widget_test_input_mode
1998
(uim '(widget-id (context-find-mode-widget tc))))
1999
(uim '(begin
2000
(context-init-widgets! tc '(widget_test_kana_input_method
2001
widget_test_input_mode
2002
widget_test_null))
2003
#t))
2004
(assert-equal 'widget_test_input_mode
2005
(uim '(widget-id (context-find-mode-widget tc))))
2006
(uim '(begin
2007
(context-init-widgets! tc '(widget_test_kana_input_method
2008
widget_test_null))
2009
#t))
2010
(assert-false (uim-bool '(context-find-mode-widget tc)))
2011
(uim '(begin
2012
(context-init-widgets! tc ())
2013
#t))
2014
(assert-false (uim-bool '(context-find-mode-widget tc))))
2015
2016
("test widget-action-id->mode-value"
2017
(uim '(begin
2018
(define mw (widget-new 'widget_test_input_mode tc))
2019
#t))
2020
(assert-equal 0
2021
(uim '(widget-action-id->mode-value mw
2022
'action_test_hiragana)))
2023
(assert-equal 1
2024
(uim '(widget-action-id->mode-value mw
2025
'action_test_katakana)))
2026
(assert-equal 2
2027
(uim '(widget-action-id->mode-value mw
2028
'action_test_hankana)))
2029
(assert-equal 3
2030
(uim '(widget-action-id->mode-value mw
2031
'action_test_direct)))
2032
(assert-equal 4
2033
(uim '(widget-action-id->mode-value mw
2034
'action_test_zenkaku)))
2035
(assert-error (lambda ()
2036
(uim '(widget-action-id->mode-value mw 'action_test_nonexistent)))))
2037
2038
("test widget-mode-value->action-id"
2039
(uim '(begin
2040
(define mw (widget-new 'widget_test_input_mode tc))
2041
#t))
2042
(assert-equal 'action_test_hiragana
2043
(uim '(widget-mode-value->action-id mw 0)))
2044
(assert-equal 'action_test_katakana
2045
(uim '(widget-mode-value->action-id mw 1)))
2046
(assert-equal 'action_test_hankana
2047
(uim '(widget-mode-value->action-id mw 2)))
2048
(assert-equal 'action_test_direct
2049
(uim '(widget-mode-value->action-id mw 3)))
2050
(assert-equal 'action_test_zenkaku
2051
(uim '(widget-mode-value->action-id mw 4)))
2052
(assert-false (uim-bool '(widget-mode-value->action-id mw 5)))
2053
(assert-false (uim-bool '(widget-mode-value->action-id mw -1))))
2054
2055
("test context-current-mode"
2056
;;; widget_test_input_mode
2057
(uim '(begin
2058
(context-init-widgets! tc '(widget_test_input_mode
2059
widget_test_kana_input_method))
2060
(define test-input-mode (context-find-mode-widget tc))
2061
#t))
2062
;; action_test_direct (initial activity)
2063
(assert-equal 3
2064
(uim '(context-current-mode tc)))
2065
;; action_test_direct -> action_test_hiragana
2066
(assert-true (uim-bool '(widget-activate! test-input-mode
2067
'action_test_hiragana)))
2068
(assert-equal 0
2069
(uim '(context-current-mode tc)))
2070
;; action_test_hiragana -> action_test_katakana
2071
(assert-true (uim-bool '(widget-activate! test-input-mode
2072
'action_test_katakana)))
2073
(assert-equal 1
2074
(uim '(context-current-mode tc)))
2075
;; action_test_katakana -> action_test_hankana
2076
(assert-true (uim-bool '(widget-activate! test-input-mode
2077
'action_test_hankana)))
2078
(assert-equal 2
2079
(uim '(context-current-mode tc)))
2080
;; action_test_hankana -> action_test_zenkaku
2081
(assert-true (uim-bool '(widget-activate! test-input-mode
2082
'action_test_zenkaku)))
2083
(assert-equal 4
2084
(uim '(context-current-mode tc)))
2085
;; action_test_zenkaku -> action_test_direct
2086
(assert-true (uim-bool '(widget-activate! test-input-mode
2087
'action_test_direct)))
2088
(assert-equal 3
2089
(uim '(context-current-mode tc)))
2090
;; action_test_direct -> invalid
2091
(assert-false (uim-bool '(widget-activate! test-input-mode
2092
'action_nonexistent)))
2093
(assert-equal 3
2094
(uim '(context-current-mode tc)))
2095
(assert-error (lambda ()
2096
(uim '(context-current-mode #f))))
2097
2098
;;; no mode-widget
2099
(uim '(begin
2100
(context-init-widgets! tc '(widget_test_null
2101
widget_test_kana_input_method))
2102
#t))
2103
(assert-equal 0
2104
(uim '(context-current-mode tc)))
2105
(assert-error (lambda ()
2106
(uim '(context-current-mode #f))))
2107
2108
;;; no activity
2109
(uim '(begin
2110
(register-widget
2111
'widget_test_dummy_input_mode
2112
(indicator-new (lambda (owner)
2113
fallback-indication))
2114
#f) ;; has no actions
2115
(context-init-widgets! tc '(widget_test_dummy_input_mode
2116
widget_test_kana_input_method))
2117
#t))
2118
(assert-equal 0
2119
(uim '(context-current-mode tc)))
2120
(assert-error (lambda ()
2121
(uim '(context-current-mode #f))))
2122
2123
;;; duplicate activity
2124
(uim '(begin
2125
(register-widget
2126
'widget_test_invalid_input_mode
2127
(indicator-new (lambda (owner)
2128
fallback-indication))
2129
(actions-new '(action_test_hiragana
2130
action_test_katakana
2131
action_test_hankana
2132
action_test_direct
2133
action_test_alt_direct
2134
action_test_zenkaku)))
2135
(context-init-widgets! tc '(widget_test_invalid_input_mode
2136
widget_test_kana_input_method))
2137
#t))
2138
;; context-current-mode returns 0 rather than 3 when
2139
;; action_test_direct and action_test_alt_direct are conflicted.
2140
(assert-equal 0
2141
(uim '(context-current-mode tc)))
2142
;; action_test_direct -> action_test_hiragana
2143
(assert-true (uim-bool '(widget-activate! test-input-mode
2144
'action_test_hiragana)))
2145
(assert-equal 0
2146
(uim '(context-current-mode tc)))
2147
;; action_test_hiragana -> action_test_katakana
2148
(assert-true (uim-bool '(widget-activate! test-input-mode
2149
'action_test_katakana)))
2150
(assert-equal 1
2151
(uim '(context-current-mode tc)))
2152
(assert-error (lambda ()
2153
(uim '(context-current-mode #f)))))
2154
2155
("test context-update-mode"
2156
;;; widget_test_input_mode
2157
(uim '(begin
2158
(define test-updated-mode #f)
2159
(define im-update-mode
2160
(lambda (context mode)
2161
(set! test-updated-mode mode)))
2162
(context-init-widgets! tc '(widget_test_input_mode
2163
widget_test_kana_input_method))
2164
(define test-input-mode (context-find-mode-widget tc))
2165
#t))
2166
;; action_test_direct (initial activity)
2167
(uim '(context-update-mode tc))
2168
(assert-equal 3
2169
(uim 'test-updated-mode))
2170
;; action_test_direct -> action_test_hiragana
2171
(assert-true (uim-bool '(widget-activate! test-input-mode
2172
'action_test_hiragana)))
2173
(uim '(context-update-mode tc))
2174
(assert-equal 0
2175
(uim 'test-updated-mode))
2176
;; action_test_hiragana -> action_test_katakana
2177
(assert-true (uim-bool '(widget-activate! test-input-mode
2178
'action_test_katakana)))
2179
(uim '(context-update-mode tc))
2180
(assert-equal 1
2181
(uim 'test-updated-mode))
2182
;; action_test_katakana -> action_test_hankana
2183
(assert-true (uim-bool '(widget-activate! test-input-mode
2184
'action_test_hankana)))
2185
(uim '(context-update-mode tc))
2186
(assert-equal 2
2187
(uim 'test-updated-mode))
2188
;; action_test_hankana -> action_test_zenkaku
2189
(assert-true (uim-bool '(widget-activate! test-input-mode
2190
'action_test_zenkaku)))
2191
(uim '(context-update-mode tc))
2192
(assert-equal 4
2193
(uim 'test-updated-mode))
2194
;; action_test_zenkaku -> action_test_direct
2195
(assert-true (uim-bool '(widget-activate! test-input-mode
2196
'action_test_direct)))
2197
(uim '(context-update-mode tc))
2198
(assert-equal 3
2199
(uim 'test-updated-mode))
2200
;; action_test_direct -> invalid
2201
(assert-false (uim-bool '(widget-activate! test-input-mode
2202
'action_nonexistent)))
2203
(uim '(context-update-mode tc))
2204
(assert-equal 3
2205
(uim 'test-updated-mode))
2206
(assert-error (lambda ()
2207
(uim '(context-current-mode #f))))
2208
2209
;;; no mode-widget
2210
(uim '(begin
2211
(context-init-widgets! tc '(widget_test_null
2212
widget_test_kana_input_method))
2213
#t))
2214
(uim '(context-update-mode tc))
2215
(assert-equal 0
2216
(uim 'test-updated-mode))
2217
2218
;;; no activity
2219
(uim '(begin
2220
(register-widget
2221
'widget_test_dummy_input_mode
2222
(indicator-new (lambda (owner)
2223
fallback-indication))
2224
#f) ;; has no actions
2225
(context-init-widgets! tc '(widget_test_dummy_input_mode
2226
widget_test_kana_input_method))
2227
#t))
2228
(uim '(context-update-mode tc))
2229
(assert-equal 0
2230
(uim 'test-updated-mode))
2231
2232
;;; duplicate activity
2233
(uim '(begin
2234
(register-widget
2235
'widget_test_invalid_input_mode
2236
(indicator-new (lambda (owner)
2237
fallback-indication))
2238
(actions-new '(action_test_hiragana
2239
action_test_katakana
2240
action_test_hankana
2241
action_test_direct
2242
action_test_alt_direct
2243
action_test_zenkaku)))
2244
(context-init-widgets! tc '(widget_test_invalid_input_mode
2245
widget_test_kana_input_method))
2246
#t))
2247
;; context-current-mode returns 0 rather than 3 when
2248
;; action_test_direct and action_test_alt_direct are conflicted.
2249
(uim '(context-update-mode tc))
2250
(assert-equal 0
2251
(uim 'test-updated-mode))
2252
;; action_test_direct -> action_test_hiragana
2253
(assert-true (uim-bool '(widget-activate! test-input-mode
2254
'action_test_hiragana)))
2255
(uim '(context-update-mode tc))
2256
(assert-equal 0
2257
(uim 'test-updated-mode))
2258
;; action_test_hiragana -> action_test_katakana
2259
(assert-true (uim-bool '(widget-activate! test-input-mode
2260
'action_test_katakana)))
2261
(uim '(context-update-mode tc))
2262
(assert-equal 1
2263
(uim 'test-updated-mode)))
2264
2265
("test context-update-mode-list"
2266
(uim '(begin
2267
(context-init-widgets! tc '(widget_test_input_mode
2268
widget_test_kana_input_method))
2269
(define test-input-mode (context-find-mode-widget tc))
2270
#t))
2271
;; initial state
2272
(uim '(begin
2273
(context-update-mode-list tc)
2274
#t))
2275
(assert-equal '("ひらがな"
2276
"カタカナ"
2277
"半角カタカナ"
2278
"直接入力"
2279
"全角英数")
2280
(uim 'test-mode-list))
2281
(assert-equal '("ひらがな"
2282
"カタカナ"
2283
"半角カタカナ"
2284
"直接入力"
2285
"全角英数")
2286
(uim 'test-updated-mode-list))
2287
(assert-equal 3
2288
(uim 'test-updated-mode))
2289
;; action_test_direct -> action_test_hankana
2290
(assert-true (uim-bool '(widget-activate! test-input-mode
2291
'action_test_hankana)))
2292
(uim '(begin
2293
(context-update-mode-list tc)
2294
#t))
2295
(assert-equal '("ひらがな"
2296
"カタカナ"
2297
"半角カタカナ"
2298
"直接入力"
2299
"全角英数")
2300
(uim 'test-mode-list))
2301
(assert-equal '("ひらがな"
2302
"カタカナ"
2303
"半角カタカナ"
2304
"直接入力"
2305
"全角英数")
2306
(uim 'test-updated-mode-list))
2307
(assert-equal 2
2308
(uim 'test-updated-mode))
2309
;; duplicate activity
2310
(uim '(begin
2311
(register-widget
2312
'widget_test_invalid_input_mode
2313
(indicator-new (lambda (owner)
2314
fallback-indication))
2315
(actions-new '(action_test_hiragana
2316
action_test_katakana
2317
action_test_hankana
2318
action_test_direct
2319
action_test_alt_direct
2320
action_test_zenkaku)))
2321
(context-init-widgets! tc '(widget_test_invalid_input_mode
2322
widget_test_kana_input_method))
2323
#t))
2324
(uim '(test-context-set-on! tc #f))
2325
(uim '(begin
2326
(context-update-mode-list tc)
2327
#t))
2328
(assert-equal '("ひらがな"
2329
"カタカナ"
2330
"半角カタカナ"
2331
"直接入力"
2332
"直接入力"
2333
"全角英数")
2334
(uim 'test-mode-list))
2335
(assert-equal '("ひらがな"
2336
"カタカナ"
2337
"半角カタカナ"
2338
"直接入力"
2339
"直接入力"
2340
"全角英数")
2341
(uim 'test-updated-mode-list))
2342
;; context-current-mode returns 0 rather than 3 when
2343
;; action_test_direct and action_test_alt_direct are conflicted.
2344
(assert-equal 0
2345
(uim 'test-updated-mode))
2346
2347
;;; no activity
2348
(uim '(begin
2349
(register-widget
2350
'widget_test_dummy_input_mode
2351
(indicator-new (lambda (owner)
2352
fallback-indication))
2353
#f) ;; has no actions
2354
(context-init-widgets! tc '(widget_test_dummy_input_mode
2355
widget_test_kana_input_method))
2356
#t))
2357
(assert-true (uim-bool '(widget-activate! test-input-mode
2358
'action_test_hankana)))
2359
(uim '(begin
2360
(context-update-mode-list tc)
2361
#t))
2362
(assert-equal ()
2363
(uim 'test-mode-list))
2364
(assert-equal ()
2365
(uim 'test-updated-mode-list))
2366
(assert-equal 0
2367
(uim 'test-updated-mode)))
2368
2369
("test context-mode-handler"
2370
;; 2 widgets
2371
(uim '(begin
2372
(context-init-widgets! tc '(widget_test_input_mode
2373
widget_test_kana_input_method))
2374
#t))
2375
(uim '(set! test-activated #f))
2376
(assert-true (uim-bool '(and (context-mode-handler tc 0)
2377
#t)))
2378
(assert-equal 'action_test_hiragana
2379
(uim 'test-activated))
2380
(uim '(set! test-activated #f))
2381
(assert-true (uim-bool '(and (context-mode-handler tc 4)
2382
#t)))
2383
(assert-equal 'action_test_zenkaku
2384
(uim 'test-activated))
2385
(uim '(set! test-activated #f))
2386
(assert-true (uim-bool '(and (context-prop-activate-handler
2387
tc
2388
"action_test_kana")
2389
#t)))
2390
(assert-equal 'action_test_kana
2391
(uim 'test-activated))
2392
(uim '(set! test-activated #f))
2393
(assert-true (uim-bool '(and (context-mode-handler tc 3)
2394
#t)))
2395
(assert-equal 'action_test_direct
2396
(uim 'test-activated))
2397
(uim '(set! test-activated #f))
2398
(assert-true (uim-bool '(and (context-mode-handler tc 3)
2399
#t)))
2400
(assert-equal 'action_test_direct
2401
(uim 'test-activated))
2402
(uim '(set! test-activated #f))
2403
(assert-false (uim-bool '(and (context-mode-handler tc -1)
2404
#t)))
2405
(assert-false (uim-bool 'test-activated))
2406
;; 1 widget
2407
(uim '(begin
2408
(context-init-widgets! tc '(widget_test_kana_input_method))
2409
#t))
2410
(uim '(set! test-activated #f))
2411
(assert-false (uim-bool '(and (context-mode-handler tc 0)
2412
#t)))
2413
(assert-false (uim-bool 'test-activated))
2414
(uim '(set! test-activated #f))
2415
(assert-false (uim-bool '(and (context-mode-handler tc 4)
2416
#t)))
2417
(assert-false (uim-bool 'test-activated))
2418
(uim '(set! test-activated #f))
2419
(assert-true (uim-bool '(and (context-prop-activate-handler
2420
tc
2421
"action_test_kana")
2422
#t)))
2423
(assert-equal 'action_test_kana
2424
(uim 'test-activated))
2425
(uim '(set! test-activated #f))
2426
(assert-false (uim-bool '(and (context-mode-handler tc 3)
2427
#t)))
2428
(assert-false (uim-bool 'test-activated))
2429
(uim '(set! test-activated #f))
2430
(assert-false (uim-bool '(and (context-mode-handler tc 3)
2431
#t)))
2432
(assert-false (uim-bool 'test-activated))
2433
(uim '(set! test-activated #f))
2434
(assert-false (uim-bool '(and (context-mode-handler tc -1)
2435
#t)))
2436
(assert-false (uim-bool 'test-activated))
2437
;; no widgets
2438
(uim '(begin
2439
(context-init-widgets! tc ())
2440
#t))
2441
(uim '(set! test-activated #f))
2442
(assert-false (uim-bool '(and (context-mode-handler tc 0)
2443
#t)))
2444
(assert-false (uim-bool 'test-activated))
2445
(uim '(set! test-activated #f))
2446
(assert-false (uim-bool '(and (context-prop-activate-handler
2447
tc
2448
"action_test_kana")
2449
#t)))
2450
(assert-false (uim-bool 'test-activated))
2451
(uim '(set! test-activated #f))
2452
(assert-false (uim-bool '(and (context-mode-handler tc 3)
2453
#t)))
2454
(assert-false (uim-bool 'test-activated))
2455
(uim '(set! test-activated #f))
2456
(assert-false (uim-bool '(and (context-mode-handler tc -1)
2457
#t)))
2458
(assert-false (uim-bool 'test-activated))
2459
;; widget_test_null (no action handlers)
2460
(uim '(begin
2461
(context-init-widgets! tc '(widget_test_null))
2462
#t))
2463
(uim '(set! test-activated #f))
2464
(assert-false (uim-bool '(and (context-mode-handler tc 0)
2465
#t)))
2466
(assert-false (uim-bool 'test-activated))
2467
(uim '(set! test-activated #f))
2468
(assert-false (uim-bool '(and (context-prop-activate-handler
2469
tc
2470
"action_test_kana")
2471
#t)))
2472
(assert-false (uim-bool 'test-activated))
2473
(uim '(set! test-activated #f))
2474
(assert-false (uim-bool '(and (context-mode-handler tc 3)
2475
#t)))
2476
(assert-false (uim-bool 'test-activated))
2477
(uim '(set! test-activated #f))
2478
(assert-false (uim-bool '(and (context-mode-handler tc -1)
2479
#t)))
2480
(assert-false (uim-bool 'test-activated))))
Loggerhead is a web-based interface for Breezy
Version: 2.0.1