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
|
# -*- perl -*-
BEGIN { $|=1; $^W=1; }
use strict;
use Test;
BEGIN { plan test => 6 };
eval { require Tk };
ok($@, "", "loading Tk module");
eval { require Tk::FBox };
ok($@, "", "loading Tk::FBox module");
my $top = new MainWindow;
eval { $top->geometry('+10+10'); }; # This works for mwm and interactivePlacement
my $f;
eval {
$f = $top->FBox(-defaultextension => ".PL",
-filetypes => [
['Text Files', ['.txt', '.text']],
['TCL Scripts', '.tcl' ],
['C Source Files', '.c', 'TEXT'],
['GIF Files', '.gif', ],
['GIF Files', '', 'GIFF'],
['All Files', '*', ],
],
-initialdir => ".",
-initialfile => "Makefile.PL",
-title => "Load file",
-type => "open",
-filter => "*.PL",
-font => "Helvetica 14",
);
};
ok($@, "", "creating Tk::FBox widget");
$f->after(1000, sub { $f->destroy });
$f->Show;
ok(1);
eval {
$f = $top->FBox(-defaultextension => ".PL",
-filetypes => [
['Text Files', ['.txt', '.text']],
['TCL Scripts', '.tcl' ],
['C Source Files', '.c', 'TEXT'],
['GIF Files', '.gif', ],
['GIF Files', '', 'GIFF'],
['All Files', '*', ],
],
-initialdir => ".",
-initialfile => "Makefile.PL",
-title => "Save file",
-type => "save",
-filter => "*.PL",
-font => "Helvetica 14",
);
};
ok($@, "", "creating Tk::FBox widget for save");
$f->after(1000, sub { $f->destroy });
$f->Show;
ok(1);
1;
__END__
|
