File: vtab.def.PL

package info (click to toggle)
perl-tk 1:804.033-2
  • links: PTS
  • area: main
  • in suites: bullseye, buster, sid
  • size: 34,724 kB
  • ctags: 37,174
  • sloc: ansic: 349,541; perl: 52,192; sh: 17,904; makefile: 5,732; asm: 3,565; ada: 1,681; pascal: 1,089; cpp: 1,006; yacc: 883; cs: 879
file content (63 lines) | stat: -rwxr-xr-x 1,710 bytes parent folder | download | duplicates (7)
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";
}