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
|
#!/usr/bin/perl -w
# -*- perl -*-
#
# $Id: $
# Author: Slaven Rezic
#
use strict;
use Tk;
BEGIN {
if (!eval q{
use Test::More;
1;
}) {
print "1..0 # skip: no Test::More module\n";
exit;
}
}
plan tests => 17;
use_ok('Tk::MsgBox');
my $mw = MainWindow->new;
$mw->geometry("+10+10");
my @opts = (-icon => "info",
-detail => "Some details...",
-message => "A message",
-type => "ok",
-title => "Dialog title",
);
for my $icon (qw(info warning error question)) {
my $w = $mw->MsgBox(@opts, -icon => $icon);
ok(Tk::Exists($w), "Setting -icon to $icon");
is($w->state, "withdrawn", "Initially invisible");
$w->after(100, sub { $w->destroy });
$w->Show;
}
for my $type (qw(abortretryignore ok okcancel retrycancel yesno yesnocancel)) {
my $w = $mw->MsgBox(@opts, -type => $type);
ok(Tk::Exists($w), "Setting -type to $type");
$w->after(100, sub { $w->destroy });
$w->Show;
}
{
my $w = $mw->MsgBox(-type => "okcancel");
ChooseMsg($w,'ok');
is($w->Show, 'ok', "Emulating mouse click to ok");
ChooseMsg($w,'cancel');
is($w->Show, 'cancel', "Emulating mouse click to cancel");
}
if (0) { # XXX this probably only works after the grab stuff...
my $w = $mw->MsgBox(-type => "okcancel");
ChooseMsgByKey($w,'ok');
is($w->Show, 'ok', "Emulating key press to ok");
ChooseMsgByKey($w,'cancel');
is($w->Show, 'cancel', "Emulating key press to cancel");
}
sub ChooseMsg {
my($w,$btn) = @_;
$w->after(100, sub {SendEventToMsg($w,$btn,'mouse')});
}
sub ChooseMsgByKey {
my($w,$btn) = @_;
$w->after(100, sub {SendEventToMsg($w,$btn,'key')});
}
sub PressButton {
my($b) = @_;
$b->eventGenerate('<Enter>');
$b->eventGenerate('<ButtonPress-1>', '-x' => 5, '-y' => 5);
$b->eventGenerate('<ButtonRelease-1>', '-x' => 5, '-y' => 5);
}
sub SendEventToMsg {
my($w, $btn, $type) = @_;
my $b = $w->Subwidget($btn);
if (!$b->ismapped) {
$b->update;
}
if ($type eq 'mouse') {
PressButton($b);
} else {
$w->eventGenerate('<Enter>');
$w->focus;
$b->eventGenerate('<Enter>');
$w->eventGenerate('<KeyPress>', -keysym => 'Return');
}
}
__END__
|
