]> gitweb.factorcode.org Git - factor.git/blob - basis/ui/commands/commands-tests.factor
ui: better platform-specific keybindings.
[factor.git] / basis / ui / commands / commands-tests.factor
1 IN: ui.commands.tests
2 USING: ui.commands ui.gestures tools.test help.markup io
3 io.streams.string system kernel ;
4
5 { "Press Button 2" } [ T{ button-down f f 2 } gesture>string ] unit-test
6
7 : com-test-1 ( -- ) ;
8
9 \ com-test-1 H{ } define-command
10
11 { [ 3 com-test-1 ] } [ 3 \ com-test-1 command-quot ] unit-test
12
13 : com-test-2 ( -- ) ;
14
15 \ com-test-2 H{ { +nullary+ t } } define-command
16
17 { [ com-test-2 ] } [ 3 \ com-test-2 command-quot ] unit-test
18
19 SYMBOL: testing
20
21 testing "testing" "hey" {
22     { T{ key-down f { C+ } "x" } com-test-1 }
23 } define-command-map
24
25 os macosx? [
26     { "⌘A" } [ T{ key-down f { M+ } "a" } gesture>string ] unit-test
27     { "B" } [ T{ key-down f f "b" } gesture>string ] unit-test
28
29     { "⌃X" } [
30         [
31             { $command testing "testing" com-test-1 } print-element
32         ] with-string-writer
33     ] unit-test
34 ] [
35     { "A+a" } [ T{ key-down f { A+ } "a" } gesture>string ] unit-test
36     { "b" } [ T{ key-down f f "b" } gesture>string ] unit-test
37
38     { "C+x" } [
39         [
40             { $command testing "testing" com-test-1 } print-element
41         ] with-string-writer
42     ] unit-test
43 ] if
44
45 : com-foo. ( -- ) ;
46
47 { "Foo" } [ \ com-foo. command-name ] unit-test