libs/glibmm2/tools/generate_wrap_init.pl.in

   1 #! @PERL_PATH@
   2 #
   3 # @configure_input@
   4 #
   5
   6 use strict;
   7
   8 my @namespace_whole = (); # list of strings.
   9 my $function_prefix = "";
  10 my $parent_dir = ""; # e.g. gtkmm
  11 my $path = "gtk--";
  12 my $debug = 0;
  13 my @filenames_headers = ();
  14 my %objects = ();
  15 my %exceptions = ();
  16 my %namespaces = (); # hashmap of lists of strings.
  17 my %basenames = ();
  18 my %win32_nowrap = ();
  19 my %deprecated = ();
  20
  21 # Loop through command line arguments, setting variables:
  22 while ($ARGV[0] =~ /^-/)
  23 {
  24   if ($ARGV[0] =~ /--namespace=(\S+)/)
  25   {
  26     push(@namespace_whole, $1);
  27
  28     if($parent_dir eq "")
  29       { $parent_dir = lc($1) . "mm"; }
  30   }
  31   elsif ($ARGV[0] =~ /--function_prefix=(\S+)/)
  32   {
  33     $function_prefix = "$1";
  34   }
  35   elsif ($ARGV[0] =~ /--parent_dir=(\S+)/)
  36   {
  37     $parent_dir = "$1";
  38   }
  39   elsif
  40   (
  41     $ARGV[0] =~ /--debug/) {$debug = 1;
  42   }
  43   elsif ($ARGV[0] =~ /--path=(\S+)/)
  44   {
  45     $path = "$1";
  46   }
  47   else
  48   {
  49     print "Error: unknown option $ARGV[0]\n";
  50     exit;
  51   }
  52
  53   shift @ARGV;
  54 }
  55
  56
  57
  58 while ($ARGV[0])
  59 {
  60   if ($debug) {warn "Processing file : $ARGV[0]\n";}
  61
  62   my $filename = $ARGV[0];
  63   open FILE, $filename or die "Couldn't open file $ARGV[0] : $!\n";
  64
  65   # my $file = $ARGV[0];
  66   # $file =~ s/.*\/([^\/]+)$/$1/;
  67   # $file =~ s/\.hg//;
  68   my @tmpnamespace = @namespace_whole;
  69   my $cppname = "";
  70   my $cname = "";
  71   my $ccast = "";
  72   while (<FILE>)
  73   {
  74     if (/CLASS_START\((\w+)\)/) #We need a new way to get the namespace.
  75     {
  76       print "generate_wrap_init: namespace found: $1\n";
  77       push(@tmpnamespace, $1);
  78     }
  79     elsif (/_CLASS_GOBJECT\s*\(/) #TODO: There is duplication of code here.
  80     {
  81       my $line = $_;
  82       while ($line !~ /\)/ && ($_ = <FILE>))
  83       {
  84         $line .= $_;
  85       }
  86
  87       $line =~ s/^.*_CLASS_GOBJECT\s*\(//;
  88       $line =~ s/\s+//g;
  89       ($cppname, $cname, $ccast) = split(/,/, $line);
  90
  91       $objects{$cppname} = $cname;
  92       @{$namespaces{$cppname}} = ( @tmpnamespace ); #both are lists of strings
  93       $basenames{$cppname} = lc($ccast);
  94     }
  95     elsif (/_CLASS_GTKOBJECT\s*\(/)
  96     {
  97       my $line = $_;
  98       while ($line !~ /\)/ && ($_ = <FILE>))
  99       {
 100         $line .= $_;
 101       }
 102
 103       $line =~ s/^.*_CLASS_GTKOBJECT\s*\(//;
 104       $line =~ s/\s+//g;
 105       ($cppname, $cname, $ccast) = split(/,/, $line);
 106
 107       #TODO: Remove this hack eventually.
 108       if( ($cname ne "GtkTree") && ($cname ne "GtkTreeItem") && ($cname ne "GtkText") )
 109       {
 110         $objects{$cppname} = $cname;
 111         @{$namespaces{$cppname}} = ( @tmpnamespace ); #both are lists of strings
 112         $basenames{$cppname} = lc($ccast);
 113       }
 114     }
 115     elsif (/_WRAP_GERROR\s*\(/) #TODO: There is duplication of code here.
 116     {
 117       my $line = $_;
 118       while ($line !~ /\)/ && ($_ = <FILE>))
 119       {
 120         $line .= $_;
 121       }
 122
 123       $line =~ s/^.*_WRAP_GERROR\s*\(//;
 124       $line =~ s/\s+//g;
 125       $line =~ s/\)//;
 126       ($cppname, $cname, $ccast) = split(/,/, $line);
 127
 128       $exceptions{$cppname} = $cname;
 129       @{$namespaces{$cppname}} = ( @tmpnamespace ); #both are lists of strings
 130       $basenames{$cppname} = lc($ccast);
 131     }
 132     elsif (/_GTKMMPROC_WIN32_NO_WRAP/)
 133     {
 134       $win32_nowrap{$cppname} = 1;
 135     }
 136     elsif (/_IS_DEPRECATED/)
 137     {
 138       $deprecated{$cppname} = 1;
 139     }
 140   }
 141
 142   # Store header filename so that we can #include it later:
 143   my $filename_header = $filename;
 144   $filename_header =~ s/.*\/([^\/]+)\.hg/$1.h/;
 145   push(@filenames_headers, $filename_header);
 146
 147   shift @ARGV;
 148   close(FILE);
 149 }
 150
 151 # my $namespace_whole_lower = lc($namespace_whole);
 152
 153 print << "EOF";
 154
 155 #include <glib.h>
 156
 157 // Disable the 'const' function attribute of the get_type() functions.
 158 // GCC would optimize them out because we don't use the return value.
 159 #undef  G_GNUC_CONST
 160 #define G_GNUC_CONST /* empty */
 161
 162 #include <${parent_dir}/wrap_init.h>
 163 #include <glibmm/error.h>
 164 #include <glibmm/object.h>
 165
 166 // #include the widget headers so that we can call the get_type() static methods:
 167
 168 EOF
 169
 170 foreach( @filenames_headers )
 171 {
 172   print "#include \"" . $_ . "\"\n";
 173 }
 174
 175 print "\n";
 176
 177 # Here we have to be subtle. The gtkmm objects are easy, they all go
 178 # into the Gtk namespace. But in gnomemm, some go into the Gnome
 179 # namespace (most of them), and some into the Gtk one (because the
 180 # corresponding widget is Gtk-prefixed, e.g. GtkTed, GtkDial, etc...
 181
 182 # First, the Gtk namespace
 183
 184 print "extern \"C\"\n";
 185 print "{\n";
 186 print "\n//Declarations of the *_get_type() functions:\n\n";
 187
 188 my $i = 0;
 189 foreach $i (sort keys %objects)
 190 {
 191   if( $deprecated{$i} eq 1 )
 192   {
 193     # The uc(parent_dir) is a bit of a hack. One day it will get it wrong.
 194     print "#ifndef " . uc($parent_dir) ."_DISABLE_DEPRECATED\n"
 195   }
 196
 197   #On Win32, these classes are not compiled:
 198   if( $win32_nowrap{$i} eq 1 )
 199   {
 200     print "#ifndef G_OS_WIN32\n"
 201   }
 202
 203   print "GType $basenames{$i}_get_type(void);\n";
 204
 205   if( $win32_nowrap{$i} eq 1 )
 206   {
 207     print "#endif //G_OS_WIN32\n"
 208   }
 209
 210   if( $deprecated{$i} eq 1 )
 211   {
 212     print "#endif // *_DISABLE_DEPRECATED\n"
 213   }
 214 }
 215
 216 print "\n//Declarations of the *_error_quark() functions:\n\n";
 217
 218 my $i = 0;
 219 foreach $i (sort keys %exceptions)
 220 {
 221   print "GQuark $basenames{$i}_quark(void);\n";
 222 }
 223
 224 print "} // extern \"C\"\n";
 225 print "\n";
 226
 227 print "\n//Declarations of the *_Class::wrap_new() methods, instead of including all the private headers:\n\n";
 228
 229 my $i = 0;
 230 foreach $i (sort keys %objects)
 231 {
 232   if( $deprecated{$i} eq 1 )
 233   {
 234     # The uc(parent_dir) is a bit of a hack. One day it will get it wrong.
 235     print "#ifndef " . uc($parent_dir) ."_DISABLE_DEPRECATED\n"
 236   }
 237
 238   #On Win32, these classes are not compiled:
 239   if( $win32_nowrap{$i} eq 1 )
 240   {
 241     print "#ifndef G_OS_WIN32\n"
 242   }
 243
 244   my $namespace_declarations = "";
 245   my $namespace_close = "";
 246   foreach ( @{$namespaces{$i}} )
 247   {
 248     $namespace_declarations .= "namespace $_ { ";
 249     $namespace_close .= " }";
 250   }
 251
 252   print "${namespace_declarations} class ${i}_Class { public: static Glib::ObjectBase* wrap_new(GObject*); }; ${namespace_close}\n";
 253
 254   if( $win32_nowrap{$i} eq 1 )
 255   {
 256     print "#endif //G_OS_WIN32\n"
 257   }
 258
 259   if( $deprecated{$i} eq 1 )
 260   {
 261     print "#endif // *_DISABLE_DEPRECATED\n"
 262   }
 263 }
 264
 265 # print "\n//Declarations of the *Error::throw_func() methods:\n\n";
 266 #
 267 # my $i = 0;
 268 # foreach $i (sort keys %exceptions)
 269 # {
 270 #   my $namespace_declarations = "";
 271 #   my $namespace_close = "";
 272 #   foreach ( @{$namespaces{$i}} )
 273 #   {
 274 #     $namespace_declarations .= "namespace $_ { ";
 275 #     $namespace_close .= " }";
 276 #   }
 277 #
 278 #   print "${namespace_declarations} class ${i} { public: static void throw_func(GError*); }; ${namespace_close}\n";
 279 # }
 280
 281 my $namespace_whole_declarations = "";
 282 my $namespace_whole_close = "";
 283 foreach( @namespace_whole )
 284 {
 285   $namespace_whole_declarations .= "namespace " . $_ ." { ";
 286   $namespace_whole_close = "} //" . $_ . "\n" . $namespace_whole_close;
 287 }
 288
 289 print "\n";
 290 print "$namespace_whole_declarations\n";
 291 print "\n";
 292 print "void " .$function_prefix . "wrap_init()\n{\n";
 293
 294
 295 # Generate namespace::wrap_init() body
 296 #
 297
 298 print "  // Register Error domains:\n";
 299
 300 foreach $i (sort keys %exceptions)
 301 {
 302   my $namespace_prefix = "";
 303   foreach( @{$namespaces{$i}} )
 304   {
 305     $namespace_prefix .= $_ ."::";
 306   }
 307
 308   print "  Glib::Error::register_domain($basenames{$i}_quark(), &", "${namespace_prefix}${i}::throw_func);\n";
 309 }
 310
 311 print "\n";
 312 print "// Map gtypes to gtkmm wrapper-creation functions:\n";
 313
 314 foreach $i (sort keys %objects)
 315 {
 316   if( $deprecated{$i} eq 1 )
 317   {
 318     # The uc(parent_dir) is a bit of a hack. One day it will get it wrong.
 319     print "#ifndef " . uc($parent_dir) ."_DISABLE_DEPRECATED\n"
 320   }
 321
 322   #On Win32, these classes are not compiled:
 323   if( $win32_nowrap{$i} eq 1 )
 324   {
 325     print "#ifndef G_OS_WIN32\n"
 326   }
 327
 328   my $namespace_prefix = "";
 329   foreach( @{$namespaces{$i}} )
 330   {
 331     $namespace_prefix .= $_ ."::";
 332   }
 333
 334   print "  Glib::wrap_register($basenames{$i}_get_type(), &", "${namespace_prefix}${i}_Class::wrap_new);\n";
 335
 336   if( $win32_nowrap{$i} eq 1 )
 337   {
 338     print "#endif //G_OS_WIN32\n"
 339   }
 340
 341   if( $deprecated{$i} eq 1 )
 342   {
 343     print "#endif // *_DISABLE_DEPRECATED\n"
 344   }
 345 }
 346
 347 print "\n";
 348 print "  // Register the gtkmm gtypes:\n";
 349
 350 foreach $i (sort keys %objects)
 351 {
 352   if( $deprecated{$i} eq 1 )
 353   {
 354     # The uc(parent_dir) is a bit of a hack. One day it will get it wrong.
 355     print "#ifndef " . uc($parent_dir) ."_DISABLE_DEPRECATED\n"
 356   }
 357
 358   #On Win32, these classes are not compiled:
 359   if( $win32_nowrap{$i} eq 1 )
 360   {
 361     print "#ifndef G_OS_WIN32\n"
 362   }
 363
 364   my $namespace_prefix = "";
 365   foreach( @{$namespaces{$i}} )
 366   {
 367     $namespace_prefix .= $_ ."::";
 368   }
 369
 370   print "  ${namespace_prefix}${i}::get_type();\n";
 371
 372   if( $win32_nowrap{$i} eq 1 )
 373   {
 374     print "#endif //G_OS_WIN32\n"
 375   }
 376
 377   if( $deprecated{$i} eq 1 )
 378   {
 379     print "#endif // *_DISABLE_DEPRECATED\n"
 380   }
 381 }
 382
 383 print << "EOF";
 384
 385 } // wrap_init()
 386
 387 $namespace_whole_close
 388
 389 EOF
 390
 391 exit 0;
 392