1 #############################################################################
2 ## Name: build/Wx/Overload/Driver.pm
3 ## Purpose: builds overload constants
4 ## Author: Mattia Barbon
7 ## RCS-ID: $Id: Driver.pm 2500 2008-11-05 22:17:53Z mbarbon $
8 ## Copyright: (c) 2001-2003, 2005-2008 Mattia Barbon
9 ## Licence: This program is free software; you can redistribute it and/or
10 ## modify it under the same terms as Perl itself
11 #############################################################################
13 package Wx::Overload::Driver;
17 use Symbol qw(gensym);
19 use Wx::Overload::Handle;
27 wmit => 'Wx::MenuItem',
31 wtip => 'Wx::ToolTip',
34 wlci => 'Wx::ListItem',
35 wgco => 'Wx::GridCellCoords',
36 wdat => 'Wx::DataObject',
38 wehd => 'Wx::EvtHandler',
54 my %name2type = %_name2type;
58 my( $class, %args ) = @_;
59 my $self = bless \%args, $class;
74 foreach my $i ( $self->files ) {
75 my %namedecl = %_name2type;
76 open my $fh, '<', $i or die "open '$i': $!";
79 if( m/DECLARE_OVERLOAD\(\s*(\w+)\s*,\s*(\S+)\s*\)/ ) {
81 next if exists $name2type{$1} && $name2type{$1} eq $2;
82 die "Clashing type: '$1' was '$name2type{$1}', redeclared as '$2'"
83 if exists $name2type{$1};
86 if( m/Wx::_match\(\s*\@_\s*,\s*\$Wx::_(\w+)\s*\,/ ||
89 my @const = split /_/, $const;
90 foreach my $j ( @const ) {
91 $j = 'num' if $j eq 'n';
92 $j = 'str' if $j eq 's';
93 $j = 'bool' if $j eq 'b';
95 die "unrecognized type '$j' in file '$i'"
97 $constants{$const} = \@const;
107 my @keys = ( ( sort grep { $name2type{$_} eq '1' } keys %name2type ),
108 ( sort grep { $name2type{$_} ne '1' } keys %name2type ) );
110 my $vars_comma = join ", ",
113 my $vars = $vars_comma; $vars =~ s/,//g;
114 my $types = join ", ",
115 map "'$name2type{$_}'",
116 grep $name2type{$_} ne '1',
118 my $cpp_types = $types; $cpp_types =~ s/\'/\"/g;
123 tie *$out, 'Wx::Overload::Handle', $self->header;
125 my $enum = join ",\n",
130 // GENERATED FILE, DO NOT EDIT
132 #ifndef _CPP_OVERLOAD_H
133 #define _CPP_OVERLOAD_H
145 foreach my $i ( sort keys %constants ) {
146 print $out "extern const wxPliPrototype wxPliOvl_${i};\n";
155 tie *$out, 'Wx::Overload::Handle', $self->source;
158 // GENERATED FILE, DO NOT EDIT
160 const char* wxPliOvl\_tnames[] = { 0,
164 extern void wxPli_set_ovl_constant( const char* name,
165 const wxPliPrototype* value );
172 void SetOvlConstants()
177 foreach my $i ( sort keys %constants ) {
179 wxPli_set_ovl_constant( \"$i\", &wxPliOvl_${i} );
190 foreach my $i ( sort keys %constants ) {
191 my $count = scalar @{$constants{$i}};
192 print $out "const unsigned char wxPliOvl_${i}_datadef\[\] = { ";
193 print $out join ", ", map { "wxPliOvl$_" } @{$constants{$i}};
196 const wxPliPrototype wxPliOvl_${i}
197 ( wxPliOvl\_tnames, wxPliOvl_${i}_datadef, $count );
205 sub source { $_[0]->{source} }
206 sub header { $_[0]->{header} }
207 sub files { @{$_[0]->{files}} }