1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
|
#!/usr/bin/perl
use v5.14;
use warnings;
BEGIN {
# We need to force TERM=xterm so that we can guarantee the right byte
# sequences for testing
$ENV{TERM} = "xterm";
}
use Test::More;
use Test::Refcount;
use Tickit qw( BIND_FIRST );
use Tickit::Term;
use Time::HiRes qw( sleep );
my $term = Tickit::Term->new( UTF8 => 1 );
$term->set_size( 25, 80 );
is( $term->get_input_handle, undef, '$term->get_input_handle undef' );
is_oneref( $term, '$term has refcount 1 initially' );
# key events
{
my ( $type, $str );
my $id = $term->bind_event( key => sub {
my ( undef, $ev, $info ) = @_;
cmp_ok( $_[0], '==', $term, '$_[0] is term for resize event' );
is( $ev, "key", '$ev is key' );
$type = $info->type;
$str = $info->str;
return 1;
} );
is_oneref( $term, '$term has refcount 1 after ->bind_event' );
$term->emit_key( type => "text", str => " ", mod => 0 );
is( $type, "text", '$type after emit_key Space' );
is( $str, " ", '$str after emit_key Space' );
$term->input_push_bytes( "A" );
is( $type, "text", '$type after push_bytes A' );
is( $str, "A", '$str after push_bytes A' );
is( $term->check_timeout, undef, '$term has no timeout after A' );
# We'll test with a Unicode character outside of Latin-1, to ensure it
# roundtrips correctly
#
# 'ĉ' [U+0109] - LATIN SMALL LETTER C WITH CIRCUMFLEX
# UTF-8: 0xc4 0x89
undef $type; undef $str;
$term->input_push_bytes( "\xc4\x89" );
is( $type, "text", '$type after push_bytes for UTF-8' );
is( $str, "\x{109}", '$str after push_bytes for UTF-8' );
$term->input_push_bytes( "\e[A" );
is( $type, "key", '$type after push_bytes Up' );
is( $str, "Up", '$str after push_bytes Up' );
is( $term->check_timeout, undef, '$term has no timeout after Up' );
undef $type; undef $str;
$term->input_push_bytes( "\e[" );
is( $type, undef, '$type undef after partial Down' );
ok( defined $term->check_timeout, '$term has timeout after partial Down' );
$term->input_push_bytes( "B" );
is( $type, "key", '$type after push_bytes after completed Down' );
is( $str, "Down", '$str after push_bytes after completed Down' );
is( $term->check_timeout, undef, '$term has no timeout after completed Down' );
undef $type; undef $str;
$term->input_push_bytes( "\e" );
is( $type, undef, '$type undef after partial Escape' );
my $timeout = $term->check_timeout;
ok( $timeout, '$term has timeout after partial Escape' );
sleep $timeout + 0.01; # account for timing overlaps
is( $term->check_timeout, undef, '$term has no timeout after timedout' );
is( $type, "key", '$type after push_bytes after timedout' );
is( $str, "Escape", '$str after push_bytes after timedout' );
$term->unbind_event_id( $id );
}
# event handler return values
{
my $first_ret = 0;
my @called;
my @ids = (
$term->bind_event( key => sub { push @called, "A"; return $first_ret } ),
$term->bind_event( key => sub { push @called, "B"; return 0 } ),
);
$term->emit_key( type => "key", str => "X" );
is_deeply( \@called, [qw( A B )], 'both event handlers called when first returns 0' );
$first_ret = 1;
@called = ();
$term->emit_key( type => "key", str => "X" );
is_deeply( \@called, [qw( A )], 'second event handlers not called when first returns 1' );
$term->unbind_event_id( $_ ) for @ids;
}
# BIND_FIRST
{
my @called;
my @ids = map {
my $str = $_;
$term->bind_event( key => BIND_FIRST, sub { push @called, $str; return 0 } );
} qw( A B );
$term->emit_key( type => "key", str => "X" );
is_deeply( \@called, [qw( B A )], 'event handlers called in reverse order with BIND_FIRST' );
$term->unbind_event_id( $_ ) for @ids;
}
# mouse events
{
my ( $type, $button, $line, $col );
my $id = $term->bind_event( mouse => sub {
my ( $term, $ev, $info ) = @_;
is( $ev, "mouse", '$ev is mouse' );
$type = $info->type;
$button = $info->button;
$line = $info->line;
$col = $info->col;
return 1;
} );
$term->emit_mouse( type => "press", button => 1, line => 2, col => 3 );
is( $type, "press", '$type after emit_mouse' );
is( $button, 1, '$button after emit_mouse' );
is( $line, 2, '$line after emit_mouse' );
is( $col, 3, '$col after emit_mouse' );
$term->emit_mouse( type => "wheel", button => "down", line => 2, col => 3 );
is( $type, "wheel", '$type after emit_mouse wheel' );
is( $button, "down", '$button after emit_mouse wheel' );
is( $line, 2, '$line after emit_mouse wheel' );
is( $col, 3, '$col after emit_mouse wheel' );
$term->unbind_event_id( $id );
}
{
pipe( my $rd, my $wr ) or die "pipe() - $!";
my $term = Tickit::Term->new( input_handle => $rd );
isa_ok( $term, "Tickit::Term", '$term isa Tickit::Term' );
is( $term->get_input_handle->fileno, $rd->fileno,
'$term->get_input_handle->fileno is $rd' );
}
done_testing;
|
