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
|
#!perl -w
use strict;
my $file = __FILE__;
$file =~ s/\.PL$//;
chmod(0666,$file) unless -w $file;
rename($file,"$file.old") unless -w $file;
open(F,">$file") || die "Cannot open $file:$!";
select(F);
my @vtable = qw(Tkoption Lang Tkevent Tk Tkint Tkglue Tkintdecls Tkdecls Tcldecls);
my @wtable = qw(Tkintxlibdecls Tkplatdecls Tkintplatdecls);
my @utable = qw(Xlib);
my @tix = qw(Tix Tixint);
my @tixxpm = qw(Tiximgxpm);
my @photo = qw(Tkimgphoto Imgint);
my @event = qw(Tkevent);
my $maxl = 0;
length > $maxl and $maxl = length foreach (@vtable,@wtable,@utable);
print <<'END';
#define IMPORT_VTABLE(ptr,type,name) do { \
ptr = INT2PTR(type *,SvIV(get_sv(name,GV_ADDWARN|GV_ADD))); \
if ((*ptr->tabSize)() != sizeof(type)) { \
Perl_warn(aTHX_ "%s wrong size for %s",name,#type); \
} \
} while (0)
END
print "#ifdef WIN32\n";
do_tables(VTABLES => @vtable,@wtable);
print "#else\n";
do_tables(VTABLES => @vtable,@utable);
print "#endif\n";
do_tables(TIX => @tix);
do_tables(PHOTO => @photo);
do_tables(EVENT => @event);
do_tables(TIXXPM => @tixxpm);
sub do_tables
{
my $name = shift;
my @tables = sort(@_);
print "#define DECLARE_$name\t\\\n";
while (@tables)
{
my $tab = shift(@tables);
my $pad = ' ' x ($maxl - length($tab));
print $tab,"Vtab$pad *",$tab,"Vptr";
print ";$pad\\" if @tables;
print "\n";
}
print "\n";
print "#define IMPORT_$name\tdo { \\\n";
foreach my $tab (sort @_)
{
my $pad = ' ' x ($maxl - length($tab));
print qq/IMPORT_VTABLE(${tab}Vptr$pad,$pad${tab}Vtab,"Tk::${tab}Vtab");$pad \\\n/;
}
print "} while (0)\n";
}
|
